71 lines
1.5 KiB
OCaml
71 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
|