before adding make-once thunks

lib/libcompile.ss

@@ -1102,7 +1102,8 @@
 
 
 
-
+;(define thunk-count 0)
+;(define total-count 0)
 (define (convert-closures prog)
   (define who 'convert-closures)
   (define (Expr* x*)
@@ -1136,6 +1137,10 @@
                                        cls*)
                                  (union (difference body-free fml*) 
                                         cls*-free)))])]))])
+          ;(set! total-count (fxadd1 total-count))
+          ;(when (null? free) 
+          ;  (set! thunk-count (fxadd1 thunk-count))
+          ;  (printf "EMPTY CLOSURE ~s/~s\n" thunk-count total-count))
           (values (make-closure (make-clambda-code (gensym) cls* free) free)
                   free))]))
   (define (Expr ex)
@@ -3623,7 +3628,9 @@
          (handle-cases (car cases) (cdr cases)))]))
   (record-case x
     [(codes list body)
-     (cons (cons 0 (Tail body '()))
+     (cons (list* 0
+                  (label (gensym))
+                  (Tail body '()))
            (map CodeExpr list))]))
 
 
@@ -3872,15 +3879,15 @@
          [p (insert-stack-overflow-checks p)]
          [p (insert-allocation-checks p)]
          [p (remove-local-variables p)]
-         [p (optimize-ap-check p)]
-         [ls* (generate-code p)]
-         [f (when (assembler-output)
-              (for-each 
-                (lambda (ls)
-                  (for-each (lambda (x) (printf "    ~s\n" x)) ls))
-                ls*))]
-         [code* (list*->code* ls*)])
-    (car code*)))
+         [p (optimize-ap-check p)])
+    (let ([ls* (generate-code p)])
+      (when (assembler-output)
+        (for-each 
+          (lambda (ls)
+            (for-each (lambda (x) (printf "    ~s\n" x)) ls))
+          ls*))
+      (let ([code* (list*->code* ls*)])
+        (car code*)))))
 
 (define compile-file
   (lambda (input-file output-file . rest)