diff options
| -rw-r--r-- | sb-eval2.lisp | 40 |
1 files changed, 21 insertions, 19 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp index a1bf54a..5db1ca5 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -231,6 +231,27 @@ (declare (ignore env)) (symbol-value var)))) + +(defun body-decls&forms (exprs) + (let* ((decl-exprs + (loop while (and (consp (first exprs)) + (eq 'declare (first (first exprs)))) + for expr = (pop exprs) + collect expr)) + (decls (mapcan #'rest decl-exprs))) + (values decls exprs))) + +(defun decl-specials (declaration) + (when (eq (first declaration) 'special) + (rest declaration))) + +(defmacro with-parsed-body ((forms-var specials-var) exprs &body body) + (let ((decls (gensym))) + `(multiple-value-bind (,decls ,forms-var) (body-decls&forms ,exprs) + (let ((,specials-var (mapcan #'decl-specials ,decls))) + ,@body)))) + + (declaim (ftype (function ((or symbol list) context) eval-closure) prepare-function-ref)) (defun prepare-function-ref (function-name context) (if (context-var-lexical-p context `(function ,function-name)) @@ -542,25 +563,6 @@ (declare (ignore lexenv)) (make-null-context)) -(defun body-decls&forms (exprs) - (let* ((decl-exprs - (loop while (and (consp (first exprs)) - (eq 'declare (first (first exprs)))) - for expr = (pop exprs) - collect expr)) - (decls (mapcan #'rest decl-exprs))) - (values decls exprs))) - -(defun decl-specials (declaration) - (when (eq (first declaration) 'special) - (rest declaration))) - -(defmacro with-parsed-body ((forms-var specials-var) exprs &body body) - (let ((decls (gensym))) - `(multiple-value-bind (,decls ,forms-var) (body-decls&forms ,exprs) - (let ((,specials-var (mapcan #'decl-specials ,decls))) - ,@body)))) - (defun globally-special-p (var) (eq :special (sb-int:info :variable :kind var))) |