better docs and names

src/api/ppx_deriving.cppo.ml

@@ -519,13 +519,22 @@ let poly_arrow_of_type_decl fn type_decl typ =
     let name = name.txt in
     Typ.arrow Label.nolabel (fn (Typ.var name)) typ) type_decl typ
 
+let newtype_arrow_of_type_decl fn type_decl typ =
+  let len = List.length type_decl.ptype_params in
+  fold_right_type_decl (fun name (idx,typ) ->
+      let name = name.txt in
+      (idx + 1, Typ.arrow Label.nolabel (fn (len - idx - 1) (Typ.constr (lid_of_string name) [])) typ))
+    type_decl 
+    (0, typ)
+  |> snd
+
 let poly_arrow_of_type_decl_idx fn type_decl typ =
   let len = List.length type_decl.ptype_params in
   fold_right_type_decl (fun name (idx, typ) ->
     let name = name.txt in
-    (idx + 1, Typ.arrow Label.nolabel (fn (len - idx - 1) (Typ.var name)) typ)) 
+    (idx - 1, Typ.arrow Label.nolabel (fn idx (Typ.var name)) typ)) 
     type_decl
-    (0, typ)
+    (len - 1, typ)
   |> snd
 
 let poly_arrow_of_type_ext fn type_ext typ =
@@ -546,15 +555,6 @@ let newtype_of_type_decl type_decl expr =
   fold_right_type_decl (fun name expr ->
     let name = name.txt in
     Exp.newtype (str_of_string name) expr) type_decl expr
-
-let newtype_arrow_of_type_decl fn type_decl typ =
-  let len = List.length type_decl.ptype_params in
-  fold_right_type_decl (fun name (idx,typ) ->
-      let name = name.txt in
-      (idx + 1, Typ.arrow Label.nolabel (fn (len - idx - 1) (Typ.constr (lid_of_string name) [])) typ))
-    type_decl 
-    (0, typ)
-  |> snd
 
 let core_type_of_type_decl_with_newtype { ptype_name = name; ptype_params } =
   let name = mkloc (Lident name.txt) name.loc in

src/api/ppx_deriving.cppo.mli

@@ -275,6 +275,13 @@ val poly_fun_of_type_decl : type_declaration -> expression -> expression
 (** Same as {!poly_fun_of_type_decl} but for type extension. *)
 val poly_fun_of_type_ext : type_extension -> expression -> expression
 
+(** [newtype_of_type_decl type_ expr] wraps [expr] into [fun (type N) -> expr] for every
+    type parameter ['N] present in [type_]. For example, if [type_] refers to
+    [type ('a, 'b) map], [expr] will be wrapped into [fun (type a) (type b) -> [%e expr]].
+
+    [_] parameters are ignored. *)
+val newtype_of_type_decl : type_declaration -> expression -> expression
+
 (** [poly_apply_of_type_decl type_ expr] wraps [expr] into [expr poly_N] for every
     type parameter ['N] present in [type_]. For example, if [type_] refers to
     [type ('a, 'b) map], [expr] will be wrapped into [[%e expr] poly_a poly_b].
@@ -294,9 +301,18 @@ val poly_apply_of_type_ext : type_extension -> expression -> expression
 val poly_arrow_of_type_decl : (core_type -> core_type) ->
                               type_declaration -> core_type -> core_type
 
+(** Same as {!poly_arrow_of_type_decl} but with indices for type parameters. *)
 val poly_arrow_of_type_decl_idx : (int -> core_type -> core_type) ->
                               type_declaration -> core_type -> core_type
 
+(** Same as {!poly_arrow_of_type_decl} but supplies locally abstract types instead of 
+    type variables. For example, [type ('a, 'b) map] and function 
+    [fun var -> [%type: [%t var] -> string]] wraps [typ] into 
+    [(a -> string) -> (b -> string) -> [%t typ]] (where [type a] and [type b] comes from 
+    type parameter names [type 'a] and [type 'b]). *)
+val newtype_arrow_of_type_decl : (int -> core_type -> core_type) ->
+    type_declaration -> core_type -> core_type
+
 (** Same as {!poly_arrow_of_type_decl} but for type extension. *)
 val poly_arrow_of_type_ext : (core_type -> core_type) ->
                               type_extension -> core_type -> core_type
@@ -308,14 +324,9 @@ val core_type_of_type_decl : type_declaration -> core_type
 (** Same as {!core_type_of_type_decl} but for type extension. *)
 val core_type_of_type_ext : type_extension -> core_type
 
-val newtype_of_type_decl : type_declaration -> expression -> expression
-
-val newtype_arrow_of_type_decl : (int -> core_type -> core_type) ->
-    type_declaration -> core_type -> core_type
-
 (** [core_type_of_type_decl_with_newtype type_] constructs type [('a, 'b, ...) t] for
     type declaration [type (a, b, ...) t = ...]. *)
-    val core_type_of_type_decl_with_newtype : type_declaration -> core_type
+val core_type_of_type_decl_with_newtype : type_declaration -> core_type
 
 (** [instantiate bound type_] returns [typ, vars, bound'] where [typ] is a type
     instantiated from type declaration [type_], [vars] ≡ [free_vars_in_core_type typ]

src_plugins/show/ppx_deriving_show.ml

@@ -49,34 +49,34 @@ let fresh_type_maker type_decl =
     bound := newvar :: !bound;
     Typ.var newvar
 
-let pp_type_of_decl ?(unusable_param_pos=[]) type_decl =
+let pp_type_of_decl ?(refined_param_pos=[]) type_decl =
   let loc = type_decl.ptype_loc in
   let typ = Ppx_deriving.core_type_of_type_decl type_decl in
   let fresh_type = fresh_type_maker type_decl in
   Ppx_deriving.poly_arrow_of_type_decl_idx
     (fun pos var ->
-      let var_or_any = if List.mem pos unusable_param_pos then fresh_type () else var in
+      let var_or_any = if List.mem pos refined_param_pos then fresh_type () else var in
       [%type: Ppx_deriving_runtime.Format.formatter -> [%t var_or_any ] -> Ppx_deriving_runtime.unit])
     type_decl
     [%type: Ppx_deriving_runtime.Format.formatter -> [%t typ] -> Ppx_deriving_runtime.unit]
 
-let pp_type_of_decl_newtype ?(unusable_param_pos=[]) type_decl =
+let pp_type_of_decl_newtype ?(refined_param_pos=[]) type_decl =
   let loc = type_decl.ptype_loc in
   let typ = Ppx_deriving.core_type_of_type_decl_with_newtype type_decl in
   Ppx_deriving.newtype_arrow_of_type_decl
     (fun pos lty -> 
-      let lty_or_any = if List.mem pos unusable_param_pos then Typ.any () else lty in
+      let lty_or_any = if List.mem pos refined_param_pos then Typ.any () else lty in
       [%type: Ppx_deriving_runtime.Format.formatter -> [%t lty_or_any] -> Ppx_deriving_runtime.unit])
     type_decl
     [%type: Ppx_deriving_runtime.Format.formatter -> [%t typ] -> Ppx_deriving_runtime.unit]
 
-let show_type_of_decl ?(unusable_param_pos=[]) type_decl =
+let show_type_of_decl ?(refined_param_pos=[]) type_decl =
   let loc = type_decl.ptype_loc in
   let typ = Ppx_deriving.core_type_of_type_decl type_decl in
   let fresh_type = fresh_type_maker type_decl in
   Ppx_deriving.poly_arrow_of_type_decl_idx
     (fun pos var ->
-      let var_or_any = if List.mem pos unusable_param_pos then fresh_type () else var in
+      let var_or_any = if List.mem pos refined_param_pos then fresh_type () else var in
       [%type: Ppx_deriving_runtime.Format.formatter -> [%t var_or_any] -> Ppx_deriving_runtime.unit])
     type_decl
     [%type: [%t typ] -> Ppx_deriving_runtime.string]
@@ -206,6 +206,9 @@ let rec expr_of_typ ~effective_variables quoter typ =
         if List.mem name effective_variables then
           [%expr [%e evar ("poly_"^name)] fmt]
         else
+          (* We assume some 'calling convention' here: for type variables not appear in the declaration, 
+             we supply a 'degenerate' pretty printer which is never called, as we deem them 'refined' to 
+             a concrete type at some point. *)
           [%expr (fun ()(*never type here*) -> failwith "impossible")]
     | { ptyp_desc = Ptyp_alias (typ, _) } -> expr_of_typ typ
     | { ptyp_loc } ->
@@ -230,15 +233,37 @@ let refined_param_pos_of_type_decl type_decl =
     | _ -> [] 
   in
   let type_variables = Ppx_deriving.type_param_names_of_type_decl type_decl in
-  constrs |> List.fold_left (fun acc -> function 
-  | {pcd_res = Some {ptyp_desc=Ptyp_constr(_, args); _} } -> 
-    let args = args |> List.mapi (fun idx x -> (idx,x)) in
-    let refined_idxs = args |> List.filter_map (function 
-      | (_idx, {ptyp_desc=Ptyp_var var}) when List.mem var type_variables -> (*not refined*)None 
-      | (idx, _) -> (*refined*)Some idx) 
-    in
-    refined_idxs @ acc
-  | _ -> acc) []
+  constrs |> List.filter_map (function 
+    | {pcd_res = Some {ptyp_desc=Ptyp_constr(_, args); _} } -> (* constructor has the return type (pcd_res) *)
+      let arg_idxs = args |> List.mapi (fun idx x -> (idx,x)) in
+      (* compute indices for refined type parameters *)
+      let refined_idxs = arg_idxs |> List.filter_map (function 
+        | (_idx, {ptyp_desc=Ptyp_var var}) when List.mem var type_variables -> 
+          (* The type parameter is a variable. It is likely that the constructor does not refine the variable.
+             However, there are cases that even if the constructor does not refine the type parameter,
+             the constructor's argument type does. In that case, the type parameter should be considered refined as well.
+             To express that the type parameter is refined, the programmer can change the type parameter in the return type
+             to a type that is not same as the one in the declaration.
+             For example, 
+               type 'a term = Var : string * 'a typ -> 'a term | ...
+             Here, when the programmer knows that the parameter 'a in type 'a type is refined, there should be a way to express that.
+             To express that, the programmer change the return type of the constructor to be different from the declaration, say 'v,
+               type 'a term = Var : string * 'v typ -> 'v term | ...
+             So that poly_a is never called to print the type.
+
+             Note that, there are cases that the constructor itself does not refine the paramter but its declaration is GADT-ish:
+             existential variables.
+             If one needs existential type variables while a type parameter is not refined, the programmer would keep using 
+             the same variable name as in the declaration, for example:
+               type 'state transition = Print : 'v term * 'state -> 'state transition | ...
+             to express that 'state is non-refined type parameter (thus poly_state is actually called) while the constructor
+             is GADT-ish.
+           *)
+          None
+        | (idx, _) -> (*refined*) Some idx) 
+      in
+      Some refined_idxs
+    | _ -> None) |> List.concat
 
 
 let str_of_type ~with_path ~path ({ ptype_loc = loc } as type_decl) =
@@ -342,20 +367,20 @@ let str_of_type ~with_path ~path ({ ptype_loc = loc } as type_decl) =
                         (Ppx_deriving.mangle_type_decl (`Prefix "pp") type_decl)) in
   let stringprinter = [%expr fun x -> Ppx_deriving_runtime.Format.asprintf "%a" [%e pp_poly_apply] x] in
   let polymorphize  = Ppx_deriving.poly_fun_of_type_decl type_decl in
-  let unusable_param_pos = refined_param_pos_of_type_decl type_decl in
+  let refined_param_pos = refined_param_pos_of_type_decl type_decl in
   let prettyprinter = polymorphize prettyprinter in
   let prettyprinter =
     if is_gadt type_decl then
       Ppx_deriving.newtype_of_type_decl type_decl
-        @@ Exp.constraint_ prettyprinter (pp_type_of_decl_newtype ~unusable_param_pos type_decl) 
+        @@ Exp.constraint_ prettyprinter (pp_type_of_decl_newtype ~refined_param_pos type_decl) 
     else
       prettyprinter
   in
   let pp_type =
-    Ppx_deriving.strong_type_of_type @@ pp_type_of_decl ~unusable_param_pos type_decl in
+    Ppx_deriving.strong_type_of_type @@ pp_type_of_decl ~refined_param_pos type_decl in
   let show_type =
     Ppx_deriving.strong_type_of_type @@
-      show_type_of_decl ~unusable_param_pos type_decl in
+      show_type_of_decl ~refined_param_pos type_decl in
   let pp_var =
     pvar (Ppx_deriving.mangle_type_decl (`Prefix "pp") type_decl) in
   let show_var =