core: added evalarg, demos added plenty

diff --git a/demos.kl b/demos.kl
index c03202cb6d00954caf37bdc6673e1b5b2db4719e..5a85cd91825da7e9fe9d45a34d7be1bd3077f531 100644 (file)
--- a/demos.kl
+++ b/demos.kl
@@ -1,18 +1,24 @@
+(def comment (rest (K nil)))
+
 (def CC (B (C B (C B cdr)) (B (Phi cons) (C B car))))
 
-(def D (B B))
-(def T (C I))
-(def V (B C T))
-(def O (S I))
-(def M (S I I))
-(def Q (C B))
-(def L (C B M))
-(def G (B B C))
-(def E (B (B B B)))
-(def R (B B T))
-(def H (B W (B C)))
-(def U (L O))
-(def F (E T T E T))
+(def D (B B)) (comment Dabcd -> ab(cd))
+(def T (C I)) (comment Tab -> ba)
+(def V (B C T)) (comment Vabc -> cab)
+(def O (S I)) (comment Oab -> b(ab))
+(def M (S I I)) (comment Ma -> aa)
+(def Q (C B)) (comment Qabc -> b(ac))
+(def L (C B M)) (comment Lab -> a(bb))
+(def G (B B C)) (comment Gabcd -> ad(bc))
+(def E (B (B B B))) (comment Eabcde -> ab(cde))
+(def R (B B T)) (comment Rabc -> bca)
+(def H (B W (B C))) (comment Habc -> abcb)
+(def U (L O)) (comment Uab -> b(aab))
+(def F (E T T E T)) (comment Fabc -> cba)
+
+(def B1 (B B B)) (comment B1abcd -> a(bcd))
+(def B2 (B B1 B)) (comment B2abcde -> a(bcde))
+(def B3 (B (B B) B)) (comment B3abcd -> a(b(cd)))
 
 (def C* (B C))
 (def C** (B C*))
@@ -26,6 +32,10 @@
 
 (def Cn (Z (B (S (C (eq 0) C)) (B (B (B C)) (B D (C B (C - 1)))))))
 
+(def import (B (B B) B (map unquote) parse readfile))
+(comment apparently it is that easy)
+
+
 (def abstract-generator (Z (B (B (B (B (C (C C nil))))) (B (Phi B (B S (B cons))) (B (B W) (B (B B)))))))
 
 (def abstract-rec (B (B (B (C B cons))) (B (B (B B)) (B (B (B Z)) (C (B B (B B (B B (B S (C (C Phi cdr) car))))) (B (B (C B)) (B (C B (C B cdr)) (B (Phi cons) (C (C Phi car) cdr)))))))))
@@ -52,15 +62,18 @@
 
 (def fac (Z (D S (C (eq 0) 1) (D S * (C B (C - 1))))))
 
-(def range (S (C (eq 0) nil) (B (Z (B B S (S (B (eq 0) car) cdr) (C B (Phi cons (B (C - 1) car) (Phi cons car cdr))))) (C cons nil))))
+(def range (abstract-rec (eq 0) (C cons) (C - 1) nil))
+(comment def range (S (C (eq 0) nil) (B (Z (B B S (S (B (eq 0) car) cdr) (C B (Phi cons (B (C - 1) car) (Phi cons car cdr))))) (C cons nil))))
 
-(def reverse (B (Z (B (S (S (B (eq nil) cdr) car)) (C B (Phi cons (Phi cons (B car cdr) car) (B cdr cdr))))) (cons nil)))
+(def reverse (abstract-rec not (C (B cons car)) cdr nil))
+(comment def reverse (B (Z (B (S (S (B (eq nil) cdr) car)) (C B (Phi cons (Phi cons (B car cdr) car) (B cdr cdr))))) (cons nil)))
 
 (def nth (B (B car) (B (C I cdr) (C - 1))))
 
 (def list (rest (map unquote)))
 
-(def len (B (Z (B (S (S (B (eq nil) cdr) car)) (C B (CC (+ 1) cdr)))) (cons 0)))
+(def len (abstract-rec not (B K (+ 1)) cdr 0))
+(comment def len (B (Z (B (S (S (B (eq nil) cdr) car)) (C B (CC (+ 1) cdr)))) (cons 0)))
 
 (def map (B (B reverse) (B (B (Z (B (S (S (B (eq nil) (2 cdr)) (B car cdr))) (C B (S (B cons car) (Phi cons (Phi cons (S car (B (B car cdr) cdr)) (B car cdr)) (3 cdr))))))) (C (B B cons) (cons nil)))))
 
@@ -71,7 +84,7 @@
 
 (def fibonacci-generator (Z (B (B (C (C C nil))) (B (Phi cons (Phi + car cdr)) (C B (Phi cons (Phi + car cdr) car))))))
 
-(def tr-fac (B (S (Phi (eq 0) cdr car)) (C B (Phi cons (Phi * car cdr) (B (C - 1) cdr)))))
+(comment def tr-fac (B (S (Phi (eq 0) cdr car)) (C B (Phi cons (Phi * car cdr) (B (C - 1) cdr)))))
 
 (def append (B (C (abstract-rec not (B (C B car) (C cons)) cdr)) reverse))
 
@@ -79,3 +92,7 @@
 
 (def qsort ((B Z (B (B (S (W atom))) (Phi (Phi (Phi append)) (B (C B) (C (B (Phi filter) (B (B (B not)) (C B car))) cdr)) (B (B (Phi cons car)) (B (C B) (C (B (Phi filter) (C B car)) cdr))))))))
 
+(def x-times-n (C (C (D abstract-rec (eq 0) (D B K cons)) (C - 1)) nil))
+(comment (x-times-n x 5) -> (x x x x x))
+
+(def m-rand-n (B (C (C (D abstract-rec (eq 0) (D B K cons)) (C - 1)) nil) rand))
\ No newline at end of file

diff --git a/src/builtins.c b/src/builtins.c
index 65f577b07acf346d8d8478a92e17747d172f2763..b312f0d9404671628ebdb26815e76fd01fb3c918 100644 (file)
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -157,6 +157,8 @@ char* lookup_builtin(Sexpr* b) {
                        return CORE_UNQUOTE_STR;
                case CORE_APPLYN:
                        return CORE_APPLYN_STR;
+               case CORE_EVALARG:
+                       return CORE_EVALARG_STR;
                case CORE_TYPE:
                        return CORE_TYPE_STR;
                case CORE_DEF:

diff --git a/src/builtins/core.c b/src/builtins/core.c
index aeb497cf328cfc94ee5a5778da05babe21482975..6caf7ab36317bc1af883636656af7b357d0bf598 100644 (file)
--- a/src/builtins/core.c
+++ b/src/builtins/core.c
@@ -181,6 +181,16 @@ Sexpr* c_applyn(Sexpr* b, Sexpr* rest, Sexpr* env) {
        return cons(ret, rest);
 }
 
+Sexpr* c_evalarg(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       if(CORE_EVALARG_ARGS != u64_get_num_args(b))
+               return cons(b, rest);
+       Sexpr* args = b->value.b.args;
+       Sexpr* argeval = eval(clone(car(args)), env);
+       Sexpr* fn = clone(car(cdr(args)));
+       sexpr_free(b);
+       return cons(fn, cons(argeval, rest));
+}
+
 Sexpr* c_type(Sexpr* b, Sexpr* rest, Sexpr* env) {
        // umm guess I gotta eval...
        if(CORE_TYPE_ARGS != u64_get_num_args(b))
@@ -261,6 +271,8 @@ Sexpr* x_core_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
                return c_unquote(b, rest, env);
        case CORE_APPLYN:
                return c_applyn(b, rest, env);
+       case CORE_EVALARG:
+               return c_evalarg(b, rest, env);
        case CORE_TYPE:
                return c_type(b, rest, env);
        case CORE_DEF:
@@ -284,7 +296,8 @@ Sexpr* load_core_env(Sexpr* env) {
        load_builtin(CORE_ATOM_STR, (CORE_PREFIX << 8) | CORE_ATOM, env);
        load_builtin(CORE_REST_STR, (CORE_PREFIX << 8) | CORE_REST, env);
        load_builtin(CORE_UNQUOTE_STR, (CORE_PREFIX << 8) | CORE_UNQUOTE, env);
-       
+               load_builtin(CORE_EVALARG_STR, (CORE_PREFIX << 8) | CORE_EVALARG, env);
+
        load_builtin(CORE_TYPE_STR, (CORE_PREFIX << 8) | CORE_TYPE, env);
        load_builtin(CORE_DEF_STR, (CORE_PREFIX << 8) | CORE_DEF, env);
        load_builtin(CORE_EXIT_STR, (CORE_PREFIX << 8) | CORE_EXIT, env);

diff --git a/src/builtins/core.h b/src/builtins/core.h
index 760afb60a5d1e61dbfc43981894c8554649ff23d..5e02dd460fa140ec93bc73ea87e04a32e5562e96 100644 (file)
--- a/src/builtins/core.h
+++ b/src/builtins/core.h
@@ -38,6 +38,9 @@
 #define CORE_APPLYN 0x09
 #define CORE_APPLYN_ARGS 3
 #define CORE_APPLYN_STR "applyn"
+#define CORE_EVALARG 0x0a
+#define CORE_EVALARG_ARGS 2
+#define CORE_EVALARG_STR "evalarg"
 
 #define CORE_TYPE 0xfd
 #define CORE_TYPE_ARGS 1