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

Added wrap/unwrap and a vau test that uses wrap!

Browse Source
This commit is contained in:
Nathan Braswell
2021-08-16 01:20:10 -04:00
parent 550565a235
commit 62a238e041
2 changed files with 27 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
partial_eval.kp
View File

@@ -54,13 +54,14 @@
env-lookup (lambda (env key) (env-lookup-helper (idx env 1) key 0 (lambda () (error (str key " not found in env " dict))) (lambda (x) x))) env-lookup (lambda (env key) (env-lookup-helper (idx env 1) key 0 (lambda () (error (str key " not found in env " dict))) (lambda (x) x)))
strip (rec-lambda recurse (x) strip (rec-lambda recurse (x)
(do (println "calling strip with " x)
(cond (val? x) (.val x) (cond (val? x) (.val x)
(later? x) (.later x) (later? x) (.later x)
(marked_array? x) (map recurse (idx x 1)) (marked_array? x) (map recurse (idx x 1))
(comb? x) (idx x 6) (comb? x) (idx x 6)
(prim_comb? x) (idx x 2) (prim_comb? x) (idx x 2)
(makred_env? x) (error "Env escaped to strip!") (makred_env? x) (error "Env escaped to strip!")
) ))
) )
; GAH ok additionally ; GAH ok additionally
@@ -156,9 +157,30 @@
[comb_to_mark_map pe_body] (partial_eval_helper body inner_env comb_to_mark_map) [comb_to_mark_map pe_body] (partial_eval_helper body inner_env comb_to_mark_map)
spe_body (strip pe_body) spe_body (strip pe_body)
) (if (or (= nil (.env_real de)) (closes_over_outside_vars de spe_body)) [comb_to_mark_map ['later (concat [vau] vau_de? [vau_params spe_body])]] ) (if (or (= nil (.env_real de)) (closes_over_outside_vars de spe_body)) [comb_to_mark_map ['later (concat [vau] vau_de? [vau_params spe_body])]]
[comb_to_mark_map ['comb 0 de? de vau_params spe_body (let (real_func (eval (concat [vau] vau_de? [vau_params spe_body]) (.env_real de))
(do (println "evaling (eval " (str (concat [vau] vau_de? [vau_params spe_body]) (.env_real de)) ")" ) (eval (concat [vau] vau_de? [vau_params spe_body]) (.env_real de)))]])) marked_func ['comb 0 de? de vau_params spe_body real_func]
) [(put comb_to_mark_map real_func marked_func) marked_func])))
) vau]] ) vau]]
['wrap ['prim_comb (lambda (de comb_to_mark_map params) (let (
_ (if (!= 1 (len params)) (error (str "bad number of params to partial-eval wrap " params)))
[comb_to_mark_map evaled] (partial_eval_helper (idx params 0) de comb_to_mark_map)
;_ (println "wrap evaled is " evaled)
) (if (comb? evaled) (let ([wrap_level de? se params body actual_function] (.comb evaled)
wrapped_actual_fun (wrap actual_function)
wrapped_marked_fun ['comb (+ 1 wrap_level) de? se params body wrapped_actual_fun]
) [(put comb_to_mark_map wrapped_actual_fun wrapped_marked_fun) wrapped_marked_fun])
[comb_to_mark_map ['later [wrap (strip evaled)]]]))
) wrap]]
['unwrap ['prim_comb (lambda (de comb_to_mark_map params) (let (
_ (if (!= 1 (len params)) (error (str "bad number of params to partial-eval unwrap " params)))
[comb_to_mark_map evaled] (partial_eval_helper (idx params 0) de comb_to_mark_map)
;_ (println "unwrap evaled is " evaled)
) (if (comb? evaled) (let ([wrap_level de? se params body actual_function] (.comb evaled)
unwrapped_actual_fun (unwrap actual_function)
unwrapped_marked_fun ['comb (- wrap_level 1) de? se params body unwrapped_actual_fun]
) [(put comb_to_mark_map unwrapped_actual_fun unwrapped_marked_fun) unwrapped_marked_fun])
[comb_to_mark_map ['later [unwrap (strip evaled)]]]))
) unwrap]]
; eval should have it's parameters partially -evaled, then partially-eval e again. ; eval should have it's parameters partially -evaled, then partially-eval e again.
; failure can 'later at either point ; failure can 'later at either point
@@ -205,8 +227,6 @@
(give_up println) (give_up println)
(give_up meta) (give_up meta)
(give_up with-meta) (give_up with-meta)
(give_up wrap)
(give_up unwrap)
(give_up error) (give_up error)
(give_up recover) (give_up recover)
(give_up read-string) (give_up read-string)

2
partial_eval_test.kp
View File

@@ -17,6 +17,7 @@
vau_with_add_called (read-string "((vau (y) (+ 1 2)) 4)") vau_with_add_called (read-string "((vau (y) (+ 1 2)) 4)")
vau_with_passthrough (read-string "((vau (y) y) 4)") vau_with_passthrough (read-string "((vau (y) y) 4)")
vau_with_no_eval_add (read-string "((vau (y) (+ 13 2 y)) 4)") vau_with_no_eval_add (read-string "((vau (y) (+ 13 2 y)) 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) (+ (eval y de) (+ 1 2))) 4)") vau_with_add_p_called (read-string "((vau de (y) (+ (eval y de) (+ 1 2))) 4)")
_ (test-case simple_add) _ (test-case simple_add)
@@ -24,6 +25,7 @@
_ (test-case vau_with_add_called) _ (test-case vau_with_add_called)
_ (test-case vau_with_passthrough) _ (test-case vau_with_passthrough)
_ (test-case vau_with_no_eval_add) _ (test-case vau_with_no_eval_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)
) nil)) ) nil))