mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

inline generate-let' and generate-let*'

Browse source 
* module/language/elisp/compile-tree-il.scm (generate-let, compile-let):
  Inline the former into the latter.
  (generate-let*, compile-let*): Likewise.
This commit is contained in:
BT Templeton 2011-08-08 20:47:03 -04:00
parent 6bb004c435
commit c64c51ebb0
1 changed files with 79 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -268,90 +268,6 @@
(receive (decls intspec doc body) (parse-body-1 body #f) (receive (decls intspec doc body) (parse-body-1 body #f)
(values decls body))) (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, ;;; Partition the argument list of a lambda expression into required,
;;; optional and rest arguments. ;;; optional and rest arguments.
@ -605,11 +521,85 @@
(defspecial let (loc args) (defspecial let (loc args)
(pmatch args (pmatch args
((,bindings . ,body) ((,varlist . ,body)
(generate-let loc (let ((bindings (map (cut parse-let-binding loc <>) varlist)))
value-slot (receive (decls forms) (parse-body body)
(map (cut parse-let-binding loc <>) bindings) (receive (lexical dynamic)
body)))) (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) (defspecial flet (loc args)
(pmatch args (pmatch args
@ -650,14 +640,6 @@
(map compile-expr vals) (map compile-expr vals)
(compile-expr `(progn ,@forms))))))))))) (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 ;;; guile-ref allows building TreeIL's module references from within
;;; elisp as a way to access data within the Guile universe. The module ;;; elisp as a way to access data within the Guile universe. The module
;;; and symbol referenced are static values, just like (@ module symbol) ;;; and symbol referenced are static values, just like (@ module symbol)