ocaml: rewrite the reader

A reference for the only mutable part reduces the boilerplate.
A separate tokenizer is not necessary for S-expressions.

Author: asarhaddon

impls/ocaml/reader.ml

@@ -1,115 +1,65 @@
-module T = Types.Types
-(* ^file ^module *)
+open Str (* not reentrant, but simple and always available *)
+open Types
 
-let find_re re str =
-  List.map
-    (function Str.Delim x -> x | Str.Text x -> "impossible!")
-    (List.filter
-       (function Str.Delim x -> true | Str.Text x -> false)
-       (Str.full_split re str))
+let separator_re = regexp "\\([, \t\n]\\|;[^\n]*\\)+"
+let number_re = regexp "-?[0-9]+"
+let chars = "[^][, \t\n;(){}'`~@^\"]+"
+let keyword_re = regexp (":\\(" ^ chars ^ "\\)")
+let symbol_re = regexp chars
+let string_re = regexp {|"\(\(\\[\\n"]\|[^\\"]\)*\)"|}
+let escape_re = regexp {|\\.|}
+let quote_re = regexp_string "'"
+let quasiquote_re = regexp_string "`"
+let deref_re = regexp_string "@"
+let unquote_re = regexp_string "~"
+let sp_unq_re = regexp_string "~@"
+let with_meta_re = regexp_string "^"
+let list_re = regexp_string "("
+let map_re = regexp_string "{"
+let vector_re = regexp_string "["
+let close_re = regexp "[])}]" (* so "[1 2)" is accepted as a vector *)
 
-let gsub re f str =
-  String.concat ""
-    (List.map
-       (function Str.Delim x -> f x | Str.Text x -> x)
-       (Str.full_split re str))
-
-let token_re =
-  Str.regexp
-    "~@\\|[][{}()'`~^@]\\|\"\\(\\\\.\\|[^\"]\\)*\"?\\|;.*\\|[^][  \n\
-     {}('\"`,;)]*"
-
-let string_re = Str.regexp "\"\\(\\\\.\\|[^\\\\\"]\\)*\""
-
-type reader = { form : Types.mal_type; tokens : string list }
-type list_reader = { list_form : Types.mal_type list; tokens : string list }
-
-let unescape_string token =
-  if Str.string_match string_re token 0 then
-    let without_quotes = String.sub token 1 (String.length token - 2) in
-    gsub (Str.regexp "\\\\.")
-      (function "\\n" -> "\n" | x -> String.sub x 1 1)
-      without_quotes
-  else raise (Invalid_argument "expected '\"', got EOF")
-
-let read_atom token =
-  match token with
-  | "nil" -> T.Nil
-  | "true" -> T.Bool true
-  | "false" -> T.Bool false
-  | _ -> (
-      match token.[0] with
-      | '0' .. '9' -> T.Int (int_of_string token)
-      | '-' -> (
-          match String.length token with
-          | 1 -> T.Symbol token
-          | _ -> (
-              match token.[1] with
-              | '0' .. '9' -> T.Int (int_of_string token)
-              | _ -> T.Symbol token))
-      | '"' -> T.String (unescape_string token)
-      | ':' -> T.Keyword (Str.replace_first (Str.regexp "^:") "" token)
-      | _ -> T.Symbol token)
-
-let rec read_list eol list_reader =
-  match list_reader.tokens with
-  | [] ->
-      raise (Invalid_argument (Format.asprintf "expected '%s', got EOF" eol))
-  | token :: tokens ->
-      if Str.string_match (Str.regexp eol) token 0 then
-        { list_form = list_reader.list_form; tokens }
-      else if token.[0] = ';' then
-        read_list eol { list_form = list_reader.list_form; tokens }
-      else
-        let reader = read_form list_reader.tokens in
-        read_list eol
-          {
-            list_form = list_reader.list_form @ [ reader.form ];
-            tokens = reader.tokens;
-          }
-
-and read_quote sym tokens =
-  let reader = read_form tokens in
-  { form = Types.list [ T.Symbol sym; reader.form ]; tokens = reader.tokens }
-
-and read_form all_tokens =
-  match all_tokens with
-  | [] -> raise (Invalid_argument "no form found in the given string")
-  | token :: tokens -> (
-      match token with
-      | "'" -> read_quote "quote" tokens
-      | "`" -> read_quote "quasiquote" tokens
-      | "~" -> read_quote "unquote" tokens
-      | "~@" -> read_quote "splice-unquote" tokens
-      | "@" -> read_quote "deref" tokens
-      | "^" ->
-          let meta = read_form tokens in
-          let value = read_form meta.tokens in
-          {
-            form = Types.list [ T.Symbol "with-meta"; value.form; meta.form ];
-            tokens = value.tokens;
-          }
-      | "(" ->
-          let list_reader = read_list ")" { list_form = []; tokens } in
-          {
-            form = Types.list list_reader.list_form;
-            tokens = list_reader.tokens;
-          }
-      | "{" ->
-          let list_reader = read_list "}" { list_form = []; tokens } in
-          {
-            form = Types.list_into_map Types.MalMap.empty list_reader.list_form;
-            tokens = list_reader.tokens;
-          }
-      | "[" ->
-          let list_reader = read_list "]" { list_form = []; tokens } in
-          {
-            form = Types.vector list_reader.list_form;
-            tokens = list_reader.tokens;
-          }
-      | _ ->
-          if token.[0] = ';' then read_form tokens
-          else { form = read_atom token; tokens })
+let unescape str =
+  let e = match_end () - 1 in
+  if str.[e] == 'n' then "\n" else String.sub str e 1
 
 let read_str str =
-  (read_form (List.filter (( <> ) "") (find_re token_re str))).form
+  (* !p is the currently parsed position inside str *)
+  let rec read pattern p =
+    let result = string_match pattern str !p in
+    if result then p := match_end ();
+    result
+  and read_list p =
+    ignore (read separator_re p);
+    if read close_re p then []
+    else
+      (* Parse the first form before the rest of the list *)
+      let first = read_form p in
+      first :: read_list p
+  and read_form p =
+    ignore (read separator_re p);
+    if read number_re p then Types.Int (int_of_string (matched_string str))
+    else if read keyword_re p then Keyword (matched_group 1 str)
+    else if read symbol_re p then
+      match matched_string str with
+      | "nil" -> Nil
+      | "true" -> Bool true
+      | "false" -> Bool false
+      | t -> Symbol t
+    else if read string_re p then
+      String (global_substitute escape_re unescape (matched_group 1 str))
+    else if read quote_re p then list [ Symbol "quote"; read_form p ]
+    else if read quasiquote_re p then list [ Symbol "quasiquote"; read_form p ]
+    else if read deref_re p then list [ Symbol "deref"; read_form p ]
+    else if read sp_unq_re p then list [ Symbol "splice-unquote"; read_form p ]
+    else if read unquote_re p then list [ Symbol "unquote"; read_form p ]
+    else if read with_meta_re p then
+      (* Parse the metadata before the value *)
+      let meta = read_form p in
+      list [ Symbol "with-meta"; read_form p; meta ]
+    else if read list_re p then list (read_list p)
+    else if read vector_re p then vector (read_list p)
+    else if read map_re p then list_into_map MalMap.empty (read_list p)
+    else raise (Invalid_argument "unexpected EOF ] } ) or string escape")
+  in
+  read_form (ref 0)