From: Elijah Cohen Date: Fri, 3 Jan 2025 17:03:32 +0000 (-0600) Subject: core: added evalarg, demos added plenty X-Git-Tag: v-12.13.13~1 X-Git-Url: https://git.eli173.com/?a=commitdiff_plain;h=e11a9bf1726c65a8ccdae90aa8588715fd0004ed;p=klapaucius core: added evalarg, demos added plenty --- diff --git a/demos.kl b/demos.kl index c03202c..5a85cd9 100644 --- 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 65f577b..b312f0d 100644 --- 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 aeb497c..6caf7ab 100644 --- 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 760afb6..5e02dd4 100644 --- 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