[Guile-commits] GNU Guile branch, elisp, updated. release_1-9-1-30-g33da12e

[Daniel Kraft]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=33da12eeff22c5b460fc01f2e0e8fe8f85a1d220

The branch, elisp has been updated
       via  33da12eeff22c5b460fc01f2e0e8fe8f85a1d220 (commit)
      from  35b2e41d6d8040251a5775fc33d7158b9598ea1c (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 33da12eeff22c5b460fc01f2e0e8fe8f85a1d220
Author: Daniel Kraft <address@hidden>
Date:   Wed Jul 22 12:50:56 2009 +0200

    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.

-----------------------------------------------------------------------

Summary of changes:
 module/language/elisp/README                    |    6 +++-
 module/language/elisp/compile-tree-il.scm       |   24 ++++++++++++++++++----
 module/language/elisp/runtime/function-slot.scm |    7 ++++++
 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 0eb3799..9cfe143 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 dfff1fc..03772ff 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 3b3cf3c..bc1645d 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 d70dd9f..cb87840 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.


hooks/post-receive
-- 
GNU Guile