blob: a415a80a01d0d6bf3044eaea43586dd52fcd7a0a (
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
|
(* Minimal s-expression parser for Modal syntax *)
open Ast
exception Parse_error of string
let is_space = function ' ' | '\n' | '\t' | '\r' -> true | _ -> false
let tokenize s =
let buf = Buffer.create 16 in
let tokens = ref [] in
let flush () =
if Buffer.length buf > 0 then (
tokens := Buffer.contents buf :: !tokens;
Buffer.clear buf)
in
String.iter
(fun c ->
match c with
| '(' | ')' -> flush (); tokens := (String.make 1 c) :: !tokens
| _ when is_space c -> flush ()
| _ -> Buffer.add_char buf c)
s;
flush (); List.rev !tokens
let parse_tokens tokens =
let rec parse_list i =
match List.nth_opt tokens i with
| Some ")" -> ([], i + 1)
| None -> raise (Parse_error "Unclosed list")
| _ ->
let (node, i') = parse_node i in
let (rest, j) = parse_list i' in
(node :: rest, j)
and parse_node i =
match List.nth_opt tokens i with
| Some "(" ->
let (nodes, j) = parse_list (i + 1) in
(List nodes, j)
| Some ")" -> raise (Parse_error "Unexpected )")
| Some tok -> (Atom tok, i + 1)
| None -> raise (Parse_error "Unexpected end")
in
let (node, i) = parse_node 0 in
if i <> List.length tokens then raise (Parse_error "Trailing tokens");
node
let parse s = parse_tokens (tokenize s)
|