Implemented the flet and flet* extensions.

* module/language/elisp/README: Document it.
* module/language/elisp/compile-tree-il.scm: Implement flet and flet*.
* test-suite/tests/elisp-compiler.test: Test flet and flet*.

module/language/elisp/README

@@ -32,7 +32,9 @@ Especially still missing:
 
 Other ideas and things to think about:
   * %nil vs. #f/'() handling in Guile
-  * flet, lexical-let and/or optional lexical binding as extensions
+  * lexical-let and/or optional lexical binding as extensions
+  * compiler options for all lexical binding, no void checks
 
 Extensions over original elisp:
   * (guile-ref module symbol) construct to build a (@ module symbol) from elisp
+  * flet and flet*

module/language/elisp/compile-tree-il.scm

@@ -346,6 +346,7 @@
       (error "non-pair expression contains unquotes" expr))
     (make-const loc expr)))
 
+
 ; Compile a dolist construct.
 ; This is compiled to something along:
 ; (with-fluid* iter-var %nil
@@ -385,6 +386,45 @@
             (list (compile-expr bind iter-list))))))))
 
 
+; Compile let and let* expressions.  The code here is used both for let/let*
+; and flet/flet*, just with a different bindings module.
+
+; Let is done with a single call to with-fluids* binding them locally to new
+; values all "at once".
+(define (generate-let loc bind module bindings body)
+ (let ((let-bind (process-let-bindings loc bindings)))
+   (begin
+     (for-each (lambda (sym)
+                 (mark-fluid-needed! bind sym module))
+               (map car let-bind))
+     (call-primitive loc 'with-fluids*
+       (make-application loc (make-primitive-ref loc 'list)
+         (map (lambda (el)
+                (make-module-ref loc module (car el) #t))
+              let-bind))
+       (make-application loc (make-primitive-ref loc 'list)
+         (map (lambda (el)
+                (compile-expr bind (cdr el)))
+              let-bind))
+       (make-lambda loc '() '() '() 
+         (make-sequence loc (map (compiler bind) body)))))))
+
+; Let* is compiled to a cascaded set of with-fluid* for each binding in turn
+; so that each one already sees the preceding bindings.
+(define (generate-let* loc bind module bindings body)
+ (let ((let-bind (process-let-bindings loc bindings)))
+   (begin
+     (for-each (lambda (sym)
+                 (mark-fluid-needed! bind sym module))
+               (map car let-bind))
+     (let iterate ((tail let-bind))
+       (if (null? tail)
+         (make-sequence loc (map (compiler bind) body))
+         (call-primitive loc 'with-fluid*
+           (make-module-ref loc module (caar tail) #t)
+           (compile-expr bind (cdar tail))
+           (make-lambda loc '() '() '() (iterate (cdr tail)))))))))
+
 
 ; Compile a symbol expression.  This is a variable reference or maybe some
 ; special value like nil.
@@ -516,47 +556,26 @@
                    (cons (set-variable! loc bind sym value-slot val)
                          (iterate (cdr tailtail)))))))))))
 
-    ; Let is done with a single call to with-fluids* binding them locally to new
+    ; let/let* and flet/flet* are done using the generate-let/generate-let*
-    ; values all "at once".
+    ; methods.
+
     ((let ,bindings . ,body) (guard (and (list? bindings)
-                                         (list? body)
                                          (not (null? bindings))
                                          (not (null? body))))
-     (let ((let-bind (process-let-bindings loc bindings)))
+     (generate-let loc bind value-slot bindings body))
-       (begin
+    ((flet ,bindings . ,body) (guard (and (list? bindings)
-         (for-each (lambda (sym)
-                     (mark-fluid-needed! bind sym value-slot))
-                   (map car let-bind))
-         (call-primitive loc 'with-fluids*
-           (make-application loc (make-primitive-ref loc 'list)
-             (map (lambda (el)
-                    (make-module-ref loc value-slot (car el) #t))
-                  let-bind))
-           (make-application loc (make-primitive-ref loc 'list)
-             (map (lambda (el)
-                    (compile-expr bind (cdr el)))
-                  let-bind))
-           (make-lambda loc '() '() '() 
-             (make-sequence loc (map (compiler bind) body)))))))
-
-    ; Let* is compiled to a cascaded set of with-fluid* for each binding in turn
-    ; so that each one already sees the preceding bindings.
-    ((let* ,bindings . ,body) (guard (and (list? bindings)
-                                          (list? body)
                                           (not (null? bindings))
                                           (not (null? body))))
-     (let ((let-bind (process-let-bindings loc bindings)))
+     (generate-let loc bind function-slot bindings body))
-       (begin
+
-         (for-each (lambda (sym)
+    ((let* ,bindings . ,body) (guard (and (list? bindings)
-                     (mark-fluid-needed! bind sym value-slot))
+                                          (not (null? bindings))
-                   (map car let-bind))
+                                          (not (null? body))))
-         (let iterate ((tail let-bind))
+     (generate-let* loc bind value-slot bindings body))
-           (if (null? tail)
+    ((flet* ,bindings . ,body) (guard (and (list? bindings)
-             (make-sequence loc (map (compiler bind) body))
+                                           (not (null? bindings))
-             (call-primitive loc 'with-fluid*
+                                           (not (null? body))))
-               (make-module-ref loc value-slot (caar tail) #t)
+     (generate-let* loc bind function-slot bindings body))
-               (compile-expr bind (cdar tail))
-               (make-lambda loc '() '() '() (iterate (cdr tail)))))))))
 
     ; guile-ref allows building TreeIL's module references from within
     ; elisp as a way to access data (and primitives, for instance) within
@@ -712,6 +731,8 @@
 ; expression we need to make sure all fluids for symbols used during the
 ; compilation are created using the generate-ensure-fluid function.
 
+; XXX: Maybe don't pass bind around but instead use a fluid for it?
+
 (define (compile-tree-il expr env opts)
   (values
     (let* ((bind (make-bindings))

test-suite/tests/elisp-compiler.test

@@ -291,7 +291,23 @@
            (fset 'b 5)
            (and (fboundp 'b) (fboundp 'test)
                 (not (fboundp 'a))
-                (= a 1)))))
+                (= a 1))))
+
+  (pass-if "flet and flet*"
+    (progn (defun foobar () 42)
+           (defun test () (foobar))
+           (and (= (test) 42)
+                (flet ((foobar (lambda () 0))
+                       (myfoo (symbol-function 'foobar)))
+                  (and (= (myfoo) 42)
+                       (= (test) 0)))
+                (flet* ((foobar (lambda () 0))
+                        (myfoo (symbol-function 'foobar)))
+                  (= (myfoo) 0))
+                (flet (foobar)
+                  (defun foobar () 0)
+                  (= (test) 0))
+                (= (test) 42)))))
 
 (with-test-prefix/compile "Calling Functions"