use unbound fluids instead of `void' sentinel value

* module/language/elisp/compile-tree-il.scm (reference-with-check)
  (compile-without-void-checks, want-void-check?): Remove.

  (compile-function, compile-pair): Use `reference-variable' instead of
  `reference-with-check'.

  (compile-defvar): Only set `sym' if `sym' is not bound to a bound
  fluid, rather than requiring that its value be `void'.

  (process-options!): Remove `#:disable-void-check' option handling.

* module/language/elisp/runtime.scm (void)
  (reference-variable-with-check): Remove.

  (ensure-fluid!): Use an undefined fluid as the initial value for
  global variables.

* module/language/elisp/runtime/function-slot.scm (without-void-checks):
  Don't import or re-export.

* module/language/elisp/runtime/macros.scm (prog1, cond, or, dolist):
  Don't use `without-void-checks'.

* module/language/elisp/runtime/subrs.scm (symbol-value)
  (symbol-function, apply): Use `reference-variable' instead of
  `reference-variable-with-check'.

  (makunbound, fmakunbound, boundp, fboundp): Unset the variable's fluid
  (or the variable itself, if it isn't bound to a fluid).

* test-suite/tests/elisp-compiler.test ("Variable
  Setting/Referencing")["disabled void check (all)", "disabled void
  check (symbol list)", "without-void-checks"]: Remove.

6 files changed, 83 insertions, 126 deletions

diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm
index 84a5af482..3830bffb2 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -142,17 +142,6 @@
                              (generate-ensure-global loc sym mod)))
      ,body)))
 
-;;; See if we should do a void-check for a given variable. That means,
-;;; check that this check is not disabled via the compiler options for
-;;; this symbol. Disabling of void check is only done for the value-slot
-;;; module!
-
-(define (want-void-check? sym module)
-  (let ((disabled (fluid-ref disable-void-check)))
-    (or (not (equal? module value-slot))
-        (and (not (eq? disabled 'all))
-             (not (memq sym disabled))))))
-
 ;;; Build a construct that establishes dynamic bindings for certain
 ;;; variables. We may want to choose between binding with fluids and
 ;;; with-fluids* and using just ordinary module symbols and
@@ -198,26 +187,6 @@
                      'fluid-ref
                      (make-module-ref loc module sym #t)))))
 
-;;; Reference a variable and error if the value is void.
-
-(define (reference-with-check loc sym module)
-  (if (want-void-check? sym module)
-      (let ((var (gensym)))
-        (make-let
-         loc
-         '(value)
-         `(,var)
-         `(,(reference-variable loc sym module))
-         (make-conditional
-          loc
-          (call-primitive loc
-                          'eq?
-                          (make-module-ref loc runtime 'void #t)
-                          (make-lexical-ref loc 'value var))
-          (runtime-error loc "variable is void:" (make-const loc sym))
-          (make-lexical-ref loc 'value var))))
-      (reference-variable loc sym module)))
-
 ;;; Generate code to set a variable. Just as with reference-variable, in
 ;;; case of a reference to value-slot, we want to generate a lexical set
 ;;; when the variable has a lexical binding.
@@ -683,15 +652,25 @@
      (if (handle-var-def loc sym doc)
          (make-sequence
           loc
-          (list (make-conditional
-                 loc
-                 (call-primitive loc
-                                 'eq?
-                                 (make-module-ref loc runtime 'void #t)
-                                 (reference-variable loc sym value-slot))
-                 (set-variable! loc sym value-slot (compile-expr value))
-                 (make-void loc))
-                (make-const loc sym)))))))
+          (list
+           (make-conditional
+            loc
+            (make-conditional
+             loc
+             (call-primitive
+              loc
+              'module-bound?
+              (call-primitive loc
+                              'resolve-interface
+                              (make-const loc value-slot))
+              (make-const loc sym))
+             (call-primitive loc
+                             'fluid-bound?
+                             (make-module-ref loc value-slot sym #t))
+             (make-const loc #f))
+            (make-void loc)
+            (set-variable! loc sym value-slot (compile-expr value)))
+           (make-const loc sym)))))))
 
 (defspecial setq (loc args)
   (define (car* x) (if (null? x) '() (car x)))
@@ -742,13 +721,8 @@
     ((,bindings . ,body)
      (generate-let* loc function-slot bindings body))))
 
-;;; Temporarily disable void checks or set symbols as always lexical
-;;; only for the lexical scope of a construct.
-
-(defspecial without-void-checks (loc args)
-  (pmatch args
-    ((,syms . ,body)
-     (with-added-symbols loc disable-void-check syms body))))
+;;; Temporarily set symbols as always lexical only for the lexical scope
+;;; of a construct.
 
 (defspecial with-always-lexical (loc args)
   (pmatch args
@@ -825,7 +799,7 @@
     (((lambda ,args . ,body))
      (compile-lambda loc args body))
     ((,sym) (guard (symbol? sym))
-     (reference-with-check loc sym function-slot))))
+     (reference-variable loc sym function-slot))))
 
 (defspecial defmacro (loc args)
   (pmatch args
@@ -890,9 +864,9 @@
      (else
       (make-application loc
                         (if (symbol? operator)
-                            (reference-with-check loc
-                                                  operator
-                                                  function-slot)
+                            (reference-variable loc
+                                                operator
+                                                function-slot)
                             (compile-expr operator))
                         (map compile-expr arguments))))))
 
@@ -903,7 +877,7 @@
   (case sym
     ((nil) (nil-value loc))
     ((t) (t-value loc))
-    (else (reference-with-check loc sym value-slot))))
+    (else (reference-variable loc sym value-slot))))
 
 ;;; Compile a single expression to TreeIL.
 
@@ -933,12 +907,6 @@
             (case key
               ((#:warnings)             ; ignore
                #f)
-              ((#:disable-void-check)
-               (if (valid-symbol-list-arg? value)
-                   (fluid-set! disable-void-check value)
-                   (report-error #f
-                                 "Invalid value for #:disable-void-check"
-                                 value)))
               ((#:always-lexical)
                (if (valid-symbol-list-arg? value)
                    (fluid-set! always-lexical value)
diff --git a/module/language/elisp/runtime.scm b/module/language/elisp/runtime.scm
index 5a0bbe9e7..66a479b43 100644
--- a/module/language/elisp/runtime.scm
+++ b/module/language/elisp/runtime.scm
@@ -20,15 +20,13 @@
 ;;; Code:
 
 (define-module (language elisp runtime)
-  #:export (void
-            nil-value
+  #:export (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)
@@ -36,10 +34,6 @@
 
 ;;; This module provides runtime support for the Elisp front-end.
 
-;;; The reserved value to mean (when eq?) void.
-
-(define void (list 42))
-
 ;;; Values for t and nil. (FIXME remove this abstraction)
 
 (define nil-value #nil)
@@ -78,8 +72,7 @@
   (let ((intf (resolve-interface module))
         (resolved (resolve-module module)))
     (if (not (module-defined? intf sym))
-        (let ((fluid (make-fluid)))
-          (fluid-set! fluid void)
+        (let ((fluid (make-undefined-fluid)))
           (module-define! resolved sym fluid)
           (module-export! resolved `(,sym))))))
 
@@ -88,12 +81,6 @@
   (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)))
diff --git a/module/language/elisp/runtime/function-slot.scm b/module/language/elisp/runtime/function-slot.scm
index da537693d..feb649bf6 100644
--- a/module/language/elisp/runtime/function-slot.scm
+++ b/module/language/elisp/runtime/function-slot.scm
@@ -48,7 +48,6 @@
                  (compile-let* . let*)
                  (compile-lexical-let* . lexical-let*)
                  (compile-flet* . flet*)
-                 (compile-without-void-checks . without-void-checks)
                  (compile-with-always-lexical . with-always-lexical)
                  (compile-guile-ref . guile-ref)
                  (compile-guile-primitive . guile-primitive)
@@ -71,7 +70,6 @@
                let*
                lexical-let*
                flet*
-               without-void-checks
                with-always-lexical
                guile-ref
                guile-primitive
diff --git a/module/language/elisp/runtime/macros.scm b/module/language/elisp/runtime/macros.scm
index 2858c511b..4b568caf9 100644
--- a/module/language/elisp/runtime/macros.scm
+++ b/module/language/elisp/runtime/macros.scm
@@ -38,10 +38,9 @@
 (built-in-macro prog1
   (lambda (form1 . rest)
     (let ((temp (gensym)))
-      `(without-void-checks (,temp)
-         (lexical-let ((,temp ,form1))
-           ,@rest
-           ,temp)))))
+      `(lexical-let ((,temp ,form1))
+         ,@rest
+         ,temp))))
 
 (built-in-macro prog2
   (lambda (form1 form2 . rest)
@@ -74,11 +73,10 @@
                    (macro-error "invalid clause in cond" cur))
                   ((null? (cdr cur))
                    (let ((var (gensym)))
-                     `(without-void-checks (,var)
-                        (lexical-let ((,var ,(car cur)))
-                          (if ,var
-                              ,var
-                              ,rest)))))
+                     `(lexical-let ((,var ,(car cur)))
+                        (if ,var
+                            ,var
+                            ,rest))))
                   (else
                    `(if ,(car cur)
                         (progn ,@(cdr cur))
@@ -107,12 +105,10 @@
        (if (null? tail)
            x
            (let ((var (gensym)))
-             `(without-void-checks
-                  (,var)
-                (lexical-let ((,var ,x))
-                  (if ,var
-                      ,var
-                      ,(iterate (car tail) (cdr tail)))))))))))
+             `(lexical-let ((,var ,x))
+                (if ,var
+                    ,var
+                    ,(iterate (car tail) (cdr tail))))))))))
 
 ;;; Define the dotimes and dolist iteration macros.
 
@@ -148,16 +144,15 @@
           (if (not (symbol? var))
               (macro-error "expected symbol as dolist variable")
               `(let (,var)
-                 (without-void-checks (,tailvar)
-                   (lexical-let ((,tailvar ,iter-list))
-                     (while ((guile-primitive not)
-                             ((guile-primitive null?) ,tailvar))
-                       (setq ,var ((guile-primitive car) ,tailvar))
-                       ,@body
-                       (setq ,tailvar ((guile-primitive cdr) ,tailvar)))
-                     ,@(if (= (length args) 3)
-                           (list (caddr args))
-                           '())))))))))
+                 (lexical-let ((,tailvar ,iter-list))
+                   (while ((guile-primitive not)
+                           ((guile-primitive null?) ,tailvar))
+                          (setq ,var ((guile-primitive car) ,tailvar))
+                          ,@body
+                          (setq ,tailvar ((guile-primitive cdr) ,tailvar)))
+                   ,@(if (= (length args) 3)
+                         (list (caddr args))
+                         '()))))))))
 
 ;;; Exception handling. unwind-protect and catch are implemented as
 ;;; macros (throw is a built-in function).
diff --git a/module/language/elisp/runtime/subrs.scm b/module/language/elisp/runtime/subrs.scm
index c981b3819..10e264df6 100644
--- a/module/language/elisp/runtime/subrs.scm
+++ b/module/language/elisp/runtime/subrs.scm
@@ -281,11 +281,11 @@
 
 (built-in-func symbol-value
   (lambda (sym)
-    (reference-variable-with-check value-slot-module sym)))
+    (reference-variable value-slot-module sym)))
 
 (built-in-func symbol-function
   (lambda (sym)
-    (reference-variable-with-check function-slot-module sym)))
+    (reference-variable function-slot-module sym)))
 
 (built-in-func set
   (lambda (sym value)
@@ -297,27 +297,48 @@
 
 (built-in-func makunbound
   (lambda (sym)
-    (set-variable! value-slot-module sym void)
+    (if (module-bound? (resolve-interface value-slot-module) sym)
+      (let ((var (module-variable (resolve-module value-slot-module)
+                                  sym)))
+        (if (and (variable-bound? var) (fluid? (variable-ref var)))
+            (fluid-unset! (variable-ref var))
+            (variable-unset! var))))
     sym))
 
 (built-in-func fmakunbound
   (lambda (sym)
-    (set-variable! function-slot-module sym void)
+    (if (module-bound? (resolve-interface function-slot-module) sym)
+        (let ((var (module-variable
+                    (resolve-module function-slot-module)
+                    sym)))
+          (if (and (variable-bound? var) (fluid? (variable-ref var)))
+              (fluid-unset! (variable-ref var))
+              (variable-unset! var))))
     sym))
 
 (built-in-func boundp
   (lambda (sym)
-    (elisp-bool (prim not
-                      (eq? void
-                           (reference-variable value-slot-module
-                                               sym))))))
+    (elisp-bool
+     (and
+      (module-bound? (resolve-interface value-slot-module) sym)
+      (let ((var (module-variable (resolve-module value-slot-module)
+                                  sym)))
+        (and (variable-bound? var)
+             (if (fluid? (variable-ref var))
+                 (fluid-bound? (variable-ref var))
+                 #t)))))))
 
 (built-in-func fboundp
   (lambda (sym)
-    (elisp-bool (prim not
-                      (eq? void
-                           (reference-variable function-slot-module
-                                               sym))))))
+    (elisp-bool
+     (and
+      (module-bound? (resolve-interface function-slot-module) sym)
+      (let* ((var (module-variable (resolve-module function-slot-module)
+                                   sym)))
+       (and (variable-bound? var)
+            (if (fluid? (variable-ref var))
+                (fluid-bound? (variable-ref var))
+                #t)))))))
 
 ;;; Function calls. These must take care of special cases, like using
 ;;; symbols or raw lambda-lists as functions!
@@ -326,9 +347,7 @@
   (lambda (func . args)
     (let ((real-func (cond
                       ((symbol? func)
-                       (reference-variable-with-check
-                        function-slot-module
-                        func))
+                       (reference-variable function-slot-module func))
                       ((list? func)
                        (if (and (prim not (null? func))
                                 (eq? (prim car func) 'lambda))
diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test
index df22afe1c..0d3a8b4b4 100644
--- a/test-suite/tests/elisp-compiler.test
+++ b/test-suite/tests/elisp-compiler.test
@@ -234,17 +234,7 @@
     (progn (setq a 1 b 2)
            (and (eq (makunbound 'b) 'b)
                 (boundp 'a)
-                (not (boundp 'b)))))
-
-  (pass-if "disabled void check (all)"
-    (progn (makunbound 'a) a t)
-    #:opts '(#:disable-void-check all))
-  (pass-if "disabled void check (symbol list)"
-    (progn (makunbound 'a) a t)
-    #:opts '(#:disable-void-check (x y a b)))
-  (pass-if "without-void-checks"
-    (progn (makunbound 'a)
-           (= (without-void-checks (a) a 5) 5))))
+                (not (boundp 'b))))))
 
 (with-test-prefix/compile "Let and Let*"