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 ; 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 ; 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) partial_eval_helper (rec-lambda recurse (x env)
(cond (= x true) ['now true ] (cond (= x true) ['val true ]
(= x false) ['now false] (= x false) ['val false]
(env? x) (error "called partial_eval with an env " x) (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) (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) (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") (and (array? x) (= 0 (len x))) (error "Partial eval on empty array")
(array? x) (let ( (array? x) (let ( comb (recurse (idx x 0) env) )
subs (map (lambda (y) (recurse y env)) x) (cond (later? comb) ['later x]
comb (idx subs 0) (prim_comb? comb) ((.prim_comb comb) env (slice x 1 -1))
) (if (now? comb) ((val comb) (slice subs 1 -1)) (comb? comb) (let (
['later (map val subs)])) [wrap_level de? se params body actual_function] (.comb comb)
(nil? x) ['now x] ;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))] needs_params_val_lambda (vau de (f_sym) (let (
['later (cons f_sym (map val params))])) ]) 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 [ partial_eval (lambda (x) (partial_eval_helper x [
; vau ; vau
; eval ; eval
; cond ; cond
[ 'symbol? (needs_params_real symbol?) ] (needs_params_val_lambda symbol?)
[ 'int? (needs_params_real int?) ] (needs_params_val_lambda int?)
[ 'string? (needs_params_real string?) ] (needs_params_val_lambda string?)
; combiner? ; combiner?
; env? ; env?
[ 'nil? (needs_params_real nil?) ] (needs_params_val_lambda nil?)
[ 'bool? (needs_params_real bool?) ] (needs_params_val_lambda bool?)
; array? ; array?
[ 'str-to-symbol (needs_params_real str-to-symbol) ] (needs_params_val_lambda str-to-symbol)
[ 'get-text (needs_params_real get-text) ] (needs_params_val_lambda get-text)
; array ; array
; len ; len
; idx ; idx
; slice ; slice
; concat ; concat
[ '+ (needs_params_real +) ] (needs_params_val_lambda +)
[ '- (needs_params_real -) ] (needs_params_val_lambda -)
[ '* (needs_params_real *) ] (needs_params_val_lambda *)
[ '/ (needs_params_real /) ] (needs_params_val_lambda /)
[ '% (needs_params_real %) ] (needs_params_val_lambda %)
[ '& (needs_params_real &) ] (needs_params_val_lambda &)
[ '| (needs_params_real |) ] (needs_params_val_lambda |)
[ '<< (needs_params_real <<) ] (needs_params_val_lambda <<)
[ '>> (needs_params_real >>) ] (needs_params_val_lambda >>)
[ '= (needs_params_real =) ] (needs_params_val_lambda =)
[ '!= (needs_params_real !=) ] (needs_params_val_lambda !=)
[ '< (needs_params_real <) ] (needs_params_val_lambda <)
[ '<= (needs_params_real <=) ] (needs_params_val_lambda <=)
[ '> (needs_params_real >) ] (needs_params_val_lambda >)
[ '>= (needs_params_real >=) ] (needs_params_val_lambda >=)
; Don't forget, these short-circut with the truthy/falsey values ; Don't forget, these short-circut with the truthy/falsey values
; and ; and
; or ; or
; pr-str ; pr-str
[ 'str (needs_params_real str) ] (needs_params_val_lambda str)
[ 'prn (needs_params_real prn) ] (needs_params_val_lambda prn)
; println ; println
; meta ; meta
; with-meta ; with-meta
@@ -115,5 +151,5 @@
; empty_env ; 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) _ (println "Code: " code)
partially_evaled (partial_eval code) partially_evaled (partial_eval code)
_ (println "Partially evaled: " partially_evaled) _ (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: " fully_evaled)
_ (println) _ (println)
) fully_evaled)) ) 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 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)| (array (quote string) (array "\"([#-[]| |[]-~]|(\\\\\\\\)|(\\\\n)|(\\\\t)|(\\*)|(\\\\0)|
|[ -!]|(\\\\\"))*\"") (lambda (x) (unescape-str x))) |[ -!]|(\\\\\"))*\"") (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 (= "false" x) false
(= "nil" x) nil (= "nil" x) nil
true (str-to-symbol x)))) true (str-to-symbol x))))