It all works! I belive all test cases from the prior partial_eval.kp work in partial_eval.csc now :D
This commit is contained in:
Nathan Braswell
@@ -111,6 +111,10 @@
|
||||
(t (- e s)) )
|
||||
(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
|
||||
(define mp (open-output-string))
|
||||
(display args mp)
|
||||
@@ -444,18 +448,18 @@
|
||||
(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 '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))
|
||||
|
||||
(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))
|
||||
(unwrapped_marked_fun (array 'comb (- wrap_level 1) de? se variadic params body))
|
||||
) 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))
|
||||
|
||||
(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))
|
||||
de))
|
||||
(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)
|
||||
(mif (!= 0 (% (len evaled_params) 2)) (error (str "partial eval cond with odd evaled_params " evaled_params))
|
||||
((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)))
|
||||
(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
|
||||
@@ -496,13 +500,13 @@
|
||||
(array 'combiner? (array 'prim_comb (parameters_evaled_proxy nil (dlambda (recurse de env_stack (evaled_param) indent)
|
||||
(cond ((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))
|
||||
)
|
||||
)) 'combinerp_fake_real))
|
||||
(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))
|
||||
((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))
|
||||
)
|
||||
)) 'envp_fake_real))
|
||||
@@ -513,7 +517,7 @@
|
||||
|
||||
(array 'array? (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 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))
|
||||
(true (array 'val false))
|
||||
)
|
||||
@@ -524,30 +528,30 @@
|
||||
; 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)
|
||||
(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 '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))))
|
||||
(true (error (str "bad type to len " evaled_param)))
|
||||
)
|
||||
)) 'len_fake_real))
|
||||
(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)))
|
||||
(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))
|
||||
(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))
|
||||
(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))
|
||||
(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)
|
||||
(.marked_array_values x))
|
||||
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))
|
||||
|
||||
@@ -571,7 +575,7 @@
|
||||
(array 'and (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
|
||||
((rec-lambda inner_recurse (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))
|
||||
(true (inner_recurse (+ 1 i))))
|
||||
) 0)
|
||||
@@ -580,7 +584,7 @@
|
||||
(array 'or (array 'prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
|
||||
((rec-lambda inner_recurse (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)))
|
||||
(true (idx evaled_params i)))
|
||||
) 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 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)"))
|
||||
|
||||
))))
|
||||
|
||||
|
||||
@@ -361,7 +361,7 @@
|
||||
(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)
|
||||
['marked_array false [['prim_comb recurse wrap] evaled]]))
|
||||
['marked_array false [['prim_comb recurse unwrap] evaled]]))
|
||||
) unwrap]]
|
||||
|
||||
['eval ['prim_comb (rec-lambda recurse (de env_stack params indent) (let (
|
||||
|
||||
Reference in New Issue
Block a user