diff --git a/partial_eval.kp b/partial_eval.kp index 92ba471..d2b21ce 100644 --- a/partial_eval.kp +++ b/partial_eval.kp @@ -166,6 +166,14 @@ (array? body) (foldl (lambda (a x) (or a (recurse env x))) false body) true false)) + parameters_evaled_proxy (lambda (inner_f) (lambda (de comb_to_mark_map params) (let ( + [comb_to_mark_map evaled_params] (foldl (lambda ([comb_to_mark_map ac] p) + (let ([comb_to_mark_map p] (partial_eval_helper p de comb_to_mark_map)) + [comb_to_mark_map (concat ac [p])])) + [comb_to_mark_map []] + params) + ) (inner_f de comb_to_mark_map evaled_params)))) + root_marked_env ['env [ ; Ok, so for combinators, it should partial eval the body. ; It should then check to see if the partial-evaled body has closed over @@ -228,31 +236,40 @@ _ (println "after second eval, " eval_2_body) ) [comb_to_mark_map eval_2_body] )))) eval]] - ['cond ['prim_comb (lambda (de comb_to_mark_map params) - (if (!= 0 (% (len params) 2)) (error (str "partial eval cond with odd params " params)) - (let ([comb_to_mark_map evaled_params] (foldl (lambda ([comb_to_mark_map ac] p) - (let ([comb_to_mark_map p] (partial_eval_helper p de comb_to_mark_map)) - [comb_to_mark_map (concat ac [p])])) - [comb_to_mark_map []] - params) - _ (println "Cond evaluated its parameters to " evaled_params) - ) ((rec-lambda recurse (i) + ['cond ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map evaled_params) + (if (!= 0 (% (len evaled_params) 2)) (error (str "partial eval cond with odd evaled_params " evaled_params)) + ((rec-lambda recurse (i) (cond (later? (idx evaled_params i)) [comb_to_mark_map ['later (cons cond (slice (map strip evaled_params) i -1))]] (and (val? (idx evaled_params i)) (not (.val (idx evaled_params i)))) (recurse (+ 2 i)) true [comb_to_mark_map (idx evaled_params (+ 1 i))]) - ) 0))) - ) cond]] + ) 0) + ) + )) cond]] (needs_params_val_lambda symbol?) (needs_params_val_lambda int?) (needs_params_val_lambda string?) - (give_up combiner?) - (give_up env?) + ['combiner? ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map [evaled_param]) + (cond (val? evaled_param) [comb_to_mark_map ['val (combiner? (.val evaled_param))]] + (comb? evaled_param) [comb_to_mark_map ['val true]] + (prim_comb? evaled_param) [comb_to_mark_map ['val true]] + (later? evaled_param) [comb_to_mark_map ['later [combiner? (strip evaled_param)]]] + true [comb_to_mark_map ['val false]] + ) + )) combiner?]] + ;(give_up env?) + ['env? ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map [evaled_param]) + (cond (val? evaled_param) [comb_to_mark_map ['val (env? (.val evaled_param))]] + (marked_env? evaled_param) [comb_to_mark_map ['val true]] + (later? evaled_param) [comb_to_mark_map ['later [env? (strip evaled_param)]]] + true [comb_to_mark_map ['val false]] + ) + )) env?]] (needs_params_val_lambda nil?) (needs_params_val_lambda bool?) - (give_up array?) (needs_params_val_lambda str-to-symbol) (needs_params_val_lambda get-text) + (give_up array?) (give_up array) (give_up len) (give_up idx) @@ -277,6 +294,7 @@ ; Don't forget, these short-circut with the truthy/falsey values (give_up and) (give_up or) + ; should make not a built in and then do here ; pr-str (needs_params_val_lambda str) diff --git a/partial_eval_test.kp b/partial_eval_test.kp index a473059..5a31982 100644 --- a/partial_eval_test.kp +++ b/partial_eval_test.kp @@ -24,9 +24,21 @@ vau_with_wrap_add (read-string "((wrap (vau (y) (+ 13 2 y))) (+ 3 4))") vau_with_add_p (read-string "(vau de (y) (+ (eval y de) (+ 1 2)))") vau_with_add_p_called (read-string "((vau de (y) ((vau dde (z) (+ 1 (eval z dde))) y)) 17)") + cond_test (read-string "(cond false 1 false 2 (+ 1 2) 3 true 1337)") cond_vau_test (read-string "(vau de (x) (cond false 1 false 2 x 3 true 42))") cond_vau_test2 (read-string "(vau de (x) (cond false 1 false 2 3 x true 42))") + + combiner_test (read-string "(combiner? true)") + combiner_test2 (read-string "(combiner? (vau de (x) x))") + combiner_test3 (read-string "(vau de (x) (combiner? x))") + + env_test (read-string "(env? true)") + ; this doesn't partially eval, but it could with a more percise if the marked values were more percise + env_test2 (read-string "(vau de (x) (env? de))") + env_test3 (read-string "(vau de (x) (env? x))") + env_test4 (read-string "((vau de (x) (env? de)) 1)") + _ (test-case simple_add) _ (test-case vau_with_add) _ (test-case vau_with_add_called) @@ -38,4 +50,11 @@ _ (test-case cond_test) _ (test-case cond_vau_test) _ (test-case cond_vau_test2) + _ (test-case combiner_test) + _ (test-case combiner_test2) + _ (test-case combiner_test3) + _ (test-case env_test) + _ (test-case env_test2) + _ (test-case env_test3) + _ (test-case env_test4) ) nil))