summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/language/elisp/compile-tree-il.scm77
1 files changed, 36 insertions, 41 deletions
diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm
index 3a95ecd10..3b36cc88b 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -128,25 +128,6 @@
(generate-ensure-global loc sym mod)))
,body)))
-;;; Build a construct that establishes dynamic bindings for certain
-;;; variables. We may want to choose between binding with fluids and
-;;; with-fluids* and using just ordinary module symbols and
-;;; setting/reverting their values with a dynamic-wind.
-
-(define (let-dynamic loc syms module vals body)
- (call-primitive
- loc
- 'with-fluids*
- (make-application loc
- (make-primitive-ref loc 'list)
- (map (lambda (sym)
- (make-module-ref loc module sym #t))
- syms))
- (make-application loc (make-primitive-ref loc 'list) vals)
- (make-lambda loc
- '()
- (make-lambda-case #f '() #f #f #f '() '() body #f))))
-
;;; Handle access to a variable (reference/setting) correctly depending
;;; on whether it is currently lexically or dynamically bound. lexical
;;; access is done only for references to the value-slot module!
@@ -344,16 +325,14 @@
(full-body
(if (null? dynamic)
tree-il
- (let-dynamic loc
- dynamic-ids
- value-slot
- (map (cut make-lexical-ref
- loc
- <>
- <>)
- dynamic-ids
- dynamic-vars)
- tree-il))))
+ (make-dynlet
+ loc
+ (map (cut make-module-ref loc value-slot <> #t)
+ dynamic-ids)
+ (map (cut make-lexical-ref loc <> <>)
+ dynamic-ids
+ dynamic-vars)
+ tree-il))))
(make-simple-lambda loc
meta
req-ids
@@ -539,8 +518,17 @@
for)))
(make-body (lambda () (compile-expr `(progn ,@forms)))))
(if (null? lexical)
- (let-dynamic loc (map car dynamic) value-slot
- (make-values dynamic) (make-body))
+ (make-dynlet loc
+ (map (compose (cut make-module-ref
+ loc
+ value-slot
+ <>
+ #t)
+ car)
+ dynamic)
+ (map (compose compile-expr cdr)
+ dynamic)
+ (make-body))
(let* ((lexical-syms (map (lambda (el) (gensym)) lexical))
(dynamic-syms (map (lambda (el) (gensym)) dynamic))
(all-syms (append lexical-syms dynamic-syms))
@@ -557,14 +545,22 @@
(lambda ()
(if (null? dynamic)
(make-body)
- (let-dynamic loc
- (map car dynamic)
- value-slot
+ (make-dynlet loc
+ (map
+ (compose
+ (cut make-module-ref
+ loc
+ value-slot
+ <>
+ #t)
+ car)
+ dynamic)
(map
(lambda (sym)
- (make-lexical-ref loc
- sym
- sym))
+ (make-lexical-ref
+ loc
+ sym
+ sym))
dynamic-syms)
(make-body)))))))))))))))
@@ -595,10 +591,9 @@
`(,sym)
`(,target)
(lambda () (iterate (cdr tail))))))
- (let-dynamic loc
- `(,(caar tail))
- value-slot
- `(,value)
+ (make-dynlet loc
+ (list (make-module-ref loc value-slot sym #t))
+ (list value)
(iterate (cdr tail))))))))))))
(defspecial flet (loc args)