Add eval-when special form
authorDavid Vázquez <davazp@gmail.com>
Thu, 29 Aug 2013 16:08:06 +0000 (18:08 +0200)
committerDavid Vázquez <davazp@gmail.com>
Thu, 29 Aug 2013 16:28:24 +0000 (18:28 +0200)
src/compiler/compiler.lisp

index 73223aa..0ec5fea 100644 (file)
 ;;; function call.
 (defvar *multiple-value-p* nil)
 
 ;;; function call.
 (defvar *multiple-value-p* nil)
 
+;;; It is bound dinamically to the number of nested calls to
+;;; `convert'. Therefore, a form is being compiled as toplevel if it
+;;; is zero.
+(defvar *convert-level* -1)
+
+
 ;;; Environment
 
 (def!struct binding
 ;;; Environment
 
 (def!struct binding
       ,(convert-block body t))))
 
 
       ,(convert-block body t))))
 
 
+;;; Was the compiler invoked from !compile-file?
 (defvar *compiling-file* nil)
 (defvar *compiling-file* nil)
+
+;;; NOTE: It is probably wrong in many cases but we will not use this
+;;; heavily. Please, do not rely on wrong cases of this
+;;; implementation.
+(define-compilation eval-when (situations &rest body)
+  ;; TODO: Error checking
+  (cond
+    ;; Toplevel form compiled by !compile-file.
+    ((and *compiling-file* (zerop *convert-level*))
+     ;; If the situation `compile-toplevel' is given. The form is
+     ;; evaluated at compilation-time.
+     (when (find :compile-toplevel situations)
+       (eval (cons 'progn body)))
+     ;; `load-toplevel' is given, then just compile the subforms as usual.
+     (if (find :load-toplevel situations)
+         (convert `(progn ,@body))))
+    ((find :execute situations)
+     (convert `(progn ,@body) *multiple-value-p*))
+    (t
+     (convert nil))))
+
 (define-compilation eval-when-compile (&rest body)
   (if *compiling-file*
       (progn
 (define-compilation eval-when-compile (&rest body)
   (if *compiling-file*
       (progn
     (when expandedp
       (return-from convert (convert sexp multiple-value-p)))
     ;; The expression has been macroexpanded. Now compile it!
     (when expandedp
       (return-from convert (convert sexp multiple-value-p)))
     ;; The expression has been macroexpanded. Now compile it!
-    (let ((*multiple-value-p* multiple-value-p))
+    (let ((*multiple-value-p* multiple-value-p)
+          (*convert-level* (1+ *convert-level*)))
       (cond
         ((symbolp sexp)
          (let ((b (lookup-in-lexenv sexp *environment* 'variable)))
       (cond
         ((symbolp sexp)
          (let ((b (lookup-in-lexenv sexp *environment* 'variable)))