diff options
author | Brian Templeton <bpt@hcoop.net> | 2010-08-14 19:28:56 -0400 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-12-07 13:21:03 +0100 |
commit | 3f70b2dc5c33073b6f24078bc1fc1d6bdcd3b03f (patch) | |
tree | b6aceae67620b68e4ddbee2c73b4b2bc87bb3f0f | |
parent | 67cb2c27610295aa68445951c03a7550efc9453a (diff) | |
download | guile-3f70b2dc5c33073b6f24078bc1fc1d6bdcd3b03f.tar.gz |
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.
Signed-off-by: Andy Wingo <wingo@pobox.com>
-rw-r--r-- | module/language/elisp/compile-tree-il.scm | 84 | ||||
-rw-r--r-- | module/language/elisp/runtime.scm | 17 | ||||
-rw-r--r-- | module/language/elisp/runtime/function-slot.scm | 2 | ||||
-rw-r--r-- | module/language/elisp/runtime/macros.scm | 45 | ||||
-rw-r--r-- | module/language/elisp/runtime/subrs.scm | 49 | ||||
-rw-r--r-- | test-suite/tests/elisp-compiler.test | 12 |
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 773f0555b..ac3e185b1 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 d8ca50232..c29310d84 100644 --- a/module/language/elisp/runtime.scm +++ b/module/language/elisp/runtime.scm @@ -19,15 +19,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) @@ -35,10 +33,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) @@ -79,8 +73,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)))))) @@ -89,12 +82,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 1e5ffed45..896e3cece 100644 --- a/module/language/elisp/runtime/function-slot.scm +++ b/module/language/elisp/runtime/function-slot.scm @@ -47,7 +47,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) @@ -70,7 +69,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 6ab8852ba..a62f721e7 100644 --- a/module/language/elisp/runtime/macros.scm +++ b/module/language/elisp/runtime/macros.scm @@ -37,10 +37,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) @@ -73,11 +72,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)) @@ -106,12 +104,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. @@ -147,16 +143,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*" |