[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, elisp, updated. release_1-9-1-69-g1b11
|
From: |
Daniel Kraft |
|
Subject: |
[Guile-commits] GNU Guile branch, elisp, updated. release_1-9-1-69-g1b1195f |
|
Date: |
Tue, 04 Aug 2009 07:36:53 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1b1195f29bd73885bcd9fd77e9b2dae0dfa003c0
The branch, elisp has been updated
via 1b1195f29bd73885bcd9fd77e9b2dae0dfa003c0 (commit)
via f4dc86f137711fcc855ab60ea803eb2bb852b971 (commit)
from dfbc6e9d5415def4cf61c9caa9f44af056348741 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 1b1195f29bd73885bcd9fd77e9b2dae0dfa003c0
Author: Daniel Kraft <address@hidden>
Date: Tue Aug 4 09:23:02 2009 +0200
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'.
commit f4dc86f137711fcc855ab60ea803eb2bb852b971
Author: Daniel Kraft <address@hidden>
Date: Mon Aug 3 18:22:12 2009 +0200
Implement catch and unwind-protect as macros.
* module/language/elisp/compile-tree-il.scm: Remove catch and
unwind-protect.
* module/language/elisp/runtime/macro-slot.scm: Re-implement them here.
-----------------------------------------------------------------------
Summary of changes:
module/language/elisp/bindings.scm | 22 ++--
module/language/elisp/compile-tree-il.scm | 155 +++++++++-----------------
module/language/elisp/runtime/macro-slot.scm | 41 +++++++
3 files changed, 105 insertions(+), 113 deletions(-)
diff --git a/module/language/elisp/bindings.scm
b/module/language/elisp/bindings.scm
index 228a746..c7937b3 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 d079d05..e88ac17 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
@@ -755,6 +750,9 @@
; (iterate))
; %nil))))
; (iterate))
+ ;
+ ; As letrec is not directly accessible from elisp, while is implemented
here
+ ; instead of with a macro.
((while ,condition . ,body)
(let* ((itersym (gensym))
(compiled-body (map compile-expr body))
@@ -771,53 +769,6 @@
(make-letrec loc '(iterate) (list itersym) (list iter-thunk)
iter-call)))
- ; catch and throw can mainly be implemented directly using Guile's
- ; primitives for exceptions, the only difficulty is that the keys used
- ; within Guile must be symbols, while elisp allows any value and checks
- ; for matches using eq (eq?). We handle this by using always #t as key
- ; for the Guile primitives and check for matches inside the handler; if
- ; the elisp keys are not eq?, we rethrow the exception.
- ;
- ; TODO: Implement catch with a macro once we can build the lambda with
- ; lexical arguments.
- ;
- ; throw is implemented as built-in function.
-
- ((catch ,tag . ,body) (guard (not (null? body)))
- (let* ((tag-value (gensym))
- (tag-ref (make-lexical-ref loc tag-value tag-value)))
- (make-let loc `(,tag-value) `(,tag-value) `(,(compile-expr tag))
- (call-primitive loc 'catch
- (make-const loc #t)
- (make-lambda loc '() '() '()
- (make-sequence loc (map compile-expr body)))
- (let* ((dummy-key (gensym))
- (dummy-ref (make-lexical-ref loc dummy-key dummy-key))
- (elisp-key (gensym))
- (key-ref (make-lexical-ref loc elisp-key elisp-key))
- (value (gensym))
- (value-ref (make-lexical-ref loc value value))
- (arglist `(,dummy-key ,elisp-key ,value)))
- (make-lambda loc arglist arglist '()
- (make-conditional loc
- (call-primitive loc 'eq? key-ref tag-ref)
- value-ref
- (call-primitive loc 'throw
- dummy-ref key-ref value-ref))))))))
-
- ; unwind-protect is just some weaker construct as dynamic-wind, so
- ; straight-forward to implement.
- ; TODO: This might be implemented as a macro, once lambda's without
- ; arguments do not call with-fluids* anymore.
- ((unwind-protect ,body . ,clean-ups) (guard (not (null? clean-ups)))
- (call-primitive loc 'dynamic-wind
- (make-lambda loc '() '() '() (make-void loc))
- (make-lambda loc '() '() '()
- (compile-expr body))
- (make-lambda loc '() '() '()
- (make-sequence loc
- (map compile-expr clean-ups)))))
-
; Either (lambda ...) or (function (lambda ...)) denotes a
lambda-expression
; that should be compiled.
((lambda ,args . ,body)
@@ -915,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
@@ -927,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))
diff --git a/module/language/elisp/runtime/macro-slot.scm
b/module/language/elisp/runtime/macro-slot.scm
index 5a308a1..2017fd4 100644
--- a/module/language/elisp/runtime/macro-slot.scm
+++ b/module/language/elisp/runtime/macro-slot.scm
@@ -152,6 +152,47 @@
'())))))))))
+; Exception handling. unwind-protect and catch are implemented as macros
(throw
+; is a built-in function).
+
+; catch and throw can mainly be implemented directly using Guile's
+; primitives for exceptions, the only difficulty is that the keys used
+; within Guile must be symbols, while elisp allows any value and checks
+; for matches using eq (eq?). We handle this by using always #t as key
+; for the Guile primitives and check for matches inside the handler; if
+; the elisp keys are not eq?, we rethrow the exception.
+(built-in-macro catch
+ (lambda (tag . body)
+ (if (null? body)
+ (macro-error "catch with empty body"))
+ (let ((tagsym (gensym)))
+ `(lexical-let ((,tagsym ,tag))
+ ((guile-primitive catch)
+ #t
+ (lambda () ,@body)
+ ,(let* ((dummy-key (gensym))
+ (elisp-key (gensym))
+ (value (gensym))
+ (arglist `(,dummy-key ,elisp-key ,value)))
+ `(with-always-lexical ,arglist
+ (lambda ,arglist
+ (if (eq ,elisp-key ,tagsym)
+ ,value
+ ((guile-primitive throw) ,dummy-key ,elisp-key
+ ,value))))))))))
+
+; unwind-protect is just some weaker construct as dynamic-wind, so
+; straight-forward to implement.
+(built-in-macro unwind-protect
+ (lambda (body . clean-ups)
+ (if (null? clean-ups)
+ (macro-error "unwind-protect without cleanup code"))
+ `((guile-primitive dynamic-wind)
+ (lambda () nil)
+ (lambda () ,body)
+ (lambda () ,@clean-ups))))
+
+
; Pop off the first element from a list or push one to it.
(built-in-macro pop
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, elisp, updated. release_1-9-1-69-g1b1195f,
Daniel Kraft <=