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.

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?

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.

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.
 

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

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"