(make-pathname :type type :directory directory :defaults defaults)
(make-pathname :directory directory :defaults defaults)))
+;;; BOOTSTRAP MAGIC: We record the macro definitions as lists during
+;;; the bootstrap. Once everything is compiled, we want to dump the
+;;; whole global environment to the output file to reproduce it in the
+;;; run-time. However, the environment must contain expander functions
+;;; rather than lists. We do not know how to dump function objects
+;;; itself, so we mark the list definitions with this object and the
+;;; compiler will be called when this object has to be dumped.
+;;; Backquote/unquote does a similar magic, but this use is exclusive.
+;;;
+;;; Indeed, perhaps to compile the object other macros need to be
+;;; evaluated. For this reason we define a valid macro-function for
+;;; this symbol.
+(defvar *magic-unquote-marker* (gensym "MAGIC-UNQUOTE"))
+(setf (macro-function *magic-unquote-marker*)
+ (lambda (form env)
+ (declare (ignore env))
+ (second form)))
+
;;; Compile jscl into the host
(with-compilation-unit ()
(dolist (input *source*)
(when (plusp (length compilation))
(write-string compilation out)))))))
-
(defun dump-global-environment (stream)
(flet ((late-compile (form)
(write-string (ls-compile-toplevel form) stream)))
;; for the compiler and it can be dumped.
(dolist (b (lexenv-function *environment*))
(when (eq (binding-type b) 'macro)
- (push *magic-unquote-marker* (binding-value b))))
+ (setf (binding-value b) `(,*magic-unquote-marker* ,(binding-value b)))))
(late-compile `(setq *environment* ',*environment*))
;; Set some counter variable properly, so user compiled code will
;; not collide with the compiler itself.
;;; to the compiler to be able to run.
(eval-when-compile
- (%compile-defmacro 'defmacro
- '(function
- (lambda (name args &rest body)
- `(eval-when-compile
- (%compile-defmacro ',name
- '(function
- (lambda ,(mapcar #'(lambda (x)
- (if (eq x '&body)
- '&rest
- x))
- args)
- ,@body))))))))
+ (let ((defmacro-macroexpander
+ '#'(lambda (form)
+ (destructuring-bind (name args &body body)
+ form
+ (let ((whole (gensym)))
+ `(eval-when-compile
+ (%compile-defmacro ',name
+ '#'(lambda (,whole)
+ (destructuring-bind ,args ,whole
+ ,@body)))))))))
+ (%compile-defmacro 'defmacro defmacro-macroexpander)))
(defmacro declaim (&rest decls)
`(eval-when-compile
(defvar *literal-table* nil)
(defvar *literal-counter* 0)
-;;; BOOTSTRAP MAGIC: During bootstrap, we record the macro definitions
-;;; as lists. Once everything is compiled, we want to dump the whole
-;;; global environment to the output file to reproduce it in the
-;;; run-time. However, the environment must contain expander functions
-;;; rather than lists. We do not know how to dump function objects
-;;; itself, so we mark the definitions with this object and the
-;;; compiler will be called when this object has to be dumped.
-;;; Backquote/unquote does a similar magic, but this use is exclusive.
-(defvar *magic-unquote-marker* (gensym "MAGIC-UNQUOTE"))
-
(defun genlit ()
(code "l" (incf *literal-counter*)))
(symbol (dump-symbol sexp))
(string (dump-string sexp))
(cons
+ ;; BOOTSTRAP MAGIC: See the root file
+ ;; jscl.lisp and the function
+ ;; `dump-global-environment' for futher
+ ;; information.
(if (eq (car sexp) *magic-unquote-marker*)
- (ls-compile (cdr sexp))
+ (ls-compile (second sexp))
(dump-cons sexp)))
(array (dump-array sexp)))))
(if (and recursive (not (symbolp sexp)))
((and (consp form) (symbolp (car form)))
(let ((macrofun (!macro-function (car form))))
(if macrofun
- (values (apply macrofun (cdr form)) t)
+ (values (funcall macrofun (cdr form)) t)
(values form nil))))
(t
(values form nil))))
(unless (consp tail)
(error "Odd number of keyword arguments.")))))
-(defmacro !destructuring-bind (lambda-list expression &body body)
+(defun !destructuring-bind-macro-function (lambda-list expression &rest body)
(multiple-value-bind (d-ll)
(parse-destructuring-lambda-list lambda-list)
(let ((bindings '()))
- (labels (;; Return a chain of the form (CAR (CDR (CDR ... (CDR X))),
+ (labels ( ;; Return a chain of the form (CAR (CDR (CDR ... (CDR X))),
;; such that there are N calls to CDR.
(nth-chain (x n &optional tail)
(if tail
,@body)))))))
+;;; Because DEFMACRO uses destructuring-bind to parse the arguments of
+;;; the macro-function, we can't define DESTRUCTURING-BIND with
+;;; defmacro to avoid a circularity. So just define the macro function
+;;; explicitly.
+
+#+common-lisp
+(defmacro !destructuring-bind (lambda-list expression &body body)
+ (apply #'!destructuring-bind-macro-function lambda-list expression body))
+
#+jscl
-(defmacro destructuring-bind (lambda-list expression &body body)
- `(!destructuring-bind ,lambda-list ,expression ,@body))
+(eval-when-compile
+ (let ((macroexpander
+ '#'(lambda (form &optional environment)
+ (declare (ignore environment))
+ (apply #'!destructuring-bind-macro-function form))))
+ (%compile-defmacro '!destructuring-bind macroexpander)
+ (%compile-defmacro 'destructuring-bind macroexpander)))
projects / jscl.git / commitdiff