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

Some more tests and cleanup, looks like we're going to have to do either a try-eval thing or CPS-style partial evaluator, which I'm reading up on

Browse Source
This commit is contained in:
Nathan Braswell
2021-08-22 20:27:48 -04:00
parent 7700f0b709
commit 2cd85a552d
2 changed files with 40 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
partial_eval.kp
View File

@@ -57,7 +57,10 @@
(cond (val? x) (.val x) (cond (val? x) (.val x)
(later? x) (.later x) (later? x) (.later x)
(marked_array? x) (cons array (map recurse (idx x 1))) (marked_array? x) (cons array (map recurse (idx x 1)))
(comb? x) (idx x 6) (comb? x) (let (c (idx x 6))
; not currently possible, I rolled back partial-vau
(if (= nil c) (error (str "partial eval failed: stripping a combinator without a real combinator (due to nil enviornment, no doubt)" x))
c))
(prim_comb? x) (idx x 2) (prim_comb? x) (idx x 2)
(marked_env? x) (error "Env escaped to strip!") (marked_env? x) (error "Env escaped to strip!")
true (error (str "some other strip? " x)) true (error (str "some other strip? " x))
@@ -189,29 +192,25 @@
[comb_to_mark_map pe_body] (partial_eval_helper body inner_env comb_to_mark_map (+ 1 indent)) [comb_to_mark_map pe_body] (partial_eval_helper body inner_env comb_to_mark_map (+ 1 indent))
spe_body (strip pe_body) spe_body (strip pe_body)
;for_later (or (= nil (.env_real de)) (closes_over_outside_vars de spe_body)) ;for_later (or (= nil (.env_real de)) (closes_over_outside_vars de spe_body))
;_ (println (indent_str indent) "for_later is " for_later " for " params " because of either env being null " (= nil (.env_real de)) " or " spe_body " closing over ourside " (closes_over_outside_vars de spe_body))
for_later (= nil (.env_real de)) for_later (= nil (.env_real de))
_ (println (indent_str indent) "for_later is " for_later " for " params " because of either env being null " (= nil (.env_real de)) " or " spe_body " closing over ourside " (closes_over_outside_vars de spe_body)) _ (println (indent_str indent) "for_later is " for_later " for " params " because of env being null " de)
) (if for_later [comb_to_mark_map ['later (concat [vau] vau_de? [vau_params spe_body])]] ) (if for_later [comb_to_mark_map ['later (concat [vau] vau_de? [vau_params spe_body])]]
(let (real_func (eval (concat [vau] vau_de? [vau_params spe_body]) (.env_real de)) ;;;rolled_back;;;[comb_to_mark_map ['comb 0 de? de vau_params spe_body nil]]
marked_func ['comb 0 de? de vau_params spe_body real_func] (let (real_func (eval (concat [vau] vau_de? [vau_params spe_body]) (.env_real de))
_ (println (indent_str indent) "Marked func is " marked_func) marked_func ['comb 0 de? de vau_params spe_body real_func]
) [(put comb_to_mark_map real_func marked_func) marked_func]))) _ (println (indent_str indent) "Marked func is " marked_func)
) [(put comb_to_mark_map real_func marked_func) marked_func])))
) vau]] ) vau]]
['wrap ['prim_comb (lambda (de comb_to_mark_map params indent) (let ( ['wrap ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map [evaled] indent)
_ (if (!= 1 (len params)) (error (str "bad number of params to partial-eval wrap " params))) (if (comb? evaled) (let ([wrap_level de? se params body actual_function] (.comb evaled)
[comb_to_mark_map evaled] (partial_eval_helper (idx params 0) de comb_to_mark_map (+ 1 indent))
;_ (println (indent_str indent) "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_actual_fun (wrap actual_function)
wrapped_marked_fun ['comb (+ 1 wrap_level) de? se params body wrapped_actual_fun] 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]) ) [(put comb_to_mark_map wrapped_actual_fun wrapped_marked_fun) wrapped_marked_fun])
[comb_to_mark_map ['later [wrap (strip evaled)]]])) [comb_to_mark_map ['later [wrap (strip evaled)]]]))
) wrap]] ) wrap]]
['unwrap ['prim_comb (lambda (de comb_to_mark_map params indent) (let ( ['unwrap ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map [evaled] indent)
_ (if (!= 1 (len params)) (error (str "bad number of params to partial-eval unwrap " params))) (if (comb? evaled) (let ([wrap_level de? se params body actual_function] (.comb evaled)
[comb_to_mark_map evaled] (partial_eval_helper (idx params 0) de comb_to_mark_map (+ 1 indent))
;_ (println (indent_str indent) "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_actual_fun (unwrap actual_function)
unwrapped_marked_fun ['comb (- wrap_level 1) de? se params body unwrapped_actual_fun] 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]) ) [(put comb_to_mark_map unwrapped_actual_fun unwrapped_marked_fun) unwrapped_marked_fun])
@@ -220,39 +219,38 @@
; 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
['eval ['prim_comb (lambda (de comb_to_mark_map params indent) (let ( ['eval ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map params indent) (let (
[comb_to_mark_map eval_env] (if (= 2 (len params)) [comb_to_mark_map (idx params 1)]
_ (println (indent_str indent) "doing an eval, evaling body " (idx params 0))
_ (println (indent_str indent) "Doing an eval, starting by getting env")
[comb_to_mark_map eval_env] (if (= 2 (len params)) (partial_eval_helper (idx params 1) de comb_to_mark_map (+ 1 indent))
[comb_to_mark_map de]) [comb_to_mark_map de])
_ (println (indent_str indent) "is this a marked env? " (marked_env? eval_env)) _ (println (indent_str indent) "is this a marked env? " (marked_env? eval_env))
) (if (not (marked_env? eval_env)) [comb_to_mark_map ['later (cons eval params)]] ) (if (not (marked_env? eval_env)) [comb_to_mark_map ['later (cons eval (map strip params))]]
(let ( (let (
_ (println (indent_str indent) "ok, env was " eval_env) _ (println (indent_str indent) "ok, env was " eval_env)
_ (println (indent_str indent) "first eval of param" (idx params 0)) body (idx params 0)
[comb_to_mark_map eval_1_body] (partial_eval_helper (idx params 0) de comb_to_mark_map (+ 1 indent)) _ (println (indent_str indent) "after first eval of param (from parameters_evaled_proxy)" body)
_ (println (indent_str indent) "after first eval, " eval_1_body)
eval_strip (rec-lambda recurse (x) eval_strip (rec-lambda recurse (x)
(do (println (indent_str indent) "calling eval_strip with " x) (do (println (indent_str indent) "calling eval_strip with " x)
(cond (val? x) (.val x) (cond (val? x) (.val x)
(later? x) [eval (.later x) (.env_real eval_env)] (later? x) [eval (.later x) (.env_real eval_env)]
(marked_array? x) (map recurse (idx x 1)) (marked_array? x) (map recurse (idx x 1))
(comb? x) (idx x 6) (comb? x) (let (c (idx x 6))
; not currently possible, I rolled back partial-vau
(if (= nil c) (error (str "partial eval failed: stripping a combinator without a real combinator (due to nil enviornment, no doubt)" x))
c))
(prim_comb? x) (idx x 2) (prim_comb? x) (idx x 2)
(marked_env? x) (error "Env escaped to eval_strip!") (marked_env? x) (error "Env escaped to eval_strip!")
true (error (str "some other eval_strip? " x)) true (error (str "some other eval_strip? " x))
)) ))
) )
eval_1_body_stripped (eval_strip eval_1_body) body_stripped (eval_strip body)
_ (println (indent_str indent) "after first eval stripped, " eval_1_body_stripped) _ (println (indent_str indent) "after first eval stripped, " body_stripped)
[comb_to_mark_map eval_2_body] (partial_eval_helper eval_1_body_stripped eval_env comb_to_mark_map (+ 1 indent)) [comb_to_mark_map eval_2_body] (partial_eval_helper body_stripped eval_env comb_to_mark_map (+ 1 indent))
_ (println (indent_str indent) "after second eval, " eval_2_body) _ (println (indent_str indent) "after second eval, " eval_2_body)
_ (println (indent_str indent) "after second eval stripped (not used), " (eval_strip eval_2_body)) _ (println (indent_str indent) "after second eval stripped (not used), " (eval_strip eval_2_body))
) [comb_to_mark_map eval_2_body] ) [comb_to_mark_map eval_2_body]
)))) eval]] ))))) eval]]
['cond ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map evaled_params indent) ['cond ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map evaled_params indent)
(if (!= 0 (% (len evaled_params) 2)) (error (str "partial eval cond with odd evaled_params " evaled_params)) (if (!= 0 (% (len evaled_params) 2)) (error (str "partial eval cond with odd evaled_params " evaled_params))
((rec-lambda recurse (i) ((rec-lambda recurse (i)

12
partial_eval_test.kp
View File

@@ -29,6 +29,8 @@
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_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)))")
;; No longer works with our more aggressive partial-evaling of vaus with incomplete environments
;; BUT DOES CUZ I ROLLED THAT BACK
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_test (read-string "(cond false 1 false 2 (+ 1 2) 3 true 1337)")
@@ -51,6 +53,10 @@
;let1_test (read-string "((wrap (vau root_env (quote) ((wrap (vau (let1) (let1 a 12 (+ a 1)))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de))))) (vau (x) x))") ;let1_test (read-string "((wrap (vau root_env (quote) ((wrap (vau (let1) (let1 a 12 (+ a 1)))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de))))) (vau (x) x))")
let1_test (read-string "((wrap (vau (let1) (let1 a 12 (+ a 1)))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))") let1_test (read-string "((wrap (vau (let1) (let1 a 12 (+ a 1)))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
let2_test (read-string "((wrap (vau (let1) (let1 a 12 (vau (x) (+ a 1))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
let3_test (read-string "((wrap (vau (let1) (let1 a 12 (wrap (vau (x) (+ x a 1)))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
let4_test (read-string "((wrap (vau (let1) (let1 a 12 (wrap (vau (x) (let1 y (+ a 1) (+ y x a))))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
;let5_test (read-string "((wrap (vau (let1) (let1 a 12 (wrap (vau (x) (let1 y (+ x a 1) (+ y x a))))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
;big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] ["" "-C" "1339"]] ;big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] ["" "-C" "1339"]]
;big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] ["" "-C" "(let (a 17) (vau (x) a))"]] ;big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] ["" "-C" "(let (a 17) (vau (x) a))"]]
@@ -64,6 +70,8 @@
_ (test-case vau_with_no_eval_add) _ (test-case vau_with_no_eval_add)
_ (test-case vau_with_wrap_add) _ (test-case vau_with_wrap_add)
_ (test-case vau_with_add_p) _ (test-case vau_with_add_p)
;; No longer works with our more aggressive partial-evaling of vaus with incomplete environments
;; BUT DOES CUZ I ROLLED THAT BACK
_ (test-case vau_with_add_p_called) _ (test-case vau_with_add_p_called)
_ (test-case cond_test) _ (test-case cond_test)
_ (test-case cond_vau_test) _ (test-case cond_vau_test)
@@ -77,6 +85,10 @@
_ (test-case env_test4) _ (test-case env_test4)
_ (test-case let1_test) _ (test-case let1_test)
_ (test-case let2_test)
_ (test-case let3_test)
_ (test-case let4_test)
;_ (test-case let5_test)
;_ (println "THE BIG SHOW") ;_ (println "THE BIG SHOW")
;_ (println big_test1) ;_ (println big_test1)