X-Git-Url: https://git.hcoop.net/clinton/parenscript.git/blobdiff_plain/43a1d5c3aecf79d64971b751a62c285e631b003a..c2c51a3db0b1bff4be5cf2afc8166f8220edfade:/src/compiler.lisp diff --git a/src/compiler.lisp b/src/compiler.lisp dissimilarity index 83% index c4cc3b1..a55fe46 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -1,268 +1,378 @@ -(in-package :parenscript) - -;;;; The mechanisms for parsing Parenscript. -(eval-when (:compile-toplevel :load-toplevel :execute) - (defvar *toplevel-special-forms* (make-hash-table :test #'equal) - "A hash-table containing functions that implement Parenscript special forms, -indexed by name (as symbols)") - (defun undefine-ps-special-form (name) - "Undefines the special form with the given name (name is a symbol)." - (remhash (lisp-symbol-to-ps-identifier name :special-form) *toplevel-special-forms*))) - -(defmacro define-ps-special-form (name lambda-list &rest body) - "Define a special form NAME. The first argument given to the special -form is a keyword indicating whether the form is expected to produce -an :expression or a :statement. The resulting Parenscript language -types are appended to the ongoing javascript compilation." - (let ((arglist (gensym "ps-arglist-"))) - `(setf (gethash (lisp-symbol-to-ps-identifier ',name :special-form) *toplevel-special-forms*) - (lambda (&rest ,arglist) - (destructuring-bind ,lambda-list - ,arglist - ,@body))))) - -(defun get-ps-special-form (name) - "Returns the special form function corresponding to the given name." - (gethash (lisp-symbol-to-ps-identifier name :special-form) *toplevel-special-forms*)) - -;;; ParenScript form predicates -(defun ps-special-form-p (form) - (and (consp form) - (symbolp (car form)) - (get-ps-special-form (car form)))) - -(defun op-form-p (form) - (and (listp form) - (not (ps-special-form-p form)) - (not (null (op-precedence (first form)))))) - -(defun funcall-form-p (form) - (and (listp form) - (not (op-form-p form)) - (not (ps-special-form-p form)))) - -(defun method-call-p (form) - (and (funcall-form-p form) - (symbolp (first form)) - (eql (char (symbol-name (first form)) 0) #\.))) - -;;; macro expansion -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun make-macro-env-dictionary () - "Creates a standard macro dictionary." - (make-hash-table :test #'equal)) - (defvar *script-macro-toplevel* (make-macro-env-dictionary) - "Toplevel macro environment dictionary. Key is the symbol of the -macro, value is (symbol-macro-p . expansion-function).") - (defvar *script-macro-env* (list *script-macro-toplevel*) - "Current macro environment.") - - (defvar *script-setf-expanders* (make-macro-env-dictionary) - "Setf expander dictionary. Key is the symbol of the access -function of the place, value is an expansion function that takes the -arguments of the access functions as a first value and the form to be -stored as the second value.") - - (defun get-macro-spec (name env-dict) - "Retrieves the macro spec of the given name with the given environment dictionary. -SPEC is of the form (symbol-macro-p . expansion-function)." - (gethash (lisp-symbol-to-ps-identifier name :macro) env-dict)) - (defsetf get-macro-spec (name env-dict) - (spec) - `(setf (gethash (lisp-symbol-to-ps-identifier ,name :macro) ,env-dict) ,spec))) - -(defun lookup-macro-spec (name &optional (environment *script-macro-env*)) - "Looks up the macro spec associated with NAME in the given environment. A -macro spec is of the form (symbol-macro-p . function). Returns two values: -the SPEC and the parent macro environment. - -NAME must be a symbol." - (when (symbolp name) - (do ((env environment (cdr env))) - ((null env) nil) - (let ((val (get-macro-spec name (car env)))) - (when val - (return-from lookup-macro-spec - (values val (or (cdr env) - (list *script-macro-toplevel*))))))))) - -(defun script-symbol-macro-p (name &optional (environment *script-macro-env*)) - "True if there is a Parenscript symbol macro named by the symbol NAME." - (and (symbolp name) (car (lookup-macro-spec name environment)))) - -(defun script-macro-p (name &optional (environment *script-macro-env*)) - "True if there is a Parenscript macro named by the symbol NAME." - (and (symbolp name) - (let ((macro-spec (lookup-macro-spec name environment))) - (and macro-spec (not (car macro-spec)))))) - -(defun lookup-macro-expansion-function (name &optional (environment *script-macro-env*)) - "Lookup NAME in the given macro expansion environment (which -defaults to the current macro environment). Returns the expansion -function and the parent macro environment of the macro." - (multiple-value-bind (macro-spec parent-env) - (lookup-macro-spec name environment) - (values (cdr macro-spec) parent-env))) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun make-ps-macro-function (args body) - (let* ((whole-var (when (eql '&whole (first args)) (second args))) - (effective-lambda-list (if whole-var (cddr args) args)) - (form-arg (or whole-var (gensym "ps-macro-form-arg-"))) - (body (if (and (cdr body) (stringp (first body))) (rest body) body))) ;; drop docstring - (compile nil `(lambda (,form-arg) - (destructuring-bind ,effective-lambda-list - (cdr ,form-arg) - ,@body))))) - - (defun define-script-macro% (name args body &key symbol-macro-p) - (undefine-ps-special-form name) - (setf (get-macro-spec name *script-macro-toplevel*) - (cons symbol-macro-p (make-ps-macro-function args body))) - nil)) - -(defmacro defpsmacro (name args &body body) - "Define a ParenScript macro, and store it in the toplevel ParenScript -macro environment." - `(define-script-macro% ',name ',args ',body :symbol-macro-p nil)) - -(defmacro define-script-symbol-macro (name &body body) - "Define a ParenScript symbol macro, and store it in the toplevel ParenScript -macro environment. BODY is a Lisp form that should return a ParenScript form." - `(define-script-macro% ',name () ',body :symbol-macro-p t)) - -(defun import-macros-from-lisp (&rest names) - "Import the named Lisp macros into the ParenScript macro -environment. When the imported macro is macroexpanded by ParenScript, -it is first fully macroexpanded in the Lisp macro environment, and -then that expansion is further expanded by ParenScript." - (dolist (name names) - (define-script-macro% name '(&rest args) - (list `(common-lisp:macroexpand `(,',name ,@args))) - :symbol-macro-p nil))) - -(defmacro defmacro/ps (name args &body body) - "Define a Lisp macro and import it into the ParenScript macro environment." - `(progn (defmacro ,name ,args ,@body) - (ps:import-macros-from-lisp ',name))) - -(defmacro defmacro+ps (name args &body body) - "Define a Lisp macro and a ParenScript macro in their respective -macro environments. This function should be used when you want to use -the same macro in both Lisp and ParenScript, but the 'macroexpand' of -that macro in Lisp makes the Lisp macro unsuitable to be imported into -the ParenScript macro environment." - `(progn (defmacro ,name ,args ,@body) - (defpsmacro ,name ,args ,@body))) - -(defun ps-macroexpand (form) - "Recursively macroexpands ParenScript macros and symbol-macros in -the given ParenScript form. Returns two values: the expanded form, and -whether any expansion was performed on the form or not." - (if (consp form) - (let ((op (car form)) - (args (cdr form))) - (cond ((equal op 'quote) (values (if (equalp '(nil) args) nil form) ;; leave quotes alone, unless it's a quoted nil - nil)) - ((script-macro-p op) (values (ps-macroexpand (funcall (lookup-macro-expansion-function op) form)) t)) - (t (values form nil)))) - (cond ((script-symbol-macro-p form) (values (ps-macroexpand (funcall (lookup-macro-expansion-function form))) t)) - (t (values form nil))))) - -;;;; compiler interface -(defgeneric compile-parenscript-form (form &key expecting) - (:documentation "Compiles a ParenScript form to the intermediate -ParenScript representation. :expecting determines whether the form is -compiled to an :expression (the default), a :statement, or a -:symbol.")) - -(defmethod compile-parenscript-form :around (form &key expecting) - (if (eql expecting :symbol) - (compile-to-symbol form) - (multiple-value-bind (expanded-form expanded-p) - (ps-macroexpand form) - (if expanded-p - (compile-parenscript-form expanded-form :expecting expecting) - (call-next-method))))) - -(defun compile-to-symbol (form) - "Compiles the given Parenscript form and guarantees that the -resultant symbol has an associated script-package. Raises an error if -the form cannot be compiled to a symbol." - (let ((exp (compile-parenscript-form form))) - (when (or (eql (first exp) 'js-variable) - (eql (first exp) 'script-quote)) - (setf exp (second exp))) - (assert (symbolp exp) () - "~a is expected to be a symbol, but compiles to ~a (the ParenScript output for ~a alone is \"~a\"). This could be due to ~a being a special form." form exp form (ps* form) form) - exp)) - -(defmethod compile-parenscript-form (form &key expecting) - (declare (ignore expecting)) - (error "The object ~S cannot be compiled by ParenScript." form)) - -(defmethod compile-parenscript-form ((form number) &key expecting) - (declare (ignore expecting)) - form) - -(defmethod compile-parenscript-form ((form string) &key expecting) - (declare (ignore expecting)) - form) - -(defmethod compile-parenscript-form ((form character) &key expecting) - (declare (ignore expecting)) - (compile-parenscript-form (string form))) - -(defmethod compile-parenscript-form ((symbol symbol) &key expecting) - (declare (ignore expecting)) - ;; is this the correct behavior? - (let ((special-symbol (get-ps-special-form symbol))) - (cond (special-symbol (funcall special-symbol :symbol)) - (t (list 'js-variable symbol))))) - -(defun compile-function-argument-forms (arg-forms) - "Compiles a bunch of Parenscript forms from a funcall form to an effective set of -Javascript arguments. The only extra processing this does is makes :keyword arguments -into a single options argument via CREATE." - (flet ((keyword-arg (arg) - "If the given compiled expression is supposed to be a keyword argument, returns -the keyword for it." - (when (and (listp arg) (eql (first arg) 'script-quote)) (second arg)))) - (let ((compiled-args (mapcar (lambda (arg) (compile-parenscript-form arg :expecting :expression)) - arg-forms))) - (do ((effective-expressions nil) - (expressions-subl compiled-args)) - ((not expressions-subl) (reverse effective-expressions)) - (let ((arg-expr (first expressions-subl))) - (if (keyword-arg arg-expr) - (progn (when (oddp (length expressions-subl)) - (error "Odd number of keyword arguments: ~A." arg-forms)) - (push (list 'js-object (loop for (name val) on expressions-subl by #'cddr - collect (list name val))) - effective-expressions) - (setf expressions-subl nil)) - (progn (push arg-expr effective-expressions) - (setf expressions-subl (rest expressions-subl))))))))) - -(defmethod compile-parenscript-form ((form cons) &key (expecting :statement)) - (let* ((name (car form)) - (args (cdr form))) - (cond ((eql name 'quote) - (assert (= 1 (length args)) () "Wrong number of arguments to quote: ~s" args) - (list 'script-quote (first args))) - ((ps-special-form-p form) (apply (get-ps-special-form name) (cons expecting args))) - ((op-form-p form) - (list 'operator - (script-convert-op-name (compile-parenscript-form (first form) :expecting :symbol)) - (mapcar (lambda (form) (compile-parenscript-form form :expecting :expression)) (rest form)))) - ((method-call-p form) - (list 'js-method-call - (compile-parenscript-form name :expecting :symbol) - (compile-parenscript-form (first args) :expecting :expression) - (compile-function-argument-forms (rest args)))) - ((funcall-form-p form) - (list 'js-funcall - (compile-parenscript-form name :expecting :expression) - (compile-function-argument-forms args))) - (t (error "Cannot compile ~S to a ParenScript form." form))))) - +(in-package "PARENSCRIPT") + +;;; reserved symbols/literals + +(defvar *ps-reserved-symbol-names* + (list "break" "case" "catch" "continue" "default" "delete" "do" "else" + "finally" "for" "function" "if" "in" "instanceof" "new" "return" + "switch" "this" "throw" "try" "typeof" "var" "void" "while" "with" + "abstract" "boolean" "byte" "char" "class" "const" "debugger" "double" + "enum" "export" "extends" "final" "float" "goto" "implements" "import" + "int" "interface" "long" "native" "package" "private" "protected" + "public" "short" "static" "super" "synchronized" "throws" "transient" + "volatile")) + +(defun add-ps-reserved-symbol (name) + (pushnew (symbol-name-to-js-string name) *ps-reserved-symbol-names* :test #'equalp)) + +(defun ps-reserved-symbol-p (symbol) + (when (symbolp symbol) + (find (symbol-name-to-js-string symbol) *ps-reserved-symbol-names* :test #'equalp))) + +;;; special forms + +(defvar *ps-special-forms* (make-hash-table :test 'eq)) + +(defun get-ps-special-form (name) + (gethash name *ps-special-forms*)) + +(defmacro define-ps-special-form (name lambda-list &rest body) + `(setf (gethash ',name *ps-special-forms*) + (lambda (&rest whole) + (destructuring-bind ,lambda-list + whole + ,@body)))) + +(defun undefine-ps-special-form (name) + (remhash name *ps-special-forms*)) + +(defun ps-special-form-p (form) + (and (consp form) + (symbolp (car form)) + (gethash (car form) *ps-special-forms*))) + +;;; scoping + +(defvar *enclosing-lexical-block-declarations* () + "This special variable is expected to be bound to a fresh list by +special forms that introduce a new JavaScript lexical block (currently +function definitions and lambdas). Enclosed special forms are expected +to push variable declarations onto the list when the variables +declaration cannot be made by the enclosed form \(for example, a +\(x,y,z\) expression progn\). It is then the responsibility of the +enclosing special form to introduce the variable bindings in its +lexical block.") + +(defvar *ps-special-variables* ()) + +(defun ps-special-variable-p (sym) + (member sym *ps-special-variables*)) + +;;; form predicates + +(defun comparison-form-p (form) + (member (car form) '(< > <= >= == != === !==))) + +(defun op-form-p (form) + (and (listp form) + (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) + (not (op-form-p form)) + (not (ps-special-form-p form)))) + +;;; macro expansion +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun make-macro-dictionary () + (make-hash-table :test 'eq)) + + (defvar *ps-macro-toplevel* (make-macro-dictionary) + "Toplevel macro environment dictionary.") + + (defvar *ps-macro-env* (list *ps-macro-toplevel*) + "Current macro environment.") + + (defvar *ps-symbol-macro-toplevel* (make-macro-dictionary)) + + (defvar *ps-symbol-macro-env* (list *ps-symbol-macro-toplevel*)) + + (defvar *ps-local-function-names* ()) + + (defvar *ps-setf-expanders* (make-macro-dictionary) + "Setf expander dictionary. Key is the symbol of the access +function of the place, value is an expansion function that takes the +arguments of the access functions as a first value and the form to be +stored as the second value.") + + (defparameter *ps-compilation-level* :toplevel + "This value takes on the following values: +:toplevel indicates that we are traversing toplevel forms. +:inside-toplevel-form indicates that we are inside a call to ps-compile-* +nil indicates we are no longer toplevel-related.")) + +(defun lookup-macro-def (name env) + (loop for e in env thereis (gethash name e))) + +(defun make-ps-macro-function (args body) + (let* ((whole-var (when (eql '&whole (first args)) (second args))) + (effective-lambda-list (if whole-var (cddr args) args)) + (whole-arg (or whole-var (gensym "ps-macro-form-arg-")))) + `(lambda (,whole-arg) + (destructuring-bind ,effective-lambda-list + (cdr ,whole-arg) + ,@body)))) + +(defmacro defpsmacro (name args &body body) + `(progn (undefine-ps-special-form ',name) + (setf (gethash ',name *ps-macro-toplevel*) ,(make-ps-macro-function args body)) + ',name)) + +(defmacro define-ps-symbol-macro (symbol expansion) + (let ((x (gensym))) + `(progn (undefine-ps-special-form ',symbol) + (setf (gethash ',symbol *ps-symbol-macro-toplevel*) (lambda (,x) (declare (ignore ,x)) ',expansion)) + ',symbol))) + +(defun import-macros-from-lisp (&rest names) + "Import the named Lisp macros into the ParenScript macro +environment. When the imported macro is macroexpanded by ParenScript, +it is first fully macroexpanded in the Lisp macro environment, and +then that expansion is further expanded by ParenScript." + (dolist (name names) + (eval `(defpsmacro ,name (&rest args) + (macroexpand `(,',name ,@args)))))) + +(defmacro defmacro/ps (name args &body body) + "Define a Lisp macro and import it into the ParenScript macro environment." + `(progn (defmacro ,name ,args ,@body) + (import-macros-from-lisp ',name))) + +(defmacro defmacro+ps (name args &body body) + "Define a Lisp macro and a ParenScript macro with the same macro +function (ie - the same result from macroexpand-1), for cases when the +two have different full macroexpansions (for example if the CL macro +contains implementation-specific code when macroexpanded fully in the +CL environment)." + `(progn (defmacro ,name ,args ,@body) + (defpsmacro ,name ,args ,@body))) + +(defun ps-macroexpand (form) + (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)) + +(defun maybe-rename-local-function (fun-name) + (aif (lookup-macro-def fun-name *ps-local-function-names*) + it + fun-name)) + +;;;; compiler interface +(defun adjust-ps-compilation-level (form level) + "Given the current *ps-compilation-level*, LEVEL, and the fully macroexpanded +form, FORM, returns the new value for *ps-compilation-level*." + (cond ((or (and (consp form) (member (car form) + '(progn locally macrolet symbol-macrolet compile-file))) + (and (symbolp form) (eq :toplevel level))) + level) + ((eq :toplevel level) :inside-toplevel-form))) + + +(defun ps-compile-symbol (form) + "Compiles the given Parenscript form and guarantees that the +resultant symbol has an associated script-package. Raises an error if +the form cannot be compiled to a symbol." + (let ((exp (ps-compile-expression form))) + (when (eq (first exp) 'js:variable) + (setf exp (second exp))) + (assert (symbolp exp) () + "~a is expected to be a symbol, but compiles to ~a (the ParenScript output for ~a alone is \"~a\"). This could be due to ~a being a special form." form exp form (ps* form) form) + exp)) + +(defmethod ps-compile (form) + (error "The object ~S cannot be compiled by ParenScript." form)) + +(defmethod ps-compile ((form number)) + form) + +(defmethod ps-compile ((form string)) + form) + +(defmethod ps-compile ((form character)) + (ps-compile (string form))) + +(defun compound-symbol-p (symbol) + (let ((split (split-sequence:split-sequence #\. (symbol-name symbol)))) + (break "~A = ~A" symbol split) + (if (cdr split) + (reduce + (lambda (&optional slot-name object-exp) + `(js:slot-value ,object-exp ,(make-symbol slot-name))) + (reverse (cddr split)) + :initial-value `(slot-value + (js:variable ,(ps-macroexpand + (intern (car split) + (symbol-package symbol)))) + ,(make-symbol (cadr split))) + :from-end t) + nil))) + +(defmethod ps-compile ((symbol 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 (aif (compound-symbol-p symbol) + it + `(js:variable ,symbol))))))) + +;;; operators + +(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 + (and '\&\&) + (or '\|\|) + (not '!) + (eql '\=\=) + (= '\=\=) + (t op))) + +(defun maybe-fix-nary-comparison-form (form) + (if (< 2 (length (cdr form))) + (values + (let* ((operator (car form)) + (tmp-var-forms (butlast (cddr form))) + (tmp-vars (loop repeat (length tmp-var-forms) + collect (ps-gensym "_cmp"))) + (all-comparisons (append (list (cadr form)) + tmp-vars + (last form)))) + `(let ,(mapcar #'list tmp-vars tmp-var-forms) + (and ,@(loop for x1 in all-comparisons + for x2 in (cdr all-comparisons) + collect (list operator x1 x2))))) + t) + form)) + +(defun compile-op-form (form) + `(js:operator ,(ps-convert-op-name (ps-compile-symbol (car form))) + ,@(mapcar (lambda (form) + (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 function-name->js-expression (name) + (aif (compound-symbol-p name) + it + `(js:variable ,(maybe-rename-local-function name)))) + +(defun compile-funcall-form (form) + `(js:funcall + ,(if (symbolp (car form)) + (function-name->js-expression (car form)) + (ps-compile-expression (ps-macroexpand (car form)))) + ,@(mapcar #'ps-compile-expression (cdr form)))) + +(defvar compile-expression?) + +(defmethod ps-compile ((form cons)) + (multiple-value-bind (form expanded-p) + (ps-macroexpand form) + (let ((*ps-compilation-level* + (if expanded-p + *ps-compilation-level* + (adjust-ps-compilation-level form *ps-compilation-level*)))) + (cond (expanded-p + (ps-compile form)) + ((ps-special-form-p form) + (apply (get-ps-special-form (car form)) (cdr form))) + ((comparison-form-p form) + (multiple-value-bind (form fixed?) + (maybe-fix-nary-comparison-form form) + (if fixed? + (ps-compile form) + (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)))))) + +(defun ps-compile-statement (form) + (let ((compile-expression? nil)) + (ps-compile form))) + +(defun ps-compile-expression (form) + (let ((compile-expression? t)) + (ps-compile form))) + +(defvar *ps-gensym-counter* 0) + +(defun ps-gensym (&optional (prefix "_js")) + (let ((prefix (if (stringp prefix) prefix (symbol-to-js-string prefix nil)))) + (make-symbol (format nil "~A~:[~;_~]~A" prefix + (digit-char-p (char prefix (1- (length prefix)))) + (incf *ps-gensym-counter*))))) + +(defmacro with-ps-gensyms (symbols &body body) + "Evaluate BODY with SYMBOLS bound to unique ParenScript identifiers. + +Each element of SYMBOLS is either a symbol or a list of (symbol +gensym-prefix-string)." + `(let* ,(mapcar (lambda (symbol) + (destructuring-bind (symbol &optional prefix) + (if (consp symbol) + symbol + (list symbol)) + (if prefix + `(,symbol (ps-gensym ,prefix)) + `(,symbol (ps-gensym ,(symbol-to-js-string symbol)))))) + symbols) + ,@body)) + +(defun %check-once-only-vars (vars) + (let ((bad-var (find-if (lambda (x) (or (not (symbolp x)) (keywordp x))) vars))) + (when bad-var + (error "PS-ONLY-ONCE expected a non-keyword symbol but got ~s" bad-var)))) + +(defmacro ps-once-only ((&rest vars) &body body) + (%check-once-only-vars vars) + (let ((gensyms (mapcar (lambda (x) (ps-gensym (string x))) vars))) + `(let ,(mapcar (lambda (g v) `(,g (ps-gensym ,(string v)))) gensyms vars) + `(let* (,,@(mapcar (lambda (g v) ``(,,g ,,v)) gensyms vars)) + ,(let ,(mapcar (lambda (g v) `(,v ,g)) gensyms vars) + ,@body)))))