(with_import "./partial_eval.kp" (let ( test-case (lambda (code) (let ( _ (println "Code: " code) ; For right now we only support calling partial_eval in such a way that it partial evals against ; the root env, but this is could and really should be extended. We could at least check if the env we're called with ; is the root_env, or if what we look up in whatever env is passed in matches something in the root env partially_evaled (partial_eval code) _ (println "Partially evaled: " partially_evaled) _ (print_strip partially_evaled) stripped (strip partially_evaled) _ (println "Stripped: " stripped) fully_evaled (eval stripped root_env) _ (println "Fully evaled: " fully_evaled) fully_evaled_called (if (combiner? fully_evaled) (fully_evaled 1337)) _ (if (combiner? fully_evaled) (println "..and called " fully_evaled_called)) outer_eval (eval code root_env) _ (println " outer-eval " outer_eval) outer_called (if (combiner? outer_eval) (outer_eval 1337)) _ (if (combiner? outer_eval) (println "..and outer called " outer_called)) _ (cond (or (combiner? fully_evaled) (combiner? outer_eval)) (if (!= fully_evaled_called outer_called) (error (str "called versions unequal for " code " are " fully_evaled_called " vs " outer_called))) (!= fully_evaled outer_eval) (error (str "partial-eval versions unequal for " code " are " fully_evaled " vs " outer_eval)) true nil) _ (println) ) fully_evaled)) simple_add (read-string "(+ 1 2)") vau_with_add (read-string "(vau (y) (+ 1 2))") vau_with_add_called (read-string "((vau (y) (+ 1 2)) 4)") vau_with_passthrough (read-string "((vau (y) y) 4)") vau_with_no_eval_add (read-string "((vau (y) (+ 13 2 y)) 4)") vau_with_wrap_add (read-string "((wrap (vau (y) (+ 13 2 y))) (+ 3 4))") vau_with_add_p (read-string "(vau de (y) (+ (eval y de) (+ 1 2)))") vau_with_add_p_called (read-string "((vau de (y) ((vau dde (z) (+ 1 (eval z dde))) y)) 17)") cond_test (read-string "(cond false 1 false 2 (+ 1 2) 3 true 1337)") cond_vau_test (read-string "(vau de (x) (cond false 1 false 2 x 3 true 42))") cond_vau_test2 (read-string "(vau de (x) (cond false 1 false 2 3 x true 42))") combiner_test (read-string "(combiner? true)") combiner_test2 (read-string "(combiner? (vau de (x) x))") combiner_test3 (read-string "(vau de (x) (combiner? x))") symbol_test (read-string "((vau (x) x) a)") env_test (read-string "(env? true)") ; this doesn't partially eval, but it could with a more percise if the marked values were more percise env_test2 (read-string "(vau de (x) (env? de))") env_test3 (read-string "(vau de (x) (env? x))") env_test4 (read-string "((vau de (x) (env? de)) 1)") ; let1 test ; ((wrap (vau root_env (quote) ((wrap (vau (let1) ;HERE;)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de))))) (vau (x) x)) ;let1_test (read-string "((wrap (vau root_env (quote) ((wrap (vau (let1) (let1 a 12 (+ a 1)))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de))))) (vau (x) x))") let1_test (read-string "((wrap (vau (let1) (let1 a 12 (+ a 1)))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))") let2_test (read-string "((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)))") let3_test (read-string "((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)))") let4_test (read-string "((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)))") let4.3_test (read-string "((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)))") let4.7_test (read-string "((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)))") ;!!!!!!!!!!!!!!!!!!!!!!!!!! ; Which means we need TODO ;!!!!!!!!!!!!!!!!!!!!!!!!!! ; 1) Change from is_val as a bool to is_val as an int, and allow negative values in certain situations ; If we're not careful about the environment it was evaluated in vs current environment, we'll also have to carry around the environment ; We might be able to call partial_eval with them, but not pass them any further down, esp into anything that might change the scope. ; This will at least allow us to decend into and partial eval the other parts of the array calling form so we can partial eval inside the body's of lets ; where the value being assigned has some later? value. ; 2) Finish up closes_over_var_from_this_env_marked so it's less finicky ; ; I think we'll need both for this to actualy work ; let5_test (read-string "((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)))") lambda1_test (read-string "((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)))") lambda2_test (read-string "((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)))") ;!!!! Ditto to let5_test lambda3_test (read-string "((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)))") array_test (read-string "(array 1 2 3 4 5)") vararg_test (read-string "((wrap (vau (a & rest) rest)) 1 2 3 4 5)") ;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"]] ;big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] ["" "-C" "(let (a 17) (vau (x) a))"]] big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] ["" "-C" "(let (a 17) a)"]] ;big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] []] _ (test-case simple_add) _ (test-case vau_with_add) _ (test-case vau_with_add_called) _ (test-case vau_with_passthrough) _ (test-case vau_with_no_eval_add) _ (test-case vau_with_wrap_add) _ (test-case vau_with_add_p) _ (test-case vau_with_add_p_called) _ (test-case cond_test) _ (test-case cond_vau_test) _ (test-case cond_vau_test2) _ (test-case combiner_test) _ (test-case combiner_test2) _ (test-case combiner_test3) _ (test-case symbol_test) _ (test-case env_test) _ (test-case env_test2) _ (test-case env_test3) _ (test-case env_test4) _ (test-case let1_test) _ (test-case let2_test) _ (test-case let3_test) _ (test-case let4_test) _ (test-case let4.3_test) _ (test-case let4.7_test) _ (test-case let5_test) _ (test-case lambda1_test) _ (test-case lambda2_test) _ (test-case lambda3_test) _ (test-case array_test) _ (test-case vararg_test) ;_ (test-case do1_test) ;_ (test-case do2_test) ;_ (println "THE BIG SHOW") ;_ (println big_test1) ;_ (test-case big_test1) ) nil))