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

Bug fixed and back to state before refactor/rewrite. Need to get that darn let5 working now! That's why we did this

Browse Source
This commit is contained in:
Nathan Braswell
2021-09-06 23:00:04 -04:00
parent 873e7c4244
commit 12271ff27c
2 changed files with 22 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
partial_eval.kp
View File

@@ -53,6 +53,10 @@
.marked_symbol_value (lambda (x) (idx x 2))
later? (lambda (x) (or (and (marked_array? x) (= false (.marked_array_is_val x)))
(and (marked_symbol? x) (= false (.marked_symbol_is_val x)))))
false? (lambda (x) (cond (and (marked_array? x) (= false (.marked_array_is_val x))) (error (str "got a later marked_array passed to false? " x))
(and (marked_symbol? x) (= false (.marked_symbol_is_val x))) (error (str "got a later marked_symbol passed to false? " x))
(val? x) (not (.val x))
true false))
comb? (lambda (x) (= 'comb (idx x 0)))
.comb (lambda (x) (slice x 1 -1))
prim_comb? (lambda (x) (= 'prim_comb (idx x 0)))
@@ -110,6 +114,12 @@
[true []]
x))
ensure_val (rec-lambda recurse (x) (let (_ (println "ensure_valing " x) r
(cond (marked_array? x) ['marked_array true (map recurse (.marked_array_values x))]
(marked_symbol? x) ['marked_symbol true (.marked_symbol_value x)]
true x
) _ (println "\tresult was " r)) r)
)
; 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
@@ -118,16 +128,13 @@
(val? x) false
(marked_symbol? x) (env-lookup-helper (concat (slice (idx env 1) 0 -2) [nil]) (.marked_symbol_value x) 0 (lambda () false) (lambda (x) [x]))
(marked_array? x) (foldl (lambda (a x) (or a (recurse env x))) false (.marked_array_values x))
(comb? x) (let (
[wrap_level de? se variadic params body actual_function] (.comb x)
; This is where we'd be smart and remove shadowed stuff
; Also this won't work yet because env
(error (str "haven't handled comb yet really either for closes_over_var_from_this_env_marked " x))
) (or (recurse env se) (recurse env body)))
(comb? x) true ;(let ( [wrap_level de? se variadic params body actual_function] (.comb x)) (or (recurse env se) (recurse env body)))
(prim_comb? x) false
; Should check to see if the env has anything form env in it, somehow? See if it has this env itself in it?
(marked_env? x) (error "haven't handled env in closes_over_var_from_this_env_marked!")
(marked_env? x) true ;(error "haven't handled env in closes_over_var_from_this_env_marked!")
true (error (str "Something odd passed to closes_over_var_from_this_env_marked " x))
))
@@ -170,7 +177,7 @@
(let (evaled_params (map rp_eval unval_params))
(param-recurse (- wrap 1) evaled_params))))
[true params])
) wrap_level literal_params)
) wrap_level (map ensure_val literal_params))
) (if (not ok) ['marked_array false (cons comb literal_params)]
(let (
final_params (if variadic (concat (slice appropriatly_evaled_params 0 (- (len params) 1))
@@ -238,7 +245,7 @@
[(concat ac [p]) (+ i 1)]))
[[] 0]
params)
) (inner_f (lambda (& args) (lapply (recurse passthrough_ie inner_f) args)) de evaled_params imm_eval indent))))
) (inner_f (lambda (& args) (lapply (recurse pasthr_ie inner_f) args)) de evaled_params imm_eval indent))))
root_marked_env ['env [
; Ok, so for combinators, it should partial eval the body.
@@ -252,11 +259,11 @@
de? (if mde? (.marked_symbol_value mde?))
vau_de? (if (= nil de?) [] [de?])
raw_marked_params (if (= nil de?) (idx params 0) (idx params 1))
raw_params (map strip (.marked_array_values raw_marked_params))
raw_params (map (lambda (x) (if (not (marked_symbol? x)) (error (str "not a marked symbol " x))
(.marked_symbol_value x))) (.marked_array_values raw_marked_params))
[variadic vau_params] (foldl (lambda ([v a] x) (if (= x '&) [true a] [v (concat a [x])])) [false []] raw_params)
body (if (= nil de?) (idx params 1) (idx params 2))
inner_env ['env (concat (map (lambda (p) [p ['marked_symbol false p]]) vau_params) (if (= nil de?) [] [ [de? ['marked_symbol false de?]] ]) [de]) nil]
_ (map (lambda (x) (if (not (symbol? x)) (error (str "bad vau param not symbol " x " in " vau_params)))) vau_params)
_ (println (indent_str indent) "in vau, evaluating body with 'later params - " body)
pe_body (partial_eval_helper body inner_env false (+ 1 indent))
_ (println (indent_str indent) "in vau, result of evaluating body was " pe_body " stripping")
@@ -267,6 +274,7 @@
(let (real_func (eval (concat [vau] vau_de? [raw_params (strip pe_body)]) (.env_real de))
marked_func ['comb 0 de? de variadic vau_params pe_body real_func]
_ (println (indent_str indent) "Marked func is " marked_func)
_ (println (indent_str indent) "Raw func was made with body " (strip pe_body))
) marked_func)))
) vau]]
@@ -292,16 +300,16 @@
) (if (not (marked_env? eval_env)) ['marked_array false (cons self params)]
(let (
_ (println (indent_str indent) "ok, env was " eval_env)
body (partial_eval_helper (idx params 0) de imm_eval (+ 1 indent))
_ (println (indent_str indent) "after first eval of param " body)
body1 (partial_eval_helper (idx params 0) de imm_eval (+ 1 indent))
_ (println (indent_str indent) "after first eval of param " body1)
[ok unval_body] (try_unval body1))
[ok unval_body] (try_unval body1)
body2 (if ok (partial_eval_helper unval_body eval_env imm_eval (+ 1 indent))
['marked_array false (cons self (if (= 2 (len params)) [body1 eval_env]
[body1]))])
_ (println (indent_str indent) "and body2 is " body2)
) body2)
) body2))
)) eval]]
;TODO: This could go a lot farther, not stopping after the first 'later, etc