Commit bb119cda authored by Jean-Claude Beaudoin's avatar Jean-Claude Beaudoin
Browse files

Turn macro expanders into anonymous functions to prevent possible...

Turn macro expanders into anonymous functions to prevent possible compiler-macro expander function collision during optimization.
parent ce5939ef
......@@ -819,7 +819,8 @@
(defun c2fset (fun macro pprint c1forms)
(declare (ignore pprint))
(unless (and (not (fun-closure fun))
(unless (and (not macro)
(not (fun-closure fun))
(eq *destination* 'TRASH))
(return-from c2fset
(c2call-global 'SI:FSET c1forms (c1form-primary-type (second c1forms)))))
......
......@@ -285,10 +285,12 @@
(push `(declare (ignore ,env)) decls)))
(multiple-value-bind (ppn whole *dl* *key-check* *arg-check*)
(destructure vl name)
(setq body (nconc decls (append *arg-check* *key-check* body)))
(values `(si::lambda-block ,name (,whole ,env &aux ,@*dl*) ,@body)
ppn
doc)))
(values
`(lambda (,whole ,env &aux ,@*dl*)
,@decls ,@*arg-check* ,@*key-check*
(block ,(si::function-block-name name) ,@body))
ppn
doc)))
(si::fset 'defmacro ;; bootstrap version. redefined in evalmacros.lsp
#'(si::lambda-block defmacro (def env)
......@@ -301,12 +303,13 @@
(multiple-value-bind (function pprint doc)
(sys::expand-defmacro name vl body)
(declare (ignore doc))
(setq function `(function ,function))
#+(or)
(when *dump-defmacro-definitions*
(print function)
(setq function `(si::bc-disassemble ,function)))
(si:register-with-pde def `(si::fset ',name ,function t ,pprint)))))
(setq function `(si::bc-disassemble #',function)))
(si:register-with-pde def `(si::fset ',name #',function t ,pprint)))))
t)
;;; valid lambda-list to DESTRUCTURING-BIND is:
......
......@@ -71,13 +71,14 @@ retrieved by (documentation 'NAME 'function). See LIST for the backquote
macro useful for defining macros."
(multiple-value-bind (function pprint doc-string)
(sys::expand-defmacro name vl body)
(setq function `(function ,function))
#+(or)
(when *dump-defun-definitions*
(print function)
(setq function `(si::bc-disassemble ,function)))
(setq function `(si::bc-disassemble #',function)))
`(define-when (:compile-toplevel :load-toplevel :execute)
(si::fset ',name ,function t ,pprint)
(si::fset ',name #',function t ,pprint)
,@(si::expand-set-documentation name 'function doc-string)
',name)))
......@@ -140,13 +141,19 @@ VARIABLE doc and can be retrieved by (DOCUMENTATION 'SYMBOL 'VARIABLE)."
(multiple-value-bind (function pprint doc-string)
(sys::expand-defmacro name vl body)
(declare (ignore pprint))
(setq function `(function ,function))
#+(or)
(when *dump-defun-definitions*
(print function)
(setq function `(si::bc-disassemble ,function)))
(setq function `(si::bc-disassemble #',function)))
`(define-when (:load-toplevel :execute) ;;progn
(put-sysprop ',name 'sys::compiler-macro ,function)
(put-sysprop ',name 'sys::compiler-macro
#'(lambda (a-form some-env)
;;(funcall #',function a-form some-env)
;;(flet (,(cdr function)) (,name a-form some-env))
(,function a-form some-env)
))
,@(si::expand-set-documentation name 'function doc-string)
,(si:register-with-pde whole)
',name)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment