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 <wingo@pobox.com>

diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm
index ac3e185..0df21c7 100644 (file)
--- 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 c29310d..47306e6 100644 (file)
--- 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 10e264d..b03a510 100644 (file)
--- 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 0d3a8b4..230dc77 100644 (file)
--- 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"