Implemented function calls!
This commit is contained in:
Nathan Braswell
220
partial_eval.csc
220
partial_eval.csc
@@ -1606,50 +1606,52 @@
|
|||||||
(call '$drop (local.get '$to_print))
|
(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))
|
(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_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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $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 $p i64) '(param $d i64) '(param $s i64) '(result i64)
|
||||||
((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)))))
|
(local.get '$p)
|
||||||
((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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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)))
|
(get_passthrough (lambda (hash datasi funcs memo) (let ((r (get-value-or-false memo hash)))
|
||||||
(if r (array r datasi funcs memo) #f))))
|
(if r (array r datasi funcs memo) #f))))
|
||||||
@@ -1667,7 +1669,7 @@
|
|||||||
(result (bor (<< c_len 32) c_loc #b111))
|
(result (bor (<< c_len 32) c_loc #b111))
|
||||||
(memo (put memo (.hash c) result))
|
(memo (put memo (.hash c) result))
|
||||||
) (array result datasi funcs memo))))
|
) (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))))
|
((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)
|
(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)))
|
(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))
|
(result (bor (<< actual_len 32) c_loc #b101))
|
||||||
(memo (put memo (.hash c) result))
|
(memo (put memo (.hash c) result))
|
||||||
) (array result datasi funcs memo)))))
|
) (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))
|
((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)))
|
((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))
|
(result (bor (<< c_loc 5) #b01001))
|
||||||
(memo (put memo (.hash c) result))
|
(memo (put memo (.hash c) result))
|
||||||
) (array result datasi funcs memo))))
|
) (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))
|
((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 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 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 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 35) (<< 1 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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? 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? 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? 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? 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? 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? 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? 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 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 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 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")))))
|
(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 (
|
((comb? c) (or (get_passthrough (.hash c) datasi funcs memo) (dlet (
|
||||||
((wrap_level de? se variadic params body) (.comb c))
|
((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)))
|
(result (lookup_helper (.env_marked env) (.marked_symbol_value c) 0 (local.get '$s_env)))
|
||||||
) (array result datasi funcs memo))))
|
) (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)))
|
((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))))
|
((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"))
|
((comb? c) (error "can't compile code comb right now"))
|
||||||
(true (error (str "can't compile-code " c " right now")))
|
(true (error (str "can't compile-code " c " right now")))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
; Add support for variadic
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
((inner_env setup_code datasi funcs memo) (cond
|
((inner_env setup_code datasi funcs memo) (cond
|
||||||
((= 0 (len params)) (array se (array) datasi funcs memo))
|
((= 0 (len params)) (array se (array) datasi funcs memo))
|
||||||
((and (= 1 (len params)) variadic) (dlet (
|
((and (= 1 (len params)) variadic) (dlet (
|
||||||
@@ -1799,6 +1827,9 @@
|
|||||||
(local.get '$s_env)))
|
(local.get '$s_env)))
|
||||||
datasi funcs memo
|
datasi funcs memo
|
||||||
)))
|
)))
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; Add support for variadic
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(variadic (error "can't compile partially variadic functions right now"))
|
(variadic (error "can't compile partially variadic functions right now"))
|
||||||
(true (dlet (
|
(true (dlet (
|
||||||
((params_vec datasi funcs memo) (recurse-value datasi funcs memo
|
((params_vec datasi funcs memo) (recurse-value datasi funcs memo
|
||||||
@@ -1830,7 +1861,7 @@
|
|||||||
) setup_code
|
) setup_code
|
||||||
))
|
))
|
||||||
((inner_code datasi funcs memo) (compile_code datasi funcs memo inner_env body))
|
((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)
|
(concat setup_code inner_code)
|
||||||
))
|
))
|
||||||
(funcs (concat funcs our_func))
|
(funcs (concat funcs our_func))
|
||||||
@@ -1926,12 +1957,12 @@
|
|||||||
k_vau
|
k_vau
|
||||||
;table
|
;table
|
||||||
0
|
0
|
||||||
|
;params
|
||||||
|
(local.get '$result)
|
||||||
;top_env
|
;top_env
|
||||||
(i64.const root_marked_env_val)
|
(i64.const root_marked_env_val)
|
||||||
; static env
|
; static env
|
||||||
(i64.or (i64.shl (i64.and (local.get '$it) (i64.const #x3FFFFFFC0)) (i64.const 2)) (i64.const #b01001))
|
(i64.or (i64.shl (i64.and (local.get '$it) (i64.const #x3FFFFFFC0)) (i64.const 2)) (i64.const #b01001))
|
||||||
;params
|
|
||||||
(local.get '$result)
|
|
||||||
;func_idx
|
;func_idx
|
||||||
(i32.wrap_i64 (i64.shr_u (local.get '$it) (i64.const 35)))
|
(i32.wrap_i64 (i64.shr_u (local.get '$it) (i64.const 35)))
|
||||||
))
|
))
|
||||||
@@ -1968,12 +1999,12 @@
|
|||||||
k_vau
|
k_vau
|
||||||
;table
|
;table
|
||||||
0
|
0
|
||||||
|
;params
|
||||||
|
(local.get '$result)
|
||||||
;top_env
|
;top_env
|
||||||
(i64.const root_marked_env_val)
|
(i64.const root_marked_env_val)
|
||||||
; static env
|
; static env
|
||||||
(i64.or (i64.shl (i64.and (local.get '$it) (i64.const #x3FFFFFFC0)) (i64.const 2)) (i64.const #b01001))
|
(i64.or (i64.shl (i64.and (local.get '$it) (i64.const #x3FFFFFFC0)) (i64.const 2)) (i64.const #b01001))
|
||||||
;params
|
|
||||||
(local.get '$result)
|
|
||||||
;func_idx
|
;func_idx
|
||||||
(i32.wrap_i64 (i64.shr_u (local.get '$it) (i64.const 35)))
|
(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) 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 (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) write) 1 \"waa\" (vau (a & args) args))"))))
|
||||||
|
|
||||||
;(output3 (compile (partial_eval (read-string "(array ((vau (x) x) read) 0 10 (vau (data code) data))"))))
|
;(output3 (compile (partial_eval (read-string "(array ((vau (x) x) read) 0 10 (vau (data code) data))"))))
|
||||||
|
|||||||
Reference in New Issue
Block a user