2 steps forward, 1 step back - I have arrays (and I think varargs) working, but let5_test is now not partial evaling as far as it should because of my fix. Detailed explanation in the comments, but it looks like we are going to have to insert that eval_strip hack, or somesuch

This commit is contained in:
Nathan Braswell
2021-09-05 00:25:33 -04:00
parent b44ff104fb
commit 49d5a196aa
2 changed files with 48 additions and 35 deletions

View File

@@ -20,6 +20,15 @@
; meta...
; !!!!!!!!!!!!!!!!!!!!!!!!!!
; ! To avoid exponential blowup due to evaluating function, then params, then function with params, etc etc
; ! Should probabally implement some form of evaluating to head-normal form controlled by boolean
; ! that quits as soon as it has any sort of value (I suppose the real change is only to combinators and arrays)
; ! so that we don't waste time re-trying etc. Anything in parameter position would be fully evaluated, so I don't think
; ! we'd waste overmuch, but it could make things less efficient I suppose...
; ! Maybe it's a bad idea - food for thought! Might need a better cacheing strategy
; !!!!!!!!!!!!!!!!!!!!!!!!!
; Ok, instead of just ['now v] and ['later v], we have these marked values
; ['val v] (v can be an array)
; ['later c]
@@ -78,8 +87,9 @@
(str " " (recurse (- i 1)))))
strip (rec-lambda recurse (x)
(do ;(println "calling strip with " x)
(cond (val? x) (.val x) ;(let (v (.val x)) (if (array? v) (cons array (map recurse (map (lambda (x) ['val x]) v))) v))
(do (println "calling strip with " x)
(cond (val? x) ;(.val x)
(let (v (.val x)) (if (array? v) (cons array (map recurse (map (lambda (x) ['val x]) v))) v))
(later? x) (.later x)
(marked_array? x) (cons array (map recurse (idx x 1)))
(comb? x) (let (c (idx x 7))
@@ -91,6 +101,22 @@
))
)
eval_strip (rec-lambda recurse (x)
(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 7))
(if (= nil c) (error (str "partial eval failed: eval_stripping a combinator without a real combinator (due to nil enviornment, no doubt)" x))
[true c]))
(prim_comb? x) [true (idx x 2)]
(marked_env? x) (error "Env escaped to eval_strip!")
true (error (str "some other eval_strip? " x))
)
)
; GAH ok additionally
; partial_eval_helper will have to deal with combinator values (at least, primitives, I suspect all)
; as it might have to use them to reconstruct an expression on strip,
@@ -131,17 +157,21 @@
(comb? comb) (let (
[wrap_level de? se variadic params body actual_function] (.comb comb)
literal_params (slice x 1 -1)
[comb_to_mark_map appropriatly_evaled_params] ((rec-lambda param-recurse (wrap params comb_to_mark_map)
[ok comb_to_mark_map appropriatly_evaled_params] ((rec-lambda param-recurse (wrap params comb_to_mark_map)
(if (!= 0 wrap)
(let ([ok eval_strip_params] (eval_strip ['marked_array params]))
(if (not ok) [ok comb_to_mark_map nil]
(let ([comb_to_mark_map evaled_params]
(foldl (lambda ([comb_to_mark_map ac] p)
(let ([comb_to_mark_map p] (recurse p env comb_to_mark_map false (+ 1 indent)))
[comb_to_mark_map (concat ac [p])]))
[comb_to_mark_map []]
(map strip params)))
(param-recurse (- wrap 1) evaled_params comb_to_mark_map))
[comb_to_mark_map params])
eval_strip_params))
(param-recurse (- wrap 1) evaled_params comb_to_mark_map))))
[true comb_to_mark_map params])
) wrap_level (map (lambda (p) ['val p]) literal_params) comb_to_mark_map)
) (if (not ok) [comb_to_mark_map ['later (cons (strip comb) (slice x 1 -1))]]
(let (
final_params (if variadic (concat (slice appropriatly_evaled_params 0 (- (len params) 1))
[['marked_array (slice appropriatly_evaled_params (- (len params) 1) -1)]])
appropriatly_evaled_params)
@@ -179,7 +209,7 @@
[comb_to_mark_map ['later (cons (strip comb) literal_params)]])
[comb_to_mark_map ['later (cons actual_function literal_params)]])
[comb_to_mark_map func_result])
) result)
) result)))
true (error (str "Partial eval noticed that you will likely call not a function " comb " total is " x))))
(nil? x) [comb_to_mark_map ['val x]]
true (error (str "impossible partial_eval value " x))
@@ -261,33 +291,12 @@
[comb_to_mark_map body1] (partial_eval_helper (idx params 0) de comb_to_mark_map imm_eval (+ 1 indent))
_ (println (indent_str indent) "after first eval of param " body1)
;;;;
;; TODO: add a terrible hack (I was thinking about some sort of value to embed a non-real combiner into the stripped that will be turned back in partial eval
;; 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) [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 7))
(if (= nil c) (error (str "partial eval failed: inne stripping a combinator without a real combinator (due to nil enviornment, no doubt)" x))
[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) fallback_result
(later? body1) [comb_to_mark_map ['later [eval (.later body1) (if (= nil (.env_real eval_env)) (slice params 1 -1) (.env_real eval_env))]]]
; 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))
(marked_array? body1) (let ([ok sbody1] (eval_strip body1))
(if ok (partial_eval_helper sbody1 eval_env comb_to_mark_map imm_eval (+ 1 indent))
fallback_result))
[comb_to_mark_map ['later [eval (strip body1) (if (= nil (.env_real eval_env)) (slice params 1 -1) (.env_real eval_env))]]]))
(comb? body1) [comb_to_mark_map body1]
(prim_comb? body1) [comb_to_mark_map body1]
(marked_env? body1) (error "Env escaped to eval_strip!")

View File

@@ -29,8 +29,6 @@
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)))")
;; No longer works with our more aggressive partial-evaling of vaus with incomplete environments
;; BUT DOES CUZ I ROLLED THAT BACK
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)")
@@ -56,6 +54,12 @@
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)))")
; I've broken this one with my parameter bailing I think
; The problem seems to be the second eval of let1, which is ( marked_array ( ( marked_array ( ( prim_comb combiner(wrap_level: 1) builtin_combiner_vau(wrap_level: 0) ) ( val ( y) ) ( val ( + y x a ) ) ) ) ( later ( builtin_combiner_+(wrap_level: 1) x a 1 ) ) ) )
; that is, ['ma ['ma vau ('val y) 'val (+ y x a) ] 'later [+ x a 1] ], and because of that later, eval_strip
; is returning not-ok, and so the whole thing can't be passed to partial_eval.
; To fix it, we'd need that strip-hack-thing to strip it out then sub it back in in the partial eval.
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)
@@ -134,8 +138,8 @@
_ (test-case lambda2_test)
_ (test-case lambda3_test)
_ (test-case vararg_test)
_ (test-case array_test)
_ (test-case vararg_test)
;_ (test-case do1_test)
;_ (test-case do2_test)