let parse ?dir u =
let l = Lexing.from_string u in
let tok = ref None in
let f =
fun () ->
match !tok with
| None -> token l
| Some x ->
tok := None;
x
in
let g t =
match !tok with
| None -> tok := Some t
| Some t' ->
raise (Parse_error(sf "Trying to unput token %s while %s is active" (string_of_token t) (string_of_token t')))
in
let read x =
let y = f () in
if x = y then
()
else
raise (Parse_error(sf "Unexpected token, expecting %s, got %s" (string_of_token x) (string_of_token y)))
in
let rec atomizer continuation = match f () with
| NOT -> atomizer (fun x -> continuation (Not x))
| ATOM x ->
begin
let a =
match add_dir dir x with
| Constant u -> Constant u
| Pattern p -> Pattern(fast_pattern_of_pattern p)
in
continuation (Atom a)
end
| TRUE -> continuation True
| FALSE -> continuation False
| LPAR ->
let y = parse_s () in
read RPAR;
continuation y
| t -> raise (Parse_error(sf "Unexpected token %s in atomizer" (string_of_token t)))
and parse_s1 x = match f () with
| OR -> let y = parse_s () in Or[x; y]
| AND -> parse_t x
| t -> g t; x
and parse_t1 x y = match f () with
| OR -> let z = parse_s () in Or[And[x;y]; z]
| AND -> parse_t (And[x;y])
| t -> g t; And[x;y]
and parse_s () = atomizer parse_s1
and parse_t x = atomizer (parse_t1 x)
in
let x = parse_s () in
read EOF;
add_ast_dir dir x