Ocaml: style

impls/ocaml/Makefile

@@ -32,4 +32,6 @@ $(STEP_BINS): %: %.ml $(MAL_LIB)
 clean:
 	rm -f $(STEP_BINS) mal mal_lib.* *.cmo *.cmx *.cmi *.o
 
-.PHONY: all repl clean
+format:
+	ocamlformat --inplace --enable-outside-detected-project *.ml
+.PHONY: all repl clean format

impls/ocaml/env.ml

@@ -1,19 +1,12 @@
 module T = Types.Types
 module Data = Map.Make (String)
 
-type env = {
-  outer : env option;
-  data : Types.mal_type Data.t ref;
-}
+type env = { outer : env option; data : Types.mal_type Data.t ref }
 
-let make outer = { outer = outer; data = ref Data.empty }
-
-let set env key value =
-  env.data := Data.add key value !(env.data)
+let make outer = { outer; data = ref Data.empty }
+let set env key value = env.data := Data.add key value !(env.data)
 
 let rec get env key =
   match Data.find_opt key !(env.data) with
-    | Some _ as v -> v
-    | None       -> match env.outer with
-      | Some outer -> get outer key
-      | None       -> None
+  | Some _ as v -> v
+  | None -> ( match env.outer with Some outer -> get outer key | None -> None)

impls/ocaml/printer.ml

@@ -1,39 +1,41 @@
 open Format
-
 module T = Types.Types
 
 (* Compile the regex once and for all *)
 let _pr_escape_re = Str.regexp "\\([\"\\\n]\\)"
+
 let _pr_escape_chunk out = function
-  | Str.Text s     -> fprintf out "%s" s
+  | Str.Text s -> fprintf out "%s" s
   | Str.Delim "\n" -> fprintf out "\\n"
-  | Str.Delim s    -> fprintf out "\\%s" s
+  | Str.Delim s -> fprintf out "\\%s" s
+
 let _pr_escape_string out s =
   List.iter (_pr_escape_chunk out) (Str.full_split _pr_escape_re s)
 
 let rec pr_str readably out mal_obj =
-    match mal_obj with
-      | T.Int i -> fprintf out "%i" i
-      | T.Keyword s -> fprintf out ":%s" s
-      | T.Nil -> fprintf out "nil"
-      | T.Bool b -> fprintf out "%B" b
-      | T.String s when readably -> fprintf out "\"%a\"" _pr_escape_string s
-      | T.String s | T.Symbol s  -> fprintf out "%s" s
-      | T.List { T.value = xs } ->
-         fprintf out "(%a)" (pr_list readably true) xs
-      | T.Vector { T.value = xs } ->
-         fprintf out "[%a]" (pr_list readably true) xs
-      | T.Map { T.value = xs } ->
-         fprintf out "{%a}" (_pr_map readably) xs
-      | T.Fn _ -> fprintf out "#<fn>"
-      | T.Atom x -> fprintf out "(atom %a)" (pr_str readably) !x
+  match mal_obj with
+  | T.Int i -> fprintf out "%i" i
+  | T.Keyword s -> fprintf out ":%s" s
+  | T.Nil -> fprintf out "nil"
+  | T.Bool b -> fprintf out "%B" b
+  | T.String s when readably -> fprintf out "\"%a\"" _pr_escape_string s
+  | T.String s | T.Symbol s -> fprintf out "%s" s
+  | T.List { T.value = xs } -> fprintf out "(%a)" (pr_list readably true) xs
+  | T.Vector { T.value = xs } -> fprintf out "[%a]" (pr_list readably true) xs
+  | T.Map { T.value = xs } -> fprintf out "{%a}" (_pr_map readably) xs
+  | T.Fn _ -> fprintf out "#<fn>"
+  | T.Atom x -> fprintf out "(atom %a)" (pr_str readably) !x
+
 and pr_list readably spaced out =
-  List.iter (
-    let sep = ref "" in fun x ->
-      fprintf out "%s%a" !sep (pr_str readably) x;
-      if spaced && !sep == "" then sep := " " else ())
+  List.iter
+    (let sep = ref "" in
+     fun x ->
+       fprintf out "%s%a" !sep (pr_str readably) x;
+       if spaced && !sep == "" then sep := " " else ())
+
 and _pr_map readably out =
-  Types.MalMap.iter (
-    let sep = ref "" in fun k v ->
-      fprintf out "%s%a %a" !sep (pr_str readably) k (pr_str readably) v;
-      if !sep == "" then sep := " " else ())
+  Types.MalMap.iter
+    (let sep = ref "" in
+     fun k v ->
+       fprintf out "%s%a %a" !sep (pr_str readably) k (pr_str readably) v;
+       if !sep == "" then sep := " " else ())

impls/ocaml/reader.ml

@@ -1,103 +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 = tokens}
-      else if token.[0] = ';' then
-        read_list eol { list_form = list_reader.list_form;
-                        tokens = 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 = tokens} in
-             {form = Types.list list_reader.list_form;
-              tokens = list_reader.tokens}
-        | "{" ->
-           let list_reader = read_list "}" {list_form = []; tokens = 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 = 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 = tokens}
-
-let read_str str = (read_form (List.filter ((<>) "") (find_re token_re str))).form
+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 =
+  (* !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)

impls/ocaml/step0_repl.ml

@@ -10,16 +10,15 @@
 *)
 
 let eval ast = ast
-
 let read str = str
 let print exp = exp
 let rep str = print (eval (read str))
 
 let main =
-      try
-        while true do
-          Format.printf "user> %!";
-          let line = read_line () in
-          Format.printf "%s\n" (rep line)
-        done
-      with End_of_file -> Format.printf "\n"
+  try
+    while true do
+      Format.printf "user> %!";
+      let line = read_line () in
+      Format.printf "%s\n" (rep line)
+    done
+  with End_of_file -> Format.printf "\n"

impls/ocaml/step1_read_print.ml

@@ -1,19 +1,14 @@
 let eval ast = ast
-
 let read str = Reader.read_str str
 let print = Printer.pr_str true
 
 let main =
-      try
-        while true do
-          Format.printf "user> %!";
-          let line = read_line () in
-          try
-            Format.printf "%a\n" print (eval (read line))
-          with
-             | Types.MalExn exc ->
-                Format.printf "mal exception: %a\n" print exc
-             | e ->
-                Format.printf "ocaml exception: %s\n" (Printexc.to_string e)
-        done
-      with End_of_file -> Format.printf "\n"
+  try
+    while true do
+      Format.printf "user> %!";
+      let line = read_line () in
+      try Format.printf "%a\n" print (eval (read line)) with
+      | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc
+      | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e)
+    done
+  with End_of_file -> Format.printf "\n"

impls/ocaml/step2_eval.ml

@@ -1,48 +1,47 @@
 module T = Types.Types
-
 module Env = Map.Make (String)
 
-let num_fun f = Types.fn
-  (function
-    | [(T.Int a); (T.Int b)] -> T.Int (f a b)
+let num_fun f =
+  Types.fn (function
+    | [ T.Int a; T.Int b ] -> T.Int (f a b)
     | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin"))
 
-let repl_env = Env.of_list
-  [ ("+", (num_fun ( + )));
-    ("-", (num_fun ( - )));
-    ("*", (num_fun ( * )));
-    ("/", (num_fun ( / ))) ]
+let repl_env =
+  Env.of_list
+    [
+      ("+", num_fun ( + ));
+      ("-", num_fun ( - ));
+      ("*", num_fun ( * ));
+      ("/", num_fun ( / ));
+    ]
 
 let rec eval env ast =
   (*
        Format.printf "EVAL: %a\n" (Printer.pr_str true) ast);
    *)
   match ast with
-    | T.Symbol s -> (match Env.find_opt s env with
-         | Some v -> v
-         | None   -> raise (Invalid_argument ("'" ^ s ^ "' not found")))
-    | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs);
-    | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs)
-    | T.List { T.value = (a0 :: args) } ->
-      (match eval env a0 with
-         | T.Fn { value = f } -> f (List.map (eval env) args)
-         | _ -> raise (Invalid_argument "Cannot invoke non-function"))
-    | _ -> ast
+  | T.Symbol s -> (
+      match Env.find_opt s env with
+      | Some v -> v
+      | None -> raise (Invalid_argument ("'" ^ s ^ "' not found")))
+  | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs)
+  | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs)
+  | T.List { T.value = a0 :: args } -> (
+      match eval env a0 with
+      | T.Fn { value = f } -> f (List.map (eval env) args)
+      | _ -> raise (Invalid_argument "Cannot invoke non-function"))
+  | _ -> ast
 
 let read str = Reader.read_str str
 let print = Printer.pr_str true
 
 let main =
-      try
-        while true do
-          Format.printf "user> %!";
-          let line = read_line () in
-          try
-            Format.printf "%a\n" print (eval repl_env (read line))
-          with
-             | Types.MalExn exc ->
-                Format.printf "mal exception: %a\n" print exc
-             | e ->
-                Format.printf "ocaml exception: %s\n" (Printexc.to_string e)
-        done
-      with End_of_file -> Format.printf "\n"
+  try
+    while true do
+      Format.printf "user> %!";
+      let line = read_line () in
+      try Format.printf "%a\n" print (eval repl_env (read line)) with
+      | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc
+      | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e)
+    done
+  with End_of_file -> Format.printf "\n"