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.

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

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.

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)

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.