open Parser type box = TermBox of dim * char list | NonTermBox of dim * char list | ParamBox of dim * char list | OptBox of dim * box | RepBox of dim * box | TermRepBox of dim * box * box | OptRepBox of dim * box | OrBoxList of dim * box list | ConBox of dim * box * box and dim = {l : float; h : float; lc : float; rc : float} let dim = function TermBox (d, _) -> d | NonTermBox (d, _) -> d | ParamBox (d, _) -> d | OptBox (d, _) -> d | RepBox (d, _) -> d | TermRepBox (d, _, _) -> d | OptRepBox (d, _) -> d | OrBoxList (d, _) -> d | ConBox (d, _, _) -> d let dim_l t = (dim t).l and dim_h t = (dim t).h and dim_lc t = (dim t).lc and dim_rc t = (dim t).rc let of_syntree box_con box_off char_off box_height box_sep_frac = let atom_dim lst = { l = 2. *. box_con +. float (List.length lst) *. char_off +. box_off; h = box_height; lc = box_height /. 2.; rc = box_height /. 2. } in let rec of_syntree_rec = function NonTerm lst -> NonTermBox (atom_dim lst, lst) | Term lst -> TermBox (atom_dim lst, lst) | Param lst -> ParamBox (atom_dim lst, lst) | Rep t -> let t = of_syntree_rec t in RepBox ( { l = dim_l t +. 2. *. box_con; h = dim_h t +. box_height /. 2.; lc = dim_lc t +. box_height /. 2.; rc = dim_rc t }, t) | TermRep (t, Term lst) -> let t = of_syntree_rec t and lng = float (List.length lst) in TermRepBox ( { l = dim_l t +. 2. *. box_con; h = dim_h t +. box_height +. box_height /. 2.; lc = dim_lc t +. 3. *. box_height /. 2.; rc = dim_rc t }, t, TermBox ( { l = lng *. char_off +. box_off; h = box_height; lc = box_height /. 2.; rc = box_height /. 2. }, lst)) | OptRep t -> let t = of_syntree_rec t in OptRepBox ( { l = dim_l t +. 2. *. box_con; h = dim_h t +. box_height; lc = dim_lc t +. box_height /. 2.; rc = dim_rc t +. box_height /. 2. }, t) | Opt t -> let t = of_syntree_rec t in OptBox ( { l = dim_l t +. 2. *. box_con; h = dim_h t +. box_height /. 2.; lc = dim_lc t; rc = dim_rc t +. box_height /. 2. }, t) | Con (t1, t2) -> let t1 = of_syntree_rec t1 and t2 = of_syntree_rec t2 in ConBox ( { l = dim_l t1 +. dim_l t2 -. box_con; h = (max ((dim_h t1) -. (dim_rc t1)) (dim_lc t2)) +. (max (dim_rc t1) ((dim_h t2) -. (dim_lc t2))); lc = (let a = (dim_lc t2) -. ((dim_h t1) -. (dim_rc t1)) in if a > 0. then (dim_lc t1) +. a else (dim_lc t1)); rc = (let a = (dim_rc t1) -. ((dim_h t2) -. (dim_lc t2)) in if a > 0. then (dim_rc t2) +. a else (dim_rc t2)) }, t1, t2) | OrList lst -> let lst = List.map of_syntree_rec lst and box_sep = box_height *. box_sep_frac in let new_l = List.fold_left (fun l1 t2 -> max l1 (dim_l t2)) 0. lst and new_h = List.fold_left (fun h1 t2 -> h1 +. dim_h t2 +. box_sep) (~-. box_sep) lst in OrBoxList ( { l = new_l +. 2. *. box_con; h = new_h; lc = dim_lc (List.hd lst); rc = dim_rc (List.hd (List.rev lst)) }, lst) | _ -> raise (Failure "Parser Bug") in of_syntree_rec