ES classes, arrow functions, and a bug. Oh My!

src/compiler.lisp

@@ -218,6 +218,8 @@ CL environment)."
 
 (defvar this-in-lambda-wrapped-form? nil)
 
+(defvar *ps-gensym-counter* 0)
+
 (defun lambda-wrap (form)
   (let ((this-in-lambda-wrapped-form? :query)
 	(*ps-gensym-counter* *ps-gensym-counter*))
@@ -298,8 +300,6 @@ form, FORM, returns the new value for *compilation-level*."
   (let ((compile-expression? t))
     (ps-compile form)))
 
-(defvar *ps-gensym-counter* 0)
-
 (defun ps-gensym (&optional (prefix-or-counter "_JS"))
   (assert (or (stringp prefix-or-counter) (integerp prefix-or-counter)))
   (let ((prefix (if (stringp prefix-or-counter) prefix-or-counter "_JS"))

src/js-ir-package.lisp

@@ -107,4 +107,7 @@
    #:funcall
    #:escape
    #:regex
+
+   #:es-class
+   #:=>
    ))

src/non-cl.lisp

@@ -214,3 +214,44 @@
 
 (define-ps-symbol-macro false ps-js:false)
 (defvar false nil)
+
+(define-expression-operator => (lambda-list &rest body)
+  (multiple-value-bind (effective-args effective-body)
+      (parse-extended-function lambda-list body)
+    `(ps-js:=> ,effective-args
+       ,(let ((*function-block-names* ()))
+          (compile-function-body effective-args effective-body)))))
+
+(define-statement-operator es-class (name (&optional parent) &body body)
+  (let (defs)
+    (flet ((collect (form)
+	     (push form defs))
+	   (parse (sym form)
+	     (destructuring-bind (name (&rest params) &body body)
+		 form
+	       (multiple-value-bind (effective-args body-block docstring)
+		   (compile-named-function-body name params body)
+		 (list* sym name effective-args docstring body-block)))))
+      (dolist (form body)
+	(ecase (first form)
+	  (static
+	   (dolist (form (rest form))
+	     (ecase (first form)
+	       (setf
+		(pop form)
+		(while form
+		  (collect `(static-assign ,(pop form)
+					   ,(compile-expression (pop form))))))
+	       ((defun)
+		(collect (parse 'static-function
+				(rest form)))))))
+	  (setf
+	   (pop form)
+	   (while form
+	     (collect `(setf ,(pop form)
+			     ,(compile-expression (pop form))))))
+	  ((defun)
+	   (collect (parse 'function
+			   (rest form))))))
+      `(ps-js:es-class ,name ,parent
+	 ,(nreverse defs)))))

src/package.lisp

@@ -275,6 +275,11 @@
    #:break
    #:continue
 
+   ;; es6+ stuff
+   #:es-class
+   #:static
+   #:=>
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Deprecated functionality
 

src/printer.lisp

@@ -255,6 +255,18 @@ vice-versa.")
   (parenthesize-at-toplevel
    (lambda () (print-fun-def nil args body-block))))
 
+(defprinter ps-js:=> (args body-block)
+  (parenthesize-at-toplevel
+   (lambda ()
+     (psw "(")
+     (loop
+       :for (arg . rest) :on args
+       :do (ps-print arg)
+	   (when rest
+	     (psw ", ")))
+     (psw ") => ")
+     (ps-print body-block))))
+
 (defprinter ps-js:defun (name args docstring body-block)
   (when docstring (print-comment docstring))
   (print-fun-def name args body-block))
@@ -388,3 +400,37 @@ vice-versa.")
   ;; literal-js should be a form that evaluates to a string containing
   ;; valid JavaScript
   (psw literal-js))
+
+(defprinter ps-js:es-class (name parent body)
+	    "class "
+	    (ps-print name)
+	    (when parent
+	      (psw " extends ")
+	      (ps-print parent))
+	    " {"
+	    (incf *indent-level*)
+	    (labels ((fun (form)
+		       (destructuring-bind (name (&rest args) docstring &body body)
+			   form
+			 (declare (ignore docstring))
+			 (print-fun-def (list name nil) args body))))
+	      (dolist (form body)
+		(newline-and-indent)
+		(ecase (first form)
+		  (static-assign
+		   (psw "static ")
+		   (ps-print (second form))
+		   (psw " = ")
+		   (ps-print (third form)))
+		  (static-function
+		   (psw "static ")
+		   (fun (rest form)))
+		  (setf
+		   (ps-print (second form))
+		   (psw " = ")
+		   (ps-print (third form)))
+		  (function
+		   (fun (rest form))))))
+	    (decf *indent-level*)
+	    (newline-and-indent)
+	    (psw "}"))