1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00

lexical function binding for elisp

* module/language/elisp/compile-tree-il.scm (access-variable)
  (reference-variable, set-variable!): Handle globally-bound non-special
  variables.

  (bind-lexically?): Create lexical bindings for flet and flet*.

* module/language/elisp/runtime.scm (reference-variable, set-variable!):
  Handle globally-bound non-special variables.

  (built-in-func): Set the variable directly instead of storing the
  function in a fluid.

* module/language/elisp/runtime/subrs.scm (funcall): Call apply
  directly.

* test-suite/tests/elisp-compiler.test ("Function Definitions")["flet
  and flet*"]:
This commit is contained in:
Brian Templeton 2010-08-16 03:20:55 -04:00
parent 761e60535b
commit c2eb58825c
4 changed files with 45 additions and 19 deletions

View file

@ -165,11 +165,17 @@
;;; on whether it is currently lexically or dynamically bound. lexical
;;; access is done only for references to the value-slot module!
(define (access-variable loc sym module handle-lexical handle-dynamic)
(define (access-variable loc
sym
module
handle-global
handle-lexical
handle-dynamic)
(let ((lexical (get-lexical-binding (fluid-ref bindings-data) sym)))
(if (and lexical (equal? module value-slot))
(handle-lexical lexical)
(handle-dynamic))))
(cond
(lexical (handle-lexical lexical))
((equal? module function-slot) (handle-global))
(else (handle-dynamic)))))
;;; Generate code to reference a variable. For references in the
;;; value-slot module, we may want to generate a lexical reference
@ -180,6 +186,7 @@
loc
sym
module
(lambda () (make-module-ref loc module sym #t))
(lambda (lexical) (make-lexical-ref loc lexical lexical))
(lambda ()
(mark-global-needed! (fluid-ref bindings-data) sym module)
@ -196,6 +203,11 @@
loc
sym
module
(lambda ()
(make-application
loc
(make-module-ref loc runtime 'set-variable! #t)
(list (make-const loc module) (make-const loc sym) value)))
(lambda (lexical) (make-lexical-set loc lexical lexical value))
(lambda ()
(mark-global-needed! (fluid-ref bindings-data) sym module)
@ -227,10 +239,12 @@
;;; dynamically. A symbol will be bound lexically if and only if: We're
;;; processing a lexical-let (i.e. module is 'lexical), OR we're
;;; processing a value-slot binding AND the symbol is already lexically
;;; bound or it is always lexical.
;;; bound or is always lexical, OR we're processing a function-slot
;;; binding.
(define (bind-lexically? sym module)
(or (eq? module 'lexical)
(eq? module function-slot)
(and (equal? module value-slot)
(let ((always (fluid-ref always-lexical)))
(or (eq? always 'all)

View file

@ -77,15 +77,29 @@
(module-export! resolved `(,sym))))))
(define (reference-variable module sym)
(ensure-fluid! module sym)
(let ((resolved (resolve-module module)))
(fluid-ref (module-ref resolved sym))))
(cond
((equal? module function-slot-module)
(module-ref resolved sym))
(else
(ensure-fluid! module sym)
(fluid-ref (module-ref resolved sym))))))
(define (set-variable! module sym value)
(ensure-fluid! module sym)
(let ((resolved (resolve-module module)))
(fluid-set! (module-ref resolved sym) value)
value))
(let ((intf (resolve-interface module))
(resolved (resolve-module module)))
(cond
((equal? module function-slot-module)
(cond
((module-defined? intf sym)
(module-set! resolved sym value))
(else
(module-define! resolved sym value)
(module-export! resolved `(,sym)))))
(else
(ensure-fluid! module sym)
(fluid-set! (module-ref resolved sym) value))))
value)
;;; Define a predefined function or predefined macro for use in the
;;; function-slot and macro-slot modules, respectively.
@ -94,8 +108,7 @@
(syntax-rules ()
((_ name value)
(begin
(define-public name (make-fluid))
(fluid-set! name value)))))
(define-public name value)))))
(define (make-id template-id . data)
(let ((append-symbols

View file

@ -358,9 +358,8 @@
(prim apply (@ (guile) apply) real-func args))))
(built-in-func funcall
(let ((myapply (fluid-ref apply)))
(lambda (func . args)
(myapply func args))))
(lambda (func . args)
(apply func args)))
;;; Throw can be implemented as built-in function.

View file

@ -460,13 +460,13 @@
(flet ((foobar (lambda () 0))
(myfoo (symbol-function 'foobar)))
(and (= (myfoo) 42)
(= (test) 0)))
(= (test) 42)))
(flet* ((foobar (lambda () 0))
(myfoo (symbol-function 'foobar)))
(= (myfoo) 0))
(= (myfoo) 42))
(flet (foobar)
(defun foobar () 0)
(= (test) 0))
(= (test) 42))
(= (test) 42)))))
(with-test-prefix/compile "Calling Functions"