1 files changed, 70 insertions, 0 deletions
diff --git a/modal/ocaml/src/program.ml b/modal/ocaml/src/program.ml
new file mode 100644
index 0000000..8e209dd
--- /dev/null
+++ b/modal/ocaml/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 [] []
+
+