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

Add an extra level of lambda and pass around name dict in order to get around not having vau (+ quotation on symbols when referenced)

Browse Source
This commit is contained in:
Nathan Braswell
2021-11-28 00:57:35 -05:00
parent de8073d1fc
commit 505dc46998
1 changed files with 65 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
partial_eval.csc
View File

@@ -846,6 +846,7 @@
(true (error (str "bad mutablity " (idx t 1)))))))) (true (error (str "bad mutablity " (idx t 1))))))))
(encode_global_section (lambda (global_section) (encode_global_section (lambda (global_section)
(let ( (let (
(_ (print "encoding exprs " global_section))
(encoded (encode_vector (lambda (x) (concat (encode_global_type (idx x 0)) (encode_expr (idx x 1)))) global_section)) (encoded (encode_vector (lambda (x) (concat (encode_global_type (idx x 0)) (encode_expr (idx x 1)))) global_section))
) (concat (array #x06) (encode_u_LEB128 (len encoded)) encoded )) ) (concat (array #x06) (encode_u_LEB128 (len encoded)) encoded ))
)) ))
@@ -937,13 +938,12 @@
((= nil cur_typ) (recurse cur_list (idx (idx locals i) 2) 1 (+ 1 i))) ((= nil cur_typ) (recurse cur_list (idx (idx locals i) 2) 1 (+ 1 i)))
(true (recurse (concat cur_list (array (array cur_num cur_typ))) (idx (idx locals i) 2) 1 (+ 1 i)))) (true (recurse (concat cur_list (array (array cur_num cur_typ))) (idx (idx locals i) 2) 1 (+ 1 i))))
) (array) nil 0 0)) ) (array) nil 0 0))
;(inner_env (add-dict-to-env de (put inner_name_dict 'depth 0)))
(_ (println "params: " params " result: " result)) (_ (println "params: " params " result: " result))
(our_type (array (map (lambda (x) (idx x 2)) params) result)) (our_type (array (map (lambda (x) (idx x 2)) params) result))
;(inner_env (add-dict-to-env de (put inner_name_dict 'depth 0)))
(inner_name_dict_with_depth (put inner_name_dict 'depth 0))
(_ (println "about to get our_code")) (_ (println "about to get our_code"))
(our_code (flat_map (lambda (ins) (cond ((array? ins) ins) (our_code (flat_map (lambda (inss) (map (lambda (ins) (ins inner_name_dict_with_depth)) inss))
(true (ins)) ; un-evaled function, bare WAT
))
body)) body))
(_ (println "resulting code " our_code)) (_ (println "resulting code " our_code))
) (array ) (array
@@ -973,40 +973,51 @@
)) ))
))) )))
(drop (lambda () (array (array 'drop)))) ;;;;;;;;;;;;;;;
(i32.const (lambda (const) (array (array 'i32.const const)))) ; Instructions
(i64.const (lambda (const) (array (array 'i64.const const)))) ;;;;;;;;;;;;;;;
(local.get (lambda (const) (array (array 'local.get const)))) (drop (lambda () (array (lambda (name_dict) (array 'drop)))))
(i32.add (lambda flatten (concat (flat_map (lambda (x) x) flatten) (array (array 'i32.add))))) (i32.const (lambda (const) (array (lambda (name_dict) (array 'i32.const const)))))
(i32.load (lambda flatten (concat (flat_map (lambda (x) x) flatten) (array (array 'i32.load 2 0))))) (i64.const (lambda (const) (array (lambda (name_dict) (array 'i64.const const)))))
(i64.load (lambda flatten (concat (flat_map (lambda (x) x) flatten) (array (array 'i64.load 3 0))))) (local.get (lambda (const) (array (lambda (name_dict) (array 'local.get const)))))
(i32.store (lambda flatten (concat (flat_map (lambda (x) x) flatten) (array (array 'i32.store 2 0))))) (i32.add (lambda flatten (concat (apply concat flatten) (array (lambda (name_dict) (array 'i32.add))))))
(i64.store (lambda flatten (concat (flat_map (lambda (x) x) flatten) (array (array 'i64.store 3 0))))) (i32.load (lambda flatten (concat (apply concat flatten) (array (lambda (name_dict) (array 'i32.load 2 0))))))
(flat_eval_ins (lambda (instructions) (flat_map (lambda (ins) (cond ((array? ins) ins) (i64.load (lambda flatten (concat (apply concat flatten) (array (lambda (name_dict) (array 'i64.load 3 0))))))
(true (ins)))) instructions))) (i32.store (lambda flatten (concat (apply concat flatten) (array (lambda (name_dict) (array 'i32.store 2 0))))))
(i64.store (lambda flatten (concat (apply concat flatten) (array (lambda (name_dict) (array 'i64.store 3 0))))))
(block_like_body (lambda (name inner) (flat_eval_ins inner))) (block_like_body (lambda (name_dict name inner) (let* (
(block (lambda (name . inner) (array (array 'block (array) (block_like_body name inner))))) (new_depth (+ 1 (get-value name_dict 'depth)))
(_loop (lambda (name . inner) (array (array 'loop (array) (block_like_body name inner))))) (inner_env (put (put name_dict name new_depth) 'depth new_depth))
) (flat_map (lambda (inss) (map (lambda (ins) (ins inner_env)) inss)) inner))))
(block (lambda (name . inner) (array (lambda (name_dict) (array 'block (array) (block_like_body name_dict name inner))))))
(_loop (lambda (name . inner) (array (lambda (name_dict) (array 'loop (array) (block_like_body name_dict name inner))))))
(_if (lambda (name . inner) (dlet ( (_if (lambda (name . inner) (dlet (
((end_idx else_section) (if (= 'else (idx (idx inner -1) 0)) (array -2 (slice (idx inner -1) 1 -1) ) ((end_idx else_section) (if (= 'else (idx (idx inner -1) 0)) (array -2 (slice (idx inner -1) 1 -1) )
(array -1 nil ))) (array -1 nil )))
((end_idx then_section) (if (= 'then (idx (idx inner end_idx) 0)) (array (- end_idx 1) (slice (idx inner end_idx) 1 -1) ) ((end_idx then_section) (if (= 'then (idx (idx inner end_idx) 0)) (array (- end_idx 1) (slice (idx inner end_idx) 1 -1) )
(array (- end_idx 1) (array (idx inner end_idx) ) ))) (array (- end_idx 1) (array (idx inner end_idx) ) )))
(flattened (flat_eval_ins (slice inner 0 end_idx))) (flattened (apply concat (slice inner 0 end_idx)))
(_ (println "flattened " flattened " then_section " then_section " else_section " else_section)) (_ (println "flattened " flattened " then_section " then_section " else_section " else_section))
(then_block (block_like_body name then_section)) ) (concat flattened (array (lambda (name_dict) (concat (array 'if (array) (block_like_body name_dict name then_section))
(else_block (if (!= nil else_section) (array (block_like_body name else_section)) (if (!= nil else_section) (array (block_like_body name_dict name else_section))
(array))) (array)))))))))
) (concat flattened (array (concat (array 'if (array) then_block) else_block))))))
(then (lambda rest (cons 'then rest)))
(else (lambda rest (cons 'else rest)))
(br (lambda (block) (array (lambda (name_dict) (array 'br (if (int? block) block (- (get-value name_dict 'depth) (get-value name_dict block))))))))
(br_if (lambda (block . flatten) (concat (apply concat flatten) (array (lambda (name_dict) (array 'br_if (if (int? block) block (- (get-value name_dict 'depth) (get-value name_dict block)))))))))
(call (lambda (f . flatten) (concat (apply concat flatten) (array (lambda (name_dict) (array 'call (if (int? f) f (get-value name_dict f))))))))
;;;;;;;;;;;;;;;;;;;
; End Instructions
;;;;;;;;;;;;;;;;;;;
(br (lambda (block) (if (int? block) (array (array 'br block)))))
(br_if (lambda (block . flatten) (let ((rest (flat_eval_ins flatten)))
(concat rest (array (array 'br_if block))))))
(call (lambda (f . flatten) (concat (flat_map (lambda (x) x) flatten) (array (array 'call f)))))
(import (lambda (mod_name name t_idx_typ) (lambda (name_dict type import function table memory global export start elem code data) (dlet ( (import (lambda (mod_name name t_idx_typ) (lambda (name_dict type import function table memory global export start elem code data) (dlet (
(_ (print "t_idx_type " t_idx_typ))
(_ (if (!= 'func (idx t_idx_typ 0)) (error "only supporting importing functions rn"))) (_ (if (!= 'func (idx t_idx_typ 0)) (error "only supporting importing functions rn")))
((import_type idx_name param_type result_type) t_idx_typ) ((import_type idx_name param_type result_type) t_idx_typ)
(actual_type_idx (len type)) (actual_type_idx (len type))
@@ -1018,7 +1029,7 @@
(global (lambda (idx_name global_type expr) (lambda (name_dict type import function table memory global export start elem code data) (global (lambda (idx_name global_type expr) (lambda (name_dict type import function table memory global export start elem code data)
(array (put name_dict idx_name (len global)) (array (put name_dict idx_name (len global))
type import function table memory type import function table memory
(concat global (array (array (if (array? global_type) (reverse global_type) (array global_type 'const)) expr ))) (concat global (array (array (if (array? global_type) (reverse global_type) (array global_type 'const)) (map (lambda (x) (x empty_dict)) expr) )))
export start elem code data ) export start elem code data )
))) )))
@@ -1033,19 +1044,12 @@
))) )))
(elem (lambda (offset . entries) (lambda (name_dict type import function table memory global export start elem code data) (elem (lambda (offset . entries) (lambda (name_dict type import function table memory global export start elem code data)
(array name_dict type import function table memory global export start (concat elem (array (array offset (map (lambda (x) (get-value name_dict x)) entries)))) code data ) (array name_dict type import function table memory global export start (concat elem (array (array (map (lambda (x) (x empty_dict)) offset) (map (lambda (x) (get-value name_dict x)) entries)))) code data )
))) )))
(data (lambda it (lambda (name_dict type import function table memory global export start elem code data) (data (lambda it (lambda (name_dict type import function table memory global export start elem code data)
(array name_dict type import function table memory global export start elem code (concat data (array it)))))) (array name_dict type import function table memory global export start elem code
(concat data (array (map (lambda (x) (if (array? x) (map (lambda (y) (y empty_dict)) x) x)) it)))))))
;(i32 'i32)
;(i64 'i32)
;(param (lambda it (cons 'param it)))
;(result (lambda it (cons 'result it)))
(then (lambda rest (cons 'then rest)))
(else (lambda rest (cons 'else rest)))
(test-all (lambda () (let* ( (test-all (lambda () (let* (
@@ -1211,66 +1215,53 @@
(i32.const 0) ;; fdflags (i32.const 0) ;; fdflags
(i32.const 4) ;; opened fd out ptr (i32.const 4) ;; opened fd out ptr
) )
drop (drop)
(block '$a ; 1 (block '$a
(block '$b ; 2 (block '$b
(br 1 ;$a (br '$a)
) (br_if '$b
(br_if 2 ;$b
(i32.const 3)) (i32.const 3))
(_loop '$l ; 3 (_loop '$l
(br ;$a (br '$a)
1 (br '$l)
)
(br ;$l
3
)
) )
(_if '$myif ; 3 (_if '$myif
(i32.const 1) (i32.const 1)
(then (then
(i32.const 1) (i32.const 1)
drop (drop)
(br ;$b (br '$b)
2
)
) )
(else (else
(br ;$myif (br '$myif)
3
)
) )
) )
(_if '$another ; 3 (_if '$another
(i32.const 1) (i32.const 1)
(br 2 ;$b (br '$b))
))
(i32.const 1) (i32.const 1)
(_if '$third ; 3 (_if '$third
(br ;$b (br '$b))
2 (_if '$fourth
)) (br '$fourth))
(_if '$fourth ; 3
(br 3 ;$fourth
))
) )
) )
(call 2; $fd_read (call '$fd_read
(i32.const 0) ;; file descriptor (i32.const 0) ;; file descriptor
(i32.const 8) ;; *iovs (i32.const 8) ;; *iovs
(i32.const 1) ;; iovs_len (i32.const 1) ;; iovs_len
(i32.const 12) ;; nwritten, overwrite buf len with it (i32.const 12) ;; nwritten, overwrite buf len with it
) )
drop (drop)
;; print name ;; print name
(call 3; $fd_write (call '$fd_write
(i32.load (i32.const 4)) ;; file descriptor (i32.load (i32.const 4)) ;; file descriptor
(i32.const 8) ;; *iovs (i32.const 8) ;; *iovs
(i32.const 1) ;; iovs_len (i32.const 1) ;; iovs_len
(i32.const 4) ;; nwritten (i32.const 4) ;; nwritten
) )
drop (drop)
) )
(elem (i32.const 0) '$start '$start) (elem (i32.const 0) '$start '$start)