From f09962ddc4479b59ab6cb488805d3df9588474c9 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Tue, 10 Aug 2021 23:26:22 -0400 Subject: [PATCH] Add 2 parameter vau that discards dynamic env --- k_prime.krak | 35 ++++++++++++++++++---------- partial_eval.kp | 54 ++++++++++++++++++++++++-------------------- partial_eval_test.kp | 8 ++++++- prelude.kp | 10 ++++---- 4 files changed, 64 insertions(+), 43 deletions(-) diff --git a/k_prime.krak b/k_prime.krak index 223ad18..29f10b5 100644 --- a/k_prime.krak +++ b/k_prime.krak @@ -152,13 +152,15 @@ fun make_builtin_combiner(name: str, wrap_level: int, tco_eval: bool, f: fun(vec obj KPCombiner (Object) { var env: *KPEnv var dynamic_env_name: str + var uses_dynamic_env: bool var wrap_level: int var parameters: vec var is_variadic: bool var body: *KPValue - fun construct(env: *KPEnv, dynamic_env_name: str, parameters: vec, is_variadic: bool, body: KPValue): *KPCombiner { + fun construct(env: *KPEnv, dynamic_env_name: str, uses_dynamic_env: bool, parameters: vec, is_variadic: bool, body: KPValue): *KPCombiner { this->env = env this->dynamic_env_name.copy_construct(&dynamic_env_name) + this->uses_dynamic_env = uses_dynamic_env this->wrap_level = 0 this->parameters.copy_construct(¶meters) this->is_variadic = is_variadic @@ -169,6 +171,7 @@ obj KPCombiner (Object) { fun copy_construct(old: *KPCombiner): void { this->env = old->env 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->parameters.copy_construct(&old->parameters) this->is_variadic = old->is_variadic @@ -188,11 +191,11 @@ 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 && 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 { // 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 fun prep_call(params: ref vec, dynamic_env: KPValue): pair<*KPEnv, KPResult> { @@ -220,7 +223,9 @@ obj KPCombiner (Object) { 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())*/ 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, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> { var param_symbols = vec() - if params.size != 3 { - return make_pair(null(), KPResult::Err(kpString(str("bad number of params to vau")))) + if params.size != 2 && params.size != 3 { + return make_pair(null(), KPResult::Err(kpString(str("bad number of params to vau: ") + params.size))) } - if !params[0].is_symbol() { - return make_pair(null(), KPResult::Err(kpString(str("first param to vau is not symbol")))) + var uses_dynamic_env = params.size == 3 + var offset = 0 + var dynamic_env_name = str() + if uses_dynamic_env { + if !params[0].is_symbol() { + return make_pair(null(), 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 parameters = vec() - if !params[1].is_array() { + if !params[offset+0].is_array() { return make_pair(null(), 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++;) { if !parameter_objects.get()[i].is_symbol() { return make_pair(null(), 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) } } - 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(), KPResult::Ok(nmMV(KPValue_int::Combiner(to_ret)))) })); // Uses TCO diff --git a/partial_eval.kp b/partial_eval.kp index af71a9f..f7dee87 100644 --- a/partial_eval.kp +++ b/partial_eval.kp @@ -94,26 +94,30 @@ (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)]))) ) [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 [ - ; vau - ; eval - ; cond + (give_up vau) + (give_up eval) + (give_up cond) (needs_params_val_lambda symbol?) (needs_params_val_lambda int?) (needs_params_val_lambda string?) - ; combiner? - ; env? + (give_up combiner?) + (give_up env?) (needs_params_val_lambda nil?) (needs_params_val_lambda bool?) - ; array? + (give_up array?) (needs_params_val_lambda str-to-symbol) (needs_params_val_lambda get-text) - ; array - ; len - ; idx - ; slice - ; concat + (give_up array) + (give_up len) + (give_up idx) + (give_up slice) + (give_up concat) (needs_params_val_lambda +) (needs_params_val_lambda -) (needs_params_val_lambda *) @@ -131,24 +135,24 @@ (needs_params_val_lambda >=) ; Don't forget, these short-circut with the truthy/falsey values - ; and - ; or + (give_up and) + (give_up or) ; pr-str (needs_params_val_lambda str) (needs_params_val_lambda prn) - ; println - ; meta - ; with-meta - ; wrap - ; unwrap - ; error - ; recover - ; read-string - ; slurp - ; get_line - ; write_file - ; empty_env + (give_up println) + (give_up meta) + (give_up with-meta) + (give_up wrap) + (give_up unwrap) + (give_up error) + (give_up recover) + (give_up read-string) + (give_up slurp) + (give_up get_line) + (give_up write_file) + (give_up empty_env) ])) ) (provide partial_eval strip) diff --git a/partial_eval_test.kp b/partial_eval_test.kp index 0f30f38..79f9730 100644 --- a/partial_eval_test.kp +++ b/partial_eval_test.kp @@ -12,7 +12,13 @@ ) fully_evaled)) 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 vau_with_add) + _ (test-case vau_with_add_p) + _ (test-case vau_with_add_called) + _ (test-case vau_with_add_p_called) ) nil)) diff --git a/prelude.kp b/prelude.kp index bfed240..2210045 100644 --- a/prelude.kp +++ b/prelude.kp @@ -1,8 +1,8 @@ ((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 (= i (- (len s) 1)) (eval (idx s i) se) @@ -129,7 +129,7 @@ sym_params (map (lambda (param) (if (symbol? param) param (str-to-symbol (str param)))) p) 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 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 ; 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 -)) (vau _ (x) x)) +)) (vau (x) x))