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

Finally excise what I belive to be the final exponential behavior, namely by adding memoization and better traversals to check_for_env_id_in_result

Browse Source
This commit is contained in:
Nathan Braswell
2022-02-06 16:34:47 -05:00
parent 76065d1957
commit 31a8002a11
1 changed files with 40 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
partial_eval.csc
View File

@@ -399,23 +399,48 @@
) )
)) ))
; TODO: memoize! (check_for_env_id_in_result (lambda (s_env_id x) (idx ((rec-lambda check_for_env_id_in_result (memo s_env_id x)
(check_for_env_id_in_result (rec-lambda check_for_env_id_in_result (s_env_id x) (cond (dlet (
((val? x) false) (hash (.hash x))
((marked_symbol? x) false) ;(result (if (or (comb? x) (marked_env? x)) (alist-ref hash memo) false))
((marked_array? x) (foldl (lambda (a x) (or a (check_for_env_id_in_result s_env_id x))) false (.marked_array_values x))) ;(result (if (or (marked_array? x) (marked_env? x)) (alist-ref hash memo) false))
((comb? x) (dlet (((wrap_level i_env_id de? se variadic params body) (.comb x))) (result (if (marked_env? x) (alist-ref hash memo) false))
(or (check_for_env_id_in_result s_env_id se) (and (!= s_env_id i_env_id) (check_for_env_id_in_result s_env_id body))))) ) (if (array? result) (array memo (idx result 0)) (cond
((val? x) (array memo false))
((marked_symbol? x) (array memo false))
((marked_array? x) (dlet (
(values (.marked_array_values x))
((memo result) ((rec-lambda recurse (memo i) (if (= (len values) i) (array memo false)
(dlet (((memo r) (check_for_env_id_in_result memo s_env_id (idx values i))))
(if r (array memo true)
(recurse memo (+ i 1))))))
memo 0))
;(memo (put memo hash result))
) (array memo result)))
((comb? x) (dlet (
((wrap_level i_env_id de? se variadic params body) (.comb x))
((memo in_se) (check_for_env_id_in_result memo s_env_id se))
((memo total) (if (and (not in_se) (!= s_env_id i_env_id)) (check_for_env_id_in_result memo s_env_id body)
(array memo in_se)))
;(memo (put memo hash total))
) (array memo total)))
((prim_comb? x) false) ((prim_comb? x) (array memo false))
((marked_env? x) (let ((inner (.env_marked x))) ((marked_env? x) (if (and (not (marked_env_real? x)) (= s_env_id (.marked_env_idx x))) (array memo true)
(cond ((and (not (marked_env_real? x)) (= s_env_id (.marked_env_idx x))) true) (dlet (
((foldl (lambda (a x) (or a (check_for_env_id_in_result s_env_id (idx x 1)))) (values (slice (.env_marked x) 0 -2))
false (slice inner 0 -2)) true) (upper (idx (.env_marked x) -1))
((!= nil (idx inner -1)) (check_for_env_id_in_result s_env_id (idx inner -1))) ((memo result) ((rec-lambda recurse (memo i) (if (= (len values) i) (array memo false)
(true false)))) (dlet (((memo r) (check_for_env_id_in_result memo s_env_id (idx (idx values i) 1))))
(if r (array memo true)
(recurse memo (+ i 1))))))
memo 0))
((memo result) (if (or result (= nil upper)) (array memo result)
(check_for_env_id_in_result memo s_env_id upper)))
(memo (put memo hash result))
) (array memo result))))
(true (error (str "Something odd passed to check_for_env_id_in_result " x))) (true (error (str "Something odd passed to check_for_env_id_in_result " x)))
))) )))) (array) s_env_id x) 1)))
(comb_takes_de? (lambda (x l) (cond (comb_takes_de? (lambda (x l) (cond
((comb? x) (dlet (((wrap_level env_id de? se variadic params body) (.comb x))) (!= nil de?))) ((comb? x) (dlet (((wrap_level env_id de? se variadic params body) (.comb x))) (!= nil de?)))