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

contains_symbols is/was exhibiting exponential behavior - probs memoizing or using needed_for_eval could fix it, but also it doesn't normally have to be called, so just doing that got us a 50x speedup or so

Browse Source
This commit is contained in:
Nathan Braswell
2022-01-26 23:43:50 -05:00
parent c8df8742d1
commit 2746e1ca75
2 changed files with 23 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
partial_eval.csc
View File

@@ -88,6 +88,7 @@
(#t (begin (cons x (loop (read-char input-port)))))))))))
(let* (
(lapply apply)
(= equal?)
(!= (lambda (a b) (not (= a b))))
(array list)
@@ -414,10 +415,6 @@
(true x)
)
))
; This is a conservative analysis, since we can't always tell what constructs introduce
; a new binding scope & would be shadowing... we should at least be able to implement it for
; vau/lambda, but we won't at first
; TODO: make this check for stop envs using de Bruijn indicies
(contains_symbols (rec-lambda recurse (stop_envs symbols x) (cond
((val? x) false)
((marked_symbol? x) (let* ((r (in_array (.marked_symbol_value x) symbols))
@@ -476,7 +473,7 @@
(get_pe_passthrough (dlambda (hash (env_counter memo) x) (let ((r (get-value-or-false memo hash)))
(cond ((= r false) false)
((= r nil) (array (array env_counter memo) nil x)) ; Nil is for preventing infinite recursion
(true false)
(true false)
; This is causing bad compiles!
; Temporarily disabled. Somehow is re-introducing fake envs that aren't in scope or somesuch
;(true (array (array env_counter memo) nil r))
@@ -612,18 +609,21 @@
((pectx func_err func_result) (partial_eval_helper body only_head inner_env (cons inner_env env_stack) pectx (+ 1 indent)))
) (mif func_err (array pectx func_err nil) (dlet (
(_ (print_strip (indent_str indent) "evaled result of function call is " func_result))
(able_to_sub_env (not (check_for_env_id_in_result env_id func_result)))
(result_is_later (later_head? func_result))
(_ (print (indent_str indent) "success? " able_to_sub_env))
(stop_envs ((rec-lambda ser (a e) (mif e (ser (cons (.marked_env_idx e) a) (idx (.env_marked e) -1)) a)) (array) se))
(result_closes_over (contains_symbols stop_envs (concat params (mif de? (array de?) (array))) func_result))
(_ (println (indent_str indent) "func call able_to_sub: " able_to_sub_env " (based on env_id " env_id ") result is later_head? " result_is_later " and result_closes_over " result_closes_over))
;(failed (or (not able_to_sub_env) (and result_is_later result_closes_over)))
((failed reason) (cond ((check_for_env_id_in_result env_id func_result) (array true "has env id in result"))
((not (later_head? func_result)) (array false ""))
(true (array (dlet ((stop_envs ((rec-lambda ser (a e) (mif e (ser (cons (.marked_env_idx e) a) (idx (.env_marked e) -1)) a)) (array) se)))
(contains_symbols stop_envs (concat params (mif de? (array de?) (array))) func_result)) "both later and contains symbols"))
))
(_ (println (indent_str indent) (if failed (str "failed because ")
"function succeded!")))
; This could be improved to a specialized version of the function
; just by re-wrapping it in a comb instead mif we wanted.
; Something to think about!
(result (mif (or (not able_to_sub_env) (and result_is_later result_closes_over))
(marked_array false true (cons comb correct_fail_params))
func_result))
(result (mif failed (marked_array false true (cons comb correct_fail_params))
func_result))
((env_counter memo) pectx)
(memo (put memo this_hash result))
(pectx (array env_counter memo))
@@ -3180,20 +3180,21 @@
;(_ (print_strip "doing further partial eval for " c))
(_ (true_print "doing further partial eval for "))
(_ (true_print "\t" (true_str_strip c)))
;(_ (true_print "doing further partial eval for "))
;(_ (true_print "\t" (true_str_strip c)))
; This can weirdly cause infinate recursion on the compile side, if partial_eval
; returns something that, when compiled, will cause partial eval to return that thing again.
; Partial eval won't recurse infinately, since it has memo, but it can return something of that
; shape in that case which will cause compile to keep stepping.
((datasi funcs memo env pectx) ctx)
((pectx err evaled_params) (if (= 'RECURSE_FAIL (get-value-or-false memo (.hash c))) (begin (true_print "got a recurse, stoping") (array pectx "RECURSE FAIL" nil))
((pectx err evaled_params) (if (= 'RECURSE_FAIL (get-value-or-false memo (.hash c))) (begin ;(true_print "got a recurse, stoping")
(array pectx "RECURSE FAIL" nil))
(foldl (dlambda ((c er ds) p) (dlet (((c e d) (partial_eval_helper p false env (array) c 1)))
(array c (mif er er e) (concat ds (array d)))))
(array pectx nil (array))
(slice func_param_values 1 -1))))
(_ (true_print "DONE further partial eval for "))
(_ (true_print "\t" (true_str_strip c)))
;(_ (true_print "DONE further partial eval for "))
;(_ (true_print "\t" (true_str_strip c)))
; TODO: This might fail because we don't have the real env stack, which we *should*!
; In the mean time, if it does, just fall back to the non-more-evaled ones.
(to_code_params (mif err (slice func_param_values 1 -1) evaled_params))

4
to_compile.kp
View File

@@ -20,10 +20,12 @@
(let1 let (vY (lambda (recurse) (vau de (vs b) (cond (= (len vs) 0) (eval b de)
true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de)))))
(let (a 1337)
(array 'open 3 "test_self_out" (lambda (fd code)
(array 'write fd "wabcdefghijk" (lambda (written code)
(array 'exit written)))))
(array 'exit (+ a written))))))
)
;(array 'write 1 "test_self_out2" (vau (written code) 1))