Fix a bug in eval strip not actually stripping in the proper eval way - f there's a later anywhere in there, it has to desist, which is now implemented. Added do tests - we have to add support for & params, which I had forgotten, and I belive it now loops infinately because it tries to partially evaluate a recursive function!
This commit is contained in:
@@ -263,21 +263,28 @@
|
||||
;; but we'd have to be careful to also remove it on this side, and what about if it gets wrapped in another combiner? Maybe just a bad idea
|
||||
;;;;
|
||||
terrible_hack_strip (rec-lambda recurse (x)
|
||||
(cond (val? x) (.val x)
|
||||
(later? x) (.later x)
|
||||
(marked_array? x) (map recurse (idx x 1))
|
||||
(cond (val? x) [true (.val x)]
|
||||
(later? x) [false (.later x)]
|
||||
(marked_array? x) (foldl (lambda ([ok a] x) (let ([nok p] (recurse x))
|
||||
[(and ok nok) (concat a [p])]))
|
||||
[true []]
|
||||
(idx x 1))
|
||||
(comb? x) (let (c (idx x 6))
|
||||
(if (= nil c) (error (str "partial eval failed: inne stripping a combinator without a real combinator (due to nil enviornment, no doubt)" x))
|
||||
c))
|
||||
(prim_comb? x) (idx x 2)
|
||||
[true c]))
|
||||
(prim_comb? x) [true (idx x 2)]
|
||||
(marked_env? x) (error "Env escaped to strip!")
|
||||
true (error (str "some other strip? " x))
|
||||
)
|
||||
)
|
||||
|
||||
fallback_result [comb_to_mark_map ['later [eval (.later body1) (if (= nil (.env_real eval_env)) (slice params 1 -1) (.env_real eval_env))]]]
|
||||
c_body2 (cond (val? body1) (partial_eval_helper (.val body1) eval_env comb_to_mark_map imm_eval (+ 1 indent))
|
||||
(later? body1) [comb_to_mark_map ['later [eval (.later body1) (if (= nil (.env_real eval_env)) (slice params 1 -1) (.env_real eval_env))]]]
|
||||
(marked_array? body1) (partial_eval_helper (map terrible_hack_strip (idx body1 1)) eval_env comb_to_mark_map imm_eval (+ 1 indent))
|
||||
(later? body1) fallback_result
|
||||
; In the case of a later value internal to marked_array, it must finish being evaluated, or at least kept as a later
|
||||
(marked_array? body1) (let ([ok sbody1] (terrible_hack_strip body1))
|
||||
(if ok (partial_eval_helper sbody1 eval_env comb_to_mark_map imm_eval (+ 1 indent))
|
||||
fallback_result))
|
||||
(comb? body1) [comb_to_mark_map body1]
|
||||
(prim_comb? body1) [comb_to_mark_map body1]
|
||||
(marked_env? body1) (error "Env escaped to eval_strip!")
|
||||
|
||||
@@ -74,6 +74,27 @@
|
||||
(+ a x b))))
|
||||
))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
|
||||
|
||||
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"]]
|
||||
@@ -110,6 +131,9 @@
|
||||
_ (test-case lambda2_test)
|
||||
_ (test-case lambda3_test)
|
||||
|
||||
_ (test-case do1_test)
|
||||
_ (test-case do2_test)
|
||||
|
||||
;_ (println "THE BIG SHOW")
|
||||
;_ (println big_test1)
|
||||
;_ (test-case big_test1)
|
||||
|
||||
Reference in New Issue
Block a user