mirror of
https://github.com/kanaka/mal.git
synced 2024-09-19 01:28:26 +03:00
0a19c2f1c7
wasm: update to wat syntax as of Jan 2019. Examples: - get_local -> local.get - i32.wrap/i64 -> i32.warp_i64 - etc The distinction between wat and wast has been clarified: - wat: textual format for web assembly modules - wast: superset of wat used in the specification to define tests.
183 lines
6.1 KiB
Plaintext
183 lines
6.1 KiB
Plaintext
(module $printer
|
|
|
|
(global $printer_buf (mut i32) 0)
|
|
|
|
(func $pr_str_val (param $res i32 $mv i32 $print_readably i32) (result i32)
|
|
(LET $type ($TYPE $mv)
|
|
$val0 ($VAL0 $mv)
|
|
$sval 0)
|
|
|
|
;;; switch(type)
|
|
(block $done
|
|
(block $default
|
|
(block (block (block (block (block (block (block (block
|
|
(block (block (block (block (block (block (block (block
|
|
(br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 $type))
|
|
;; 0: nil
|
|
($memmove $res "nil" 4)
|
|
(local.set $res (i32.add 3 $res))
|
|
(br $done))
|
|
;; 1: boolean
|
|
(if (i32.eq $val0 0)
|
|
(then
|
|
;; false
|
|
($memmove $res "false" 6)
|
|
(local.set $res (i32.add 5 $res)))
|
|
(else
|
|
;; true
|
|
($memmove $res "true" 5)
|
|
(local.set $res (i32.add 4 $res))))
|
|
(br $done))
|
|
;; 2: integer
|
|
(local.set $res ($sprintf_1 $res "%d" $val0))
|
|
(br $done))
|
|
;; 3: float/ERROR
|
|
(local.set $res ($sprintf_1 $res "%d" " *** GOT FLOAT *** "))
|
|
(br $done))
|
|
;; 4: string/kw
|
|
(local.set $sval ($to_String $mv))
|
|
(if (i32.eq (i32.load8_u $sval) (CHR "\x7f"))
|
|
(then
|
|
(local.set $res ($sprintf_1 $res ":%s" (i32.add $sval 1))))
|
|
(else (if $print_readably
|
|
(then
|
|
;; escape backslashes, quotes, and newlines
|
|
(local.set $res ($sprintf_1 $res "\"" 0))
|
|
(local.set $res (i32.add $res ($REPLACE3 $res ($to_String $mv)
|
|
"\\" "\\\\"
|
|
"\"" "\\\""
|
|
"\n" "\\n")))
|
|
(local.set $res ($sprintf_1 $res "\"" 0)))
|
|
(else
|
|
(local.set $res ($sprintf_1 $res "%s" $sval))))))
|
|
(br $done))
|
|
;; 5: symbol
|
|
(local.set $res ($sprintf_1 $res "%s" ($to_String $mv)))
|
|
(br $done))
|
|
;; 6: list, fallthrouogh
|
|
)
|
|
;; 7: vector, fallthrough
|
|
)
|
|
;; 8: hashmap
|
|
(local.set
|
|
$res ($sprintf_1 $res "%c"
|
|
(if (result i32) (i32.eq $type (global.get $LIST_T))
|
|
(then (CHR "("))
|
|
(else (if (result i32) (i32.eq $type (global.get $VECTOR_T))
|
|
(then (CHR "["))
|
|
(else (CHR "{")))))))
|
|
;; PR_SEQ_LOOP
|
|
;;; while (VAL0(mv) != 0)
|
|
(block $done_seq
|
|
(loop $seq_loop
|
|
(br_if $done_seq (i32.eq ($VAL0 $mv) 0))
|
|
;;; res = pr_str_val(res, MEM_VAL1(mv), print_readably)
|
|
(local.set $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably))
|
|
|
|
;; if this is a hash-map, print the next element
|
|
(if (i32.eq $type (global.get $HASHMAP_T))
|
|
(then
|
|
;;; res += snprintf(res, 2, " ")
|
|
(local.set $res ($sprintf_1 $res " " 0))
|
|
(local.set $res ($pr_str_val $res ($MEM_VAL2_ptr $mv)
|
|
$print_readably))))
|
|
;;; mv = MEM_VAL0(mv)
|
|
(local.set $mv ($MEM_VAL0_ptr $mv))
|
|
;;; if (VAL0(mv) != 0)
|
|
(if (i32.ne ($VAL0 $mv) 0)
|
|
;;; res += snprintf(res, 2, " ")
|
|
(local.set $res ($sprintf_1 $res " " 0)))
|
|
(br $seq_loop)
|
|
)
|
|
)
|
|
|
|
(local.set
|
|
$res ($sprintf_1 $res "%c"
|
|
(if (result i32) (i32.eq $type (global.get $LIST_T))
|
|
(then (CHR ")"))
|
|
(else (if (result i32) (i32.eq $type (global.get $VECTOR_T))
|
|
(then (CHR "]"))
|
|
(else (CHR "}")))))))
|
|
(br $done))
|
|
;; 9: function
|
|
($memmove $res "#<fn ...>" 10)
|
|
(local.set $res (i32.add 9 $res))
|
|
(br $done))
|
|
;; 10: mal function
|
|
($memmove $res "(fn* " 6)
|
|
(local.set $res (i32.add 5 $res))
|
|
(local.set $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably))
|
|
($memmove $res " " 2)
|
|
(local.set $res (i32.add 1 $res))
|
|
(local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably))
|
|
($memmove $res ")" 2)
|
|
(local.set $res (i32.add 1 $res))
|
|
(br $done))
|
|
;; 11: macro fn
|
|
($memmove $res "#<macro ...>" 13)
|
|
(local.set $res (i32.add 12 $res))
|
|
(br $done))
|
|
;; 12: atom
|
|
($memmove $res "(atom " 7)
|
|
(local.set $res (i32.add 6 $res))
|
|
(local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably))
|
|
($memmove $res ")" 2)
|
|
(local.set $res (i32.add 1 $res))
|
|
(br $done))
|
|
;; 13: environment
|
|
($memmove $res "#<mem ...>" 11)
|
|
(local.set $res (i32.add 10 $res))
|
|
(br $done))
|
|
;; 14: metadata
|
|
;; recur on object itself
|
|
(local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably))
|
|
(br $done))
|
|
;; 15: FREE
|
|
($memmove $res "#<free ...>" 12)
|
|
(local.set $res (i32.add 11 $res))
|
|
(br $done))
|
|
;; 16: default
|
|
($memmove $res "#<unknown>" 11)
|
|
(local.set $res (i32.add 10 $res))
|
|
)
|
|
|
|
$res
|
|
)
|
|
|
|
(func $pr_str_internal (param $seq i32) (param $mv i32)
|
|
(param $print_readably i32) (param $sep i32) (result i32)
|
|
(LET $res ($STRING_INIT (global.get $STRING_T))
|
|
$res_str ($to_String $res))
|
|
|
|
(if $seq
|
|
(then
|
|
(block $done
|
|
(loop $loop
|
|
(br_if $done (i32.eqz ($VAL0 $mv)))
|
|
(local.set $res_str ($pr_str_val $res_str ($MEM_VAL1_ptr $mv) $print_readably))
|
|
(local.set $mv ($MEM_VAL0_ptr $mv))
|
|
(if (i32.ne ($VAL0 $mv) 0)
|
|
(local.set $res_str ($sprintf_1 $res_str "%s" $sep)))
|
|
(br $loop)
|
|
)
|
|
))
|
|
(else
|
|
(local.set $res_str ($pr_str_val $res_str $mv $print_readably))))
|
|
|
|
(local.set $res ($STRING_FINALIZE $res (i32.sub $res_str ($to_String $res))))
|
|
|
|
$res
|
|
)
|
|
|
|
(func $pr_str (param $mv i32 $print_readably i32) (result i32)
|
|
($pr_str_internal 0 $mv $print_readably "")
|
|
)
|
|
|
|
(func $pr_str_seq (param $mv i32 $print_readably i32 $sep i32) (result i32)
|
|
($pr_str_internal 1 $mv $print_readably $sep)
|
|
)
|
|
|
|
(export "pr_str" (func $pr_str))
|
|
|
|
)
|