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

Fixed the Y combiner not partial evaluating as far as it should thing by adding infinite-recursion-blocking-hash-tracking to the needed_for_progress infrustracture. Only arrays need to track it, since at function boundries you won't want to reevaluate it anyway until the function is called. Having a hash from the IRBHT be not in your memo counts as a #t true need to re-partial eval.

Browse Source
This commit is contained in:
Nathan Braswell
2022-02-10 01:15:02 -05:00
parent 325afd773e
commit 69fd587989
1 changed files with 58 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files

107
partial_eval.csc
View File

@@ -215,23 +215,27 @@
(.any_comb_wrap_level (lambda (x) (cond ((prim_comb? x) (.prim_comb_wrap_level x)) (.any_comb_wrap_level (lambda (x) (cond ((prim_comb? x) (.prim_comb_wrap_level x))
((comb? x) (.comb_wrap_level x)) ((comb? x) (.comb_wrap_level x))
(true (error "bad .any_comb_level"))))) (true (error "bad .any_comb_level")))))
; Results are either ; The actual needed_for_progress values are either
; #t - any eval will do something ; #t - any eval will do something
; nil - is a value, no eval will do anything ; nil - is a value, no eval will do anything
; (3 4 1...) - list of env de Bruijn indicies that would allow forward progress ; (3 4 1...) - list of env ids that would allow forward progress
; But these are paired with another list of hashes that if you're not inside
; of an evaluation of, then it could progress futher. These are all caused by
; the infinite recursion stopper.
(needed_for_progress (rec-lambda needed_for_progress (x) (cond ((marked_array? x) (.marked_array_needed_for_progress x)) (needed_for_progress (rec-lambda needed_for_progress (x) (cond ((marked_array? x) (.marked_array_needed_for_progress x))
((marked_symbol? x) (.marked_symbol_needed_for_progress x)) ((marked_symbol? x) (array (.marked_symbol_needed_for_progress x) nil))
((marked_env? x) (.marked_env_needed_for_progress x)) ((marked_env? x) (array (.marked_env_needed_for_progress x) nil))
((comb? x) (dlet ((id (.comb_id x)) ((comb? x) (dlet ((id (.comb_id x))
(body_needed (needed_for_progress (.comb_body x))) (body_needed (idx (needed_for_progress (.comb_body x)) 0))
(se_needed (needed_for_progress (.comb_env x)))) (se_needed (idx (needed_for_progress (.comb_env x)) 0)))
(if (or (= true body_needed) (= true se_needed)) true (if (or (= true body_needed) (= true se_needed)) (array true nil)
(foldl (lambda (a xi) (if (or (= id xi) (in_array xi a)) a (cons xi a))) (array (foldl (lambda (a xi) (if (or (= id xi) (in_array xi a)) a (cons xi a)))
(array) (concat body_needed se_needed)) (array) (concat body_needed se_needed)) nil)
))) )))
((prim_comb? x) nil) ((prim_comb? x) (array nil nil))
((val? x) nil) ((val? x) (array nil nil))
(true (error (str "what is this? in need for progress" x)))))) (true (error (str "what is this? in need for progress" x))))))
(needed_for_progress_slim (lambda (x) (idx (needed_for_progress x) 0)))
(combine_hash (lambda (a b) (+ (* 37 a) b))) (combine_hash (lambda (a b) (+ (* 37 a) b)))
(hash_bool (lambda (b) (if b 2 3))) (hash_bool (lambda (b) (if b 2 3)))
@@ -266,22 +270,24 @@
; 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 ; 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173
(marked_symbol (lambda (progress_idxs x) (array 'marked_symbol (hash_symbol progress_idxs x) progress_idxs x))) (marked_symbol (lambda (progress_idxs x) (array 'marked_symbol (hash_symbol progress_idxs x) progress_idxs x)))
(marked_array (lambda (is_val attempted x) (dlet ( (marked_array (lambda (is_val attempted resume_hashes x) (dlet (
(array_union (lambda (a b) (foldl (lambda (a bi) (if (in_array bi a) a (cons bi a))) a b)))
; If not is_val, then if the first entry (combiner) is not done or is a combiner and not function ; If not is_val, then if the first entry (combiner) is not done or is a combiner and not function
; shouldn't add the rest of them, since they'll have to be passed without eval ; shouldn't add the rest of them, since they'll have to be passed without eval
; We do this by ignoring trues for non-first ; We do this by ignoring trues for non-first
((_ sub_progress_idxs) (foldl (dlambda ((f a) x) ((_ sub_progress_idxs hashes) (foldl (dlambda ((f a ahs) (x xhs))
(cond ((or (= true a) (and f (= true x))) (array false true)) (array false
((= true x) (array false a)) (cond ((or (= true a) (and f (= true x))) true)
(true (array false (foldl (lambda (a xi) (if (in_array xi a) a (cons xi a))) a x))) ((= true x) a)
) (true (array_union a x)))
) (array true (array)) (map needed_for_progress x))) (array_union ahs xhs))
) (array true (array) resume_hashes) (map needed_for_progress x)))
;(_ (print "got " sub_progress_idxs " out of " x)) ;(_ (print "got " sub_progress_idxs " out of " x))
;(_ (print "\twhich evalated to " (map needed_for_progress x))) ;(_ (print "\twhich evalated to " (map needed_for_progress x)))
(progress_idxs (cond ((and (= nil sub_progress_idxs) (not is_val) attempted) nil) (progress_idxs (cond ((and (= nil sub_progress_idxs) (not is_val) attempted) nil)
((and (= nil sub_progress_idxs) (not is_val) (not attempted)) true) ((and (= nil sub_progress_idxs) (not is_val) (not attempted)) true)
(true sub_progress_idxs))) (true sub_progress_idxs)))
) (array 'marked_array (hash_array is_val attempted x) is_val attempted progress_idxs x)))) ) (array 'marked_array (hash_array is_val attempted x) is_val attempted (array progress_idxs hashes) x))))
(marked_env (lambda (has_vals progress_idxs dbi arrs) (array 'env (hash_env progress_idxs dbi arrs) has_vals progress_idxs dbi arrs))) (marked_env (lambda (has_vals progress_idxs dbi arrs) (array 'env (hash_env progress_idxs dbi arrs) has_vals progress_idxs dbi arrs)))
(marked_val (lambda (x) (array 'val (hash_val x) x))) (marked_val (lambda (x) (array 'val (hash_val x) x)))
(marked_comb (lambda (wrap_level env_id de? se variadic params body) (array 'comb (hash_comb wrap_level env_id de? se variadic params body) wrap_level env_id de? se variadic params body))) (marked_comb (lambda (wrap_level env_id de? se variadic params body) (array 'comb (hash_comb wrap_level env_id de? se variadic params body) wrap_level env_id de? se variadic params body)))
@@ -298,14 +304,15 @@
(and (marked_symbol? x) (= false (.marked_symbol_is_val x))) (and (marked_symbol? x) (= false (.marked_symbol_is_val x)))
))) )))
; array and comb are the ones wherewhere (= nil (needed_for_progress x)) == total_value? isn't true. ; array and comb are the ones wherewhere (= nil (needed_for_progress_slim x)) == total_value? isn't true.
; Right now we only call functions when all parameters are values, which means you can't ; Right now we only call functions when all parameters are values, which means you can't
; create a true_value array with non-value memebers (*right now* anyway), but it does mean that ; create a true_value array with non-value memebers (*right now* anyway), but it does mean that
; you can create a nil needed for progress array that isn't a value, namely for the give_up_* ; you can create a nil needed for progress array that isn't a value, namely for the give_up_*
; primitive functions (extra namely, log and error, which are our two main sources of non-purity besides implicit runtime errors). ; primitive functions (extra namely, log and error, which are our two main sources of non-purity besides implicit runtime errors).
; OR, currently, having your code stopped because of infinite recursion checker. This comes up with the Y combiner
; For combs, being a value is having your env-chain be real? ; For combs, being a value is having your env-chain be real?
(total_value? (lambda (x) (if (marked_array? x) (.marked_array_is_val x) (total_value? (lambda (x) (if (marked_array? x) (.marked_array_is_val x)
(= nil (needed_for_progress x))))) (= nil (needed_for_progress_slim x)))))
(is_all_values (lambda (evaled_params) (foldl (lambda (a x) (and a (total_value? x))) true evaled_params))) (is_all_values (lambda (evaled_params) (foldl (lambda (a x) (and a (total_value? x))) true evaled_params)))
@@ -322,7 +329,7 @@
((symbol? x) (cond ((= 'true x) (marked_val #t)) ((symbol? x) (cond ((= 'true x) (marked_val #t))
((= 'false x) (marked_val #f)) ((= 'false x) (marked_val #f))
(#t (marked_symbol (if eval_pos true nil) x)))) (#t (marked_symbol (if eval_pos true nil) x))))
((array? x) (marked_array (not eval_pos) false ((array? x) (marked_array (not eval_pos) false nil
(idx (foldl (dlambda ((ep a) x) (array false (concat a (array (recurse ep x))))) (idx (foldl (dlambda ((ep a) x) (array false (concat a (array (recurse ep x)))))
(array eval_pos (array)) (array eval_pos (array))
x) x)
@@ -346,7 +353,7 @@
((comb? x) (dlet (((wrap_level env_id de? se variadic params body) (.comb x)) ((comb? x) (dlet (((wrap_level env_id de? se variadic params body) (.comb x))
((se_s done_envs) (recurse se done_envs)) ((se_s done_envs) (recurse se done_envs))
((body_s done_envs) (recurse body done_envs))) ((body_s done_envs) (recurse body done_envs)))
(array (str "<n" (needed_for_progress x) "(comb " wrap_level " " env_id " " de? " " se_s " " params " " body_s ")>") done_envs))) (array (str "<n" (needed_for_progress_slim x) "(comb " wrap_level " " env_id " " de? " " se_s " " params " " body_s ")>") done_envs)))
((prim_comb? x) (array (str "<wl=" (.prim_comb_wrap_level x) " " (.prim_comb_sym x) ">") done_envs)) ((prim_comb? x) (array (str "<wl=" (.prim_comb_wrap_level x) " " (.prim_comb_sym x) ">") done_envs))
((marked_env? x) (dlet ((e (.env_marked x)) ((marked_env? x) (dlet ((e (.env_marked x))
(index (.marked_env_idx x)) (index (.marked_env_idx x))
@@ -397,8 +404,8 @@
(if (!= 0 (len (.marked_array_values x))) (if (!= 0 (len (.marked_array_values x)))
(dlet ((values (.marked_array_values x)) (dlet ((values (.marked_array_values x))
((ok f) (recurse (idx values 0) fail_f)) ((ok f) (recurse (idx values 0) fail_f))
) (array ok (marked_array false false (cons f (slice values 1 -1))))) ) (array ok (marked_array false false nil (cons f (slice values 1 -1)))))
(array true (marked_array false false (array)))))) (array true (marked_array false false nil (array))))))
((marked_symbol? x) (mif (.marked_symbol_is_val x) (array true (marked_symbol true (.marked_symbol_value x))) ((marked_symbol? x) (mif (.marked_symbol_is_val x) (array true (marked_symbol true (.marked_symbol_value x)))
(array false (fail_f x)))) (array false (fail_f x))))
(true (array true x)) (true (array true x))
@@ -528,7 +535,7 @@
) (array c err (concat ds (array d)) changed))) ) (array c err (concat ds (array d)) changed)))
(array pectx nil (array) false) (array pectx nil (array) false)
(.marked_array_values x))) (.marked_array_values x)))
(new_array (marked_array false (.marked_array_is_attempted x) ress)) (new_array (marked_array false (.marked_array_is_attempted x) nil ress))
((pectx err new_array) (if (or (!= nil err) (not changed)) ((pectx err new_array) (if (or (!= nil err) (not changed))
(array pectx err new_array) (array pectx err new_array)
(partial_eval_helper new_array false de env_stack pectx (+ indent 1) true))) (partial_eval_helper new_array false de env_stack pectx (+ indent 1) true)))
@@ -544,13 +551,15 @@
(make_tmp_inner_env (lambda (params de? de env_id) (make_tmp_inner_env (lambda (params de? de env_id)
(dlet ((param_entries (map (lambda (p) (array p (marked_symbol (array env_id) p))) params)) (dlet ((param_entries (map (lambda (p) (array p (marked_symbol (array env_id) p))) params))
(possible_de_entry (mif (= nil de?) (array) (array (array de? (marked_symbol (array env_id) de?))))) (possible_de_entry (mif (= nil de?) (array) (array (array de? (marked_symbol (array env_id) de?)))))
(progress_idxs (cons env_id (needed_for_progress de))) (progress_idxs (cons env_id (needed_for_progress_slim de)))
) (marked_env false progress_idxs env_id (concat param_entries possible_de_entry (array de)))))) ) (marked_env false progress_idxs env_id (concat param_entries possible_de_entry (array de))))))
(partial_eval_helper (rec-lambda partial_eval_helper (x only_head env env_stack pectx indent force) (partial_eval_helper (rec-lambda partial_eval_helper (x only_head env env_stack pectx indent force)
(dlet ((for_progress (needed_for_progress x)) (dlet (((for_progress for_progress_hashes) (needed_for_progress x))
(_ (print_strip (indent_str indent) "for_progress " for_progress " for " x)) (_ (print_strip (indent_str indent) "for_progress " for_progress ", for_progress_hashes " for_progress_hashes " for " x))
((env_counter memo) pectx)
(hashes_now (foldl (lambda (a hash) (or a (= false (get-value-or-false memo hash)))) false for_progress_hashes))
(progress_now (or (= for_progress true) ((rec-lambda rr (i) (if (= i (len for_progress)) false (progress_now (or (= for_progress true) ((rec-lambda rr (i) (if (= i (len for_progress)) false
(dlet ( (dlet (
; possible if called from a value context in the compiler ; possible if called from a value context in the compiler
@@ -564,7 +573,7 @@
) (if this_now this_now (rr (+ i 1)))) ) (if this_now this_now (rr (+ i 1))))
)) 0))) )) 0)))
) )
(if (or force progress_now) (if (or force hashes_now progress_now)
(cond ((val? x) (array pectx nil x)) (cond ((val? x) (array pectx nil x))
((marked_env? x) (let ((dbi (.marked_env_idx x))) ((marked_env? x) (let ((dbi (.marked_env_idx x)))
; compiler calls with empty env stack ; compiler calls with empty env stack
@@ -592,7 +601,7 @@
((marked_array? x) (cond ((.marked_array_is_val x) (dlet ( ((pectx err inner_arr) (foldl (dlambda ((c er ds) p) (dlet (((c e d) (partial_eval_helper p false env env_stack c (+ 1 indent) false))) (array c (mif er er e) (concat ds (array d))))) ((marked_array? x) (cond ((.marked_array_is_val x) (dlet ( ((pectx err inner_arr) (foldl (dlambda ((c er ds) p) (dlet (((c e d) (partial_eval_helper p false env env_stack c (+ 1 indent) false))) (array c (mif er er e) (concat ds (array d)))))
(array pectx nil (array)) (array pectx nil (array))
(.marked_array_values x))) (.marked_array_values x)))
) (array pectx err (mif err nil (marked_array true false inner_arr))))) ) (array pectx err (mif err nil (marked_array true false nil inner_arr)))))
((= 0 (len (.marked_array_values x))) (array pectx "Partial eval on empty array" nil)) ((= 0 (len (.marked_array_values x))) (array pectx "Partial eval on empty array" nil))
(true (dlet ((values (.marked_array_values x)) (true (dlet ((values (.marked_array_values x))
(_ (print_strip (indent_str indent) "partial_evaling comb " (idx values 0))) (_ (print_strip (indent_str indent) "partial_evaling comb " (idx values 0)))
@@ -600,12 +609,12 @@
(literal_params (slice values 1 -1)) (literal_params (slice values 1 -1))
((pectx err comb) (partial_eval_helper (idx values 0) true env env_stack pectx (+ 1 indent) false)) ((pectx err comb) (partial_eval_helper (idx values 0) true env env_stack pectx (+ 1 indent) false))
) (cond ((!= nil err) (array pectx err nil)) ) (cond ((!= nil err) (array pectx err nil))
((later_head? comb) (array pectx nil (marked_array false true (cons comb literal_params)))) ((later_head? comb) (array pectx nil (marked_array false true nil (cons comb literal_params))))
((not (or (comb? comb) (prim_comb? comb))) (array pectx (str "impossible comb value " x) nil)) ((not (or (comb? comb) (prim_comb? comb))) (array pectx (str "impossible comb value " x) nil))
(true (dlet ( (true (dlet (
; If we haven't evaluated the function before at all, we would like to partially evaluate it so we know ; If we haven't evaluated the function before at all, we would like to partially evaluate it so we know
; what it needs. We'll see if this re-introduces exponentail (I think this should limit it to twice?) ; what it needs. We'll see if this re-introduces exponentail (I think this should limit it to twice?)
((pectx comb_err comb) (if (and (= nil err) (= true (needed_for_progress comb))) ((pectx comb_err comb) (if (and (= nil err) (= true (needed_for_progress_slim comb)))
(partial_eval_helper comb false env env_stack pectx (+ 1 indent) false) (partial_eval_helper comb false env env_stack pectx (+ 1 indent) false)
(array pectx err comb))) (array pectx err comb)))
(_ (println (indent_str indent) "Going to do an array call!")) (_ (println (indent_str indent) "Going to do an array call!"))
@@ -635,7 +644,7 @@
wrap_level literal_params pectx))) wrap_level literal_params pectx)))
(_ (println (indent_str indent) "Done evaluating parameters")) (_ (println (indent_str indent) "Done evaluating parameters"))
(later_call_array (marked_array false true (cons (with_wrap_level comb remaining_wrap) evaled_params))) (later_call_array (marked_array false true nil (cons (with_wrap_level comb remaining_wrap) evaled_params)))
(ok_and_non_later (and (= 0 remaining_wrap) (if (and (prim_comb? comb) (.prim_comb_val_head_ok comb)) (ok_and_non_later (and (= 0 remaining_wrap) (if (and (prim_comb? comb) (.prim_comb_val_head_ok comb))
(is_all_head_values evaled_params) (is_all_head_values evaled_params)
(is_all_values evaled_params)))) (is_all_values evaled_params))))
@@ -653,13 +662,13 @@
(final_params (mif variadic (concat (slice evaled_params 0 (- (len params) 1)) (final_params (mif variadic (concat (slice evaled_params 0 (- (len params) 1))
(array (marked_array true false (slice evaled_params (- (len params) 1) -1)))) (array (marked_array true false nil (slice evaled_params (- (len params) 1) -1))))
evaled_params)) evaled_params))
((de_progress_idxs de_entry) (mif (!= nil de?) ((de_progress_idxs de_entry) (mif (!= nil de?)
(array (needed_for_progress env) (array (array de? env))) (array (needed_for_progress_slim env) (array (array de? env)))
(array nil (array)))) (array nil (array))))
; Don't need to check params, they're all values! ; Don't need to check params, they're all values!
(inner_env_progress_idxs (concat de_progress_idxs (needed_for_progress se))) (inner_env_progress_idxs (concat de_progress_idxs (needed_for_progress_slim se)))
(inner_env (marked_env true inner_env_progress_idxs env_id (concat (zip params final_params) de_entry (array se)))) (inner_env (marked_env true inner_env_progress_idxs env_id (concat (zip params final_params) de_entry (array se))))
(_ (print_strip (indent_str indent) " with inner_env is " inner_env)) (_ (print_strip (indent_str indent) " with inner_env is " inner_env))
(_ (print_strip (indent_str indent) "going to eval " body)) (_ (print_strip (indent_str indent) "going to eval " body))
@@ -668,7 +677,7 @@
(hash (combine_hash (.hash body) (.hash inner_env))) (hash (combine_hash (.hash body) (.hash inner_env)))
((env_counter memo) pectx) ((env_counter memo) pectx)
((pectx func_err func_result rec_stop) (if (!= false (get-value-or-false memo hash)) ((pectx func_err func_result rec_stop) (if (!= false (get-value-or-false memo hash))
(array pectx nil "stopping for rec" true) (array pectx nil "stopping for infinite recursion" true)
(dlet ( (dlet (
(new_memo (put memo hash nil)) (new_memo (put memo hash nil))
(pectx (array env_counter new_memo)) (pectx (array env_counter new_memo))
@@ -682,7 +691,7 @@
(_ (print_strip (indent_str indent) "evaled result of function call (in env " (.marked_env_idx env) ", with inner " env_id ") and err " func_err " is " func_result)) (_ (print_strip (indent_str indent) "evaled result of function call (in env " (.marked_env_idx env) ", with inner " env_id ") and err " func_err " is " func_result))
) (if (!= nil func_err) (array pectx func_err nil) ) (if (!= nil func_err) (array pectx func_err nil)
(if (or rec_stop (not (combiner_return_ok func_result env_id))) (if (or rec_stop (not (combiner_return_ok func_result env_id)))
(array pectx nil (marked_array false true (cons (with_wrap_level comb remaining_wrap) evaled_params))) (array pectx nil (marked_array false true (if rec_stop (array hash) nil) (cons (with_wrap_level comb remaining_wrap) evaled_params)))
(drop_redundent_veval partial_eval_helper func_result env env_stack pectx indent))))) (drop_redundent_veval partial_eval_helper func_result env env_stack pectx indent)))))
))) )))
))))) )))))
@@ -751,8 +760,8 @@
) 'unwrap 1 true)) ) 'unwrap 1 true))
(array 'eval (marked_prim_comb (rec-lambda recurse (only_head de env_stack pectx evaled_params indent) (array 'eval (marked_prim_comb (rec-lambda recurse (only_head de env_stack pectx evaled_params indent)
(if (not (total_value? (idx evaled_params 0))) (array pectx nil (marked_array false true (cons (marked_prim_comb recurse 'eval 0 true) evaled_params))) (if (not (total_value? (idx evaled_params 0))) (array pectx nil (marked_array false true nil (cons (marked_prim_comb recurse 'eval 0 true) evaled_params)))
(if (and (= 2 (len evaled_params)) (not (marked_env? (idx evaled_params 1)))) (array pectx nil (marked_array false true (cons (marked_prim_comb recurse 'eval 0 true) evaled_params))) (if (and (= 2 (len evaled_params)) (not (marked_env? (idx evaled_params 1)))) (array pectx nil (marked_array false true nil (cons (marked_prim_comb recurse 'eval 0 true) evaled_params)))
(dlet ( (dlet (
(body (idx evaled_params 0)) (body (idx evaled_params 0))
(implicit_env (!= 2 (len evaled_params))) (implicit_env (!= 2 (len evaled_params)))
@@ -774,7 +783,7 @@
; If our env was implicit, then our unval'd code can be inlined directly in our caller ; If our env was implicit, then our unval'd code can be inlined directly in our caller
(implicit_env (drop_redundent_veval partial_eval_helper ebody de env_stack pectx indent)) (implicit_env (drop_redundent_veval partial_eval_helper ebody de env_stack pectx indent))
((combiner_return_ok ebody (.marked_env_idx eval_env)) (drop_redundent_veval partial_eval_helper ebody de env_stack pectx indent)) ((combiner_return_ok ebody (.marked_env_idx eval_env)) (drop_redundent_veval partial_eval_helper ebody de env_stack pectx indent))
(true (drop_redundent_veval partial_eval_helper (marked_array false true (array (marked_prim_comb recurse 'veval -1 true) ebody eval_env)) de env_stack pectx indent)) (true (drop_redundent_veval partial_eval_helper (marked_array false true nil (array (marked_prim_comb recurse 'veval -1 true) ebody eval_env)) de env_stack pectx indent))
)))) ))))
) (veval_inner only_head de env_stack pectx (if implicit_env (array unval_body) (array unval_body eval_env)) indent)))) ) (veval_inner only_head de env_stack pectx (if implicit_env (array unval_body) (array unval_body eval_env)) indent))))
@@ -794,7 +803,7 @@
(dlet (((pectx err pred) (if (and (= i 0) first_evaled_already) (array pectx nil (idx params 0)) (dlet (((pectx err pred) (if (and (= i 0) first_evaled_already) (array pectx nil (idx params 0))
(eval_helper (idx params i) pectx)))) (eval_helper (idx params i) pectx))))
(cond ((!= nil err) (array pectx err nil)) (cond ((!= nil err) (array pectx err nil))
((later_head? pred) (array pectx nil (marked_array false true (concat (array (marked_prim_comb (recurse true) 'vcond 0 true) ((later_head? pred) (array pectx nil (marked_array false true nil (concat (array (marked_prim_comb (recurse true) 'vcond 0 true)
pred) pred)
(slice params (+ i 1) -1))))) (slice params (+ i 1) -1)))))
((and (< (+ 2 i) (len params)) (false? pred)) (recurse_inner (+ 2 i) so_far pectx)) ((and (< (+ 2 i) (len params)) (false? pred)) (recurse_inner (+ 2 i) so_far pectx))
@@ -835,7 +844,7 @@
; Look into eventually allowing some non values, perhaps, when we look at combiner non all value params ; Look into eventually allowing some non values, perhaps, when we look at combiner non all value params
(array 'array (marked_prim_comb (lambda (only_head de env_stack pectx evaled_params indent) (array 'array (marked_prim_comb (lambda (only_head de env_stack pectx evaled_params indent)
(array pectx nil (marked_array true false evaled_params)) (array pectx nil (marked_array true false nil evaled_params))
) 'array 1 false)) ) 'array 1 false))
(array 'len (marked_prim_comb (dlambda (only_head de env_stack pectx (evaled_param) indent) (array 'len (marked_prim_comb (dlambda (only_head de env_stack pectx (evaled_param) indent)
(cond (cond
@@ -852,13 +861,13 @@
(array 'slice (marked_prim_comb (dlambda (only_head de env_stack pectx (evaled_array evaled_begin evaled_end) indent) (array 'slice (marked_prim_comb (dlambda (only_head de env_stack pectx (evaled_array evaled_begin evaled_end) indent)
(cond (cond
((and (val? evaled_begin) (val? evaled_end) (marked_array? evaled_array)) ((and (val? evaled_begin) (val? evaled_end) (marked_array? evaled_array))
(array pectx nil (marked_array true false (slice (.marked_array_values evaled_array) (.val evaled_begin) (.val evaled_end))))) (array pectx nil (marked_array true false nil (slice (.marked_array_values evaled_array) (.val evaled_begin) (.val evaled_end)))))
(true (array pectx "bad params to slice" nil)) (true (array pectx "bad params to slice" nil))
) )
) 'slice 1 true)) ) 'slice 1 true))
(array 'concat (marked_prim_comb (lambda (only_head de env_stack pectx evaled_params indent) (array 'concat (marked_prim_comb (lambda (only_head de env_stack pectx evaled_params indent)
(cond (cond
((foldl (lambda (a x) (and a (marked_array? x))) true evaled_params) (array pectx nil (marked_array true false (lapply concat (map (lambda (x) ((foldl (lambda (a x) (and a (marked_array? x))) true evaled_params) (array pectx nil (marked_array true false nil (lapply concat (map (lambda (x)
(.marked_array_values x)) (.marked_array_values x))
evaled_params))))) evaled_params)))))
(true (array pectx "bad params to concat" nil)) (true (array pectx "bad params to concat" nil))
@@ -3440,7 +3449,7 @@
((inner_env setup_code ctx) (cond ((inner_env setup_code ctx) (cond
((= 0 (len params)) (array se (array) ctx)) ((= 0 (len params)) (array se (array) ctx))
((and (= 1 (len params)) variadic) (dlet ( ((and (= 1 (len params)) variadic) (dlet (
((params_vec _ _ _) (compile-inner ctx (marked_array true false (array (marked_symbol nil (idx params 0)))) true)) ((params_vec _ _ _) (compile-inner ctx (marked_array true false nil (array (marked_symbol nil (idx params 0)))) true))
;(make_tmp_inner_env (array (idx params 0)) de? se env_id) ;(make_tmp_inner_env (array (idx params 0)) de? se env_id)
) (array (make_tmp_inner_env (array (idx params 0)) nil se env_id) ) (array (make_tmp_inner_env (array (idx params 0)) nil se env_id)
(local.set '$s_env (call '$env_alloc (i64.const params_vec) (local.set '$s_env (call '$env_alloc (i64.const params_vec)
@@ -3449,7 +3458,7 @@
ctx ctx
))) )))
(true (dlet ( (true (dlet (
((params_vec _ _ ctx) (compile-inner ctx (marked_array true false (map (lambda (k) (marked_symbol nil k)) params)) true)) ((params_vec _ _ ctx) (compile-inner ctx (marked_array true false nil (map (lambda (k) (marked_symbol nil k)) params)) true))
(params_code (if variadic (concat (params_code (if variadic (concat
(local.set '$param_ptr (i32.wrap_i64 (i64.and (i64.const -8) (local.get '$params)))) (local.set '$param_ptr (i32.wrap_i64 (i64.and (i64.const -8) (local.get '$params))))
(local.set '$tmp_ptr (call '$malloc (i32.const (* 8 (len params))))) (local.set '$tmp_ptr (call '$malloc (i32.const (* 8 (len params)))))
@@ -3466,7 +3475,7 @@
)) ))
((inner_env setup_code ctx) (if (= nil de?) (array inner_env (concat setup_code (call '$drop (local.get '$d_env))) ctx) ((inner_env setup_code ctx) (if (= nil de?) (array inner_env (concat setup_code (call '$drop (local.get '$d_env))) ctx)
(dlet ( (dlet (
((de_array_val _ _ ctx) (compile-inner ctx (marked_array true false (array (marked_symbol nil de?))) true)) ((de_array_val _ _ ctx) (compile-inner ctx (marked_array true false nil (array (marked_symbol nil de?))) true))
) (array (make_tmp_inner_env (array de?) nil inner_env env_id) ) (array (make_tmp_inner_env (array de?) nil inner_env env_id)
(concat setup_code (concat setup_code
(local.set '$s_env (call '$env_alloc (i64.const de_array_val) (local.set '$s_env (call '$env_alloc (i64.const de_array_val)