From c6500a53b38d3ce9ac6df0d6a435c989cd7749e1 Mon Sep 17 00:00:00 2001
From: Jesse McDonald <nybble41@gmail.com>
Date: Sun, 11 Apr 2010 05:50:29 -0500
Subject: [PATCH] Commit implementation of (foldl ...) function.

---
 src/examples/test-foldl.rla | 35 ++++++++++++++++
 src/examples/test-list.rla  |  2 +-
 src/lib/primitive/foldl.rla | 79 +++++++++++++++++++++++++++++++++++++
 3 files changed, 115 insertions(+), 1 deletion(-)
 create mode 100644 src/examples/test-foldl.rla
 create mode 100644 src/lib/primitive/foldl.rla

diff --git a/src/examples/test-foldl.rla b/src/examples/test-foldl.rla
new file mode 100644
index 0000000..c1d79de
--- /dev/null
+++ b/src/examples/test-foldl.rla
@@ -0,0 +1,35 @@
+#S(#="lambda"
+  ; (define (test-foldl)
+  ;   (foldl + 0 '(2 3 4 5)))
+  #(
+    #i"../lib/primitive/foldl.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:
diff --git a/src/examples/test-list.rla b/src/examples/test-list.rla
index 7246375..007cc8f 100644
--- a/src/examples/test-list.rla
+++ b/src/examples/test-list.rla
@@ -8,7 +8,7 @@
   #()
   0
   ""
-  0x01  ; g0
+  0x01  ; g1
   0x02  ; g2
   0xfe  ; k
   0xff  ; ctx
diff --git a/src/lib/primitive/foldl.rla b/src/lib/primitive/foldl.rla
new file mode 100644
index 0000000..8714334
--- /dev/null
+++ b/src/lib/primitive/foldl.rla
@@ -0,0 +1,79 @@
+;; Fold a function over a list; left-associative
+;; (foldl fn init lst)
+;; ==> (foldl fn (fn init (car lst)) (cdr lst))
+
+; (define (foldl fn init lst)
+;   (if (pair? lst)
+;     (foldl fn (fn init (car lst)) (cdr lst))
+;     init))
+
+#0=#S(#="lambda"
+  ; (define (foldl fn init lst)
+  ;   ((if (pair? lst)
+  ;      (lambda () (foldl fn (fn init (car lst)) (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
+      ;     (call-with-multiple-values
+      ;       (lambda (new-init)
+      ;         (k (foldl fn new-init (cdr lst))))
+      ;       (lambda () (fn init (car lst))))))
+      #(
+        #S(#="template"
+          ; (lambda (new-init)
+          ;   (k (foldl fn new-init (cdr lst))))
+          #(#=0)
+          "\x40\x41\x42\xfe\xff"  ; i0 i1 i2 k ctx
+          2
+          "\x00\x80\x04\x42\; (set! f0 (cdr i2))
+           \x02\x80\x80\x00\; (set! f0 (cons f0 nil))
+           \x00\x81\x03\xfd\; (set! f1 (car argv))
+           \x02\x80\x81\x80\; (set! f0 (cons f1 f0))
+           \x02\x80\x40\x80"; (set! f0 (cons i0 f0))
+          0x01  ; g1
+          0x80  ; f0
+          0x43  ; i3
+          0x44  ; i4
+        )
+      )
+      "\x80\x81\x82" ; f0=fn f1=init f2=lst
+      2
+      "\x00\x80\x03\x42\; (set! f0 (car i2))
+       \x02\x80\x80\x00\; (set! f0 (cons f0 nil))
+       \x02\x80\x41\x80\; (set! f0 (cons i1 f0))
+       \x00\x81\x1b\x01"; (set! f1 (lambda g1))
+      0x40  ; i0
+      0x80  ; f0
+      0x81  ; f1
+      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! f0 (lambda f3))
+  0x83  ; f0
+  0x00  ; nil
+  0xfe  ; k
+  0xff  ; ctx
+)
+; vim:set syntax= sw=2 expandtab: