let rec print_tree ppf tree =
let rec get_brothers acc =
function
| DeadEnd -> List.rev acc
| LocAct (_, _) -> List.rev acc
| Node { node = n; brother = b; son = s } ->
get_brothers ((Bro (n, (get_brothers [] s))) :: acc)
b
and print_brothers ppf brothers =
if brothers = []
then fprintf ppf "@ []"
else
List.iter
(function
| Bro (n, xs) ->
(fprintf ppf "@ @[<hv2>- %a" print_symbol n;
(match xs with
| [] -> ()
| [ _ ] ->
(try
print_children ppf (get_children [] xs)
with
| Exit ->
fprintf ppf ":%a" print_brothers xs)
| _ -> fprintf ppf ":%a" print_brothers xs);
fprintf ppf "@]"))
brothers
and print_children ppf =
List.iter (fprintf ppf ";@ %a" print_symbol)
and get_children acc =
function
| [] -> List.rev acc
| [ Bro (n, x) ] -> get_children (n :: acc) x
| _ -> raise Exit
in print_brothers ppf (get_brothers [] tree)
and print_symbol ppf =
function
| Smeta (n, sl, _) -> print_meta ppf n sl
| Slist0 s -> fprintf ppf "LIST0 %a" print_symbol1 s
| Slist0sep (s, t) ->
fprintf ppf "LIST0 %a SEP %a" print_symbol1 s
print_symbol1 t
| Slist1 s -> fprintf ppf "LIST1 %a" print_symbol1 s
| Slist1sep (s, t) ->
fprintf ppf "LIST1 %a SEP %a" print_symbol1 s
print_symbol1 t
| Sopt s -> fprintf ppf "OPT %a" print_symbol1 s
| Stry s -> fprintf ppf "TRY %a" print_symbol1 s
| Snterml (e, l) -> fprintf ppf "%s@ LEVEL@ %S" e.ename l
| (Snterm _ | Snext | Sself | Stree _ | Stoken _ |
Skeyword _
as s) -> print_symbol1 ppf s
and print_meta ppf n sl =
let rec loop i =
function
| [] -> ()
| s :: sl ->
let j =
(try String.index_from n i ' '
with | Not_found -> String.length n)
in
(fprintf ppf "%s %a" (String.sub n i (j - i))
print_symbol1 s;
if sl = []
then ()
else
(fprintf ppf " ";
loop (min (j + 1) (String.length n)) sl))
in loop 0 sl
and print_symbol1 ppf =
function
| Snterm e -> pp_print_string ppf e.ename
| Sself -> pp_print_string ppf "SELF"
| Snext -> pp_print_string ppf "NEXT"
| Stoken ((_, descr)) -> pp_print_string ppf descr
| Skeyword s -> fprintf ppf "%S" s
| Stree t -> print_tree ppf t
| (Smeta (_, _, _) | Snterml (_, _) | Slist0 _ |
Slist0sep (_, _) | Slist1 _ | Slist1sep (_, _) |
Sopt _ | Stry _
as s) -> fprintf ppf "(%a)" print_symbol s
and print_rule ppf symbols =
(fprintf ppf "@[<hov 0>";
let _ =
List.fold_left
(fun sep symbol ->
(fprintf ppf "%t%a" sep print_symbol symbol;
fun ppf -> fprintf ppf ";@ "))
(fun _ -> ()) symbols
in fprintf ppf "@]")
and print_level ppf pp_print_space rules =
(fprintf ppf "@[<hov 0>[ ";
let _ =
List.fold_left
(fun sep rule ->
(fprintf ppf "%t%a" sep print_rule rule;
fun ppf -> fprintf ppf "%a| " pp_print_space ()))
(fun _ -> ()) rules
in fprintf ppf " ]@]")