Fix type substition for parametric types

types/types.ml

@@ -1008,8 +1008,6 @@ let get_variables main_memo temp_memo t =
     (Var.Set.union tvpos tpos,
      Var.Set.union tvneg tneg,
      Var.Set.union tvars vars)
-
-
   in
   get_variables true Var.Set.(empty,empty,empty) t
 
@@ -2816,6 +2814,17 @@ module Positive = struct
       descr (solve new_t)
     end
 
+  let substitute_list t l =
+    if no_var t then t
+    else begin
+      let subst l d =
+        try ty(snd(List.find (fun (alpha,_) -> Var.equal d alpha) l))
+        with Not_found -> var d 
+      in
+      let new_t = (substitute_aux Var.Set.empty (decompose t) (subst l)) in
+      descr (solve new_t)
+    end
+
   let substitutefree delta t =
     if no_var t then t else
     let h = Hashtbl.create 17 in

types/types.mli

@@ -165,6 +165,7 @@ module Positive : sig
   val xml: v -> v -> v
 
   val substitute : t -> (Var.var * t) -> t
+  val substitute_list : t -> (Var.var * t) list -> t
   val substituterec : t -> Var.var -> t
   val solve: v -> Node.t
   val substitutefree : Var.Set.t -> t -> t

typing/typer.ml

@@ -59,11 +59,9 @@ let pp_env ppf env =
   let pp_item ppf (s,t) = match t with
     |Val t -> Format.fprintf ppf "val %s : %a" s Types.Print.pp_type t
     |Type (t,[||]) -> Format.fprintf ppf "type %s = %a" s Types.Print.pp_noname t
-    |Type (t,[|a|]) ->
-        Format.fprintf ppf "type %s %a = %a" s Var.pp a Types.Print.pp_noname t
     |Type (t,al) ->
         Format.fprintf ppf "type %s %a = %a" s 
-          (Utils.pp_list ~delim:("(",")") Var.pp) (Array.to_list al) 
+          (Utils.pp_list ~delim:("{[","]}") Var.pp) (Array.to_list al) 
           Types.Print.pp_noname t
     |_ -> ()
   in
@@ -273,7 +271,8 @@ let type_ns env loc p ns =
 
 let find_global_type env loc ids =
   match find_global env loc ids with
-    | Type (t,_) | ESchemaComponent (t,_) -> t
+    | Type (t,pargs) -> (t,pargs)
+    | ESchemaComponent (t,_) -> (t,[||]) (* XXX *)
     | _ -> error loc "This path does not refer to a type"
 
 let find_global_schema_component env loc ids =
@@ -283,7 +282,7 @@ let find_global_schema_component env loc ids =
 
 let find_local_type env loc id =
   match Env.find id env.ids with
-    | Type (t,_) -> t
+    | Type (t,pargs) -> (t,pargs)
     | _ -> raise Not_found
 
 let find_value id env =
@@ -381,16 +380,27 @@ module IType = struct
 
   and derecurs_var env loc ids =
     match ids with
-      | ([v],_) ->
+      | ([v],a) ->
 	  let v = ident env.penv_tenv loc v in
 	  begin 
           try Env.find v env.penv_derec
 	    with Not_found ->
-	     try mk_type (find_local_type env.penv_tenv loc v)
+	     try 
+             let (t,pargs) = find_local_type env.penv_tenv loc v in
+             let palen = Array.length pargs in
+             if palen <> List.length a then
+               raise_loc_generic loc
+                 (Printf.sprintf "Parametric type %s is not fully qualified" (Ident.to_string v));
+             let a = Array.of_list a in
+             let l = ref [] in
+             for i=0 to (Array.length pargs) - 1 do
+               l := (pargs.(i), typ(derecurs env a.(i)))::!l
+             done;
+             mk_type (Types.Positive.substitute_list t !l)
 	     with Not_found -> mk_capture v
         end
       | (ids,_) ->
-          mk_type (find_global_type env.penv_tenv loc ids)
+          mk_type (fst(find_global_type env.penv_tenv loc ids))
 
   and derecurs_def env b =
     let seen = ref IdSet.empty in