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

50
partial_eval.kp
View File

@@ -57,7 +57,10 @@
(cond (val? x) (.val x)
(later? x) (.later x)
(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)
(marked_env? x) (error "Env escaped to strip!")
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))
spe_body (strip pe_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))
_ (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])]]
;;;rolled_back;;;[comb_to_mark_map ['comb 0 de? de vau_params spe_body nil]]
(let (real_func (eval (concat [vau] vau_de? [vau_params spe_body]) (.env_real de))
marked_func ['comb 0 de? de vau_params spe_body real_func]
_ (println (indent_str indent) "Marked func is " marked_func)
) [(put comb_to_mark_map real_func marked_func) marked_func])))
) vau]]
['wrap ['prim_comb (lambda (de comb_to_mark_map params indent) (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 (+ 1 indent))
;_ (println (indent_str indent) "wrap evaled is " evaled)
) (if (comb? evaled) (let ([wrap_level de? se params body actual_function] (.comb evaled)
['wrap ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map [evaled] indent)
(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 indent) (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 (+ 1 indent))
;_ (println (indent_str indent) "unwrap evaled is " evaled)
) (if (comb? evaled) (let ([wrap_level de? se params body actual_function] (.comb evaled)
['unwrap ['prim_comb (parameters_evaled_proxy (lambda (de comb_to_mark_map [evaled] indent)
(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])
@@ -220,39 +219,38 @@
; eval should have it's parameters partially -evaled, then partially-eval e again.
; failure can 'later at either point
['eval ['prim_comb (lambda (de comb_to_mark_map params indent) (let (
_ (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))
['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)]
[comb_to_mark_map de])
_ (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 (
_ (println (indent_str indent) "ok, env was " eval_env)
_ (println (indent_str indent) "first eval of param" (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, " eval_1_body)
body (idx params 0)
_ (println (indent_str indent) "after first eval of param (from parameters_evaled_proxy)" body)
eval_strip (rec-lambda recurse (x)
(do (println (indent_str indent) "calling eval_strip with " x)
(cond (val? x) (.val x)
(later? x) [eval (.later x) (.env_real eval_env)]
(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)
(marked_env? x) (error "Env escaped to eval_strip!")
true (error (str "some other eval_strip? " x))
))
)
eval_1_body_stripped (eval_strip eval_1_body)
_ (println (indent_str indent) "after first eval stripped, " eval_1_body_stripped)
[comb_to_mark_map eval_2_body] (partial_eval_helper eval_1_body_stripped eval_env comb_to_mark_map (+ 1 indent))
body_stripped (eval_strip body)
_ (println (indent_str indent) "after first eval stripped, " body_stripped)
[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 stripped (not used), " (eval_strip 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)
(if (!= 0 (% (len evaled_params) 2)) (error (str "partial eval cond with odd evaled_params " evaled_params))
((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_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)))")
;; 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)")
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 (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" "(let (a 17) (vau (x) a))"]]
@@ -64,6 +70,8 @@
_ (test-case vau_with_no_eval_add)
_ (test-case vau_with_wrap_add)
_ (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 cond_test)
_ (test-case cond_vau_test)
@@ -77,6 +85,10 @@
_ (test-case env_test4)
_ (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 big_test1)