mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-05 03:30:24 +02:00
eval-when
(Best-ability ChangeLog annotation added by Christine Lemmer-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.
This commit is contained in:
parent
e07e9a0962
commit
cd630c1f38
1 changed files with 41 additions and 4 deletions
|
@ -461,13 +461,42 @@
|
|||
(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 (with-native-target
|
||||
(lambda ()
|
||||
(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)
|
||||
|
@ -826,7 +855,7 @@
|
|||
|
||||
;;; Compile a single expression to TreeIL.
|
||||
|
||||
(define (compile-expr expr)
|
||||
(define (compile-expr-1 expr)
|
||||
(let ((loc (location expr)))
|
||||
(cond
|
||||
((symbol? expr)
|
||||
|
@ -835,9 +864,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))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue