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:
parent
761e60535b
commit
c2eb58825c
4 changed files with 45 additions and 19 deletions
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
||||||
|
|
|
@ -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"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue