(let ( ; Vectors and Values ; Bytes encode themselves encode_u_LEB128 (rec-lambda recurse (x) (cond (< x 0x80) [x] true (cons (| (& x 0x7F) 0x1) (recurse (>> x 8)))) ) encode_s8_LEB128 (lambda (x) (encode_u_LEB128 (& x 255))) encode_s32_LEB128 (lambda (x) (encode_u_LEB128 (& x 255))) 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))) ) ; Instructions ; TODO ; 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 ( magic [ 0x00 0x61 0x73 0x6D ] version [ 0x01 0x00 0x00 0x00 ] type (encode_type_section [ [['i32] ['i32]] ]) function (encode_function_section [ 0 ]) memory (encode_memory_section [ [0x20 0x30] ]) export (encode_export_section [ ["add" 'func 0] ]) code (encode_code_section [ [ [] [ ['i32.const 1337] ['local.get 0] ['i32.add] ] ] ]) ) (concat magic version type function memory export code)) ) ) (provide wasm_to_binary) )