From 47d5149400d8606cbda92490828bde0d977c0be1 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Tue, 17 Aug 2021 18:17:42 -0400 Subject: [PATCH] Implement smart cond partial-eval --- partial_eval.kp | 16 +++++++++++++++- partial_eval_test.kp | 6 ++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/partial_eval.kp b/partial_eval.kp index c7553d8..92ba471 100644 --- a/partial_eval.kp +++ b/partial_eval.kp @@ -228,7 +228,21 @@ _ (println "after second eval, " eval_2_body) ) [comb_to_mark_map eval_2_body] )))) eval]] - (give_up cond) + ['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 (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]] (needs_params_val_lambda symbol?) (needs_params_val_lambda int?) (needs_params_val_lambda string?) diff --git a/partial_eval_test.kp b/partial_eval_test.kp index f2160d5..a473059 100644 --- a/partial_eval_test.kp +++ b/partial_eval_test.kp @@ -24,6 +24,9 @@ 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))") _ (test-case simple_add) _ (test-case vau_with_add) _ (test-case vau_with_add_called) @@ -32,4 +35,7 @@ _ (test-case vau_with_wrap_add) _ (test-case vau_with_add_p) _ (test-case vau_with_add_p_called) + _ (test-case cond_test) + _ (test-case cond_vau_test) + _ (test-case cond_vau_test2) ) nil))