clean up compile more, going straight to pulling out of memo, removing compile-body-part, removing now-unecessary recursion checking (for ping-pong between partial-eval and compile-inner because of how we now check memo and normalize), and finally add all tests to new_test.sh
This commit is contained in:
@@ -15,22 +15,52 @@ pushd "$SCRIPT_DIR"
|
||||
echo "Inside flake, running!"
|
||||
fi
|
||||
|
||||
ITERS=420000
|
||||
|
||||
rm -rf build || true
|
||||
mkdir build
|
||||
|
||||
|
||||
pushd build
|
||||
# workaround thanks to https://github.com/NixOS/nixpkgs/issues/139943
|
||||
cp -r "$(dirname $(dirname $(which emcc)))/share/emscripten/cache" ./emcache
|
||||
chmod u+rwX -R emcache
|
||||
export EM_CACHE="$(pwd)/emcache"
|
||||
|
||||
#no_compile
|
||||
#no_lazy_env
|
||||
#no_y_comb
|
||||
#no_prim_inline
|
||||
#no_closure_inline
|
||||
|
||||
echo "RB-Tree"
|
||||
ITERS=420000
|
||||
scheme --script ../../partial_eval.scm ../kraken/rbtree-opt.kp && mv csc_out.wasm kraken-rbtree-opt.wasm
|
||||
koka --target=wasm -v -O2 ../koka/rbtree.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_rbtree.wasm ./
|
||||
koka --target=c -v -O2 ../koka/rbtree.kk && mv ./.koka/v*/cc-drelease/koka_rbtree ./
|
||||
#koka --target=c -v -O2 ../koka/rbtree.kk && mv ./.koka/v*/cc-drelease/koka_rbtree ./
|
||||
|
||||
hyperfine --warmup 2 "./koka_rbtree $ITERS" "wasmtime ./koka_rbtree.wasm $ITERS" "wasmtime ./kraken-rbtree-opt.wasm $ITERS"
|
||||
hyperfine --warmup 2 "wasmtime ./koka_rbtree.wasm $ITERS" "wasmtime ./kraken-rbtree-opt.wasm $ITERS" --export-markdown rbtree_table.md --export-csv rbtree_table.csv
|
||||
|
||||
echo "Fib"
|
||||
ITERS=40
|
||||
scheme --script ../../partial_eval.scm ../kraken/fib.kp && mv csc_out.wasm kraken-fib.wasm
|
||||
koka --target=wasm -v -O2 ../koka/fib.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_fib.wasm ./
|
||||
hyperfine --warmup 2 "wasmtime ./koka_fib.wasm $ITERS" "wasmtime ./kraken-fib.wasm $ITERS" --export-markdown fib_table.md --export-csv fib_table.csv
|
||||
|
||||
|
||||
echo "CFold"
|
||||
ITERS=9
|
||||
scheme --script ../../partial_eval.scm ../kraken/cfold.kp && mv csc_out.wasm kraken-cfold.wasm
|
||||
koka --target=wasm -v -O2 ../koka/cfold.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_cfold.wasm ./
|
||||
hyperfine --warmup 2 "wasmtime ./koka_cfold.wasm $ITERS" "wasmtime ./kraken-cfold.wasm $ITERS" --export-markdown cfold_table.md --export-csv cfold_table.csv
|
||||
|
||||
echo "N-Queens"
|
||||
ITERS=10
|
||||
scheme --script ../../partial_eval.scm ../kraken/nqueens.kp && mv csc_out.wasm kraken-nqueens.wasm
|
||||
koka --target=wasm -v -O2 ../koka/nqueens.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_nqueens.wasm ./
|
||||
hyperfine --warmup 2 "wasmtime ./koka_nqueens.wasm $ITERS" "wasmtime ./kraken-nqueens.wasm $ITERS" --export-markdown nqueens_table.md --export-csv nqueens_table.csv
|
||||
|
||||
echo "Deriv"
|
||||
ITERS=9
|
||||
scheme --script ../../partial_eval.scm ../kraken/deriv.kp && mv csc_out.wasm kraken-deriv.wasm
|
||||
koka --target=wasm -v -O2 ../koka/deriv.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_deriv.wasm ./
|
||||
hyperfine --warmup 2 "wasmtime ./koka_deriv.wasm $ITERS" "wasmtime ./kraken-deriv.wasm $ITERS" --export-markdown deriv_table.md --export-csv deriv_table.csv
|
||||
popd
|
||||
popd
|
||||
|
||||
116
partial_eval.scm
116
partial_eval.scm
@@ -4646,23 +4646,6 @@
|
||||
((comb? c) (dlet (
|
||||
((wrap_level env_id de? se variadic params body) (.comb c))
|
||||
(_ (mif (> wrap_level 1) (error "wrap level TOO DARN HIGH")))
|
||||
(attempt_reduction (and
|
||||
(not dont_y_comb)
|
||||
variadic
|
||||
(= 1 (len params))
|
||||
(marked_array? body)
|
||||
(= 4 (len (.marked_array_values body)))
|
||||
(prim_comb? (idx (.marked_array_values body) 0))
|
||||
(= 'lapply (.prim_comb_sym (idx (.marked_array_values body) 0)))
|
||||
(marked_symbol? (idx (.marked_array_values body) 2))
|
||||
(not (.marked_symbol_is_val (idx (.marked_array_values body) 2)))
|
||||
(= (idx params 0) (.marked_symbol_value (idx (.marked_array_values body) 2)))
|
||||
(marked_symbol? (idx (.marked_array_values body) 3))
|
||||
(not (.marked_symbol_is_val (idx (.marked_array_values body) 3)))
|
||||
(= de? (.marked_symbol_value (idx (.marked_array_values body) 3)))
|
||||
))
|
||||
; new tce data
|
||||
; new env_id
|
||||
|
||||
) nil)
|
||||
((prim_comb? c) nil)
|
||||
@@ -4681,12 +4664,10 @@
|
||||
(and (not dont_y_comb) (!= nil (.marked_array_this_rec_stop c)) (get_passthrough (idx (.marked_array_this_rec_stop c) 0) ctx))
|
||||
|
||||
|
||||
(hit_recursion (= 'RECURSE_FAIL (get-value-or-false memo (.hash c))))
|
||||
((ok x) (try_unval x (lambda (_) nil)))
|
||||
(err (if (not ok) "couldn't unval in compile" err))
|
||||
|
||||
((pectx e pex) (cond ((!= nil err) (array pectx err nil))
|
||||
(hit_recursion (array pectx "blockrecursion" nil))
|
||||
(true (partial_eval_helper x false env (array nil nil) pectx 1 false))))
|
||||
|
||||
((tce_idx tce_full_params) (mif tce_data tce_data (array nil nil)))
|
||||
@@ -5241,7 +5222,6 @@
|
||||
; shape in that case which will cause compile to keep stepping.
|
||||
|
||||
((datasi funcs memo env pectx inline_locals) ctx)
|
||||
(hit_recursion (= 'RECURSE_FAIL (get-value-or-false memo (.hash c))))
|
||||
|
||||
(func_param_values (.marked_array_values c))
|
||||
(num_params (- (len func_param_values) 1))
|
||||
@@ -5269,7 +5249,6 @@
|
||||
(err (if (not ok) "couldn't unval in compile" err))
|
||||
|
||||
((pectx e pex) (cond ((!= nil err) (array pectx err nil))
|
||||
(hit_recursion (array pectx "blockrecursion" nil))
|
||||
(true (partial_eval_helper x false env (array nil nil) pectx 1 false))))
|
||||
|
||||
(ctx (array datasi funcs memo env pectx inline_locals))
|
||||
@@ -5812,7 +5791,7 @@
|
||||
; and so we can only tell here weather or not it will be safe to remove the level of lazyness (because we get a func value back instead of code)
|
||||
; and perform the eta reduction.
|
||||
|
||||
(attempt_reduction (and
|
||||
) (mif (and
|
||||
(not dont_y_comb)
|
||||
variadic
|
||||
(= 1 (len params))
|
||||
@@ -5820,22 +5799,46 @@
|
||||
(= 4 (len (.marked_array_values body)))
|
||||
(prim_comb? (idx (.marked_array_values body) 0))
|
||||
(= 'lapply (.prim_comb_sym (idx (.marked_array_values body) 0)))
|
||||
|
||||
; since we partial eval before now, instead of checking for the rec hash stopped thing itself, we use normal memo to tie the knot
|
||||
; Check to see if it even needs it now
|
||||
(get-value-or-false memo (.hash (idx (.marked_array_values body) 1)))
|
||||
|
||||
(int? (get-value-or-false memo (.hash (idx (.marked_array_values body) 1))))
|
||||
(marked_symbol? (idx (.marked_array_values body) 2))
|
||||
(not (.marked_symbol_is_val (idx (.marked_array_values body) 2)))
|
||||
(= (idx params 0) (.marked_symbol_value (idx (.marked_array_values body) 2)))
|
||||
(marked_symbol? (idx (.marked_array_values body) 3))
|
||||
(not (.marked_symbol_is_val (idx (.marked_array_values body) 3)))
|
||||
(= de? (.marked_symbol_value (idx (.marked_array_values body) 3)))
|
||||
))
|
||||
)
|
||||
(array (set_wrap_val wrap_level (get-value-or-false memo (.hash (idx (.marked_array_values body) 1)))) nil err ctx)
|
||||
(dlet (
|
||||
|
||||
(full_params (concat params (mif de? (array de?) (array))))
|
||||
(normal_params_length (if variadic (- (len params) 1) (len params)))
|
||||
(compile_body_part (lambda (ctx body_part new_tce_data) (dlet (
|
||||
|
||||
|
||||
((env_val env_code env_err ctx) (if (and need_value (not (marked_env_real? se)))
|
||||
(array nil nil "Env wasn't real when compiling comb, but need value" ctx)
|
||||
(compile-inner ctx se need_value inside_veval outer_s_env_access_code s_env_access_code inline_level nil analysis_nil)))
|
||||
(_ (if (not (or (= nil env_val) (int? env_val))) (error "BADBADBADenv_val")))
|
||||
(maybe_func (get_passthrough (.hash c) ctx))
|
||||
((func_value _ func_err ctx) (mif maybe_func maybe_func
|
||||
(dlet (
|
||||
|
||||
((datasi funcs memo env pectx outer_inline_locals) ctx)
|
||||
(old_funcs funcs)
|
||||
(funcs (concat funcs (array nil)))
|
||||
(our_wrap_func_idx (+ (len funcs) func_id_dynamic_ofset))
|
||||
(funcs (concat funcs (array nil)))
|
||||
(our_func_idx (+ (len funcs) func_id_dynamic_ofset))
|
||||
(calculate_func_val (lambda (wrap) (mk_comb_val_nil_env our_func_idx (mif de? 1 0) wrap)))
|
||||
(func_value (calculate_func_val wrap_level))
|
||||
; if variadic, we just use the wrapper func and don't expect callers to know that we're varidic
|
||||
(func_value (mif variadic (mod_fval_to_wrap func_value) func_value))
|
||||
(memo (put memo (.hash c) func_value))
|
||||
|
||||
|
||||
(new_inline_locals (array))
|
||||
(ctx (array datasi funcs memo env pectx new_inline_locals))
|
||||
|
||||
(new_tce_data (array our_func_idx full_params))
|
||||
(inner_env (make_tmp_inner_env params de? se env_id))
|
||||
|
||||
((params_vec _ _ ctx) (compile-inner ctx (marked_array true false nil (map (lambda (k) (marked_symbol nil k)) full_params) nil) true false outer_s_env_access_code s_env_access_code 0 nil analysis_nil))
|
||||
@@ -5861,62 +5864,25 @@
|
||||
((datasi funcs memo env pectx inline_locals) ctx)
|
||||
(inner_ctx (array datasi funcs memo inner_env pectx inline_locals))
|
||||
;-------------
|
||||
(_ (true_print "Doing call-info" full_params))
|
||||
;(_ (true_print "Doing call-info" full_params))
|
||||
;(call_info (call-info c env_id))
|
||||
;-------------
|
||||
(_ (true_print "Doing infer_types for body part for " full_params))
|
||||
(inner_type_data (infer_types body_part (.marked_env_idx inner_env) empty_dict-list empty_dict-list))
|
||||
(inner_type_data (infer_types body (.marked_env_idx inner_env) empty_dict-list empty_dict-list))
|
||||
(_ (true_print "done infer_types, Doing pseudo perceus " full_params))
|
||||
((used_map_before used_map_sub_data) (pseudo_perceus body_part (.marked_env_idx inner_env) memo (push_used_map empty_use_map full_params)))
|
||||
((used_map_before used_map_sub_data) (pseudo_perceus body (.marked_env_idx inner_env) memo (push_used_map empty_use_map full_params)))
|
||||
(_ (true_print "done pseudo_perceus, Doing borrow? " full_params))
|
||||
((borrowed borrow_sub_data) (borrow? body_part false (.marked_env_idx inner_env) used_map_sub_data))
|
||||
(_ (mif borrowed (error "body hast to be borrowed? " borrowed " " (true_str_strip body_part))))
|
||||
(_ (true_print "done pseudo_perceus, Doing compile_body_part func def compile-inner " full_params))
|
||||
((borrowed borrow_sub_data) (borrow? body false (.marked_env_idx inner_env) used_map_sub_data))
|
||||
(_ (mif borrowed (error "body hast to be borrowed? " borrowed " " (true_str_strip body))))
|
||||
(_ (true_print "done pseudo_perceus, Doing compile_body func def compile-inner " full_params))
|
||||
(inner_analysis_data (array inner_type_data used_map_sub_data))
|
||||
((inner_value inner_code err ctx) (compile-inner inner_ctx body_part false false (local.get '$outer_s_env) new_get_s_env_code 0 new_tce_data inner_analysis_data))
|
||||
(_ (true_print "Done compile_body_part func def compile-inner " full_params))
|
||||
((inner_value inner_code err ctx) (compile-inner inner_ctx body false false (local.get '$outer_s_env) new_get_s_env_code 0 new_tce_data inner_analysis_data))
|
||||
(_ (true_print "Done compile_body func def compile-inner " full_params))
|
||||
; 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 pectx inline_locals) ctx)
|
||||
) (array inner_value inner_code err (array datasi funcs memo env pectx inline_locals) generate_get_s_env_code))))
|
||||
|
||||
((early_quit err ctx) (mif attempt_reduction
|
||||
(dlet (
|
||||
(_ (true_print "Attempting reduction!"))
|
||||
((inner_value inner_code err ctx generate_get_s_env_code) (compile_body_part ctx (idx (.marked_array_values body) 1) nil))
|
||||
; set it's wrap level to our wrap level
|
||||
(inner_value (mif inner_value (set_wrap_val wrap_level inner_value)))
|
||||
) (array inner_value err ctx))
|
||||
(array nil nil ctx)))
|
||||
|
||||
) (mif (and (!= nil early_quit) (= nil err)) (array ;(mod_fval_to_wrap early_quit)
|
||||
early_quit
|
||||
nil nil ctx)
|
||||
(dlet (
|
||||
|
||||
((env_val env_code env_err ctx) (if (and need_value (not (marked_env_real? se)))
|
||||
(array nil nil "Env wasn't real when compiling comb, but need value" ctx)
|
||||
(compile-inner ctx se need_value inside_veval outer_s_env_access_code s_env_access_code inline_level nil analysis_nil)))
|
||||
(_ (if (not (or (= nil env_val) (int? env_val))) (error "BADBADBADenv_val")))
|
||||
(maybe_func (get_passthrough (.hash c) ctx))
|
||||
((func_value _ func_err ctx) (mif maybe_func maybe_func
|
||||
(dlet (
|
||||
|
||||
((datasi funcs memo env pectx outer_inline_locals) ctx)
|
||||
(old_funcs funcs)
|
||||
(funcs (concat funcs (array nil)))
|
||||
(our_wrap_func_idx (+ (len funcs) func_id_dynamic_ofset))
|
||||
(funcs (concat funcs (array nil)))
|
||||
(our_func_idx (+ (len funcs) func_id_dynamic_ofset))
|
||||
(calculate_func_val (lambda (wrap) (mk_comb_val_nil_env our_func_idx (mif de? 1 0) wrap)))
|
||||
(func_value (calculate_func_val wrap_level))
|
||||
; if variadic, we just use the wrapper func and don't expect callers to know that we're varidic
|
||||
(func_value (mif variadic (mod_fval_to_wrap func_value) func_value))
|
||||
(memo (put memo (.hash c) func_value))
|
||||
(ctx (array datasi funcs memo env pectx inline_locals))
|
||||
|
||||
|
||||
(new_inline_locals (array))
|
||||
(ctx (array datasi funcs memo env pectx new_inline_locals))
|
||||
((inner_value inner_code err ctx generate_get_s_env_code) (compile_body_part ctx body (array our_func_idx full_params)))
|
||||
(inner_code (mif inner_value (i64.const (mod_fval_to_wrap inner_value)) inner_code))
|
||||
(wrapper_func (func '$wrapper_func '(param $params i64) '(param $d_env i64) '(param $outer_s_env i64) '(result i64) '(local $param_ptr i32) '(local $rc_bytes i64) '(local $rc_ptr i32) '(local $rc_tmp i32)
|
||||
(_if '$params_len_good
|
||||
|
||||
Reference in New Issue
Block a user