From c6920dc8bae4546ffeb250570d7abc8ace9ce91c Mon Sep 17 00:00:00 2001 From: Brian Templeton Date: Mon, 16 Aug 2010 03:20:55 -0400 Subject: [PATCH] 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*"]: Signed-off-by: Andy Wingo --- module/language/elisp/compile-tree-il.scm | 24 +++++++++++++++---- module/language/elisp/runtime.scm | 29 ++++++++++++++++------- module/language/elisp/runtime/subrs.scm | 5 ++-- test-suite/tests/elisp-compiler.test | 6 ++--- 4 files changed, 45 insertions(+), 19 deletions(-) diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index ac3e185b1..0df21c7e6 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -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) diff --git a/module/language/elisp/runtime.scm b/module/language/elisp/runtime.scm index c29310d84..47306e627 100644 --- a/module/language/elisp/runtime.scm +++ b/module/language/elisp/runtime.scm @@ -78,15 +78,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. @@ -95,8 +109,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 diff --git a/module/language/elisp/runtime/subrs.scm b/module/language/elisp/runtime/subrs.scm index 10e264df6..b03a510a1 100644 --- a/module/language/elisp/runtime/subrs.scm +++ b/module/language/elisp/runtime/subrs.scm @@ -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. diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test index 0d3a8b4b4..230dc772d 100644 --- a/test-suite/tests/elisp-compiler.test +++ b/test-suite/tests/elisp-compiler.test @@ -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" -- 2.20.1