diff options
Diffstat (limited to 'modal/ocaml/_build/default/src/program.ml')
-rw-r--r-- | modal/ocaml/_build/default/src/program.ml | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/modal/ocaml/_build/default/src/program.ml b/modal/ocaml/_build/default/src/program.ml new file mode 100644 index 0000000..8e209dd --- /dev/null +++ b/modal/ocaml/_build/default/src/program.ml @@ -0,0 +1,70 @@ +(* Loading rules and inputs from a simple .modal text format *) + +open Ast + +(* Lines beginning with "<>" are rules: "<> left right". Lines beginning with ".." are inputs to evaluate, concatenated into a single input tree. *) + +let trim s = String.trim s + +let starts_with pref s = + let n = String.length pref in + String.length s >= n && String.sub s 0 n = pref + +let load_file path : rule list * node option = + let ic = open_in path in + let rec loop rules inputs = + match input_line ic with + | line -> + let line = trim line in + if line = "" then loop rules inputs + else if starts_with "<>" line then ( + let rest = String.sub line 2 (String.length line - 2) |> trim in + (* split rest into two trees by parsing greedily twice *) + (* strategy: parse first tree, then parse second from remaining tokens *) + let tokens = Parse.tokenize rest in + let parse_one toks = + let rec take_tree i depth acc = + match List.nth_opt toks i with + | None -> acc, i + | Some tok -> + let depth' = + if tok = "(" then depth + 1 + else if tok = ")" then depth - 1 + else depth + in + let acc' = acc @ [ tok ] in + if depth' = 0 && acc' <> [] then acc', i + 1 + else take_tree (i + 1) depth' acc' + in + take_tree 0 0 [] + in + let left_toks, i = parse_one tokens in + let rec drop k xs = match (k, xs) with 0, _ -> xs | _, [] -> [] | k, _ :: tl -> drop (k - 1) tl in + let right_toks = drop i tokens in + let left = Parse.parse_tokens left_toks in + let right = Parse.parse_tokens right_toks in + let rules = rules @ [ { left; right } ] in + loop rules inputs) + else if starts_with ".." line then ( + let rest = String.sub line 2 (String.length line - 2) |> trim in + let node = Parse.parse rest in + loop rules (inputs @ [ node ])) + else ( + (* Treat any other non-empty line as an input expression *) + try + let node = Parse.parse line in + loop rules (inputs @ [ node ]) + with _ -> loop rules inputs) + | exception End_of_file -> + close_in ic; + let input = + match inputs with + | [] -> None + | [ x ] -> Some x + | xs -> Some (List xs) + in + (rules, input) + in + loop [] [] + + |