[Guile-commits] GNU Guile branch, elisp, updated. release_1-9-1-31-g3709984

[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=3709984696eaba6698318312ceaf9997f3b1c4fd

The branch, elisp has been updated
       via  3709984696eaba6698318312ceaf9997f3b1c4fd (commit)
      from  33da12eeff22c5b460fc01f2e0e8fe8f85a1d220 (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 3709984696eaba6698318312ceaf9997f3b1c4fd
Author: Daniel Kraft <address@hidden>
Date:   Thu Jul 23 14:09:55 2009 +0200

    Implemented dynamic symbol access built-ins (set, fset, symbol-value, 
makunbound...)
    
    * module/language/elisp/README: Document it.
    * module/language/elisp/compile-tree-il.scm: Moved ensure-fluid! to runtime 
function.
    * module/language/elisp/runtime.scm: Runtime functions to support dynamic 
value access.
    * module/language/elisp/runtime/function-slot.scm: Defined the built-ins.
    * test-suite/tests/elisp-compiler.test: Test them.

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

Summary of changes:
 module/language/elisp/README                    |    4 +-
 module/language/elisp/compile-tree-il.scm       |   24 ++--------
 module/language/elisp/runtime.scm               |   51 ++++++++++++++++++++++-
 module/language/elisp/runtime/function-slot.scm |   35 +++++++++++++++
 test-suite/tests/elisp-compiler.test            |   34 +++++++++++++--
 5 files changed, 121 insertions(+), 27 deletions(-)

diff --git a/module/language/elisp/README b/module/language/elisp/README
index 9cfe143..140124d 100644
--- a/module/language/elisp/README
+++ b/module/language/elisp/README
@@ -9,6 +9,8 @@ Already implemented:
   * if, cond, when, unless
   * not, and, or
   * referencing and setting (setq) variables
+  * set, symbol-value, makunbound, boundp functions
+  * fset, symbol-function, fmakunbound, fboundp
   * while, dotimes, dolist
   * catch, throw, unwind-protect
   * let, let*
@@ -20,10 +22,8 @@ Already implemented:
 
 Especially still missing:
   * real elisp reader instead of Scheme's
-  * set, makunbound, boundp functions
   * more general built-ins
   * funcall and apply functions
-  * fset & friends, defalias functions
   * advice?
   * defsubst and inlining
   * need fluids for function bindings?
diff --git a/module/language/elisp/compile-tree-il.scm 
b/module/language/elisp/compile-tree-il.scm
index 03772ff..e44303b 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -46,9 +46,9 @@
 ; Modules that contain the value and function slot bindings.
 
 (define runtime '(language elisp runtime))
-(define value-slot '(language elisp runtime value-slot))
-(define function-slot '(language elisp runtime function-slot))
 (define macro-slot '(language elisp runtime macro-slot))
+(define value-slot (@ (language elisp runtime) value-slot-module))
+(define function-slot (@ (language elisp runtime) function-slot-module))
 
 
 ; The backquoting works the same as quasiquotes in Scheme, but the forms are
@@ -94,23 +94,9 @@
 ; the fluids are really generated with this routine.
 
 (define (generate-ensure-fluid loc sym module)
-  (let ((resolved-module (call-primitive loc 'resolve-module
-                                         (make-const loc module)))
-        (resolved-intf (call-primitive loc 'resolve-interface
-                                       (make-const loc module))))
-    (make-conditional loc
-      (call-primitive loc 'module-defined? resolved-intf (make-const loc sym))
-      (make-void loc)
-      (make-sequence loc
-        (list (call-primitive loc 'module-define!
-                resolved-module (make-const loc sym)
-                (call-primitive loc 'make-fluid))
-              (call-primitive loc 'module-export!
-                resolved-module
-                (call-primitive loc 'list (make-const loc sym)))
-              (call-primitive loc 'fluid-set!
-                (make-module-ref loc module sym #t)
-                (make-module-ref loc runtime 'void #t)))))))
+  (make-application loc (make-module-ref loc runtime 'ensure-fluid! #t)
+    (list (make-const loc module)
+          (make-const loc sym))))
 
 
 ; Generate code to reference a fluid saved variable.
diff --git a/module/language/elisp/runtime.scm 
b/module/language/elisp/runtime.scm
index 1ec5bb4..bad9b38 100644
--- a/module/language/elisp/runtime.scm
+++ b/module/language/elisp/runtime.scm
@@ -20,7 +20,16 @@
 ;;; Code:
 
 (define-module (language elisp runtime)
-  #:export (void nil-value t-value elisp-bool runtime-error macro-error)
+  #:export (void
+            nil-value t-value
+            value-slot-module function-slot-module
+
+            elisp-bool
+
+            ensure-fluid! reference-variable reference-variable-with-check
+            set-variable!
+
+            runtime-error macro-error)
   #:export-syntax (built-in-func built-in-macro prim))
 
 ; This module provides runtime support for the Elisp front-end.
@@ -38,6 +47,14 @@
 (define t-value #t)
 
 
+; Modules for the binding slots.
+; Note: Naming those value-slot and/or function-slot clashes with the
+; submodules of these names!
+
+(define value-slot-module '(language elisp runtime value-slot))
+(define function-slot-module '(language elisp runtime function-slot))
+
+
 ; Report an error during macro compilation, that means some special compilation
 ; (syntax) error; or report a simple runtime-error from a built-in function.
 
@@ -55,6 +72,38 @@
     nil-value))
 
 
+; Routines for access to elisp dynamically bound symbols.
+; This is used for runtime access using functions like symbol-value or set,
+; where the symbol accessed might not be known at compile-time.
+; These always access the dynamic binding and can not be used for the lexical!
+
+(define (ensure-fluid! module sym)
+  (let ((intf (resolve-interface module))
+        (resolved (resolve-module module)))
+    (if (not (module-defined? intf sym))
+      (let ((fluid (make-fluid)))
+        (fluid-set! fluid void)
+        (module-define! resolved sym fluid)
+        (module-export! resolved `(,sym))))))
+
+(define (reference-variable module sym)
+  (ensure-fluid! module sym)
+  (let ((resolved (resolve-module module)))
+    (fluid-ref (module-ref resolved sym))))
+
+(define (reference-variable-with-check module sym)
+  (let ((value (reference-variable module sym)))
+    (if (eq? value void)
+      (runtime-error "variable is void:" sym)
+      value)))
+
+(define (set-variable! module sym value)
+  (ensure-fluid! module sym)
+  (let ((resolved (resolve-module module)))
+    (fluid-set! (module-ref resolved sym) value)
+    value))
+
+
 ; Define a predefined function or predefined macro for use in the function-slot
 ; and macro-slot modules, respectively.
 
diff --git a/module/language/elisp/runtime/function-slot.scm 
b/module/language/elisp/runtime/function-slot.scm
index bc1645d..805f22a 100644
--- a/module/language/elisp/runtime/function-slot.scm
+++ b/module/language/elisp/runtime/function-slot.scm
@@ -235,6 +235,41 @@
     val))
 
 
+; Accessing symbol bindings for symbols known only at runtime.
+
+(built-in-func symbol-value
+  (lambda (sym)
+    (reference-variable-with-check value-slot-module sym)))
+(built-in-func symbol-function
+  (lambda (sym)
+    (reference-variable-with-check function-slot-module sym)))
+
+(built-in-func set
+  (lambda (sym value)
+    (set-variable! value-slot-module sym value)))
+(built-in-func fset
+  (lambda (sym value)
+    (set-variable! function-slot-module sym value)))
+
+(built-in-func makunbound
+  (lambda (sym)
+    (set-variable! value-slot-module sym void)
+    sym))
+(built-in-func fmakunbound
+  (lambda (sym)
+    (set-variable! function-slot-module sym void)
+    sym))
+
+(built-in-func boundp
+  (lambda (sym)
+    (elisp-bool (prim not
+                  (eq? void (reference-variable value-slot-module sym))))))
+(built-in-func fboundp
+  (lambda (sym)
+    (elisp-bool (prim not
+                  (eq? void (reference-variable function-slot-module sym))))))
+
+
 ; Throw can be implemented as built-in function.
 
 (built-in-func throw
diff --git a/test-suite/tests/elisp-compiler.test 
b/test-suite/tests/elisp-compiler.test
index cb87840..67dbc70 100644
--- a/test-suite/tests/elisp-compiler.test
+++ b/test-suite/tests/elisp-compiler.test
@@ -191,9 +191,19 @@
   (pass-if-equal "setq and reference" 6
     (progn (setq a 1 b 2 c 3)
            (+ a b c)))
-
   (pass-if-equal "setq value" 2
-    (progn (setq a 1 b 2))))
+    (progn (setq a 1 b 2)))
+
+  (pass-if "set and symbol-value"
+    (progn (setq myvar 'a)
+           (and (= (set myvar 42) 42)
+                (= a 42)
+                (= (symbol-value myvar) 42))))
+  (pass-if "void variables"
+    (progn (setq a 1 b 2)
+           (and (eq (makunbound 'b) 'b)
+                (boundp 'a)
+                (not (boundp 'b))))))
 
 (with-test-prefix/compile "Let and Let*"
 
@@ -235,9 +245,9 @@
     (progn (setq a 42)
            (defvar a 1 "Some docstring is also ok")
            a))
-  ; FIXME: makunbound a!
   (pass-if-equal "defvar on undefined variable" 1
-    (progn (defvar a 1)
+    (progn (makunbound 'a)
+           (defvar a 1)
            a))
   (pass-if-equal "defvar value" 'a
     (defvar a)))
@@ -267,7 +277,21 @@
     (progn (defun test (a b) (+ a b))
            (test 1 2)))
   (pass-if-equal "defun value" 'test
-    (defun test (a b) (+ a b))))
+    (defun test (a b) (+ a b)))
+
+  (pass-if "fset and symbol-function"
+    (progn (setq myfunc 'x x 5)
+           (and (= (fset myfunc 42) 42)
+                (= (symbol-function myfunc) 42)
+                (= x 5))))
+  (pass-if "void function values"
+    (progn (setq a 1)
+           (defun test (a b) (+ a b))
+           (fmakunbound 'a)
+           (fset 'b 5)
+           (and (fboundp 'b) (fboundp 'test)
+                (not (fboundp 'a))
+                (= a 1)))))
 
 (with-test-prefix/compile "Calling Functions"
 


hooks/post-receive
-- 
GNU Guile