Commit (foldr ...) function, and refactor (list ...) to use it.

src/examples/test-foldr.rla

@@ -0,0 +1,35 @@
+#S(#="lambda"
+  ; (define (test-foldr)
+  ;   (foldr + 0 '(2 3 4 5)))
+  #(
+    #i"../lib/primitive/foldr.rla"
+    (
+      #S(#="lambda"
+        ; (define (+ x y)
+        ;   (fix+ x y))
+        #(#f)
+        #()
+        2
+        "\x00\x80\x03\xfd\; (set! f0 (car argv))
+         \x00\x81\x04\xfd\; (set! f1 (cdr argv))
+         \x00\x81\x03\x81\; (set! f1 (car f1))
+         \x08\x80\x80\x81\; (set! f0 (fix+ f0 f1))
+         \x02\x80\x80\x00"; (set! f0 (cons f0 nil))
+        0xfe  ; k
+        0x80  ; f0
+        0x01  ; g1
+        0x01  ; g1
+      )
+      0
+      (2 3 4 5)
+    )
+  )
+  #()
+  0
+  ""
+  0x01  ; g1
+  0x02  ; g2
+  0xfe  ; k
+  0xff  ; ctx
+)
+; vim:set syntax= sw=2 expandtab:

src/lib/primitive/cons.rla

@@ -0,0 +1,17 @@
+#S(#="lambda"
+  ; (define (cons x y)
+  ;   (builtin-cons x y))
+  #(#f)
+  #()
+  2
+  "\x00\x80\x03\xfd\; (set! f0 (car argv))
+   \x00\x81\x04\xfd\; (set! f1 (cdr argv))
+   \x00\x81\x03\x81\; (set! f1 (car f1))
+   \x02\x80\x80\x81\; (set! f0 (cons f0 f1))
+   \x02\x80\x80\x00"; (set! f0 (cons f0 nil))
+  0xfe  ; k
+  0x80  ; f0
+  0x01  ; g1
+  0x01  ; g1
+)
+; vim:set syntax= sw=2 expandtab:

src/lib/primitive/foldr.rla

@@ -0,0 +1,81 @@
+;; Fold a function over a list; right-associative
+;; (foldr fn init lst)
+;; ==> (fn (car lst) (foldr fn init (cdr lst)))
+
+; (define (foldr fn init lst)
+;   (if (pair? lst)
+;     (fn (car lst)
+;         (foldr fn init (cdr lst)))
+;     init))
+
+#0=#S(#="lambda"
+  ; (define (foldr fn init lst)
+  ;   ((if (pair? lst)
+  ;      (lambda () (fn (car lst)
+  ;                     (foldr fn init (cdr lst))))
+  ;      (lambda () init))))
+  #(
+    #S(#="template"
+      ; (lambda () init)
+      #(#f)
+      "\x81" ; f1
+      1
+      "\x02\x80\x40\x00"; (set! f0 (cons i0 nil))
+      0xfe  ; k
+      0x80  ; f0
+      0x01  ; g1
+      0x01  ; g1
+    )
+    #S(#="template"
+      ; (lambda ()
+      ;   (let/cc k
+      ;     (let ([lstcar (car lst)])
+      ;       (call-with-multiple-values
+      ;         (lambda (v) (k (fn lstcar v)))
+      ;         (lambda () (foldr fn init (cdr lst)))))))
+      #(
+        #S(#="template"
+          ; (lambda (v) (k (fn lstcar v)))
+          #()
+          "\x40\x81\xfe\xff"  ; i0 f1 k ctx
+          1
+          "\x00\x80\x03\xfd\; (set! f0 (car argv))
+           \x02\x80\x80\x00\; (set! f0 (cons f0 nil))
+           \x02\x80\x41\x80"; (set! f0 (cons i1 f0))
+          0x40  ; i0
+          0x80  ; f0
+          0x42  ; i2
+          0x43  ; i3
+        )
+        #=0  ; foldr
+      )
+      "\x80\x81\x82" ; f0=fn f1=init f2=lst
+      4
+      "\x00\x80\x04\x42\; (set! f0 (cdr i2))
+       \x00\x81\x03\x42\; (set! f1 (car i2))
+       \x00\x82\x1b\x01\; (set! f2 (lambda g1))
+       \x02\x83\x80\x00\; (set! f3 (cons f0 nil))
+       \x02\x83\x41\x83\; (set! f3 (cons i1 f3))
+       \x02\x83\x40\x83"; (set! f3 (cons i0 f3))
+      0x02  ; g2
+      0x83  ; f3
+      0x82  ; f2
+      0xff  ; ctx
+    )
+  )
+  #()
+  4
+  "\x00\x80\x03\xfd\; (set! f0 (car argv)) ; f0=fn
+   \x00\x82\x04\xfd\; (set! f2 (cdr argv))
+   \x00\x81\x03\x82\; (set! f1 (car f2))   ; f1=init
+   \x00\x82\x04\x82\; (set! f2 (cdr f2))
+   \x00\x82\x03\x82\; (set! f2 (car f2))   ; f2=lst
+   \x00\x83\x0b\x82\; (set! f3 (pair? f2))
+   \x83\x83\x02\x01\; (set! f3 (if f3 g2 g1))
+   \x00\x83\x1b\x83"; (set! f3 (lambda f3))
+  0x83  ; f3
+  0x00  ; nil
+  0xfe  ; k
+  0xff  ; ctx
+)
+; vim:set syntax= sw=2 expandtab:

src/lib/primitive/list.rla

@@ -1,69 +1,18 @@
 ;; Returns a copy of the argument list
 ; (define (list . lst)
-;   (if (pair? lst)
+;   (foldr cons nil lst))
-;     (cons (car lst)
+#S(#="lambda"
-;           (apply list (cdr lst)))
-;     lst))
-
-#0=#S(#="lambda"
-  ; (define (list . lst)
-  ;   ((if (pair? lst)
-  ;      (lambda () (cons (car lst)
-  ;                       (apply list (cdr lst))))
-  ;      (lambda () lst))))
   #(
-    #S(#="template"
+    #i"foldr.rla"
-      ; (lambda () lst)
+    #i"cons.rla"
-      #(#f)
-      "\xfd" ; argv=lst
-      1
-      "\x02\x80\x40\x00"; (set! f0 (cons i0 nil))
-      0xfe  ; k
-      0x80  ; f0
-      0x01  ; g1
-      0x01  ; g1
-    )
-    #S(#="template"
-      ; (lambda ()
-      ;   (let/cc k
-      ;     (let ([lstcar (car lst)])
-      ;       (call-with-multiple-values
-      ;         (lambda (v) (k (cons lstcar v)))
-      ;         (lambda () (apply list (cdr lst)))))
-      #(
-        #S(#="template"
-          ; (lambda (v) (k (cons lstcar v)))
-          #(#f)
-          "\x81\xfe"  ; f1 k
-          1
-          "\x00\x80\x03\xfd\; (set! f0 (car argv))
-           \x02\x80\x40\x80\; (set! f0 (cons i0 f0))
-           \x02\x80\x80\x00"; (set! f0 (cons f0 nil))
-          0x41  ; i1
-          0x80  ; f0
-          0x01  ; g1
-          0x01  ; g1
-        )
-        #=0  ; list
-      )
-      "\xfd" ; argv=lst
-      3
-      "\x00\x80\x04\x40\; (set! f0 (cdr i0))
-       \x00\x81\x03\x40\; (set! f1 (car i0))
-       \x00\x82\x1b\x01"; (set! f2 (lambda g1))
-      0x02  ; g2
-      0x80  ; f0
-      0x82  ; f2
-      0xff  ; ctx
-    )
   )
   #()
   1
-  "\x00\x80\x0b\xfd\; (set! f0 (pair? argv))
+  "\x02\x80\xfd\x00\; (set! f0 (cons argv nil))
-   \x80\x80\x02\x01\; (set! f0 (if f0 g2 g1))
+   \x02\x80\x00\x80\; (set! f0 (cons nil f0))
-   \x00\x80\x1b\x80"; (set! f0 (lambda f0))
+   \x02\x80\x02\x80"; (set! f0 (cons g2 f0))
+  0x01  ; g1
   0x80  ; f0
-  0x00  ; nil
   0xfe  ; k
   0xff  ; ctx
 )