diff --git a/partial_eval.csc b/partial_eval.csc index 2de5fc8..1a89ed6 100644 --- a/partial_eval.csc +++ b/partial_eval.csc @@ -1606,50 +1606,52 @@ (call '$drop (local.get '$to_print)) )))) - ((k_len func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$len '(param $it i64) '(result i64) + ((k_len func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$len '(param $it i64) '(param $d i64) '(param $s i64) '(result i64) (i64.and (i64.shr_u (local.get '$it) (i64.const 31)) (i64.const -2)) )))) - ((k_vau func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$vau '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_read-string func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$read-string '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_log func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$log '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_error func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$error '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_str func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$str '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_or func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$or '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_and func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$and '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_geq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$geq '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_gt func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$gt '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_leq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$leq '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_lt func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$lt '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_neq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$neq '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_eq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$eq '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_mod func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$mod '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_div func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$div '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_mul func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$mul '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_add func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$add '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_sub func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$sub '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_band func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$band '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_bor func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$bor '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_ls func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$ls '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_rs func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$rs '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_concat func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$concat '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_slice func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$slice '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_idx func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$idx '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_array func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$array '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_arrayp func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$arrayp '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_get-text func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$get-text '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_str-to-symbol func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$str-to-symbol '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_bool? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$bool? '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_nil? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$nil? '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_env? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$env? '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_combiner? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$combiner? '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_string? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$string? '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_int? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$int? '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_symbol? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$symbol? '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_cond func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$cond '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_eval func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$eval '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_unwrap func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$unwrap '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) - ((k_wrap func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$wrap '(param $d i64) '(param $s i64) '(param $p i64) '(result i64) (unreachable))))) + ((k_vau func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$vau '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((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) (unreachable))))) + ((k_log func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$log '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((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) (unreachable))))) + ((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) (unreachable))))) + ((k_or func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$or '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_and func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$and '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((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) (unreachable))))) + ((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) (unreachable))))) + ((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) (unreachable))))) + ((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) (unreachable))))) + ((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) (unreachable))))) + ((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) (unreachable))))) + ((k_mod func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$mod '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_div func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$div '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_mul func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$mul '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_add func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$add '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_sub func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$sub '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_band func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$band '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_bor func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$bor '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_ls func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$ls '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((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) (unreachable))))) + ((k_concat func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$concat '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((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) (unreachable))))) + ((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) (unreachable))))) + ((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) + (local.get '$p) + )))) + ((k_arrayp func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$arrayp '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_get-text func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$get-text '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((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) (unreachable))))) + ((k_bool? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$bool? '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_nil? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$nil? '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_env? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$env? '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_combiner? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$combiner? '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_string? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$string? '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_int? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$int? '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((k_symbol? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$symbol? '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((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) (unreachable))))) + ((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) (unreachable))))) + ((k_unwrap func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$unwrap '(param $p i64) '(param $d i64) '(param $s i64) '(result i64) (unreachable))))) + ((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) (unreachable))))) (get_passthrough (lambda (hash datasi funcs memo) (let ((r (get-value-or-false memo hash))) (if r (array r datasi funcs memo) #f)))) @@ -1667,7 +1669,7 @@ (result (bor (<< c_len 32) c_loc #b111)) (memo (put memo (.hash c) result)) ) (array result datasi funcs memo)))) - (true (error (str "can't compile non-val symbols " c " right now"))))) + (true (error (str "can't compile non-val symbols " c " as val right now"))))) ((marked_array? c) (if (.marked_array_is_val c) (or (get_passthrough (.hash c) datasi funcs memo) (let ((actual_len (len (.marked_array_values c)))) (if (= 0 actual_len) (array nil_array_value datasi funcs memo) (dlet (((comp_values datasi funcs memo) (foldr (dlambda (x (a datasi funcs memo)) (dlet (((v datasi funcs memo) (recurse-value datasi funcs memo x))) @@ -1676,7 +1678,7 @@ (result (bor (<< actual_len 32) c_loc #b101)) (memo (put memo (.hash c) result)) ) (array result datasi funcs memo))))) - (error (str "can't compile call right now " c)))) + (error (str "can't compile call as value right now " c)))) ((marked_env? c) (or (get_passthrough (.hash c) datasi funcs memo) (dlet ((e (.env_marked c)) ((kvs vvs datasi funcs memo) (foldr (dlambda ((k v) (ka va datasi funcs memo)) (dlet (((kv datasi funcs memo) (recurse-value datasi funcs memo (marked_symbol true k))) @@ -1698,47 +1700,47 @@ (result (bor (<< c_loc 5) #b01001)) (memo (put memo (.hash c) result)) ) (array result datasi funcs memo)))) - ((prim_comb? c) (cond ((= 'vau_fake_real (.prim_comb_sym c)) (array (bor (<< k_vau 35) (<< 0 4) #b0001) datasi funcs memo)) - ((= 'cond_fake_real (.prim_comb_sym c)) (array (bor (<< k_cond 35) (<< 0 4) #b0001) datasi funcs memo)) - ((= 'or_fake_real (.prim_comb_sym c)) (array (bor (<< k_or 35) (<< 0 4) #b0001) datasi funcs memo)) - ((= 'and_fake_real (.prim_comb_sym c)) (array (bor (<< k_and 35) (<< 0 4) #b0001) datasi funcs memo)) - ((= 'len_fake_real (.prim_comb_sym c)) (array (bor (<< k_len 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'read-string (.prim_comb_sym c)) (array (bor (<< k_read-string 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'log (.prim_comb_sym c)) (array (bor (<< k_log 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'error (.prim_comb_sym c)) (array (bor (<< k_error 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'str (.prim_comb_sym c)) (array (bor (<< k_str 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '>= (.prim_comb_sym c)) (array (bor (<< k_geq 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '> (.prim_comb_sym c)) (array (bor (<< k_gt 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '<= (.prim_comb_sym c)) (array (bor (<< k_leq 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '< (.prim_comb_sym c)) (array (bor (<< k_lt 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '!= (.prim_comb_sym c)) (array (bor (<< k_neq 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '= (.prim_comb_sym c)) (array (bor (<< k_eq 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '% (.prim_comb_sym c)) (array (bor (<< k_mod 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '/ (.prim_comb_sym c)) (array (bor (<< k_div 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '* (.prim_comb_sym c)) (array (bor (<< k_mul 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '+ (.prim_comb_sym c)) (array (bor (<< k_add 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '- (.prim_comb_sym c)) (array (bor (<< k_sub 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '& (.prim_comb_sym c)) (array (bor (<< k_band 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'bor (.prim_comb_sym c)) (array (bor (<< k_bor 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '<< (.prim_comb_sym c)) (array (bor (<< k_ls 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= '>> (.prim_comb_sym c)) (array (bor (<< k_rs 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'concat_fake_real (.prim_comb_sym c)) (array (bor (<< k_concat 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'slice_fake_real (.prim_comb_sym c)) (array (bor (<< k_slice 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'idx_fake_real (.prim_comb_sym c)) (array (bor (<< k_idx 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'array_fake_real (.prim_comb_sym c)) (array (bor (<< k_array 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'arrayp_fake_real (.prim_comb_sym c)) (array (bor (<< k_arrayp 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'get-text (.prim_comb_sym c)) (array (bor (<< k_get-text 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'str-to-symbol (.prim_comb_sym c)) (array (bor (<< k_str-to-symbol 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'bool? (.prim_comb_sym c)) (array (bor (<< k_bool? 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'nil? (.prim_comb_sym c)) (array (bor (<< k_nil? 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'envp_fake_real (.prim_comb_sym c)) (array (bor (<< k_env? 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'combinerp_fake_real (.prim_comb_sym c)) (array (bor (<< k_combiner? 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'string? (.prim_comb_sym c)) (array (bor (<< k_string? 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'int? (.prim_comb_sym c)) (array (bor (<< k_int? 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'symbol? (.prim_comb_sym c)) (array (bor (<< k_symbol? 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'eval_fake_real (.prim_comb_sym c)) (array (bor (<< k_eval 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'unwrap_fake_real (.prim_comb_sym c)) (array (bor (<< k_unwrap 35) (<< 1 4) #b0001) datasi funcs memo)) - ((= 'wrap_fake_real (.prim_comb_sym c)) (array (bor (<< k_wrap 35) (<< 1 4) #b0001) datasi funcs memo)) + ((prim_comb? c) (cond ((= 'vau_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_vau k_len) 35) (<< 0 4) #b0001) datasi funcs memo)) + ((= 'cond_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_cond k_len) 35) (<< 0 4) #b0001) datasi funcs memo)) + ((= 'or_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_or k_len) 35) (<< 0 4) #b0001) datasi funcs memo)) + ((= 'and_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_and k_len) 35) (<< 0 4) #b0001) datasi funcs memo)) + ((= 'len_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_len k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'read-string (.prim_comb_sym c)) (array (bor (<< (- k_read-string k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'log (.prim_comb_sym c)) (array (bor (<< (- k_log k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'error (.prim_comb_sym c)) (array (bor (<< (- k_error k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'str (.prim_comb_sym c)) (array (bor (<< (- k_str k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '>= (.prim_comb_sym c)) (array (bor (<< (- k_geq k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '> (.prim_comb_sym c)) (array (bor (<< (- k_gt k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '<= (.prim_comb_sym c)) (array (bor (<< (- k_leq k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '< (.prim_comb_sym c)) (array (bor (<< (- k_lt k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '!= (.prim_comb_sym c)) (array (bor (<< (- k_neq k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '= (.prim_comb_sym c)) (array (bor (<< (- k_eq k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '% (.prim_comb_sym c)) (array (bor (<< (- k_mod k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '/ (.prim_comb_sym c)) (array (bor (<< (- k_div k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '* (.prim_comb_sym c)) (array (bor (<< (- k_mul k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '+ (.prim_comb_sym c)) (array (bor (<< (- k_add k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '- (.prim_comb_sym c)) (array (bor (<< (- k_sub k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '& (.prim_comb_sym c)) (array (bor (<< (- k_band k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'bor (.prim_comb_sym c)) (array (bor (<< (- k_bor k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '<< (.prim_comb_sym c)) (array (bor (<< (- k_ls k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= '>> (.prim_comb_sym c)) (array (bor (<< (- k_rs k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'concat_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_concat k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'slice_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_slice k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'idx_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_idx k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'array_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_array k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'arrayp_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_arrayp k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'get-text (.prim_comb_sym c)) (array (bor (<< (- k_get-text k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'str-to-symbol (.prim_comb_sym c)) (array (bor (<< (- k_str-to-symbol k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'bool? (.prim_comb_sym c)) (array (bor (<< (- k_bool? k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'nil? (.prim_comb_sym c)) (array (bor (<< (- k_nil? k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'envp_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_env? k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'combinerp_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_combiner? k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'string? (.prim_comb_sym c)) (array (bor (<< (- k_string? k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'int? (.prim_comb_sym c)) (array (bor (<< (- k_int? k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'symbol? (.prim_comb_sym c)) (array (bor (<< (- k_symbol? k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'eval_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_eval k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'unwrap_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_unwrap k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) + ((= 'wrap_fake_real (.prim_comb_sym c)) (array (bor (<< (- k_wrap k_len) 35) (<< 1 4) #b0001) datasi funcs memo)) (true (error (str "Can't compile prim comb " (.prim_comb_sym c) " right now"))))) ((comb? c) (or (get_passthrough (.hash c) datasi funcs memo) (dlet ( ((wrap_level de? se variadic params body) (.comb c)) @@ -1779,15 +1781,41 @@ (result (lookup_helper (.env_marked env) (.marked_symbol_value c) 0 (local.get '$s_env))) ) (array result datasi funcs memo)))) ((marked_array? c) (if (.marked_array_is_val c) (map_val (recurse-value datasi funcs memo c) (lambda (v) (i64.const v))) - (error (str "call cuz array in code" c)))) + (dlet ( + (func_param_values (.marked_array_values c)) + (num_params (- (len func_param_values) 1)) + ((param_code datasi funcs memo) (foldr (dlambda (x (a datasi funcs memo)) + (dlet (((code datasi funcs memo) (recurse-code datasi funcs memo env x))) + (array (concat code a) datasi funcs memo))) + (array (array) datasi funcs memo) func_param_values)) + (result_code (concat + param_code + (local.set '$param_ptr (call '$malloc (i32.const 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) + (call_indirect + ;type + k_vau + ;table + 0 + ;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) + (local.get '$s_env) + ; static env + (i64.or (i64.shl (i64.and (local.get '$tmp) (i64.const #x3FFFFFFC0)) + (i64.const 2)) (i64.const #b01001)) + ;func_idx + (i32.wrap_i64 (i64.shr_u (local.get '$tmp) (i64.const 35))) + ) + ))) (array result_code datasi funcs memo)))) ((prim_comb? c) (map_val (recurse-value datasi funcs memo c) (lambda (v) (i64.const v)))) ((comb? c) (error "can't compile code comb right now")) (true (error (str "can't compile-code " c " right now"))) ))) - ;;;;;;;;;;;;;;;;;;;;;;;;;; - ; Add support for variadic - ;;;;;;;;;;;;;;;;;;;;;;;;;; ((inner_env setup_code datasi funcs memo) (cond ((= 0 (len params)) (array se (array) datasi funcs memo)) ((and (= 1 (len params)) variadic) (dlet ( @@ -1799,6 +1827,9 @@ (local.get '$s_env))) datasi funcs memo ))) + ;;;;;;;;;;;;;;;;;;;;;;;;;; + ; Add support for variadic + ;;;;;;;;;;;;;;;;;;;;;;;;;; (variadic (error "can't compile partially variadic functions right now")) (true (dlet ( ((params_vec datasi funcs memo) (recurse-value datasi funcs memo @@ -1830,7 +1861,7 @@ ) setup_code )) ((inner_code datasi funcs memo) (compile_code datasi funcs memo inner_env body)) - (our_func (func '$len '(param $d_env i64) '(param $s_env i64) '(param $params i64) '(result i64) + (our_func (func '$len '(param $params i64) '(param $d_env i64) '(param $s_env i64) '(result i64) '(local $param_ptr i32) '(local $tmp i64) (concat setup_code inner_code) )) (funcs (concat funcs our_func)) @@ -1926,12 +1957,12 @@ k_vau ;table 0 + ;params + (local.get '$result) ;top_env (i64.const root_marked_env_val) ; static env (i64.or (i64.shl (i64.and (local.get '$it) (i64.const #x3FFFFFFC0)) (i64.const 2)) (i64.const #b01001)) - ;params - (local.get '$result) ;func_idx (i32.wrap_i64 (i64.shr_u (local.get '$it) (i64.const 35))) )) @@ -1968,12 +1999,12 @@ k_vau ;table 0 + ;params + (local.get '$result) ;top_env (i64.const root_marked_env_val) ; static env (i64.or (i64.shl (i64.and (local.get '$it) (i64.const #x3FFFFFFC0)) (i64.const 2)) (i64.const #b01001)) - ;params - (local.get '$result) ;func_idx (i32.wrap_i64 (i64.shr_u (local.get '$it) (i64.const 35))) )) @@ -2240,7 +2271,8 @@ ;(output3 (compile (partial_eval (read-string "(array ((vau (x) x) write) 1 \"waa\" (vau (written code) written))")))) ;(output3 (compile (partial_eval (read-string "(array ((vau (x) x) write) 1 \"waa\" (vau (written code) code))")))) - (output3 (compile (partial_eval (read-string "(array ((vau (x) x) write) 1 \"waa\" (vau (& args) args))")))) + (output3 (compile (partial_eval (read-string "(array ((vau (x) x) write) 1 \"waa\" (vau (written code) (array 1337 written 1338 code 1339)))")))) + ;(output3 (compile (partial_eval (read-string "(array ((vau (x) x) write) 1 \"waa\" (vau (& args) args))")))) ;(output3 (compile (partial_eval (read-string "(array ((vau (x) x) write) 1 \"waa\" (vau (a & args) args))")))) ;(output3 (compile (partial_eval (read-string "(array ((vau (x) x) read) 0 10 (vau (data code) data))"))))