* before attempting to use chaitin to compile the system.

src/libaltcogen.ss

@@ -1570,14 +1570,20 @@
         [else (error who "invalid tail ~s" x)])]
       [else (error who "invalid tail ~s" x)]))
   ;;;
+  (define (properize args proper ac)
+    (cond
+      [proper ac]
+      [else
+       (error 'properize "not yet")
+       ac]))
+  ;;;
   (define (ClambdaCase x) 
     (record-case x
       [(clambda-case info body)
        (record-case info
          [(case-info L args proper)
-          (unless proper (error who "improper lambda"))
+          (properize args proper
-          (cons (label L) 
+            (cons (label L) (T body '())))])]))
-                (T body '()))])]))
   ;;;
   (define (Clambda x)
     (record-case x

src/libcompile.ss

@@ -5221,7 +5221,21 @@
       (close-input-port ip)
       (close-output-port op))))
 
+(define alt-compile-file
+  (lambda (input-file output-file . rest)
+    (let ([ip (open-input-file input-file)]
+          [op (apply open-output-file output-file rest)])
+      (let f ()
+        (let ([x (read ip)])
+          (unless (eof-object? x)
+            (fasl-write (alt-compile-expr x) op)
+            (f))))
+      (close-input-port ip)
+      (close-output-port op))))
+
+
 (primitive-set! 'compile-file compile-file)
+(primitive-set! 'alt-compile-file alt-compile-file)
 (primitive-set! 'assembler-output (make-parameter #f))
 (primitive-set! 'compile
   (lambda (x)

src/libcxr.ss

@@ -1,17 +1,18 @@
 
-(primitive-set! 'car (lambda (x) (car x)))
+;(primitive-set! 'car (lambda (x) (car x)))
-(primitive-set! 'cdr (lambda (x) (cdr x)))
+;(primitive-set! 'cdr (lambda (x) (cdr x)))
-(primitive-set! 'cadr (lambda (x) (cadr x)))
+;(primitive-set! 'cadr (lambda (x) (cadr x)))
+
 (let ([err (lambda (who x)
              (error who "invalid list structure ~s" x))])
-  ;(primitive-set!
+  (primitive-set!
-  ;  'car
+    'car
-  ;  (lambda (orig)
+    (lambda (orig)
-  ;    (if (pair? orig) ($car orig) (err 'car orig))))
+      (if (pair? orig) ($car orig) (err 'car orig))))
-  ;(primitive-set!
+  (primitive-set!
-  ;  'cdr
+    'cdr
-  ;  (lambda (orig)
+    (lambda (orig)
-  ;    (if (pair? orig) ($cdr orig) (err 'cdr orig))))
+      (if (pair? orig) ($cdr orig) (err 'cdr orig))))
   (primitive-set!
     'caar
     (lambda (orig)
@@ -19,13 +20,13 @@
           (let ([x ($car orig)])
             (if (pair? x) ($car x) (err 'caar orig)))
           (err 'caar orig))))
-  ;(primitive-set!
+  (primitive-set!
-  ;  'cadr
+    'cadr
-  ;  (lambda (orig)
+    (lambda (orig)
-  ;    (if (pair? orig)
+      (if (pair? orig)
-  ;        (let ([x ($cdr orig)])
+          (let ([x ($cdr orig)])
-  ;          (if (pair? x) ($car x) (err 'cadr orig)))
+            (if (pair? x) ($car x) (err 'cadr orig)))
-  ;        (err 'cadr orig))))
+          (err 'cadr orig))))
   (primitive-set!
     'cdar
     (lambda (orig)

src/makefile.ss

@@ -56,6 +56,7 @@
     dynamic-wind display write print-graph fasl-write printf fprintf format
     print-error read-token read comment-handler error warning exit call/cc
     error-handler eval current-eval compile alt-compile compile-file
+    alt-compile-file
     new-cafe load system expand sc-expand current-expand expand-mode
     environment? interaction-environment identifier?
     free-identifier=? bound-identifier=? literal-identifier=?
@@ -225,29 +226,29 @@
 (whack-system-env #t)
 
 (define scheme-library-files
-  '(["libhandlers.ss"   "libhandlers.fasl"  p0]
+  '(["libhandlers.ss"   "libhandlers.fasl"  p0 onepass]
-    ["libcontrol.ss"    "libcontrol.fasl"   p0]
+    ["libcontrol.ss"    "libcontrol.fasl"   p0 onepass]
-    ["libcollect.ss"    "libcollect.fasl"   p0]
+    ["libcollect.ss"    "libcollect.fasl"   p0 onepass]
-    ["librecord.ss"     "librecord.fasl"    p0]
+    ["librecord.ss"     "librecord.fasl"    p0 onepass]
-    ["libcxr.ss"        "libcxr.fasl"       p0]
+    ["libcxr.ss"        "libcxr.fasl"       p0 onepass]
-    ["libnumerics.ss"   "libnumerics.fasl"  p0]
+    ["libnumerics.ss"   "libnumerics.fasl"  p0 onepass]
-    ["libguardians.ss"  "libguardians.fasl" p0]
+    ["libguardians.ss"  "libguardians.fasl" p0 onepass]
-    ["libcore.ss"       "libcore.fasl"      p0]
+    ["libcore.ss"       "libcore.fasl"      p0 onepass]
-    ["libchezio.ss"     "libchezio.fasl"    p0]
+    ["libchezio.ss"     "libchezio.fasl"    p0 onepass]
-    ["libhash.ss"       "libhash.fasl"      p0]
+    ["libhash.ss"       "libhash.fasl"      p0 onepass]
-    ["libwriter.ss"     "libwriter.fasl"    p0]
+    ["libwriter.ss"     "libwriter.fasl"    p0 onepass]
-    ["libtokenizer.ss"  "libtokenizer.fasl" p0]
+    ["libtokenizer.ss"  "libtokenizer.fasl" p0 onepass]
-    ["libassembler.ss"  "libassembler.fasl" p0]
+    ["libassembler.ss"  "libassembler.fasl" p0 onepass]
-    ["libintelasm.ss"   "libintelasm.fasl"  p0]
+    ["libintelasm.ss"   "libintelasm.fasl"  p0 onepass]
-    ["libfasl.ss"       "libfasl.fasl"      p0]
+    ["libfasl.ss"       "libfasl.fasl"      p0 onepass]
-    ["libtrace.ss"      "libtrace.fasl"     p0]
+    ["libtrace.ss"      "libtrace.fasl"     p0 onepass]
-    ["libcompile.ss"    "libcompile.fasl"   p1]
+    ["libcompile.ss"    "libcompile.fasl"   p1 onepass]
-    ["psyntax-7.1.ss"   "psyntax.fasl"      p0]
+    ["psyntax-7.1.ss"   "psyntax.fasl"      p0 onepass]
-    ["libpp.ss"         "libpp.fasl"        p0]
+    ["libpp.ss"         "libpp.fasl"        p0 onepass]
-    ["libcafe.ss"       "libcafe.fasl"      p0]
+    ["libcafe.ss"       "libcafe.fasl"      p0 onepass]
-    ["libposix.ss"      "libposix.fasl"     p0]
+    ["libposix.ss"      "libposix.fasl"     p0 onepass]
-    ["libtimers.ss"     "libtimers.fasl"    p0]
+    ["libtimers.ss"     "libtimers.fasl"    p0 onepass]
-    ["libtoplevel.ss"   "libtoplevel.fasl"  p0]
+    ["libtoplevel.ss"   "libtoplevel.fasl"  p0 onepass]
     ))
 
 
@@ -263,12 +264,18 @@
 (define (expand-file ifile)
   (map sc-expand (read-file ifile)))
 
-(define (compile-library ifile ofile)
+(define (compile-library ifile ofile which-compile)
   (parameterize ([assembler-output #f] 
                  [expand-mode 'bootstrap]
                  [interaction-environment system-env])
-     (printf "compiling ~a ... \n" ifile)
+     (let ([proc 
-     (compile-file ifile ofile 'replace)))
+            (case which-compile
+              [(onepass) compile-file]
+              [(chaitin) alt-compile-file]
+              [else (error 'compile-library "unknown compile ~s"
+                           which-compile)])])
+      (printf "compiling ~a ... \n" ifile)
+      (proc ifile ofile 'replace))))
 
 
 
@@ -277,7 +284,7 @@
     (for-each
       (lambda (x)
         (when (eq? who (caddr x))
-          (compile-library (car x) (cadr x))))
+          (compile-library (car x) (cadr x) (cadddr x))))
       scheme-library-files))
   (define (time x) x)
   (fork