(let ( ; Vectors and Values ; Bytes encode themselves encode_u_LEB128 (rec-lambda recurse (x) (cond (< x 0x80) [x] true (cons (| (& x 0x7F) 0x80) (recurse (>> x 7)))) ) encode_s8_LEB128 (lambda (x) (encode_u_LEB128 (& x 0xFF))) encode_s32_LEB128 (lambda (x) (encode_u_LEB128 (& x 0xFFFFFFFF))) encode_vector (lambda (enc v) (concat (encode_u_LEB128 (len v)) (flat_map enc v) ) ) encode_floating_point (lambda (x) (error "unimplemented")) encode_name (lambda (name) (encode_vector (lambda (x) [x]) name) ) ; Types ; TODO encode_limits (lambda (x) (cond (= 1 (len x)) (concat [0x00] (encode_u_LEB128 (idx x 0))) (= 2 (len x)) (concat [0x01] (encode_u_LEB128 (idx x 0)) (encode_u_LEB128 (idx x 1))) true (error "trying to encode bad limits")) ) encode_number_type (lambda (x) (cond (= x 'i32) [0x7F] (= x 'i64) [0x7E] (= x 'f32) [0x7D] (= x 'f64) [0x7C] true (error "bad number type")) ) encode_valtype (lambda (x) ; we don't handle reference types yet (encode_number_type x) ) encode_result_type (lambda (x) (encode_vector encode_valtype x) ) encode_function_type (lambda (x) (concat [0x60] (encode_result_type (idx x 0)) (encode_result_type (idx x 1))) ) ; Modules encode_type_section (lambda (x) (let ( encoded (encode_vector encode_function_type x) ) (concat [0x01] (encode_u_LEB128 (len encoded)) encoded )) ) encode_memory_section (lambda (x) (let ( encoded (encode_vector encode_limits x) ) (concat [0x05] (encode_u_LEB128 (len encoded)) encoded )) ) encode_export (lambda (export) (let ( (name type idx) export ) (concat (encode_name name) (cond (= type 'func) [0x00] (= type 'table) [0x01] (= type 'mem) [0x02] (= type 'global) [0x03] true (error "bad export type")) (encode_u_LEB128 idx) )) ) encode_export_section (lambda (x) (let ( encoded (encode_vector encode_export x) ) (concat [0x07] (encode_u_LEB128 (len encoded)) encoded )) ) encode_function_section (lambda (x) (let ( encoded (encode_vector encode_u_LEB128 x) ) (concat [0x03] (encode_u_LEB128 (len encoded)) encoded )) ) encode_ins (lambda (ins) (let ( op (idx ins 0) ) (cond (= op 'unreachable) [0x00] (= op 'nop) [0x01] ; skipping a bunch ; Parametric Instructions (= op 'drop) [0x1A] ; skip ; Variable Instructions (= op 'local.get) (concat [0x20] (encode_u_LEB128 (idx ins 1))) (= op 'local.set) (concat [0x21] (encode_u_LEB128 (idx ins 1))) (= op 'local.tee) (concat [0x22] (encode_u_LEB128 (idx ins 1))) (= op 'global.get) (concat [0x23] (encode_u_LEB128 (idx ins 1))) (= op 'global.set) (concat [0x24] (encode_u_LEB128 (idx ins 1))) ; skip ; Numeric Instructions (= op 'i32.const) (concat [0x41] (encode_s32_LEB128 (idx ins 1))) ; skip (= op 'i32.add) [0x6A] )) ) encode_code (lambda (x) (let ( (locals body) x enc_locals (encode_vector (lambda (loc) (concat (encode_u_LEB128 (idx loc 0)) (encode_u_LEB128 (idx loc 1)))) locals) enc_expr (concat (flat_map encode_ins body) [0x0B]) code_bytes (concat enc_locals enc_expr) ) (concat (encode_u_LEB128 (len code_bytes)) code_bytes)) ) encode_code_section (lambda (x) (let ( encoded (encode_vector encode_code x) ) (concat [0x0A] (encode_u_LEB128 (len encoded)) encoded )) ) wasm_to_binary (lambda (wasm_code) (let ( (type_section function_section memory_section export_section code_section) wasm_code _ (println "type_section" type_section "function_section" function_section "memory_section" memory_section "export_section" export_section "code_section" code_section) magic [ 0x00 0x61 0x73 0x6D ] version [ 0x01 0x00 0x00 0x00 ] type (encode_type_section type_section) function (encode_function_section function_section) memory (encode_memory_section memory_section) export (encode_export_section export_section) code (encode_code_section code_section) ) (concat magic version type function memory export code)) ) module (lambda (& args) (let ( helper (rec-lambda recurse (entries i type function memory export code) (if (= i (len entries)) [ type function memory export code ] (let ( (t f m e c) ((idx entries i) type function memory export code) ) (recurse entries (+ i 1) t f m e c)))) ) (helper args 0 [] [] [] [] []))) func (vau de (p_type r_type & body) (lambda (type function memory export code) (let ( our_type [ [ (idx p_type 1) ] [ (idx r_type 1) ] ] our_code (flat_map (lambda (x) (let (ins (eval x de)) (cond (array? ins) ins true (ins) ; un-evaled function, bare WAT ))) body) ) [ ; type (concat type [ our_type ]) ; function (concat function [ (len function) ]) ; memory memory ; export export ; code (concat code [ [ [] our_code ] ]) ]) )) i32.const (lambda (const) [['i32.const const]]) local.get (lambda (const) [['local.get const]]) i32.add (lambda (& flatten) (concat (map (lambda (x) (idx x 0)) flatten) [['i32.add]])) export (vau de (name t_v) (lambda (type function memory export code) [ type function memory (concat export [ [ name (idx t_v 0) (idx t_v 1) ] ]) code ] )) ) (provide wasm_to_binary module func i32.const local.get i32.add export) )