miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

More work on compiling comb, adding wrap level to comb, placeholders for all builtins, memoization

Browse Source
This commit is contained in:
Nathan Braswell
2021-12-24 17:26:41 -05:00
parent 69b87cbe72
commit 5097a11bb6
1 changed files with 134 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

166
partial_eval.csc
View File

@@ -112,6 +112,9 @@
(get-value (lambda (d k) (let ((result (alist-ref k d))) (get-value (lambda (d k) (let ((result (alist-ref k d)))
(if (array? result) (idx result 0) (if (array? result) (idx result 0)
(error (print "could not find " k " in " d)))))) (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) (% modulo)
(int? integer?) (int? integer?)
@@ -1196,7 +1199,7 @@
; <array_size32><array_ptr29>101 / 0..0 101 ; <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...) ; 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 ; Env
; 0..0<env_ptr32 but still aligned>01001 ; 0..0<env_ptr32 but still aligned>01001
@@ -1344,7 +1347,7 @@
(_if '$is_comb '(result i32) (_if '$is_comb '(result i32)
(i64.eq (i64.const #b0001) (i64.and (i64.const #b1111) (local.get '$to_str_len))) (i64.eq (i64.const #b0001) (i64.and (i64.const #b1111) (local.get '$to_str_len)))
(then (then
(i32.const 4) (i32.const 5)
) )
(else (else
;; must be int ;; must be int
@@ -1478,7 +1481,11 @@
(i64.eq (i64.const #b0001) (i64.and (i64.const #b1111) (local.get '$to_str))) (i64.eq (i64.const #b0001) (i64.and (i64.const #b1111) (local.get '$to_str)))
(then (then
(i32.store (local.get '$buf) (i32.const #x626D6F63)) (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 (else
;; must be int ;; must be int
@@ -1538,31 +1545,73 @@
(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))
)))) ))))
(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))) ((val? c) (let ((v (.val c)))
(cond ((int? v) (array (<< v 1) datasi funcs)) (cond ((int? v) (array (<< v 1) datasi funcs memo))
((= true v) (array #b00111101 datasi funcs)) ((= true v) (array #b00111101 datasi funcs memo))
((= false v) (array #b00011101 datasi funcs)) ((= false v) (array #b00011101 datasi funcs memo))
((str? v) (dlet (((c_loc c_len datasi) (alloc_data v datasi)) ((str? v) (dlet (((c_loc c_len datasi) (alloc_data v datasi))
(a (bor (<< c_len 32) c_loc #b011)) (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")))))) (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)) ((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))
(a (bor (<< c_len 32) c_loc #b111)) (result (bor (<< c_len 32) c_loc #b111))
) (array a datasi funcs))) (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 " right now")))))
((marked_array? c) (if (.marked_array_is_val c) (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) (if (= 0 actual_len) (array nil_array_value datasi funcs memo)
(dlet (((comp_values datasi funcs) (foldr (dlambda (x (a datasi funcs)) (dlet (((v datasi funcs) (recurse datasi funcs x))) (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))) (array (array) datasi funcs) (.marked_array_values c))) (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))) ((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)))) (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 right now " c))))
((marked_env? c) (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) (foldr (dlambda ((k v) (ka va datasi funcs)) (dlet (((kv datasi funcs) (recurse datasi funcs (marked_symbol true k))) ((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) (recurse datasi funcs v))) ((vv datasi funcs memo) (recurse datasi funcs memo v)))
(array (cons kv ka) (cons vv va) datasi funcs))) (array (array) (array) datasi funcs) (slice e 0 -2))) (array (cons kv ka) (cons vv va) datasi funcs memo))) (array (array) (array) datasi funcs memo) (slice e 0 -2)))
(u (idx e -1)) (u (idx e -1))
(_ (print "comp values are " kvs " and " vvs)) (_ (print "comp values are " kvs " and " vvs))
((kvs_array datasi) (if (= 0 (len kvs)) (array nil_array_value datasi) ((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) ((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))) (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)))) (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))) ((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)))) (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))) (all_hex (map i64_le_hexify (array kvs_array vvs_array uv)))
(_ (print "all_hex " all_hex)) (_ (print "all_hex " all_hex))
((c_loc c_len datasi) (alloc_data (apply concat all_hex) datasi))) ((c_loc c_len datasi) (alloc_data (apply concat all_hex) datasi))
(array (bor (<< c_loc 5) #b01001) datasi funcs))) (result (bor (<< c_loc 5) #b01001))
((prim_comb? c) (cond ((= 'len_fake_real (.prim_comb_sym c)) (array (bor 1 (<< k_len 33)) datasi funcs)) (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"))))) (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) (our_func (func '$len '(param $it 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))
)) ))
(funcs (concat funcs our_func)) (funcs (concat funcs our_func))
(our_func_idx (len funcs)) (our_func_idx (len funcs))
; also insert env here ; also insert env here
(result (bor 1 (<< our_func_idx 33))) (result (bor (<< our_func_idx 35) located_env_ptr (<< wrap_level 4) #b0001))
) (array result datasi funcs))) (memo (put memo (.hash c) result))
) (array result datasi funcs memo))))
(true (error (str "can't compile " c " right now"))) (true (error (str "can't compile " c " right now")))
))) )))
(_ (println "compiling partial evaled " (str_strip marked_code))) (_ (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)) (_ (println "compiled it to " compiled_value_ptr))
(start (func '$start (start (func '$start
(call '$print (i64.const compiled_value_ptr)) (call '$print (i64.const compiled_value_ptr))
@@ -1831,11 +1929,15 @@
; (export "_start" '(func $start)) ; (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 ((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 "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)))) 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 "(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 "len"))))
;(output3 (compile (partial_eval (read-string "vau"))))
;(output3 (compile (partial_eval (read-string "(array len 3 len)")))) ;(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 "(+ 1 1337 (+ 1 2))"))))
;(output3 (compile (partial_eval (read-string "\"hello world\"")))) ;(output3 (compile (partial_eval (read-string "\"hello world\""))))