- let rec make_patterns =
- (function
- [] -> []
- | [(n,p)] ->
- [P.Mtext([],(n ^ " -> "));(aux p)]
- | (n,p)::tl ->
- P.Mtext([],(n ^ " -> "))::
- (aux p)::P.Mtext([]," | ")::(make_patterns tl)) in
- P.Mrow (attr,
- P.Mtext([],("case "))::
- (aux a)::
- P.Mtext([],(" of "))::
- (make_patterns np)) in
- aux t
+ let arg =
+ if (is_big a) then
+ let tail = P.Mtext([],(" with"))::tail in
+ [P.Mtr ([],[P.Mtd ([],P.Mtext([],("match ")))]);
+ P.Mtr ([],[P.Mtd ([],aux a ~tail:tail)])]
+ else
+ [P.Mtr ([],[P.Mtd ([],P.Mrow([],[P.Mtext([],("match"));P.smallskip;aux a ~tail:tail; P.smallskip;P.Mtext([],("with"))]))])] in
+ let rec make_patterns is_first ~tail =
+ function
+ [] -> []
+ | [(n,p)] ->
+ let sep =
+ if is_first then "[ " else "| " in
+ [P.Mtr ([],
+ [P.Mtd ([],
+ make_pattern sep ~tail n p)])]
+ | (n,p)::tl ->
+ let sep =
+ if is_first then "[ " else "| " in
+ P.Mtr ([],
+ [P.Mtd ([],
+ make_pattern sep [] n p)])
+ ::(make_patterns false ~tail tl)
+ and make_pattern sep ~tail n p =
+ let rec get_vars_and_body =
+ function
+ CE.Binder (_, "Lambda",(n,_),body) ->
+ let v,b = get_vars_and_body body in
+ n::v,b
+ | t -> [],t in
+ let vars,body = get_vars_and_body p in
+ let lhs =
+ match vars with
+ [] -> sep ^ n ^ " -> "
+ | l -> sep ^"(" ^n^" "^(String.concat " " l) ^ ")" ^ " -> " in
+ if (is_big body) then
+ P.Mtable (P.standard_tbl_attr,
+ [P.Mtr ([],
+ [P.Mtd ([],P.Mtext([],lhs))]);
+ P.Mtr ([],
+ [P.Mtd ([],P.indented (aux ~tail body ))])])
+ else
+ P.Mrow([],[P.Mtext([],lhs);aux ~tail body]) in
+ let patterns =
+ make_patterns true np ~tail:(P.Mtext([],"]")::tail) in
+ P.Mtable (attr@P.standard_tbl_attr,
+ arg@patterns)