diff --git a/module/language/elisp/README b/module/language/elisp/README index 17206221c..004fd971a 100644 --- a/module/language/elisp/README +++ b/module/language/elisp/README @@ -42,6 +42,7 @@ Extensions over original elisp: * guile-ref, guile-primitive * flet and flet* * lexical-let and lexical-let* + * without-void-checks Details to the implemented extensions @@ -95,3 +96,12 @@ for compatibility: * If symbols are accessed where they are not known at compile-time (like symbol-value or set primitives), this always refers to the dynamic binding and never the lexical one. That's very nice to the implementor... + +without-void-checks: +-------------------- + +Disable void checks in addition to the compiler option for all or some symbols +in the lexical scope of this construct: + +(without-void-checks all body...) or +(without-void-checks (sym1 sym2 ...) body... diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index 6a81d3025..269037d52 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -111,11 +111,13 @@ ; 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) +(define (want-void-check? sym module) (let ((disabled (fluid-ref disable-void-check))) - (and (not (eq? disabled 'all)) - (not (memq sym disabled))))) + (or (not (equal? module value-slot)) + (and (not (eq? disabled 'all)) + (not (memq sym disabled)))))) ; Handle access to a variable (reference/setting) correctly depending on @@ -146,7 +148,7 @@ ; Reference a variable and error if the value is void. (define (reference-with-check loc sym module) - (if (want-void-check? sym) + (if (want-void-check? sym module) (let ((var (gensym))) (make-let loc '(value) `(,var) `(,(reference-variable loc sym module)) (make-conditional loc @@ -700,6 +702,23 @@ (not (null? body)))) (generate-let* loc function-slot bindings body)) + ; Temporarily disable void checks for certain symbols within the lexical + ; scope of without-void-checks. + ((without-void-checks ,syms . ,body) + (guard (and (list? body) (not (null? body)) + (or (eq? syms 'all) + (and (list? syms) (and-map symbol? syms))))) + (let ((disabled (fluid-ref disable-void-check)) + (make-body (lambda () + (make-sequence loc (map compile-expr body))))) + (if (eq? disabled 'all) + (make-body) + (let ((new-disabled (if (eq? syms 'all) + 'all + (append syms disabled)))) + (with-fluid* disable-void-check new-disabled make-body))))) + + ; guile-ref allows building TreeIL's module references from within ; elisp as a way to access data within ; the Guile universe. The module and symbol referenced are static values, diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test index 1eed4502e..7d77c3b8d 100644 --- a/test-suite/tests/elisp-compiler.test +++ b/test-suite/tests/elisp-compiler.test @@ -241,7 +241,10 @@ #: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)))) + #:opts '(#:disable-void-check (x y a b))) + (pass-if "without-void-checks" + (progn (makunbound 'a) + (= (without-void-checks (a) a 5) 5)))) (with-test-prefix/compile "Let and Let*"