From b44ff104fb42b5a22a3e6ef132ffce81a904ef5e Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Thu, 26 Aug 2021 01:03:36 -0400 Subject: [PATCH] Implement variadic paremters, found additional bug for array, still need to handle recursion too --- partial_eval.kp | 35 +++++++++++++++++-------------- partial_eval_test.kp | 50 +++++++++++++++++++++++++------------------- 2 files changed, 47 insertions(+), 38 deletions(-) diff --git a/partial_eval.kp b/partial_eval.kp index 4591c5b..5785866 100644 --- a/partial_eval.kp +++ b/partial_eval.kp @@ -24,7 +24,7 @@ ; ['val v] (v can be an array) ; ['later c] ; ['marked_array a] (a contains marked values) - ; ['comb wrap_level de? se params body ] + ; ['comb wrap_level de? se variadic params body ] ; ['prim_comb ] ; ['env [ ['symbol marked_value ]... ] ] @@ -63,7 +63,7 @@ (marked_array? x) (foldl (lambda (a x) (or a (recurse env x))) false (.marked_array x)) ; This is where we'd be smart and remove shadowed stuff (comb? x) (let ( - [wrap_level de? se params body actual_function] (.comb x) + [wrap_level de? se variadic params body actual_function] (.comb x) ; Also this won't work yet because env (error (str "haven't handled comb yet really either for closes_over_var_from_this_env_marked " x)) ) (or (recurse env se) (recurse env body))) @@ -79,10 +79,10 @@ strip (rec-lambda recurse (x) (do ;(println "calling strip with " x) - (cond (val? x) (.val x) + (cond (val? x) (.val x) ;(let (v (.val x)) (if (array? v) (cons array (map recurse (map (lambda (x) ['val x]) v))) v)) (later? x) (.later x) (marked_array? x) (cons array (map recurse (idx x 1))) - (comb? x) (let (c (idx x 6)) + (comb? x) (let (c (idx x 7)) (if (= nil c) (error (str "partial eval failed: regular stripping a combinator without a real combinator (due to nil enviornment, no doubt)" x)) c)) (prim_comb? x) (idx x 2) @@ -129,7 +129,7 @@ (cond (later? comb) [comb_to_mark_map ['later (cons (strip comb) (slice x 1 -1))]] (prim_comb? comb) ((.prim_comb comb) env comb_to_mark_map (slice x 1 -1) imm_eval (+ 1 indent)) (comb? comb) (let ( - [wrap_level de? se params body actual_function] (.comb comb) + [wrap_level de? se variadic params body actual_function] (.comb comb) literal_params (slice x 1 -1) [comb_to_mark_map appropriatly_evaled_params] ((rec-lambda param-recurse (wrap params comb_to_mark_map) (if (!= 0 wrap) @@ -142,17 +142,20 @@ (param-recurse (- wrap 1) evaled_params comb_to_mark_map)) [comb_to_mark_map params]) ) wrap_level (map (lambda (p) ['val p]) literal_params) comb_to_mark_map) + final_params (if variadic (concat (slice appropriatly_evaled_params 0 (- (len params) 1)) + [['marked_array (slice appropriatly_evaled_params (- (len params) 1) -1)]]) + appropriatly_evaled_params) de_entry (if (!= nil de?) [ [de? env] ] []) - _ (println (indent_str indent) "appropriately evaled params " appropriatly_evaled_params) + _ (println (indent_str indent) "final_params params " final_params) de_real_entry (if (!= nil de?) [ [de? (.env_real env)] ] []) se_real_env (.env_real se) inner_real_env (if (and se_real_env (or (not de?) (.env_real env))) (add-dict-to-env se_real_env - (concat (zip params (map strip appropriatly_evaled_params)) + (concat (zip params (map strip final_params)) de_real_entry)) nil) _ (println (indent_str indent) "Inner_real_env is " inner_real_env " because de_real " de_real_entry " se_real_env " se_real_env) - inner_env ['env (concat (zip params appropriatly_evaled_params) de_entry [se]) inner_real_env] + inner_env ['env (concat (zip params final_params) de_entry [se]) inner_real_env] _ (println (indent_str indent) "going to eval " body " with inner_env is " inner_env) @@ -216,7 +219,7 @@ ['vau ['prim_comb (lambda (de comb_to_mark_map params imm_eval indent) (let ( de? (if (= 3 (len params)) (idx params 0)) vau_de? (if (= nil de?) [] [de?]) - vau_params (if (= nil de?) (idx params 0) (idx params 1)) + [variadic vau_params] (foldl (lambda ([v a] x) (if (= x '&) [true a] [v (concat a [x])])) [false []] (if (= nil de?) (idx params 0) (idx params 1))) body (if (= nil de?) (idx params 1) (idx params 2)) inner_env ['env (concat (map (lambda (p) [p ['later p]]) vau_params) (if (= nil de?) [] [ [de? ['later de?]] ]) [de]) nil] _ (println (indent_str indent) "in vau, evaluating body with 'later params - " body) @@ -227,24 +230,24 @@ for_later (= nil (.env_real de)) _ (println (indent_str indent) "imm_eval is " imm_eval " and for_later is " for_later " for " params " because of env being null " de) ) (if for_later (if (not imm_eval) [comb_to_mark_map ['later (concat [vau] vau_de? [vau_params spe_body])]] - [comb_to_mark_map ['comb 0 de? de vau_params spe_body nil]]) + [comb_to_mark_map ['comb 0 de? de variadic 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] + marked_func ['comb 0 de? de variadic 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 (parameters_evaled_proxy 0 (lambda (de comb_to_mark_map [evaled] imm_eval indent) - (if (comb? evaled) (let ([wrap_level de? se params body actual_function] (.comb evaled) + (if (comb? evaled) (let ([wrap_level de? se variadic params body actual_function] (.comb evaled) wrapped_actual_fun (if (= nil actual_function) nil (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 variadic 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 (parameters_evaled_proxy 0 (lambda (de comb_to_mark_map [evaled] imm_eval indent) - (if (comb? evaled) (let ([wrap_level de? se params body actual_function] (.comb evaled) + (if (comb? evaled) (let ([wrap_level de? se variadic params body actual_function] (.comb evaled) unwrapped_actual_fun (if (= nil actual_function) nil (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 variadic params body unwrapped_actual_fun] ) [(put comb_to_mark_map unwrapped_actual_fun unwrapped_marked_fun) unwrapped_marked_fun]) [comb_to_mark_map ['later [unwrap (strip evaled)]]])) ) unwrap]] @@ -269,7 +272,7 @@ [(and ok nok) (concat a [p])])) [true []] (idx x 1)) - (comb? x) (let (c (idx x 6)) + (comb? x) (let (c (idx x 7)) (if (= nil c) (error (str "partial eval failed: inne stripping a combinator without a real combinator (due to nil enviornment, no doubt)" x)) [true c])) (prim_comb? x) [true (idx x 2)] diff --git a/partial_eval_test.kp b/partial_eval_test.kp index e770fa8..5e8832a 100644 --- a/partial_eval_test.kp +++ b/partial_eval_test.kp @@ -74,27 +74,30 @@ (+ a x b)))) ))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))") - do1_test (read-string "((wrap (vau (let1) - (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se))) - (let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil - (= i (- (len s) 1)) (eval (idx s i) se) - (eval (idx s i) se) (recurse recurse s (+ i 1) se) - true (recurse recurse s (+ i 1) se))) - (let1 do (vau se (& s) (do_helper do_helper s 0 se)) - (do (println 1 2 3) - (println 4 5 6)) - ))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))") + array_test (read-string "(array 1 2 3 4 5)") + vararg_test (read-string "((wrap (vau (a & rest) rest)) 1 2 3 4 5)") - do2_test (read-string "((wrap (vau (let1) - (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se))) - (let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil - (= i (- (len s) 1)) (eval (idx s i) se) - (eval (idx s i) se) (recurse recurse s (+ i 1) se) - true (recurse recurse s (+ i 1) se))) - (let1 do (vau se (& s) (do_helper do_helper s 0 se)) - (do (println 1 2 3) - (println 4 5 6)) - ))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))") + ;do1_test (read-string "((wrap (vau (let1) + ; (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se))) + ; (let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil + ; (= i (- (len s) 1)) (eval (idx s i) se) + ; (eval (idx s i) se) (recurse recurse s (+ i 1) se) + ; true (recurse recurse s (+ i 1) se))) + ; (let1 do (vau se (& s) (do_helper do_helper s 0 se)) + ; (do (println 1 2 3) + ; (println 4 5 6)) + ; ))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))") + + ;do2_test (read-string "((wrap (vau (let1) + ; (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se))) + ; (let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil + ; (= i (- (len s) 1)) (eval (idx s i) se) + ; (eval (idx s i) se) (recurse recurse s (+ i 1) se) + ; true (recurse recurse s (+ i 1) se))) + ; (let1 do (vau se (& s) (do_helper do_helper s 0 se)) + ; (do (println 1 2 3) + ; (println 4 5 6)) + ; ))))) (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"]] @@ -131,8 +134,11 @@ _ (test-case lambda2_test) _ (test-case lambda3_test) - _ (test-case do1_test) - _ (test-case do2_test) + _ (test-case vararg_test) + _ (test-case array_test) + + ;_ (test-case do1_test) + ;_ (test-case do2_test) ;_ (println "THE BIG SHOW") ;_ (println big_test1)