miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fully functional now, removing set!, set-idx!, array-with-len, and making concat a builtin. Also, added 2 fun rules to new_kraken that allow nesting of new_kraken and k_prime languages

Browse Source
This commit is contained in:
Nathan Braswell
2021-01-17 19:57:33 -05:00
parent 7d7b2bd6d5
commit 1f8fb59220
4 changed files with 48 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
k_prime.krak
View File

@@ -176,7 +176,7 @@ obj KPCombiner (Object) {
}
fun operator==(other: ref KPCombiner):bool {
// not sure about env
return env == other.env && dynamic_env_name == other.dynamic_env_name && wrap_level == other.wrap_level && parameters == other.parameters && is_variadic == other.is_variadic && body->equals(*other.body)
return env == other.env && dynamic_env_name == other.dynamic_env_name && wrap_level == other.wrap_level && parameters == other.parameters && is_variadic == other.is_variadic && body->equals(*other.body)
}
// no call b/c need to do in EVAL for TCO
fun prep_call(params: ref vec<KPValue>, dynamic_env: KPValue): pair<*KPEnv, KPResult> {
@@ -810,21 +810,6 @@ fun main(argc: int, argv: **char): int {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("wrong number of params to eval"))))
}));
env->set(str("set!"), make_builtin_combiner(str("set!"), 0, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
if params.size != 2 {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("not 2 params to set!"))))
}
if !params[0].is_symbol() {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("first parameter to set! is not a symbol"))))
}
var data = EVAL(dynamic_env, params[1])
if is_err(data) {
return make_pair(null<KPEnv>(), data)
}
dynamic_env->set(params[0].get_symbol_text(), get_value(data))
return make_pair(null<KPEnv>(), KPResult::Ok(kpNil()))
}));
// cond uses TCO
env->set(str("cond"), make_builtin_combiner(str("cond"), 0, true, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
if (params.size % 2) != 0 {
@@ -873,17 +858,6 @@ fun main(argc: int, argv: **char): int {
env->set(str("array"), make_builtin_combiner(str("array"), 1, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
return make_pair(null<KPEnv>(), KPResult::Ok(kpArray(params)))
}));
env->set(str("array-with-len"), make_builtin_combiner(str("array-with-len"), 1, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
if !params[0].is_int() {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("Called array-with-len with not an int"))))
}
var to_ret = vec<KPValue>()
var l = params[0].get_int()
for (var i = 0; i < l; i++;) {
to_ret.add(kpNil())
}
return make_pair(null<KPEnv>(), KPResult::Ok(kpArray(to_ret)))
}));
env->set(str("array?"), make_builtin_combiner(str("array?"), 1, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
if params.size != 1 {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("Need 1 param to array?"))))
@@ -921,17 +895,6 @@ fun main(argc: int, argv: **char): int {
return make_pair(null<KPEnv>(), KPResult::Ok(kpInt((params[0].get_string()[index]) cast int)))
}
}));
env->set(str("set-idx!"), make_builtin_combiner(str("set-idx!"), 1, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
if params.size != 3 {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("Need 3 params to set-idx!"))))
}
if !params[0].is_array() { return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("Param 1 to set-idx! is not array")))); }
if !params[1].is_int() { return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("Param 2 to set-idx! is not int")))); }
params[0].get_array_rc().get()[params[1].get_int()] = params[2];
return make_pair(null<KPEnv>(), KPResult::Ok(kpNil()))
}));
env->set(str("slice"), make_builtin_combiner(str("slice"), 1, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
if params.size != 3 {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("Need 3 params to slice"))))
@@ -948,6 +911,14 @@ fun main(argc: int, argv: **char): int {
return make_pair(null<KPEnv>(), KPResult::Ok(kpString(params[0].get_string().slice(start, end))))
}
}));
env->set(str("concat"), make_builtin_combiner(str("concat"), 1, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
var to_ret = vec<KPValue>()
for (var i = 0; i < params.size; i++;) {
if !params[i].is_array() { return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("param to concat is not an array")))); }
to_ret += params[i].get_array_rc().get()
}
return make_pair(null<KPEnv>(), KPResult::Ok(kpArray(to_ret)));
}));
env->set(str("+"), make_builtin_combiner(str("+"), 1, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
var to_ret = 0

13
new_kraken.kp
View File

@@ -18,7 +18,7 @@
make_constructor (lambda (name members methods)
`(~rec-lambda ~name ~members
(~with-meta [,members]
[,(map_with_idx (lambda (i x) [array `'~x (lambda (o) (idx o i))]) members)
[,(map_i (lambda (i x) [array `'~x (lambda (o) (idx o i))]) members)
,(map (lambda (x) [array `'~(idx x 0) (idx x 1)]) methods)])))
@@ -40,7 +40,7 @@
new_kraken_untyped (concat basic_rules [
new_kraken_untyped (concat standard_grammar [
[ 'expr [ 'number ] (lambda (x) x) ]
[ 'expr [ 'string ] (lambda (x) x) ]
@@ -87,11 +87,16 @@
(lambda (_ inner) (construct_body true [do] (map (lambda (x) (idx x 0)) inner) 0)) ]
[ 'expr [ "$\"" [ "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*$" 'expr ] * "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
[ 'expr [ "$\"" [ "(#|[%-[]| |[]-~]|(\\\\\\\\)|(\\\\n)|(\\\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*$" 'expr ] * "(#|[%-[]| |[]-~]|(\\\\\\\\)|(\\\\n)|(\\\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*\"" ]
(lambda (_ string_expr_pairs end) `(str ,( flat_map (lambda (x) [ (fixup_str_parts (idx x 0)) (idx x 1) ]) string_expr_pairs) ~(fixup_str_parts end))) ]
; Swapping back and forth between underlying Lisp syntax
; Might want to disable this when we start doing typing
; till we figure out how to type Vau and such.
[ 'expr [ "\\\\" 'form ] (lambda (_ inner) inner) ]
[ 'form [ "\\\\" 'expr ] (lambda (_ inner) inner) ]
]))
(provide new_kraken_untyped)
)

8
new_kraken_test.kp
View File

@@ -37,5 +37,13 @@ fun test() {
println("post after + a b" +(a b))
with_import "./import_test.kp":
println("post new impot after + a b" +(a b))
println("We're back baby" \(+ 1 13
(do
(println "hahaha" 'a \{
let a = 75
let b = 75
println("Inside hahaha more HAHAHAA " +(1 2 a b))
"Inside Result"
}) 4)))
}
println("Test result is" test())

56
prelude.kp
View File

@@ -9,16 +9,10 @@
(eval (idx s i) se) (recurse recurse s (+ i 1) se)
true (recurse recurse s (+ i 1) se)))
(let1 do (vau se (& s) (do_helper do_helper s 0 se))
(let1 cons (lambda (h t) (let1 a (array-with-len (+ 1 (len t)))
(let1 helper (lambda (recurse d s i) (cond (< i (len s)) (do (set-idx! d (+ i 1) (idx s i))
(recurse recurse d s (+ i 1)))
true d))
(do (set-idx! a 0 h)
(helper helper a t 0)))))
(let1 current-env (vau de () de)
(let1 lapply (lambda (f p) (eval (cons (unwrap f) p) (current-env)))
(let1 vapply (lambda (f p ede) (eval (cons f p) ede))
(let1 lapply (lambda (f p) (eval (concat (array (unwrap f)) p) (current-env)))
(let1 vapply (lambda (f p ede) (eval (concat (array f) p) ede))
(let1 Y (lambda (f)
((lambda (x) (x x))
(lambda (x) (f (lambda (& y) (lapply (x x) y))))))
@@ -40,26 +34,27 @@
map (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(do (set-idx! n i (f (idx l i)))
(recurse f l n (+ i 1))))))
(helper f l (array-with-len (len l)) 0)))
(cond (= i (len l)) n
(<= i (- (len l) 4)) (recurse f l (concat n (array
(f (idx l (+ i 0)))
(f (idx l (+ i 1)))
(f (idx l (+ i 2)))
(f (idx l (+ i 3)))
)) (+ i 4))
true (recurse f l (concat n (array (f (idx l i)))) (+ i 1)))))
(helper f l (array) 0)))
map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(do (set-idx! n i (f i (idx l i)))
(recurse f l n (+ i 1))))))
(helper f l (array-with-len (len l)) 0)))
concat_helper (lambda (recurse as o i j k) (if (< i (len as))
(if (< j (len (idx as i))) (do (set-idx! o k (idx (idx as i) j))
(recurse recurse as o i (+ j 1) (+ k 1)))
(recurse recurse as o (+ i 1) 0 k))
o))
concat (lambda (& as) (concat_helper concat_helper as (array-with-len (lapply + (map len as))) 0 0 0))
(cond (= i (len l)) n
(<= i (- (len l) 4)) (recurse f l (concat n (array
(f (+ i 0) (idx l (+ i 0)))
(f (+ i 1) (idx l (+ i 1)))
(f (+ i 2) (idx l (+ i 2)))
(f (+ i 3) (idx l (+ i 3)))
)) (+ i 4))
true (recurse f l (concat n (array (f i (idx l i)))) (+ i 1)))))
(helper f l (array) 0)))
filter_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
@@ -102,13 +97,6 @@
n
(recurse f l (concat n (f (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
map_with_idx (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(do (set-idx! n i (f i (idx l i)))
(recurse f l n (+ i 1))))))
(helper f l (array-with-len (len l)) 0)))
is_pair? (lambda (x) (and (array? x) (> (len x) 0)))
@@ -182,8 +170,8 @@
if
concat
map
map_i
flat_map
map_with_idx
lapply
vapply
Y
@@ -246,7 +234,7 @@
)
)
)
)))))))))) ; end of all the let1's
))))))))) ; end of all the let1's
; impl of let1
)) (vau de (s v b) (eval (array (array vau (quote _) (array s) b) (eval v de)) de)))