diff options
author | Robin Templeton <robin@terpri.org> | 2014-08-04 23:16:09 -0400 |
---|---|---|
committer | Christopher Allan Webber <cwebber@dustycloud.org> | 2016-03-25 12:00:13 -0700 |
commit | d9284d3bcde1cd3bdc69e99751427d65bd8463b0 (patch) | |
tree | 40a40ce869eb5bfff4de93e0c5166f94d46bdce8 | |
parent | 3587fb1a9e0ae8b066c44d2f3f8739d85a1e68c0 (diff) | |
download | guile-d9284d3bcde1cd3bdc69e99751427d65bd8463b0.tar.gz |
eval-when
(Best-ability ChangeLog annotation added by Christopher Allan Webber.)
* module/language/elisp/compile-tree-il.scm (progn): Use compile-expr-1
instead of compile-expr.
(toplevel?, compile-time-too?): New fluids.
(eval-when): New special form.
(compile-expr, compile-expr-1): compile-expr is renamed to
compile-expr-1, and compile-expr is now a procedure which, if
fulid-ref of toplevel? is true, will call compile-expr-1 with
toplevel? fulid bound to #f. Otherwise, continue with compile-expr-1.
(compile-tree-il): Set toplevel? and compile-time-too? fluids to #t
during evaluation.
-rw-r--r-- | module/language/elisp/compile-tree-il.scm | 45 |
1 files changed, 41 insertions, 4 deletions
diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index 87ee48670..66247a49b 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -459,11 +459,40 @@ (list->seq loc (if (null? args) (list (nil-value loc)) - (map compile-expr args)))) + (map compile-expr-1 args)))) (defspecial eval-when-compile (loc args) (make-const loc (compile `(progn ,@args) #:from 'elisp #:to 'value))) +(define toplevel? (make-fluid)) + +(define compile-time-too? (make-fluid)) + +(defspecial eval-when (loc args) + (pmatch args + ((,situations . ,forms) + (let ((compile? (memq ':compile-toplevel situations)) + (load? (memq ':load-toplevel situations)) + (execute? (memq ':execute situations))) + (cond + ((not (fluid-ref toplevel?)) + (if execute? + (compile-expr `(progn ,@forms)) + (make-const loc #nil))) + (load? + (with-fluids ((compile-time-too? + (cond (compile? #t) + (execute? (fluid-ref compile-time-too?)) + (else #f)))) + (when (fluid-ref compile-time-too?) + (eval-elisp `(progn ,@forms))) + (compile-expr-1 `(progn ,@forms)))) + ((or compile? (and execute? (fluid-ref compile-time-too?))) + (eval-elisp `(progn ,@forms)) + (make-const loc #nil)) + (else + (make-const loc #nil))))))) + (defspecial if (loc args) (pmatch args ((,cond ,then . ,else) @@ -820,7 +849,7 @@ ;;; Compile a single expression to TreeIL. -(define (compile-expr expr) +(define (compile-expr-1 expr) (let ((loc (location expr))) (cond ((symbol? expr) @@ -829,9 +858,17 @@ (compile-pair loc expr)) (else (make-const loc expr))))) +(define (compile-expr expr) + (if (fluid-ref toplevel?) + (with-fluids ((toplevel? #f)) + (compile-expr-1 expr)) + (compile-expr-1 expr))) + (define (compile-tree-il expr env opts) (values - (with-fluids ((bindings-data (make-bindings))) - (compile-expr expr)) + (with-fluids ((bindings-data (make-bindings)) + (toplevel? #t) + (compile-time-too? #f)) + (compile-expr-1 expr)) env env)) |