wasm/reader.wam

   1 (module $reader
   2
   3   ;; TODO: global warning
   4   (global $token_buf   (mut i32) 0)
   5   (global $read_index  (mut i32) 0)
   6
   7   (func $skip_spaces (param $str i32) (result i32)
   8     (LET $found 0
   9          $c (i32.load8_u (i32.add $str (global.get $read_index))))
  10     (block $done
  11       (loop $loop
  12         ;;; while (c == ' ' || c == ',' || c == '\n')
  13         (br_if $done (AND (i32.ne $c (CHR " "))
  14                           (i32.ne $c (CHR ","))
  15                           (i32.ne $c (CHR "\n"))))
  16         (local.set $found 1)
  17         ;;; c=str[++(*index)]
  18         (global.set $read_index (i32.add (global.get $read_index) 1))
  19         (local.set $c (i32.load8_u (i32.add $str (global.get $read_index))))
  20         (br $loop)
  21       )
  22     )
  23 ;;    ($debug ">>> skip_spaces:" $found)
  24     $found
  25   )
  26
  27   (func $skip_to_eol (param $str i32) (result i32)
  28     (LET $found 0
  29          $c (i32.load8_u (i32.add $str (global.get $read_index))))
  30     (if (i32.eq $c (CHR ";"))
  31       (then
  32         (local.set $found 1)
  33         (block $done
  34           (loop $loop
  35             ;;; c=str[++(*index)]
  36             (global.set $read_index (i32.add (global.get $read_index) 1))
  37             (local.set $c (i32.load8_u (i32.add $str
  38                                                 (global.get $read_index))))
  39             ;;; while (c != '\0' && c != '\n')
  40             (br_if $loop (AND (i32.ne $c (CHR "\x00"))
  41                               (i32.ne $c (CHR "\n"))))
  42           )
  43         )))
  44 ;;    ($debug ">>> skip_to_eol:" $found)
  45     $found
  46   )
  47
  48   (func $skip_spaces_comments (param $str i32)
  49     (loop $loop
  50       ;; skip spaces
  51       (br_if $loop ($skip_spaces $str))
  52       ;; skip comments
  53       (br_if $loop ($skip_to_eol $str))
  54     )
  55   )
  56
  57   (func $read_token (param $str i32) (result i32)
  58     (LET $token_index 0
  59          $isstring    0
  60          $instring    0
  61          $escaped     0
  62          $c           0)
  63
  64     ($skip_spaces_comments $str)
  65
  66     ;; read first character
  67     ;;; c=str[++(*index)]
  68     (local.set $c (i32.load8_u (i32.add $str (global.get $read_index))))
  69     (global.set $read_index (i32.add (global.get $read_index) 1))
  70     ;; read first character
  71     ;;; token[token_index++] = c
  72     (i32.store8 (i32.add (global.get $token_buf) $token_index) $c)
  73     (local.set $token_index (i32.add $token_index 1))
  74     ;; single/double character token
  75     (if (OR (i32.eq $c (CHR "("))
  76             (i32.eq $c (CHR ")"))
  77             (i32.eq $c (CHR "["))
  78             (i32.eq $c (CHR "]"))
  79             (i32.eq $c (CHR "{"))
  80             (i32.eq $c (CHR "}"))
  81             (i32.eq $c (CHR "'"))
  82             (i32.eq $c (CHR "`"))
  83             (i32.eq $c (CHR "@"))
  84             (AND (i32.eq $c (CHR "~"))
  85                  (i32.ne (i32.load8_u (i32.add $str (global.get $read_index)))
  86                          (CHR "@"))))
  87
  88       (then
  89         ;; continue
  90         (nop))
  91       (else
  92         ;;; if (c == '"') isstring = true
  93         (local.set $isstring (i32.eq $c (CHR "\"")))
  94         (local.set $instring $isstring)
  95         (block $done
  96           (loop $loop
  97             ;; peek at next character
  98             ;;; c = str[*index]
  99             (local.set $c (i32.load8_u
 100                             (i32.add $str (global.get $read_index))))
 101             ;;; if (c == '\0') break
 102             (br_if $done (i32.eq $c 0))
 103             ;;; if (!isstring)
 104             (if (i32.eqz $isstring)
 105               (then
 106                 ;; next character is token delimiter
 107                 (br_if $done (OR (i32.eq $c (CHR "("))
 108                                  (i32.eq $c (CHR ")"))
 109                                  (i32.eq $c (CHR "["))
 110                                  (i32.eq $c (CHR "]"))
 111                                  (i32.eq $c (CHR "{"))
 112                                  (i32.eq $c (CHR "}"))
 113                                  (i32.eq $c (CHR " "))
 114                                  (i32.eq $c (CHR ","))
 115                                  (i32.eq $c (CHR "\n"))))))
 116             ;; read next character
 117             ;;; token[token_index++] = str[(*index)++]
 118             (i32.store8 (i32.add (global.get $token_buf) $token_index)
 119                           (i32.load8_u
 120                             (i32.add $str (global.get $read_index))))
 121             (local.set $token_index (i32.add $token_index 1))
 122             (global.set $read_index (i32.add (global.get $read_index) 1))
 123             ;;; if (token[0] == '~' && token[1] == '@') break
 124             (br_if $done (AND (i32.eq (i32.load8_u
 125                                         (i32.add (global.get $token_buf) 0))
 126                                       (CHR "~"))
 127                               (i32.eq (i32.load8_u
 128                                         (i32.add (global.get $token_buf) 1))
 129                                       (CHR "@"))))
 130
 131             ;;; if ((!isstring) || escaped)
 132             (if (OR (i32.eqz $isstring) $escaped)
 133               (then
 134                 (local.set $escaped 0)
 135                 (br $loop)))
 136             (if (i32.eq $c (CHR "\\"))
 137               (local.set $escaped 1))
 138             (if (i32.eq $c (CHR "\""))
 139               (then
 140                 (local.set $instring 0)
 141                 (br $done)))
 142             (br $loop)
 143           )
 144         )
 145
 146         (if (AND $isstring $instring)
 147           (then
 148             ($THROW_STR_0 "expected '\"', got EOF")
 149             (return 0)))))
 150
 151     ;;; token[token_index] = '\0'
 152     (i32.store8 (i32.add (global.get $token_buf) $token_index) 0)
 153     (global.get $token_buf)
 154   )
 155
 156   (func $read_seq (param $str i32 $type i32 $end i32) (result i32)
 157     (LET $res ($MAP_LOOP_START $type)
 158          $val2 0
 159          $val3 0
 160          $c 0
 161          ;; MAP_LOOP stack
 162          $ret $res
 163          $empty $res
 164          $current $res)
 165
 166     ;; READ_SEQ_LOOP
 167     (block $done
 168       (loop $loop
 169         ($skip_spaces_comments $str)
 170
 171         ;; peek at next character
 172         ;;; c = str[*index]
 173         (local.set $c (i32.load8_u (i32.add $str (global.get $read_index))))
 174         (if (i32.eq $c (CHR "\x00"))
 175           (then
 176             ($THROW_STR_0 "unexpected EOF")
 177             (br $done)))
 178         (if (i32.eq $c $end)
 179           (then
 180             ;; read next character
 181             ;;; c = str[(*index)++]
 182             (local.set $c (i32.load8_u (i32.add $str (global.get $read_index))))
 183             (global.set $read_index (i32.add (global.get $read_index) 1))
 184             (br $done)))
 185
 186         ;; value (or key for hash-maps)
 187         (local.set $val2 ($read_form $str))
 188
 189         ;; if error, release the unattached element
 190         (if (global.get $error_type)
 191           (then
 192             ($RELEASE $val2)
 193             (br $done)))
 194
 195         ;; if this is a hash-map, READ_FORM again
 196         (if (i32.eq $type (global.get $HASHMAP_T))
 197           (local.set $val3 ($read_form $str)))
 198
 199         ;; update the return sequence structure
 200         ;; MAP_LOOP_UPDATE
 201         (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3))
 202         (if (i32.le_u $current (global.get $EMPTY_HASHMAP))
 203           ;; if first element, set return to new element
 204           (local.set $ret $res))
 205         ;; update current to point to new element
 206         (local.set $current $res)
 207
 208         (br $loop)
 209       )
 210     )
 211
 212     ;; MAP_LOOP_DONE
 213     $ret
 214   )
 215
 216   (func $read_macro (param $str i32 $sym i32 $with_meta i32) (result i32)
 217     (LET $first ($STRING (global.get $SYMBOL_T) $sym)
 218          $second ($read_form $str)
 219          $third 0
 220          $res $second)
 221     (if (global.get $error_type) (return $res))
 222     (if (i32.eqz $with_meta)
 223       (then
 224         (local.set $res ($LIST2 $first $second)))
 225       (else
 226         (local.set $third ($read_form $str))
 227         (local.set $res ($LIST3 $first $third $second))
 228         ;; release values, list has ownership
 229         ($RELEASE $third)))
 230     ;; release values, list has ownership
 231     ($RELEASE $second)
 232     ($RELEASE $first)
 233     $res
 234   )
 235
 236   (func $read_form (param $str i32) (result i32)
 237     (LET $tok 0 $c0 0 $c1 0 $res 0 $slen 0)
 238
 239     (if (global.get $error_type) (return 0))
 240
 241     (local.set $tok ($read_token $str))
 242
 243     (if (global.get $error_type) (return 0))
 244     ;;($printf_1 ">>> read_form 1: %s\n" $tok)
 245     ;;; c0 = token[0]
 246     (local.set $c0 (i32.load8_u $tok))
 247     (local.set $c1 (i32.load8_u (i32.add $tok 1)))
 248
 249     (if (i32.eq $c0 0)
 250       (then
 251         (return ($INC_REF (global.get $NIL))))
 252       (else (if (OR (AND (i32.ge_u $c0 (CHR "0"))
 253                          (i32.le_u $c0 (CHR "9")))
 254                     (AND (i32.eq $c0 (CHR "-"))
 255                          (i32.ge_u $c1 (CHR "0"))
 256                          (i32.le_u $c1 (CHR "9"))))
 257       (then
 258         (return ($INTEGER ($atoi $tok))))
 259     (else (if (i32.eq $c0 (CHR ":"))
 260       (then
 261         (i32.store8 $tok (CHR "\x7f"))
 262         (return ($STRING (global.get $STRING_T) $tok)))
 263     (else (if (i32.eq $c0 (CHR "\""))
 264       (then
 265         (local.set $slen ($strlen (i32.add $tok 1)))
 266         (if (i32.ne (i32.load8_u (i32.add $tok $slen)) (CHR "\""))
 267           (then
 268             ($THROW_STR_0 "expected '\"', got EOF")
 269             (return 0))
 270           (else
 271             ;; unescape backslashes, quotes, and newlines
 272             ;; remove the trailing quote
 273             (i32.store8 (i32.add $tok $slen) (CHR "\x00"))
 274             (local.set $tok (i32.add $tok 1))
 275             (drop ($REPLACE3 0 $tok
 276                              "\\\"" "\""
 277                              "\\n" "\n"
 278                              "\\\\" "\\"))
 279             (return ($STRING (global.get $STRING_T) $tok)))))
 280     (else (if (i32.eqz ($strcmp "nil" $tok))
 281       (then (return ($INC_REF (global.get $NIL))))
 282     (else (if (i32.eqz ($strcmp "false" $tok))
 283       (then (return ($INC_REF (global.get $FALSE))))
 284     (else (if (i32.eqz ($strcmp "true" $tok))
 285       (then (return ($INC_REF (global.get $TRUE))))
 286     (else (if (i32.eqz ($strcmp "'" $tok))
 287       (then (return ($read_macro $str "quote" 0)))
 288     (else (if (i32.eqz ($strcmp "`" $tok))
 289       (then (return ($read_macro $str "quasiquote" 0)))
 290     (else (if (i32.eqz ($strcmp "~@" $tok))
 291       (then (return ($read_macro $str "splice-unquote" 0)))
 292     (else (if (i32.eqz ($strcmp "~" $tok))
 293       (then (return ($read_macro $str "unquote" 0)))
 294     (else (if (i32.eqz ($strcmp "^" $tok))
 295       (then (return ($read_macro $str "with-meta" 1)))
 296     (else (if (i32.eqz ($strcmp "@" $tok))
 297       (then (return ($read_macro $str "deref" 0)))
 298     (else (if (i32.eq $c0 (CHR "("))
 299       (then (return ($read_seq $str (global.get $LIST_T) (CHR ")"))))
 300     (else (if (i32.eq $c0 (CHR "["))
 301       (then (return ($read_seq $str (global.get $VECTOR_T) (CHR "]"))))
 302     (else (if (i32.eq $c0 (CHR "{"))
 303       (then (return ($read_seq $str (global.get $HASHMAP_T) (CHR "}"))))
 304     (else (if (OR (i32.eq $c0 (CHR ")"))
 305                   (i32.eq $c0 (CHR "]"))
 306                   (i32.eq $c0 (CHR "}")))
 307       (then
 308         ($THROW_STR_1 "unexpected '%c'" $c0)
 309         (return 0))
 310     (else
 311       (return ($STRING (global.get $SYMBOL_T) $tok))))
 312     ))))))))))))))))))))))))))))))))
 313     0 ;; not reachable
 314   )
 315
 316   (func $read_str (param $str i32) (result i32)
 317     (global.set $read_index 0)
 318     ($read_form $str)
 319   )
 320
 321   (export "read_str" (func $read_str))
 322
 323 )