diff --git a/partial_eval.csc b/partial_eval.csc index bc0241d..43e588c 100644 --- a/partial_eval.csc +++ b/partial_eval.csc @@ -3095,7 +3095,7 @@ (if (= 0 actual_len) (array nil_val nil nil ctx) (dlet (((comp_values err ctx) (foldr (dlambda (x (a err ctx)) (dlet (((v c e ctx) (compile-inner ctx x))) (array (cons v a) (or (mif err err false) (mif e e false) (mif c (str "got code " c) false)) ctx))) (array (array) nil ctx) (.marked_array_values c))) - ) (mif err (array nil nil err ctx) (dlet ( + ) (mif err (array nil nil (str err ", from an array value compile " (str_strip c)) ctx) (dlet ( ((datasi funcs memo env env_counter) ctx) ;(_ (print_strip "made from " c)) ;(_ (print "pre le_hexify " comp_values)) @@ -3140,7 +3140,7 @@ ;; Insert test for the function being a constant to inline ;; Namely, cond ) (cond - ((or (!= nil err) (!= nil func_err)) (array nil nil (mif err err func_err) ctx)) + ((or (!= nil err) (!= nil func_err)) (array nil nil (mif err (str err " from function params in call " (str_strip c)) (str func_err " from function itself in call " (str_strip c))) ctx)) ((and (prim_comb? func_value) (= (.prim_comb_sym func_value) 'cond)) (dlet ( ((datasi funcs memo env env_counter) ctx) @@ -3221,16 +3221,18 @@ ((kvs vvs ctx) (foldr (dlambda ((k v) (ka va ctx)) (dlet (((kv _ _ ctx) (compile-inner ctx (marked_symbol nil k))) ((vv code err ctx) (compile-inner ctx v)) - ;(_ (print_strip "result of v compile-inner vv " vv " code " code " err " err ", based on " v)) + (_ (print_strip "result of (kv is " kv ") v compile-inner vv " vv " code " code " err " err ", based on " v)) + (_ (if (= nil vv) (print_strip "VAL NIL CODE IN ENV B/C " k " = " v) nil)) + (_ (if (!= nil err) (print_strip "ERRR IN ENV B/C " err " " k " = " v) nil)) ) - (if (or (= false ka) (= nil vv) (!= nil err)) (array false false ctx) + (if (or (= false ka) (= nil vv) (!= nil err)) (array false k ctx) (array (cons kv ka) (cons vv va) ctx)))) (array (array) (array) ctx) (slice e 0 -2))) ((uv ucode err ctx) (mif (idx e -1) (compile-inner ctx (idx e -1)) (array nil_val nil nil ctx))) - ) (mif (or (= false kvs) (= nil uv) (!= nil err)) (begin (print_strip "kvs " kvs " uv " uv " or err " err " based off of " c) (generate_env_access ctx (.marked_env_idx c))) + ) (mif (or (= false kvs) (= nil uv) (!= nil err)) (begin (print_strip "kvs " kvs " vvs " vvs " uv " uv " or err " err " based off of " c) (generate_env_access ctx (.marked_env_idx c))) (dlet ( ((datasi funcs memo env env_counter) ctx) ((kvs_array datasi) (if (= 0 (len kvs)) (array nil_val datasi) @@ -3362,7 +3364,8 @@ ((datasi funcs memo env env_counter) ctx) ((inner_value inner_code err ctx) (compile-inner (array datasi funcs memo inner_env env_counter) body)) - ((datasi funcs memo env env_counter) ctx) + ; Don't overwrite env with what was our inner env! Env is returned as part of context to our caller! + ((datasi funcs memo _was_inner_env env_counter) ctx) ;(_ (print_strip "inner_value for maybe const is " inner_value " inner_code is " inner_code " err is " err " this was for " body)) (inner_code (mif inner_value (i64.const inner_value) inner_code)) (end_code (call '$drop (local.get '$s_env))) diff --git a/to_compile.kp b/to_compile.kp index 50585ec..0cd81ee 100644 --- a/to_compile.kp +++ b/to_compile.kp @@ -7,11 +7,13 @@ (let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se))) (let1 current-env (vau de () de) (let1 cons (lambda (h t) (concat (array h) t)) -(let1 lapply (lambda (f p) (eval (cons (unwrap f) p) (current-env))) -(let1 vapply (lambda (f p ede) (eval (cons f p) ede)) -(let1 Y (lambda (f) +(let1 lapply (lambda (f1 p) (eval (cons (unwrap f1) p) (current-env))) +(let1 vapply (lambda (f2 p ede) (eval (cons f2 p) ede)) + +(let1 Y (lambda (f3) ((lambda (x1) (x1 x1)) - (lambda (x2) (f (lambda (& y) (lapply (x2 x2) y)))))) + (lambda (x2) (f3 (lambda (& y) (lapply (x2 x2) y)))))) + ;(let1 vY (lambda (f) ; ((lambda (x3) (x3 x3)) ; (lambda (x4) (f (vau de (& y) (vapply (x4 x4) y de)))))) @@ -20,7 +22,7 @@ (array 'open 3 "test_self_out" (lambda (fd code) -(array 'write fd "wabcdefghi" (lambda (written code) +(array 'write fd "wabcdefghijk" (lambda (written code) (array 'exit written))))) ;(array 'write 1 "test_self_out2" (vau (written code) 1))