Commit 49d173b7 authored by Pietro Abate's avatar Pietro Abate

Fix type substition for parametric types

parent 0d3a9e60
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment