1
Fork 0
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:
BT Templeton 2011-07-30 17:12:13 -04:00
parent 0ab2a63af1
commit 35724ee1dc
2 changed files with 12 additions and 22 deletions

View file

@ -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))))

View file

@ -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 ...))))))))