160 lines
6.6 KiB
Plaintext
160 lines
6.6 KiB
Plaintext
(with_import "./collections.kp"
|
|
(let (
|
|
; This partial eval only works via the root env,
|
|
; since we can't tell from outside if something takes an env
|
|
; or not
|
|
; Also, based on that, we have to switch on every primitive...
|
|
|
|
|
|
; Here is every form in k'
|
|
; True
|
|
; False
|
|
; Env: *KPEnv
|
|
; Combiner: KPCombiner / BuiltinCombiner: KPBuiltinCombiner
|
|
; String: str
|
|
; Symbol: str
|
|
; Int: int
|
|
; Array: rc<vec<KPValue>>
|
|
; Nil
|
|
|
|
|
|
; Ok, some more things we need / need to change
|
|
|
|
; Arrays need to be able to contain some combination of now and later that
|
|
; can be extracted correctly by the relevent operators (idx, slice)
|
|
|
|
; Vau needs to be handled, obv, which will require a handling of it
|
|
; pre-evaluating the parameters. The more I think about it, the more
|
|
; straight forward it seems actually - it can mostly mirror actual vau?
|
|
|
|
; how should empty-env be handled? More generally, how much do we reify enviornments?
|
|
|
|
; meta...
|
|
|
|
; I think now/later will have to be split into
|
|
; later/now_value/array/comb(wrap_level / dynamic_env_usage?)/env
|
|
; Env will need special checking for escaping, including when contained inside of an array or other combinator
|
|
; Actually, that extends to checking escaping for combinators in general, since they may close over laters
|
|
|
|
; Ok, instead of just ['now v] and ['later v], we have these marked values
|
|
; ['val v] (v can be an array)
|
|
; ['later c]
|
|
; ['marked_array a] (a contains marked values)
|
|
; ['comb wrap_level de? se params body <actual_function>]
|
|
; ['prim_comb <handler_function> <actual_function>]
|
|
; ['env [ ['symbol marked_value ]... ] <name_it_can_be_found_as(changes, must not escape)>]
|
|
|
|
|
|
val? (lambda (x) (= 'val (idx x 0)))
|
|
.val (lambda (x) (idx x 1))
|
|
later? (lambda (x) (= 'later (idx x 0)))
|
|
.later (lambda (x) (idx x 1))
|
|
marked_array? (lambda (x) (= 'marked_array (idx x 0)))
|
|
comb? (lambda (x) (= 'comb (idx x 0)))
|
|
.comb (lambda (x) (slice x 1 -1))
|
|
prim_comb? (lambda (x) (= 'prim_comb (idx x 0)))
|
|
.prim_comb (lambda (x) (idx x 1))
|
|
marked_env? (lambda (x) (= 'env (idx x 0)))
|
|
|
|
strip (rec-lambda recurse (x)
|
|
(cond (val? x) (.val x)
|
|
(later? x) (.later x)
|
|
(marked_array? x) (map recurse (idx x 1))
|
|
(comb? x) (idx x 6)
|
|
(prim_comb? x) (idx x 2)
|
|
(makred_env? x) (error "Env escaped to strip!")
|
|
)
|
|
)
|
|
|
|
; partial_eval_helper always takes in unmarked expressions and makes marked ones, maintaining marked envs
|
|
partial_eval_helper (rec-lambda recurse (x env)
|
|
(cond (= x true) ['val true ]
|
|
(= x false) ['val false]
|
|
(env? x) (error "called partial_eval with an env " x)
|
|
(combiner? x) (error "called partial_eval with a combiner, not yet supported (assuming just parsed symbols etc) " x)
|
|
(string? x) ['val x]
|
|
(symbol? x) (get-value env x)
|
|
(int? x) ['val x]
|
|
(and (array? x) (= 0 (len x))) (error "Partial eval on empty array")
|
|
(array? x) (let ( comb (recurse (idx x 0) env) )
|
|
(cond (later? comb) ['later x]
|
|
(prim_comb? comb) ((.prim_comb comb) env (slice x 1 -1))
|
|
(comb? comb) (let (
|
|
[wrap_level de? se params body actual_function] (.comb comb)
|
|
;subs (map (lambda (y) (recurse y env)) x)
|
|
) ['later x])
|
|
true (error (str "Partial eval noticed that you will likely call not a function " x))))
|
|
(nil? x) ['val x]
|
|
|
|
)
|
|
)
|
|
needs_params_val_lambda (vau de (f_sym) (let (
|
|
actual_function (eval f_sym de)
|
|
handler (lambda (de params) (let (evaled_params (map (lambda (x) (partial_eval_helper x de)) params))
|
|
(if (foldl (lambda (a x) (and a (val? x))) true evaled_params) ['val (lapply actual_function (map .val evaled_params))]
|
|
['later (cons actual_function params)])))
|
|
) [f_sym ['prim_comb handler actual_function]]))
|
|
give_up (vau de (f_sym) (let (
|
|
actual_function (eval f_sym de)
|
|
handler (lambda (de params) ['later (cons actual_function params)])
|
|
) [f_sym ['prim_comb handler actual_function]]))
|
|
|
|
partial_eval (lambda (x) (partial_eval_helper x [
|
|
(give_up vau)
|
|
(give_up eval)
|
|
(give_up cond)
|
|
(needs_params_val_lambda symbol?)
|
|
(needs_params_val_lambda int?)
|
|
(needs_params_val_lambda string?)
|
|
(give_up combiner?)
|
|
(give_up env?)
|
|
(needs_params_val_lambda nil?)
|
|
(needs_params_val_lambda bool?)
|
|
(give_up array?)
|
|
(needs_params_val_lambda str-to-symbol)
|
|
(needs_params_val_lambda get-text)
|
|
(give_up array)
|
|
(give_up len)
|
|
(give_up idx)
|
|
(give_up slice)
|
|
(give_up concat)
|
|
(needs_params_val_lambda +)
|
|
(needs_params_val_lambda -)
|
|
(needs_params_val_lambda *)
|
|
(needs_params_val_lambda /)
|
|
(needs_params_val_lambda %)
|
|
(needs_params_val_lambda &)
|
|
(needs_params_val_lambda |)
|
|
(needs_params_val_lambda <<)
|
|
(needs_params_val_lambda >>)
|
|
(needs_params_val_lambda =)
|
|
(needs_params_val_lambda !=)
|
|
(needs_params_val_lambda <)
|
|
(needs_params_val_lambda <=)
|
|
(needs_params_val_lambda >)
|
|
(needs_params_val_lambda >=)
|
|
|
|
; Don't forget, these short-circut with the truthy/falsey values
|
|
(give_up and)
|
|
(give_up or)
|
|
|
|
; pr-str
|
|
(needs_params_val_lambda str)
|
|
(needs_params_val_lambda prn)
|
|
(give_up println)
|
|
(give_up meta)
|
|
(give_up with-meta)
|
|
(give_up wrap)
|
|
(give_up unwrap)
|
|
(give_up error)
|
|
(give_up recover)
|
|
(give_up read-string)
|
|
(give_up slurp)
|
|
(give_up get_line)
|
|
(give_up write_file)
|
|
(give_up empty_env)
|
|
]))
|
|
)
|
|
(provide partial_eval strip)
|
|
))
|