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*"