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

elisp `while' macro

Browse source 
* module/language/elisp/compile-tree-il.scm (compile-while): Remove.

* module/language/elisp/boot.el (while): New macro.

* module/language/elisp/runtime/function-slot.scm: Update module
  definition.
This commit is contained in:
BT Templeton 2011-08-08 18:53:01 -04:00
parent 1c2f9636dc
commit 9b90b45398
3 changed files with 8 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

8
module/language/elisp/boot.el
View file

@ -90,6 +90,14 @@
,temp
(or ,@(cdr conditions))))))))
(defmacro while (test &rest body)
(let ((loop (make-symbol "loop")))
`(labels ((,loop ()
(if ,test
(progn ,@body (,loop))
nil)))
(,loop))))
(defmacro catch (tag &rest body)
(let* ((temp (make-symbol "catch-temp"))
(elisp-key (make-symbol "catch-elisp-key"))

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

@ -44,7 +44,6 @@
compile-lexical-let*
compile-guile-ref
compile-guile-primitive
compile-while
compile-function
compile-defmacro
compile-defun
@ -692,53 +691,6 @@
((,sym)
(make-primitive-ref loc sym))))
;;; A while construct is transformed into a tail-recursive loop like
;;; this:
;;;
;;; (letrec ((iterate (lambda ()
;;; (if condition
;;; (begin body
;;; (iterate))
;;; #nil))))
;;; (iterate))
;;;
;;; As letrec is not directly accessible from elisp, while is
;;; implemented here instead of with a macro.
(defspecial while (loc args)
(pmatch args
((,condition . ,body)
(let* ((itersym (gensym))
(compiled-body (map compile-expr body))
(iter-call (make-application loc
(make-lexical-ref loc
'iterate
itersym)
(list)))
(full-body (make-sequence loc
`(,@compiled-body ,iter-call)))
(lambda-body (make-conditional loc
(compile-expr condition)
full-body
(nil-value loc)))
(iter-thunk (make-lambda loc
'()
(make-lambda-case #f
'()
#f
#f
#f
'()
'()
lambda-body
#f))))
(make-letrec loc
#f
'(iterate)
(list itersym)
(list iter-thunk)
iter-call)))))
(defspecial function (loc args)
(pmatch args
(((lambda ,args . ,body))

2
module/language/elisp/runtime/function-slot.scm
View file

@ -33,7 +33,6 @@
(compile-lexical-let* . lexical-let*)
(compile-guile-ref . guile-ref)
(compile-guile-primitive . guile-primitive)
(compile-while . while)
(compile-function . function)
(compile-defun . defun)
(compile-defmacro . defmacro)
@ -58,7 +57,6 @@
lexical-let*
guile-ref
guile-primitive
while
function
defun
defmacro