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

Ok, I think this is a correct? skeleton, implemented as much as I did yesterday

Browse Source
This commit is contained in:
Nathan Braswell
2021-08-10 22:56:12 -04:00
parent e1fa65deaf
commit 95b37da44e
3 changed files with 79 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files

114
partial_eval.kp
View File

@@ -36,71 +36,107 @@
; 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)>]
now? (lambda (x) (= 'now (idx x 0)))
val (lambda (x) (idx x 1))
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) ['now true ]
(= x false) ['now false]
(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) ['now x]
(string? x) ['val x]
(symbol? x) (get-value env x)
(int? x) ['now x]
(int? x) ['val x]
(and (array? x) (= 0 (len x))) (error "Partial eval on empty array")
(array? x) (let (
subs (map (lambda (y) (recurse y env)) x)
comb (idx subs 0)
) (if (now? comb) ((val comb) (slice subs 1 -1))
['later (map val subs)]))
(nil? x) ['now x]
(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_real (vau de (f_sym) ['now (lambda (params) (if (foldl (lambda (a x) (and a (now? x))) true params) ['now (lapply (eval f_sym de) (map val params))]
['later (cons f_sym (map val params))])) ])
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]]))
partial_eval (lambda (x) (partial_eval_helper x [
; vau
; eval
; cond
[ 'symbol? (needs_params_real symbol?) ]
[ 'int? (needs_params_real int?) ]
[ 'string? (needs_params_real string?) ]
(needs_params_val_lambda symbol?)
(needs_params_val_lambda int?)
(needs_params_val_lambda string?)
; combiner?
; env?
[ 'nil? (needs_params_real nil?) ]
[ 'bool? (needs_params_real bool?) ]
(needs_params_val_lambda nil?)
(needs_params_val_lambda bool?)
; array?
[ 'str-to-symbol (needs_params_real str-to-symbol) ]
[ 'get-text (needs_params_real get-text) ]
(needs_params_val_lambda str-to-symbol)
(needs_params_val_lambda get-text)
; array
; len
; idx
; slice
; concat
[ '+ (needs_params_real +) ]
[ '- (needs_params_real -) ]
[ '* (needs_params_real *) ]
[ '/ (needs_params_real /) ]
[ '% (needs_params_real %) ]
[ '& (needs_params_real &) ]
[ '| (needs_params_real |) ]
[ '<< (needs_params_real <<) ]
[ '>> (needs_params_real >>) ]
[ '= (needs_params_real =) ]
[ '!= (needs_params_real !=) ]
[ '< (needs_params_real <) ]
[ '<= (needs_params_real <=) ]
[ '> (needs_params_real >) ]
[ '>= (needs_params_real >=) ]
(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
; and
; or
; pr-str
[ 'str (needs_params_real str) ]
[ 'prn (needs_params_real prn) ]
(needs_params_val_lambda str)
(needs_params_val_lambda prn)
; println
; meta
; with-meta
@@ -115,5 +151,5 @@
; empty_env
]))
)
(provide partial_eval now? val)
(provide partial_eval strip)
))

4
partial_eval_test.kp
View File

@@ -4,7 +4,9 @@
_ (println "Code: " code)
partially_evaled (partial_eval code)
_ (println "Partially evaled: " partially_evaled)
fully_evaled (eval (val partially_evaled))
stripped (strip partially_evaled)
_ (println "Stripped: " stripped)
fully_evaled (eval stripped)
_ (println "Fully evaled: " fully_evaled)
_ (println)
) fully_evaled))

2
prelude.kp
View File

@@ -199,7 +199,7 @@
(array (quote number) (array "(0(x|X)([0-9]|[a-f]|[A-F])+)|(-?[0-9]+)") (lambda (x) (string-to-int x)))
(array (quote string) (array "\"([#-[]| |[]-~]|(\\\\\\\\)|(\\\\n)|(\\\\t)|(\\*)|(\\\\0)|
|[ -!]|(\\\\\"))*\"") (lambda (x) (unescape-str x)))
(array (quote bool_nil_symbol) (array "-|(([a-z]|[A-Z]|_|\\*|/|\\?|\\+|!|=|&|\\||<|>|%|$)([a-z]|[A-Z]|_|[0-9]|\\*|\\?|\\+|-|!|=|&|\\||<|>|%|$|\\.)*)") (lambda (x) (cond (= "true" x) true
(array (quote bool_nil_symbol) (array "-|(([a-z]|[A-Z]|_|\\*|/|\\?|\\+|!|=|&|\\||<|>|%|$|\\.)([a-z]|[A-Z]|_|[0-9]|\\*|\\?|\\+|-|!|=|&|\\||<|>|%|$|\\.)*)") (lambda (x) (cond (= "true" x) true
(= "false" x) false
(= "nil" x) nil
true (str-to-symbol x))))