From 48cab3cbdf0296bbe63bf358b08f27a255d45ce6 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Tue, 4 Jan 2022 01:19:41 -0500 Subject: [PATCH] Found the partial eval bug - a comb with a non-real environment doesn't count as later? which means that array values with them get skipped and not partial evaled further, which means they don't get further refined. I need to think through exactly which definition of later? is correct, or if it should be two concepts, because one of the two uses or the definition must change. For now just commented out the array value return and has it always re-traverse --- partial_eval.csc | 117 ++++++++++++++++++++++++----------------------- 1 file changed, 61 insertions(+), 56 deletions(-) diff --git a/partial_eval.csc b/partial_eval.csc index 5dcd63a..0dc99f1 100644 --- a/partial_eval.csc +++ b/partial_eval.csc @@ -159,7 +159,7 @@ )) f l))) (str (lambda args (begin (define mp (open-output-string)) - (display args mp) + ((rec-lambda recurse (x) (mif x (begin (display (car x) mp) (recurse (cdr x))) nil)) args) (get-output-string mp)))) (write_file (lambda (file bytes) (call-with-output-file file (lambda (out) (foldl (lambda (_ o) (write-byte o out)) (void) bytes))))) @@ -251,15 +251,15 @@ (str " " (recurse (- i 1)))))) (str_strip (lambda args (apply str (concat (slice args 0 -2) (array ((rec-lambda recurse (x) - (cond ((val? x) (.val x)) + (cond ((val? x) (str (.val x))) ((marked_array? x) (let ((stripped_values (map recurse (.marked_array_values x)))) - (mif (.marked_array_is_val x) (cons array stripped_values) - stripped_values))) - ((marked_symbol? x) (mif (.marked_symbol_is_val x) (array 'quote (.marked_symbol_value x)) - (.marked_symbol_value x))) + (mif (.marked_array_is_val x) (str "[" stripped_values "]") + (str stripped_values)))) + ((marked_symbol? x) (mif (.marked_symbol_is_val x) (str "'" (.marked_symbol_value x)) + (str (.marked_symbol_value x)))) ((comb? x) (dlet (((wrap_level de? se variadic params body) (.comb x))) (str " " params " " (recurse body) ">"))) - ((prim_comb? x) (idx x 2)) + ((prim_comb? x) (str (idx x 3))) ((marked_env? x) (let* ((e (.env_marked x)) (index (.marked_env_idx x)) (u (idx e -1)) @@ -405,7 +405,8 @@ ((prim_comb? x) x) ((marked_symbol? x) (mif (.marked_symbol_is_val x) x (env-lookup env (.marked_symbol_value x)))) - ((marked_array? x) (cond ((.marked_array_is_val x) x) + ((marked_array? x) (cond ;((.marked_array_is_val x) x) + ((.marked_array_is_val x) (marked_array true (map (lambda (p) (recurse p env env_stack (+ 1 indent))) (.marked_array_values x)))) ((= 0 (len (.marked_array_values x))) (error "Partial eval on empty array")) (true (let* ((values (.marked_array_values x)) (_ (print_strip (indent_str indent) "partial_evaling comb " (idx values 0))) @@ -3350,14 +3351,13 @@ )))) - (test-all (lambda () (let* ( - (run_test (lambda (s) (let* ( - (_ (print "\n\ngoing to partial eval " s)) - (result (partial_eval (read-string s))) - (_ (print "result of test \"" s "\" => " (str_strip result))) - (_ (print "with a hash of " (.hash result))) - ) nil))) - ) (begin + (run_partial_eval_test (lambda (s) (let* ( + (_ (print "\n\ngoing to partial eval " s)) + (result (partial_eval (read-string s))) + (_ (print "result of test \"" s "\" => " (str_strip result))) + (_ (print "with a hash of " (.hash result))) + ) nil))) + (test-most (lambda () (begin (print (val? '(val))) (print "take 3" (take '(1 2 3 4 5 6 7 8 9 10) 3)) ; shadowed by wasm @@ -3390,88 +3390,88 @@ (print "zip " (zip '(1 2 3) '(4 5 6) '(7 8 9))) - (print (run_test "(+ 1 2)")) + (print (run_partial_eval_test "(+ 1 2)")) (print) (print) - (print (run_test "(cond false 1 true 2)")) - (print (run_test "(log 1)")) - (print (run_test "((vau (x) (+ x 1)) 2)")) + (print (run_partial_eval_test "(cond false 1 true 2)")) + (print (run_partial_eval_test "(log 1)")) + (print (run_partial_eval_test "((vau (x) (+ x 1)) 2)")) - (print (run_test "(+ 1 2)")) - (print (run_test "(vau (y) (+ 1 2))")) - (print (run_test "((vau (y) (+ 1 2)) 4)")) - (print (run_test "((vau (y) y) 4)")) - (print (run_test "((vau (y) (+ 13 2 y)) 4)")) - (print (run_test "((wrap (vau (y) (+ 13 2 y))) (+ 3 4))")) - (print (run_test "(vau de (y) (+ (eval y de) (+ 1 2)))")) - (print (run_test "((vau de (y) ((vau dde (z) (+ 1 (eval z dde))) y)) 17)")) + (print (run_partial_eval_test "(+ 1 2)")) + (print (run_partial_eval_test "(vau (y) (+ 1 2))")) + (print (run_partial_eval_test "((vau (y) (+ 1 2)) 4)")) + (print (run_partial_eval_test "((vau (y) y) 4)")) + (print (run_partial_eval_test "((vau (y) (+ 13 2 y)) 4)")) + (print (run_partial_eval_test "((wrap (vau (y) (+ 13 2 y))) (+ 3 4))")) + (print (run_partial_eval_test "(vau de (y) (+ (eval y de) (+ 1 2)))")) + (print (run_partial_eval_test "((vau de (y) ((vau dde (z) (+ 1 (eval z dde))) y)) 17)")) - (print (run_test "(cond false 1 false 2 (+ 1 2) 3 true 1337)")) - (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_partial_eval_test "(cond false 1 false 2 (+ 1 2) 3 true 1337)")) + (print (run_partial_eval_test "(vau de (x) (cond false 1 false 2 x 3 true 42))")) + (print (run_partial_eval_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_partial_eval_test "(combiner? true)")) + (print (run_partial_eval_test "(combiner? (vau de (x) x))")) + (print (run_partial_eval_test "(vau de (x) (combiner? x))")) - (print (run_test "((vau (x) x) a)")) + (print (run_partial_eval_test "((vau (x) x) a)")) - (print (run_test "(env? true)")) + (print (run_partial_eval_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_partial_eval_test "(vau de (x) (env? de))")) + (print (run_partial_eval_test "(vau de (x) (env? x))")) + (print (run_partial_eval_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 (run_partial_eval_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_partial_eval_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_partial_eval_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_partial_eval_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) + (print (run_partial_eval_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) + (print (run_partial_eval_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) + (print (run_partial_eval_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 "\n\nlambda 1\n\n") - (print (run_test "((wrap (vau (let1) + (print (run_partial_eval_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 "\n\nlambda 2\n\n") - (print (run_test "((wrap (vau (let1) + (print (run_partial_eval_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 "\n\nlambda 3\n\n") - (print (run_test "((wrap (vau (let1) + (print (run_partial_eval_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)")) + (print (run_partial_eval_test "(array 1 2 3 4 5)")) + (print (run_partial_eval_test "((wrap (vau (a & rest) rest)) 1 2 3 4 5)")) (print "\n\nrecursion test\n\n") - (print (run_test "((wrap (vau (let1) + (print (run_partial_eval_test "((wrap (vau (let1) (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se))) ((lambda (x n) (x x n)) (lambda (recurse n) (cond (!= 0 n) (* n (recurse recurse (- n 1))) true 1 )) 5) ))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")) (print "\n\nlambda recursion test\n\n") - (print (run_test "((wrap (vau (let1) + (print (run_partial_eval_test "((wrap (vau (let1) (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se))) (lambda (n) ((lambda (x n) (x x n)) (lambda (recurse n) (cond (!= 0 n) (* n (recurse recurse (- n 1))) true 1 )) n)) @@ -3668,12 +3668,17 @@ ;(_ (print "ok, hexfy of 15 << 60 is " (i64_le_hexify (<< 15 60)))) ;(_ (print "ok, hexfy of 15 << 56 is " (i64_le_hexify (<< 15 56)))) ) (void)) - )))) + ))) (run-compiler (lambda () (write_file "./csc_out.wasm" (compile (partial_eval (read-string (slurp "to_compile.kp"))))) )) -) (test-all)) -;) (run-compiler)) + (test-new (lambda () (begin + (print (run_partial_eval_test "((vau (some_val) (array (vau (x) 4))) 1337)")) + ))) + +;) (test-most)) +;) (test-new)) +) (run-compiler)) )