mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-18 10:10:23 +02:00
Code Activity

use unbound fluids instead of `void' sentinel value

Browse source 
* 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 2010-08-14 19:28:56 -04:00
parent 825bc696ed
commit 761e60535b
6 changed files with 83 additions and 126 deletions
Download patch file Download diff file Expand all files Collapse all files

84
module/language/elisp/compile-tree-il.scm
View file

@ -142,17 +142,6 @@
(generate-ensure-global loc sym mod))) (generate-ensure-global loc sym mod)))
,body))) ,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 ;;; Build a construct that establishes dynamic bindings for certain
;;; variables. We may want to choose between binding with fluids and ;;; variables. We may want to choose between binding with fluids and
;;; with-fluids* and using just ordinary module symbols and ;;; with-fluids* and using just ordinary module symbols and
@ -198,26 +187,6 @@
'fluid-ref 'fluid-ref
(make-module-ref loc module sym #t))))) (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 ;;; 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 ;;; case of a reference to value-slot, we want to generate a lexical set
;;; when the variable has a lexical binding. ;;; when the variable has a lexical binding.
@ -683,15 +652,25 @@
(if (handle-var-def loc sym doc) (if (handle-var-def loc sym doc)
(make-sequence (make-sequence
loc loc
(list (make-conditional (list
loc (make-conditional
(call-primitive loc loc
'eq? (make-conditional
(make-module-ref loc runtime 'void #t) loc
(reference-variable loc sym value-slot)) (call-primitive
(set-variable! loc sym value-slot (compile-expr value)) loc
(make-void loc)) 'module-bound?
(make-const loc sym))))))) (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) (defspecial setq (loc args)
(define (car* x) (if (null? x) '() (car x))) (define (car* x) (if (null? x) '() (car x)))
@ -742,13 +721,8 @@
((,bindings . ,body) ((,bindings . ,body)
(generate-let* loc function-slot bindings body)))) (generate-let* loc function-slot bindings body))))
;;; Temporarily disable void checks or set symbols as always lexical ;;; Temporarily set symbols as always lexical only for the lexical scope
;;; only for the lexical scope of a construct. ;;; of a construct.
(defspecial without-void-checks (loc args)
(pmatch args
((,syms . ,body)
(with-added-symbols loc disable-void-check syms body))))
(defspecial with-always-lexical (loc args) (defspecial with-always-lexical (loc args)
(pmatch args (pmatch args
@ -825,7 +799,7 @@
(((lambda ,args . ,body)) (((lambda ,args . ,body))
(compile-lambda loc args body)) (compile-lambda loc args body))
((,sym) (guard (symbol? sym)) ((,sym) (guard (symbol? sym))
(reference-with-check loc sym function-slot)))) (reference-variable loc sym function-slot))))
(defspecial defmacro (loc args) (defspecial defmacro (loc args)
(pmatch args (pmatch args
@ -890,9 +864,9 @@
(else (else
(make-application loc (make-application loc
(if (symbol? operator) (if (symbol? operator)
(reference-with-check loc (reference-variable loc
operator operator
function-slot) function-slot)
(compile-expr operator)) (compile-expr operator))
(map compile-expr arguments)))))) (map compile-expr arguments))))))
@ -903,7 +877,7 @@
(case sym (case sym
((nil) (nil-value loc)) ((nil) (nil-value loc))
((t) (t-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. ;;; Compile a single expression to TreeIL.
@ -933,12 +907,6 @@
(case key (case key
((#:warnings) ; ignore ((#:warnings) ; ignore
#f) #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) ((#:always-lexical)
(if (valid-symbol-list-arg? value) (if (valid-symbol-list-arg? value)
(fluid-set! always-lexical value) (fluid-set! always-lexical value)

17
module/language/elisp/runtime.scm
View file

@ -20,15 +20,13 @@
;;; Code: ;;; Code:
(define-module (language elisp runtime) (define-module (language elisp runtime)
#:export (void #:export (nil-value
nil-value
t-value t-value
value-slot-module value-slot-module
function-slot-module function-slot-module
elisp-bool elisp-bool
ensure-fluid! ensure-fluid!
reference-variable reference-variable
reference-variable-with-check
set-variable! set-variable!
runtime-error runtime-error
macro-error) macro-error)
@ -36,10 +34,6 @@
;;; This module provides runtime support for the Elisp front-end. ;;; 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) ;;; Values for t and nil. (FIXME remove this abstraction)
(define nil-value #nil) (define nil-value #nil)
@ -78,8 +72,7 @@
(let ((intf (resolve-interface module)) (let ((intf (resolve-interface module))
(resolved (resolve-module module))) (resolved (resolve-module module)))
(if (not (module-defined? intf sym)) (if (not (module-defined? intf sym))
(let ((fluid (make-fluid))) (let ((fluid (make-undefined-fluid)))
(fluid-set! fluid void)
(module-define! resolved sym fluid) (module-define! resolved sym fluid)
(module-export! resolved `(,sym)))))) (module-export! resolved `(,sym))))))
@ -88,12 +81,6 @@
(let ((resolved (resolve-module module))) (let ((resolved (resolve-module module)))
(fluid-ref (module-ref resolved sym)))) (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) (define (set-variable! module sym value)
(ensure-fluid! module sym) (ensure-fluid! module sym)
(let ((resolved (resolve-module module))) (let ((resolved (resolve-module module)))

2
module/language/elisp/runtime/function-slot.scm
View file

@ -48,7 +48,6 @@
(compile-let* . let*) (compile-let* . let*)
(compile-lexical-let* . lexical-let*) (compile-lexical-let* . lexical-let*)
(compile-flet* . flet*) (compile-flet* . flet*)
(compile-without-void-checks . without-void-checks)
(compile-with-always-lexical . with-always-lexical) (compile-with-always-lexical . with-always-lexical)
(compile-guile-ref . guile-ref) (compile-guile-ref . guile-ref)
(compile-guile-primitive . guile-primitive) (compile-guile-primitive . guile-primitive)
@ -71,7 +70,6 @@
let* let*
lexical-let* lexical-let*
flet* flet*
without-void-checks
with-always-lexical with-always-lexical
guile-ref guile-ref
guile-primitive guile-primitive

45
module/language/elisp/runtime/macros.scm
View file

@ -38,10 +38,9 @@
(built-in-macro prog1 (built-in-macro prog1
(lambda (form1 . rest) (lambda (form1 . rest)
(let ((temp (gensym))) (let ((temp (gensym)))
`(without-void-checks (,temp) `(lexical-let ((,temp ,form1))
(lexical-let ((,temp ,form1)) ,@rest
,@rest ,temp))))
,temp)))))
(built-in-macro prog2 (built-in-macro prog2
(lambda (form1 form2 . rest) (lambda (form1 form2 . rest)
@ -74,11 +73,10 @@
(macro-error "invalid clause in cond" cur)) (macro-error "invalid clause in cond" cur))
((null? (cdr cur)) ((null? (cdr cur))
(let ((var (gensym))) (let ((var (gensym)))
`(without-void-checks (,var) `(lexical-let ((,var ,(car cur)))
(lexical-let ((,var ,(car cur))) (if ,var
(if ,var ,var
,var ,rest))))
,rest)))))
(else (else
`(if ,(car cur) `(if ,(car cur)
(progn ,@(cdr cur)) (progn ,@(cdr cur))
@ -107,12 +105,10 @@
(if (null? tail) (if (null? tail)
x x
(let ((var (gensym))) (let ((var (gensym)))
`(without-void-checks `(lexical-let ((,var ,x))
(,var) (if ,var
(lexical-let ((,var ,x)) ,var
(if ,var ,(iterate (car tail) (cdr tail))))))))))
,var
,(iterate (car tail) (cdr tail)))))))))))
;;; Define the dotimes and dolist iteration macros. ;;; Define the dotimes and dolist iteration macros.
@ -148,16 +144,15 @@
(if (not (symbol? var)) (if (not (symbol? var))
(macro-error "expected symbol as dolist variable") (macro-error "expected symbol as dolist variable")
`(let (,var) `(let (,var)
(without-void-checks (,tailvar) (lexical-let ((,tailvar ,iter-list))
(lexical-let ((,tailvar ,iter-list)) (while ((guile-primitive not)
(while ((guile-primitive not) ((guile-primitive null?) ,tailvar))
((guile-primitive null?) ,tailvar)) (setq ,var ((guile-primitive car) ,tailvar))
(setq ,var ((guile-primitive car) ,tailvar)) ,@body
,@body (setq ,tailvar ((guile-primitive cdr) ,tailvar)))
(setq ,tailvar ((guile-primitive cdr) ,tailvar))) ,@(if (= (length args) 3)
,@(if (= (length args) 3) (list (caddr args))
(list (caddr args)) '()))))))))
'())))))))))
;;; Exception handling. unwind-protect and catch are implemented as ;;; Exception handling. unwind-protect and catch are implemented as
;;; macros (throw is a built-in function). ;;; macros (throw is a built-in function).

49
module/language/elisp/runtime/subrs.scm
View file

@ -281,11 +281,11 @@
(built-in-func symbol-value (built-in-func symbol-value
(lambda (sym) (lambda (sym)
(reference-variable-with-check value-slot-module sym))) (reference-variable value-slot-module sym)))
(built-in-func symbol-function (built-in-func symbol-function
(lambda (sym) (lambda (sym)
(reference-variable-with-check function-slot-module sym))) (reference-variable function-slot-module sym)))
(built-in-func set (built-in-func set
(lambda (sym value) (lambda (sym value)
@ -297,27 +297,48 @@
(built-in-func makunbound (built-in-func makunbound
(lambda (sym) (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)) sym))
(built-in-func fmakunbound (built-in-func fmakunbound
(lambda (sym) (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)) sym))
(built-in-func boundp (built-in-func boundp
(lambda (sym) (lambda (sym)
(elisp-bool (prim not (elisp-bool
(eq? void (and
(reference-variable value-slot-module (module-bound? (resolve-interface value-slot-module) sym)
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 (built-in-func fboundp
(lambda (sym) (lambda (sym)
(elisp-bool (prim not (elisp-bool
(eq? void (and
(reference-variable function-slot-module (module-bound? (resolve-interface function-slot-module) sym)
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 ;;; Function calls. These must take care of special cases, like using
;;; symbols or raw lambda-lists as functions! ;;; symbols or raw lambda-lists as functions!
@ -326,9 +347,7 @@
(lambda (func . args) (lambda (func . args)
(let ((real-func (cond (let ((real-func (cond
((symbol? func) ((symbol? func)
(reference-variable-with-check (reference-variable function-slot-module func))
function-slot-module
func))
((list? func) ((list? func)
(if (and (prim not (null? func)) (if (and (prim not (null? func))
(eq? (prim car func) 'lambda)) (eq? (prim car func) 'lambda))

12
test-suite/tests/elisp-compiler.test
View file

@ -234,17 +234,7 @@
(progn (setq a 1 b 2) (progn (setq a 1 b 2)
(and (eq (makunbound 'b) 'b) (and (eq (makunbound 'b) 'b)
(boundp 'a) (boundp 'a)
(not (boundp 'b))))) (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))))
(with-test-prefix/compile "Let and Let*" (with-test-prefix/compile "Let and Let*"