Makefile added

.gitignore

@@ -1,3 +1,5 @@
 *.cmo
 *.cmi
-a.out
+*.cmx
+*.o
+*.out

Makefile

@@ -0,0 +1,9 @@
+common_files = parser.ml periodic.ml main.ml
+
+native:
+	ocamlfind ocamlopt $(common_files) 
+
+byte:
+	ocamlfind ocamlc $(common_files)
+clean:
+	rm -f *.cmo *.cmi *.o *.out *.cmx

README.md

@@ -0,0 +1,7 @@
+```bash
+$ make native
+```
+
+```bash
+$ make byte
+```

main.ml

@@ -1,97 +1,5 @@
-type input = 
-  { content : string
-  ; column : int
-  }
-
-let make_input s = { content = s; column = 0 }
-
-type error =
-  { content : string
-  ; column : int }
-
-type 'a parser_result = (('a * input) list, error list) result
-
-type 'a parser =
-  { run : input -> 'a parser_result
-  }
-
-let runParser i p = p.run i
-
-let fold_left1 (f: 'a -> 'a -> 'a) (xs: 'a list) : 'a = match xs with
-  | []      -> failwith "TODO: make method total; empty list"
-  | x :: xs -> List.fold_left f x xs 
-
-let append (a: 'a parser_result) (b: 'a parser_result) : 'a parser_result =
-  match (a,b) with
-  | (Ok v, Ok v')       -> Ok (List.append v v')
-  | (Error e, Error e') -> Error (List.append e e')
-  | (v, _)              -> v
-
-let fail (s: string) : 'a parser = 
-  { run = fun x -> match x with
-          | {content = _; column = c} -> Error [{content = s; column = c}] 
-  }
-
-let get : char parser = 
-  { run = function
-          | { content = ""; column = c } -> 
-            Error [{ content = "unexpected EOF"; column = c }]
-          | { content = xs; column = c } -> 
-            Ok [(String.get xs 0, { content = String.sub xs 1 (String.length xs - 1); column = c+1})]
-  }
-
-let return (x: 'a) : 'a parser = 
-  { run = fun inp ->
-      Ok [(x,inp)]
-  }
-
-let (>>=) (p: 'a parser) (f: 'a -> 'b parser) : 'b parser = 
-  { run = fun inp -> 
-      match p.run inp with
-      | Ok    v ->
-        let f (x: 'a * input) =
-          let (v',out) = x 
-          in
-          (f v').run out
-        in 
-        fold_left1 (fun acc v -> append acc v) @@ List.map f v
-      | Error e -> Error e
-  }
-
-let (let*) = (>>=)
-
-let sat (p: char -> bool) : char parser =
-  let* x = get in
-    if p x then return x else fail "unexpected character"
-
-let (+++) (p: 'a parser) (q: 'a parser) : 'a parser =
-  { run = fun inp -> match (p.run inp,q.run inp) with
-          | (Error _, Ok v) -> Ok v
-          | (a,b)           -> append a b
-  }
-
-let (<++) (p: 'a parser) (q: 'a parser) : 'a parser =
-  { run = fun inp -> match (p.run inp,q.run inp) with
-          | (Error _, Ok v)  -> Ok v
-          | (Ok v ,   _)     -> Ok v
-          | (a,b)            -> append a b 
-  }
-
-let digit : 'a parser = sat (fun x -> x >= '0' && x <= '9') 
-let lower : 'a parser = sat (fun x -> x >= 'a' && x <= 'z') 
-let upper : 'a parser = sat (fun x -> x >= 'A' && x <= 'Z') 
-
-let rec many (p: 'a parser): 'a list parser =
-  (
-  let* x = p in 
-  let* xs = many p in
-    x::xs |> return
-  ) +++ return []
-
-let many1 (p: 'a parser): 'a list parser =
-  let* x = p in
-  let* xs = many p in
-    x::xs |> return
+open Periodic
+open Parser 
 
 type element = 
   { symbol : string
@@ -111,11 +19,19 @@ let binary_symbol_p : string parser =
   let* x' = lower in
     String.make 1 x ^ String.make 1 x' |> return
 
-let symbol_p : string parser = binary_symbol_p <++ unary_symbol_p
+let symbol_p : string parser =
+  let* xs = binary_symbol_p <++ unary_symbol_p in
+    match StringMap.find_opt xs periodic_table with
+    | Some _ -> return xs
+    | None   -> match element_find_closest xs with
+                | [] -> fail "invalid atomic element"
+                | xs -> List.fold_left (fun acc x -> acc ^ Printf.sprintf "%s " x) "" xs
+                        |> Printf.sprintf "invalid atomic element. Did you mean any of the following: %s"
+                        |> fail
 
 let element_count_p : int parser =
   let* x = many1 digit in
-    List.to_seq x 
+    List.to_seq x
     |> String.of_seq
     |> int_of_string
     |> return
@@ -127,35 +43,25 @@ let element_p : element parser =
     ; count = n
     } |> return
 
-let manyTill1 (p: 'a parser) (q: 'b parser): 'a list parser =
-  let* xs = many1 p in
-  let* _  = q in
-    return xs
-
-let eof : unit parser =
-  { run = fun inp -> 
-      if inp.content = "" 
-      then Ok [(), {content = ""; column = inp.column}] 
-      else Error [{content = "expected EOF"; column = inp.column+1}]
-  }
-
 let molecule_p : molecule parser =
-  let* xs = manyTill1 element_p eof in
+  let* xs = manyTill element_p eof in
     return { elements = xs }
 
 let parse_molecule s : (molecule, error list) result =
   match make_input s |> molecule_p.run with
-  | Ok []         -> failwith "TODO: make method total; empty list" 
+  | Ok []         -> failwith "TODO: make method total; empty list"
   | Ok ((x,_)::_) -> Ok x
   | Error xs      -> Error xs
 
-let print_molecule (s: molecule) : unit = 
+let print_molecule (s: molecule) : unit =
   List.iter (fun x -> Printf.printf "%s, %i\n" x.symbol x.count) s.elements
 
-let print_error (xs: error list) (s: string) : unit = 
-  List.iter (fun x -> Printf.printf "%s\n%*s\n%s\n" s x.column "^" x.content) xs 
+let print_error (xs: error list) (s: string) : unit =
+  List.iter (fun x -> Printf.printf "%s\n%*s\n%s\n\n" s x.column "^" x.content) xs
 
 let molecule s : unit =
   match parse_molecule s with
-  | Ok x     -> print_molecule x 
+  | Ok x     -> print_molecule x
   | Error xs -> print_error xs s
+
+let () = molecule "C6Hi12O6"

parser.ml

@@ -0,0 +1,108 @@
+type input =
+  { content : string
+  ; column : int
+  }
+
+let make_input s = { content = s; column = 0 }
+
+type error =
+  { content : string
+  ; column : int }
+
+type 'a parser_result = (('a * input) list, error list) result
+
+type 'a parser =
+  { run : input -> 'a parser_result
+  }
+
+let runParser i p = p.run i
+
+let fold_left1 (f: 'a -> 'a -> 'a) (xs: 'a list) : 'a = match xs with
+  | []      -> failwith "TODO: make method total; empty list"
+  | x :: xs -> List.fold_left f x xs 
+
+let append (a: 'a parser_result) (b: 'a parser_result) : 'a parser_result =
+  match (a,b) with
+  | (Ok v, Ok v')       -> Ok (List.append v v')
+  | (Error e, Error e') -> Error (List.append e e')
+  | (v, _)              -> v
+
+let fail (s: string) : 'a parser = 
+  { run = fun x -> match x with
+          | {content = _; column = c} -> Error [{content = s; column = c}] 
+  }
+
+let get : char parser = 
+  { run = function
+          | { content = ""; column = c } -> 
+            Error [{ content = "unexpected EOF"; column = c }]
+          | { content = xs; column = c } -> 
+            Ok [(String.get xs 0, { content = String.sub xs 1 (String.length xs - 1); column = c+1})]
+  }
+
+let return (x: 'a) : 'a parser = 
+  { run = fun inp ->
+      Ok [(x,inp)]
+  }
+
+let (>>=) (p: 'a parser) (f: 'a -> 'b parser) : 'b parser = 
+  { run = fun inp -> 
+      match p.run inp with
+      | Ok    v ->
+        let f (x: 'a * input) =
+          let (v',out) = x 
+          in
+          (f v').run out
+        in 
+        fold_left1 (fun acc v -> append acc v) @@ List.map f v
+      | Error e -> Error e
+  }
+
+let (let*) = (>>=)
+
+let sat (p: char -> bool) : char parser =
+  let* x = get in
+    if p x then return x else fail "unexpected character"
+
+let (+++) (p: 'a parser) (q: 'a parser) : 'a parser =
+  { run = fun inp -> match (p.run inp,q.run inp) with
+          | (Error _, Ok v) -> Ok v
+          | (a,b)           -> append a b
+  }
+
+let (<++) (p: 'a parser) (q: 'a parser) : 'a parser =
+  { run = fun inp -> match (p.run inp,q.run inp) with
+          | (Error _, Ok v)  -> Ok v
+          | (Ok v ,   _)     -> Ok v
+          | (a,b)            -> append a b 
+  }
+
+let digit : 'a parser = sat (fun x -> x >= '0' && x <= '9') 
+let lower : 'a parser = sat (fun x -> x >= 'a' && x <= 'z') 
+let upper : 'a parser = sat (fun x -> x >= 'A' && x <= 'Z') 
+
+let rec many (p: 'a parser): 'a list parser =
+  (
+  let* x = p in 
+  let* xs = many p in
+    x::xs |> return
+  ) +++ return []
+
+let many1 (p: 'a parser): 'a list parser =
+  let* x = p in
+  let* xs = many p in
+    x::xs |> return
+
+let rec manyTill (p: 'a parser) (q: 'b parser): 'a list parser =
+  (
+  let* x = p in 
+  let* xs = manyTill p q in
+    x::xs |> return
+  ) <++ (q >>= fun _ -> return [])
+
+let eof : unit parser =
+  { run = fun inp -> 
+      if inp.content = "" 
+      then Ok [(), {content = ""; column = inp.column}] 
+      else Error[{content = "expected EOF"; column = inp.column+1}]
+  }

periodic.ml

@@ -0,0 +1,127 @@
+module StringMap = Map.Make(String)
+
+let periodic_table =
+  StringMap.empty
+  |> StringMap.add "H" 1.008  (* Hydrogen *)
+  |> StringMap.add "He" 4.0026 (* Helium *)
+  |> StringMap.add "Li" 6.941  (* Lithium *)
+  |> StringMap.add "Be" 9.0122 (* Beryllium *)
+  |> StringMap.add "B" 10.811 (* Boron *)
+  |> StringMap.add "C" 12.011 (* Carbon *)
+  |> StringMap.add "N" 14.007 (* Nitrogen *)
+  |> StringMap.add "O" 15.999 (* Oxygen *)
+  |> StringMap.add "F" 18.998 (* Fluorine *)
+  |> StringMap.add "Ne" 20.180 (* Neon *)
+  |> StringMap.add "Na" 22.990 (* Sodium *)
+  |> StringMap.add "Mg" 24.305 (* Magnesium *)
+  |> StringMap.add "Al" 26.982 (* Aluminum *)
+  |> StringMap.add "Si" 28.085 (* Silicon *)
+  |> StringMap.add "P" 30.974 (* Phosphorus *)
+  |> StringMap.add "S" 32.06  (* Sulfur *)
+  |> StringMap.add "Cl" 35.45 (* Chlorine *)
+  |> StringMap.add "K" 39.098 (* Potassium *)
+  |> StringMap.add "Ar" 39.948 (* Argon *)
+  |> StringMap.add "Ca" 40.078 (* Calcium *)
+  |> StringMap.add "Sc" 44.956 (* Scandium *)
+  |> StringMap.add "Ti" 47.867 (* Titanium *)
+  |> StringMap.add "V" 50.942 (* Vanadium *)
+  |> StringMap.add "Cr" 51.996 (* Chromium *)
+  |> StringMap.add "Mn" 54.938 (* Manganese *)
+  |> StringMap.add "Fe" 55.845 (* Iron *)
+  |> StringMap.add "Ni" 58.693 (* Nickel *)
+  |> StringMap.add "Co" 58.933 (* Cobalt *)
+  |> StringMap.add "Cu" 63.546 (* Copper *)
+  |> StringMap.add "Zn" 65.38  (* Zinc *)
+  |> StringMap.add "Ga" 69.723 (* Gallium *)
+  |> StringMap.add "Ge" 72.63  (* Germanium *)
+  |> StringMap.add "As" 74.922 (* Arsenic *)
+  |> StringMap.add "Se" 78.971 (* Selenium *)
+  |> StringMap.add "Br" 79.904 (* Bromine *)
+  |> StringMap.add "Kr" 83.798 (* Krypton *)
+  |> StringMap.add "Rb" 85.468 (* Rubidium *)
+  |> StringMap.add "Sr" 87.62  (* Strontium *)
+  |> StringMap.add "Y" 88.906 (* Yttrium *)
+  |> StringMap.add "Zr" 91.224 (* Zirconium *)
+  |> StringMap.add "Nb" 92.906 (* Niobium *)
+  |> StringMap.add "Mo" 95.95  (* Molybdenum *)
+  |> StringMap.add "Tc" 98.0   (* Technetium *)
+  |> StringMap.add "Ru" 101.07 (* Ruthenium *)
+  |> StringMap.add "Rh" 102.91 (* Rhodium *)
+  |> StringMap.add "Pd" 106.42 (* Palladium *)
+  |> StringMap.add "Ag" 107.87 (* Silver *)
+  |> StringMap.add "Cd" 112.41 (* Cadmium *)
+  |> StringMap.add "In" 114.82 (* Indium *)
+  |> StringMap.add "Sn" 118.71 (* Tin *)
+  |> StringMap.add "Sb" 121.76 (* Antimony *)
+  |> StringMap.add "I" 126.90 (* Iodine *)
+  |> StringMap.add "Te" 127.60 (* Tellurium *)
+  |> StringMap.add "Xe" 131.29 (* Xenon *)
+  |> StringMap.add "Cs" 132.91 (* Cesium *)
+  |> StringMap.add "Ba" 137.33 (* Barium *)
+  |> StringMap.add "La" 138.91 (* Lanthanum *)
+  |> StringMap.add "Ce" 140.12 (* Cerium *)
+  |> StringMap.add "Pr" 140.91 (* Praseodymium *)
+  |> StringMap.add "Nd" 144.24 (* Neodymium *)
+  |> StringMap.add "Pm" 145.0  (* Promethium *)
+  |> StringMap.add "Sm" 150.36 (* Samarium *)
+  |> StringMap.add "Eu" 151.96 (* Europium *)
+  |> StringMap.add "Gd" 157.25 (* Gadolinium *)
+  |> StringMap.add "Tb" 158.93 (* Terbium *)
+  |> StringMap.add "Dy" 162.50 (* Dysprosium *)
+  |> StringMap.add "Ho" 164.93 (* Holmium *)
+  |> StringMap.add "Er" 167.26 (* Erbium *)
+  |> StringMap.add "Tm" 168.93 (* Thulium *)
+  |> StringMap.add "Yb" 173.05 (* Ytterbium *)
+  |> StringMap.add "Lu" 174.97 (* Lutetium *)
+  |> StringMap.add "Hf" 178.49 (* Hafnium *)
+  |> StringMap.add "Ta" 180.95 (* Tantalum *)
+  |> StringMap.add "W" 183.84 (* Tungsten *)
+  |> StringMap.add "Re" 186.21 (* Rhenium *)
+  |> StringMap.add "Os" 190.23 (* Osmium *)
+  |> StringMap.add "Ir" 192.22 (* Iridium *)
+  |> StringMap.add "Pt" 195.08 (* Platinum *)
+  |> StringMap.add "Au" 196.97 (* Gold *)
+  |> StringMap.add "Hg" 200.59 (* Mercury *)
+  |> StringMap.add "Tl" 204.38 (* Thallium *)
+  |> StringMap.add "Pb" 207.2  (* Lead *)
+  |> StringMap.add "Bi" 208.98 (* Bismuth *)
+  |> StringMap.add "Po" 209.0  (* Polonium *)
+  |> StringMap.add "At" 210.0  (* Astatine *)
+  |> StringMap.add "Rn" 222.0  (* Radon *)
+  |> StringMap.add "Fr" 223.0  (* Francium *)
+  |> StringMap.add "Ra" 226.0  (* Radium *)
+  |> StringMap.add "Ac" 227.0  (* Actinium *)
+  |> StringMap.add "Pa" 231.04 (* Protactinium *)
+  |> StringMap.add "Th" 232.04 (* Thorium *)
+  |> StringMap.add "Np" 237.0  (* Neptunium *)
+  |> StringMap.add "U" 238.03 (* Uranium *)
+  |> StringMap.add "Am" 243.0  (* Americium *)
+  |> StringMap.add "Pu" 244.0  (* Plutonium *)
+  |> StringMap.add "Cm" 247.0  (* Curium *)
+  |> StringMap.add "Bk" 247.0  (* Berkelium *)
+  |> StringMap.add "Cf" 251.0  (* Californium *)
+  |> StringMap.add "Es" 252.0  (* Einsteinium *)
+  |> StringMap.add "Fm" 257.0  (* Fermium *)
+  |> StringMap.add "Md" 258.0  (* Mendelevium *)
+  |> StringMap.add "No" 259.0  (* Nobelium *)
+  |> StringMap.add "Lr" 262.0  (* Lawrencium *)
+  |> StringMap.add "Rf" 267.0  (* Rutherfordium *)
+  |> StringMap.add "Db" 268.0  (* Dubnium *)
+  |> StringMap.add "Sg" 269.0  (* Seaborgium *)
+  |> StringMap.add "Bh" 270.0  (* Bohrium *)
+  |> StringMap.add "Hs" 269.0  (* Hassium *)
+  |> StringMap.add "Mt" 278.0  (* Meitnerium *)
+  |> StringMap.add "Ds" 281.0  (* Darmstadtium *)
+  |> StringMap.add "Rg" 282.0  (* Roentgenium *)
+  |> StringMap.add "Cn" 285.0  (* Copernicium *)
+  |> StringMap.add "Nh" 286.0  (* Nihonium *)
+  |> StringMap.add "Fl" 289.0  (* Flerovium *)
+  |> StringMap.add "Mc" 289.0  (* Moscovium *)
+  |> StringMap.add "Lv" 293.0  (* Livermorium *)
+  |> StringMap.add "Ts" 294.0  (* Tennessine *)
+  |> StringMap.add "Og" 294.0  (* Oganesson *)
+
+let element_find_closest s : string list = 
+  StringMap.filter (fun k _ -> String.get k 0 = String.get s 0) periodic_table
+  |> StringMap.to_list
+  |> List.map (fun x -> fst x)