diff --git a/.gitignore b/.gitignore index 2b8708e..cbdfd82 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ *.cmo *.cmi -a.out +*.cmx +*.o +*.out diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..28b223f --- /dev/null +++ b/Makefile @@ -0,0 +1,9 @@ +common_files = parser.ml periodic.ml main.ml + +monpar.native: + ocamlfind ocamlopt $(common_files) + +monpar.byte: + ocamlfind ocamlc $(common_files) +clean: + rm -f *.cmo *.cmi *.o *.out *.cmx diff --git a/main.ml b/main.ml index e73b472..17418af 100644 --- a/main.ml +++ b/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" diff --git a/parser.ml b/parser.ml new file mode 100644 index 0000000..e3bf936 --- /dev/null +++ b/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}] + } diff --git a/periodic.ml b/periodic.ml new file mode 100644 index 0000000..d39c47d --- /dev/null +++ b/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)