summaryrefslogtreecommitdiff
path: root/module/language/elisp
diff options
context:
space:
mode:
authorBT Templeton <bpt@hcoop.net>2011-08-08 20:47:03 -0400
committerBT Templeton <bpt@hcoop.net>2012-02-03 18:53:50 -0500
commitc64c51ebb09e305e80a13a872a23197b39453f21 (patch)
tree6bfa41d968884024ddff875ca73f0913c3bdfa5f /module/language/elisp
parent6bb004c435441552c29e1c29d0ba5cca328d038b (diff)
downloadguile-c64c51ebb09e305e80a13a872a23197b39453f21.tar.gz
inline `generate-let' and `generate-let*'
* module/language/elisp/compile-tree-il.scm (generate-let, compile-let): Inline the former into the latter. (generate-let*, compile-let*): Likewise.
Diffstat (limited to 'module/language/elisp')
-rw-r--r--module/language/elisp/compile-tree-il.scm176
1 files changed, 79 insertions, 97 deletions
diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm
index 6cf223f71..3a95ecd10 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -268,90 +268,6 @@
(receive (decls intspec doc body) (parse-body-1 body #f)
(values decls body)))
-;;; 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
-;;; let-dynamic for the variables to bind dynamically.
-
-(define (generate-let loc module bindings body)
- (receive (decls forms) (parse-body body)
- (receive (lexical dynamic)
- (partition (compose (cut bind-lexically? <> module decls)
- car)
- bindings)
- (for-each (lambda (sym)
- (mark-global! (fluid-ref bindings-data)
- sym
- module))
- (map car dynamic))
- (let ((make-values (lambda (for)
- (map (lambda (el) (compile-expr (cdr el)))
- for)))
- (make-body (lambda () (compile-expr `(progn ,@forms)))))
- (if (null? lexical)
- (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))
- (vals (append (make-values lexical)
- (make-values dynamic))))
- (make-let loc
- all-syms
- all-syms
- vals
- (with-lexical-bindings
- (fluid-ref bindings-data)
- (map car lexical) lexical-syms
- (lambda ()
- (if (null? dynamic)
- (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 so that each one already sees the preceding bindings.
-
-(define (generate-let* loc module bindings body)
- (receive (decls forms) (parse-body body)
- (begin
- (for-each (lambda (sym)
- (if (not (bind-lexically? sym module decls))
- (mark-global! (fluid-ref bindings-data)
- sym
- module)))
- (map car bindings))
- (let iterate ((tail bindings))
- (if (null? tail)
- (compile-expr `(progn ,@forms))
- (let ((sym (caar tail))
- (value (compile-expr (cdar tail))))
- (if (bind-lexically? sym module decls)
- (let ((target (gensym)))
- (make-let loc
- `(,target)
- `(,target)
- `(,value)
- (with-lexical-bindings
- (fluid-ref bindings-data)
- `(,sym)
- `(,target)
- (lambda () (iterate (cdr tail))))))
- (let-dynamic loc
- `(,(caar tail))
- module
- `(,value)
- (iterate (cdr tail))))))))))
-
;;; Partition the argument list of a lambda expression into required,
;;; optional and rest arguments.
@@ -605,11 +521,85 @@
(defspecial let (loc args)
(pmatch args
- ((,bindings . ,body)
- (generate-let loc
- value-slot
- (map (cut parse-let-binding loc <>) bindings)
- body))))
+ ((,varlist . ,body)
+ (let ((bindings (map (cut parse-let-binding loc <>) varlist)))
+ (receive (decls forms) (parse-body body)
+ (receive (lexical dynamic)
+ (partition
+ (compose (cut bind-lexically? <> value-slot decls)
+ car)
+ bindings)
+ (for-each (lambda (sym)
+ (mark-global! (fluid-ref bindings-data)
+ sym
+ value-slot))
+ (map car dynamic))
+ (let ((make-values (lambda (for)
+ (map (lambda (el) (compile-expr (cdr el)))
+ for)))
+ (make-body (lambda () (compile-expr `(progn ,@forms)))))
+ (if (null? lexical)
+ (let-dynamic loc (map car dynamic) value-slot
+ (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))
+ (vals (append (make-values lexical)
+ (make-values dynamic))))
+ (make-let loc
+ all-syms
+ all-syms
+ vals
+ (with-lexical-bindings
+ (fluid-ref bindings-data)
+ (map car lexical)
+ lexical-syms
+ (lambda ()
+ (if (null? dynamic)
+ (make-body)
+ (let-dynamic loc
+ (map car dynamic)
+ value-slot
+ (map
+ (lambda (sym)
+ (make-lexical-ref loc
+ sym
+ sym))
+ dynamic-syms)
+ (make-body)))))))))))))))
+
+(defspecial let* (loc args)
+ (pmatch args
+ ((,varlist . ,body)
+ (let ((bindings (map (cut parse-let-binding loc <>) varlist)))
+ (receive (decls forms) (parse-body body)
+ (for-each (lambda (sym)
+ (if (not (bind-lexically? sym value-slot decls))
+ (mark-global! (fluid-ref bindings-data)
+ sym
+ value-slot)))
+ (map car bindings))
+ (let iterate ((tail bindings))
+ (if (null? tail)
+ (compile-expr `(progn ,@forms))
+ (let ((sym (caar tail))
+ (value (compile-expr (cdar tail))))
+ (if (bind-lexically? sym value-slot decls)
+ (let ((target (gensym)))
+ (make-let loc
+ `(,target)
+ `(,target)
+ `(,value)
+ (with-lexical-bindings
+ (fluid-ref bindings-data)
+ `(,sym)
+ `(,target)
+ (lambda () (iterate (cdr tail))))))
+ (let-dynamic loc
+ `(,(caar tail))
+ value-slot
+ `(,value)
+ (iterate (cdr tail))))))))))))
(defspecial flet (loc args)
(pmatch args
@@ -650,14 +640,6 @@
(map compile-expr vals)
(compile-expr `(progn ,@forms)))))))))))
-(defspecial let* (loc args)
- (pmatch args
- ((,bindings . ,body)
- (generate-let* loc
- value-slot
- (map (cut parse-let-binding loc <>) bindings)
- body))))
-
;;; guile-ref allows building TreeIL's module references from within
;;; elisp as a way to access data within the Guile universe. The module
;;; and symbol referenced are static values, just like (@ module symbol)