diff --git a/partial_eval.csc b/partial_eval.csc index e6e6a60..0155ac1 100644 --- a/partial_eval.csc +++ b/partial_eval.csc @@ -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)")) )))) diff --git a/partial_eval.kp b/partial_eval.kp index 48fb13a..f09675f 100644 --- a/partial_eval.kp +++ b/partial_eval.kp @@ -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 (