summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRobin Templeton <robin@terpri.org>2014-08-04 23:16:09 -0400
committerChristopher Allan Webber <cwebber@dustycloud.org>2016-03-25 12:00:13 -0700
commitd9284d3bcde1cd3bdc69e99751427d65bd8463b0 (patch)
tree40a40ce869eb5bfff4de93e0c5166f94d46bdce8
parent3587fb1a9e0ae8b066c44d2f3f8739d85a1e68c0 (diff)
downloadguile-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.scm45
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))