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

Implement smart cond partial-eval

Browse Source
This commit is contained in:
Nathan Braswell
2021-08-17 18:17:42 -04:00
parent 772b984de0
commit 47d5149400
2 changed files with 21 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
partial_eval.kp
View File

@@ -228,7 +228,21 @@
_ (println "after second eval, " eval_2_body) _ (println "after second eval, " eval_2_body)
) [comb_to_mark_map eval_2_body] ) [comb_to_mark_map eval_2_body]
)))) eval]] )))) 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 symbol?)
(needs_params_val_lambda int?) (needs_params_val_lambda int?)
(needs_params_val_lambda string?) (needs_params_val_lambda string?)

6
partial_eval_test.kp
View File

@@ -24,6 +24,9 @@
vau_with_wrap_add (read-string "((wrap (vau (y) (+ 13 2 y))) (+ 3 4))") 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 (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)") 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 simple_add)
_ (test-case vau_with_add) _ (test-case vau_with_add)
_ (test-case vau_with_add_called) _ (test-case vau_with_add_called)
@@ -32,4 +35,7 @@
_ (test-case vau_with_wrap_add) _ (test-case vau_with_wrap_add)
_ (test-case vau_with_add_p) _ (test-case vau_with_add_p)
_ (test-case vau_with_add_p_called) _ (test-case vau_with_add_p_called)
_ (test-case cond_test)
_ (test-case cond_vau_test)
_ (test-case cond_vau_test2)
) nil)) ) nil))