miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix another bug where things like (<comb0> <somecomb fake env>) wasn't reevaluating somecomb and fixing up the fake env on calls because comb0 has wrap level 0. In fact, it should still be partially evaluated again, just not stripped. This only comes up in slightly nontrivial examples because there's a good bit of nesting

Browse Source
This commit is contained in:
Nathan Braswell
2022-01-04 23:37:57 -05:00
parent 48cab3cbdf
commit d1fc4e5d66
1 changed files with 15 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
partial_eval.csc
View File

@@ -258,12 +258,12 @@
((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) ">")))
(str "<(comb " wrap_level " " de? " " (recurse se) " " params " " (recurse body) ")>")))
((prim_comb? x) (str (idx x 3)))
((marked_env? x) (let* ((e (.env_marked x))
(index (.marked_env_idx x))
(u (idx e -1))
) (str "<" (mif (marked_env_real? x) "real" "fake") " ENV idx: " (str index) ", " (map (dlambda ((k v)) (array k (recurse v))) (slice e 0 -2)) " upper: " (mif u (recurse u) "<no_upper_likely_root_env>") ">")
) (if (> (len e) 30) (str "{" (len e) "env}") (str "{" (mif (marked_env_real? x) "real" "fake") " ENV idx: " (str index) ", " (map (dlambda ((k v)) (array k (recurse v))) (slice e 0 -2)) " upper: " (mif u (recurse u) "no_upper_likely_root_env") "}"))
))
(true (error (str "some other str_strip? |" x "|")))
)
@@ -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 ; This isn't true, because there might be comb like values in marked array that need to be further evaluated ((.marked_array_is_val x) x)
; to actually prevent redoing this work, marked_array should keep track of if everything inside is is head-values or pure done values
((.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))
@@ -423,13 +424,13 @@
((wrap_level de? se variadic params body) (.comb comb))
(ensure_val_params (map ensure_val literal_params))
((ok appropriatly_evaled_params) ((rec-lambda param-recurse (wrap cparams)
(mif (!= 0 wrap)
(dlet ((pre_evaled (map rp_eval cparams))
((ok unval_params) (try_unval_array pre_evaled)))
(mif (not ok) (array ok nil)
(let* ((evaled_params (map rp_eval unval_params)))
(param-recurse (- wrap 1) evaled_params))))
(array true cparams))
(dlet ((pre_evaled (map rp_eval cparams)))
(mif (!= 0 wrap)
(dlet (((ok unval_params) (try_unval_array pre_evaled)))
(mif (not ok) (array ok nil)
(let* ((evaled_params (map rp_eval unval_params)))
(param-recurse (- wrap 1) evaled_params))))
(array true pre_evaled)))
) wrap_level ensure_val_params))
(ok_and_non_later (and ok (is_all_values appropriatly_evaled_params)))
) (mif (not ok_and_non_later) (marked_array false (cons comb (mif (> wrap_level 0) (map rp_eval literal_params)
@@ -470,7 +471,7 @@
; ! I think needs_params_val_lambda should be combined with parameters_evaled_proxy
; !!!!!!
(parameters_evaled_proxy (rec-lambda recurse (pasthr_ie inner_f) (lambda (de env_stack params indent) (dlet (
(_ (println "partial_evaling params in parameters_evaled_proxy is " params))
;(_ (println "partial_evaling params in parameters_evaled_proxy is " params))
((evaled_params l) (foldl (dlambda ((ac i) p) (let ((p (partial_eval_helper p de env_stack (+ 1 indent))))
(array (concat ac (array p)) (+ i 1))))
(array (array) 0)
@@ -500,10 +501,10 @@
(array 'vau (marked_prim_comb (rec-lambda recurse (de env_stack params indent) (dlet (
(mde? (mif (= 3 (len params)) (idx params 0) nil))
(vau_mde? (mif (= nil mde?) (array) (array mde?)))
(_ (print "mde? is " mde?))
(_ (print "\tmde? if " (mif mde? #t #f)))
(_ (print (indent_str indent) "mde? is " mde?))
(_ (print (indent_str indent) "\tmde? if " (mif mde? #t #f)))
(de? (mif mde? (.marked_symbol_value mde?) nil))
(_ (print "de? is " de?))
(_ (print (indent_str indent) "de? is " de?))
(vau_de? (mif (= nil de?) (array) (array de?)))
(raw_marked_params (mif (= nil de?) (idx params 0) (idx params 1)))
(raw_params (map (lambda (x) (mif (not (marked_symbol? x)) (error (str "not a marked symbol " x))