188 lines
12 KiB
Plaintext
188 lines
12 KiB
Plaintext
(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)))")
|
|
|
|
; Ok, the post-refactor sticking point is
|
|
;
|
|
; after first eval of param ( marked_array true ( ( marked_array true ( ( prim_comb combiner(wrap_level: 1) builtin_combiner_vau(wrap_level: 0) ) ( marked_array true ( ( marked_symbol true y ) ) ) ( marked_array true ( ( marked_symbol true + ) ( marked_symbol true y ) ( marked_symbol true x ) ( marked_symbol true a ) ) ) ) ) ( marked_array false ( ( prim_comb combiner(wrap_level: 1) builtin_combiner_+(wrap_level: 1) ) ( marked_symbol false x ) ( val 12 ) ( val 1 ) ) ) ) )
|
|
;
|
|
; tries to finish the eval by unvaling & then partial evaling:
|
|
; [ [ vau [ 'y ] [ '+ 'y 'x 'a ] ] ( + x 12 1 ) ]
|
|
;
|
|
; This fails as it can't unval (+ x 12 1). Note the vau's not wrapped, so it won't actually partial eval after that, but it still dies first...
|
|
; This is where that is_val as an int might make sense...
|
|
; theoretically when the vau uses y and then strips it can sub in the stuff exactly, as subbing in itself counts as an evaluation.
|
|
; In general, stripping counts as a +1 to the is_val counter and we need to add evals or (array ...)/quote to get it to 0. In this case, it would work perfectly.
|
|
; The REALLY tricky part is that by allow it to go negative we have to remember what environment it needs to be evaluated in and make sure it's either the same environment
|
|
; or a sub environment that doesn't shadow anything...
|
|
;
|
|
; ALTERNATIVE: allow partial evals on things that contain negatives, but don't actually do the call, but allow the partial eval to go into the other
|
|
; parts, namely into the body of the vau above
|
|
;
|
|
; Also, it seems to be bailing even harder than it otherwise should be, as that above partial eval of let1, as limited as it is, doesn't show up in the final output
|
|
; This is due to the later? and closes_over_var_from_this_env_marked check in function call
|
|
;
|
|
;!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
; 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 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))
|