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) {
var env: *KPEnv
var dynamic_env_name: str
var uses_dynamic_env: bool
var wrap_level: int
var parameters: vec<str>
var is_variadic: bool
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->dynamic_env_name.copy_construct(&dynamic_env_name)
this->uses_dynamic_env = uses_dynamic_env
this->wrap_level = 0
this->parameters.copy_construct(&parameters)
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<KPValue>, 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<KPValue>, dynamic_env: *KPEnv): pair<*KPEnv, KPResult> {
var param_symbols = vec<str>()
if params.size != 3 {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("bad number of params to vau"))))
if params.size != 2 && params.size != 3 {
return make_pair(null<KPEnv>(), KPResult::Err(kpString(str("bad number of params to vau: ") + params.size)))
}
if !params[0].is_symbol() {
return make_pair(null<KPEnv>(), 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<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 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"))))
}
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<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)
}
}
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))))
}));
// 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))]
['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)

8
partial_eval_test.kp
View File

@@ -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))

10
prelude.kp
View File

@@ -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))