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

It all works! I belive all test cases from the prior partial_eval.kp work in partial_eval.csc now :D

Browse Source
This commit is contained in:
Nathan Braswell
2021-11-24 00:45:44 -05:00
parent f3525def87
commit a036936e3b
2 changed files with 68 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

81
partial_eval.csc
View File

@@ -111,6 +111,10 @@
(t (- e s)) ) (t (- e s)) )
(take (drop x s) t)))) (take (drop x s) t))))
(filter (rec-lambda recurse (f l) (cond ((nil? l) nil)
((f (car l)) (cons (car l) (recurse f (cdr l))))
(true (recurse f (cdr l))))))
(str (lambda args (begin (str (lambda args (begin
(define mp (open-output-string)) (define mp (open-output-string))
(display args mp) (display args mp)
@@ -444,18 +448,18 @@
(mif (comb? evaled) (dlet (((wrap_level de? se variadic params body) (.comb evaled)) (mif (comb? evaled) (dlet (((wrap_level de? se variadic params body) (.comb evaled))
(wrapped_marked_fun (array 'comb (+ 1 wrap_level) de? se variadic params body)) (wrapped_marked_fun (array 'comb (+ 1 wrap_level) de? se variadic params body))
) wrapped_marked_fun) ) wrapped_marked_fun)
(array 'marked_array false (array (array 'prim_comb recurse wrap) evaled)))) (array 'marked_array false (array (array 'prim_comb recurse 'wrap_fake_real) evaled))))
) 'wrap_fake_real)) ) 'wrap_fake_real))
(array 'unwrap (array 'prim_comb (parameters_evaled_proxy 0 (dlambda (recurse de env_stack (evaled) indent) (array 'unwrap (array 'prim_comb (parameters_evaled_proxy 0 (dlambda (recurse de env_stack (evaled) indent)
(mif (comb? evaled) (dlet (((wrap_level de? se variadic params body) (.comb evaled)) (mif (comb? evaled) (dlet (((wrap_level de? se variadic params body) (.comb evaled))
(unwrapped_marked_fun (array 'comb (- wrap_level 1) de? se variadic params body)) (unwrapped_marked_fun (array 'comb (- wrap_level 1) de? se variadic params body))
) unwrapped_marked_fun) ) unwrapped_marked_fun)
(array 'marked_array false (array (array 'prim_comb recurse wrap) evaled)))) (array 'marked_array false (array (array 'prim_comb recurse 'unwrap_fake_real) evaled))))
) 'unwrap_fake_real)) ) 'unwrap_fake_real))
(array 'eval (array 'prim_comb (rec-lambda recurse (de env_stack params indent) (dlet ( (array 'eval (array 'prim_comb (rec-lambda recurse (de env_stack params indent) (dlet (
(self (array 'prim_comb recurse eval)) (self (array 'prim_comb recurse 'eval_fake_real))
(eval_env (mif (= 2 (len params)) (partial_eval_helper (idx params 1) de env_stack (+ 1 indent)) (eval_env (mif (= 2 (len params)) (partial_eval_helper (idx params 1) de env_stack (+ 1 indent))
de)) de))
(eval_env_v (mif (= 2 (len params)) (array eval_env) (array))) (eval_env_v (mif (= 2 (len params)) (array eval_env) (array)))
@@ -481,7 +485,7 @@
(array 'cond (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent) (array 'cond (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
(mif (!= 0 (% (len evaled_params) 2)) (error (str "partial eval cond with odd evaled_params " evaled_params)) (mif (!= 0 (% (len evaled_params) 2)) (error (str "partial eval cond with odd evaled_params " evaled_params))
((rec-lambda recurse_inner (i) ((rec-lambda recurse_inner (i)
(cond ((later? (idx evaled_params i)) (array 'marked_array false (cons (array 'prim_comb recurse cond) (slice evaled_params i -1)))) (cond ((later? (idx evaled_params i)) (array 'marked_array false (cons (array 'prim_comb recurse 'cond_fake_real) (slice evaled_params i -1))))
((false? (idx evaled_params i)) (recurse_inner (+ 2 i))) ((false? (idx evaled_params i)) (recurse_inner (+ 2 i)))
(true (idx evaled_params (+ 1 i)))) ; we could partially_eval again passing in immediate (true (idx evaled_params (+ 1 i)))) ; we could partially_eval again passing in immediate
; eval mif it was true, to partially counteract the above GAH ; eval mif it was true, to partially counteract the above GAH
@@ -496,13 +500,13 @@
(array 'combiner? (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_param) indent) (array 'combiner? (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_param) indent)
(cond ((comb? evaled_param) (array 'val true)) (cond ((comb? evaled_param) (array 'val true))
((prim_comb? evaled_param) (array 'val true)) ((prim_comb? evaled_param) (array 'val true))
((later? evaled_param) (array 'marked_array false (array (array 'prim_comb recurse combiner?) evaled_param))) ((later? evaled_param) (array 'marked_array false (array (array 'prim_comb recurse 'combinerp_fake_Real) evaled_param)))
(true (array 'val false)) (true (array 'val false))
) )
)) 'combinerp_fake_real)) )) 'combinerp_fake_real))
(array 'env? (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_param) indent) (array 'env? (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_param) indent)
(cond ((marked_env? evaled_param) (array 'val true)) (cond ((marked_env? evaled_param) (array 'val true))
((later? evaled_param) (array 'marked_array false (array (array 'prim_comb recurse env?) evaled_param))) ((later? evaled_param) (array 'marked_array false (array (array 'prim_comb recurse 'envp_fake_real) evaled_param)))
(true (array 'val false)) (true (array 'val false))
) )
)) 'envp_fake_real)) )) 'envp_fake_real))
@@ -513,7 +517,7 @@
(array 'array? (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_param) indent) (array 'array? (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_param) indent)
(cond (cond
((later? evaled_param) (array 'marked_array false (array (array 'prim_comb recurse array?) evaled_param))) ((later? evaled_param) (array 'marked_array false (array (array 'prim_comb recurse 'arrayp_fake_real) evaled_param)))
((marked_array? evaled_param) (array 'val true)) ((marked_array? evaled_param) (array 'val true))
(true (array 'val false)) (true (array 'val false))
) )
@@ -524,30 +528,30 @@
; for when we ensure_params_values or whatever, because that's super wrong ; for when we ensure_params_values or whatever, because that's super wrong
(array 'array (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent) (array 'array (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
(mif (is_all_values evaled_params) (array 'marked_array true evaled_params) (mif (is_all_values evaled_params) (array 'marked_array true evaled_params)
(array 'marked_array false (cons (array 'prim_comb recurse array) evaled_params))) (array 'marked_array false (cons (array 'prim_comb recurse 'array_fake_real) evaled_params)))
)) 'array_fake_real)) )) 'array_fake_real))
(array 'len (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_param) indent) (array 'len (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_param) indent)
(cond ((later? evaled_param) (array 'marked_array false (array (array 'prim_comb recurse len) evaled_param))) (cond ((later? evaled_param) (array 'marked_array false (array (array 'prim_comb recurse 'len_fake_real) evaled_param)))
((marked_array? evaled_param) (array 'val (len (.marked_array_values evaled_param)))) ((marked_array? evaled_param) (array 'val (len (.marked_array_values evaled_param))))
(true (error (str "bad type to len " evaled_param))) (true (error (str "bad type to len " evaled_param)))
) )
)) 'len_fake_real)) )) 'len_fake_real))
(array 'idx (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_array evaled_idx) indent) (array 'idx (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_array evaled_idx) indent)
(cond ((and (val? evaled_idx) (marked_array? evaled_array) (.marked_array_is_val evaled_array)) (idx (.marked_array_values evaled_array) (.val evaled_idx))) (cond ((and (val? evaled_idx) (marked_array? evaled_array) (.marked_array_is_val evaled_array)) (idx (.marked_array_values evaled_array) (.val evaled_idx)))
(true (array 'marked_array false (array (array 'prim_comb recurse idx) evaled_array evaled_idx))) (true (array 'marked_array false (array (array 'prim_comb recurse 'idx_fake_real) evaled_array evaled_idx)))
) )
)) 'idx_fake_real)) )) 'idx_fake_real))
(array 'slice (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_array evaled_begin evaled_end) indent) (array 'slice (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_array evaled_begin evaled_end) indent)
(cond ((and (val? evaled_begin) (val? evaled_end) (marked_array? evaled_array) (.marked_array_is_val evaled_array)) (cond ((and (val? evaled_begin) (val? evaled_end) (marked_array? evaled_array) (.marked_array_is_val evaled_array))
(array 'marked_array true (slice (.marked_array_values evaled_array) (.val evaled_begin) (.val evaled_end)))) (array 'marked_array true (slice (.marked_array_values evaled_array) (.val evaled_begin) (.val evaled_end))))
(true (array 'marked_array false (array (array 'prim_comb recurse slice) evaled_array evaled_idx evaled_begin evaled_end))) (true (array 'marked_array false (array (array 'prim_comb recurse 'slice_fake_real) evaled_array evaled_idx evaled_begin evaled_end)))
) )
)) 'slice_fake_real)) )) 'slice_fake_real))
(array 'concat (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent) (array 'concat (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
(cond ((foldl (lambda (a x) (and a (and (marked_array? x) (.marked_array_is_val x)))) true evaled_params) (array 'marked_array true (lapply concat (map (lambda (x) (cond ((foldl (lambda (a x) (and a (and (marked_array? x) (.marked_array_is_val x)))) true evaled_params) (array 'marked_array true (lapply concat (map (lambda (x)
(.marked_array_values x)) (.marked_array_values x))
evaled_params)))) evaled_params))))
(true (array 'marked_array false (cons (array 'prim_comb recurse concat) evaled_params))) (true (array 'marked_array false (cons (array 'prim_comb recurse 'concat_fake_real) evaled_params)))
) )
)) 'concat_fake_real)) )) 'concat_fake_real))
@@ -571,7 +575,7 @@
(array 'and (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent) (array 'and (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
((rec-lambda inner_recurse (i) ((rec-lambda inner_recurse (i)
(cond ((= i (- (len evaled_params) 1)) (idx evaled_params i)) (cond ((= i (- (len evaled_params) 1)) (idx evaled_params i))
((later? (idx evaled_params i)) (array 'marked_array false (cons (array 'prim_comb recurse and) (slice evaled_params i -1)))) ((later? (idx evaled_params i)) (array 'marked_array false (cons (array 'prim_comb recurse 'and_fake_real) (slice evaled_params i -1))))
((false? (idx evaled_params i)) (idx evaled_params i)) ((false? (idx evaled_params i)) (idx evaled_params i))
(true (inner_recurse (+ 1 i)))) (true (inner_recurse (+ 1 i))))
) 0) ) 0)
@@ -580,7 +584,7 @@
(array 'or (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent) (array 'or (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
((rec-lambda inner_recurse (i) ((rec-lambda inner_recurse (i)
(cond ((= i (- (len evaled_params) 1)) (idx evaled_params i)) (cond ((= i (- (len evaled_params) 1)) (idx evaled_params i))
((later? (idx evaled_params i)) (array 'marked_array false (cons (array 'prim_comb recurse or) (slice evaled_params i -1)))) ((later? (idx evaled_params i)) (array 'marked_array false (cons (array 'prim_comb recurse 'or_fake_real) (slice evaled_params i -1))))
((false? (idx evaled_params i)) (recurse (+ 1 i))) ((false? (idx evaled_params i)) (recurse (+ 1 i)))
(true (idx evaled_params i))) (true (idx evaled_params i)))
) 0) ) 0)
@@ -665,6 +669,55 @@
(print (run_test "(vau de (x) (cond false 1 false 2 x 3 true 42))")) (print (run_test "(vau de (x) (cond false 1 false 2 x 3 true 42))"))
(print (run_test "(vau de (x) (cond false 1 false 2 3 x true 42))")) (print (run_test "(vau de (x) (cond false 1 false 2 3 x true 42))"))
(print (run_test "(combiner? true)"))
(print (run_test "(combiner? (vau de (x) x))"))
(print (run_test "(vau de (x) (combiner? x))"))
(print (run_test "((vau (x) x) a)"))
(print (run_test "(env? true)"))
; this doesn't partially eval, but it could with a more percise if the marked values were more percise
(print (run_test "(vau de (x) (env? de))"))
(print (run_test "(vau de (x) (env? x))"))
(print (run_test "((vau de (x) (env? de)) 1)"))
(print (run_test "((wrap (vau (let1) (let1 a 12 (+ a 1)))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))"))
(print (run_test "((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)))"))
(print (run_test "((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)))"))
(print (run_test "((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)))"))
(print "\n\nlet 4.3\n\n")
(print (run_test "((wrap (vau (let1)
(let1 a 12 (wrap (vau (x) (let1 y (+ a 1) (+ y x a))))
))) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de)))"))
(print "\n\nlet 4.7\n\n")
(print (run_test "((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 wrap (array vau (array s) b)) v) de)))"))
(print "\n\nlet 5\n\n")
(print (run_test "((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)))"))
(print (run_test "((wrap (vau (let1)
(let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
(lambda (x) x)
))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))"))
(print (run_test "((wrap (vau (let1)
(let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
(let1 a 12
(lambda (x) (+ a x)))
))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))"))
(print (run_test "((wrap (vau (let1)
(let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
(let1 a 12
(lambda (x) (let1 b (+ a x)
(+ a x b))))
))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))"))
(print (run_test "(array 1 2 3 4 5)"))
(print (run_test "((wrap (vau (a & rest) rest)) 1 2 3 4 5)"))
)))) ))))

2
partial_eval.kp
View File

@@ -361,7 +361,7 @@
(if (comb? evaled) (let ([wrap_level de? se variadic params body] (.comb evaled) (if (comb? evaled) (let ([wrap_level de? se variadic params body] (.comb evaled)
unwrapped_marked_fun ['comb (- wrap_level 1) de? se variadic params body] unwrapped_marked_fun ['comb (- wrap_level 1) de? se variadic params body]
) unwrapped_marked_fun) ) unwrapped_marked_fun)
['marked_array false [['prim_comb recurse wrap] evaled]])) ['marked_array false [['prim_comb recurse unwrap] evaled]]))
) unwrap]] ) unwrap]]
['eval ['prim_comb (rec-lambda recurse (de env_stack params indent) (let ( ['eval ['prim_comb (rec-lambda recurse (de env_stack params indent) (let (