diff --git a/bench/typing/good/coercions.mlw b/bench/typing/good/coercions.mlw
index f636a0f4fed56d0dc99c48664b910ad7024968de..3aeb1b491277d63a28b5e14249bac961f477fda8 100644
--- a/bench/typing/good/coercions.mlw
+++ b/bench/typing/good/coercions.mlw
@@ -11,6 +11,7 @@ module Simple
 end
 
 module SameOne
+
   use import Simple
 
 end
@@ -31,7 +32,7 @@ module SimplePolymorphic
   function f (t 'a) : int
   meta coercion function f
 
-goal G: forall x: t (bool,bool). x = 42
+  goal G: forall x: t (bool,bool). x = 42
 
 end
 
@@ -53,11 +54,13 @@ module Transitivity
 end
 
 module SameTransitivity
+
   use import Transitivity
 
 end
 
 module SameTransitivityCheck
+
   use import Transitivity
   use import SameTransitivity
 
@@ -84,13 +87,13 @@ module TrickyPolymorphicAlpha
   type t1 'a
   type t2 'a
 
- function f (t 'a) : t1 (list 'a)
- meta coercion function f
+  function f (t 'a) : t1 (list 'a)
+  meta coercion function f
 
- function g (t1 'a) : t2 (list 'a)
- meta coercion function g
+  function g (t1 'a) : t2 (list 'a)
+  meta coercion function g
 
- goal a : forall x:t int, y:t2 (list (list int)). x = y
+  goal a : forall x:t int, y:t2 (list (list int)). x = y
 
 end
 
@@ -108,27 +111,24 @@ module TrickyPolymorphicBeta
   function g (t1 'a) : t2 (list 'a)
   meta coercion function g
 
-
   goal a : forall x:t int, y:t2 (list (list int)). x = y
 
 end
 
 module InTypeArgs
 
+  type t1 'a
+  type t2 'a
+  type t3 'a
 
-type t1 'a
-type t2 'a
-type t3 'a
-
-function t2_of_t1 (t1 'a) : t2 'a
-meta coercion function t2_of_t1
-
-function bool_of_int bool : int
-meta coercion function bool_of_int
+  function t2_of_t1 (t1 'a) : t2 'a
+  meta coercion function t2_of_t1
 
+  function bool_of_int bool : int
+  meta coercion function bool_of_int
 
-function h (x: t1 'a) (b: int) : t1 int
+  function h (x: t1 'a) (b: int) : t1 int
 
-goal G: forall x: t1 'a, y: t2 int. h x true = y
+  goal G: forall x: t1 'a, y: t2 int. h x true = y
 
 end
\ No newline at end of file
diff --git a/src/core/coercion.ml b/src/core/coercion.ml
index 2202fa0e31c2649188d78f1cae2d1121ed66d1ff..6f36c8e2d361ae0e85feb20e6145e4f1fe56ebe7 100644
--- a/src/core/coercion.ml
+++ b/src/core/coercion.ml
@@ -30,16 +30,19 @@ let create_crc ls =
      { crc_kind = CRCleaf ls; crc_src = ty1; crc_tar = ty2; crc_len = 1 }
   | _ -> raise (NotACoercion ls)
 
-
-
 let mem crcmap ts1 ts2 =
   try let m = Mts.find ts1 crcmap in Mts.mem ts2 m
   with Not_found -> false
 
-let find crcmap ts1 ts2 =
+let find_crc crcmap ts1 ts2 =
   Mts.find ts2 (Mts.find ts1 crcmap)
 
-
+let find crcmap ts1 ts2 =
+  let crc = find_crc crcmap ts1 ts2 in
+  let rec ls_list_of acc = function
+    | CRCleaf ls -> ls :: acc
+    | CRCcomp (k1, k2) -> ls_list_of (ls_list_of acc k2) k1 in
+  ls_list_of [] crc.crc_kind
 
 (* replace an old coercion by a new one, or fail *)
 let rec ck_eq ck_old ck_new =
@@ -55,12 +58,11 @@ let replace c_old c_new _m1 m =
   try ck_eq c_old.crc_kind c_new.crc_kind; m
   with Not_found -> raise (CoercionAlreadyDefined c_old)
 
-
 (* add a new coercion c, without making the transitive closure *)
 let insert crc m =
   let put crc m1 m2 = Mts.add crc.crc_src (Mts.add crc.crc_tar crc m1) m2 in
   if mem m crc.crc_tar crc.crc_src then
-    raise (CoercionCycle (find m crc.crc_tar crc.crc_src));
+    raise (CoercionCycle (find_crc m crc.crc_tar crc.crc_src));
   let m1 = Mts.find_def Mts.empty crc.crc_src m in
   if Mts.mem crc.crc_tar m1 then replace (Mts.find crc.crc_tar m1) crc m1 m
   else put crc m1 m
@@ -105,7 +107,7 @@ let print_kind fmt crc =
        let s1, s2 = ty_str_of ls in
        Format.fprintf fmt "%s: %s -> %s" ls.ls_name.id_string s1 s2
     | CRCcomp (k1, k2) ->
-       Format.fprintf fmt "%a \n %a" print_kind k1 print_kind k2
+       Format.fprintf fmt "%a@\n%a" print_kind k1 print_kind k2
   in print_kind fmt crc
 
 let rec print_kind_ls fmt = function
@@ -114,10 +116,9 @@ let rec print_kind_ls fmt = function
   | CRCcomp (k1, k2) ->
      Format.fprintf fmt "%a; %a" print_kind_ls k1 print_kind_ls k2
 
-
-
 let already_a_coercion fmt crc =
-  Format.fprintf fmt "There is already a coercion [%a] from type %s to type %s@ \n %a"
+  Format.fprintf fmt
+    "There is already a coercion [%a] from type %s to type %s:@\n%a"
     print_kind_ls crc.crc_kind
     crc.crc_src.ts_name.id_string crc.crc_tar.ts_name.id_string
     print_kind crc.crc_kind
diff --git a/src/core/coercion.mli b/src/core/coercion.mli
index 5609eceaa6d9623841d9f56014ab25778b5e3640..c1a490ef547d33c7f0d3f1dd8e1ff9a38c1a2543 100644
--- a/src/core/coercion.mli
+++ b/src/core/coercion.mli
@@ -1,29 +1,21 @@
 
-
-type coercion_kind =
-  | CRCleaf of Term.lsymbol
-  | CRCcomp of coercion_kind * coercion_kind
-
-type coercion = private {
-  crc_kind: coercion_kind;
-  crc_src : Ty.tysymbol;
-  crc_tar : Ty.tysymbol;
-  crc_len : int;
-}
+open Ty
+open Term
 
 type t
   (** a set of coercions *)
 
 val empty: t
 
-val add: t -> Term.lsymbol -> t
+val add: t -> lsymbol -> t
   (** adds a new coercion from function [ls: ty1 -> ty2 ]
       raises an error if
-        - this introduces a cycle, i.e. a coercion from [ty2] to [ty1] is already defined;
-        - function [ls] cannot be coercion, i.e. [ty1 = ty2];
+        - this introduces a cycle, i.e. a coercion from [ty2] to [ty1]
+          is already defined;
+        - function [ls] cannot be used as a coercion, e.g. [ty1 = ty2];
         - a coercion from [ty1] to [ty2] is already defined *)
 
-val find: t -> Ty.tysymbol -> Ty.tysymbol -> coercion
+val find: t -> tysymbol -> tysymbol -> lsymbol list
   (** returns the coercion, or raises [Not_found] *)
 
 val union: t -> t -> t
diff --git a/src/core/dterm.ml b/src/core/dterm.ml
index f50abef6da12ebb8e56c71ce2ecef6ffee424996..59dc51bf78cdabd59378ee8e5da4d7d36299082c 100644
--- a/src/core/dterm.ml
+++ b/src/core/dterm.ml
@@ -296,15 +296,14 @@ let dpattern ?loc node =
 
 let slab_coercion = Slab.singleton Pretty.label_coercion
 
-let rec apply_coercion ~loc k dt = match k with
-  | Coercion.CRCleaf ls ->
+let apply_coercion ~loc l dt =
+  let apply dt ls =
      let (dtyl, dty) = specialize_ls ls in
      let dtl = [dt] in
      List.iter2 dterm_expected_type dtl dtyl;
      let dt = { dt_node = DTapp (ls, dtl); dt_dty  = dty; dt_loc  = loc } in
-     { dt with dt_node = DTlabel (dt, slab_coercion) }
-  | Coercion.CRCcomp (k1, k2) ->
-     apply_coercion ~loc k2 (apply_coercion ~loc k1 dt)
+     { dt with dt_node = DTlabel (dt, slab_coercion) } in
+  List.fold_left apply dt l
 
 (* coercions using just head tysymbols without type arguments: *)
 (* TODO: this can be improved *)
@@ -333,10 +332,9 @@ let dterm_expected tuc dt dty =
     if (ts_equal ts1 ts2) then dt
     else
       let crc = Coercion.find tuc.Theory.uc_crcmap ts1 ts2 in
-      apply_coercion ~loc:dt.dt_loc crc.Coercion.crc_kind dt
+      apply_coercion ~loc:dt.dt_loc crc dt
   with Not_found | UndefinedTypeVar _ -> dt
 
-
 let dterm_expected_dterm tuc dt dty =
   let dt = dterm_expected tuc dt (Some dty) in
   dterm_expected_type dt dty;
@@ -347,7 +345,6 @@ let dfmla_expected_dterm tuc dt =
   dfmla_expected_type dt;
   dt
 
-
 let dterm tuc ?loc node =
   let dterm_node loc node =
     let mk_dty ty = { dt_node = node; dt_dty = ty; dt_loc = loc } in