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

Add 2 parameter vau that discards dynamic env

Browse Source
This commit is contained in:
Nathan Braswell
2021-08-10 23:26:22 -04:00
parent 95b37da44e
commit f09962ddc4
4 changed files with 64 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
k_prime.krak
View File

@@ -152,13 +152,15 @@ fun make_builtin_combiner(name: str, wrap_level: int, tco_eval: bool, f: fun(vec
obj KPCombiner (Object) { obj KPCombiner (Object) {
var env: *KPEnv var env: *KPEnv
var dynamic_env_name: str var dynamic_env_name: str
var uses_dynamic_env: bool
var wrap_level: int var wrap_level: int
var parameters: vec<str> var parameters: vec<str>
var is_variadic: bool var is_variadic: bool
var body: *KPValue var body: *KPValue
fun construct(env: *KPEnv, dynamic_env_name: str, parameters: vec<str>, is_variadic: bool, body: KPValue): *KPCombiner { fun construct(env: *KPEnv, dynamic_env_name: str, uses_dynamic_env: bool, parameters: vec<str>, is_variadic: bool, body: KPValue): *KPCombiner {
this->env = env this->env = env
this->dynamic_env_name.copy_construct(&dynamic_env_name) this->dynamic_env_name.copy_construct(&dynamic_env_name)
this->uses_dynamic_env = uses_dynamic_env
this->wrap_level = 0 this->wrap_level = 0
this->parameters.copy_construct(&parameters) this->parameters.copy_construct(&parameters)
this->is_variadic = is_variadic this->is_variadic = is_variadic
@@ -169,6 +171,7 @@ obj KPCombiner (Object) {
fun copy_construct(old: *KPCombiner): void { fun copy_construct(old: *KPCombiner): void {
this->env = old->env this->env = old->env
this->dynamic_env_name.copy_construct(&old->dynamic_env_name) this->dynamic_env_name.copy_construct(&old->dynamic_env_name)
this->uses_dynamic_env = old->uses_dynamic_env
this->wrap_level = old->wrap_level this->wrap_level = old->wrap_level
this->parameters.copy_construct(&old->parameters) this->parameters.copy_construct(&old->parameters)
this->is_variadic = old->is_variadic this->is_variadic = old->is_variadic
@@ -188,11 +191,11 @@ obj KPCombiner (Object) {
} }
fun operator==(other: ref KPCombiner):bool { fun operator==(other: ref KPCombiner):bool {
// not sure about env // 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 && uses_dynamic_env == other.uses_dynamic_env && wrap_level == other.wrap_level && parameters == other.parameters && is_variadic == other.is_variadic && body->equals(*other.body)
} }
fun operator<(other: ref KPCombiner):bool { fun operator<(other: ref KPCombiner):bool {
// not sure about env // 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->lt(*other.body) return *env < *other.env || dynamic_env_name < other.dynamic_env_name || uses_dynamic_env < other.uses_dynamic_env || wrap_level < other.wrap_level || parameters < other.parameters || is_variadic < other.is_variadic || body->lt(*other.body)
} }
// no call b/c need to do in EVAL for TCO // no call b/c need to do in EVAL for TCO
fun prep_call(params: ref vec<KPValue>, dynamic_env: KPValue): pair<*KPEnv, KPResult> { fun prep_call(params: ref vec<KPValue>, dynamic_env: KPValue): pair<*KPEnv, KPResult> {
@@ -220,7 +223,9 @@ obj KPCombiner (Object) {
new_env->set(parameters[i], params[i]) new_env->set(parameters[i], params[i])
} }
} }
new_env->set(dynamic_env_name, dynamic_env) if uses_dynamic_env {
new_env->set(dynamic_env_name, dynamic_env)
}
/*println("Calling with\n" + new_env->to_string())*/ /*println("Calling with\n" + new_env->to_string())*/
return make_pair(new_env, KPResult::Ok(*body)) return make_pair(new_env, KPResult::Ok(*body))
} }
@@ -836,19 +841,25 @@ fun main(argc: int, argv: **char): int {
env->set(str("vau"), make_builtin_combiner(str("vau"), 0, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> { env->set(str("vau"), make_builtin_combiner(str("vau"), 0, false, fun(params: vec<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
var param_symbols = vec<str>() var param_symbols = vec<str>()
if params.size != 3 { if params.size != 2 && params.size != 3 {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("bad number of params to vau")))) return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("bad number of params to vau: ") + params.size)))
} }
if !params[0].is_symbol() { var uses_dynamic_env = params.size == 3
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("first param to vau is not symbol")))) var offset = 0
var dynamic_env_name = str()
if uses_dynamic_env {
if !params[0].is_symbol() {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("first param to vau is not symbol"))))
}
dynamic_env_name = params[0].get_symbol_text()
offset = 1
} }
var dynamic_env_name = params[0].get_symbol_text()
var is_variadic = false var is_variadic = false
var parameters = vec<str>() var parameters = vec<str>()
if !params[1].is_array() { if !params[offset+0].is_array() {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("second param to vau is not array")))) return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("second param to vau is not array"))))
} }
var parameter_objects = params[1].get_array_rc() var parameter_objects = params[offset+0].get_array_rc()
for (var i = 0; i < parameter_objects.get().size; i++;) { for (var i = 0; i < parameter_objects.get().size; i++;) {
if !parameter_objects.get()[i].is_symbol() { if !parameter_objects.get()[i].is_symbol() {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("second param to vau has a not symbol member: ") + pr_str(parameter_objects.get()[i], true)))) return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("second param to vau has a not symbol member: ") + pr_str(parameter_objects.get()[i], true))))
@@ -860,7 +871,7 @@ fun main(argc: int, argv: **char): int {
parameters.add(parameter) parameters.add(parameter)
} }
} }
var to_ret.construct(dynamic_env, dynamic_env_name, parameters, is_variadic, params[2]) : KPCombiner var to_ret.construct(dynamic_env, dynamic_env_name, uses_dynamic_env, parameters, is_variadic, params[offset+1]) : KPCombiner
return make_pair(null<KPEnv>(), KPResult::Ok(nmMV(KPValue_int::Combiner(to_ret)))) return make_pair(null<KPEnv>(), KPResult::Ok(nmMV(KPValue_int::Combiner(to_ret))))
})); }));
// Uses TCO // Uses TCO

54
partial_eval.kp
View File

@@ -94,26 +94,30 @@
(if (foldl (lambda (a x) (and a (val? x))) true evaled_params) ['val (lapply actual_function (map .val evaled_params))] (if (foldl (lambda (a x) (and a (val? x))) true evaled_params) ['val (lapply actual_function (map .val evaled_params))]
['later (cons actual_function params)]))) ['later (cons actual_function params)])))
) [f_sym ['prim_comb handler actual_function]])) ) [f_sym ['prim_comb handler actual_function]]))
give_up (vau de (f_sym) (let (
actual_function (eval f_sym de)
handler (lambda (de params) ['later (cons actual_function params)])
) [f_sym ['prim_comb handler actual_function]]))
partial_eval (lambda (x) (partial_eval_helper x [ partial_eval (lambda (x) (partial_eval_helper x [
; vau (give_up vau)
; eval (give_up eval)
; cond (give_up cond)
(needs_params_val_lambda symbol?) (needs_params_val_lambda symbol?)
(needs_params_val_lambda int?) (needs_params_val_lambda int?)
(needs_params_val_lambda string?) (needs_params_val_lambda string?)
; combiner? (give_up combiner?)
; env? (give_up env?)
(needs_params_val_lambda nil?) (needs_params_val_lambda nil?)
(needs_params_val_lambda bool?) (needs_params_val_lambda bool?)
; array? (give_up array?)
(needs_params_val_lambda str-to-symbol) (needs_params_val_lambda str-to-symbol)
(needs_params_val_lambda get-text) (needs_params_val_lambda get-text)
; array (give_up array)
; len (give_up len)
; idx (give_up idx)
; slice (give_up slice)
; concat (give_up concat)
(needs_params_val_lambda +) (needs_params_val_lambda +)
(needs_params_val_lambda -) (needs_params_val_lambda -)
(needs_params_val_lambda *) (needs_params_val_lambda *)
@@ -131,24 +135,24 @@
(needs_params_val_lambda >=) (needs_params_val_lambda >=)
; Don't forget, these short-circut with the truthy/falsey values ; Don't forget, these short-circut with the truthy/falsey values
; and (give_up and)
; or (give_up or)
; pr-str ; pr-str
(needs_params_val_lambda str) (needs_params_val_lambda str)
(needs_params_val_lambda prn) (needs_params_val_lambda prn)
; println (give_up println)
; meta (give_up meta)
; with-meta (give_up with-meta)
; wrap (give_up wrap)
; unwrap (give_up unwrap)
; error (give_up error)
; recover (give_up recover)
; read-string (give_up read-string)
; slurp (give_up slurp)
; get_line (give_up get_line)
; write_file (give_up write_file)
; empty_env (give_up empty_env)
])) ]))
) )
(provide partial_eval strip) (provide partial_eval strip)

8
partial_eval_test.kp
View File

@@ -12,7 +12,13 @@
) fully_evaled)) ) fully_evaled))
simple_add (read-string "(+ 1 2)") simple_add (read-string "(+ 1 2)")
vau_with_add (read-string "(vau de (x) (+ (eval x de) (+ 1 2)))") vau_with_add (read-string "(vau (x) (+ 1 2))")
vau_with_add_called (read-string "((vau (x) (+ 1 2)) 4)")
vau_with_add_p (read-string "(vau de (x) (+ (eval x de) (+ 1 2)))")
vau_with_add_p_called (read-string "((vau de (x) (+ (eval x de) (+ 1 2))) 4)")
_ (test-case simple_add) _ (test-case simple_add)
_ (test-case vau_with_add) _ (test-case vau_with_add)
_ (test-case vau_with_add_p)
_ (test-case vau_with_add_called)
_ (test-case vau_with_add_p_called)
) nil)) ) nil))

10
prelude.kp
View File

@@ -1,8 +1,8 @@
((wrap (vau root_env (quote) ((wrap (vau root_env (quote)
((wrap (vau _ (let1) ((wrap (vau (let1)
(let1 lambda (vau se (p b) (wrap (eval (array vau (quote _) p b) se))) (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
(let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil (let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil
(= i (- (len s) 1)) (eval (idx s i) se) (= i (- (len s) 1)) (eval (idx s i) se)
@@ -129,7 +129,7 @@
sym_params (map (lambda (param) (if (symbol? param) param sym_params (map (lambda (param) (if (symbol? param) param
(str-to-symbol (str param)))) p) (str-to-symbol (str param)))) p)
body (array let (flat_map_i (lambda (i x) (array (idx p i) x)) sym_params) b) body (array let (flat_map_i (lambda (i x) (array (idx p i) x)) sym_params) b)
) (wrap (eval (array vau (quote _) sym_params body) se))))) ) (wrap (eval (array vau sym_params body) se)))))
; and rec-lambda - yes it's the same definition again ; and rec-lambda - yes it's the same definition again
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se)) rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
@@ -291,7 +291,7 @@
)))))))))) ; end of all the let1's )))))))))) ; end of all the let1's
; impl of let1 ; impl of let1
)) (vau de (s v b) (eval (array (array vau (quote _) (array s) b) (eval v de)) de))) )) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))
; impl of quote ; impl of quote
)) (vau _ (x) x)) )) (vau (x) x))