mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 01:00:20 +02:00
Code Activity

simplify elisp symbol accessors

Browse source 
* module/language/elisp/boot.el (fset, symbol-value, symbol-function)
  (set, makunbound, fmakunbound, boundp, fboundp): Use procedures in
  `(language elisp runtime)'.
  (symbolp): New function.

* module/language/elisp/compile-tree-il.scm (set-variable!): Use
  `set-symbol-function!'.

* module/language/elisp/runtime.scm (reference-variable, set-variable!):
  Remove.
  (symbol-fluid, set-symbol-fluid!): New procedure.
  (symbol-value, set-symbol-value!, symbol-function)
  (set-symbol-function!, symbol-bound?, symbol-fbound?, makunbound!)
  (fmakunbound!): Moved from `(language elisp subrs)' and updated to
  avoid using `reference-variable' and `set-variable!'.

* module/language/elisp/runtime/subrs.scm (symbol-value)
  (symbol-function, set, fset, makunbound, fmakunbound, boundp)
  (fboundp): Move to `(language elisp runtime)'.
  (apply): Use `symbol-function'.
This commit is contained in:
BT Templeton 2011-07-12 20:56:38 -04:00
parent 12ca82caa2
commit 85bc6238bf
4 changed files with 92 additions and 99 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -22,80 +22,17 @@
(define-module (language elisp runtime subrs)
#:use-module (language elisp runtime)
#:use-module (system base compile)
#:export (symbol-value
symbol-function
set
fset
makunbound
fmakunbound
boundp
fboundp
apply
#:export (apply
eval
load))
;;; Accessing symbol bindings for symbols known only at runtime.
(define (symbol-value sym)
(reference-variable value-slot-module sym))
(define (symbol-function sym)
(reference-variable function-slot-module sym))
(define (set sym value)
(set-variable! value-slot-module sym value))
(define (fset sym value)
(set-variable! function-slot-module sym value))
(define (makunbound sym)
(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)
(define (fmakunbound sym)
(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)
(define (boundp 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))))))
(define (fboundp 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!
(define (apply func . args)
(let ((real-func (cond
((symbol? func)
(reference-variable function-slot-module func))
(symbol-function func))
((list? func)
(if (and (prim not (null? func))
(eq? (prim car func) 'lambda))