More work on cp0 which can now swallow the compiler but cannot yet

fold any primitives.

scheme/Makefile.am

@@ -24,7 +24,7 @@ EXTRA_DIST=ikarus.boot.prebuilt ikarus.enumerations.ss \
   psyntax.internal.ss psyntax.library-manager.ss \
   unicode/unicode-char-cases.ss unicode/unicode-charinfo.ss \
   ikarus.io.ss ikarus.time-and-date.ss ikarus.not-yet-implemented.ss \
-  ikarus.string-to-number.ss
+  ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss
  
 all: $(nodist_pkglib_DATA)
 

scheme/Makefile.in

@@ -178,7 +178,7 @@ EXTRA_DIST = ikarus.boot.prebuilt ikarus.enumerations.ss \
   psyntax.internal.ss psyntax.library-manager.ss \
   unicode/unicode-char-cases.ss unicode/unicode-charinfo.ss \
   ikarus.io.ss ikarus.time-and-date.ss ikarus.not-yet-implemented.ss \
-  ikarus.string-to-number.ss
+  ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss
 
 revno = "$(shell sed 's/ .*//' ../.bzr/branch/last-revision 2>/dev/null)"
 CLEANFILES = $(nodist_pkglib_DATA) ikarus.config.ss

scheme/ikarus.compiler.altcogen.ss

@@ -1493,6 +1493,7 @@
                       (mark-nfv/frms-conf! d fs)
                       (R s vs rs fs (add-nfv d ns)))])]
                 [else (error who "invalid op d" (unparse x))])))] 
+         [(nop) (values vs rs fs ns)]
          [(logand logor logxor sll sra srl int+ int- int* bswap!
            sll/overflow) 
           (cond

scheme/ikarus.compiler.ss

@@ -15,10 +15,11 @@
 
 
 (library (ikarus.compiler)
-  (export compile-core-expr-to-port optimize-level
+  (export compile-core-expr-to-port 
           assembler-output scc-letrec optimize-cp
           current-primitive-locations eval-core
-          compile-core-expr)
+          compile-core-expr
+          cp0-effort-limit cp0-size-limit)
   (import 
     (rnrs hashtables)
     (ikarus system $fx)
@@ -29,7 +30,8 @@
         optimize-level
         fasl-write scc-letrec optimize-cp
         compile-core-expr-to-port assembler-output
-        current-primitive-locations eval-core)
+        current-primitive-locations eval-core
+        cp0-size-limit cp0-effort-limit)
     (ikarus.fasl.write)
     (ikarus.intel-assembler))
 
@@ -431,11 +433,11 @@
              [else (cons (E x) ac)]))
          (cons 'begin (f e0 (f e1 '()))))]
       [(clambda-case info body)
-       `(label: ,(case-info-label info)
+       `(    label: ,(case-info-label info)
-            ,(E-args (case-info-proper info) (case-info-args info))
+         ,(E-args (case-info-proper info) (case-info-args info))
-          ,(E body))]
+         ,(E body))]
       [(clambda g cls* cp free)
-       `(clambda (label: ,g cp: ,(E cp) ) ;free: ,(map E free))
+       `(clambda (label: ,g) ; cp: ,(E cp) ) ;free: ,(map E free))
            ,@(map E cls*))]
       [(clambda label clauses free)
        `(code ,label . ,(map E clauses))]
@@ -2997,6 +2999,8 @@
      (printf "    ~s\n" x)]))
 
 
+(define optimizer 'old)
+
 (define (compile-core-expr->code p)
   (let* ([p (recordize p)]
          [p (parameterize ([open-mvcalls #f])
@@ -3004,9 +3008,13 @@
          [p (if (scc-letrec) 
                 (optimize-letrec/scc p)
                 (optimize-letrec p))]
-         [p (source-optimize p)]
+         [p (if (eq? optimizer 'new)
+                (source-optimize p)
+                p)]
          [p (uncover-assigned/referenced p)]
-         [p (copy-propagate p)]
+         [p (if (eq? optimizer 'old)
+                (copy-propagate p)
+                p)]
          [p (rewrite-assignments p)]
          [p (sanitize-bindings p)]
          [p (optimize-for-direct-jumps p)]

scheme/last-revision

@@ -1 +1 @@
-1520
+1521

scheme/makefile.ss

@@ -17,7 +17,8 @@
 ;;; vim:syntax=scheme
 (import (only (ikarus) import))
 (import (except (ikarus) 
-          optimize-level assembler-output scc-letrec optimize-cp))
+          assembler-output scc-letrec optimize-cp
+          cp0-size-limit cp0-effort-limit))
 (import (ikarus.compiler))
 (import (except (psyntax system $bootstrap)
                 eval-core 
@@ -25,6 +26,9 @@
                 compile-core-expr-to-port))
 (import (ikarus.compiler)) ; just for fun
 
+(pretty-width 160)
+((pretty-format 'fix) ((pretty-format 'letrec)))
+
 (define scheme-library-files
   ;;; Listed in the order in which they're loaded.
   ;;;
@@ -1428,7 +1432,8 @@
     [ellipsis-map ]
     [scc-letrec i]
     [optimize-cp i]
-    [optimize-level i]
+    [cp0-size-limit i]
+    [cp0-effort-limit i]
   ))
 
 (define (macro-identifier? x) 

scheme/pass-specify-rep-primops.ss

@@ -420,8 +420,9 @@
              (prm 'mref (T x) 
                   (K (+ (* i wordsize) (- disp-vector-data vector-tag)))))]
        [else #f])
-        (prm 'mref (T x) 
+     (prm 'mref (T x) 
-           (prm 'int+ (T i) (K (- disp-vector-data vector-tag)))))])
+        (prm 'int+ (T i) (K (- disp-vector-data vector-tag)))))]
+  [(E x i) (nop)])
 
 (define-primop $vector-length unsafe
   [(V x) (prm 'mref (T x) (K (- disp-vector-length vector-tag)))]
@@ -1471,8 +1472,7 @@
 
 (define-primop $struct-ref unsafe
   [(V x i) (cogen-value-$vector-ref x i)]
-  [(E x i) (cogen-effect-$vector-ref x i)]
+  [(E x i) (nop)])
-  [(P x i) (cogen-pred-$vector-ref x i)])
 
 (define-primop $struct-set! unsafe
   [(V x i v)