More work on compiling comb, adding wrap level to comb, placeholders for all builtins, memoization
This commit is contained in:
Nathan Braswell
166
partial_eval.csc
166
partial_eval.csc
@@ -112,6 +112,9 @@
|
||||
(get-value (lambda (d k) (let ((result (alist-ref k d)))
|
||||
(if (array? result) (idx result 0)
|
||||
(error (print "could not find " k " in " d))))))
|
||||
(get-value-or-false (lambda (d k) (let ((result (alist-ref k d)))
|
||||
(if (array? result) (idx result 0)
|
||||
false))))
|
||||
|
||||
(% modulo)
|
||||
(int? integer?)
|
||||
@@ -1196,7 +1199,7 @@
|
||||
; <array_size32><array_ptr29>101 / 0..0 101
|
||||
|
||||
; Combiner - a double of func index and closure (which could just be the env, actually, even if we trim...)
|
||||
; <func_idx31>|<env_ptr29>0001
|
||||
; <func_idx29>|<env_ptr29><wrap2>0001
|
||||
|
||||
; Env
|
||||
; 0..0<env_ptr32 but still aligned>01001
|
||||
@@ -1344,7 +1347,7 @@
|
||||
(_if '$is_comb '(result i32)
|
||||
(i64.eq (i64.const #b0001) (i64.and (i64.const #b1111) (local.get '$to_str_len)))
|
||||
(then
|
||||
(i32.const 4)
|
||||
(i32.const 5)
|
||||
)
|
||||
(else
|
||||
;; must be int
|
||||
@@ -1478,7 +1481,11 @@
|
||||
(i64.eq (i64.const #b0001) (i64.and (i64.const #b1111) (local.get '$to_str)))
|
||||
(then
|
||||
(i32.store (local.get '$buf) (i32.const #x626D6F63))
|
||||
(i32.const 4)
|
||||
(i32.store8 (i32.add (local.get '$buf) (i32.const 4))
|
||||
(i32.add (i32.const #x30)
|
||||
(i32.and (i32.const #b11)
|
||||
(i32.wrap_i64 (i64.shr_u (local.get '$to_str) (i64.const 4))))))
|
||||
(i32.const 5)
|
||||
)
|
||||
(else
|
||||
;; must be int
|
||||
@@ -1538,31 +1545,73 @@
|
||||
(i64.and (i64.shr_u (local.get '$it) (i64.const 31)) (i64.const -2))
|
||||
))))
|
||||
|
||||
(compile_helper (rec-lambda recurse (datasi funcs c) (cond
|
||||
((k_vau func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$vau (unreachable)))))
|
||||
((k_read-string func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$read-string (unreachable)))))
|
||||
((k_println func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$read-string (unreachable)))))
|
||||
((k_str func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$str (unreachable)))))
|
||||
((k_or func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$or (unreachable)))))
|
||||
((k_and func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$and (unreachable)))))
|
||||
((k_geq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$geq (unreachable)))))
|
||||
((k_gt func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$gt (unreachable)))))
|
||||
((k_leq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$leq (unreachable)))))
|
||||
((k_lt func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$lt (unreachable)))))
|
||||
((k_neq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$neq (unreachable)))))
|
||||
((k_eq func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$eq (unreachable)))))
|
||||
((k_mod func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$mod (unreachable)))))
|
||||
((k_div func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$div (unreachable)))))
|
||||
((k_mul func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$mul (unreachable)))))
|
||||
((k_add func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$add (unreachable)))))
|
||||
((k_sub func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$sub (unreachable)))))
|
||||
((k_concat func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$concat (unreachable)))))
|
||||
((k_slice func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$slice (unreachable)))))
|
||||
((k_idx func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$idx (unreachable)))))
|
||||
((k_array func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$array (unreachable)))))
|
||||
((k_arrayp func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$arrayp (unreachable)))))
|
||||
((k_get-text func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$get-text (unreachable)))))
|
||||
((k_str-to-symbol func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$str-to-symbol (unreachable)))))
|
||||
((k_bool? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$bool? (unreachable)))))
|
||||
((k_nil? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$nil? (unreachable)))))
|
||||
((k_env? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$env? (unreachable)))))
|
||||
((k_combiner? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$combiner? (unreachable)))))
|
||||
((k_string? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$string? (unreachable)))))
|
||||
((k_int? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$int? (unreachable)))))
|
||||
((k_symbol? func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$symbol? (unreachable)))))
|
||||
((k_cond func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$cond (unreachable)))))
|
||||
((k_eval func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$eval (unreachable)))))
|
||||
((k_unwrap func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$unwrap (unreachable)))))
|
||||
((k_wrap func_idx funcs) (array func_idx (+ 1 func_idx) (concat funcs (func '$wrap (unreachable)))))
|
||||
|
||||
(get_passthrough (lambda (hash datasi funcs memo) (let ((r (get-value-or-false memo hash)))
|
||||
(if r (array r datasi funcs memo) #f))))
|
||||
|
||||
(compile_value (rec-lambda recurse (datasi funcs memo c) (cond
|
||||
((val? c) (let ((v (.val c)))
|
||||
(cond ((int? v) (array (<< v 1) datasi funcs))
|
||||
((= true v) (array #b00111101 datasi funcs))
|
||||
((= false v) (array #b00011101 datasi funcs))
|
||||
(cond ((int? v) (array (<< v 1) datasi funcs memo))
|
||||
((= true v) (array #b00111101 datasi funcs memo))
|
||||
((= false v) (array #b00011101 datasi funcs memo))
|
||||
((str? v) (dlet (((c_loc c_len datasi) (alloc_data v datasi))
|
||||
(a (bor (<< c_len 32) c_loc #b011))
|
||||
) (array a datasi funcs)))
|
||||
) (array a datasi funcs memo)))
|
||||
(true (error (str "Can't compile value " v " right now"))))))
|
||||
((marked_symbol? c) (cond ((.marked_symbol_is_val c) (dlet (((c_loc c_len datasi) (alloc_data (symbol->string (.marked_symbol_value c)) datasi))
|
||||
(a (bor (<< c_len 32) c_loc #b111))
|
||||
) (array a datasi funcs)))
|
||||
((marked_symbol? c) (cond ((.marked_symbol_is_val c) (or (get_passthrough (.hash c) datasi funcs memo) (dlet (((c_loc c_len datasi) (alloc_data (symbol->string (.marked_symbol_value c)) datasi))
|
||||
(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")))))
|
||||
((marked_array? c) (if (.marked_array_is_val c) (let ((actual_len (len (.marked_array_values c))))
|
||||
(if (= 0 actual_len) (array nil_array_value datasi funcs)
|
||||
(dlet (((comp_values datasi funcs) (foldr (dlambda (x (a datasi funcs)) (dlet (((v datasi funcs) (recurse datasi funcs x)))
|
||||
(array (cons v a) datasi funcs))) (array (array) datasi funcs) (.marked_array_values c)))
|
||||
((c_loc c_len datasi) (alloc_data (apply concat (map i64_le_hexify comp_values)) datasi)))
|
||||
(array (bor (<< actual_len 32) c_loc #b101) datasi funcs))))
|
||||
((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 datasi funcs memo x)))
|
||||
(array (cons v a) datasi funcs memo))) (array (array) datasi funcs memo) (.marked_array_values c)))
|
||||
((c_loc c_len datasi) (alloc_data (apply concat (map i64_le_hexify comp_values)) datasi))
|
||||
(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))))
|
||||
|
||||
((marked_env? c) (dlet ((e (.env_marked c))
|
||||
((kvs vvs datasi funcs) (foldr (dlambda ((k v) (ka va datasi funcs)) (dlet (((kv datasi funcs) (recurse datasi funcs (marked_symbol true k)))
|
||||
((vv datasi funcs) (recurse datasi funcs v)))
|
||||
(array (cons kv ka) (cons vv va) datasi funcs))) (array (array) (array) datasi funcs) (slice e 0 -2)))
|
||||
((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 datasi funcs memo (marked_symbol true k)))
|
||||
((vv datasi funcs memo) (recurse datasi funcs memo v)))
|
||||
(array (cons kv ka) (cons vv va) datasi funcs memo))) (array (array) (array) datasi funcs memo) (slice e 0 -2)))
|
||||
(u (idx e -1))
|
||||
(_ (print "comp values are " kvs " and " vvs))
|
||||
((kvs_array datasi) (if (= 0 (len kvs)) (array nil_array_value datasi)
|
||||
@@ -1571,29 +1620,78 @@
|
||||
((vvs_array datasi) (if (= 0 (len vvs)) (array nil_array_value datasi)
|
||||
(dlet (((vvs_loc vvs_len datasi) (alloc_data (apply concat (map i64_le_hexify vvs)) datasi)))
|
||||
(array (bor (<< (len vvs) 32) vvs_loc #b101) datasi))))
|
||||
((uv datasi funcs) (mif u (begin (print "turns out " u " did exist") (recurse datasi funcs (idx e -1)))
|
||||
(begin (print "turns out " u " didn't exist, returning nil_array value") (array nil_array_value datasi funcs))))
|
||||
((uv datasi funcs memo) (mif u (begin (print "turns out " u " did exist") (recurse datasi funcs memo (idx e -1)))
|
||||
(begin (print "turns out " u " didn't exist, returning nil_array value") (array nil_array_value datasi funcs memo))))
|
||||
(all_hex (map i64_le_hexify (array kvs_array vvs_array uv)))
|
||||
(_ (print "all_hex " all_hex))
|
||||
((c_loc c_len datasi) (alloc_data (apply concat all_hex) datasi)))
|
||||
(array (bor (<< c_loc 5) #b01001) datasi funcs)))
|
||||
((prim_comb? c) (cond ((= 'len_fake_real (.prim_comb_sym c)) (array (bor 1 (<< k_len 33)) datasi funcs))
|
||||
((c_loc c_len datasi) (alloc_data (apply concat all_hex) datasi))
|
||||
(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))
|
||||
((= 'println (.prim_comb_sym c)) (array (bor (<< k_println 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))
|
||||
((= '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))
|
||||
(true (error (str "Can't compile prim comb " (.prim_comb_sym c) " right now")))))
|
||||
((comb? c) (dlet (
|
||||
|
||||
((comb? c) (or (get_passthrough (.hash c) datasi funcs memo) (dlet (
|
||||
((wrap_level de? se variadic params body) (.comb c))
|
||||
((our_env_val datasi funcs memo) (recurse datasi funcs memo se))
|
||||
; <func_idx29>|<env_ptr29><wrap2>0001
|
||||
; e29><2><4> = 6
|
||||
; 0..0<env_ptr29><3 bits>01001
|
||||
; e29><3><5> = 8
|
||||
; 0..0<env_ptr32 but still aligned>01001
|
||||
; x+2+4 = y + 3 + 5
|
||||
; x + 6 = y + 8
|
||||
; x - 2 = y
|
||||
(located_env_ptr (band #x7FFFFFFC0 (>> our_env_val 2)))
|
||||
(our_func (func '$len '(param $it i64) '(result i64)
|
||||
(i64.and (i64.shr_u (local.get '$it) (i64.const 31)) (i64.const -2))
|
||||
))
|
||||
(funcs (concat funcs our_func))
|
||||
(our_func_idx (len funcs))
|
||||
; also insert env here
|
||||
(result (bor 1 (<< our_func_idx 33)))
|
||||
) (array result datasi funcs)))
|
||||
(result (bor (<< our_func_idx 35) located_env_ptr (<< wrap_level 4) #b0001))
|
||||
(memo (put memo (.hash c) result))
|
||||
) (array result datasi funcs memo))))
|
||||
(true (error (str "can't compile " c " right now")))
|
||||
)))
|
||||
|
||||
(_ (println "compiling partial evaled " (str_strip marked_code)))
|
||||
((compiled_value_ptr datasi funcs) (compile_helper datasi funcs marked_code))
|
||||
(memo empty_dict)
|
||||
((compiled_value_ptr datasi funcs memo) (compile_value datasi funcs memo marked_code))
|
||||
(_ (println "compiled it to " compiled_value_ptr))
|
||||
(start (func '$start
|
||||
(call '$print (i64.const compiled_value_ptr))
|
||||
@@ -1831,11 +1929,15 @@
|
||||
; (export "_start" '(func $start))
|
||||
;)))
|
||||
;(output3 (compile (partial_eval (read-string "(array 1 (array ((vau (x) x) a) (array \"asdf\")) 2)"))))
|
||||
(output3 (compile (partial_eval (read-string "(array 1 (array 1 2 3 4) 2 (array 1 2 3 4))"))))
|
||||
;(output3 (compile (partial_eval (read-string "empty_env"))))
|
||||
;(output3 (compile (partial_eval (read-string "(eval (array (array vau ((vau (x) x) (a b)) (array (array vau ((vau (x) x) x) (array) ((vau (x) x) x)))) 1 2) empty_env)"))))
|
||||
(output3 (compile (partial_eval (read-string "(eval (array (array vau ((vau (x) x) (a b)) (array (array vau ((vau (x) x) x) (array) ((vau (x) x) x)))) empty_env 2) empty_env)"))))
|
||||
;(output3 (compile (partial_eval (read-string "(eval (array (array vau ((vau (x) x) (a b)) (array (array vau ((vau (x) x) x) (array) ((vau (x) x) x)))) empty_env 2) empty_env)"))))
|
||||
;(output3 (compile (partial_eval (read-string "(eval (array (array vau ((vau (x) x) x) (array) ((vau (x) x) x))))"))))
|
||||
;(output3 (compile (partial_eval (read-string "(vau (x) x)"))))
|
||||
;(output3 (compile (partial_eval (read-string "(wrap (vau (x) x))"))))
|
||||
;(output3 (compile (partial_eval (read-string "len"))))
|
||||
;(output3 (compile (partial_eval (read-string "vau"))))
|
||||
;(output3 (compile (partial_eval (read-string "(array len 3 len)"))))
|
||||
;(output3 (compile (partial_eval (read-string "(+ 1 1337 (+ 1 2))"))))
|
||||
;(output3 (compile (partial_eval (read-string "\"hello world\""))))
|
||||
|
||||
Reference in New Issue
Block a user