From 259f6aaee78865c11889b9b83f3306192fee6bd9 Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Thu, 29 Aug 2013 18:08:06 +0200 Subject: [PATCH] Add eval-when special form --- src/compiler/compiler.lisp | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/src/compiler/compiler.lisp b/src/compiler/compiler.lisp index 73223aa..0ec5fea 100644 --- a/src/compiler/compiler.lisp +++ b/src/compiler/compiler.lisp @@ -42,6 +42,12 @@ ;;; 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 @@ -578,7 +584,29 @@ ,(convert-block body t)))) +;;; Was the compiler invoked from !compile-file? (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 @@ -1361,7 +1389,8 @@ (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))) -- 1.7.10.4