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)) )