X-Git-Url: http://git.hcoop.net/clinton/parenscript.git/blobdiff_plain/f0e3839b5fc655c4aeddcb6ac4e365c1f5083cc6..5ffb1ebaaff5e8f899fd4b1bd91b015f2c52d656:/src/special-forms.lisp

diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index e07d331..62d3864 100644
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -1,12 +1,12 @@
-(in-package :parenscript)
+(in-package "PARENSCRIPT")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; literals
 (defmacro defpsliteral (name string)
-  `(progn (pushnew ',name *ps-literals*)
-    (define-ps-special-form ,name (expecting)
-      (declare (ignore expecting))
-      (list 'js-literal ,string))))
+  `(progn
+     (add-ps-literal ',name)
+     (define-ps-special-form ,name ()
+       (list 'js:literal ,string))))
 
 (defpsliteral this      "this")
 (defpsliteral t         "true")
@@ -18,140 +18,130 @@
 
 (macrolet ((def-for-literal (name printer)
              `(progn
-                (pushnew ',name *ps-literals*)
-                (define-ps-special-form ,name (expecting &optional label)
-                  (declare (ignore expecting))
+                (add-ps-literal ',name)
+                (define-ps-special-form ,name (&optional label)
                   (list ',printer label)))))
-  (def-for-literal break js-break)
-  (def-for-literal continue js-continue))
+  (def-for-literal break js:break)
+  (def-for-literal continue js:continue))
+
+(defpsmacro quote (x)
+  (typecase x
+    (cons (cons 'array (mapcar (lambda (x) (when x `',x)) x)))
+    (null '(array))
+    (keyword x)
+    (symbol (symbol-to-js-string x))
+    (number x)
+    (string x)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; unary operators
-(mapcar (lambda (op) (eval `(define-ps-special-form ,op (expecting value)
-                             (declare (ignore expecting))
-                             (list 'js-named-operator ',op (compile-parenscript-form value)))))
-        '(throw delete void typeof new))
+(macrolet ((def-unary-ops (&rest ops)
+             `(progn ,@(mapcar (lambda (op)
+                                 (let ((op (if (listp op) (car op) op))
+                                       (spacep (if (listp op) (second op) nil)))
+                                   `(define-ps-special-form ,op (x)
+                                      (list 'js:unary-operator ',op
+                                            (compile-parenscript-form x :expecting :expression)
+                                            :prefix t :space ,spacep))))
+                               ops))))
+  (def-unary-ops ~ ! (new t) (delete t) (void t) (typeof t)))
 
-(define-ps-special-form return (expecting &optional value)
-  (declare (ignore expecting))
-  (list 'js-return (compile-parenscript-form value :expecting :expression)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; statements
+(define-ps-special-form return (&optional value)
+  `(js:return ,(compile-parenscript-form value :expecting :expression)))
+
+(define-ps-special-form throw (value)
+  `(js:throw ,(compile-parenscript-form value :expecting :expression)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; arrays
-(define-ps-special-form array (expecting &rest values)
-  (declare (ignore expecting))
-  (cons 'array-literal (mapcar (lambda (form) (compile-parenscript-form form :expecting :expression))
+(define-ps-special-form array (&rest values)
+  `(js:array ,@(mapcar (lambda (form) (compile-parenscript-form form :expecting :expression))
                                values)))
 
-(define-ps-special-form aref (expecting array &rest coords)
-  (declare (ignore expecting))
-  (list 'js-aref (compile-parenscript-form array :expecting :expression)
-        (mapcar (lambda (form)
-                  (compile-parenscript-form form :expecting :expression))
-                coords)))
-
-(pushnew '{} *ps-literals*)
-(define-ps-special-form {} (expecting &rest arrows)
-  (declare (ignore expecting))
-  (cons 'object-literal (loop for (key value) on arrows by #'cddr
-                              collect (cons key (compile-parenscript-form value :expecting :expression)))))
+(define-ps-special-form aref (array &rest coords)
+  `(js:aref ,(compile-parenscript-form array :expecting :expression)
+            ,(mapcar (lambda (form)
+                       (compile-parenscript-form form :expecting :expression))
+                     coords)))
 
 (defpsmacro list (&rest values)
   `(array ,@values))
 
-(defpsmacro make-array (&rest inits)
-  `(new (*array ,@inits)))
+(defpsmacro make-array (&rest initial-values)
+  `(new (*array ,@initial-values)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; operators
-(define-ps-special-form incf (expecting x &optional (delta 1))
-  (declare (ignore expecting))
-  (if (equal delta 1)
-      (list 'unary-operator "++" (compile-parenscript-form x :expecting :expression) :prefix t)
-      (list 'operator '+= (list (compile-parenscript-form x :expecting :expression)
-                                (compile-parenscript-form delta :expecting :expression)))))
-
-(define-ps-special-form decf (expecting x &optional (delta 1))
-  (declare (ignore expecting))
-  (if (equal delta 1)
-      (list 'unary-operator "--" (compile-parenscript-form x :expecting :expression) :prefix t)
-      (list 'operator '-= (list (compile-parenscript-form x :expecting :expression)
-                                (compile-parenscript-form delta :expecting :expression)))))
-
-(define-ps-special-form - (expecting first &rest rest)
-  (declare (ignore expecting))
-  (if (null rest)
-      (list 'unary-operator "-" (compile-parenscript-form first :expecting :expression) :prefix t)
-      (list 'operator '- (mapcar (lambda (val) (compile-parenscript-form val :expecting :expression))
-                                 (cons first rest)))))
-
-(define-ps-special-form not (expecting x)
-  (declare (ignore expecting))
+(define-ps-special-form incf (x &optional (delta 1))
+  (if (eql delta 1)
+      `(js:unary-operator js:++ ,(compile-parenscript-form x :expecting :expression) :prefix t)
+      `(js:operator js:+= ,(compile-parenscript-form x :expecting :expression)
+                    ,(compile-parenscript-form delta :expecting :expression))))
+
+(define-ps-special-form decf (x &optional (delta 1))
+  (if (eql delta 1)
+      `(js:unary-operator js:-- ,(compile-parenscript-form x :expecting :expression) :prefix t)
+      `(js:operator js:-= ,(compile-parenscript-form x :expecting :expression)
+                    ,(compile-parenscript-form delta :expecting :expression))))
+
+(define-ps-special-form - (first &rest rest)
+  (if rest
+      `(js:operator js:- ,@(mapcar (lambda (val) (compile-parenscript-form val :expecting :expression))
+                                   (cons first rest)))
+      `(js:unary-operator js:- ,(compile-parenscript-form first :expecting :expression) :prefix t)))
+
+(define-ps-special-form not (x)
   (let ((form (compile-parenscript-form x :expecting :expression))
-        (not-op nil))
-    (if (and (eql (first form) 'operator)
-             (= (length (third form)) 2)
-             (setf not-op (case (second form)
-                            (== '!=)
-                            (< '>=)
-                            (> '<=)
-                            (<= '>)
-                            (>= '<)
-                            (!= '==)
-                            (=== '!==)
-                            (!== '===)
-                            (t nil))))
-        (list 'operator not-op (third form))
-        (list 'unary-operator "!" form :prefix t))))
-
-(define-ps-special-form ~ (expecting x)
-  (declare (ignore expecting))
-  (list 'unary-operator "~" (compile-parenscript-form x :expecting :expression) :prefix t))
-
-(defpsmacro 1- (form)
-  `(- ,form 1))
-
-(defpsmacro 1+ (form)
-  `(+ ,form 1))
+        inverse-op)
+    (if (and (eq (car form) 'js:operator)
+             (= (length (cddr form)) 2)
+             (setf inverse-op (case (cadr form)
+                                (== '!=)
+                                (< '>=)
+                                (> '<=)
+                                (<= '>)
+                                (>= '<)
+                                (!= '==)
+                                (=== '!==)
+                                (!== '===))))
+        `(js:operator ,inverse-op ,@(cddr form))
+        `(js:unary-operator js:! ,form :prefix t))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; control structures
 (defun flatten-blocks (body)
   (when body
     (if (and (listp (car body))
-             (eql 'js-block (caar body)))
-        (append (third (car body)) (flatten-blocks (cdr body)))
+             (eq 'js:block (caar body)))
+        (append (cdr (car body)) (flatten-blocks (cdr body)))
         (cons (car body) (flatten-blocks (cdr body))))))
 
 (defun constant-literal-form-p (form)
   (or (numberp form)
       (stringp form)
       (and (listp form)
-           (eql 'js-literal (car form)))))
+           (eq 'js:literal (car form)))))
 
-(define-ps-special-form progn (expecting &rest body)
-  (if (and (eql expecting :expression) (= 1 (length body)))
+(define-ps-special-form progn (&rest body)
+  (if (and (eq expecting :expression) (= 1 (length body)))
       (compile-parenscript-form (car body) :expecting :expression)
-      (list 'js-block
-            expecting
-            (let* ((block (mapcar (lambda (form)
-                                    (compile-parenscript-form form :expecting expecting))
-                                  body))
-                   (clean-block (remove nil block))
-                   (flat-block (flatten-blocks clean-block))
-                   (reachable-block (append (remove-if #'constant-literal-form-p (butlast flat-block))
-                                            (last flat-block))))
-              reachable-block))))
-
-(define-ps-special-form cond (expecting &rest clauses)
+      `(,(if (eq expecting :expression) 'js:|,| 'js:block)
+         ,@(let* ((block (flatten-blocks (remove nil (mapcar (lambda (form)
+                                                               (compile-parenscript-form form :expecting expecting))
+                                                             body)))))
+                 (append (remove-if #'constant-literal-form-p (butlast block)) (last block))))))
+
+(define-ps-special-form cond (&rest clauses)
   (ecase expecting
-    (:statement (list 'js-cond-statement
-                      (mapcar (lambda (clause)
-                                (destructuring-bind (test &rest body)
-                                    clause
-                                  (list (compile-parenscript-form test :expecting :expression)
-                                        (compile-parenscript-form `(progn ,@body) :expecting :statement))))
-                              clauses)))
+    (:statement `(js:if ,(compile-parenscript-form (caar clauses) :expecting :expression)
+                        ,(compile-parenscript-form `(progn ,@(cdar clauses)))
+                        ,@(loop for (test . body) in (cdr clauses) appending
+                               (if (eq t test)
+                                   `(:else ,(compile-parenscript-form `(progn ,@body) :expecting :statement))
+                                   `(:else-if ,(compile-parenscript-form test :expecting :expression)
+                                              ,(compile-parenscript-form `(progn ,@body) :expecting :statement))))))
     (:expression (make-cond-clauses-into-nested-ifs clauses))))
 
 (defun make-cond-clauses-into-nested-ifs (clauses)
@@ -160,37 +150,32 @@
           (car clauses)
         (if (eq t test)
             (compile-parenscript-form `(progn ,@body) :expecting :expression)
-            (list 'js-expression-if (compile-parenscript-form test :expecting :expression)
-                  (compile-parenscript-form `(progn ,@body) :expecting :expression)
-                  (make-cond-clauses-into-nested-ifs (cdr clauses)))))
-      (compile-parenscript-form nil :expecting :expression)))
+            `(js:? ,(compile-parenscript-form test :expecting :expression)
+                   ,(compile-parenscript-form `(progn ,@body) :expecting :expression)
+                   ,(make-cond-clauses-into-nested-ifs (cdr clauses)))))
+      (compile-parenscript-form nil :expecting :expression))) ;; js:null
 
-(define-ps-special-form if (expecting test then &optional else)
+(define-ps-special-form if (test then &optional else)
   (ecase expecting
-    (:statement (list 'js-statement-if (compile-parenscript-form test :expecting :expression)
-                      (compile-parenscript-form `(progn ,then))
-                      (when else (compile-parenscript-form `(progn ,else)))))
-    (:expression (list 'js-expression-if (compile-parenscript-form test :expecting :expression)
-                       (compile-parenscript-form then :expecting :expression)
-                       (compile-parenscript-form else :expecting :expression)))))
-
-(define-ps-special-form switch (expecting test-expr &rest clauses)
-  (declare (ignore expecting))
-  (let ((clauses (mapcar (lambda (clause)
-                             (let ((val (car clause))
-                                   (body (cdr clause)))
-                               (cons (if (eql val 'default)
-                                         'default
-                                         (compile-parenscript-form val :expecting :expression))
-                                     (mapcar (lambda (statement) (compile-parenscript-form statement :expecting :statement))
-                                             body))))
-                         clauses))
-        (expr (compile-parenscript-form test-expr :expecting :expression)))
-    (list 'js-switch expr clauses)))
+    (:statement `(js:if ,(compile-parenscript-form test :expecting :expression)
+                        ,(compile-parenscript-form `(progn ,then))
+                        ,@(when else `(:else ,(compile-parenscript-form `(progn ,else))))))
+    (:expression `(js:? ,(compile-parenscript-form test :expecting :expression)
+                        ,(compile-parenscript-form then :expecting :expression)
+                        ,(compile-parenscript-form else :expecting :expression)))))
+
+(define-ps-special-form switch (test-expr &rest clauses)
+  `(js:switch ,(compile-parenscript-form test-expr :expecting :expression)
+     ,(loop for (val . body) in clauses collect
+           (cons (if (eq val 'default)
+                     'default
+                     (compile-parenscript-form val :expecting :expression))
+                 (mapcar (lambda (x) (compile-parenscript-form x :expecting :statement))
+                         body)))))
 
 (defpsmacro case (value &rest clauses)
   (labels ((make-clause (val body more)
-             (cond ((listp val)
+             (cond ((and (listp val) (not (eq (car val) 'quote)))
                     (append (mapcar #'list (butlast val))
                             (make-clause (first (last val)) body more)))
                    ((member val '(t otherwise))
@@ -213,20 +198,17 @@
 ;;; function definition
 (defun compile-function-definition (args body)
   (list (mapcar (lambda (arg) (compile-parenscript-form arg :expecting :symbol)) args)
-        (let ((*enclosing-lexical-block-declarations* ()))
-          ;; the first compilation will produce a list of variables we need to declare in the function body
-          (compile-parenscript-form `(progn ,@body) :expecting :statement)
-          ;; now declare and compile
-          (compile-parenscript-form `(progn ,@(loop for var in *enclosing-lexical-block-declarations* collect `(var ,var))
-                                      ,@body) :expecting :statement))))
+        (let* ((*enclosing-lexical-block-declarations* ())
+               (body (compile-parenscript-form `(progn ,@body)))
+               (var-decls (compile-parenscript-form
+                           `(progn ,@(mapcar (lambda (var) `(var ,var)) *enclosing-lexical-block-declarations*)))))
+          `(js:block ,@(cdr var-decls) ,@(cdr body)))))
 
-(define-ps-special-form %js-lambda (expecting args &rest body)
-  (declare (ignore expecting))
-  (cons 'js-lambda (compile-function-definition args body)))
+(define-ps-special-form %js-lambda (args &rest body)
+  `(js:lambda ,@(compile-function-definition args body)))
 
-(define-ps-special-form %js-defun (expecting name args &rest body)
-  (declare (ignore expecting))
-  (append (list 'js-defun name) (compile-function-definition args body)))
+(define-ps-special-form %js-defun (name args &rest body)
+  `(js:defun ,name ,@(compile-function-definition args body)))
 
 (defun parse-function-body (body)
   (let* ((docstring
@@ -236,7 +218,7 @@
     (values body-forms docstring)))
 
 (defun parse-key-spec (key-spec)
-  "parses an &key parameter.  Returns 4 values:
+  "parses an &key parameter.  Returns 5 values:
 var, init-form,  keyword-name, supplied-p-var, init-form-supplied-p.
 
 Syntax of key spec:
@@ -244,7 +226,7 @@ Syntax of key spec:
 "
   (let* ((var (cond ((symbolp key-spec) key-spec)
                     ((and (listp key-spec) (symbolp (first key-spec))) (first key-spec))
-                    ((and (listp key-spec) (listp (first key-spec)))   (second key-spec))))
+                    ((and (listp key-spec) (listp (first key-spec)))   (second (first key-spec)))))
          (keyword-name (if (and (listp key-spec) (listp (first key-spec)))
                            (first (first key-spec))
                            (intern (string var) :keyword)))
@@ -269,8 +251,8 @@ Syntax of key spec:
           (when (listp spec) (second spec))))
 
 (defpsmacro defaultf (place value)
-  `(setf ,place (or (and (=== undefined ,place) ,value)
-                 ,place)))
+  `(when (=== ,place undefined)
+     (setf ,place ,value)))
 
 (defun parse-extended-function (lambda-list body &optional name)
   "Returns two values: the effective arguments and body for a function with
@@ -282,63 +264,58 @@ the given lambda-list and body."
   ;; * optional variables' variable names are mapped directly into the lambda list,
   ;;   and for each optional variable with name v and default value d, a form is produced
   ;;   (defaultf v d)
-  ;; * when any keyword variables are in the lambda list, a single 'optional-args' variable is
-  ;;   appended to the js-lambda list as the last argument.  WITH-SLOTS is used for all
-  ;;   the variables with  inside the body of the function,
-  ;;   a (with-slots ((var-name key-name)) optional-args ...)
+  ;; * keyword variables are not included in the js-lambda list, but instead are
+  ;;   obtained from the magic js ARGUMENTS pseudo-array. Code assigning values to
+  ;;   keyword vars is prepended to the body of the function.
   (declare (ignore name))
   (multiple-value-bind (requireds optionals rest? rest keys? keys allow? aux? aux
                                   more? more-context more-count key-object)
       (parse-lambda-list lambda-list)
-    (declare (ignore allow? aux? aux more? more-context more-count))
-    (let* ((options-var (or key-object (ps-gensym)))
-           ;; optionals are of form (var default-value)
+    (declare (ignore allow? aux? aux more? more-context more-count key-object))
+    (let* (;; optionals are of form (var default-value)
            (effective-args
             (remove-if
              #'null
              (append requireds
-                     (mapcar #'parse-optional-spec optionals)
-                     (when keys (list options-var)))))
-           ;; an alist of arg -> default val
-           (initform-pairs
-            (remove
-             nil
-             (append
-              ;; optional arguments first
-              (mapcar #'(lambda (opt-spec)
-                          (multiple-value-bind (var val) (parse-optional-spec opt-spec)
-                            (cons var val)))
-                      optionals)
-              (if keys? (list (cons options-var '(create))))
-              (mapcar #'(lambda (key-spec)
-                          (multiple-value-bind (var val x y specified?) (parse-key-spec key-spec)
-                            (declare (ignore x y))
-                            (when specified? (cons var val))))
-                      keys))))
-           (body-paren-forms (parse-function-body body)) ; remove documentation
-           (initform-forms
-            (mapcar #'(lambda (default-pair)
-                        `(defaultf ,(car default-pair) ,(cdr default-pair)))
-                    initform-pairs))
+                     (mapcar #'parse-optional-spec optionals))))
+           (opt-forms
+            (mapcar #'(lambda (opt-spec)
+                        (multiple-value-bind (var val) (parse-optional-spec opt-spec)
+                          `(defaultf ,var ,val)))
+                    optionals))
+           (key-forms
+            (when keys?
+              (if (< *js-target-version* 1.6)
+                  (with-ps-gensyms (n)
+                    (let ((decls nil) (assigns nil) (defaults nil))
+                      (mapc (lambda (k)
+                              (multiple-value-bind (var init-form keyword-str)
+                                  (parse-key-spec k)
+                                (push `(var ,var) decls)
+                                (push `(,keyword-str (setf ,var (aref arguments (1+ ,n)))) assigns)
+                                (push (list 'defaultf var init-form) defaults)))
+                            (reverse keys))
+                      `(,@decls
+                        (loop :for ,n :from ,(length requireds)
+                           :below (length arguments) :by 2 :do
+                           (case (aref arguments ,n) ,@assigns))
+                        ,@defaults)))
+                  (mapcar (lambda (k)
+                            (multiple-value-bind (var init-form keyword-str)
+                                (parse-key-spec k)
+                              (with-ps-gensyms (x)
+                                `(let ((,x ((@ *Array prototype index-of call) arguments ,keyword-str ,(length requireds))))
+                                   (var ,var (if (= -1 ,x) ,init-form (aref arguments (1+ ,x))))))))
+                          keys))))
            (rest-form
             (if rest?
                 (with-ps-gensyms (i)
                   `(progn (var ,rest (array))
-                    (dotimes (,i (- arguments.length ,(length effective-args)))
+                    (dotimes (,i (- (slot-value arguments 'length) ,(length effective-args)))
                       (setf (aref ,rest ,i) (aref arguments (+ ,i ,(length effective-args)))))))
                 `(progn)))
-           (effective-body   (append initform-forms (list rest-form) body-paren-forms))
-           (effective-body
-            (if keys?
-                (list `(with-slots ,(mapcar #'(lambda (key-spec)
-                                                (multiple-value-bind (var x key-name)
-                                                    (parse-key-spec key-spec)
-                                                  (declare (ignore x))
-                                                  (list var key-name)))
-                                            keys)
-                        ,options-var
-                        ,@effective-body))
-                effective-body)))
+           (body-paren-forms (parse-function-body body)) ; remove documentation
+           (effective-body (append opt-forms key-forms (list rest-form) body-paren-forms)))
       (values effective-args effective-body))))
 
 (defpsmacro defun (name lambda-list &body body)
@@ -351,7 +328,7 @@ lambda-list::=
   [&aux {var | (var [init-form])}*])"
   (if (symbolp name)
       `(defun-function ,name ,lambda-list ,@body)
-      (progn (assert (and (= (length name) 2) (eql 'setf (car name))) ()
+      (progn (assert (and (listp name) (= (length name) 2) (eq 'setf (car name))) ()
                      "(defun ~s ~s ...) needs to have a symbol or (setf symbol) for a name." name lambda-list)
              `(defun-setf ,name ,lambda-list ,@body))))
 
@@ -384,8 +361,18 @@ lambda-list::=
     `(%js-lambda ,effective-args
       ,@effective-body)))
 
+(defpsmacro flet (fn-defs &rest body)
+  (flet ((process-fn-def (def)
+           `(var ,(car def) (lambda ,@(cdr def)))))
+    `(progn ,@(mapcar #'process-fn-def fn-defs) ,@body)))
+
+(defpsmacro labels (fn-defs &rest body)
+  (flet ((process-fn-def (def)
+           `(var ,(car def) (defun ,(car def) ,@(cdr def)))))
+    `(progn ,@(mapcar #'process-fn-def fn-defs) ,@body)))
+
 (defpsmacro defsetf-long (access-fn lambda-list (store-var) form)
-  (setf (get-macro-spec access-fn *script-setf-expanders*)
+  (setf (get-macro-spec access-fn *ps-setf-expanders*)
         (compile nil
                  (let ((var-bindings (ordered-set-difference lambda-list lambda-list-keywords)))
                    `(lambda (access-fn-args store-form)
@@ -403,7 +390,7 @@ lambda-list::=
 
 (defpsmacro defsetf-short (access-fn update-fn &optional docstring)
   (declare (ignore docstring))
-  (setf (get-macro-spec access-fn *script-setf-expanders*)
+  (setf (get-macro-spec access-fn *ps-setf-expanders*)
         (lambda (access-fn-args store-form)
           `(,update-fn ,@access-fn-args ,store-form)))
   nil)
@@ -411,68 +398,70 @@ lambda-list::=
 (defpsmacro defsetf (access-fn &rest args)
   `(,(if (= (length args) 3) 'defsetf-long 'defsetf-short) ,access-fn ,@args))
 
+(defpsmacro funcall (&rest arg-form)
+  arg-form)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; macros
 (defmacro with-temp-macro-environment ((var) &body body)
   `(let* ((,var (make-macro-env-dictionary))
-          (*script-macro-env* (cons ,var *script-macro-env*)))
+          (*ps-macro-env* (cons ,var *ps-macro-env*)))
     ,@body))
 
-(define-ps-special-form macrolet (expecting macros &body body)
-  (declare (ignore expecting))
+(define-ps-special-form macrolet (macros &body body)
   (with-temp-macro-environment (macro-env-dict)
     (dolist (macro macros)
       (destructuring-bind (name arglist &body body)
           macro
         (setf (get-macro-spec name macro-env-dict)
-              (cons nil (make-ps-macro-function arglist body)))))
+              (cons nil (eval (make-ps-macro-function arglist body))))))
     (compile-parenscript-form `(progn ,@body))))
 
-(define-ps-special-form symbol-macrolet (expecting symbol-macros &body body)
-  (declare (ignore expecting))
+(define-ps-special-form symbol-macrolet (symbol-macros &body body)
   (with-temp-macro-environment (macro-env-dict)
     (dolist (macro symbol-macros)
       (destructuring-bind (name expansion)
           macro
         (setf (get-macro-spec name macro-env-dict)
-              (cons t (make-ps-macro-function () (list `',expansion))))))
+              (cons t (lambda (x) (declare (ignore x)) expansion)))))
     (compile-parenscript-form `(progn ,@body))))
 
-(define-ps-special-form defmacro (expecting name args &body body)
-  (declare (ignore expecting))
-  (define-script-macro% name args body :symbol-macro-p nil)
+(define-ps-special-form defmacro (name args &body body) ;; should this be a macro?
+  (eval `(defpsmacro ,name ,args ,@body))
   nil)
 
-(define-ps-special-form define-symbol-macro (expecting name expansion)
-  (declare (ignore expecting))
-  (define-script-macro% name () (list `',expansion) :symbol-macro-p t)
+(define-ps-special-form define-symbol-macro (name expansion) ;; should this be a macro?
+  (eval `(define-ps-symbol-macro ,name ,expansion))
   nil)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; objects
-(define-ps-special-form create (expecting &rest args)
-  (declare (ignore expecting))
-  (list 'js-object (loop for (name val) on args by #'cddr collecting
-                         (let ((name-expr (compile-parenscript-form name :expecting :expression)))
-                           (assert (or (stringp name-expr)
-                                       (numberp name-expr)
-                                       (and (listp name-expr)
-                                            (or (eql 'js-variable (car name-expr))
-                                                (eql 'script-quote (car name-expr)))))
-                                   ()
-                                   "Slot ~s is not one of js-variable, keyword, string or number." name-expr)
-                           (list name-expr (compile-parenscript-form val :expecting :expression))))))
-
-(define-ps-special-form %js-slot-value (expecting obj slot)
-  (declare (ignore expecting))
-  (if (ps::ps-macroexpand slot)
-      (list 'js-slot-value (compile-parenscript-form obj :expecting :expression) (compile-parenscript-form slot))
-      (compile-parenscript-form obj :expecting :expression)))
-
-(define-ps-special-form instanceof (expecting value type)
-  (declare (ignore expecting))
-  (list 'js-instanceof (compile-parenscript-form value :expecting :expression)
-        (compile-parenscript-form type :expecting :expression)))
+(add-ps-literal '{})
+(define-ps-symbol-macro {} (create))
+
+(define-ps-special-form create (&rest arrows)
+  `(js:object ,@(loop for (key-expr val-expr) on arrows by #'cddr collecting
+                     (let ((key (compile-parenscript-form key-expr :expecting :expression)))
+                       (when (keywordp key)
+                         (setf key `(js:variable ,key)))
+                       (assert (or (stringp key)
+                                   (numberp key)
+                                   (and (listp key)
+                                        (or (eq 'js:variable (car key))
+                                            (eq 'quote (car key)))))
+                               ()
+                               "Slot key ~s is not one of js-variable, keyword, string or number." key)
+                       (cons key (compile-parenscript-form val-expr :expecting :expression))))))
+
+(define-ps-special-form %js-slot-value (obj slot)
+  `(js:slot-value ,(compile-parenscript-form obj :expecting :expression)
+                  ,(if (and (listp slot) (eq 'quote (car slot)))
+                       (second slot) ;; assume we're quoting a symbol
+                       (compile-parenscript-form slot))))
+
+(define-ps-special-form instanceof (value type)
+  `(js:instanceof ,(compile-parenscript-form value :expecting :expression)
+                  ,(compile-parenscript-form type :expecting :expression)))
 
 (defpsmacro slot-value (obj &rest slots)
   (if (null (rest slots))
@@ -505,41 +494,34 @@ lambda-list::=
     (/   '/=)
     (t   nil)))
 
-(defun smart-setf (lhs rhs)
-  (if (and (listp rhs)
-           (eql 'operator (car rhs))
-           (member lhs (third rhs) :test #'equalp))
-      (let ((args-without-first (remove lhs (third rhs) :count 1 :end 1 :test #'equalp)))
-        (cond ((and (assignment-op (second rhs))
-                    (member (second rhs) '(+ *))
-                    (equalp lhs (first (third rhs))))
-               (list 'operator (assignment-op (second rhs))
-                     (list lhs (list 'operator (second rhs) args-without-first))))
-              (t (list 'js-assign lhs rhs))))
-      (list 'js-assign lhs rhs)))
-
-(define-ps-special-form setf1% (expecting lhs rhs)
-  (declare (ignore expecting))
-  (smart-setf (compile-parenscript-form lhs :expecting :expression) (compile-parenscript-form rhs :expecting :expression)))
+(define-ps-special-form setf1% (lhs rhs)
+  (let ((lhs (compile-parenscript-form lhs :expecting :expression))
+        (rhs (compile-parenscript-form rhs :expecting :expression)))
+    (if (and (listp rhs)
+             (eq 'js:operator (car rhs))
+             (member (cadr rhs) '(+ *))
+             (equalp lhs (caddr rhs)))
+        `(js:operator ,(assignment-op (cadr rhs)) ,lhs (js:operator ,(cadr rhs) ,@(cdddr rhs)))
+        `(js:= ,lhs ,rhs))))
 
 (defpsmacro setf (&rest args)
   (flet ((process-setf-clause (place value-form)
-           (if (and (listp place) (get-macro-spec (car place) *script-setf-expanders*))
-               (funcall (get-macro-spec (car place) *script-setf-expanders*) (cdr place) value-form)
+           (if (and (listp place) (get-macro-spec (car place) *ps-setf-expanders*))
+               (funcall (get-macro-spec (car place) *ps-setf-expanders*) (cdr place) value-form)
                (let ((exp-place (ps-macroexpand place)))
-                 (if (and (listp exp-place) (get-macro-spec (car exp-place) *script-setf-expanders*))
-                     (funcall (get-macro-spec (car exp-place) *script-setf-expanders*) (cdr exp-place) value-form)
+                 (if (and (listp exp-place) (get-macro-spec (car exp-place) *ps-setf-expanders*))
+                     (funcall (get-macro-spec (car exp-place) *ps-setf-expanders*) (cdr exp-place) value-form)
                      `(setf1% ,exp-place ,value-form))))))
     (assert (evenp (length args)) ()
             "~s does not have an even number of arguments." (cons 'setf args))
     `(progn ,@(loop for (place value) on args by #'cddr collect (process-setf-clause place value)))))
 
 (defpsmacro psetf (&rest args)
-  (let ((vars (loop for x in args by #'cddr collect x))
+  (let ((places (loop for x in args by #'cddr collect x))
         (vals (loop for x in (cdr args) by #'cddr collect x)))
-    (let ((gensyms (mapcar (lambda (x) (declare (ignore x)) (ps-gensym)) vars)))
-      `(simple-let* ,(mapcar #'list gensyms vals)
-         (setf ,@(mapcan #'list vars gensyms))))))
+    (let ((gensyms (mapcar (lambda (x) (declare (ignore x)) (ps-gensym)) places)))
+      `(let ,(mapcar #'list gensyms vals)
+         (setf ,@(mapcan #'list places gensyms))))))
 
 (defun check-setq-args (args)
   (let ((vars (loop for x in args by #'cddr collect x)))
@@ -555,92 +537,69 @@ lambda-list::=
   (check-setq-args args)
   `(psetf ,@args))
 
-(define-ps-special-form var (expecting name &rest value)
-  (declare (ignore expecting))
-  (append (list 'js-var name)
-          (when value
-            (assert (= (length value) 1) () "Wrong number of arguments to var: ~s" `(var ,name ,@value))
-            (list (compile-parenscript-form (car value) :expecting :expression)))))
+(define-ps-special-form var (name &optional (value (values) value-provided?) documentation)
+  (declare (ignore documentation))
+  (ecase expecting
+    (:statement
+     `(js:var ,name ,@(when value-provided?
+                            (list (compile-parenscript-form value :expecting :expression)))))
+    (:expression
+     (push name *enclosing-lexical-block-declarations*)
+     (when value-provided?
+       (compile-parenscript-form `(setf ,name ,value) :expecting :expression)))))
 
-(defpsmacro defvar (name &rest value)
-  "Note: this must be used as a top-level form, otherwise the result will be undefined behavior."
+(defpsmacro defvar (name &optional (value (values) value-provided?) documentation)
+  ;; this must be used as a top-level form, otherwise the resulting behavior will be undefined.
+  (declare (ignore documentation))
   (pushnew name *ps-special-variables*)
-  (assert (or (null value) (= (length value) 1)) () "Wrong number of arguments to defvar: ~s" `(defvar ,name ,@value))
-  `(var ,name ,@value))
-
-(defun make-let-vars (bindings)
-  (mapcar (lambda (x) (if (listp x) (car x) x)) bindings))
+  `(var ,name ,@(when value-provided? (list value))))
 
-(defun make-let-vals (bindings)
-  (mapcar (lambda (x) (if (or (atom x) (endp (cdr x))) nil (second x))) bindings))
-
-(defpsmacro lexical-let* (bindings &body body)
-  `((lambda ()
-      (let* ,bindings
-        ,@body))))
-
-(defpsmacro lexical-let (bindings &body body)
-  `((lambda ,(make-let-vars bindings)
-      ,@body)
-    ,@(make-let-vals bindings)))
+(defpsmacro let (bindings &body body)
+  (flet ((add-renamed-vars (bindings predicate)
+           (mapcar (lambda (x) (append x (list (ps-gensym (car x)))))
+                   (remove-if predicate bindings :key #'car)))
+         (var (x) (first x))
+         (val (x) (second x))
+         (renamed (x) (third x)))
+    (let* ((normalized-bindings (mapcar (lambda (x) (if (symbolp x) `(,x nil) x)) bindings))
+           (lexical-bindings (add-renamed-vars normalized-bindings #'ps-special-variable-p))
+           (dynamic-bindings (add-renamed-vars normalized-bindings (complement #'ps-special-variable-p)))
+           (renamed-body `(symbol-macrolet ,(mapcar (lambda (x) (list (var x) (renamed x)))
+                                                    lexical-bindings)
+                            ,@body)))
+    `(progn
+       ,@(mapcar (lambda (x) `(var ,(renamed x) ,(val x))) lexical-bindings)
+       ,(if dynamic-bindings
+            `(progn ,@(mapcar (lambda (x) `(var ,(renamed x))) dynamic-bindings)
+                    (try (progn (setf ,@(loop for x in dynamic-bindings append
+                                             `(,(renamed x) ,(var x)
+                                               ,(var x) ,(val x))))
+                                ,renamed-body)
+                         (:finally
+                          (setf ,@(mapcan (lambda (x) `(,(var x) ,(renamed x))) dynamic-bindings)))))
+            renamed-body)))))
 
-(defpsmacro simple-let* (bindings &body body)
+(defpsmacro let* (bindings &body body)
   (if bindings
-      (let ((var (if (listp (car bindings)) (caar bindings) (car bindings))))
-        `(,(if (member var *ps-special-variables*) 'let1-dynamic 'let1) ,(car bindings)
-           (simple-let* ,(cdr bindings) ,@body)))
+      `(let (,(car bindings))
+         (let* ,(cdr bindings)
+           ,@body))
       `(progn ,@body)))
 
-(defpsmacro simple-let (bindings &body body)
-  (let ((vars (mapcar (lambda (x) (if (atom x) x (first x))) bindings))
-        (vals (mapcar (lambda (x) (if (or (atom x) (endp (cdr x))) nil (second x))) bindings)))
-    (let ((gensyms (mapcar (lambda (x) (ps-gensym (format nil "_js_~a" x))) vars)))
-      `(simple-let* ,(mapcar #'list gensyms vals)
-         (simple-let* ,(mapcar #'list vars gensyms)
-           ,@(mapcar (lambda (x) `(delete ,x)) gensyms)
-           ,@body)))))
-
-(defpsmacro let* (bindings &body body)
-  `(simple-let* ,bindings ,@body))
-
-(defpsmacro let (bindings &body body)
-  `(simple-let ,bindings ,@body))
-
-(define-ps-special-form let1 (expecting binding &rest body)
-  (ecase expecting
-    (:statement
-     (compile-parenscript-form `(progn ,(if (atom binding) `(var ,binding) `(var ,@binding)) ,@body) :expecting :statement))
-    (:expression
-     (let ((var (if (atom binding) binding (car binding)))
-           (variable-assignment (when (listp binding) (cons 'setf binding))))
-       (push var *enclosing-lexical-block-declarations*)
-       (compile-parenscript-form `(progn ,variable-assignment ,@body) :expecting :expression)))))
-
-(defpsmacro let1-dynamic ((var value) &rest body)
-  (with-ps-gensyms (temp-stack-var)
-    `(progn (var ,temp-stack-var)
-      (try (progn (setf ,temp-stack-var ,var)
-                  (setf ,var ,value)
-                  ,@body)
-       (:finally
-        (setf ,var ,temp-stack-var)
-        (delete ,temp-stack-var))))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; iteration
 (defun make-for-vars/inits (init-forms)
   (mapcar (lambda (x)
             (cons (compile-parenscript-form (if (atom x) x (first x)) :expecting :symbol)
-                  (compile-parenscript-form (if (atom x) nil (second x)))))
+                  (compile-parenscript-form (if (atom x) nil (second x)) :expecting :expression)))
           init-forms))
 
-(define-ps-special-form labeled-for (expecting label init-forms cond-forms step-forms &rest body)
-  (declare (ignore expecting))
-  (let ((vars (make-for-vars/inits init-forms))
-        (steps (mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) step-forms))
-        (tests (mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) cond-forms))
-        (body (compile-parenscript-form `(progn ,@body))))
-    (list 'js-for label vars tests steps body)))
+(define-ps-special-form labeled-for (label init-forms cond-forms step-forms &rest body)
+  `(js:for ,label
+           ,(make-for-vars/inits init-forms)
+           ,(mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) cond-forms)
+           ,(mapcar (lambda (x) (compile-parenscript-form x :expecting :expression)) step-forms)
+           ,(compile-parenscript-form `(progn ,@body))))
 
 (defpsmacro for (init-forms cond-forms step-forms &body body)
   `(labeled-for nil ,init-forms ,cond-forms ,step-forms ,@body))
@@ -698,45 +657,14 @@ lambda-list::=
               ,@body
               ,(do-make-iter-psteps decls)))))
 
-(define-ps-special-form for-in (expecting decl &rest body)
-  (declare (ignore expecting))
-  (list 'js-for-in
-        (compile-parenscript-form (first decl) :expecting :expression)
-        (compile-parenscript-form (second decl) :expecting :expression)
-        (compile-parenscript-form `(progn ,@body))))
-
-(defpsmacro doeach ((var array &optional (result (values) result?)) &body body)
-  "Iterates over `array'.  If `var' is a symbol, binds `var' to each
-element key.  If `var' is a list, it must be a list of two
-symbols, (key value), which will be bound to each successive key/value
-pair in `array'."
-  (if result?
-      (if (consp var)
-          (destructuring-bind (key val) var
-            `((lambda ()
-                (let* (,val)
-                  (for-in ((var ,key) ,array)
-                    (setf ,val (aref ,array ,key))
-                    ,@body)
-                  (return ,result)))))
-          `((lambda ()
-              (for-in ((var ,var) ,array)
-                ,@body)
-              (return ,result))))
-      (if (consp var)
-          (destructuring-bind (key val) var
-            `(progn
-               (let* (,val)
-                 (for-in ((var ,key) ,array)
-                   (setf ,val (aref ,array ,key))
-                   ,@body))))
-          `(progn
-             (for-in ((var ,var) ,array) ,@body)))))
-
-(define-ps-special-form while (expecting test &rest body)
-  (declare (ignore expecting))
-  (list 'js-while (compile-parenscript-form test :expecting :expression)
-                  (compile-parenscript-form `(progn ,@body))))
+(define-ps-special-form for-in ((var object) &rest body)
+  `(js:for-in ,(compile-parenscript-form var :expecting :expression)
+              ,(compile-parenscript-form object :expecting :expression)
+              ,(compile-parenscript-form `(progn ,@body))))
+
+(define-ps-special-form while (test &rest body)
+  `(js:while ,(compile-parenscript-form test :expecting :expression)
+     ,(compile-parenscript-form `(progn ,@body))))
 
 (defpsmacro dotimes ((var count &optional (result nil result?)) &rest body)
   `(do* ((,var 0 (1+ ,var)))
@@ -756,34 +684,44 @@ pair in `array'."
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; misc
-(define-ps-special-form with (expecting expression &rest body)
-  (declare (ignore expecting))
-  (list 'js-with (compile-parenscript-form expression :expecting :expression)
-                 (compile-parenscript-form `(progn ,@body))))
+(define-ps-special-form with (expression &rest body)
+  `(js:with ,(compile-parenscript-form expression :expecting :expression)
+     ,(compile-parenscript-form `(progn ,@body))))
 
-(define-ps-special-form try (expecting form &rest clauses)
-  (declare (ignore expecting))
+(define-ps-special-form try (form &rest clauses)
   (let ((catch (cdr (assoc :catch clauses)))
         (finally (cdr (assoc :finally clauses))))
     (assert (not (cdar catch)) nil "Sorry, currently only simple catch forms are supported.")
     (assert (or catch finally) ()
             "Try form should have either a catch or a finally clause or both.")
-    (list 'js-try (compile-parenscript-form `(progn ,form))
-          :catch (when catch (list (compile-parenscript-form (caar catch) :expecting :symbol)
+    `(js:try ,(compile-parenscript-form `(progn ,form))
+          :catch ,(when catch (list (compile-parenscript-form (caar catch) :expecting :symbol)
                                    (compile-parenscript-form `(progn ,@(cdr catch)))))
-          :finally (when finally (compile-parenscript-form `(progn ,@finally))))))
-
-(define-ps-special-form cc-if (expecting test &rest body)
-  (declare (ignore expecting))
-  (list 'cc-if test (mapcar #'compile-parenscript-form body)))
-
-(define-ps-special-form regex (expecting regex)
-  (declare (ignore expecting))
-  (list 'js-regex (string regex)))
-
-(defpsmacro lisp (&body forms)
-  "Evaluates the given forms in Common Lisp at ParenScript
-macro-expansion time. The value of the last form is treated as a
-ParenScript expression and is inserted into the generated Javascript
-\(use nil for no-op)."
-  (eval (cons 'progn forms)))
+          :finally ,(when finally (compile-parenscript-form `(progn ,@finally))))))
+
+(define-ps-special-form cc-if (test &rest body)
+  `(js:cc-if ,test ,@(mapcar #'compile-parenscript-form body)))
+
+(define-ps-special-form regex (regex)
+  `(js:regex ,(string regex)))
+
+(define-ps-special-form lisp (lisp-form)
+  ;; (ps (foo (lisp bar))) is in effect equivalent to (ps* `(foo ,bar))
+  ;; when called from inside of ps*, lisp-form has access only to the dynamic environment (like for eval)
+  `(js:escape (ps1* ,lisp-form)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; eval-when
+(define-ps-special-form eval-when (situation-list &body body)
+  "(eval-when (situation*) body-form*)
+
+The body forms are evaluated only during the given SITUATION. The accepted SITUATIONS are
+:load-toplevel, :compile-toplevel, and :execute.  The code in BODY-FORM is assumed to be
+COMMON-LISP code in :compile-toplevel and :load-toplevel sitations, and parenscript code in
+:execute.  "
+  (when (and (member :compile-toplevel situation-list)
+	     (member *toplevel-compilation-level* '(:toplevel :inside-toplevel-form)))
+    (eval `(progn ,@body)))
+  (if (member :execute situation-list)
+      (compile-parenscript-form `(progn ,@body) :expecting expecting)
+      (compile-parenscript-form `(progn) :expecting expecting)))
\ No newline at end of file