diff --git a/src/compiler.lisp b/src/compiler.lisp index 620de51..777bee1 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -72,10 +72,18 @@ lexical block.") (eval-when (:compile-toplevel :load-toplevel :execute) (defun make-macro-dictionary () (make-hash-table :test 'eq)) + + (defvar *ps-function-toplevel-cache* (make-macro-dictionary) + "Toplevel environment dictionary from function name to lambda + list, for use in SLIME.") (defvar *ps-macro-toplevel* (make-macro-dictionary) "Toplevel macro environment dictionary.") + (defvar *ps-macro-toplevel-lambda-list* (make-macro-dictionary) + "Toplevel macro environment dictionary (but maps macro name to + lambda list). For SLIME.") + (defvar *ps-macro-env* (list *ps-macro-toplevel*) "Current macro environment.") @@ -101,18 +109,27 @@ nil indicates we are no longer toplevel-related.")) (loop for e in env thereis (gethash name e))) (defun make-ps-macro-function (args body) + "Given the arguments and body to a parenscript macro, returns a +function that may be called on the entire parenscript form and outputs +some parenscript code. Returns a second value that is the effective +lambda list from a Parenscript perspective." (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)))) + (values + `(lambda (,whole-arg) + (destructuring-bind ,effective-lambda-list + (cdr ,whole-arg) + ,@body)) + effective-lambda-list))) (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)) + (multiple-value-bind (macro-fn-form effective-lambda-list) + (make-ps-macro-function args body) + `(progn (undefine-ps-special-form ',name) + (setf (gethash ',name *ps-macro-toplevel*) ,macro-fn-form) + (setf (gethash ',name *ps-macro-toplevel-lambda-list*) ',effective-lambda-list) + ',name))) (defmacro define-ps-symbol-macro (symbol expansion) (let ((x (gensym))) diff --git a/src/special-forms.lisp b/src/special-forms.lisp index a99ffd3..d277768 100644 --- a/src/special-forms.lisp +++ b/src/special-forms.lisp @@ -369,7 +369,9 @@ lambda-list::= [&key {var | ({var | (keyword-name var)} [init-form [supplied-p-parameter]])}* [&allow-other-keys]] [&aux {var | (var [init-form])}*])" (if (symbolp name) - `(defun-function ,name ,lambda-list ,@body) + (progn + (setf (gethash name *ps-function-toplevel-cache*) lambda-list) + `(defun-function ,name ,lambda-list ,@body)) (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)))) diff --git a/src/swank-parenscript.lisp b/src/swank-parenscript.lisp new file mode 100644 index 0000000..7183d0a --- /dev/null +++ b/src/swank-parenscript.lisp @@ -0,0 +1,18 @@ +(in-package :parenscript) + +(defun parenscript-function-p (symbol) + (and (or (gethash symbol *ps-macro-toplevel* ) + (gethash symbol *ps-function-toplevel-cache*)) + t)) + +(pushnew 'parenscript-function-p swank::*external-valid-function-name-p-hooks*) + +(defun parenscript-arglist (fname) + (acond + ((gethash fname *ps-macro-toplevel-lambda-list*) + (values it t)) + ((gethash fname *ps-function-toplevel-cache*) + (values it t)))) + +(pushnew 'parenscript-arglist swank::*external-arglist-hooks*) +