Update peval tests for fix-letrec

* module/language/tree-il/fix-letrec.scm (fix-scc): Initial binding of
  letrec values is unspecified, not false.
* test-suite/tests/peval.test (pass-if-peval): Fix letrec before
  pevalling.  Update tests.  A couple got better, no regressions.

module/language/tree-il/fix-letrec.scm

@@ -207,7 +207,7 @@
       ((and (lambda? init) (not (hashq-ref assigned sym)))
        (make-fix src (list name) (list sym) (list init) body))
       ((memq sym (free-variables init fv-cache))
-       (make-let src (list name) (list sym) (list (make-const src #f))
+       (make-let src (list name) (list sym) (list (make-void src))
                  (make-seq src
                            (make-lexical-set src name sym init)
                            body)))

test-suite/tests/peval.test

@@ -24,6 +24,7 @@
   #:use-module (system base message)
   #:use-module (language tree-il)
   #:use-module (language tree-il primitives)
+  #:use-module (language tree-il fix-letrec)
   #:use-module (rnrs bytevectors) ;; for the bytevector primitives
   #:use-module (srfi srfi-13))
 
@@ -35,10 +36,11 @@
   (syntax-rules ()
     ((_ in pat)
      (pass-if-peval in pat
+                    (fix-letrec
                      (expand-primitives
                       (resolve-primitives
                        (compile 'in #:from 'scheme #:to 'tree-il)
-                      (current-module)))))
+                       (current-module))))))
     ((_ in pat code)
      (pass-if 'in
        (let ((evaled (unparse-tree-il (peval code))))
@@ -544,7 +546,7 @@
                          b
                          (f (car x3) (fold f (cdr x3) b null? car cdr))))))
       (fold * x 1 zero? (lambda (x1) x1) (lambda (x2) (- x2 1))))
-    (letrec (fold) (_) (_)
+    (fix (fold) (_) (_)
             (call (lexical fold _)
                    (primitive *)
                    (toplevel x)
@@ -756,7 +758,7 @@
                   x)))
       (frob f) ; may mutate `x'
       x)
-    (letrec (x) (_) ((const 0))
+    (let (x) (_) ((const 0))
          (seq
           (call (toplevel frob) (lambda _ _))
           (lexical x _))))
@@ -767,7 +769,7 @@
                   (set! f (lambda (_) x))
                   x)))
       (f 2))
-    (letrec _ . _))
+    (let (f) (_) ((void)) (seq _ (call . _))))
 
   (pass-if-peval
     ;; Bindings possibly mutated.
@@ -783,7 +785,7 @@
     ;; Inlining stops at recursive calls with dynamic arguments.
     (let loop ((x x))
       (if (< x 0) x (loop (1- x))))
-    (letrec (loop) (_) ((lambda (_)
+    (fix (loop) (_) ((lambda (_)
                        (lambda-case
                         (((x) #f #f #f () (_))
                          (if _ _
@@ -812,7 +814,7 @@
           (if (< x 0)
               x
               (loop (1+ x) (1+ y)))))
-    (letrec (loop) (_) ((lambda (_)
+    (fix (loop) (_) ((lambda (_)
                        (lambda-case
                         (((x y) #f #f #f () (_ _))
                          (if (primcall >
@@ -821,12 +823,12 @@
          (call (lexical loop _) (toplevel x) (const 0))))
 
   (pass-if-peval
-    ;; Infinite recursion: `peval' gives up and leaves it as is.
+    ;; Infinite recursion: `peval' can inline some but eventually gives up.
     (letrec ((f (lambda (x) (g (1- x))))
              (g (lambda (x) (h (1+ x))))
              (h (lambda (x) (f x))))
       (f 0))
-    (letrec _ . _))
+    (fix (f) (_) (_) (call . _)))
 
   (pass-if-peval
     ;; Infinite recursion: all the arguments to `loop' are static, but
@@ -834,7 +836,7 @@
     (let loop ((x 0))
       (and (< x top)
            (loop (1+ x))))
-    (letrec (loop) (_) ((lambda . _))
+    (fix (loop) (_) ((lambda . _))
          (call (lexical loop _) (const 0))))
 
   (pass-if-peval
@@ -851,24 +853,23 @@
                (call (lexical here _))))))
 
   (pass-if-peval
-   ;; FIXME: should this one residualize the binding?
+   ;; FIXME: Signal an error?
    (letrec ((a a))
      1)
-   (const 1))
+   (let (a) (_) ((void)) (seq (set! . _) (const 1))))
 
   (pass-if-peval
    ;; This is a fun one for peval to handle.
    (letrec ((a a))
      a)
-   (letrec (a) (_) ((lexical a _))
+   (let (a) (_) ((void)) (seq (set! . _) (lexical a _))))
-           (lexical a _)))
 
   (pass-if-peval
    ;; Another interesting recursive case.
    (letrec ((a b) (b a))
      a)
-   (letrec (a) (_) ((lexical a _))
+   (let (a b) (_ _) ((void) (void))
-           (lexical a _)))
+        (seq (set! . _) (seq (set! . _) (lexical a _)))))
 
   (pass-if-peval
    ;; Another pruning case, that `a' is residualized.
@@ -881,16 +882,17 @@
    ;; "b c a" is the current order that we get with unordered letrec,
    ;; but it's not important to this test, so if it changes, just adapt
    ;; the test.
-   (letrec (b a) (_ _)
+   (fix (a) (_)
         ((lambda _
            (lambda-case
             ((() #f #f #f () ())
-                (call (lexical a _)))))
+             (call (lexical a _))))))
-            (lambda _
+        (fix (b) (_)
+             ((lambda _
                 (lambda-case
                  ((() #f #f #f () ())
                   (call (lexical a _))))))
-     (call (toplevel foo) (lexical b _))))
+             (call (toplevel foo) (lexical b _)))))
 
   (pass-if-peval
    ;; In this case, we can prune the bindings.  `a' ends up being copied
@@ -1239,11 +1241,11 @@
    ;; reference.)
    (while #t #t)
    (let (_) (_) ((primcall make-prompt-tag . _))
-        (letrec (lp) (_)
+        (fix (lp) (_)
              ((lambda _
                 (lambda-case
                  ((() #f #f #f () ())
-                     (letrec (loop) (_)
+                  (fix (loop) (_)
                        ((lambda _
                           (lambda-case
                            ((() #f #f #f () ())
@@ -1397,7 +1399,7 @@
     (lambda ()
       (lambda-case
        (((f x) #f #f #f () (_ _))
-        (letrec (lp)
+        (fix (lp)
              (_)
              ((lambda ((name . lp))
                 (lambda-case