diff options
author | Daniel Kraft <d@domob.eu> | 2009-08-04 09:23:02 +0200 |
---|---|---|
committer | Daniel Kraft <d@domob.eu> | 2009-08-04 09:23:02 +0200 |
commit | 1b1195f29bd73885bcd9fd77e9b2dae0dfa003c0 (patch) | |
tree | d5a8cfe5a1255df037e306438515c851dbdfde3c | |
parent | f4dc86f137711fcc855ab60ea803eb2bb852b971 (diff) | |
download | guile-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.scm | 22 | ||||
-rw-r--r-- | module/language/elisp/compile-tree-il.scm | 105 |
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)) |