Commits

Peter Szilagyi committed f7d2879

updated to the latest ocp-indent and typerex (ocp-build)

  • Participants
  • Parent commits 52cfdd3

Comments (0)

Files changed (49)

File ocaml/contrib/ocp-indent/src/approx_lexer.mll

             lexbuf.lex_start_p <- start;
             token
           }
-      | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
-          ("\"" ([^ '\010' '\013' '"' ] * as name) "\"")?
+      | "#" [' ' '\t']* (['0'-'9']+ as _num) [' ' '\t']*
+          ("\"" ([^ '\010' '\013' '"' ] * as _name) "\"")?
           [^ '\010' '\013'] * newline
-          { update_loc lexbuf name (int_of_string num) true 0;
+          { update_loc lexbuf None 1 false 0;
             token lexbuf
           }
       | "#"  { SHARP }
           { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
             string lexbuf }
       | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
-          { store_string_char(char_for_decimal_code 1 (Lexing.lexeme lexbuf));
+          { (match can_overflow (char_for_decimal_code 1) lexbuf with
+            | Overflow _ ->
+                let s = Lexing.lexeme lexbuf in
+                for i = 0 to String.length s - 1 do store_string_char s.[i] done
+            | InRange c -> store_string_char c);
             string lexbuf }
       | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F']
           { store_string_char(char_for_hexadecimal_code lexbuf 2);

File ocaml/contrib/ocp-indent/src/indentBlock.ml

     (* special negative indent is only honored at beginning of line *)
     (* then else : 10 *)
     | BAR -> 10,T,-2
-    | OF -> 20,L,0
+    | OF -> 20,L,2
     | LESSMINUS | COLONEQUAL -> 20,L,config.i_base
     | COMMA -> 30,L,0
     | MINUSGREATER -> 32,L,0 (* is an operator only in types *)
           append (KWith KMatch) L ~pad:(max l.pad config.i_with) p
       | p ->
           append (KWith KMatch) L ~pad:config.i_with p)
-  | FUN         -> append KFun L (fold_expr t.path)
+  | FUN         ->
+      (match t.path with
+      | {k=KArrow KFun}::p ->
+          replace KFun L (unwind (function KFun -> true | _ -> false) p)
+      | p -> append KFun L (fold_expr p))
   | STRUCT      -> append KStruct L t.path
   | WHEN ->
       append KWhen L ~pad:(config.i_base + 2)
         (unwind (function
-        | KWith(KTry|KMatch) | KBar(KTry|KMatch) -> true
+        | KWith(KTry|KMatch) | KBar(KTry|KMatch) | KFun -> true
         | _ -> false)
            t.path)
   | SIG         -> append KSig L t.path
 
   | CONSTRAINT ->
       let path =
-        unwind (function KBody KType | KObject -> true | _ -> false) t.path
+        unwind (function KType | KBody KType | KObject -> true | _ -> false) t.path
       in
-      append KType L path
+      append KLet L path
 
   | AND ->
       let unwind_to = function

File ocaml/contrib/ocp-indent/tests/failing-output/core-failing.ml

 exception IOError of
-  int *
-    exn
+    int *
+      exn
 
 module type S = S
 with type ('a, 'b, 'c) map := ('a, 'b, 'c) t

File ocaml/contrib/ocp-indent/tests/failing-output/obuild.ml

+type predicate =
+        Pred_Byte
+    | Pred_Native
+    | Pred_Toploop
+
+let _ =
+    { pkg with
+        package_version = projFile.version
+      ; package_description = _
+        ; package_requires = [] }

File ocaml/contrib/ocp-indent/tests/failing-output/traverse.ml

+(*
+    Copyright © 2011 MLstate
+
+    This file is part of OPA.
+
+    OPA is free software: you can redistribute it and/or modify it under the
+    terms of the GNU Affero General Public License, version 3, as published by
+    the Free Software Foundation.
+
+    OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+    WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+    FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+    more details.
+
+    You should have received a copy of the GNU Affero General Public License
+    along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*)
+(* depends *)
+module List = BaseList
+
+(* -- *)
+
+module Utils =
+struct
+  type ('a, 'at, 'bt, 'b) sub = 'a -> ('bt list -> 'b) * 'at list
+  let sub_2 sub1 sub2 = fun (x,y) ->
+    let unsub1, list1 = sub1 x in
+    let unsub2, list2 = sub2 y in
+    let length = List.length list1 in
+      (fun l ->
+        let l1, l2 = List.split_at length l in
+          (unsub1 l1, unsub2 l2)),
+      (list1 @ list2)
+  (* could be simplified using wrap *)
+  let sub_3 sub1 sub2 sub3 = fun (a,b,c) ->
+    let unsub,l = sub_2 (sub_2 sub1 sub2) sub3 ((a,b),c) in
+      (fun l -> let ((a,b),c) = unsub l in (a,b,c)), l
+  let sub_4 sub1 sub2 sub3 sub4 (a,b,c,d) =
+    let unsub,l = sub_2 (sub_2 sub1 sub2) (sub_2 sub3 sub4) ((a,b),(c,d)) in
+      (fun l -> let ((a,b),(c,d)) = unsub l in (a,b,c,d)), l
+
+  let sub_list sub = fun args ->
+    let unsubs, lists = List.split (List.map sub args) in
+    let lengths = List.map List.length lists in
+      (fun l ->
+        let ll = List.split_ats lengths l in
+          List.map2 (fun f x -> f x) unsubs ll),
+      (List.concat lists)
+
+  let sub_current e = (function [e] -> e | _ ->  assert false), [e]
+  let sub_ignore x = (function [] -> x | _ -> assert false), []
+
+  let sub_option sub_e opt =
+    match opt with
+    | None -> (fun x -> assert (List.is_empty x); None), []
+    | Some e ->
+        let usub, l = sub_e e in
+          (fun l -> Some (usub l)), l
+
+  let wrap cons (unsub,l) = (fun l -> cons (unsub l)), l
+end
+
+(* TODO: remove this, merge with TRAVERSE *)
+module type OLD_TRAVERSE =
+sig
+
+  type 'p t constraint 'p = _ * _ * _
+  val traverse_iter : (('p t -> unit) -> 'p t -> unit) -> 'p t -> unit
+  val traverse_map : (('p t -> 'p t) -> 'p t -> 'p t) -> 'p t -> 'p t
+  val traverse_fold : (('a -> 'p t -> 'a) -> 'a -> 'p t -> 'a) -> 'a -> 'p t -> 'a
+  val traverse_foldmap : (('a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t
+  val traverse_exists : (('p t -> bool) -> 'p t -> bool) -> 'p t -> bool
+  val traverse_forall : (('p t -> bool) -> 'p t -> bool) -> 'p t -> bool
+  val traverse_fold_context_down : (('env -> 'a -> 'p t -> 'a) -> 'env -> 'a -> 'p t -> 'a) -> 'env -> 'a -> 'p t -> 'a
+  val iter : ('p t -> unit) -> 'p t -> unit
+  val iter_up : ('p t -> unit) -> 'p t -> unit
+  val iter_down : ('p t -> unit) -> 'p t -> unit
+  val map : ('p t -> 'p t) -> 'p t -> 'p t
+  val map_up : ('p t -> 'p t) -> 'p t -> 'p t
+  val map_down : ('p t -> 'p t) -> 'p t -> 'p t
+  val fold : ('a -> 'p t -> 'a) -> 'a -> 'p t -> 'a
+  val fold_up : ('a -> 'p t -> 'a) -> 'a -> 'p t -> 'a
+  val fold_down : ('a -> 'p t -> 'a) -> 'a -> 'p t -> 'a
+  val foldmap : ('a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t
+  val foldmap_up : ('a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t
+  val foldmap_down : ('a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t
+  val exists : ('p t -> bool) -> 'p t -> bool
+  val exists_up : ('p t -> bool) -> 'p t -> bool
+  val exists_down : ('p t -> bool) -> 'p t -> bool
+  val find : ('p t -> bool) -> 'p t -> 'p t option
+  val find_up : ('p t -> bool) -> 'p t -> 'p t option
+  val find_down : ('p t -> bool) -> 'p t -> 'p t option
+  val findmap : ('p t -> 'a option) -> 'p t -> 'a option
+  val findmap_up : ('p t -> 'a option) -> 'p t -> 'a option
+  val findmap_down : ('p t -> 'a option) -> 'p t -> 'a option
+
+  val traverse_fold_right :  (('b t -> 'a -> 'a) -> 'b t -> 'a -> 'a) -> 'b t -> 'a -> 'a
+  val fold_up_combine : ?combine:('a -> 'a -> 'a) -> ('a -> 'b t -> 'a) -> 'a -> 'b t -> 'a
+  val fold_right_down : ('b t -> 'a -> 'a) -> 'b t -> 'a -> 'a
+  val foldmap_up_combine : ?combine:('a -> 'a -> 'a) -> ('a -> 'b t -> 'a * 'b t) -> 'a -> 'b t -> 'a * 'b t
+  val map_nonrec : ('b t -> 'b t) -> 'b t -> 'b t
+  val fold_nonrec : ('a -> 'b t -> 'a) -> 'a -> 'b t -> 'a
+  val foldmap_nonrec : ('a -> 'b t -> 'a * 'b t) -> 'a -> 'b t -> 'a * 'b t
+  val map_down_fix : ('b t -> 'b t) -> 'b t -> 'b t
+  type ('b, 'c) sub = ('b, 'c t, 'c t , 'b) Utils.sub
+  val lift_iter_up : ('b,'c) sub -> ('c t -> unit) -> ('b -> unit)
+  val lift_iter_down : ('b,'c) sub -> ('c t -> unit) -> ('b -> unit)
+  val lift_map_up : ('b,'c) sub -> ('c t -> 'c t) -> ('b -> 'b)
+  val lift_map_down : ('b,'c) sub -> ('c t -> 'c t) -> ('b -> 'b)
+  val lift_fold_up_combine : ('b,'c) sub -> ?combine:('a -> 'a -> 'a) -> ('a -> 'c t -> 'a) -> ('a -> 'b -> 'a)
+  val lift_fold : ('b,'c) sub -> ('a -> 'c t -> 'a) -> ('a -> 'b -> 'a)
+  val lift_fold_right_down : ('b,'c) sub -> ('c t -> 'a -> 'a) -> ('b -> 'a -> 'a)
+  val lift_foldmap_up : ('b,'c) sub -> ('a -> 'c t -> 'a * 'c t) -> ('a -> 'b -> 'a * 'b)
+  val lift_foldmap_down : ('b,'c) sub -> ('a -> 'c t -> 'a * 'c t) -> ('a -> 'b -> 'a * 'b)
+  val lift_exists : ('b,'c) sub -> ('c t -> bool) -> ('b -> bool)
+end
+
+
+(* This internal module generates function find*, find_map* and *exists* from an iteration function
+ * When an object is found, the execution is stopped (just like if you had raised an exception) *)
+module type IteratedType =
+sig
+  type 'a t constraint 'a = _ * _ * _
+  type 'a container constraint 'a = _ * _ * _
+  val iter_up : ('a t -> unit) -> 'a container -> unit
+  val iter_down : ('a t -> unit) -> 'a container -> unit
+end
+module MakeFromIter (X : IteratedType) =
+struct
+  let find_up pred tree =
+    Return.set_checkpoint_opt
+      (fun label ->
+        X.iter_up (fun e -> if pred e then Return.return label e) tree)
+  let find_down pred tree =
+    Return.set_checkpoint_opt
+      (fun label ->
+        X.iter_down (fun e -> if pred e then Return.return label e) tree)
+  let find = find_up
+
+  let findmap_up pred tree =
+    Return.set_checkpoint_opt
+      (fun label ->
+        X.iter_up
+          (fun e ->
+            match pred e with
+            | None -> ()
+            | Some a -> Return.return label a) tree)
+  let findmap_down pred tree =
+    Return.set_checkpoint_opt
+      (fun label ->
+        X.iter_down
+          (fun e ->
+            match pred e with
+            | None -> ()
+            | Some a -> Return.return label a) tree)
+  let findmap = findmap_up
+
+  let exists_up f tree = find_up f tree <> None
+  let exists_down f tree = find_down f tree <> None
+  let exists = exists_up
+end
+
+(* FIRST VERSION *)
+module Make (X : TraverseInterface.S) (* : TRAVERSE with type 'a t = 'a X.t *) = struct
+  type 'a t = 'a X.t
+
+  let subs e = snd (X.subs_cons e)
+  let subs_cons e = (* An optimisation ; no idea if it's really worth it *)
+    let f_cons, sub_e = X.subs_cons e in
+      (fun sub_e' -> if sub_e' == sub_e then e else f_cons sub_e'),
+      sub_e
+
+  (* Higher-order traverse functions *)
+
+  let rec traverse_iter f e =
+    f (fun e -> List.iter (traverse_iter f) (subs e)) e
+
+  let rec traverse_map f e =
+    f (fun e -> let f_cons, sub_e = subs_cons e in f_cons (List.map (traverse_map f) sub_e)) e
+
+  let rec traverse_fold f e =
+    f (fun acc e -> List.fold_left (traverse_fold f) acc (subs e)) e
+
+  let rec traverse_fold_right f e =
+    f (fun e acc -> List.fold_right (traverse_fold_right f) (subs e) acc) e
+
+  let rec traverse_foldmap f e =
+    f (fun acc e ->
+      let f_cons, sub_e = subs_cons e in
+      let acc, el = List.fold_left_map (traverse_foldmap f) acc sub_e in
+        acc, f_cons el) e
+
+  let traverse_foldmap_context_down f =
+    let rec tra env acc e =
+      let f_cons, sub_e = subs_cons e in
+      let acc, el = List.fold_left_map (fun acc e -> aux env acc e) acc sub_e in
+        acc, f_cons el
+    and aux env acc e = f tra env acc e in
+      aux
+  let traverse_fold_context_down f =
+    let rec tra env acc e =
+      let _, sub_e = subs_cons e in
+        List.fold_left (fun acc e -> aux env acc e) acc sub_e
+    and aux env acc e = f tra env acc e in
+      aux
+
+  let rec traverse_exists f e =
+    f (fun e -> List.exists (traverse_exists f) (subs e)) e
+
+  let rec traverse_forall f e =
+    f (fun e -> List.for_all (traverse_forall f) (subs e)) e
+
+  (* Usual, more simple traverse functions *)
+
+  let iter_up f = traverse_iter (fun tra e -> tra e; f e)
+  let iter_down f = traverse_iter (fun tra e -> f e; tra e)
+  let iter = iter_down
+
+  let map_up f = traverse_map (fun tra e -> f (tra e))
+  let map_down f = traverse_map (fun tra e -> tra (f e))
+  let map = map_up
+
+  let fold_up_combine ?(combine = fun _ b -> b) f acc = traverse_fold (fun tra acc' e -> combine acc' (f (tra acc e) e)) acc
+  let fold_up f = traverse_fold (fun tra acc e -> f (tra acc e) e)
+  let fold_down f = traverse_fold (fun tra acc e -> tra (f acc e) e)
+  let fold = fold_down
+  let fold_right_down f = traverse_fold_right (fun tra e acc -> tra e (f e acc))
+  let foldmap_up_combine ?(combine = fun _ b -> b) f acc = traverse_foldmap
+      (fun tra acc' e ->
+        let acc, e = tra acc e in
+        let acc, e = f acc e in
+          combine acc' acc, e)
+      acc
+  let foldmap_up f = traverse_foldmap (fun tra acc e -> let acc, e = tra acc e in f acc e)
+  let foldmap_down f = traverse_foldmap (fun tra acc e -> let acc, e = f acc e in tra acc e)
+  let foldmap = foldmap_up
+
+  include MakeFromIter(
+      struct
+        type 'a t = ('b * 'c * 'd) X.t constraint 'a = 'b * 'c * 'd
+        type 'a container = 'a t
+        let iter_up = iter_up
+        let iter_down = iter_down
+      end
+    )
+
+  (* Non-recursive versions *)
+
+  let map_nonrec f e =
+    let f_cons, sub_e = subs_cons e in
+      f_cons (List.map f sub_e)
+
+  let fold_nonrec f acc e =
+    let _, sub_e = subs_cons e in
+    let acc = List.fold_left f acc sub_e in
+      acc
+
+  let foldmap_nonrec f acc e =
+    let f_cons, sub_e = subs_cons e in
+    let acc, el = List.fold_left_map f acc sub_e in
+      acc, f_cons el
+
+  (* Just because we had fun writing it :] *)
+  let map_down_fix f = traverse_map
+      (fun tra e ->
+        let rec fixtra e =
+          let e' = tra e in
+            if e' = e then e else fixtra e' in
+          fixtra (f e))
+
+
+  type ('b, 'c) sub = ('b, 'c X.t, 'c X.t, 'b) Utils.sub
+
+  let lift_iter_up sub f c =
+    let _, l = sub c in
+      List.iter (iter_up f) l
+  let lift_iter_down sub f c =
+    let _, l = sub c in
+      List.iter (iter_down f) l
+  let lift_map_up sub f c =
+    let unsub, l = sub c in
+    let l2 = List.map (map_up f) l in
+      unsub l2
+  let lift_map_down sub f c =
+    let unsub, l = sub c in
+    let l2 = List.map (map_down f) l in
+      unsub l2
+  let lift_fold_up_combine sub ?(combine=fun _ b -> b) f acc c =
+    let _, l = sub c in
+      List.fold_left (fold_up_combine ~combine f) acc l
+  let lift_fold sub f acc c =
+    let _, l = sub c in
+      List.fold_left (fold_down f) acc l
+  let lift_fold_right_down sub f c acc =
+    let _, l = sub c in
+      List.fold_right (fold_right_down f) l acc
+  let lift_foldmap_up sub f acc c =
+    let unsub, l = sub c in
+    let acc2, l2 = List.fold_left_map (foldmap_up f) acc l in
+      acc2, unsub l2
+  let lift_foldmap_down sub f acc c =
+    let unsub, l = sub c in
+    let acc2, l2 = List.fold_left_map (foldmap_down f) acc l in
+      acc2, unsub l2
+  let lift_exists sub f c =
+    let _, l = sub c in
+      List.exists (exists f) l
+end
+
+module MakePair (Fst : TraverseInterface.S) (Snd : TraverseInterface.S) =
+  Make (struct
+    type 'a t = 'a Fst.t * 'a Snd.t
+    let subs_cons (x1, x2) =
+      let f1, l1 = Fst.subs_cons x1
+      and f2, l2 = Snd.subs_cons x2 in
+      let f l =
+        let (l1, l2) = List.split l in
+          (f1 l1, f2 l2)
+      and l = List.combine l1 l2 in
+        (f, l)
+  end)
+
+(* =============================================================== *)
+
+open TraverseInterface
+
+module Unoptimized =
+struct
+
+  type ('acc, 't, 't2) foldmap = ('acc -> 't -> 'acc * 't) -> 'acc -> 't2 -> 'acc * 't2
+  let iter foldmap iter t = fst (foldmap (fun () t -> let _ = iter t in ((), t)) () t)
+  let map foldmap map t = snd (foldmap (fun () t -> ((), map t)) () t)
+  let fold foldmap fold acc t = fst (foldmap (fun acc t -> fold acc t, t) acc t)
+
+  type ('acc, 'tA, 'tB) foldmapAB =
+    ('acc -> 'tA -> 'acc * 'tA) ->
+    ('acc -> 'tB -> 'acc * 'tB) ->
+    'acc -> 'tA -> 'acc * 'tA
+  let iterAB foldmap iterA iterB t =
+    fst (foldmap (fun () tA -> iterA tA; ((), tA)) (fun () tB -> iterB tB; ((), tB)) () t)
+  let mapAB foldmap mapA mapB t =
+    snd (foldmap (fun () tA -> ((), mapA tA)) (fun () tB -> ((), mapB tB)) () t)
+  let foldAB foldmap foldA foldB acc t =
+    fst (foldmap (fun acc tA -> foldA acc tA, tA) (fun acc tB -> foldB acc tB, tB) acc t)
+end
+
+module Make2 (X : S2) =
+struct
+  type 'a t = 'a X.t constraint 'a = _ * _ * _
+  type 'a container = 'a X.t constraint 'a = _ * _ * _
+  let xfoldmap = X.foldmap
+  let xiter = X.iter
+  let xmap = X.map
+  let xfold = X.fold
+  exception StopExists
+  let xexists exists t =
+    try xiter (fun t -> if exists t then raise StopExists) t; false
+    with StopExists -> true
+
+  let xfindmap findmap t =
+    let r = ref None in
+      try
+        xiter (fun t ->
+          match findmap t with
+          | Some a -> r := Some a; raise StopExists
+          | None -> ()) t;
+        None
+      with StopExists -> !r
+
+  (* <!> beware by factorizing arguments,
+     it may lead to infinity recursive loop @runtime (should not, needs further investigation)
+     Solution to this long standing mystery: you probably wrote
+     [let rec traverse_foldmap f = f (xfoldmap (traverse_foldmap f))]
+  *)
+
+  (* Higher-order *)
+  exception StopForall
+  let xforall forall t =
+    try xiter (fun t -> if not (forall t) then raise StopForall) t; true
+    with StopForall -> false
+
+  let traverse_iter f =
+    let rec tra e = xiter aux e
+    and aux e = f tra e in
+      aux
+  let traverse_map f =
+    let rec tra e = xmap aux e
+    and aux e = f tra e in
+      aux
+  let traverse_fold f =
+    let rec tra acc e = xfold aux acc e
+    and aux acc e = f tra acc e in
+      aux
+  let traverse_foldmap f =
+    let rec tra acc e = xfoldmap aux acc e
+    and aux acc e = f tra acc e in
+      aux
+  let traverse_exists f =
+    let rec tra e = xexists aux e
+    and aux e = f tra e in
+      aux
+  let traverse_forall f =
+    let rec tra e = xforall aux e
+    and aux e = f tra e in
+      aux
+  let traverse_findmap f =
+    let rec tra e = xfindmap aux e
+    and aux e = f tra e in
+      aux
+  let traverse_foldmap_context_down f =
+    let rec tra env acc e = xfoldmap (fun acc e -> aux env acc e) acc e
+    and aux env acc e = f tra env acc e in
+      aux
+  let traverse_map_context_down f =
+    let rec tra env e = xmap (fun e -> aux env e) e
+    and aux env e = f tra env e in
+      aux
+  let traverse_fold_context_down f =
+    let rec tra env acc e = xfold (fun acc e -> aux env acc e) acc e
+    and aux env acc e = f tra env acc e in
+      aux
+  let traverse_iter_context_down f =
+    let rec tra env e = xiter (fun e -> aux env e) e
+    and aux env e = f tra env e in
+      aux
+  let traverse_forall_context_down f =
+    let rec tra env e = xforall (fun e -> aux env e) e
+    and aux env e = f tra env e in
+      aux
+  let traverse_exists_context_down f =
+    let rec tra env e = xexists (fun e -> aux env e) e
+    and aux env e = f tra env e in
+      aux
+
+  let self_traverse_iter f =
+    let rec tra e = xiter aux e
+    and aux e = f aux tra e in
+      aux
+  let self_traverse_map f =
+    let rec tra e = xmap aux e
+    and aux e = f aux tra e in
+      aux
+  let self_traverse_fold f =
+    let rec tra acc e = xfold aux acc e
+    and aux acc e = f aux tra acc e in
+      aux
+  let self_traverse_foldmap f =
+    let rec tra acc e = xfoldmap aux acc e
+    and aux acc e = f aux tra acc e in
+      aux
+  let self_traverse_exists f =
+    let rec tra e = xexists aux e
+    and aux e = f aux tra e in
+      aux
+  let self_traverse_forall f =
+    let rec tra e = xforall aux e
+    and aux e = f aux tra e in
+      aux
+  let self_traverse_findmap f =
+    let rec tra e = xfindmap aux e
+    and aux e = f aux tra e in
+      aux
+  let self_traverse_foldmap_context_down f =
+    let rec tra env acc e = xfoldmap (fun acc e -> aux env acc e) acc e
+    and aux env acc e = f aux tra env acc e in
+      aux
+  let self_traverse_map_context_down f =
+    let rec tra env e = xmap (fun e -> aux env e) e
+    and aux env e = f aux tra env e in
+      aux
+  let self_traverse_fold_context_down f =
+    let rec tra env acc e = xfold (fun acc e -> aux env acc e) acc e
+    and aux env acc e = f aux tra env acc e in
+      aux
+  let self_traverse_iter_context_down f =
+    let rec tra env e = xiter (fun e -> aux env e) e
+    and aux env e = f aux tra env e in
+      aux
+  let self_traverse_forall_context_down f =
+    let rec tra env e = xforall (fun e -> aux env e) e
+    and aux env e = f aux tra env e in
+      aux
+  let self_traverse_exists_context_down f =
+    let rec tra env e = xexists (fun e -> aux env e) e
+    and aux env e = f aux tra env e in
+      aux
+
+  (* iter *)
+  let iter_up f = traverse_iter (fun tra e -> tra e; f e)
+  let iter_down f = traverse_iter (fun tra e -> f e; tra e)
+  let iter = iter_down
+
+  (* map *)
+  let map_up f = traverse_map (fun tra e -> f (tra e))
+  let map_down f = traverse_map (fun tra e -> tra (f e))
+  let map = map_up (* down can loop *)
+
+  (* fold *)
+  let fold_up f = traverse_fold (fun tra acc e -> f (tra acc e) e)
+  let fold_down f = traverse_fold (fun tra acc e -> tra (f acc e) e)
+  let fold = fold_down
+
+  (* foldmap *)
+  let foldmap_up f = traverse_foldmap (fun tra acc e -> let acc, e = tra acc e in f acc e)
+  let foldmap_down f = traverse_foldmap (fun tra acc e -> let acc, e = f acc e in tra acc e)
+  let foldmap = foldmap_up (* down can loop *)
+
+  (* exists, find, find_map *)
+  include MakeFromIter(
+      struct
+        type 'a t = ('b * 'c * 'd) X.t constraint 'a = 'b * 'c * 'd
+        type 'a container = 'a X.t
+        let iter_up = iter_up
+        let iter_down = iter_down
+      end
+    )
+
+  (* iterators with contexts *)
+  let rec foldmap_context_down f env acc v =
+    let env, acc, v = f env acc v in
+      xfoldmap (fun acc e -> foldmap_context_down f env acc e) acc v
+  let rec fold_context_down f env acc v =
+    let env, acc = f env acc v in
+      xfold (fun acc e -> fold_context_down f env acc e) acc v
+  let rec map_context_down f env v =
+    let env, v = f env v in
+      xmap (fun e -> map_context_down f env e) v
+  let rec iter_context_down f env v =
+    let env = f env v in
+      xiter (fun v -> iter_context_down f env v) v
+
+  let iter_nonrec = X.iter
+  let map_nonrec = X.map
+  let fold_nonrec = X.fold
+  let foldmap_nonrec = X.foldmap
+  let exists_nonrec = xexists
+  let forall_nonrec = xforall
+end
+
+module MakeLift2 (Y : LIFT2) (X : TRAVERSE with type 'a container = 'a Y.t) =
+struct
+  type 'a t = 'a X.t
+  type 'a container = 'a Y.container
+
+  (* high-order *)
+  exception StopExists
+  let yexists exists cont =
+    try
+      Y.iter (fun t -> if exists t then raise StopExists) cont;
+      false
+    with StopExists -> true
+
+  exception StopForall
+  let yforall forall cont =
+    try
+      Y.iter (fun t -> if not (forall t) then raise StopForall) cont;
+      true
+    with StopForall -> false
+
+  let yfindmap findmap t =
+    let r = ref None in
+      try
+        Y.iter (fun t ->
+          match findmap t with
+          | Some a -> r := Some a; raise StopExists
+          | None -> ()) t;
+        None
+      with StopExists -> !r
+
+  let traverse_iter f = Y.iter (X.traverse_iter f)
+  let traverse_map f = Y.map (X.traverse_map f)
+  let traverse_fold f = Y.fold (X.traverse_fold f)
+  let traverse_foldmap f = Y.foldmap (X.traverse_foldmap f)
+  let traverse_exists f = yexists (X.traverse_exists f)
+  let traverse_forall f = yforall (X.traverse_forall f)
+  let traverse_findmap f = yfindmap (X.traverse_findmap f)
+  let traverse_iter_context_down f env = Y.iter (let g = X.traverse_iter_context_down f in fun e -> g env e)
+  let traverse_fold_context_down f env = Y.fold (let g = X.traverse_fold_context_down f in fun acc e -> g env acc e)
+  let traverse_map_context_down f env = Y.map (let g = X.traverse_map_context_down f in fun e -> g env e)
+  let traverse_foldmap_context_down f env = Y.foldmap (let g = X.traverse_foldmap_context_down f in fun acc e -> g env acc e)
+  let traverse_forall_context_down f env = yforall (let g = X.traverse_forall_context_down f in fun e -> g env e)
+  let traverse_exists_context_down f env = yexists (let g = X.traverse_exists_context_down f in fun e -> g env e)
+
+  let self_traverse_iter f = Y.iter (X.self_traverse_iter f)
+  let self_traverse_map f = Y.map (X.self_traverse_map f)
+  let self_traverse_fold f = Y.fold (X.self_traverse_fold f)
+  let self_traverse_foldmap f = Y.foldmap (X.self_traverse_foldmap f)
+  let self_traverse_exists f = yexists (X.self_traverse_exists f)
+  let self_traverse_forall f = yforall (X.self_traverse_forall f)
+  let self_traverse_findmap f = yfindmap (X.self_traverse_findmap f)
+  let self_traverse_iter_context_down f env = Y.iter (let g = X.self_traverse_iter_context_down f in fun e -> g env e)
+  let self_traverse_fold_context_down f env = Y.fold (let g = X.self_traverse_fold_context_down f in fun acc e -> g env acc e)
+  let self_traverse_map_context_down f env = Y.map (let g = X.self_traverse_map_context_down f in fun e -> g env e)
+  let self_traverse_foldmap_context_down f env = Y.foldmap (let g = X.self_traverse_foldmap_context_down f in fun acc e -> g env acc e)
+  let self_traverse_forall_context_down f env = yforall (let g = X.self_traverse_forall_context_down f in fun e -> g env e)
+  let self_traverse_exists_context_down f env = yexists (let g = X.self_traverse_exists_context_down f in fun e -> g env e)
+
+  (* iter *)
+  let iter f = Y.iter (X.iter f)
+  let iter_up f = Y.iter (X.iter_up f)
+  let iter_down f = Y.iter (X.iter_down f)
+
+  (* map *)
+  let map f = Y.map (X.map f)
+  let map_up f = Y.map (X.map_up f)
+  let map_down f = Y.map (X.map_down f)
+
+  (* fold *)
+  let fold f = Y.fold (X.fold f)
+  let fold_up f = Y.fold (X.fold_up f)
+  let fold_down f = Y.fold (X.fold_down f)
+
+  (* foldmap *)
+  let foldmap f = Y.foldmap (X.foldmap f)
+  let foldmap_up f = Y.foldmap (X.foldmap_up f)
+  let foldmap_down f = Y.foldmap (X.foldmap_down f)
+
+  (* traversal with context *)
+  let iter_context_down f env = Y.iter (fun e -> X.iter_context_down f env e)
+  let fold_context_down f env = Y.fold (fun acc e -> X.fold_context_down f env acc e)
+  let map_context_down f env = Y.map (fun e -> X.map_context_down f env e)
+  let foldmap_context_down f env = Y.foldmap (fun acc e -> X.foldmap_context_down f env acc e)
+
+  include MakeFromIter(
+      struct
+        type 'a t = 'a X.t
+        type 'a container = 'a Y.container
+        let iter_up = iter_up
+        let iter_down = iter_down
+      end
+    )
+
+  (* non rec *)
+  let iter_nonrec f = Y.iter (fun e -> X.iter_nonrec f e)
+  let map_nonrec f = Y.map (fun e -> X.map_nonrec f e)
+  let fold_nonrec f = Y.fold (fun acc e -> X.fold_nonrec f acc e)
+  let foldmap_nonrec f = Y.foldmap (fun acc e -> X.foldmap_nonrec f acc e)
+  let exists_nonrec f = yexists (fun e -> X.exists_nonrec f e)
+  let forall_nonrec f = yforall (fun e -> X.forall_nonrec f e)
+end
+
+module MakeLift1 (Y : LIFT2) (X :  TRAVERSE with type 'a container = 'a Y.t and type 'a t = 'a Y.t)  =
+struct
+  include MakeLift2(Y)(X)
+  let iter_nonrec = Y.iter
+  let map_nonrec = Y.map
+  let fold_nonrec = Y.fold
+  let foldmap_nonrec = Y.foldmap
+  let exists_nonrec = yexists
+  let forall_nonrec = yforall
+end
+
+(* mutual recursive types *)
+
+module type IteratedType12 =
+sig
+  type 'p t1 constraint 'p = _ * _ * _
+  type 'p t2 constraint 'p = _ * _ * _
+  val iter_up : ('p t1 -> unit) -> ('p t2 -> unit) -> 'p t1 -> unit
+  val iter_down : ('p t1 -> unit) -> ('p t2 -> unit) -> 'p t1 -> unit
+end
+module MakeFromIter12 (X : IteratedType12) =
+struct
+  let find_up predA predB tree =
+    Return.set_checkpoint_opt
+      (fun label ->
+        X.iter_up
+          (fun e -> if predA e then Return.return label (Base.Left e))
+          (fun e -> if predB e then Return.return label (Base.Right e))
+          tree)
+  let find_down predA predB tree =
+    Return.set_checkpoint_opt
+      (fun label ->
+        X.iter_down
+          (fun e -> if predA e then Return.return label (Base.Left e))
+          (fun e -> if predB e then Return.return label (Base.Right e))
+          tree)
+  let find = find_up
+
+  let findmap_up predA predB tree =
+    Return.set_checkpoint_opt
+      (fun label ->
+        X.iter_up
+          (fun e -> match predA e with Some e -> Return.return label e | None -> ())
+          (fun e -> match predB e with Some e -> Return.return label e | None -> ())
+          tree)
+  let findmap_down predA predB tree =
+    Return.set_checkpoint_opt
+      (fun label ->
+        X.iter_down
+          (fun e -> match predA e with Some e -> Return.return label e | None -> ())
+          (fun e -> match predB e with Some e -> Return.return label e | None -> ())
+          tree)
+  let findmap = findmap_up
+
+  let exists_up fa fb tree = find_up fa fb tree <> None
+  let exists_down fa fb tree = find_down fa fb tree <> None
+  let exists = exists_up
+end
+
+module type X_12 =
+sig
+  include AB
+  val existsA : ('p tA -> bool) -> ('p tB -> bool) -> 'p tA -> bool
+  val existsB : ('p tB -> bool) -> ('p tA -> bool) -> 'p tB -> bool
+  val findmapA : ('p tA -> 'a option) -> ('p tB -> 'a option) -> 'p tA -> 'a option
+  val findmapB : ('p tB -> 'a option) -> ('p tA -> 'a option) -> 'p tB -> 'a option
+  val forallA : ('p tA -> bool) -> ('p tB -> bool) -> 'p tA -> bool
+  val forallB : ('p tB -> bool) -> ('p tA -> bool) -> 'p tB -> bool
+end
+
+
+module Make12 (AB : X_12) =
+struct
+  type 'p t1 = 'p AB.tA
+  type 'p t2 = 'p AB.tB
+
+  let traverse_iter fA fB =
+    let rec traA e = AB.iterA auxA auxB e
+    and traB e = AB.iterB auxB auxA e
+    and auxA e = fA traA traB e
+    and auxB e = fB traB traA e in
+      auxA
+
+  let traverse_map fA fB =
+    let rec traA e = AB.mapA auxA auxB e
+    and traB e = AB.mapB auxB auxA e
+    and auxA e = fA traA traB e
+    and auxB e = fB traB traA e in
+      auxA
+
+  let traverse_fold fA fB =
+    let rec traA acc e = AB.foldA auxA auxB acc e
+    and traB acc e = AB.foldB auxB auxA acc e
+    and auxA acc e = fA traA traB acc e
+    and auxB acc e = fB traB traA acc e in
+      auxA
+
+  let traverse_foldmap fA fB =
+    let rec traA acc e = AB.foldmapA auxA auxB acc e
+    and traB acc e = AB.foldmapB auxB auxA acc e
+    and auxA acc e = fA traA traB acc e
+    and auxB acc e = fB traB traA acc e in
+      auxA
+
+  let traverse_exists fA fB =
+    let rec traA e = AB.existsA auxA auxB e
+    and traB e = AB.existsB auxB auxA e
+    and auxA e = fA traA traB e
+    and auxB e = fB traB traA e in
+      auxA
+
+  let traverse_forall fA fB =
+    let rec traA e = AB.forallA auxA auxB e
+    and traB e = AB.forallB auxB auxA e
+    and auxA e = fA traA traB e
+    and auxB e = fB traB traA e in
+      auxA
+
+  let traverse_findmap fA fB =
+    let rec traA e = AB.findmapA auxA auxB e
+    and traB e = AB.findmapB auxB auxA e
+    and auxA e = fA traA traB e
+    and auxB e = fB traB traA e in
+      auxA
+
+  let traverse_foldmap_context_down fA fB =
+    let rec traA env acc a = AB.foldmapA (fun acc a -> auxA env acc a) (fun acc b -> auxB env acc b) acc a
+    and traB env acc e = AB.foldmapB (fun acc b -> auxB env acc b) (fun acc a -> auxA env acc a) acc e
+    and auxA env acc e = fA traA traB env acc e
+    and auxB env acc e = fB traB traA env acc e in
+      auxA
+  let traverse_map_context_down fA fB =
+    let rec traA env e = AB.mapA (fun a -> auxA env a) (fun b -> auxB env b) e
+    and traB env e = AB.mapB (fun b -> auxB env b) (fun a -> auxA env a) e
+    and auxA env e = fA traA traB env e
+    and auxB env e = fB traB traA env e in
+      auxA
+  let traverse_fold_context_down fA fB =
+    let rec traA env acc e = AB.foldA (fun acc a -> auxA env acc a) (fun acc b -> auxB env acc b) acc e
+    and traB env acc e = AB.foldB (fun acc b -> auxB env acc b) (fun acc a -> auxA env acc a) acc e
+    and auxA env acc e = fA traA traB env acc e
+    and auxB env acc e = fB traB traA env acc e in
+      auxA
+  let traverse_iter_context_down fA fB =
+    let rec traA env e = AB.iterA (fun a -> auxA env a) (fun b -> auxB env b) e
+    and traB env e = AB.iterB (fun b -> auxB env b) (fun a -> auxA env a) e
+    and auxA env e = fA traA traB env e
+    and auxB env e = fB traB traA env e in
+      auxA
+  let traverse_forall_context_down fA fB =
+    let rec traA env a = AB.forallA (fun a -> auxA env a) (fun b -> auxB env b) a
+    and traB env b = AB.forallB (fun b -> auxB env b) (fun a -> auxA env a) b
+    and auxA env a = fA traA traB env a
+    and auxB env b = fB traB traA env b in
+      auxA
+  let traverse_exists_context_down fA fB =
+    let rec traA env a = AB.existsA (fun a -> auxA env a) (fun b -> auxB env b) a
+    and traB env b = AB.existsB (fun b -> auxB env b) (fun a -> auxA env a) b
+    and auxA env a = fA traA traB env a
+    and auxB env b = fB traB traA env b in
+      auxA
+
+  let self_traverse_iter fA fB =
+    let rec traA e = AB.iterA auxA auxB e
+    and traB e = AB.iterB auxB auxA e
+    and auxA e = fA auxA traA auxB traB e
+    and auxB e = fB auxB traB auxA traA e in
+      auxA
+  let self_traverse_map fA fB =
+    let rec traA e = AB.mapA auxA auxB e
+    and traB e = AB.mapB auxB auxA e
+    and auxA e = fA auxA traA auxB traB e
+    and auxB e = fB auxB traB auxA traA e in
+      auxA
+  let self_traverse_fold fA fB =
+    let rec traA acc e = AB.foldA auxA auxB acc e
+    and traB acc e = AB.foldB auxB auxA acc e
+    and auxA acc e = fA auxA traA auxB traB acc e
+    and auxB acc e = fB auxB traB auxA traA acc e in
+      auxA
+  let self_traverse_foldmap fA fB =
+    let rec traA acc e = AB.foldmapA auxA auxB acc e
+    and traB acc e = AB.foldmapB auxB auxA acc e
+    and auxA acc e = fA auxA traA auxB traB acc e
+    and auxB acc e = fB auxB traB auxA traA acc e in
+      auxA
+  let self_traverse_exists fA fB =
+    let rec traA e = AB.existsA auxA auxB e
+    and traB e = AB.existsB auxB auxA e
+    and auxA e = fA auxA traA auxB traB e
+    and auxB e = fB auxB traB auxA traA e in
+      auxA
+  let self_traverse_forall fA fB =
+    let rec traA e = AB.forallA auxA auxB e
+    and traB e = AB.forallB auxB auxA e
+    and auxA e = fA auxA traA auxB traB e
+    and auxB e = fB auxB traB auxA traA e in
+      auxA
+  let self_traverse_findmap fA fB =
+    let rec traA e = AB.findmapA auxA auxB e
+    and traB e = AB.findmapB auxB auxA e
+    and auxA e = fA auxA traA auxB traB e
+    and auxB e = fB auxB traB auxA traA e in
+      auxA
+
+  let self_traverse_foldmap_context_down fA fB =
+    let rec traA env acc a = AB.foldmapA (fun acc a -> auxA env acc a) (fun acc b -> auxB env acc b) acc a
+    and traB env acc e = AB.foldmapB (fun acc b -> auxB env acc b) (fun acc a -> auxA env acc a) acc e
+    and auxA env acc e = fA auxA traA auxB traB env acc e
+    and auxB env acc e = fB auxB traB auxA traA env acc e in
+      auxA
+  let self_traverse_map_context_down fA fB =
+    let rec traA env e = AB.mapA (fun a -> auxA env a) (fun b -> auxB env b) e
+    and traB env e = AB.mapB (fun b -> auxB env b) (fun a -> auxA env a) e
+    and auxA env e = fA auxA traA auxB traB env e
+    and auxB env e = fB auxB traB auxA traA env e in
+      auxA
+  let self_traverse_fold_context_down fA fB =
+    let rec traA env acc e = AB.foldA (fun acc a -> auxA env acc a) (fun acc b -> auxB env acc b) acc e
+    and traB env acc e = AB.foldB (fun acc b -> auxB env acc b) (fun acc a -> auxA env acc a) acc e
+    and auxA env acc e = fA auxA traA auxB traB env acc e
+    and auxB env acc e = fB auxB traB auxA traA env acc e in
+      auxA
+  let self_traverse_iter_context_down fA fB =
+    let rec traA env e = AB.iterA (fun a -> auxA env a) (fun b -> auxB env b) e
+    and traB env e = AB.iterB (fun b -> auxB env b) (fun a -> auxA env a) e
+    and auxA env e = fA auxA traA auxB traB env e
+    and auxB env e = fB auxB traB auxA traA env e in
+      auxA
+  let self_traverse_forall_context_down fA fB =
+    let rec traA env a = AB.forallA (fun a -> auxA env a) (fun b -> auxB env b) a
+    and traB env b = AB.forallB (fun b -> auxB env b) (fun a -> auxA env a) b
+    and auxA env a = fA auxA traA auxB traB env a
+    and auxB env b = fB auxB traB auxA traA env b in
+      auxA
+  let self_traverse_exists_context_down fA fB =
+    let rec traA env a = AB.existsA (fun a -> auxA env a) (fun b -> auxB env b) a
+    and traB env b = AB.existsB (fun b -> auxB env b) (fun a -> auxA env a) b
+    and auxA env a = fA auxA traA auxB traB env a
+    and auxB env b = fB auxB traB auxA traA env b in
+      auxA
+
+  let iter_up fA fB = traverse_iter (fun traA _ e -> traA e; fA e) (fun traB _ e -> traB e; fB e)
+  let iter_down fA fB = traverse_iter (fun traA _ e -> fA e; traA e) (fun traB _ e -> fB e; traB e)
+  let iter = iter_down
+
+  let map_up fA fB = traverse_map (fun traA _ e -> fA (traA e)) (fun traB _ e -> fB (traB e))
+  let map_down fA fB = traverse_map (fun traA _ e -> traA (fA e)) (fun traB _ e -> traB (fB e))
+  let map = map_up (* down can loop *)
+
+  let fold_up fA fB = traverse_fold (fun traA _ acc e -> fA (traA acc e) e) (fun traB _ acc e -> fB (traB acc e) e)
+  let fold_down fA fB = traverse_fold (fun traA _ acc e -> traA (fA acc e) e) (fun traB _ acc e -> traB (fB acc e) e)
+  let fold = fold_down
+
+  let foldmap_up fA fB =
+    traverse_foldmap
+      (fun traA _ acc e -> let acc, e = traA acc e in fA acc e)
+      (fun traB _ acc e -> let acc, e = traB acc e in fB acc e)
+  let foldmap_down fA fB =
+    traverse_foldmap
+      (fun traA _ acc e -> let acc, e = fA acc e in traA acc e)
+      (fun traB _ acc e -> let acc, e = fB acc e in traB acc e)
+  let foldmap = foldmap_up (* down can loop *)
+
+  include MakeFromIter12(
+      struct
+        type 'p t1 = 'p AB.tA
+        type 'p t2 = 'p AB.tB
+        let iter_up = iter_up
+        let iter_down = iter_down
+      end
+    )
+
+  let foldmap_context_down fA fB =
+    traverse_foldmap_context_down
+      (fun traA _ env acc a -> let env, acc, a = fA env acc a in traA env acc a)
+      (fun traB _ env acc b -> let env, acc, b = fB env acc b in traB env acc b)
+  let fold_context_down fA fB =
+    traverse_fold_context_down
+      (fun traA _ env acc a -> let env, acc = fA env acc a in traA env acc a)
+      (fun traB _ env acc b -> let env, acc = fB env acc b in traB env acc b)
+  let map_context_down fA fB =
+    traverse_map_context_down
+      (fun traA _ env a -> let env, a = fA env a in traA env a)
+      (fun traB _ env b -> let env, b = fB env b in traB env b)
+  let iter_context_down fA fB =
+    traverse_iter_context_down
+      (fun traA _ env a -> let env = fA env a in traA env a)
+      (fun traB _ env b -> let env = fB env b in traB env b)
+
+  let iter_nonrec = AB.iterA
+  let map_nonrec = AB.mapA
+  let fold_nonrec = AB.foldA
+  let foldmap_nonrec = AB.foldmapA
+  let exists_nonrec = AB.existsA
+  let forall_nonrec = AB.forallA
+end
+
+module MakeAB (AB : AB) =
+struct
+  type 'p tA = 'p AB.tA
+  type 'p tB = 'p AB.tB
+
+  exception StopExists
+  let existsGEN iterA existsA existsB tA =
+    try
+      iterA
+        (fun tA -> if existsA tA then raise StopExists)
+        (fun tB -> if existsB tB then raise StopExists)
+        tA;
+      false
+    with StopExists -> true
+
+  let existsA a = existsGEN AB.iterA a
+  let existsB a = existsGEN AB.iterB a
+
+  let findmapGEN iterA findmapA findmapB tA =
+    let r = ref None in
+      try
+        iterA
+          (fun tA -> match findmapA tA with
+          | Some a -> r := Some a; raise StopExists
+          | None -> ())
+          (fun tB -> match findmapB tB with
+          | Some a -> r := Some a; raise StopExists
+          | None -> ())
+          tA
+      ;
+        None
+      with StopExists -> !r
+
+  let findmapA a = findmapGEN AB.iterA a
+  let findmapB a = findmapGEN AB.iterB a
+
+  exception StopForall
+  let forallGEN iterA forallA forallB tA =
+    try
+      iterA
+        (fun tA -> if not (forallA tA) then raise StopForall)
+        (fun tB -> if not (forallB tB) then raise StopForall)
+        tA;
+      true
+    with StopForall -> false
+
+  let forallA a = forallGEN AB.iterA a
+  let forallB a = forallGEN AB.iterB a
+
+  module A = Make12 (
+      struct
+        include AB
+        let existsA = existsA
+        let existsB = existsB
+        let findmapA = findmapA
+        let findmapB = findmapB
+        let forallA = forallA
+        let forallB = forallB
+      end
+    )
+
+  module B = Make12 (
+      struct
+        type 'p tA = 'p AB.tB
+        type 'p tB = 'p AB.tA
+        let foldmapA = AB.foldmapB
+        let foldmapB = AB.foldmapA
+        let iterA = AB.iterB
+        let iterB = AB.iterA
+        let mapA = AB.mapB
+        let mapB = AB.mapA
+        let foldA = AB.foldB
+        let foldB = AB.foldA
+        let existsA, existsB = existsB, existsA
+        let findmapA, findmapB = findmapB, findmapA
+        let forallA, forallB = forallB, forallA
+      end
+    )
+
+  module AinA = Make2 (
+      struct
+        type 'p t = 'p tA
+
+        let foldmap traA acc e =
+          let rec traB acc e = AB.foldmapB traB traA acc e in
+            AB.foldmapA traA traB acc e
+
+        let iter traA e =
+          let rec traB e = AB.iterB traB traA e in
+            AB.iterA traA traB e
+
+        let map traA e =
+          let rec traB e = AB.mapB traB traA e in
+            AB.mapA traA traB e
+
+        let fold traA acc e =
+          let rec traB acc e = AB.foldB traB traA acc e in
+            AB.foldA traA traB acc e
+      end
+    )
+
+  module BinB = Make2 (
+      struct
+        type 'p t = 'p tB
+
+        let foldmap traB acc e =
+          let rec traA acc e = AB.foldmapA traA traB acc e in
+            AB.foldmapB traB traA acc e
+
+        let iter traB e =
+          let rec traA e = AB.iterA traA traB e in
+            AB.iterB traB traA e
+
+        let map traB e =
+          let rec traA e = AB.mapA traA traB e in
+            AB.mapB traB traA e
+
+        let fold traB acc e =
+          let rec traA acc e = AB.foldA traA traB acc e in
+            AB.foldB traB traA acc e
+      end
+    )
+
+  module OnlyA = Make2 (
+      struct
+        type 'p t = 'p tA
+
+        let foldmap traA acc e =
+          let traB acc e = acc, e in
+            AB.foldmapA traA traB acc e
+
+        let iter traA e =
+          let traB _ = () in
+            AB.iterA traA traB e
+
+        let map traA e =
+          let traB e = e in
+            AB.mapA traA traB e
+
+        let fold traA acc e =
+          let traB acc _ = acc in
+            AB.foldA traA traB acc e
+      end
+    )
+
+  module OnlyB = Make2 (
+      struct
+        type 'p t = 'p tB
+
+        let foldmap traB acc e =
+          let traA acc e = acc, e in
+            AB.foldmapB traB traA acc e
+
+        let iter traB e =
+          let traA _ = () in
+            AB.iterB traB traA e
+
+        let map traB e =
+          let traA e = e in
+            AB.mapB traB traA e
+
+        let fold traB acc e =
+          let traA acc _ = acc in
+            AB.foldB traB traA acc e
+      end
+    )
+
+  module AinB = MakeLift1 (
+      struct
+        type 'p t = 'p tA
+        type 'p container = 'p tB
+
+        (* : ('acc -> 'p tA -> 'acc * 'p tA) -> 'acc -> 'p tB -> 'acc * 'p tB *)
+        let foldmap traA acc e =
+          let rec traB acc e = AB.foldmapB traB traA acc e in
+            AB.foldmapB traB traA acc e
+
+        (* : ('p tA -> unit) -> 'p tB -> unit *)
+        let iter traA e =
+          let rec traB e = AB.iterB traB traA e in
+            AB.iterB traB traA e
+
+        (* : ('p tA -> 'p tA) -> 'p tB -> 'p tB *)
+        let map traA e =
+          let rec traB e = AB.mapB traB traA e in
+            AB.mapB traB traA e
+
+        (* : ('acc -> 'p tA -> 'acc) -> 'acc -> 'p tB -> 'acc *)
+        let fold traA acc e =
+          let rec traB acc e = AB.foldB traB traA acc e in
+            AB.foldB traB traA acc e
+      end
+    ) (AinA)
+
+  module BinA = MakeLift1 (
+      struct
+        type 'p t = 'p tB
+        type 'p container = 'p tA
+
+        (* : ('acc -> 'p tB -> 'acc * 'p tB) -> 'acc -> 'p tA -> 'acc * 'p tA *)
+        let foldmap traB acc e =
+          let rec traA acc e = AB.foldmapA traA traB acc e in
+            AB.foldmapA traA traB acc e
+
+        (* : ('p tB -> unit) -> 'p tA -> unit *)
+        let iter traB e =
+          let rec traA e = AB.iterA traA traB e in
+            AB.iterA traA traB e
+
+        (* : ('p tB -> 'p tB) -> 'p tA -> 'p tA *)
+        let map traB e =
+          let rec traA e = AB.mapA traA traB e in
+            AB.mapA traA traB e
+
+        (* : ('acc -> 'p tB -> 'acc) -> 'acc -> 'p tA -> 'acc *)
+        let fold traB acc e =
+          let rec traA acc e = AB.foldA traA traB acc e in
+            AB.foldA traA traB acc e
+      end
+    ) (BinB)
+
+end

File ocaml/contrib/ocp-indent/tests/failing-output/unit-classes.ml

+(** ocaml classes
+   (http://caml.inria.fr/pub/docs/manual-ocaml/manual017.html)
+*)
+
+(* class types *)
+
+class type c =
+  object
+  end
+
+class type c =
+    M.cl
+
+class type c =
+  ['a, 'b] M.cl
+
+class type c =
+  object
+    ('ty)
+      inherit cl
+    val mutable virtual
+      var : bool
+    method private bar1 x ~y : bool
+    method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t
+    constraint
+      'a = 'b
+  end
+
+(* class expressions *)
+
+class c =
+  ['a, 'b]
+    M.cl
+
+class c =
+  fun a b ->
+    object
+    end
+
+class c = object
+  val x = true
+end
+
+class c =
+  object
+    (_ :
+       'a)
+      inherit Something.someclass
+    as v
+    val mutable
+      var : bool
+      = true
+    val mutable virtual var2
+      : string
+    method private bar1 x ~y : bool =
+      false
+    method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t
+    constraint
+      'a = 'b
+    initializer
+      z
+  end
+
+(* method specific expressions *)
+
+let e =
+  var <- true
+
+let e =
+  {< var = false;
+     var2 = true;
+  >}
+
+
+(* class definitions *)
+
+class cl =
+  object
+    val x = true
+  end
+and
+virtual ['a, 'b]
+    cl2 x y :
+    object
+      val x : bool
+    end = fun x y ->
+  object
+    val x : bool = true
+  end
+
+class cl
+  : object end
+
+class type virtual ['a] clty = object
+  method x : int
+end
+
+(* objects *)
+val a :
+  < >
+
+val a :
+  < .. >
+
+val a :
+  < meth: int option;
+  meth2: 'a. 'a option;
+  meth3: 'a 'b. ('a,'b) Hashtbl.t >
+
+val a :
+  < meth: int option;
+  meth2: 'a. 'a option;
+  meth3: 'a 'b. ('a,'b) Hashtbl.t;
+  .. >
+
+(* #-types *)
+val a :
+  #M.meth
+
+val a :
+  'a#M.meth
+
+val a :
+  ('a,'b*'c)
+  #M.meth
+

File ocaml/contrib/ocp-indent/tests/failing-output/unit-expr.ml

+(** ocaml expressions
+   (http://caml.inria.fr/pub/docs/manual-ocaml/expr.html)
+*)
+
+let e =
+  Array.make
+
+let e =
+  true
+
+let e =
+  (true)
+
+let e =
+  begin
+    true
+  end
+
+let e =
+  (true:
+     bool)
+
+let e =
+  true,
+  false,
+  true
+
+let e =
+  Some
+    true
+
+let e =
+  `_
+    true
+
+let e =
+  true ::
+    false ::
+    true
+
+let e =
+  [ true;
+    false;
+    true;
+  ]
+
+let e =
+  [| true;
+     false;
+     true
+  |]
+
+let e =
+  { f1 = true;
+    f2 = false;
+    f3 = true;
+  }
+
+let e =
+  { e with f1 = true;
+    f2 = false;
+  }
+
+let e =
+  f
+    true
+    false
+    true
+
+let e =
+  !?
+    true
+
+let e =
+  true
+  || false
+     && true
+
+let e =
+  1
+  mod 1
+  land 1
+  lor 1
+  lxor 1
+    lsl 1
+    lsr 1
+    asr 1
+
+let e =
+  re.f1
+
+let e =
+  re.f1 <-
+    true
+
+let e =
+  a.(0) <-
+    true
+
+let e =
+  a.[0] <-
+    true
+
+let e =
+  if
+    true
+  then
+    false
+  else
+    true
+
+let e =
+  while
+    true
+  do
+    ()
+  done
+
+let e =
+  for x =
+      a
+      to
+        b
+  do
+    ()
+  done
+
+let e =
+  true;
+  false;
+  true
+
+let e =
+  match
+    true
+  with
+  | true ->
+    false
+  | false
+    ->
+    true
+
+let e =
+  function
+  | true ->
+    false
+  | false
+    ->
+    true
+
+let e =
+  fun
+    x
+      ~ lbl1
+      ~ ( lbl2 : int )
+      ~lbl3: _a
+      ? olbl1
+      ? (olbl2 : 'a list = [])
+      ?olbl3: _c
+      ?olbl4: ( _d : bool = false )
+      ()
+    when
+        true
+    ->
+      true
+
+let e =
+  fun x ->
+  fun ~ lbl1 ->
+  fun ~ ( lbl2 : int ) ->
+  fun ~lbl3: _a ->
+  fun ? olbl1 ->
+  fun ? (olbl2 : 'a list = []) ->
+  fun ?olbl3: _c
+    when true
+    ->
+  fun ?olbl4: ( _d : bool = false ) ->
+  fun ()
+    when
+        true
+    ->
+      true
+
+let e
+    x
+    ~ lbl1
+    ~ ( lbl2 : int )
+    ~lbl3: _a
+    ? olbl1
+    ? (olbl2 : 'a list = [])
+    ?olbl3: _c
+    ?olbl4: ( _d : bool = false )
+    ()
+  =
+  true
+
+let e =
+  try
+    true
+  with
+  | Exit ->
+    true
+  | _ ->
+    false
+
+let e =
+  let rec
+    a =
+    true
+  and _b =
+    false
+  in
+  true
+
+let e =
+  new
+    foo
+
+let foo =
+  object
+  end
+
+let e =
+  foo#
+    bar1
+
+let e =
+  (true :>
+     bool)
+
+let e =
+  (true :
+     bool :>
+     bool)
+
+let e =
+  assert
+    true
+
+let e =
+  lazy
+    true
+

File ocaml/contrib/ocp-indent/tests/failing-output/unit-expressions.ml

-(** ocaml expressions
-   (http://caml.inria.fr/pub/docs/manual-ocaml/expr.html)
-*)
-
-let e =
-  Array.make
-
-let e =
-  true
-
-let e =
-  (true)
-
-let e =
-  begin
-    true
-  end
-
-let e =
-  (true:
-     bool)
-
-let e =
-  true,
-  false,
-  true
-
-let e =
-  Some
-    true
-
-let e =
-  `_
-    true
-
-let e =
-  true ::
-    false ::
-    true
-
-let e =
-  [ true;
-    false;
-    true;
-  ]
-
-let e =
-  [| true;
-     false;
-     true
-  |]
-
-let e =
-  { f1 = true;
-    f2 = false;
-    f3 = true;
-  }
-
-let e =
-  { e with f1 = true;
-    f2 = false;
-  }
-
-let e =
-  f
-    true
-    false
-    true
-
-let e =
-  !?
-    true
-
-let e =
-  true
-  || false
-     && true
-
-let e =
-  1
-  mod 1
-  land 1
-  lor 1
-  lxor 1
-    lsl 1
-    lsr 1
-    asr 1
-
-let e =
-  re.f1
-
-let e =
-  re.f1 <-
-    true
-
-let e =
-  a.(0) <-
-    true
-
-let e =
-  a.[0] <-
-    true
-
-let e =
-  if
-    true
-  then
-    false
-  else
-    true
-
-let e =
-  while
-    true
-  do
-    ()
-  done
-
-let e =
-  for x =
-      a
-      to
-        b
-  do
-    ()
-  done
-
-let e =
-  true;
-  false;
-  true
-
-let e =
-  match
-    true
-  with
-  | true ->
-    false
-  | false
-    ->
-    true
-
-let e =
-  function
-  | true ->
-    false
-  | false
-    ->
-    true
-
-let e =
-  fun
-    x
-      ~ lbl1
-      ~ ( lbl2 : int )
-      ~lbl3: _a
-      ? olbl1
-      ? (olbl2 : 'a list = [])
-      ?olbl3: _c
-      ?olbl4: ( _d : bool = false )
-      ()
-when
-    true
-    ->
-    true
-
-let e =
-  fun x ->
-    fun ~ lbl1 ->
-      fun ~ ( lbl2 : int ) ->
-        fun ~lbl3: _a ->
-          fun ? olbl1 ->
-            fun ? (olbl2 : 'a list = []) ->
-              fun ?olbl3: _c
-when true
-    ->
-    fun ?olbl4: ( _d : bool = false ) ->