diff options
author | Daniel Kraft <d@domob.eu> | 2009-07-22 12:50:56 +0200 |
---|---|---|
committer | Daniel Kraft <d@domob.eu> | 2009-07-22 12:50:56 +0200 |
commit | 33da12eeff22c5b460fc01f2e0e8fe8f85a1d220 (patch) | |
tree | 12ed209f3de8f1d10eb831408e6da0bf69f87021 | |
parent | 35b2e41d6d8040251a5775fc33d7158b9598ea1c (diff) | |
download | guile-33da12eeff22c5b460fc01f2e0e8fe8f85a1d220.tar.gz |
Added guile-ref extension construct, change throw implementation to easier one using a built-in function and implement unwind-protect.
* module/language/elisp/README: Document the changes.
* module/language/elisp/compile-tree-il.scm: Implement unwind-protect.
* module/language/elisp/runtime/function-slot.scm: throw as built-in.
* test-suite/tests/elisp-compiler.test: Test unwind-protect.
-rw-r--r-- | module/language/elisp/README | 6 | ||||
-rw-r--r-- | module/language/elisp/compile-tree-il.scm | 24 | ||||
-rw-r--r-- | module/language/elisp/runtime/function-slot.scm | 7 | ||||
-rw-r--r-- | test-suite/tests/elisp-compiler.test | 15 |
4 files changed, 43 insertions, 9 deletions
diff --git a/module/language/elisp/README b/module/language/elisp/README index 0eb3799bd..9cfe14384 100644 --- a/module/language/elisp/README +++ b/module/language/elisp/README @@ -10,7 +10,7 @@ Already implemented: * not, and, or * referencing and setting (setq) variables * while, dotimes, dolist - * catch, throw + * catch, throw, unwind-protect * let, let* * lambda expressions, function calls using list notation * some built-ins (mainly numbers/arithmetic) @@ -19,7 +19,6 @@ Already implemented: * quotation and backquotation with unquote/unquote-splicing Especially still missing: - * unwind-protect * real elisp reader instead of Scheme's * set, makunbound, boundp functions * more general built-ins @@ -34,3 +33,6 @@ Especially still missing: Other ideas and things to think about: * %nil vs. #f/'() handling in Guile * flet, lexical-let and/or optional lexical binding as extensions + +Extensions over original elisp: + * (guile-ref module symbol) construct to build a (@ module symbol) from elisp diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index dfff1fc0c..03772ff5f 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -572,6 +572,13 @@ (compile-expr bind (cdar tail)) (make-lambda loc '() '() '() (iterate (cdr tail))))))))) + ; guile-ref allows building TreeIL's module references from within + ; elisp as a way to access data (and primitives, for instance) within + ; the Guile universe. The module and symbol referenced are static values, + ; just like (@ module symbol) does! + ((guile-ref ,module ,sym) (guard (and (list? module) (symbol? sym))) + (make-module-ref loc module sym #t)) + ; A while construct is transformed into a tail-recursive loop like this: ; (letrec ((iterate (lambda () ; (if condition @@ -608,6 +615,8 @@ ; for matches using eq (eq?). We handle this by using always #t as key ; for the Guile primitives and check for matches inside the handler; if ; the elisp keys are not eq?, we rethrow the exception. + ; + ; throw is implemented as built-in function. ((catch ,tag . ,body) (guard (not (null? body))) (let* ((tag-value (gensym)) @@ -631,11 +640,16 @@ (call-primitive loc 'throw dummy-ref key-ref value-ref)))))))) - ((throw ,tag ,value) - (call-primitive loc 'throw - (make-const loc 'elisp-exception) - (compile-expr bind tag) - (compile-expr bind value))) + ; unwind-protect is just some weaker construct as dynamic-wind, so + ; straight-forward to implement. + ((unwind-protect ,body . ,clean-ups) (guard (not (null? clean-ups))) + (call-primitive loc 'dynamic-wind + (make-lambda loc '() '() '() (make-void loc)) + (make-lambda loc '() '() '() + (compile-expr bind body)) + (make-lambda loc '() '() '() + (make-sequence loc + (map (compiler bind) clean-ups))))) ; Either (lambda ...) or (function (lambda ...)) denotes a lambda-expression ; that should be compiled. diff --git a/module/language/elisp/runtime/function-slot.scm b/module/language/elisp/runtime/function-slot.scm index 3b3cf3c8d..bc1645d8d 100644 --- a/module/language/elisp/runtime/function-slot.scm +++ b/module/language/elisp/runtime/function-slot.scm @@ -235,6 +235,13 @@ val)) +; Throw can be implemented as built-in function. + +(built-in-func throw + (lambda (tag value) + (prim throw 'elisp-exception tag value))) + + ; Miscellaneous. (built-in-func not (lambda (x) diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test index d70dd9fe5..cb87840a3 100644 --- a/test-suite/tests/elisp-compiler.test +++ b/test-suite/tests/elisp-compiler.test @@ -165,9 +165,20 @@ (pass-if "catch and throw" (and (setq mylist '(1 2)) (= (catch 'abc (throw 'abc 2) 1) 2) - (= (catch 'abc (catch 'def (throw 'abc 1) 2) 3) 1) + (= (catch 'abc (catch 'def (throw 'abc (1+ 0)) 2) 3) 1) (= (catch 'abc (catch 'def (throw 'def 1) 2) 3) 3) - (= (catch mylist (catch '(1 2) (throw mylist 1) 2) 3) 1)))) + (= (catch mylist (catch '(1 2) (throw mylist 1) 2) 3) 1))) + + (pass-if "unwind-protect" + (progn (setq a 0 b 1 c 1) + (catch 'exc + (unwind-protect (progn (setq a 1) + (throw 'exc 0)) + (setq a 0) + (setq b 0))) + (unwind-protect nil (setq c 0)) + (and (= a 0) (= b 0) (= c 0) + (= (unwind-protect 42 1 2 3) 42))))) ; Test handling of variables. |