mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
remove dynamic function binding
* module/language/elisp/compile-tree-il.scm (find-operator): Assume that `name' is lexically bound. * module/language/elisp/runtime.scm (symbol-fbound?, fmakunbound!): Assume that `symbol' is lexically bound. (defspecial): Bind special operators lexically.
This commit is contained in:
parent
0ab2a63af1
commit
35724ee1dc
2 changed files with 12 additions and 22 deletions
|
@ -529,12 +529,11 @@
|
|||
|
||||
;;; Handle macro and special operator bindings.
|
||||
|
||||
(define (find-operator sym type)
|
||||
(define (find-operator name type)
|
||||
(and
|
||||
(symbol? sym)
|
||||
(module-defined? (resolve-interface function-slot) sym)
|
||||
(let* ((op (module-ref (resolve-module function-slot) sym))
|
||||
(op (if (fluid? op) (fluid-ref op) op)))
|
||||
(symbol? name)
|
||||
(module-defined? (resolve-interface function-slot) name)
|
||||
(let ((op (module-ref (resolve-module function-slot) name)))
|
||||
(if (and (pair? op) (eq? (car op) type))
|
||||
(cdr op)
|
||||
#f))))
|
||||
|
|
|
@ -108,12 +108,9 @@
|
|||
(define (symbol-fbound? symbol)
|
||||
(and
|
||||
(module-bound? (resolve-interface function-slot-module) symbol)
|
||||
(let* ((var (module-variable (resolve-module function-slot-module)
|
||||
symbol)))
|
||||
(and (variable-bound? var)
|
||||
(if (fluid? (variable-ref var))
|
||||
(fluid-bound? (variable-ref var))
|
||||
#t)))))
|
||||
(variable-bound?
|
||||
(module-variable (resolve-module function-slot-module)
|
||||
symbol))))
|
||||
|
||||
(define (makunbound! symbol)
|
||||
(if (module-bound? (resolve-interface value-slot-module) symbol)
|
||||
|
@ -126,12 +123,9 @@
|
|||
|
||||
(define (fmakunbound! symbol)
|
||||
(if (module-bound? (resolve-interface function-slot-module) symbol)
|
||||
(let ((var (module-variable
|
||||
(resolve-module function-slot-module)
|
||||
symbol)))
|
||||
(if (and (variable-bound? var) (fluid? (variable-ref var)))
|
||||
(fluid-unset! (variable-ref var))
|
||||
(variable-unset! var))))
|
||||
(variable-unset! (module-variable
|
||||
(resolve-module function-slot-module)
|
||||
symbol)))
|
||||
symbol)
|
||||
|
||||
;;; Define a predefined macro for use in the function-slot module.
|
||||
|
@ -155,8 +149,5 @@
|
|||
(syntax-case x ()
|
||||
((_ name args body ...)
|
||||
(with-syntax ((scheme-name (make-id #'name 'compile- #'name)))
|
||||
#'(begin
|
||||
(define scheme-name (make-fluid))
|
||||
(fluid-set! scheme-name
|
||||
(cons 'special-operator
|
||||
(lambda args body ...)))))))))
|
||||
#'(define scheme-name
|
||||
(cons 'special-operator (lambda args body ...))))))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue