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
This commit is contained in:
Nathan Braswell
117
partial_eval.csc
117
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 "<comb " wrap_level " " de? " <se " (recurse se) "> " 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))
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user