Implement unwrapped static calls! Modest speedup of 0.50 -> 0.43, I belive because calls to + and - still create the arrays. Still less than expected, though
This commit is contained in:
163
partial_eval.scm
163
partial_eval.scm
@@ -2486,6 +2486,7 @@
|
||||
drop_p_d
|
||||
(i64.const nil_val)
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_error_loc k_error_length datasi) (alloc_data "k_error" datasi))
|
||||
(k_error_msg_val (bor (<< k_error_length 32) k_error_loc #b011))
|
||||
((k_error func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$error '(param $p i64) '(param $d i64) '(param $s i64) '(result i64)
|
||||
@@ -2495,6 +2496,7 @@
|
||||
drop_p_d
|
||||
(unreachable)
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_str_loc k_str_length datasi) (alloc_data "k_str" datasi))
|
||||
(k_str_msg_val (bor (<< k_str_length 32) k_str_loc #b011))
|
||||
((k_str func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$str '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $buf i32) '(local $size i32)
|
||||
@@ -2510,6 +2512,7 @@
|
||||
(i64.extend_i32_u (local.get '$buf)))
|
||||
(i64.const #b011))
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
(pred_func (lambda (name type_check) (func name '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $ptr i32) '(local $len i32)
|
||||
(ensure_not_op_n_params_set_ptr_len i32.ne 1)
|
||||
@@ -2524,27 +2527,35 @@
|
||||
((k_nil_loc k_nil_length datasi) (alloc_data "k_nil" datasi))
|
||||
(k_nil_msg_val (bor (<< k_nil_length 32) k_nil_loc #b011))
|
||||
((k_nil? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (pred_func '$nil? (array -1 #x0000000000000005)))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_array_loc k_array_length datasi) (alloc_data "k_array" datasi))
|
||||
(k_array_msg_val (bor (<< k_array_length 32) k_array_loc #b011))
|
||||
((k_array? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (pred_func '$array? type_array))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_bool_loc k_bool_length datasi) (alloc_data "k_bool" datasi))
|
||||
(k_bool_msg_val (bor (<< k_bool_length 32) k_bool_loc #b011))
|
||||
((k_bool? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (pred_func '$bool? type_bool))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_env_loc k_env_length datasi) (alloc_data "k_env" datasi))
|
||||
(k_env_msg_val (bor (<< k_env_length 32) k_env_loc #b011))
|
||||
((k_env? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (pred_func '$env? type_env))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_combiner_loc k_combiner_length datasi) (alloc_data "k_combiner" datasi))
|
||||
(k_combiner_msg_val (bor (<< k_combiner_length 32) k_combiner_loc #b011))
|
||||
((k_combiner? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (pred_func '$combiner type_combiner))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_string_loc k_string_length datasi) (alloc_data "k_string" datasi))
|
||||
(k_string_msg_val (bor (<< k_string_length 32) k_string_loc #b011))
|
||||
((k_string? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (pred_func '$string? type_string))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_int_loc k_int_length datasi) (alloc_data "k_int" datasi))
|
||||
(k_int_msg_val (bor (<< k_int_length 32) k_int_loc #b011))
|
||||
((k_int? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (pred_func '$int? type_int))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_symbol_loc k_symbol_length datasi) (alloc_data "k_symbol" datasi))
|
||||
(k_symbol_msg_val (bor (<< k_symbol_length 32) k_symbol_loc #b011))
|
||||
((k_symbol? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (pred_func '$symbol? type_symbol))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_str_sym_comp func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$str_sym_comp '(param $a i64) '(param $b i64) '(param $lt_val i64) '(param $eq_val i64) '(param $gt_val i64) '(result i64) '(local $result i64) '(local $a_len i32) '(local $b_len i32) '(local $a_ptr i32) '(local $b_ptr i32)
|
||||
(local.set '$result (local.get '$eq_val))
|
||||
@@ -2585,6 +2596,7 @@
|
||||
)
|
||||
(local.get '$result)
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_comp_helper_helper func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$comp_helper_helper '(param $a i64) '(param $b i64) '(param $lt_val i64) '(param $eq_val i64) '(param $gt_val i64) '(result i64) '(local $result i64) '(local $a_tmp i32) '(local $b_tmp i32) '(local $a_ptr i32) '(local $b_ptr i32) '(local $result_tmp i64)
|
||||
(block '$b
|
||||
@@ -2827,6 +2839,7 @@
|
||||
)
|
||||
(local.get '$result)
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_comp_helper func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$comp_helper '(param $p i64) '(param $d i64) '(param $s i64) '(param $lt_val i64) '(param $eq_val i64) '(param $gt_val i64) '(result i64) '(local $ptr i32) '(local $len i32) '(local $result i64) '(local $a i64) '(local $b i64)
|
||||
set_len_ptr
|
||||
@@ -2851,37 +2864,44 @@
|
||||
(local.get '$result)
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_eq_loc k_eq_length datasi) (alloc_data "k_eq" datasi))
|
||||
(k_eq_msg_val (bor (<< k_eq_length 32) k_eq_loc #b011))
|
||||
((k_eq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$eq '(param $p i64) '(param $d i64) '(param $s i64) '(result i64)
|
||||
(call '$comp_helper (local.get '$p) (local.get '$d) (local.get '$s) (i64.const false_val) (i64.const true_val) (i64.const false_val))
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_neq_loc k_neq_length datasi) (alloc_data "k_neq" datasi))
|
||||
(k_neq_msg_val (bor (<< k_neq_length 32) k_neq_loc #b011))
|
||||
((k_neq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$neq '(param $p i64) '(param $d i64) '(param $s i64) '(result i64)
|
||||
(call '$comp_helper (local.get '$p) (local.get '$d) (local.get '$s) (i64.const true_val) (i64.const false_val) (i64.const true_val))
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_geq_loc k_geq_length datasi) (alloc_data "k_geq" datasi))
|
||||
(k_geq_msg_val (bor (<< k_geq_length 32) k_geq_loc #b011))
|
||||
((k_geq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$geq '(param $p i64) '(param $d i64) '(param $s i64) '(result i64)
|
||||
(call '$comp_helper (local.get '$p) (local.get '$d) (local.get '$s) (i64.const false_val) (i64.const true_val) (i64.const true_val))
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_gt_loc k_gt_length datasi) (alloc_data "k_gt" datasi))
|
||||
(k_gt_msg_val (bor (<< k_gt_length 32) k_gt_loc #b011))
|
||||
((k_gt func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$gt '(param $p i64) '(param $d i64) '(param $s i64) '(result i64)
|
||||
(call '$comp_helper (local.get '$p) (local.get '$d) (local.get '$s) (i64.const false_val) (i64.const false_val) (i64.const true_val))
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_leq_loc k_leq_length datasi) (alloc_data "k_leq" datasi))
|
||||
(k_leq_msg_val (bor (<< k_leq_length 32) k_leq_loc #b011))
|
||||
((k_leq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$leq '(param $p i64) '(param $d i64) '(param $s i64) '(result i64)
|
||||
(call '$comp_helper (local.get '$p) (local.get '$d) (local.get '$s) (i64.const true_val) (i64.const true_val) (i64.const false_val))
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_lt_loc k_lt_length datasi) (alloc_data "k_lt" datasi))
|
||||
(k_lt_msg_val (bor (<< k_lt_length 32) k_lt_loc #b011))
|
||||
((k_lt func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$lt '(param $p i64) '(param $d i64) '(param $s i64) '(result i64)
|
||||
(call '$comp_helper (local.get '$p) (local.get '$d) (local.get '$s) (i64.const true_val) (i64.const false_val) (i64.const false_val))
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
(math_function (lambda (name sensitive op)
|
||||
(func name '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $ptr i32) '(local $len i32) '(local $i i32) '(local $cur i64) '(local $next i64)
|
||||
@@ -2913,27 +2933,35 @@
|
||||
((k_mod_loc k_mod_length datasi) (alloc_data "k_mod" datasi))
|
||||
(k_mod_msg_val (bor (<< k_mod_length 32) k_mod_loc #b011))
|
||||
((k_mod func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (math_function '$mod true i64.rem_s))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_div_loc k_div_length datasi) (alloc_data "k_div" datasi))
|
||||
(k_div_msg_val (bor (<< k_div_length 32) k_div_loc #b011))
|
||||
((k_div func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (math_function '$div true i64.div_s))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_mul_loc k_mul_length datasi) (alloc_data "k_mul" datasi))
|
||||
(k_mul_msg_val (bor (<< k_mul_length 32) k_mul_loc #b011))
|
||||
((k_mul func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (math_function '$mul true i64.mul))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_sub_loc k_sub_length datasi) (alloc_data "k_sub" datasi))
|
||||
(k_sub_msg_val (bor (<< k_sub_length 32) k_sub_loc #b011))
|
||||
((k_sub func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (math_function '$sub true i64.sub))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_add_loc k_add_length datasi) (alloc_data "k_add" datasi))
|
||||
(k_add_msg_val (bor (<< k_add_length 32) k_add_loc #b011))
|
||||
((k_add func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (math_function '$add false i64.add))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_band_loc k_band_length datasi) (alloc_data "k_band" datasi))
|
||||
(k_band_msg_val (bor (<< k_band_length 32) k_band_loc #b011))
|
||||
((k_band func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (math_function '$band false i64.and))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_bor_loc k_bor_length datasi) (alloc_data "k_bor" datasi))
|
||||
(k_bor_msg_val (bor (<< k_bor_length 32) k_bor_loc #b011))
|
||||
((k_bor func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (math_function '$bor false i64.or))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_bxor_loc k_bxor_length datasi) (alloc_data "k_bxor" datasi))
|
||||
(k_bxor_msg_val (bor (<< k_bxor_length 32) k_bxor_loc #b011))
|
||||
((k_bxor func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (math_function '$bxor false i64.xor))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_bnot_loc k_bnot_length datasi) (alloc_data "k_bnot" datasi))
|
||||
(k_bnot_msg_val (bor (<< k_bnot_length 32) k_bnot_loc #b011))
|
||||
@@ -2943,6 +2971,7 @@
|
||||
(i64.xor (i64.const -2) (i64.load (local.get '$ptr)))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_ls_loc k_ls_length datasi) (alloc_data "k_ls" datasi))
|
||||
(k_ls_msg_val (bor (<< k_ls_length 32) k_ls_loc #b011))
|
||||
@@ -2953,6 +2982,7 @@
|
||||
(i64.shl (i64.load 0 (local.get '$ptr)) (i64.shr_s (i64.load 8 (local.get '$ptr)) (i64.const 1)))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_rs_loc k_rs_length datasi) (alloc_data "k_rs" datasi))
|
||||
(k_rs_msg_val (bor (<< k_rs_length 32) k_rs_loc #b011))
|
||||
((k_rs func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$rs '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $ptr i32) '(local $len i32)
|
||||
@@ -2962,6 +2992,7 @@
|
||||
(i64.and (i64.const -2) (i64.shr_s (i64.load 0 (local.get '$ptr)) (i64.shr_s (i64.load 8 (local.get '$ptr)) (i64.const 1))))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
|
||||
((k_builtin_fib_helper func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$builtin_fib_helper '(param $n i64) '(result i64)
|
||||
@@ -2979,6 +3010,7 @@
|
||||
)
|
||||
)
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_builtin_fib_loc k_builtin_fib_length datasi) (alloc_data "k_builtin_fib" datasi))
|
||||
(k_builtin_fib_msg_val (bor (<< k_builtin_fib_length 32) k_builtin_fib_loc #b011))
|
||||
@@ -2988,6 +3020,7 @@
|
||||
(call '$builtin_fib_helper (i64.load 0 (local.get '$ptr)))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
|
||||
((k_concat_loc k_concat_length datasi) (alloc_data "k_concat" datasi))
|
||||
@@ -3109,6 +3142,7 @@
|
||||
)
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_slice_loc k_slice_length datasi) (alloc_data "k_slice" datasi))
|
||||
(k_slice_msg_val (bor (<< k_slice_length 32) k_slice_loc #b011))
|
||||
((k_slice func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$slice '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $ptr i32) '(local $len i32)
|
||||
@@ -3121,6 +3155,7 @@
|
||||
(i32.wrap_i64 (i64.shr_s (i64.load 16 (local.get '$ptr)) (i64.const 1))))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_idx_loc k_idx_length datasi) (alloc_data "k_idx" datasi))
|
||||
(k_idx_msg_val (bor (<< k_idx_length 32) k_idx_loc #b011))
|
||||
((k_idx func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$idx '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $ptr i32) '(local $len i32) '(local $array i64) '(local $idx i32) '(local $size i32)
|
||||
@@ -3146,6 +3181,7 @@
|
||||
)
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_len_loc k_len_length datasi) (alloc_data "k_len" datasi))
|
||||
(k_len_msg_val (bor (<< k_len_length 32) k_len_loc #b011))
|
||||
((k_len func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$len '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $ptr i32) '(local $len i32)
|
||||
@@ -3154,6 +3190,7 @@
|
||||
(i64.and (i64.shr_u (i64.load 0 (local.get '$ptr)) (i64.const 31)) (i64.const -2))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_array_loc k_array_length datasi) (alloc_data "k_array" datasi))
|
||||
(k_array_msg_val (bor (<< k_array_length 32) k_array_loc #b011))
|
||||
((k_array func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$array '(param $p i64) '(param $d i64) '(param $s i64) '(result i64)
|
||||
@@ -3161,6 +3198,7 @@
|
||||
(call '$drop (local.get '$d))
|
||||
; s is 0
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_get_loc k_get_length datasi) (alloc_data "k_get-text" datasi))
|
||||
(k_get_msg_val (bor (<< k_get_length 32) k_get_loc #b011))
|
||||
@@ -3170,6 +3208,7 @@
|
||||
(call '$dup (i64.and (i64.const -5) (i64.load (local.get '$ptr))))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_str_loc k_str_length datasi) (alloc_data "k_str" datasi))
|
||||
(k_str_msg_val (bor (<< k_str_length 32) k_str_loc #b011))
|
||||
((k_str-to-symbol func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$str-to-symbol '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $ptr i32) '(local $len i32)
|
||||
@@ -3178,6 +3217,7 @@
|
||||
(call '$dup (i64.or (i64.const #b100) (i64.load (local.get '$ptr))))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_unwrap_loc k_unwrap_length datasi) (alloc_data "k_unwrap" datasi))
|
||||
(k_unwrap_msg_val (bor (<< k_unwrap_length 32) k_unwrap_loc #b011))
|
||||
@@ -3194,6 +3234,7 @@
|
||||
(i64.shl (i64.sub (local.get '$wrap_level) (i64.const 1)) (i64.const 4))))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_wrap_loc k_wrap_length datasi) (alloc_data "k_wrap" datasi))
|
||||
(k_wrap_msg_val (bor (<< k_wrap_length 32) k_wrap_loc #b011))
|
||||
((k_wrap func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$wrap '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $ptr i32) '(local $len i32) '(local $comb i64) '(local $wrap_level i64)
|
||||
@@ -3209,6 +3250,7 @@
|
||||
(i64.shl (i64.add (local.get '$wrap_level) (i64.const 1)) (i64.const 4))))
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_lapply_loc k_lapply_length datasi) (alloc_data "k_lapply" datasi))
|
||||
(k_lapply_msg_val (bor (<< k_lapply_length 32) k_lapply_loc #b011))
|
||||
@@ -3261,6 +3303,7 @@
|
||||
(i32.wrap_i64 (i64.shr_u (local.get '$comb) (i64.const 35)))
|
||||
)
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_vapply_loc k_vapply_length datasi) (alloc_data "k_vapply" datasi))
|
||||
(k_vapply_msg_val (bor (<< k_vapply_length 32) k_vapply_loc #b011))
|
||||
@@ -3313,6 +3356,7 @@
|
||||
(i32.wrap_i64 (i64.shr_u (local.get '$comb) (i64.const 35)))
|
||||
)
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
;true_val #b000111001
|
||||
;false_val #b00001100)
|
||||
@@ -3725,6 +3769,7 @@
|
||||
)
|
||||
(local.get '$result)
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_read_loc k_read_length datasi) (alloc_data "k_read" datasi))
|
||||
(k_read_msg_val (bor (<< k_read_length 32) k_read_loc #b011))
|
||||
((k_read-string func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$read-string '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $ptr i32) '(local $len i32) '(local $str i64) '(local $result i64) '(local $tmp_result i64) '(local $tmp_offset i32)
|
||||
@@ -3767,6 +3812,7 @@
|
||||
(local.get '$result)
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
|
||||
|
||||
@@ -3923,6 +3969,7 @@
|
||||
)
|
||||
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_eval_loc k_eval_length datasi) (alloc_data "k_eval" datasi))
|
||||
(k_eval_msg_val (bor (<< k_eval_length 32) k_eval_loc #b011))
|
||||
((k_eval func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$eval '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $len i32) '(local $ptr i32)
|
||||
@@ -3940,6 +3987,7 @@
|
||||
)
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_debug_parameters_loc k_debug_parameters_length datasi) (alloc_data "parameters to debug were " datasi))
|
||||
(k_debug_parameters_msg_val (bor (<< k_debug_parameters_length 32) k_debug_parameters_loc #b011))
|
||||
@@ -4135,6 +4183,7 @@
|
||||
drop_p_d
|
||||
(local.get '$to_ret)
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_vau_helper_loc k_vau_helper_length datasi) (alloc_data "k_vau_helper" datasi))
|
||||
(k_vau_helper_msg_val (bor (<< k_vau_helper_length 32) k_vau_helper_loc #b011))
|
||||
@@ -4248,6 +4297,7 @@
|
||||
(call '$drop (local.get '$new_env))
|
||||
(call '$drop (local.get '$s))
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
((k_env_symbol_loc k_env_symbol_length datasi) (alloc_data "env_symbol" datasi))
|
||||
(k_env_symbol_val (bor (<< k_env_symbol_length 32) k_env_symbol_loc #b111))
|
||||
@@ -4352,6 +4402,7 @@
|
||||
(i64.const #b0001))
|
||||
(call '$drop (local.get '$p))
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
((k_cond_loc k_cond_length datasi) (alloc_data "k_cond" datasi))
|
||||
(k_cond_msg_val (bor (<< k_cond_length 32) k_cond_loc #b011))
|
||||
((k_cond func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$cond '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) '(local $len i32) '(local $ptr i32) '(local $tmp i64)
|
||||
@@ -4383,10 +4434,19 @@
|
||||
(local.get '$tmp)
|
||||
drop_p_d
|
||||
))))
|
||||
((func_idx funcs) (array (+ 1 func_idx) (concat funcs (func '$dummy '(result i64) (i64.const 0)))))
|
||||
|
||||
(get_passthrough (dlambda (hash (datasi funcs memo env pectx)) (dlet ((r (get-value-or-false memo hash)))
|
||||
(if r (array r nil nil (array datasi funcs memo env pectx)) #f))))
|
||||
|
||||
; <func_idx29>|<env_ptr29><usesde1><wrap1>0001
|
||||
(mod_fval_to_wrap (lambda (it) (cond ((= nil it) it)
|
||||
;((and (= (band it #b1111) #b0001) (= #b0 (band (>> it 35) #b1))) (- it (<< 1 35)))
|
||||
((and (= (band it #b1111) #b0001) (= #b0 (band (>> it 35) #b1))) (dlet ( (r (- it (<< 1 35)))
|
||||
(_ (true_print "changing " it " to " r ", that is " (>> it 35) " to " (>> r 35)))
|
||||
) r) )
|
||||
(true it))))
|
||||
|
||||
; This is the second run at this, and is a little interesting
|
||||
; It can return a value OR code OR an error string. An error string should be propegated,
|
||||
; unless it was expected as a possiblity, which can happen when compling a call that may or
|
||||
@@ -4440,7 +4500,7 @@
|
||||
(dlet ((actual_len (len (.marked_array_values c))))
|
||||
(if (= 0 actual_len) (array nil_val nil nil ctx)
|
||||
(dlet ( ((comp_values err ctx) (foldr (dlambda (x (a err ctx)) (dlet (((v c e ctx) (compile-inner ctx x need_value inside_veval s_env_access_code)))
|
||||
(array (cons v a) (or (mif err err false) (mif e e false) (mif c (str "got code " c) false)) ctx))) (array (array) nil ctx) (.marked_array_values c)))
|
||||
(array (cons (mod_fval_to_wrap v) a) (or (mif err err false) (mif e e false) (mif c (str "got code " c) false)) ctx))) (array (array) nil ctx) (.marked_array_values c)))
|
||||
) (mif err (array nil nil (str err ", from an array value compile " (str_strip c)) ctx) (dlet (
|
||||
((datasi funcs memo env pectx) ctx)
|
||||
((c_loc c_len datasi) (alloc_data (apply concat (map i64_le_hexify comp_values)) datasi))
|
||||
@@ -4491,7 +4551,7 @@
|
||||
((datasi funcs memo env pectx) ctx)
|
||||
(memo (put memo (.hash c) 'RECURSE_OK))
|
||||
(ctx (array datasi funcs memo env pectx))
|
||||
) (array (cons (mif val (i64.const val) code) a) err ctx)))
|
||||
) (array (cons (mif val (i64.const (mod_fval_to_wrap val)) code) a) err ctx)))
|
||||
|
||||
(array (array) nil ctx) params)))
|
||||
|
||||
@@ -4524,7 +4584,7 @@
|
||||
(local.get '$tmp)))
|
||||
) (array full_code env_err ctx))
|
||||
(array code nil ctx)))
|
||||
) (array val code (mif err err env_err) ctx)))
|
||||
) (array (mod_fval_to_wrap val) code (mif err err env_err) ctx)))
|
||||
|
||||
((and (prim_comb? func_value) (= (.prim_comb_sym func_value) 'vcond))
|
||||
(dlet (
|
||||
@@ -4544,18 +4604,20 @@
|
||||
(true (dlet (
|
||||
((param_codes first_params_err ctx) (compile_params false ctx params))
|
||||
((func_val func_code func_err ctx) (compile-inner ctx func_value false inside_veval s_env_access_code))
|
||||
;(_ (print_strip "func val " func_val " func code " func_code " func err " func_err " param_codes " param_codes " err " err " from " func_value))
|
||||
|
||||
((unval_param_codes err ctx) (compile_params true ctx params))
|
||||
((bad_unval_params_msg_val _ _ ctx) (compile-inner ctx (marked_val (str "error was with unval-evaling parameters of " (str_strip c))) true inside_veval s_env_access_code))
|
||||
(wrap_0_param_code (concat
|
||||
(wrap_param_code (lambda (code) (concat
|
||||
(local.get '$tmp) ; saving ito restore it
|
||||
(apply concat param_codes)
|
||||
code
|
||||
(local.set '$param_ptr (call '$malloc (i32.const (* 8 num_params))))
|
||||
(flat_map (lambda (i) (i64.store (* i 8) (local.set '$tmp) (local.get '$param_ptr) (local.get '$tmp)))
|
||||
(range (- num_params 1) -1))
|
||||
(local.set '$tmp) ; restoring tmp
|
||||
))
|
||||
(wrap_1_param_code (concat
|
||||
)))
|
||||
(wrap_0_inner_code (apply concat param_codes))
|
||||
(wrap_0_param_code (wrap_param_code wrap_0_inner_code))
|
||||
(wrap_1_inner_code
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; Since we're not sure if it's going to be a vau or not,
|
||||
; this code might not be compilable, so we gracefully handle
|
||||
@@ -4566,43 +4628,47 @@
|
||||
(call '$print (i64.const bad_unval_params_msg_val))
|
||||
(call '$print (i64.shl (local.get '$tmp) (i64.const 1)))
|
||||
(unreachable))
|
||||
(concat
|
||||
(local.get '$tmp) ; saving ito restore it
|
||||
(apply concat unval_param_codes)
|
||||
(local.set '$param_ptr (call '$malloc (i32.const (* 8 num_params))))
|
||||
(flat_map (lambda (i) (i64.store (* i 8) (local.set '$tmp) (local.get '$param_ptr) (local.get '$tmp)))
|
||||
(range (- num_params 1) -1))
|
||||
(local.set '$tmp) ; restoring tmp
|
||||
))))
|
||||
(apply concat unval_param_codes)))
|
||||
(wrap_1_param_code (wrap_param_code wrap_1_inner_code))
|
||||
(wrap_x_param_code (concat
|
||||
; TODO: Handle other wrap levels
|
||||
(call '$print (i64.const weird_wrap_msg_val))
|
||||
(unreachable)))
|
||||
|
||||
|
||||
|
||||
((source_code ctx) (mif (.marked_array_source c) (dlet (((code _ _ ctx) (compile-inner ctx (.marked_array_source c) true inside_veval s_env_access_code))
|
||||
) (array code ctx))
|
||||
(array k_cond_msg_val ctx)))
|
||||
;(func_code (mif func_val (i64.const func_val) func_code))
|
||||
(result_code (mif func_val
|
||||
(concat
|
||||
(front_half_stack_code (i64.const source_code) (call '$dup s_env_access_code))
|
||||
(call (- (>> func_val 35) func_id_dynamic_ofset (- 0 num_pre_functions) 1)
|
||||
;params
|
||||
(mif (= #b0 (band (>> func_val 35) #b1))
|
||||
(concat
|
||||
(dlet ((wrap_level (>> (band func_val #x10) 4)))
|
||||
(cond ((= 0 wrap_level) wrap_0_inner_code)
|
||||
((= 1 wrap_level) wrap_1_inner_code)
|
||||
(true wrap_x_param_code)))
|
||||
;dynamic env (is caller's static env)
|
||||
; hay, we can do this statically! the static version of the dynamic check
|
||||
(mif (!= 0 (band func_val #b100000))
|
||||
(call '$dup s_env_access_code)
|
||||
(array))
|
||||
)
|
||||
(concat
|
||||
(dlet ((wrap_level (>> (band func_val #x10) 4)))
|
||||
(cond ((= 0 wrap_level) wrap_0_param_code)
|
||||
((= 1 wrap_level) wrap_1_param_code)
|
||||
(true wrap_x_param_code)))
|
||||
(front_half_stack_code (i64.const source_code) (call '$dup s_env_access_code))
|
||||
(call (- (>> func_val 35) func_id_dynamic_ofset (- 0 num_pre_functions) 1)
|
||||
;params
|
||||
(i64.or (i64.extend_i32_u (local.get '$param_ptr))
|
||||
(i64.const (bor (<< num_params 32) #x5)))
|
||||
;dynamic env (is caller's static env)
|
||||
;(call '$dup (local.get '$s_env))
|
||||
|
||||
; hay, we can do this statically! the static version of the dynamic check
|
||||
(mif (!= 0 (band func_val #b100000))
|
||||
(call '$dup s_env_access_code)
|
||||
(i64.const nil_val))
|
||||
)
|
||||
)
|
||||
; static env
|
||||
(i64.const (bor (<< (band func_val #x3FFFFFFC0) 2) #b01001))
|
||||
)
|
||||
@@ -4629,20 +4695,13 @@
|
||||
;table
|
||||
0
|
||||
;params
|
||||
|
||||
;(i64.store (i32.add (i32.const -16) (local.get '$param_ptr))
|
||||
; (i64.or (i64.extend_i32_u (local.get '$param_ptr))
|
||||
; (i64.const (bor (<< num_params 32) #x5)))) ; MDEBUG
|
||||
|
||||
(i64.or (i64.extend_i32_u (local.get '$param_ptr))
|
||||
(i64.const (bor (<< num_params 32) #x5)))
|
||||
;dynamic env (is caller's static env)
|
||||
;(call '$dup (local.get '$s_env))
|
||||
(_if '$needs_dynamic_env '(result i64)
|
||||
(i64.ne (i64.const #b0) (i64.and (local.get '$tmp) (i64.const #b100000)))
|
||||
(then (call '$dup s_env_access_code))
|
||||
(else (i64.const nil_val)))
|
||||
;(local.get '$s_env)
|
||||
; static env
|
||||
(i64.or (i64.shl (i64.and (local.get '$tmp) (i64.const #x3FFFFFFC0))
|
||||
(i64.const 2)) (i64.const #b01001))
|
||||
@@ -4677,7 +4736,7 @@
|
||||
)
|
||||
(if (= false ka) (array false va ctx)
|
||||
(if (or (= nil vv) (!= nil err)) (array false (str "vv was " vv " err is " err " and we needed_value? " need_value " based on v " (str_strip v)) ctx)
|
||||
(array (cons kv ka) (cons vv va) ctx)))))
|
||||
(array (cons kv ka) (cons (mod_fval_to_wrap vv) va) ctx)))))
|
||||
(array (array) (array) ctx)
|
||||
(slice e 0 -2)))
|
||||
((uv ucode err ctx) (mif (idx e -1) (compile-inner ctx (idx e -1) need_value inside_veval s_env_access_code)
|
||||
@@ -4806,7 +4865,9 @@
|
||||
) (array inner_value err ctx))
|
||||
(array nil nil ctx)))
|
||||
|
||||
) (mif (and (!= nil early_quit) (= nil err)) (array early_quit 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)))
|
||||
@@ -4821,24 +4882,25 @@
|
||||
((datasi funcs memo env pectx) ctx)
|
||||
(old_funcs funcs)
|
||||
(funcs (concat funcs (array nil)))
|
||||
(our_func_idx (+ (len funcs) func_id_dynamic_ofset))
|
||||
(our_wrap_func_idx (+ (len funcs) func_id_dynamic_ofset))
|
||||
(_ (true_print "Our wrapper id is " our_wrap_func_idx))
|
||||
(funcs (concat funcs (array nil)))
|
||||
(our_func_idx (+ (len funcs) func_id_dynamic_ofset))
|
||||
(_ (true_print "Our inner id is " our_func_idx))
|
||||
(calculate_func_val (lambda (wrap) (bor (<< our_func_idx 35) (<< (mif de? 1 0) 5) (<< wrap 4) #b0001)))
|
||||
(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 (mif env_val (foldl (dlambda (memo (hash wrap)) (put memo hash (calculate_combined_value env_val (calculate_func_val wrap)))) memo rec_hashes)
|
||||
memo))
|
||||
|
||||
(ctx (array datasi funcs memo env pectx))
|
||||
|
||||
;((name_msg_value _ _ ctx) (compile-inner ctx (marked_val (str "\n\ncalling function " (true_str_strip c) " with: ")) true inside_veval))
|
||||
|
||||
; This can be optimized for common cases, esp with no de? and varidaic to make it much faster
|
||||
; But not prematurely, I just had to redo it after doing that the first time, we'll get there when we get there
|
||||
(parameter_symbols (map (lambda (k) (array 'param k 'i64)) full_params))
|
||||
|
||||
|
||||
((inner_value inner_code err ctx) (compile_body_part ctx body))
|
||||
(inner_code (mif inner_value (i64.const inner_value) inner_code))
|
||||
(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)
|
||||
;(call '$print (i64.const 2674))
|
||||
(_if '$params_len_good
|
||||
@@ -4893,7 +4955,7 @@
|
||||
; x + 6 = y + 8
|
||||
; x - 2 = y
|
||||
) (mif env_val (array (calculate_combined_value env_val func_value) nil (mif func_err (str func_err ", from compiling comb body") (mif env_err (str env_err ", from compiling comb env") nil)) ctx)
|
||||
(array nil (i64.or (i64.const func_value) (i64.and (i64.const #x7FFFFFFC0) (i64.shr_u env_code (i64.const 2)))) (mif func_err (str func_err ", from compiling comb body (env as code)") (mif env_err (str env_err ", from compiling comb env (as code)") nil)) ctx))
|
||||
(array nil (i64.or (i64.const (mod_fval_to_wrap func_value)) (i64.and (i64.const #x7FFFFFFC0) (i64.shr_u env_code (i64.const 2)))) (mif func_err (str func_err ", from compiling comb body (env as code)") (mif env_err (str env_err ", from compiling comb env (as code)") nil)) ctx))
|
||||
))))
|
||||
|
||||
(true (error (str "Can't compile-inner impossible " c)))
|
||||
@@ -4917,7 +4979,7 @@
|
||||
|
||||
((compiled_value_ptr compiled_value_code compiled_value_error ctx) (compile-inner ctx marked_code true false (array)))
|
||||
((datasi funcs memo root_marked_env pectx) ctx)
|
||||
(compiled_value_code (mif compiled_value_ptr (i64.const compiled_value_ptr) compiled_value_code))
|
||||
(compiled_value_code (mif compiled_value_ptr (i64.const (mod_fval_to_wrap compiled_value_ptr)) compiled_value_code))
|
||||
|
||||
; Swap for when need to profile what would be an error
|
||||
;(compiled_value_ptr (mif compiled_value_error 0 compiled_value_ptr))
|
||||
@@ -5643,7 +5705,6 @@
|
||||
; Known TODOs
|
||||
;;;;;;;;;;;;;;
|
||||
;
|
||||
; * eval vau other missing builtins
|
||||
; * NON NAIVE REFCOUNTING
|
||||
; EVENTUALLY: Support some hard core partial_eval that an fully make (foldl or stuff) short circut effeciencly with double-inlining, finally
|
||||
; addressing the strict-languages-don't-compose thing
|
||||
@@ -5661,27 +5722,11 @@
|
||||
; otherwise lets are single use closures that do use their dynamic env just by virtue of being closures that take the dynamic env as the static env
|
||||
; wait, this is still vaguely ok - will stop at function boundries
|
||||
; Debugging restart-rerun
|
||||
|
||||
; Trial debugging restart-rerun for stack traces?
|
||||
; gets:
|
||||
; speed back, stack traces seem like 50% slowdown
|
||||
; needs:
|
||||
; checkpoint saving of form/env pair
|
||||
; probs outer loop calling monads
|
||||
; This is ok even later, b/c the closure will ony require refied environments in it's created func, which if not a closure is great, just params and static env
|
||||
;
|
||||
;
|
||||
; On the other hand, this introduces some weirdness
|
||||
; if we do a func & wrapper opt
|
||||
; need to track both dynamic env usage and param vector usage (including through env)
|
||||
; otherwise, we have the weird situation where the wrapper destructs params and then inner func must re-construct for inner dynamic env
|
||||
; also we need a way to get the code back for debugging
|
||||
;
|
||||
; THUS TODO:
|
||||
; trial debugging restart-rerun
|
||||
; opt versions of functions with backup code
|
||||
; CAN BE A DEBUGGING CHECK IN WRAPPER FUNC!
|
||||
; inlining of single use closures
|
||||
; also primitives?
|
||||
; dup and drop!
|
||||
; idx, etc
|
||||
; idx, +, -, *, etc
|
||||
|
||||
Reference in New Issue
Block a user