wasm/printer.wam

   1 (module $printer
   2
   3   (global $printer_buf   (mut i32) 0)
   4
   5   (func $pr_str_val (param $res i32 $mv i32 $print_readably i32) (result i32)
   6     (LET $type ($TYPE $mv)
   7          $val0 ($VAL0 $mv)
   8          $sval 0)
   9
  10     ;;; switch(type)
  11     (block $done
  12       (block $default
  13       (block (block (block (block (block (block (block (block
  14       (block (block (block (block (block (block (block (block
  15       (br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 $type))
  16       ;; 0: nil
  17       ($memmove $res "nil" 4)
  18       (local.set $res (i32.add 3 $res))
  19       (br $done))
  20       ;; 1: boolean
  21       (if (i32.eq $val0 0)
  22         (then
  23           ;; false
  24           ($memmove $res "false" 6)
  25           (local.set $res (i32.add 5 $res)))
  26         (else
  27           ;; true
  28           ($memmove $res "true" 5)
  29           (local.set $res (i32.add 4 $res))))
  30       (br $done))
  31       ;; 2: integer
  32       (local.set $res ($sprintf_1 $res "%d" $val0))
  33       (br $done))
  34       ;; 3: float/ERROR
  35       (local.set $res ($sprintf_1 $res "%d" " *** GOT FLOAT *** "))
  36       (br $done))
  37       ;; 4: string/kw
  38       (local.set $sval ($to_String $mv))
  39       (if (i32.eq (i32.load8_u $sval) (CHR "\x7f"))
  40         (then
  41           (local.set $res ($sprintf_1 $res ":%s" (i32.add $sval 1))))
  42       (else (if $print_readably
  43         (then
  44           ;; escape backslashes, quotes, and newlines
  45           (local.set $res ($sprintf_1 $res "\"" 0))
  46           (local.set $res (i32.add $res ($REPLACE3 $res ($to_String $mv)
  47                                                    "\\" "\\\\"
  48                                                    "\"" "\\\""
  49                                                    "\n" "\\n")))
  50           (local.set $res ($sprintf_1 $res "\"" 0)))
  51       (else
  52         (local.set $res ($sprintf_1 $res "%s" $sval))))))
  53       (br $done))
  54       ;; 5: symbol
  55       (local.set $res ($sprintf_1 $res "%s" ($to_String $mv)))
  56       (br $done))
  57       ;; 6: list, fallthrouogh
  58       )
  59       ;; 7: vector, fallthrough
  60       )
  61       ;; 8: hashmap
  62       (local.set
  63         $res ($sprintf_1 $res "%c"
  64                          (if (result i32) (i32.eq $type (global.get $LIST_T))
  65                            (then (CHR "("))
  66                            (else (if (result i32) (i32.eq $type (global.get $VECTOR_T))
  67                                    (then (CHR "["))
  68                                    (else (CHR "{")))))))
  69       ;; PR_SEQ_LOOP
  70       ;;; while (VAL0(mv) != 0)
  71       (block $done_seq
  72         (loop $seq_loop
  73           (br_if $done_seq (i32.eq ($VAL0 $mv) 0))
  74           ;;; res = pr_str_val(res, MEM_VAL1(mv), print_readably)
  75           (local.set $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably))
  76
  77           ;; if this is a hash-map, print the next element
  78           (if (i32.eq $type (global.get $HASHMAP_T))
  79             (then
  80               ;;; res += snprintf(res, 2, " ")
  81               (local.set $res ($sprintf_1 $res " " 0))
  82               (local.set $res ($pr_str_val $res ($MEM_VAL2_ptr $mv)
  83                                            $print_readably))))
  84           ;;; mv = MEM_VAL0(mv)
  85           (local.set $mv ($MEM_VAL0_ptr $mv))
  86           ;;; if (VAL0(mv) != 0)
  87           (if (i32.ne ($VAL0 $mv) 0)
  88             ;;; res += snprintf(res, 2, " ")
  89             (local.set $res ($sprintf_1 $res " " 0)))
  90           (br $seq_loop)
  91         )
  92       )
  93
  94       (local.set
  95         $res ($sprintf_1 $res "%c"
  96                          (if (result i32) (i32.eq $type (global.get $LIST_T))
  97                            (then (CHR ")"))
  98                            (else (if (result i32) (i32.eq $type (global.get $VECTOR_T))
  99                                    (then (CHR "]"))
 100                                    (else (CHR "}")))))))
 101       (br $done))
 102       ;; 9: function
 103       ($memmove $res "#<fn ...>" 10)
 104       (local.set $res (i32.add 9 $res))
 105       (br $done))
 106       ;; 10: mal function
 107       ($memmove $res "(fn* " 6)
 108       (local.set $res (i32.add 5 $res))
 109       (local.set $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably))
 110       ($memmove $res " " 2)
 111       (local.set $res (i32.add 1 $res))
 112       (local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably))
 113       ($memmove $res ")" 2)
 114       (local.set $res (i32.add 1 $res))
 115       (br $done))
 116       ;; 11: macro fn
 117       ($memmove $res "#<macro ...>" 13)
 118       (local.set $res (i32.add 12 $res))
 119       (br $done))
 120       ;; 12: atom
 121       ($memmove $res "(atom " 7)
 122       (local.set $res (i32.add 6 $res))
 123       (local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably))
 124       ($memmove $res ")" 2)
 125       (local.set $res (i32.add 1 $res))
 126       (br $done))
 127       ;; 13: environment
 128       ($memmove $res "#<mem ...>" 11)
 129       (local.set $res (i32.add 10 $res))
 130       (br $done))
 131       ;; 14: metadata
 132       ;; recur on object itself
 133       (local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably))
 134       (br $done))
 135       ;; 15: FREE
 136       ($memmove $res "#<free ...>" 12)
 137       (local.set $res (i32.add 11 $res))
 138       (br $done))
 139       ;; 16: default
 140       ($memmove $res "#<unknown>" 11)
 141       (local.set $res (i32.add 10 $res))
 142     )
 143
 144     $res
 145   )
 146
 147   (func $pr_str_internal (param $seq i32) (param $mv i32)
 148         (param $print_readably i32) (param $sep i32) (result i32)
 149     (LET $res     ($STRING_INIT (global.get $STRING_T))
 150          $res_str ($to_String $res))
 151
 152     (if $seq
 153       (then
 154         (block $done
 155           (loop $loop
 156             (br_if $done (i32.eqz ($VAL0 $mv)))
 157             (local.set $res_str ($pr_str_val $res_str ($MEM_VAL1_ptr $mv) $print_readably))
 158             (local.set $mv ($MEM_VAL0_ptr $mv))
 159             (if (i32.ne ($VAL0 $mv) 0)
 160               (local.set $res_str ($sprintf_1 $res_str "%s" $sep)))
 161             (br $loop)
 162           )
 163         ))
 164       (else
 165         (local.set $res_str ($pr_str_val $res_str $mv $print_readably))))
 166
 167     (local.set $res ($STRING_FINALIZE $res (i32.sub $res_str ($to_String $res))))
 168
 169     $res
 170   )
 171
 172   (func $pr_str (param $mv i32 $print_readably i32) (result i32)
 173     ($pr_str_internal 0 $mv $print_readably "")
 174   )
 175
 176   (func $pr_str_seq (param $mv i32 $print_readably i32 $sep i32) (result i32)
 177     ($pr_str_internal 1 $mv $print_readably $sep)
 178   )
 179
 180   (export "pr_str" (func $pr_str))
 181
 182 )