1
Fork 0
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:
Robin Templeton 2014-08-04 23:16:09 -04:00 committed by Christine Lemmer-Webber
parent e07e9a0962
commit cd630c1f38
No known key found for this signature in database
GPG key ID: 4BC025925FF8F4D3

View file

@ -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))