(loop for idx in indices do
(psw #\[) (ps-print idx) (psw #\])))
+(defvar *lexical-bindings* nil)
+
+(defun rename-js-variable (name)
+ (or (cdr (assoc name *lexical-bindings*))
+ name))
+
+(defprinter js:let (variables expression)
+ (let ((*lexical-bindings*
+ (append (mapcar (lambda (var)
+ (cons var (if (assoc var *lexical-bindings*)
+ (ps-gensym var)
+ var)))
+ variables))))
+ (ps-print expression)))
+
(defprinter js:variable (var)
- (psw (symbol-to-js-string var)))
+ (psw (symbol-to-js-string (rename-js-variable var))))
;;; arithmetic operators
(defun parenthesize-print (ps-form)
(defprinter js:var (var-name &rest var-value)
(psw "var ")
- (psw (symbol-to-js-string var-name))
+ (ps-print var-name)
(when var-value
(psw " = ")
(ps-print (car var-value))))
(progn (push name *enclosing-lexical-block-declarations*)
(when value-provided?
(ps-compile-expression `(setf ,name ,value))))
- `(js:var ,name ,@(when value-provided?
- (list (ps-compile-expression (ps-macroexpand value))))))))
+ `(js:var (js:variable ,name) ,@(when value-provided?
+ (list (ps-compile-expression (ps-macroexpand value))))))))
(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.
`(var ,name ,@(when value-provided? (list value))))
(define-ps-special-form let (bindings &body body)
- (let* (lexical-bindings-introduced-here
- (normalized-bindings (mapcar (lambda (x)
- (if (symbolp x)
- (list x nil)
- (list (car x) (ps-macroexpand (cadr x)))))
- bindings))
- (free-variables-in-binding-value-expressions (mapcan (lambda (x) (flatten (cadr x)))
- normalized-bindings)))
- (flet ((maybe-rename-lexical-var (x)
- (if (or (member x *vars-bound-in-enclosing-lexical-scopes*)
- (member x free-variables-in-binding-value-expressions))
- (ps-gensym x)
- (progn (push x lexical-bindings-introduced-here) nil)))
- (rename (x) (first x))
- (var (x) (second x))
- (val (x) (third x)))
- (let* ((lexical-bindings (loop for x in normalized-bindings
- unless (ps-special-variable-p (car x))
- collect (cons (maybe-rename-lexical-var (car x)) x)))
- (dynamic-bindings (loop for x in normalized-bindings
- when (ps-special-variable-p (car x))
- collect (cons (ps-gensym (format nil "~A_~A" (car x) 'tmp-stack)) x)))
- (renamed-body `(symbol-macrolet ,(loop for x in lexical-bindings
- when (rename x) collect
- `(,(var x) ,(rename x)))
- ,@body))
- (*vars-bound-in-enclosing-lexical-scopes* (append lexical-bindings-introduced-here
- *vars-bound-in-enclosing-lexical-scopes*)))
- (ps-compile
- `(progn
- ,@(mapcar (lambda (x) `(var ,(or (rename x) (var x)) ,(val x))) lexical-bindings)
- ,(if dynamic-bindings
- `(progn ,@(mapcar (lambda (x) `(var ,(rename x))) dynamic-bindings)
- (try (progn (setf ,@(loop for x in dynamic-bindings append
- `(,(rename x) ,(var x)
- ,(var x) ,(val x))))
- ,renamed-body)
- (:finally
- (setf ,@(mapcan (lambda (x) `(,(var x) ,(rename x))) dynamic-bindings)))))
- renamed-body)))))))
+ `(js:let ,(mapcar #'car bindings)
+ ,(ps-compile `(progn
+ ,@(mapcar (lambda (bind)
+ `(var ,(car bind) ,(cadr bind)))
+ bindings)
+ ,@body))))
(defpsmacro let* (bindings &body body)
(if bindings