blob: 8e209dd7e01b1e5202967202b97366b9582f49f3 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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 [] []
|