-
Notifications
You must be signed in to change notification settings - Fork 136
/
parser.ml
46 lines (37 loc) · 1.47 KB
/
parser.ml
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
open Core
type 'a parsing = (string*int -> ('a*int) list)
let return_parse (x : 'a) : 'a parsing =
fun (s,n) -> [(x,n)]
let parse_failure : 'a parsing =
fun (s,n) -> []
let bind_parse (x : 'a parsing) (f : 'a -> 'b parsing) : 'b parsing =
fun (s,n) ->
x (s,n) |> List.map ~f:(fun (xp,n') -> f xp (s,n')) |> List.concat
let (%%) = bind_parse
let (<|>) (x : 'a parsing) (y : 'a parsing) : 'a parsing =
fun s ->
x s @ y s
let constant_parser (k : string) : unit parsing =
fun (s,n) ->
let rec check consumed =
if consumed = String.length k then true else
if n + consumed >= String.length s || s.[n + consumed] <> k.[consumed] then false else
check (consumed + 1)
in
if check 0 then [(),n + String.length k] else []
let token_parser ?can_be_empty:(can_be_empty = false) (element : char -> bool) : string parsing =
fun (s,n) ->
let rec check consumed =
if n + consumed >= String.length s || (not (element s.[n + consumed])) then [] else
s.[n + consumed] :: check (consumed + 1)
in
let token = check 0 in
if (not can_be_empty) && List.length token = 0 then [] else
let token = String.concat ~sep:"" (token |> List.map ~f:(String.make 1)) in
[(token, n + String.length token)]
let run_parser (p : 'a parsing) (s : string) : 'a option =
p (s,0) |> List.fold_right ~init:None ~f:(fun (r,n) a ->
match a with
| Some(_) -> a
| None ->
if String.length s = n then Some(r) else None)