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

Fixed up!

Browse Source
This commit is contained in:
Nathan Braswell
2021-10-19 02:45:56 -04:00
parent e0c4366771
commit c0a07b54ce
1 changed files with 12 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
partial_eval.kp
View File

@@ -103,9 +103,9 @@
) (idx args -1))]))) ) (idx args -1))])))
print_strip (lambda (& args) (println (lapply str_strip args))) print_strip (lambda (& args) (println (lapply str_strip args)))
strip (let (helper (rec-lambda recurse (x need_value de_sym) strip (let (helper (rec-lambda recurse (x need_value)
(cond (val? x) (.val x) (cond (val? x) (.val x)
(marked_array? x) (let (stripped_values (map (lambda (x) (recurse x need_value de_sym)) (.marked_array_values x))) (marked_array? x) (let (stripped_values (map (lambda (x) (recurse x need_value)) (.marked_array_values x)))
(if (.marked_array_is_val x) (if need_value (error (str "needed value for this strip but got" x)) (cons array stripped_values)) (if (.marked_array_is_val x) (if need_value (error (str "needed value for this strip but got" x)) (cons array stripped_values))
stripped_values)) stripped_values))
(marked_symbol? x) (if (.marked_symbol_is_val x) (if need_value (error (str "needed value for this strip but got" x)) [quote (.marked_symbol_value x)]) (marked_symbol? x) (if (.marked_symbol_is_val x) (if need_value (error (str "needed value for this strip but got" x)) [quote (.marked_symbol_value x)])
@@ -115,24 +115,24 @@
final_params (if variadic (concat (slice params 0 -2) '& [(idx params -1)]) params) final_params (if variadic (concat (slice params 0 -2) '& [(idx params -1)]) params)
; Honestly, could trim down the env to match what could be evaluated in the comb ; Honestly, could trim down the env to match what could be evaluated in the comb
; Also if this isn't real, lower to a call to vau ; Also if this isn't real, lower to a call to vau
se_env (if (marked_env_real? se) (recurse se true de_sym) nil) se_env (if (marked_env_real? se) (recurse se true) nil)
body_v (recurse body false de?) body_v (recurse body false)
ve (concat [vau] de_entry [final_params] [body_v]) ve (concat [vau] de_entry [final_params] [body_v])
fe ((rec-lambda recurse (x i) (if (= i 0) x (recurse [wrap x] (- i 1)))) ve wrap_level) fe ((rec-lambda recurse (x i) (if (= i 0) x (recurse [wrap x] (- i 1)))) ve wrap_level)
) (if se_env (eval fe se_env) fe)) ) (if se_env (eval fe se_env) fe))
(prim_comb? x) (idx x 2) (prim_comb? x) (idx x 2)
; env emitting doesn't pay attention to real value right now, not sure if that makes sense ; env emitting doesn't pay attention to real value right now, not sure if that makes sense
; TODO: properly handle de Bruijn indexed envs ; TODO: properly handle de Bruijn indexed envs
(marked_env? x) (cond (and de_sym (= 0 (.marked_env_idx x))) de_sym (marked_env? x) (cond (and (not need_value) (= 0 (.marked_env_idx x))) [current-env]
true (let (_ (if (not (marked_env_real? x)) (error (str_strip "trying to emit fake env! " de_sym " " (.marked_env_idx x) " " x))) true (let (_ (if (not (marked_env_real? x)) (error (str_strip "trying to emit fake env!" x)))
upper (idx (.env_marked x) -1) upper (idx (.env_marked x) -1)
upper_env (if upper (recurse upper true de_sym) empty_env) upper_env (if upper (recurse upper true) empty_env)
just_entries (slice (.env_marked x) 0 -2) just_entries (slice (.env_marked x) 0 -2)
vdict (map (lambda ([k v]) [k (recurse v true de_sym)]) just_entries) vdict (map (lambda ([k v]) [k (recurse v true)]) just_entries)
) (add-dict-to-env upper_env vdict))) ) (add-dict-to-env upper_env vdict)))
true (error (str "some other strip? " x)) true (error (str "some other strip? " x))
) )
)) (lambda (x) (let (_ (print_strip "stripping: " x) r (helper x false nil) _ (println "result of strip " r)) r))) )) (lambda (x) (let (_ (print_strip "stripping: " x) r (helper x false) _ (println "result of strip " r)) r)))
; A bit wild, but what if instead of is_value we had an evaluation level integer, kinda like wrap? ; A bit wild, but what if instead of is_value we had an evaluation level integer, kinda like wrap?
; when lowering, it could just turn into multiple evals or somesuch, though we'd have to be careful of envs... ; when lowering, it could just turn into multiple evals or somesuch, though we'd have to be careful of envs...