mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-03 03:00:34 -08:00
Code Issues Projects Releases Packages Wiki Activity

EXPAND-DEFMACRO now outputs a lambda block.

Browse source
This commit is contained in:
jgarcia 2006-06-12 08:51:38 +00:00
parent 9ba498dd0b
commit ab2da5b861
4 changed files with 28 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/compiler.d
View file

@ -1291,7 +1291,7 @@ c_macrolet(cl_object args, int flags)
cl_object macro, function;
macro = funcall(4, @'si::expand-defmacro', name, arglist,
definition);
function = make_lambda(name, CDR(macro));
function = make_lambda(name, CDDR(macro));
c_register_macro(name, function);
}
/* Remove declarations */

13
src/cmp/cmpflet.lsp
View file

@ -198,13 +198,12 @@
(defun c1macrolet (args &aux (*funs* *funs*))
(check-args-number 'MACROLET args 1)
(dolist (def (car args))
(cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def)))
"The macro definition ~s is illegal." def)
(push (list (car def)
'MACRO
(si::make-lambda (car def)
(cdr (sys::expand-defmacro (car def) (second def) (cddr def)))))
*funs*))
(let ((name (first def)))
(cmpck (or (endp def) (not (symbolp name)) (endp (cdr def)))
"The macro definition ~s is illegal." def)
(push (list name 'MACRO
(si::eval-with-env (sys::expand-defmacro name (second def) (cddr def))))
*funs*)))
(c1locally (cdr args)))
(defun c1symbol-macrolet (args &aux (*vars* *vars*))

6
src/lsp/defmacro.lsp
View file

@ -274,7 +274,7 @@
(multiple-value-bind (ppn whole *dl* *key-check* *arg-check*)
(destructure vl t)
(setq body (nconc decls (append *arg-check* *key-check* body)))
(values (list* 'LAMBDA (list* whole env '&aux *dl*) body)
(values `(ext::lambda-block ,name (,whole ,env &aux ,@*dl*) ,@body)
ppn
doc)))
@ -284,9 +284,9 @@
(vl (third def))
(body (cdddr def))
(function))
(multiple-value-bind (expr pprint doc)
(multiple-value-bind (function pprint doc)
(sys::expand-defmacro name vl body)
(setq function `#'(ext::lambda-block ,name ,@(cdr expr)))
(setq function `(function ,function))
(when *dump-defmacro-definitions*
(print function)
(setq function `(si::bc-disassemble ,function)))

36
src/lsp/evalmacros.lsp
View file

@ -55,16 +55,16 @@ or
The doc-string DOC, if supplied, is saved as a FUNCTION doc and can be
retrieved by (documentation 'NAME 'function). See LIST for the backquote
macro useful for defining macros."
(multiple-value-bind (expr pprint doc-string)
(multiple-value-bind (function pprint doc-string)
(sys::expand-defmacro name vl body)
(let* ((function `#'(lambda-block ,name ,@(cdr expr))))
(when *dump-defun-definitions*
(print function)
(setq function `(si::bc-disassemble ,function)))
`(eval-when (:compile-toplevel :load-toplevel :execute)
(si::fset ',name ,function t ,pprint)
,@(si::expand-set-documentation name 'function doc-string)
',name))))
(setq function `(function ,function))
(when *dump-defun-definitions*
(print function)
(setq function `(si::bc-disassemble ,function)))
`(eval-when (:compile-toplevel :load-toplevel :execute)
(si::fset ',name ,function t ,pprint)
,@(si::expand-set-documentation name 'function doc-string)
',name)))
(defmacro defvar (var &optional (form nil form-sp) doc-string)
"Syntax: (defvar name [form [doc]])
@ -109,16 +109,16 @@ as a VARIABLE doc and can be retrieved by (documentation 'NAME 'variable)."
;;; This is a no-op unless the compiler is installed
;;;
(defmacro define-compiler-macro (name vl &rest body)
(multiple-value-bind (expr pprint doc-string)
(multiple-value-bind (function pprint doc-string)
(sys::expand-defmacro name vl body)
(let* ((function `#'(lambda-block ,name ,@(cdr expr))))
(when *dump-defun-definitions*
(print function)
(setq function `(si::bc-disassemble ,function)))
`(progn
(put-sysprop ',name 'sys::compiler-macro ,function)
,@(si::expand-set-documentation name 'function doc-string)
',name))))
(setq function `(function ,function))
(when *dump-defun-definitions*
(print function)
(setq function `(si::bc-disassemble ,function)))
`(progn
(put-sysprop ',name 'sys::compiler-macro ,function)
,@(si::expand-set-documentation name 'function doc-string)
',name)))
(defun compiler-macro-function (name &optional env)
(declare (ignore env))