-(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)
- `(,(if (= 1 (length bindings)) 'simple-let* 'simple-let) ,bindings ,@body))
-
-(define-ps-special-form let1 (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))))))
-