70 lines
1.5 KiB
OCaml
70 lines
1.5 KiB
OCaml
open Fun
|
||
open Fmlib_parse
|
||
|
||
module Token = struct
|
||
type tt =
|
||
| Ident of string
|
||
| LParen
|
||
| RParen
|
||
| Comma
|
||
| Wedge
|
||
| Vee
|
||
| RArrow
|
||
| LRArrow
|
||
| Dot
|
||
| Forall
|
||
| Exists
|
||
| EOF
|
||
|
||
type t = tt
|
||
end
|
||
|
||
module Token_plus = struct
|
||
type t = Position.range * Token.t
|
||
end
|
||
|
||
module C = struct
|
||
include Fmlib_parse.Character.Make (Unit) (Token_plus) (Fmlib_std.Void)
|
||
|
||
let ( <$> ) = map
|
||
let ( *> ) t p = const t <$> p
|
||
|
||
let whitespace =
|
||
one_of_chars " \n\t" "unreachable" |> skip_zero_or_more |> no_expectations
|
||
|
||
let punctuation =
|
||
List.map
|
||
(fun (t, s) -> t *> string s)
|
||
Token.
|
||
[
|
||
(LParen, "(");
|
||
(RParen, ")");
|
||
(Comma, ",");
|
||
(Dot, ".");
|
||
(Wedge, "∧");
|
||
(Vee, "∨");
|
||
(RArrow, "→");
|
||
(LRArrow, "↔");
|
||
(Forall, "∀");
|
||
(Exists, "∃");
|
||
]
|
||
|
||
let alpha c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || c = '_'
|
||
let numeric c = c >= '0' && c <= '9'
|
||
let alphanumeric c = alpha c || numeric c
|
||
|
||
let identifier =
|
||
(fun s -> Token.Ident s) <$> word alpha alphanumeric "Expected identifier"
|
||
|
||
let token = choices identifier punctuation
|
||
let final = lexer whitespace Token.EOF token
|
||
end
|
||
|
||
include C.Parser
|
||
|
||
let start = C.make_partial Position.start () C.final
|
||
|
||
let restart lex =
|
||
assert (has_succeeded lex);
|
||
assert (not (has_consumed_end lex));
|
||
C.make_partial (position lex) () C.final |> transfer_lookahead lex
|