diff options
author | BT Templeton <bpt@hcoop.net> | 2011-08-08 18:53:01 -0400 |
---|---|---|
committer | BT Templeton <bpt@hcoop.net> | 2012-02-03 18:53:50 -0500 |
commit | 9b90b453984a92e7e2d5f9ee0da97d33ff39fdc4 (patch) | |
tree | 2040810c6ad47500b175a8b238baa697710dee11 /module/language/elisp | |
parent | 1c2f9636dcd6a4fde0a8df989f09cd82704d09af (diff) | |
download | guile-9b90b453984a92e7e2d5f9ee0da97d33ff39fdc4.tar.gz |
elisp `while' macro
* 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.
Diffstat (limited to 'module/language/elisp')
-rw-r--r-- | module/language/elisp/boot.el | 8 | ||||
-rw-r--r-- | module/language/elisp/compile-tree-il.scm | 48 | ||||
-rw-r--r-- | module/language/elisp/runtime/function-slot.scm | 2 |
3 files changed, 8 insertions, 50 deletions
diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el index e17b0bdf6..f2ca6b620 100644 --- a/module/language/elisp/boot.el +++ b/module/language/elisp/boot.el @@ -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")) diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index a53d5752d..fb8189bfc 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -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)) diff --git a/module/language/elisp/runtime/function-slot.scm b/module/language/elisp/runtime/function-slot.scm index 34098ae7e..03fd454ba 100644 --- a/module/language/elisp/runtime/function-slot.scm +++ b/module/language/elisp/runtime/function-slot.scm @@ -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 |