mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

use `dynlet' for dynamic binding

Browse source 
* module/language/elisp/compile-tree-il.scm (let-dynamic): Remove. All
  callers changed to use `dynlet' instead.
This commit is contained in:
BT Templeton 2011-08-08 23:40:07 -04:00
parent c64c51ebb0
commit c7e0d2f81c
1 changed files with 36 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

77
module/language/elisp/compile-tree-il.scm
View file

@ -128,25 +128,6 @@
(generate-ensure-global loc sym mod))) (generate-ensure-global loc sym mod)))
,body))) ,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 ;;; Handle access to a variable (reference/setting) correctly depending
;;; on whether it is currently lexically or dynamically bound. lexical ;;; on whether it is currently lexically or dynamically bound. lexical
;;; access is done only for references to the value-slot module! ;;; access is done only for references to the value-slot module!
@ -344,16 +325,14 @@
(full-body (full-body
(if (null? dynamic) (if (null? dynamic)
tree-il tree-il
(let-dynamic loc (make-dynlet
dynamic-ids loc
value-slot (map (cut make-module-ref loc value-slot <> #t)
(map (cut make-lexical-ref dynamic-ids)
loc (map (cut make-lexical-ref loc <> <>)
<> dynamic-ids
<>) dynamic-vars)
dynamic-ids tree-il))))
dynamic-vars)
tree-il))))
(make-simple-lambda loc (make-simple-lambda loc
meta meta
req-ids req-ids
@ -539,8 +518,17 @@
for))) for)))
(make-body (lambda () (compile-expr `(progn ,@forms))))) (make-body (lambda () (compile-expr `(progn ,@forms)))))
(if (null? lexical) (if (null? lexical)
(let-dynamic loc (map car dynamic) value-slot (make-dynlet loc
(make-values dynamic) (make-body)) (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)) (let* ((lexical-syms (map (lambda (el) (gensym)) lexical))
(dynamic-syms (map (lambda (el) (gensym)) dynamic)) (dynamic-syms (map (lambda (el) (gensym)) dynamic))
(all-syms (append lexical-syms dynamic-syms)) (all-syms (append lexical-syms dynamic-syms))
@ -557,14 +545,22 @@
(lambda () (lambda ()
(if (null? dynamic) (if (null? dynamic)
(make-body) (make-body)
(let-dynamic loc (make-dynlet loc
(map car dynamic) (map
value-slot (compose
(cut make-module-ref
loc
value-slot
<>
#t)
car)
dynamic)
(map (map
(lambda (sym) (lambda (sym)
(make-lexical-ref loc (make-lexical-ref
sym loc
sym)) sym
sym))
dynamic-syms) dynamic-syms)
(make-body))))))))))))))) (make-body)))))))))))))))
@ -595,10 +591,9 @@
`(,sym) `(,sym)
`(,target) `(,target)
(lambda () (iterate (cdr tail)))))) (lambda () (iterate (cdr tail))))))
(let-dynamic loc (make-dynlet loc
`(,(caar tail)) (list (make-module-ref loc value-slot sym #t))
value-slot (list value)
`(,value)
(iterate (cdr tail)))))))))))) (iterate (cdr tail))))))))))))
(defspecial flet (loc args) (defspecial flet (loc args)