mirror of
https://github.com/kanaka/mal.git
synced 2024-11-11 00:52:44 +03:00
4aa0ebdf47
Add a step1 test to make sure that implementations are properly throwing an error on unclosed strings. Fix 47 implementations and update the guide to note the correct behavior.
312 lines
11 KiB
Plaintext
312 lines
11 KiB
Plaintext
(module $reader
|
|
|
|
;; TODO: global warning
|
|
(global $token_buf (mut i32) 0)
|
|
(global $read_index (mut i32) 0)
|
|
|
|
(func $skip_spaces (param $str i32) (result i32)
|
|
(LET $found 0
|
|
$c (i32.load8_u (i32.add $str (global.get $read_index))))
|
|
(block $done
|
|
(loop $loop
|
|
;;; while (c == ' ' || c == ',' || c == '\n')
|
|
(br_if $done (AND (i32.ne $c (CHR " "))
|
|
(i32.ne $c (CHR ","))
|
|
(i32.ne $c (CHR "\n"))))
|
|
(local.set $found 1)
|
|
;;; c=str[++(*index)]
|
|
(global.set $read_index (i32.add (global.get $read_index) 1))
|
|
(local.set $c (i32.load8_u (i32.add $str (global.get $read_index))))
|
|
(br $loop)
|
|
)
|
|
)
|
|
;; ($debug ">>> skip_spaces:" $found)
|
|
$found
|
|
)
|
|
|
|
(func $skip_to_eol (param $str i32) (result i32)
|
|
(LET $found 0
|
|
$c (i32.load8_u (i32.add $str (global.get $read_index))))
|
|
(if (i32.eq $c (CHR ";"))
|
|
(then
|
|
(local.set $found 1)
|
|
(block $done
|
|
(loop $loop
|
|
;;; c=str[++(*index)]
|
|
(global.set $read_index (i32.add (global.get $read_index) 1))
|
|
(local.set $c (i32.load8_u (i32.add $str
|
|
(global.get $read_index))))
|
|
;;; while (c != '\0' && c != '\n')
|
|
(br_if $loop (AND (i32.ne $c (CHR "\x00"))
|
|
(i32.ne $c (CHR "\n"))))
|
|
)
|
|
)))
|
|
;; ($debug ">>> skip_to_eol:" $found)
|
|
$found
|
|
)
|
|
|
|
(func $skip_spaces_comments (param $str i32)
|
|
(loop $loop
|
|
;; skip spaces
|
|
(br_if $loop ($skip_spaces $str))
|
|
;; skip comments
|
|
(br_if $loop ($skip_to_eol $str))
|
|
)
|
|
)
|
|
|
|
(func $read_token (param $str i32) (result i32)
|
|
(LET $token_index 0
|
|
$instring 0
|
|
$escaped 0
|
|
$c 0)
|
|
|
|
($skip_spaces_comments $str)
|
|
|
|
;; read first character
|
|
;;; c=str[++(*index)]
|
|
(local.set $c (i32.load8_u (i32.add $str (global.get $read_index))))
|
|
(global.set $read_index (i32.add (global.get $read_index) 1))
|
|
;; read first character
|
|
;;; token[token_index++] = c
|
|
(i32.store8 (i32.add (global.get $token_buf) $token_index) $c)
|
|
(local.set $token_index (i32.add $token_index 1))
|
|
;; single/double character token
|
|
(if (OR (i32.eq $c (CHR "("))
|
|
(i32.eq $c (CHR ")"))
|
|
(i32.eq $c (CHR "["))
|
|
(i32.eq $c (CHR "]"))
|
|
(i32.eq $c (CHR "{"))
|
|
(i32.eq $c (CHR "}"))
|
|
(i32.eq $c (CHR "'"))
|
|
(i32.eq $c (CHR "`"))
|
|
(i32.eq $c (CHR "@"))
|
|
(AND (i32.eq $c (CHR "~"))
|
|
(i32.ne (i32.load8_u (i32.add $str (global.get $read_index)))
|
|
(CHR "@"))))
|
|
|
|
(then
|
|
;; continue
|
|
(nop))
|
|
(else
|
|
;;; if (c == '"') instring = true
|
|
(local.set $instring (i32.eq $c (CHR "\"")))
|
|
(block $done
|
|
(loop $loop
|
|
;; peek at next character
|
|
;;; c = str[*index]
|
|
(local.set $c (i32.load8_u
|
|
(i32.add $str (global.get $read_index))))
|
|
;;; if (c == '\0') break
|
|
(br_if $done (i32.eq $c 0))
|
|
;;; if (!instring)
|
|
(if (i32.eqz $instring)
|
|
(then
|
|
;; next character is token delimiter
|
|
(br_if $done (OR (i32.eq $c (CHR "("))
|
|
(i32.eq $c (CHR ")"))
|
|
(i32.eq $c (CHR "["))
|
|
(i32.eq $c (CHR "]"))
|
|
(i32.eq $c (CHR "{"))
|
|
(i32.eq $c (CHR "}"))
|
|
(i32.eq $c (CHR " "))
|
|
(i32.eq $c (CHR ","))
|
|
(i32.eq $c (CHR "\n"))))))
|
|
;; read next character
|
|
;;; token[token_index++] = str[(*index)++]
|
|
(i32.store8 (i32.add (global.get $token_buf) $token_index)
|
|
(i32.load8_u
|
|
(i32.add $str (global.get $read_index))))
|
|
(local.set $token_index (i32.add $token_index 1))
|
|
(global.set $read_index (i32.add (global.get $read_index) 1))
|
|
;;; if (token[0] == '~' && token[1] == '@') break
|
|
(br_if $done (AND (i32.eq (i32.load8_u
|
|
(i32.add (global.get $token_buf) 0))
|
|
(CHR "~"))
|
|
(i32.eq (i32.load8_u
|
|
(i32.add (global.get $token_buf) 1))
|
|
(CHR "@"))))
|
|
|
|
;;; if ((!instring) || escaped)
|
|
(if (OR (i32.eqz $instring) $escaped)
|
|
(then
|
|
(local.set $escaped 0)
|
|
(br $loop)))
|
|
(if (i32.eq $c (CHR "\\"))
|
|
(local.set $escaped 1))
|
|
(br_if $done (i32.eq $c (CHR "\"")))
|
|
(br $loop)
|
|
)
|
|
)))
|
|
|
|
;;; token[token_index] = '\0'
|
|
(i32.store8 (i32.add (global.get $token_buf) $token_index) 0)
|
|
(global.get $token_buf)
|
|
)
|
|
|
|
(func $read_seq (param $str i32 $type i32 $end i32) (result i32)
|
|
(LET $res ($MAP_LOOP_START $type)
|
|
$val2 0
|
|
$val3 0
|
|
$c 0
|
|
;; MAP_LOOP stack
|
|
$ret $res
|
|
$empty $res
|
|
$current $res)
|
|
|
|
;; READ_SEQ_LOOP
|
|
(block $done
|
|
(loop $loop
|
|
($skip_spaces_comments $str)
|
|
|
|
;; peek at next character
|
|
;;; c = str[*index]
|
|
(local.set $c (i32.load8_u (i32.add $str (global.get $read_index))))
|
|
(if (i32.eq $c (CHR "\x00"))
|
|
(then
|
|
($THROW_STR_0 "unexpected EOF")
|
|
(br $done)))
|
|
(if (i32.eq $c $end)
|
|
(then
|
|
;; read next character
|
|
;;; c = str[(*index)++]
|
|
(local.set $c (i32.load8_u (i32.add $str (global.get $read_index))))
|
|
(global.set $read_index (i32.add (global.get $read_index) 1))
|
|
(br $done)))
|
|
|
|
;; value (or key for hash-maps)
|
|
(local.set $val2 ($read_form $str))
|
|
|
|
;; if error, release the unattached element
|
|
(if (global.get $error_type)
|
|
(then
|
|
($RELEASE $val2)
|
|
(br $done)))
|
|
|
|
;; if this is a hash-map, READ_FORM again
|
|
(if (i32.eq $type (global.get $HASHMAP_T))
|
|
(local.set $val3 ($read_form $str)))
|
|
|
|
;; update the return sequence structure
|
|
;; MAP_LOOP_UPDATE
|
|
(local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3))
|
|
(if (i32.le_u $current (global.get $EMPTY_HASHMAP))
|
|
;; if first element, set return to new element
|
|
(local.set $ret $res))
|
|
;; update current to point to new element
|
|
(local.set $current $res)
|
|
|
|
(br $loop)
|
|
)
|
|
)
|
|
|
|
;; MAP_LOOP_DONE
|
|
$ret
|
|
)
|
|
|
|
(func $read_macro (param $str i32 $sym i32 $with_meta i32) (result i32)
|
|
(LET $first ($STRING (global.get $SYMBOL_T) $sym)
|
|
$second ($read_form $str)
|
|
$third 0
|
|
$res $second)
|
|
(if (global.get $error_type) (return $res))
|
|
(if (i32.eqz $with_meta)
|
|
(then
|
|
(local.set $res ($LIST2 $first $second)))
|
|
(else
|
|
(local.set $third ($read_form $str))
|
|
(local.set $res ($LIST3 $first $third $second))
|
|
;; release values, list has ownership
|
|
($RELEASE $third)))
|
|
;; release values, list has ownership
|
|
($RELEASE $second)
|
|
($RELEASE $first)
|
|
$res
|
|
)
|
|
|
|
(func $read_form (param $str i32) (result i32)
|
|
(LET $tok 0 $c0 0 $c1 0 $res 0 $slen 0)
|
|
|
|
(if (global.get $error_type) (return 0))
|
|
|
|
(local.set $tok ($read_token $str))
|
|
;;($printf_1 ">>> read_form 1: %s\n" $tok)
|
|
;;; c0 = token[0]
|
|
(local.set $c0 (i32.load8_u $tok))
|
|
(local.set $c1 (i32.load8_u (i32.add $tok 1)))
|
|
|
|
(if (i32.eq $c0 0)
|
|
(then
|
|
(return ($INC_REF (global.get $NIL))))
|
|
(else (if (OR (AND (i32.ge_u $c0 (CHR "0"))
|
|
(i32.le_u $c0 (CHR "9")))
|
|
(AND (i32.eq $c0 (CHR "-"))
|
|
(i32.ge_u $c1 (CHR "0"))
|
|
(i32.le_u $c1 (CHR "9"))))
|
|
(then
|
|
(return ($INTEGER ($atoi $tok))))
|
|
(else (if (i32.eq $c0 (CHR ":"))
|
|
(then
|
|
(i32.store8 $tok (CHR "\x7f"))
|
|
(return ($STRING (global.get $STRING_T) $tok)))
|
|
(else (if (i32.eq $c0 (CHR "\""))
|
|
(then
|
|
(local.set $slen ($strlen (i32.add $tok 1)))
|
|
(if (i32.ne (i32.load8_u (i32.add $tok $slen)) (CHR "\""))
|
|
(then
|
|
($THROW_STR_0 "expected '\"', got EOF")
|
|
(return 0))
|
|
(else
|
|
;; unescape backslashes, quotes, and newlines
|
|
;; remove the trailing quote
|
|
(i32.store8 (i32.add $tok $slen) (CHR "\x00"))
|
|
(local.set $tok (i32.add $tok 1))
|
|
(drop ($REPLACE3 0 $tok
|
|
"\\\"" "\""
|
|
"\\n" "\n"
|
|
"\\\\" "\\"))
|
|
(return ($STRING (global.get $STRING_T) $tok)))))
|
|
(else (if (i32.eqz ($strcmp "nil" $tok))
|
|
(then (return ($INC_REF (global.get $NIL))))
|
|
(else (if (i32.eqz ($strcmp "false" $tok))
|
|
(then (return ($INC_REF (global.get $FALSE))))
|
|
(else (if (i32.eqz ($strcmp "true" $tok))
|
|
(then (return ($INC_REF (global.get $TRUE))))
|
|
(else (if (i32.eqz ($strcmp "'" $tok))
|
|
(then (return ($read_macro $str "quote" 0)))
|
|
(else (if (i32.eqz ($strcmp "`" $tok))
|
|
(then (return ($read_macro $str "quasiquote" 0)))
|
|
(else (if (i32.eqz ($strcmp "~@" $tok))
|
|
(then (return ($read_macro $str "splice-unquote" 0)))
|
|
(else (if (i32.eqz ($strcmp "~" $tok))
|
|
(then (return ($read_macro $str "unquote" 0)))
|
|
(else (if (i32.eqz ($strcmp "^" $tok))
|
|
(then (return ($read_macro $str "with-meta" 1)))
|
|
(else (if (i32.eqz ($strcmp "@" $tok))
|
|
(then (return ($read_macro $str "deref" 0)))
|
|
(else (if (i32.eq $c0 (CHR "("))
|
|
(then (return ($read_seq $str (global.get $LIST_T) (CHR ")"))))
|
|
(else (if (i32.eq $c0 (CHR "["))
|
|
(then (return ($read_seq $str (global.get $VECTOR_T) (CHR "]"))))
|
|
(else (if (i32.eq $c0 (CHR "{"))
|
|
(then (return ($read_seq $str (global.get $HASHMAP_T) (CHR "}"))))
|
|
(else (if (OR (i32.eq $c0 (CHR ")"))
|
|
(i32.eq $c0 (CHR "]"))
|
|
(i32.eq $c0 (CHR "}")))
|
|
(then
|
|
($THROW_STR_1 "unexpected '%c'" $c0)
|
|
(return 0))
|
|
(else
|
|
(return ($STRING (global.get $SYMBOL_T) $tok))))
|
|
))))))))))))))))))))))))))))))))
|
|
0 ;; not reachable
|
|
)
|
|
|
|
(func $read_str (param $str i32) (result i32)
|
|
(global.set $read_index 0)
|
|
($read_form $str)
|
|
)
|
|
|
|
(export "read_str" (func $read_str))
|
|
|
|
)
|