mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-18 10:10:23 +02:00
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.
This commit is contained in:
Brian Templeton
parent
825bc696ed
commit
761e60535b
6 changed files with 83 additions and 126 deletions
|
|
@ -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,14 +652,24 @@
|
|||
(if (handle-var-def loc sym doc)
|
||||
(make-sequence
|
||||
loc
|
||||
(list (make-conditional
|
||||
(list
|
||||
(make-conditional
|
||||
loc
|
||||
(make-conditional
|
||||
loc
|
||||
(call-primitive
|
||||
loc
|
||||
'module-bound?
|
||||
(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))
|
||||
'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)
|
||||
|
|
@ -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,7 +864,7 @@
|
|||
(else
|
||||
(make-application loc
|
||||
(if (symbol? operator)
|
||||
(reference-with-check loc
|
||||
(reference-variable loc
|
||||
operator
|
||||
function-slot)
|
||||
(compile-expr operator))
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -38,10 +38,9 @@
|
|||
(built-in-macro prog1
|
||||
(lambda (form1 . rest)
|
||||
(let ((temp (gensym)))
|
||||
`(without-void-checks (,temp)
|
||||
(lexical-let ((,temp ,form1))
|
||||
`(lexical-let ((,temp ,form1))
|
||||
,@rest
|
||||
,temp)))))
|
||||
,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)))
|
||||
`(lexical-let ((,var ,(car cur)))
|
||||
(if ,var
|
||||
,var
|
||||
,rest)))))
|
||||
,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))
|
||||
`(lexical-let ((,var ,x))
|
||||
(if ,var
|
||||
,var
|
||||
,(iterate (car tail) (cdr tail)))))))))))
|
||||
,(iterate (car tail) (cdr tail))))))))))
|
||||
|
||||
;;; Define the dotimes and dolist iteration macros.
|
||||
|
||||
|
|
@ -148,7 +144,6 @@
|
|||
(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))
|
||||
|
|
@ -157,7 +152,7 @@
|
|||
(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).
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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*"
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue