code cleanup

lib/libcompile.ss

@@ -1188,6 +1188,9 @@
           free (unparse prog)))
    prog))
 
+(define (optimize-closures x)
+  (define who 'optimize-closures)
+  x)
 
 (define (lift-codes x)
   (define who 'lift-codes)
@@ -1226,9 +1229,6 @@
   (let ([x (E x)])
     (make-codes all-codes x)))
 
-
-
-            
 (define (syntactically-valid? op rand*)
   (define (valid-arg-count? op rand*)
     (let ([n (open-coded-primitive-args op)] [m (length rand*)])
@@ -1331,20 +1331,17 @@
        (or (null? rand*)
            (valid-arg-types? op rand*))))
 
-
+(begin ;;; UNINLINED ANALYSIS
   ;;; the output of simplify-operands differs from the input in that the 
   ;;; operands to primcalls are all simple (variables, primrefs, or constants).
   ;;; funcalls to open-codable primrefs whos arguments are "ok" are converted to
   ;;; primcalls.  
-
-
   (define uninlined '())
   (define (mark-uninlined x)
     (cond
       [(assq x uninlined) =>
        (lambda (p) (set-cdr! p (fxadd1 (cdr p))))]
       [else (set! uninlined (cons (cons x 1) uninlined))]))
-
   (module ()
     (primitive-set! 'uninlined-stats 
       (lambda () 
@@ -1353,7 +1350,7 @@
             [(null? ls) ac]
             [(fx> (cdar ls) 15)
              (f (cdr ls) (cons (car ls) ac))]
-          [else (f (cdr ls) ac)])))))
+            [else (f (cdr ls) ac)]))))))
 
 (define (introduce-primcalls x)
   (define who 'introduce-primcalls)
@@ -1445,7 +1442,6 @@
        (make-codes (map CodeExpr list) (Tail body))]))
   (CodesExpr x))
 
-
 (define (simplify-operands x)
   (define who 'simplify-operands)
   (define (simple? x) 
@@ -1522,7 +1518,6 @@
        (make-codes (map CodeExpr list) (Tail body))]))
   (CodesExpr x))
 
-
 (define (insert-stack-overflow-checks x)
   (define who 'insert-stack-overflow-checks)
   (define (insert-check body)
@@ -1580,7 +1575,6 @@
                        body))]))
   (CodesExpr x))
 
-
 (define (insert-allocation-checks x)
   (define who 'insert-allocation-checks)
   (define (check-bytes n var body)
@@ -1724,8 +1718,6 @@
        (make-codes (map CodeExpr list) (Tail body))]))
   (CodesExpr x))
 
-
-
 (define (remove-local-variables x)
   (define who 'remove-local-variables)
   (define (simple* x* r)
@@ -1967,9 +1959,6 @@
                    (Tail body 1 '() '()))]))
   (CodesExpr x))
 
-
-
-(define checks-elim-count 0)
 (define (optimize-ap-check x)
   (define who 'optimize-ap-check)
   (define (min x y)
@@ -1998,8 +1987,6 @@
        (let ([n (constant-value (car arg*))])
          (cond
            [(fx< n f) 
-            ;(set! checks-elim-count (fxadd1 checks-elim-count))
-            ;(printf "~s checks eliminated\n" checks-elim-count)
             (values (make-constant #f) (fx- f n))]
            [(fx<= n 4096)
             (values (make-primcall '$ap-check-const 
@@ -2073,7 +2060,7 @@
                    (Tail body 0))]))
   (CodesExpr x))
 
-(begin
+(begin ;;; DEFINITIONS
   (define fx-shift 2)
   (define fx-mask #x03)
   (define fx-tag 0)
@@ -2162,10 +2149,9 @@
   (define align-shift 3)
   (define dirty-word -1))
 
+(begin ;;; COGEN HELERS
   (define (align n)
     (fxsll (fxsra (fx+ n (fxsub1 object-alignment)) align-shift) align-shift))
-
-(begin
   (define (mem off val)
     (cond
       [(fixnum? off) (list 'disp (int off) val)]
@@ -2234,7 +2220,6 @@
   (define (argc-convention n)
     (fx- 0 (fxsll n fx-shift))))
 
-
 (define pcb-ref
   (lambda (x)
     (case x
@@ -2254,7 +2239,6 @@
   (mem (fx- disp-symbol-system-value symbol-tag)
         (obj op)))
 
-
 (define (generate-code x)
   (define who 'generate-code)
   (define (rp-label x)
@@ -3681,13 +3665,11 @@
                   (Tail body '()))
            (map CodeExpr list))]))
 
-
+(begin ;;; ASSEMBLY HELPERS
   (define SL_nonprocedure (gensym "SL_nonprocedure"))
-
   (define SL_top_level_value_error (gensym "SL_top_level_value_error"))
   (define SL_car_error (gensym "SL_car_error"))
   (define SL_cdr_error (gensym "SL_cdr_error"))
-
   (define SL_invalid_args (gensym "SL_invalid_args"))
   (define SL_foreign_call (gensym "SL_foreign_call"))
   (define SL_continuation_code (gensym "SL_continuation_code"))
@@ -3699,7 +3681,6 @@
   (define SL_apply (gensym "SL_apply"))
   (define SL_values (gensym "SL_values"))
   (define SL_call_with_values (gensym "SL_call_with_values"))
-
   (module ()
     (list*->code* (lambda (x) #f)
       (list
@@ -3907,9 +3888,7 @@
               (movl (mem 0 ebx) ebx)
               (jmp (mem disp-multivalue-rp ebx))
               ))
-    )))
-
-
+        ))))
 
 (define (compile-expr expr)
   (let* ([p (recordize expr)]
@@ -3921,6 +3900,7 @@
          [p (copy-propagate p)]
          [p (rewrite-assignments p)]
          [p (convert-closures p)]
+         [p (optimize-closures p)]
          [p (lift-codes p)]
          [p (introduce-primcalls p)]
          [p (simplify-operands p)]