diff --git a/src/examples/test-foldr.rla b/src/examples/test-foldr.rla new file mode 100644 index 0000000..9ea2c7f --- /dev/null +++ b/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: diff --git a/src/lib/primitive/cons.rla b/src/lib/primitive/cons.rla new file mode 100644 index 0000000..d315728 --- /dev/null +++ b/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: diff --git a/src/lib/primitive/foldr.rla b/src/lib/primitive/foldr.rla new file mode 100644 index 0000000..4e118fa --- /dev/null +++ b/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: diff --git a/src/lib/primitive/list.rla b/src/lib/primitive/list.rla index 8465165..7c4c1a9 100644 --- a/src/lib/primitive/list.rla +++ b/src/lib/primitive/list.rla @@ -1,69 +1,18 @@ ;; Returns a copy of the argument list ; (define (list . lst) -; (if (pair? lst) -; (cons (car lst) -; (apply list (cdr lst))) -; lst)) - -#0=#S(#="lambda" - ; (define (list . lst) - ; ((if (pair? lst) - ; (lambda () (cons (car lst) - ; (apply list (cdr lst)))) - ; (lambda () lst)))) +; (foldr cons nil lst)) +#S(#="lambda" #( - #S(#="template" - ; (lambda () lst) - #(#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 - ) + #i"foldr.rla" + #i"cons.rla" ) #() 1 - "\x00\x80\x0b\xfd\; (set! f0 (pair? argv)) - \x80\x80\x02\x01\; (set! f0 (if f0 g2 g1)) - \x00\x80\x1b\x80"; (set! f0 (lambda f0)) + "\x02\x80\xfd\x00\; (set! f0 (cons argv nil)) + \x02\x80\x00\x80\; (set! f0 (cons nil f0)) + \x02\x80\x02\x80"; (set! f0 (cons g2 f0)) + 0x01 ; g1 0x80 ; f0 - 0x00 ; nil 0xfe ; k 0xff ; ctx )