<span class="Apple-style-span" style="font-family: 'Courier New'; white-space: pre-wrap; "><div>I am away from a lispy computer, but here are the problem areas in js.lisp:</div><div><br class="webkit-block-placeholder">
</div>(defun js-expand-form (expr)
"Expand a javascript form."
(cond ((atom expr)
(multiple-value-bind (js-macro macro-env)
(lookup-macro expr)
(if js-macro
(js-expand-form (let ((*js-macro-env* macro-env))
(funcall js-macro)))
expr)))</span><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder"></span></font></div><div><font class="Apple-style-span" face="'Courier New'">
<span class="Apple-style-span" style="white-space: pre-wrap;">;;; macros
(define-js-compiler-macro macrolet (macros &rest body)
(let* ((macro-env (make-hash-table :test 'equal))
(*js-macro-env* (cons macro-env *js-macro-env*)))
(dolist (macro macros)
(destructuring-bind (name arglist &rest body) macro
(setf (gethash (symbol-name name) macro-env)
(compile nil `(lambda ,arglist ,@body)))))
(js-compile `(progn ,@body))))</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder"></span>
</font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;">(defjsmacro symbol-macrolet (macros &rest body)
`(macrolet ,(mapcar #'(lambda (macro)
`(,(first macro) () ,@(rest macro))) macros)
,@body))</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder"></span></font></div><div>
<font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;">The problem is that symbol-macrolets use the same machinery as regular macrolets. A solution is to maintain parallel symbol and regular macro environments...
</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder"></span></font></div><div><font class="Apple-style-span" face="'Courier New'">
<span class="Apple-style-span" style="white-space: pre-wrap;">;; new variables</span></font></div><div><span class="Apple-style-span" style="font-family: 'Courier New'; white-space: pre-wrap; ">(eval-when (:compile-toplevel :load-toplevel :execute)
</span></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"> (defvar *js-symbol-macro-toplevel* (make-hash-table :test 'equal)
"Toplevel of symbol macro expansion, holds all the toplevel javascript macros.")
(defvar *js-symbol-macro-env* (list js-symbol-macro-toplevel*)
"Current symbol macro environment."))</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder">
</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;">;; amend (lookup-macro ..) to take a :type argument.</span></font></div><div>
<span class="Apple-style-span" style="font-family: 'Courier New'; white-space: pre-wrap; ">(defun lookup-macro (name &keyword (type :lambda))</span></div><div><font class="Apple-style-span" face="'Courier New'">
<span class="Apple-style-span" style="white-space: pre-wrap;"> "Lookup the macro NAME in the current macro expansion
environment. Returns the macro and the parent macro environment of
this macro."
(unless (symbolp name)
(return-from lookup-macro nil))
(do ((env (case type</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"> (:lambda *js-macro-env*)</span></font>
</div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"> (:symbol *js-symbol-macro-env*)</span></font></div><div><font class="Apple-style-span" face="'Courier New'">
<span class="Apple-style-span" style="white-space: pre-wrap;"> (t (error "Invalid macro type ~A" type)))</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;">
(cdr env)))
((null env) nil)
(let ((val (gethash (symbol-name name) (car env))))
(when val
(return-from lookup-macro
(values val (or (cdr env)
(list</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"> (case type</span></font></div><div><font class="Apple-style-span" face="'Courier New'">
<span class="Apple-style-span" style="white-space: pre-wrap; "> (:lambda *js-macro-toplevel*)</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap; ">
(:symbol *js-symbol-macro-toplevel*)</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"> (t (error "Invalid macro type ~A" type))))))))))
</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder"></span></font></div><div><font class="Apple-style-span" face="'Courier New'">
<span class="Apple-style-span" style="white-space: pre-wrap;">;; get rid of (defjsmacro symbol-macrolet ...) and replace it with</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;">
;; a compiler macro:</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;">(define-js-compiler-macro symbol-macrolet (macros &rest body)
(let* ((macro-env (make-hash-table :test 'equal))
(*js-symbol-macro-env* (cons macro-env *js-symbol-macro-env*)))
(dolist (macro macros)
(setf (gethash (symbol-name (first macro)) macro-env)
(compile nil `(lambda () ,@(rest macro)))))
(js-compile `(progn ,@body))))</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder"></span>
</font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;">;; change expand-form</span></font></div><div><font class="Apple-style-span" face="'Courier New'">
<span class="Apple-style-span" style="white-space: pre-wrap;">(defun js-expand-form (expr)
"Expand a javascript form."
(cond ((atom expr)
(multiple-value-bind (js-macro macro-env)
(lookup-macro expr :type :symbol)
(if js-macro
(js-expand-form (let ((*js-symbol-macro-env* macro-env))
(funcall js-macro)))
expr)))
((js-compiler-macro-form-p expr) expr)
((equal (first expr) 'quote) expr)
(t (let ((js-macro (lookup-macro (car expr))))
(if js-macro
(js-expand-form (apply js-macro (cdr expr)))
expr)))))</span></font></div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder"></span></font></div><div>
<font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder"></span></font></div><div>This should at least give an idea of the relevant areas of code.
</div><div><font class="Apple-style-span" face="'Courier New'"><span class="Apple-style-span" style="white-space: pre-wrap;"><br class="webkit-block-placeholder"></span></font></div><div><font class="Apple-style-span" face="'Courier New'">
<span class="Apple-style-span" style="white-space: pre-wrap;">-Red</span></font></div>