Reimplement (.method object . args) syntax

[clinton/parenscript.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 4f590c0..8a98dda 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -68,6 +68,11 @@ lexical block.")
        (not (ps-special-form-p form))
        (not (null (op-precedence (first form))))))
 
+(defun method-call-form-p (form)
+  (and (listp form)
+       (symbolp (car form))
+       (char= #\. (char (symbol-name (car form)) 0))))
+
 (defun funcall-form-p (form)
   (and form
        (listp form)
@@ -150,7 +155,7 @@ CL environment)."
           (defpsmacro ,name ,args ,@body)))
 
 (defun ps-macroexpand (form)
-  (aif (or (lookup-macro-def form *ps-symbol-macro-env*)
+  (aif (or (and (symbolp form) (lookup-macro-def form *ps-symbol-macro-env*))
            (and (consp form) (lookup-macro-def (car form) *ps-macro-env*)))
        (values (ps-macroexpand (funcall it form)) t)
        form))
@@ -195,39 +200,42 @@ the form cannot be compiled to a symbol."
   (ps-compile (string form)))
 
 (defmethod ps-compile ((symbol symbol))
-  (when (eq *ps-compilation-level* :toplevel)
-    (multiple-value-bind (expansion expanded-p)
-        (ps-macroexpand symbol)
-      (when expanded-p 
-        (return-from ps-compile (ps-compile expansion)))))
-  (cond ((keywordp symbol) symbol)
-        ((ps-special-form-p (list symbol))
-         (if (ps-reserved-symbol-p symbol)
-             (funcall (get-ps-special-form symbol))
-             (error "Attempting to use Parenscript special form ~a as variable" symbol)))
-        (t `(js:variable ,symbol))))
+  (multiple-value-bind (expansion expanded?)
+      (ps-macroexpand symbol)
+    (if expanded?
+        (ps-compile expansion)
+        (cond ((keywordp symbol) symbol)
+              ((ps-special-form-p (list symbol))
+               (if (ps-reserved-symbol-p symbol)
+                   (funcall (get-ps-special-form symbol))
+                   (error "Attempting to use Parenscript special form ~a as variable" symbol)))
+              (t `(js:variable ,symbol))))))
 
 ;;; operators
 
-(defun op-precedence (op)
-  (position op
-            '((js:new js:slot-value js:aref)
-              (postfix++ postfix--)
-              (delete void typeof ++ -- unary+ unary- ~ !)
-              (* / %)
-              (+ -)
-              (<< >> >>>)
-              (< > <= >= js:instanceof js:in)
-              (== != === !==)
-              (&)
-              (^)
-              (\|)
-              (\&\& and)
-              (\|\| or)
-              (js:?)
-              (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|=)
-              (comma))
-            :test #'member))
+(let ((precedence-table (make-hash-table :test 'eq)))
+  (loop for level in '((js:new js:slot-value js:aref)
+                       (postfix++ postfix--)
+                       (delete void typeof ++ -- unary+ unary- ~ !)
+                       (* / %)
+                       (+ -)
+                       (<< >> >>>)
+                       (< > <= >= js:instanceof js:in)
+                       (== != === !==)
+                       (&)
+                       (^)
+                       (\|)
+                       (\&\& and)
+                       (\|\| or)
+                       (js:?)
+                       (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|=)
+                       (comma))
+     for i from 0
+     do (mapcar (lambda (symbol)
+                  (setf (gethash symbol precedence-table) i))
+                level))
+  (defun op-precedence (op)
+    (gethash op precedence-table)))
 
 (defun ps-convert-op-name (op)
   (case op
@@ -261,11 +269,17 @@ the form cannot be compiled to a symbol."
                             (ps-compile-expression (ps-macroexpand form)))
                           (cdr form))))
 
+(defun compile-method-call-form (form)
+  (compile-funcall-form
+   `((js:slot-value ,(second form)
+                    ',(make-symbol (subseq (symbol-name (first form)) 1)))
+     ,@(cddr form))))
+
 (defun compile-funcall-form (form)
   `(js:funcall
-    ,(ps-compile-expression (if (symbolp (car form))
-                                (maybe-rename-local-function (car form))
-                                (ps-macroexpand (car form))))
+    ,(if (symbolp (car form))
+         `(js:variable ,(maybe-rename-local-function (car form)))
+         (ps-compile-expression (ps-macroexpand (car form))))
     ,@(mapcar #'ps-compile-expression (cdr form))))
 
 (defvar compile-expression?)
@@ -289,9 +303,11 @@ the form cannot be compiled to a symbol."
                    (compile-op-form form))))
             ((op-form-p form)
              (compile-op-form form))
+            ((method-call-form-p form)
+            (compile-method-call-form form))
             ((funcall-form-p form)
              (compile-funcall-form form))
-            (t (error "Cannot compile ~S to a ParenScript form." form))))))
+           (t (error "Cannot compile ~S to a ParenScript form." form))))))
 
 (defun ps-compile-statement (form)
   (let ((compile-expression? nil))