summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Kraft <d@domob.eu>2009-08-04 09:23:02 +0200
committerDaniel Kraft <d@domob.eu>2009-08-04 09:23:02 +0200
commit1b1195f29bd73885bcd9fd77e9b2dae0dfa003c0 (patch)
treed5a8cfe5a1255df037e306438515c851dbdfde3c
parentf4dc86f137711fcc855ab60ea803eb2bb852b971 (diff)
downloadguile-1b1195f29bd73885bcd9fd77e9b2dae0dfa003c0.tar.gz
Abstracted dynamic binding a little off the fluids.
* module/language/elisp/compile-tree-il.scm: Move dynamic binding to one place and changed names that refer to `fluids' for dynamic binding. * module/language/elisp/bindings.scm: Changed names referring to `fluids'.
-rw-r--r--module/language/elisp/bindings.scm22
-rw-r--r--module/language/elisp/compile-tree-il.scm105
2 files changed, 61 insertions, 66 deletions
diff --git a/module/language/elisp/bindings.scm b/module/language/elisp/bindings.scm
index 228a746a8..c7937b333 100644
--- a/module/language/elisp/bindings.scm
+++ b/module/language/elisp/bindings.scm
@@ -21,15 +21,15 @@
(define-module (language elisp bindings)
#:export (make-bindings
- mark-fluid-needed! map-fluids-needed
+ mark-global-needed! map-globals-needed
with-lexical-bindings with-dynamic-bindings
get-lexical-binding))
; This module defines routines to handle analysis of symbol bindings used
; during elisp compilation. This data allows to collect the symbols, for
-; which fluids need to be created, or mark certain symbols as lexically bound.
+; which globals need to be created, or mark certain symbols as lexically bound.
-; Needed fluids are stored in an association-list that stores a list of fluids
+; Needed globals are stored in an association-list that stores a list of symbols
; for each module they are needed in.
; The lexical bindings of symbols are stored in a hash-table that associates
@@ -42,7 +42,7 @@
(define bindings-type
(make-record-type 'bindings
- '(needed-fluids lexical-bindings)))
+ '(needed-globals lexical-bindings)))
; Construct an 'empty' instance of the bindings data structure to be used
@@ -52,23 +52,23 @@
((record-constructor bindings-type) '() (make-hash-table)))
-; Mark that a given symbol is needed as fluid in the specified slot-module.
+; Mark that a given symbol is needed as global in the specified slot-module.
-(define (mark-fluid-needed! bindings sym module)
- (let* ((old-needed ((record-accessor bindings-type 'needed-fluids) bindings))
+(define (mark-global-needed! bindings sym module)
+ (let* ((old-needed ((record-accessor bindings-type 'needed-globals) bindings))
(old-in-module (or (assoc-ref old-needed module) '()))
(new-in-module (if (memq sym old-in-module)
old-in-module
(cons sym old-in-module)))
(new-needed (assoc-set! old-needed module new-in-module)))
- ((record-modifier bindings-type 'needed-fluids) bindings new-needed)))
+ ((record-modifier bindings-type 'needed-globals) bindings new-needed)))
-; Cycle through all fluids needed in order to generate the code for their
+; Cycle through all globals needed in order to generate the code for their
; creation or some other analysis.
-(define (map-fluids-needed bindings proc)
- (let ((needed ((record-accessor bindings-type 'needed-fluids) bindings)))
+(define (map-globals-needed bindings proc)
+ (let ((needed ((record-accessor bindings-type 'needed-globals) bindings)))
(let iterate-modules ((mod-tail needed)
(mod-result '()))
(if (null? mod-tail)
diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm
index 15cc51381..e88ac17b4 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -104,12 +104,12 @@
(cons (make-const loc msg) args)))
-; Generate code to ensure a fluid is there for further use of a given symbol.
-; In general during the compilation, fluids needed are only tracked with the
-; bindings data structure. Afterwards, however, for all those needed symbols
-; the fluids are really generated with this routine.
+; Generate code to ensure a global symbol is there for further use of a given
+; symbol. In general during the compilation, those needed are only tracked with
+; the bindings data structure. Afterwards, however, for all those needed
+; symbols the globals are really generated with this routine.
-(define (generate-ensure-fluid loc sym module)
+(define (generate-ensure-global loc sym module)
(make-application loc (make-module-ref loc runtime 'ensure-fluid! #t)
(list (make-const loc module)
(make-const loc sym))))
@@ -126,6 +126,21 @@
(not (memq sym disabled))))))
+; 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 '() '() '() body)))
+
+
; 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!
@@ -146,7 +161,7 @@
(lambda (lexical)
(make-lexical-ref loc lexical lexical))
(lambda ()
- (mark-fluid-needed! (fluid-ref bindings-data) sym module)
+ (mark-global-needed! (fluid-ref bindings-data) sym module)
(call-primitive loc 'fluid-ref
(make-module-ref loc module sym #t)))))
@@ -175,7 +190,7 @@
(lambda (lexical)
(make-lexical-set loc lexical lexical value))
(lambda ()
- (mark-fluid-needed! (fluid-ref bindings-data) sym module)
+ (mark-global-needed! (fluid-ref bindings-data) sym module)
(call-primitive loc 'fluid-set!
(make-module-ref loc module sym #t)
value))))
@@ -226,13 +241,13 @@
; and flet/flet*, just with a different bindings module.
;
; A special module value 'lexical means that we're doing a lexical-let instead
-; and the bindings should not be safed to fluids at all but be done with the
+; and the bindings should not be saved to globals at all but be done with the
; lexical framework instead.
-; Let is done with a single call to with-fluids* binding them locally to new
+; Let is done with a single call to let-dynamic binding them locally to new
; values all "at once". If there is at least one variable to bind lexically
; among the bindings, we first do a let for all of them to evaluate all
-; values before any bindings take place, and then call with-fluids* for the
+; values before any bindings take place, and then call let-dynamic for the
; variables to bind dynamically.
(define (generate-let loc module bindings body)
(let ((bind (process-let-bindings loc bindings)))
@@ -241,24 +256,17 @@
(split-let-bindings bind module))
(lambda (lexical dynamic)
(for-each (lambda (sym)
- (mark-fluid-needed! (fluid-ref bindings-data) sym module))
+ (mark-global-needed! (fluid-ref bindings-data) sym module))
(map car dynamic))
- (let ((fluids (make-application loc (make-primitive-ref loc 'list)
- (map (lambda (el)
- (make-module-ref loc module (car el) #t))
- dynamic)))
- (make-values (lambda (for)
+ (let ((make-values (lambda (for)
(map (lambda (el)
(compile-expr (cdr el)))
for)))
(make-body (lambda ()
(make-sequence loc (map compile-expr body)))))
(if (null? lexical)
- (call-primitive loc 'with-fluids*
- fluids
- (make-application loc (make-primitive-ref loc 'list)
- (make-values dynamic))
- (make-lambda loc '() '() '() (make-body)))
+ (let-dynamic loc (map car dynamic) module
+ (make-values 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))
@@ -269,12 +277,11 @@
(lambda ()
(if (null? dynamic)
(make-body)
- (call-primitive loc 'with-fluids*
- fluids
- (make-application loc (make-primitive-ref loc 'list)
- (map (lambda (sym) (make-lexical-ref loc sym sym))
- dynamic-syms))
- (make-lambda loc '() '() '() (make-body))))))))))))))
+ (let-dynamic loc (map car dynamic) module
+ (map (lambda (sym)
+ (make-lexical-ref loc sym sym))
+ dynamic-syms)
+ (make-body)))))))))))))
; Let* is compiled to a cascaded set of "small lets" for each binding in turn
@@ -284,7 +291,7 @@
(begin
(for-each (lambda (sym)
(if (not (bind-lexically? sym module))
- (mark-fluid-needed! (fluid-ref bindings-data) sym module)))
+ (mark-global-needed! (fluid-ref bindings-data) sym module)))
(map car bind))
(let iterate ((tail bind))
(if (null? tail)
@@ -298,9 +305,9 @@
`(,sym) `(,target)
(lambda ()
(iterate (cdr tail))))))
- (call-primitive loc 'with-fluid*
- (make-module-ref loc module (caar tail) #t) value
- (make-lambda loc '() '() '() (iterate (cdr tail)))))))))))
+ (let-dynamic loc
+ `(,(caar tail)) module `(,value)
+ (iterate (cdr tail))))))))))
; Split the argument list of a lambda expression into required, optional and
@@ -399,7 +406,7 @@
; Another thing we have to be aware of is that lambda arguments are usually
; dynamically bound, even when a lexical binding is in tact for a symbol.
; For symbols that are marked as 'always lexical' however, we bind them here
-; lexically, too -- and thus we get them out of the with-fluids* call and
+; lexically, too -- and thus we get them out of the let-dynamic call and
; register a lexical binding for them (the lexical target variable is already
; there, namely the real lambda argument from TreeIL).
; For optional arguments that are lexically bound we need to create the lexical
@@ -439,8 +446,8 @@
(all-lex-pairs (append required-lex-pairs optional-lex-pairs
rest-pair)))
(for-each (lambda (sym)
- (mark-fluid-needed! (fluid-ref bindings-data)
- sym value-slot))
+ (mark-global-needed! (fluid-ref bindings-data)
+ sym value-slot))
dynamic)
(with-dynamic-bindings (fluid-ref bindings-data) dynamic
(lambda ()
@@ -450,10 +457,7 @@
(lambda ()
(make-lambda loc
arg-names real-args '()
- (let* ((fluids (map (lambda (sym)
- (make-module-ref loc value-slot sym #t))
- dynamic))
- (init-req (map (lambda (name-sym)
+ (let* ((init-req (map (lambda (name-sym)
(make-lexical-ref loc (car name-sym)
(cdr name-sym)))
(find-required-pairs dynamic)))
@@ -468,18 +472,9 @@
,(process-rest loc rest
rest-name rest-sym)
,@(map compile-expr body))))
- (with-fluids-call (call-primitive loc 'with-fluids*
- (make-application loc
- (make-primitive-ref loc 'list)
- fluids)
- (make-application loc
- (make-primitive-ref loc 'list)
- init)
- (make-lambda loc '() '() '()
- func-body)))
- (full-body (if (null? dynamic)
- func-body
- with-fluids-call)))
+ (dynlet (let-dynamic loc dynamic value-slot
+ init func-body))
+ (full-body (if (null? dynamic) func-body dynlet)))
(if (null? optional-sym)
full-body
(make-let loc
@@ -871,8 +866,8 @@
; Entry point for compilation to TreeIL.
; This creates the bindings data structure, and after compiling the main
-; expression we need to make sure all fluids for symbols used during the
-; compilation are created using the generate-ensure-fluid function.
+; expression we need to make sure all globals for symbols used during the
+; compilation are created using the generate-ensure-global function.
(define (compile-tree-il expr env opts)
(values
@@ -883,9 +878,9 @@
(let ((loc (location expr))
(compiled (compile-expr expr)))
(make-sequence loc
- `(,@(map-fluids-needed (fluid-ref bindings-data)
- (lambda (mod sym)
- (generate-ensure-fluid loc sym mod)))
+ `(,@(map-globals-needed (fluid-ref bindings-data)
+ (lambda (mod sym)
+ (generate-ensure-global loc sym mod)))
,compiled))))
env
env))