cautiously reconnoitering the great dragon's lair: moved the
first innocuous-looking src/pcl/ file into cold build
("src/code/late-setf")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
("src/code/late-setf")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; other target-code-building stuff which can't be processed until
;; machinery like SB!XC:DEFMACRO exists
("src/code/late-format") ; needs SB!XC:DEFMACRO
("src/code/sxhash") ; needs SB!XC:DEFINE-MODIFY-MACRO
("src/code/signal")
;; other target-code-building stuff which can't be processed until
;; machinery like SB!XC:DEFMACRO exists
("src/code/late-format") ; needs SB!XC:DEFMACRO
("src/code/sxhash") ; needs SB!XC:DEFINE-MODIFY-MACRO
("src/code/signal")
- ("src/code/late-defbangmethod"))
+ ("src/code/late-defbangmethod")
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; PCL-related stuff, which shouldn't need to be done earlier than
+ ;; anything else in cold build because after all it used to be
+ ;; postponed 'til warm init with no problems.
+
+ ("src/pcl/walk"))
;; (arbitrary) linearization of the declared build
;; order dependencies from the old PCL defsys.lisp
;; dependency database.
;; (arbitrary) linearization of the declared build
;; order dependencies from the old PCL defsys.lisp
;; dependency database.
+ #+nil "src/pcl/walk" ; #+NIL = moved to build-order.lisp-expr
"src/pcl/early-low"
"src/pcl/macros"
"src/pcl/compiler-support"
"src/pcl/early-low"
"src/pcl/macros"
"src/pcl/compiler-support"
-;;;; a simple code walker for PCL
+;;;; a simple code walker
;;;;
;;;; The code which implements the macroexpansion environment
;;;; manipulation mechanisms is in the first part of the file, the
;;;;
;;;; The code which implements the macroexpansion environment
;;;; manipulation mechanisms is in the first part of the file, the
;;;; warranty about the software, its performance or its conformity to any
;;;; specification.
;;;; warranty about the software, its performance or its conformity to any
;;;; specification.
-(in-package "SB-WALKER")
+(in-package "SB!WALKER")
+\f
+;;;; forward references
+
+(defvar *key-to-walker-environment*)
\f
;;;; environment hacking stuff, necessarily SBCL-specific
\f
;;;; environment hacking stuff, necessarily SBCL-specific
;;; In SBCL, as in CMU CL before it, the environment is represented
;;; with a structure that holds alists for the functional things,
;;; variables, blocks, etc. Except for SYMBOL-MACROLET, only the
;;; In SBCL, as in CMU CL before it, the environment is represented
;;; with a structure that holds alists for the functional things,
;;; variables, blocks, etc. Except for SYMBOL-MACROLET, only the
-;;; SB-C::LEXENV-FUNS slot is relevant. It holds: Alist (Name . What),
+;;; SB!C::LEXENV-FUNS slot is relevant. It holds: Alist (Name . What),
;;; where What is either a functional (a local function) or a list
;;; (MACRO . <function>) (a local macro, with the specifier expander.)
;;; Note that Name may be a (SETF <name>) function. Accessors are
;;; where What is either a functional (a local function) or a list
;;; (MACRO . <function>) (a local macro, with the specifier expander.)
;;; Note that Name may be a (SETF <name>) function. Accessors are
;;;
;;; If WITH-AUGMENTED-ENVIRONMENT is called from WALKER-ENVIRONMENT-BIND
;;; this code hides the WALKER version of an environment
;;;
;;; If WITH-AUGMENTED-ENVIRONMENT is called from WALKER-ENVIRONMENT-BIND
;;; this code hides the WALKER version of an environment
-;;; inside the SB-C::LEXENV structure.
+;;; inside the SB!C::LEXENV structure.
;;;
;;; In CMUCL (and former SBCL), This used to be a list of lists of form
;;; (<gensym-name> MACRO . #<interpreted-function>) in the :functions slot
;;;
;;; In CMUCL (and former SBCL), This used to be a list of lists of form
;;; (<gensym-name> MACRO . #<interpreted-function>) in the :functions slot
;;; Instead this list was COERCEd to a #<FUNCTION ...>!
;;;
;;; Instead, we now use a special sort of "function"-type for that
;;; Instead this list was COERCEd to a #<FUNCTION ...>!
;;;
;;; Instead, we now use a special sort of "function"-type for that
-;;; information, because the functions slot in SB-C::LEXENV is
+;;; information, because the functions slot in SB!C::LEXENV is
;;; supposed to have a list of <Name MACRO . #<function> elements.
;;; So, now we hide our bits of interest in the walker-info slot in
;;; our new BOGO-FUN.
;;;
;;; supposed to have a list of <Name MACRO . #<function> elements.
;;; So, now we hide our bits of interest in the walker-info slot in
;;; our new BOGO-FUN.
;;;
-;;; MACROEXPAND-1 and SB-INT:EVAL-IN-LEXENV are the only SBCL
+;;; MACROEXPAND-1 and SB!INT:EVAL-IN-LEXENV are the only SBCL
;;; functions that get called with the constructed environment
;;; argument.
;;; functions that get called with the constructed environment
;;; argument.
;; environment. So we just blow it off, 'cause anything real we do
;; would be wrong. But we still have to make an entry so we can tell
;; functions from macros.
;; environment. So we just blow it off, 'cause anything real we do
;; would be wrong. But we still have to make an entry so we can tell
;; functions from macros.
- (let ((lexenv (sb-kernel::coerce-to-lexenv env)))
- (sb-c::make-lexenv
- :default lexenv
- :funs (append (mapcar (lambda (f)
- (cons (car f)
- (sb-c::make-functional :lexenv lexenv)))
- funs)
- (mapcar (lambda (m)
- (list* (car m)
- 'sb-c::macro
- (if (eq (car m)
- *key-to-walker-environment*)
- (walker-info-to-bogo-fun (cadr m))
- (coerce (cadr m) 'function))))
- macros)))))
+ (let ((lexenv (sb!kernel::coerce-to-lexenv env)))
+ (sb!c::make-lexenv
+ :default lexenv
+ :funs (append (mapcar (lambda (f)
+ (cons (car f)
+ (sb!c::make-functional :lexenv lexenv)))
+ funs)
+ (mapcar (lambda (m)
+ (list* (car m)
+ 'sb!c::macro
+ (if (eq (car m)
+ *key-to-walker-environment*)
+ (walker-info-to-bogo-fun (cadr m))
+ (coerce (cadr m) 'function))))
+ macros)))))
(defun environment-function (env fn)
(when env
(defun environment-function (env fn)
(when env
- (let ((entry (assoc fn (sb-c::lexenv-funs env) :test #'equal)))
+ (let ((entry (assoc fn (sb!c::lexenv-funs env) :test #'equal)))
- (sb-c::functional-p (cdr entry))
+ (sb!c::functional-p (cdr entry))
(cdr entry)))))
(defun environment-macro (env macro)
(when env
(cdr entry)))))
(defun environment-macro (env macro)
(when env
- (let ((entry (assoc macro (sb-c::lexenv-funs env) :test #'eq)))
+ (let ((entry (assoc macro (sb!c::lexenv-funs env) :test #'eq)))
- (eq (cadr entry) 'sb-c::macro)
+ (eq (cadr entry) 'sb!c::macro)
(if (eq macro *key-to-walker-environment*)
(values (bogo-fun-to-walker-info (cddr entry)))
(values (function-lambda-expression (cddr entry))))))))
(if (eq macro *key-to-walker-environment*)
(values (bogo-fun-to-walker-info (cddr entry)))
(values (function-lambda-expression (cddr entry))))))))
(defun convert-macro-to-lambda (llist body env &optional (name "dummy macro"))
(let ((gensym (make-symbol name)))
(eval-in-lexenv `(defmacro ,gensym ,llist ,@body)
(defun convert-macro-to-lambda (llist body env &optional (name "dummy macro"))
(let ((gensym (make-symbol name)))
(eval-in-lexenv `(defmacro ,gensym ,llist ,@body)
- (sb-c::make-restricted-lexenv env))
+ (sb!c::make-restricted-lexenv env))
(macro-function gensym)))
\f
;;;; the actual walker
(macro-function gensym)))
\f
;;;; the actual walker
(list
(list *key-to-walker-environment*
(list (if wfnp walk-function (car lock))
(list
(list *key-to-walker-environment*
(list (if wfnp walk-function (car lock))
- (if wfop walk-form (cadr lock))
+ (if wfop walk-form (cadr lock))
(if decp declarations (caddr lock))
(if lexp lexical-variables (cadddr lock)))))))
(if decp declarations (caddr lock))
(if lexp lexical-variables (cadddr lock)))))))
(defun variable-symbol-macro-p (var env)
(let ((entry (member var (env-lexical-variables env) :key #'car)))
(defun variable-symbol-macro-p (var env)
(let ((entry (member var (env-lexical-variables env) :key #'car)))
- (when (eq (cadar entry) 'sb-sys:macro)
+ (when (eq (cadar entry) 'sb!sys:macro)
entry)))
(defvar *var-declarations* '(special))
entry)))
(defvar *var-declarations* '(special))
;;; - Is a common lisp special form (not likely)
;;; - Is not a common lisp special form (on the 3600 IF --> COND).
;;;
;;; - Is a common lisp special form (not likely)
;;; - Is not a common lisp special form (on the 3600 IF --> COND).
;;;
-;;; * We can safe ourselves from this case (second subcase really)
+;;; * We can save ourselves from this case (second subcase really)
;;; by checking to see whether there is a template defined for
;;; something before we check to see whether we can macroexpand it.
;;;
;;; by checking to see whether there is a template defined for
;;; something before we check to see whether we can macroexpand it.
;;;
(define-walker-template unwind-protect (nil return repeat (eval)))
;;; SBCL-only special forms
(define-walker-template unwind-protect (nil return repeat (eval)))
;;; SBCL-only special forms
-(define-walker-template sb-ext:truly-the (nil quote eval))
+(define-walker-template sb!ext:truly-the (nil quote eval))
\f
(defvar *walk-form-expand-macros-p* nil)
\f
(defvar *walk-form-expand-macros-p* nil)
(multiple-value-bind (newnewform macrop)
(walker-environment-bind
(new-env env :walk-form newform)
(multiple-value-bind (newnewform macrop)
(walker-environment-bind
(new-env env :walk-form newform)
- (macroexpand-1 newform new-env))
+ (sb-xc:macroexpand-1 newform new-env))
(cond
(macrop
(let ((newnewnewform (walk-form-internal newnewform
(cond
(macrop
(let ((newnewnewform (walk-form-internal newnewform
;; maintained as part of SBCL, so it should know
;; about all the special forms that SBCL knows
;; about.
;; maintained as part of SBCL, so it should know
;; about all the special forms that SBCL knows
;; about.
- (error "unexpected special form ~S" fn))
+ (bug "unexpected special form ~S" fn))
(t
;; Otherwise, walk the form as if it's just a
;; standard function call using a template for
(t
;; Otherwise, walk the form as if it's just a
;; standard function call using a template for
(null (get-walker-template (car form)))
(progn
(multiple-value-setq (new-form macrop)
(null (get-walker-template (car form)))
(progn
(multiple-value-setq (new-form macrop)
- (macroexpand-1 form env))
+ (sb-xc:macroexpand-1 form env))
macrop))
;; This form was a call to a macro. Maybe it expanded
;; into a declare? Recurse to find out.
macrop))
;; This form was a call to a macro. Maybe it expanded
;; into a declare? Recurse to find out.
:lexical-variables
(append (mapcar (lambda (binding)
`(,(car binding)
:lexical-variables
(append (mapcar (lambda (binding)
`(,(car binding)
- sb-sys:macro . ,(cadr binding)))
+ sb!sys:macro . ,(cadr binding)))
bindings)
(env-lexical-variables old-env)))
(relist* form 'symbol-macrolet bindings
bindings)
(env-lexical-variables old-env)))
(relist* form 'symbol-macrolet bindings
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)