Implemented prog1, prog2, dotimes, dolist control structures.

* module/language/elisp/README: Document it and some further ideas written down.
* module/language/elisp/compile-tree-il.scm: Implement prog1, dolist.
* module/language/elisp/runtime/macro-slot.scm: prog2 and dotimes.
* test-suite/tests/elisp-compiler.test: Test prog1, prog2, dotimes, dolist.

module/language/elisp/README

@@ -5,11 +5,11 @@ This is more or less a lot of work in progress.  Here are some notes as well
 as status information.
 
 Already implemented:
-  * progn
+  * progn, prog1, prog2
   * if, cond, when, unless
   * not, and, or
   * referencing and setting (setq) variables
-  * while, dotimes
+  * while, dotimes, dolist
   * let, let*
   * lambda expressions, function calls using list notation
   * some built-ins (mainly numbers/arithmetic)
@@ -18,8 +18,6 @@ Already implemented:
   * quotation and backquotation with unquote/unquote-splicing
 
 Especially still missing:
-  * other progX forms, will be done in macros
-  * dolist using macros
   * catch/throw, unwind-protect
   * real elisp reader instead of Scheme's
   * set, makunbound, boundp functions
@@ -31,3 +29,10 @@ Especially still missing:
   * need fluids for function bindings?
   * recursive macros
   * anonymous macros
+
+Other ideas and things to think about:
+  * %nil vs. #f/'() handling in Guile, possibly get rid of setting empty rest
+    arguments to %nil
+  * don't ensure-fluids for variables known to be let- or argument-bound
+  * or, perhaps, get rid of ensure-fluids over all but rather scan all code for
+    variables and create all needed fluids beforehand

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

@@ -365,6 +365,47 @@
       (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
+;   (lambda ()
+;     (let iterate ((tail list))
+;       (if (null? tail)
+;         result
+;         (begin
+;           (fluid-set! iter-var (car tail))
+;           body
+;           (iterate (cdr tail)))))))
+
+(define (compile-dolist loc var iter-list result body)
+  (let* ((tailvar (gensym))
+         (iterate (gensym))
+         (tailref (make-lexical-ref loc tailvar tailvar))
+         (iterate-func (make-lambda loc `(,tailvar) `(,tailvar) '()
+                         (make-conditional loc
+                           (call-primitive loc 'null? tailref)
+                           (compile-expr result)
+                           (make-sequence loc
+                             `(,(set-variable! loc var value-slot
+                                  (call-primitive loc 'car tailref))
+                               ,@(map compile-expr body)
+                               ,(make-application loc
+                                  (make-lexical-ref loc iterate iterate)
+                                  (list (call-primitive loc 'cdr
+                                          tailref)))))))))
+
+    (make-sequence loc
+      (list (ensure-fluid! loc var value-slot)
+            (call-primitive loc 'with-fluid*
+              (make-module-ref loc value-slot var #t)
+              (nil-value loc)
+              (make-lambda loc '() '() '()
+                (make-letrec loc `(,iterate) `(,iterate) `(,iterate-func)
+                  (make-application loc
+                    (make-lexical-ref loc iterate iterate)
+                    (list (compile-expr iter-list))))))))))
+
+
 
 ; Compile a symbol expression.  This is a variable reference or maybe some
 ; special value like nil.
@@ -384,6 +425,16 @@
     ((progn . ,forms)
      (make-sequence loc (map compile-expr forms)))
 
+    ; I chose to implement prog1 directly (not with macros) so that the
+    ; temporary variable used can be a lexical one that is not backed by a fluid
+    ; for better performance.
+    ((prog1 ,form1 . ,forms)
+     (let ((temp (gensym)))
+       (make-let loc `(,temp) `(,temp) `(,(compile-expr form1))
+         (make-sequence loc
+           (append (map compile-expr forms)
+                   (list (make-lexical-ref loc temp temp)))))))
+
     ((if ,condition ,ifclause)
      (make-conditional loc (compile-expr condition)
                            (compile-expr ifclause)
@@ -544,6 +595,13 @@
        (make-letrec loc '(iterate) (list itersym) (list iter-thunk)
          iter-call)))
 
+    ; dolist is treated here rather than as macro because it can take advantage
+    ; of a non-fluid-based variable.
+    ((dolist (,var ,iter-list) . ,body) (guard (symbol? var))
+     (compile-dolist loc var iter-list 'nil body))
+    ((dolist (,var ,iter-list ,result) . ,body) (guard (symbol? var))
+     (compile-dolist loc var iter-list result body))
+
     ; Either (lambda ...) or (function (lambda ...)) denotes a lambda-expression
     ; that should be compiled.
     ((lambda ,args . ,body)

module/language/elisp/runtime/macro-slot.scm

@@ -28,6 +28,14 @@
 ; here.
 
 
+; The prog2 construct can be directly defined in terms of prog1 and progn,
+; so this is done using a macro.
+
+(built-in-macro prog2
+  (lambda (form1 form2 . rest)
+    `(progn ,form1 (prog1 ,form2 ,@rest))))
+
+
 ; Define the conditionals when and unless as macros.
 
 (built-in-macro when
@@ -39,11 +47,15 @@
     `(if ,condition nil (progn ,@elses))))
 
 
-; Define the dotimes and dolist iteration macros.
+; Define the dotimes iteration macro.
 ; As the variable has to be bound locally for elisp, this needs to go through
 ; the dynamic scoping fluid system.  So we can't speed these forms up by
 ; implementing them directly in the compiler with just a lexical variable
 ; anyways.
+; For dolist, on the other hand, we have to bind the elisp variable to the
+; list elements but keep track of the list-tails in another one.  Therefore,
+; this can take advantage of real compilation because of circumventing the
+; fluid-system for this variable.
 
 (built-in-macro dotimes
   (lambda (args . body)

test-suite/tests/elisp-compiler.test

@@ -50,7 +50,19 @@
   (pass-if-equal "progn" 1
     (progn (setq a 0)
            (setq a (1+ a))
-           a)))
+           a))
+
+  (pass-if "prog1"
+    (progn (setq a 0)
+           (setq b (prog1 a (setq a (1+ a))))
+           (and (= a 1) (= b 0))))
+
+  (pass-if "prog2"
+    (progn (setq a 0)
+           (setq b (prog2 (setq a (1+ a))
+                          (setq a (1+ a))
+                          (setq a (1+ a))))
+           (and (= a 3) (= b 2)))))
 
 (with-test-prefix/compile "Conditionals"
 
@@ -122,7 +134,18 @@
                      (setq j (1+ i))
                      (setq a (+ a j))))
            (setq c (dotimes (i 10 42) nil))
-           (and (= a 5050) (equal b nil) (= c 42)))))
+           (and (= a 5050) (equal b nil) (= c 42))))
+
+  (pass-if "dolist"
+    (let ((mylist '(7 2 5)))
+      (setq sum 0)
+      (setq a (dolist (i mylist)
+                (setq sum (+ sum i))))
+      (setq b (dolist (i mylist 5) 0))
+      (and (= sum (+ 7 2 5))
+           (equal a nil)
+           (equal mylist '(7 2 5))
+           (equal b 5)))))
 
 
 ; Test handling of variables.