Rewrite cat.rla to be closer to what a compiler should generate.

cat.rla

@@ -1,98 +1,117 @@
 #! /home/nybble/src/c/rosella/rosella
 
-;(lambda (pathname)
-;  (let [(fd (posix-open pathname O_RDONLY))]
-;    (let [(str (make-byte-string 4096))]
-;      (let loop ()
-;        (let [(size (posix-read fd str (byte-string-size str)))] 
-;          (posix-write 1 str size))
-;        (loop)))))
-
 #S(#="lambda"
+  ; (lambda (pathname . _)
+  ;   (call-with-values
+  ;     (lambda () (posix-open pathname O_RDONLY))
+  ;     (lambda (fd errno . _)
+  ;       ((if fd
+  ;          (lambda (fd errno . _)
+  ;            (let [(str (make-byte-string 4096))]
+  ;              (letrec [(loop (lambda ()
+  ;                               (call-with-values
+  ;                                 (lambda () (posix-read fd str (byte-string-size str)))
+  ;                                 (lambda (result . _)
+  ;                                   (unless (eq? size 0)
+  ;                                     (posix-write 1 str size))
+  ;                                       (loop)))))]
+  ;                (loop))))
+  ;          k)
+  ;        fd errno))))
   #(
-    0
+    0  ; O_RDONLY
     #="posix-open"
     #S(#="template"
-      ; (lambda (fd)
+      ; (let/cc k
-      ;   (letrec [(loop (lambda ()
+      ;   (lambda (fd errno . _)
-      ;                    (let [(size (posix-read fd str (byte-string-size str)))] 
+      ;     (if fd
-      ;                      (posix-write 1 str size))
+      ;        (k (apply ... argv))
-      ;                    (loop)))]
+      ;        (k argv))))
-      ;     (loop)))
+      #(
+        #S(#="lambda"
+          ; (lambda (fd errno . _)
+          ;   (let/cc k
+          ;     (let [(str (make-byte-string 4096 0))]
+          ;       (letrec [(loop (lambda () ... k fd ...))]
+          ;         (loop)))))
           #(
             4096
+            0
+            #S(#="template"  ; loop
+              ; (let (fd str)
+              ;   (letrec [(loop (lambda ()
+              ;                    (let/cc k
+              ;                      (call-with-values
+              ;                        (lambda () (posix-read fd str (byte-string-size str)))
+              ;                        (lambda (result . _) ... k str loop ...)))))]
+              ;     loop))
+              #(
+                #="posix-read"
                 #S(#="template"
-          #(#="posix-read")
+                  ; (lambda (result . _)
-          "\x80\x81\x83\xff"  ; #(f0 f1 f3 ctx)
+                  ;   (unless (eq? result 0)
+                  ;     ((lambda _ (loop)) (posix-write 1 str result))
+                  ;     (k)))
+                  #(0 1 #="posix-write")
+                  "\x41\xfc\xfe\xff"  ; #(i1=str self=loop k ctx)
+                  2
+                  "\x00\x81\x03\xfd\; (set! f1 (car argv))
+                   \x02\x80\x81\x00\; (set! f0 (cons f1 nil))
+                   \x02\x80\x40\x80\; (set! f0 (cons i0 f0))
+                   \x02\x80\x02\x80\; (set! f0 (cons g2 f0))
+                   \x01\x81\x81\x01\; (set! f1 (eq? f1 g1))
+                   \x80\x81\x00\x80\; (set! f0 (if f1 nil f0))
+                   \x81\x81\x42\x03"; (set! f1 (if f1 i2 g3))
+                  0x81  ; f1
+                  0x80  ; f0
+                  0x41  ; i1
+                  0x43  ; i3
+                )
+              )
+              "\x80\x81"  ; #(f0 f1)
               2
               "\x00\x80\x29\x41\; (set! f0 (byte-string-size i1))
                \x02\x80\x80\x00\; (set! f0 (cons f0 nil))
                \x02\x80\x41\x80\; (set! f0 (cons i1 f0))
                \x02\x80\x40\x80\; (set! f0 (cons i0 f0))
-           \x00\x81\x02\x42"; (set! f1 (unbox i2))
+               \x00\x81\x1b\x02"; (set! f1 (lambda g2))
               0x01  ; g1
               0x80  ; f0
               0x81  ; f1
-          0x43  ; i3
+              0xff  ; ctx
-        )
-        #S(#="template"
-          ; (letrec [(loop (lambda ()
-          ;                  (let [(size (posix-read fd str (byte-string-size str)))] 
-          ;                    (posix-write 1 str size))
-          ;                  (loop)))]
-          ;   ...)
-          #(1 #="posix-write" 0)
-          "\x80\x81\x82\x40\x41"  ; #(f0 f1 f2 i0 i1)
-          2
-          "\x00\x81\x03\xfd\; (set! f1 (car argv))
-           \x02\x80\x81\x00\; (set! f0 (cons f1 nil))
-           \x02\x80\x41\x80\; (set! f0 (cons i1 f0))
-           \x02\x80\x01\x80\; (set! f0 (cons g1 f0))
-           \x01\x81\x81\x03\; (set! f1 (eq? f1 g3))
-           \x80\x81\x00\x80\; (set! f0 (if f1 nil f0))
-           \x81\x81\x43\x02"; (set! f1 (if f1 i3 g2))
-          0x81  ; f1
-          0x80  ; f0
-          0x42  ; i2
-          0x44  ; i4
-        )
-        0
-      )
-      "\xfe\xff"  ; i0=k, i1=ctx
-      5
-      "\x00\x80\x03\xfd\; (set! f0 (car argv))
-       \x04\x81\x01\x04\; (set! f1 (make-byte-string g1 g4))
-       \x00\x83\x18\x83\; (set! f3 (make-box f3))
-       \x00\x82\x1b\x02\; (set! f2 (lambda g2))
-       \x00\x84\x1b\x03\; (set! f4 (lambda g3))
-       \x40\x83\x84\x00"; (set-box! f3 f4)
-      0x82  ; f2
-      0x00  ; nil
-      0x40  ; i0
-      0x41  ; i1
-    )
-    #S(#="template"
-      #(0 #f)
-      "\x81\xfe"  ; f1 k
-      1
-      "\x00\x80\x03\xfd\; (set! f0 (car argv))
-       \x80\x80\x40\x41"; (set! f0 (if f0 i0 i1))
-      0x80  ; f0
-      0xfd  ; argv
-      0x02  ; g2
-      0x02  ; g2
             )
           )
           #()
           3
+          "\x00\x80\x03\xfd\; (set! f0 (car argv))
+           \x04\x81\x01\x02\; (set! f1 (make-byte-string g1 g2))
+           \x00\x82\x1b\x03"; (set! f2 (lambda g3))
+          0x82  ; f2
+          0x00  ; nil
+          0xfe  ; k
+          0xff  ; ctx
+        )
+      )
+      "\xfe\xff"  ; k ctx
+      1
+      "\x00\x80\x03\xfd\; (set! f0 (car argv))
+       \x80\x80\x01\x40\; (set! f0 (if f0 g1 i0))
+       \x00\x80\x1b\x80"; (set! f0 (lambda f0))
+      0x80  ; f0
+      0xfd  ; argv
+      0x40  ; i0
+      0x41  ; i1
+    )
+  )
+  #()
+  2
   "\x02\x80\x01\x00\; (set! f0 (cons g1 nil))
    \x00\x81\x03\xfd\; (set! f1 (car argv))
    \x02\x80\x81\x80\; (set! f0 (cons f1 f0))
-   \x00\x81\x1b\x03\; (set! f1 (lambda g3))
+   \x00\x81\x1b\x03"; (set! f1 (lambda g3))
-   \x00\x82\x1b\x04"; (set! f2 (lambda g4))
   0x02  ; g2
   0x80  ; f0
-  0x82  ; f2
+  0x81  ; f1
   0xff  ; ctx
 )