1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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 ;;; on whether it is currently lexically or dynamically bound. lexical
;;; access is done only for references to the value-slot module! ;;; 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))) (let ((lexical (get-lexical-binding (fluid-ref bindings-data) sym)))
(if (and lexical (equal? module value-slot)) (cond
(handle-lexical lexical) (lexical (handle-lexical lexical))
(handle-dynamic)))) ((equal? module function-slot) (handle-global))
(else (handle-dynamic)))))
;;; Generate code to reference a variable. For references in the ;;; Generate code to reference a variable. For references in the
;;; value-slot module, we may want to generate a lexical reference ;;; value-slot module, we may want to generate a lexical reference
@ -180,6 +186,7 @@
loc loc
sym sym
module module
(lambda () (make-module-ref loc module sym #t))
(lambda (lexical) (make-lexical-ref loc lexical lexical)) (lambda (lexical) (make-lexical-ref loc lexical lexical))
(lambda () (lambda ()
(mark-global-needed! (fluid-ref bindings-data) sym module) (mark-global-needed! (fluid-ref bindings-data) sym module)
@ -196,6 +203,11 @@
loc loc
sym sym
module 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 (lexical) (make-lexical-set loc lexical lexical value))
(lambda () (lambda ()
(mark-global-needed! (fluid-ref bindings-data) sym module) (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 ;;; 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 lexical-let (i.e. module is 'lexical), OR we're
;;; processing a value-slot binding AND the symbol is already lexically ;;; 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) (define (bind-lexically? sym module)
(or (eq? module 'lexical) (or (eq? module 'lexical)
(eq? module function-slot)
(and (equal? module value-slot) (and (equal? module value-slot)
(let ((always (fluid-ref always-lexical))) (let ((always (fluid-ref always-lexical)))
(or (eq? always 'all) (or (eq? always 'all)

View file

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

View file

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

View file

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