From bf5daf1b54cde8e23376452f7621bc02e06101dd Mon Sep 17 00:00:00 2001 From: bunny Date: Wed, 17 Sep 2025 20:20:42 +0100 Subject: [PATCH] go --- .gitignore | 3 + README.md | 0 main.ml | 161 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 164 insertions(+) create mode 100644 .gitignore create mode 100644 README.md create mode 100644 main.ml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..2b8708e --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.cmo +*.cmi +a.out diff --git a/README.md b/README.md new file mode 100644 index 0000000..e69de29 diff --git a/main.ml b/main.ml new file mode 100644 index 0000000..e73b472 --- /dev/null +++ b/main.ml @@ -0,0 +1,161 @@ +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 + +type element = + { symbol : string + ; count : int + } + +type molecule = + { elements : element list + } + +let unary_symbol_p : string parser = + let* x = upper in + String.make 1 x |> return + +let binary_symbol_p : string parser = + let* x = upper in + 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 element_count_p : int parser = + let* x = many1 digit in + List.to_seq x + |> String.of_seq + |> int_of_string + |> return + +let element_p : element parser = + let* s = symbol_p in + let* n = element_count_p <++ return 1 in + { symbol = s + ; 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 + 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 ((x,_)::_) -> Ok x + | Error xs -> Error xs + +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 molecule s : unit = + match parse_molecule s with + | Ok x -> print_molecule x + | Error xs -> print_error xs s