diff --git a/k_prime.krak b/k_prime.krak index fd3ac3d..d063188 100644 --- a/k_prime.krak +++ b/k_prime.krak @@ -880,7 +880,7 @@ fun main(argc: int, argv: **char): int { return make_pair(dynamic_env, KPResult::Ok(params[0])) } else if params.size == 2 { if !params[1].is_env() { - return make_pair(null(), KPResult::Err(kpString(str("second param to eval is not an environment")))) + return make_pair(null(), KPResult::Err(kpString(str("second param to eval is not an environment") + pr_str(params[1], true)))) } return make_pair(params[1].get_env(), KPResult::Ok(params[0])) } diff --git a/partial_eval.kp b/partial_eval.kp index 934bb7c..3dce578 100644 --- a/partial_eval.kp +++ b/partial_eval.kp @@ -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