mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

define `flet' directly

Browse source 
* module/language/elisp/compile-tree-il.scm (compile-flet): Compile
  `flet' directly instead of using `generate-let'.
This commit is contained in:
BT Templeton 2011-08-08 20:40:13 -04:00
parent 9083c48d37
commit 6bb004c435
1 changed files with 15 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -268,9 +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)))
;;; Compile let and let* expressions. The code here is used both for
;;; let/let* and flet, just with a different bindings module.
;;; Let is done with a single call to let-dynamic binding them locally ;;; 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 ;;; 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 ;;; bind lexically among the bindings, we first do a let for all of them
@ -617,10 +614,21 @@
(defspecial flet (loc args) (defspecial flet (loc args)
(pmatch args (pmatch args
((,bindings . ,body) ((,bindings . ,body)
(generate-let loc (let ((names+vals (map (cut parse-flet-binding loc <>) bindings)))
function-slot (receive (decls forms) (parse-body body)
(map (cut parse-flet-binding loc <>) bindings) (let ((names (map car names+vals))
body)))) (vals (map cdr names+vals))
(gensyms (map (lambda (x) (gensym)) names+vals)))
(with-lexical-bindings
(fluid-ref bindings-data)
names
gensyms
(lambda ()
(make-let loc
names
gensyms
(map compile-expr vals)
(compile-expr `(progn ,@forms)))))))))))
(defspecial labels (loc args) (defspecial labels (loc args)
(pmatch args (pmatch args