#open "divers";;
#open "types";;
#open "global";;
#open "am";;
#open "topl";;

let mk_loc_constr n = LocSpecial { VSCode=(fun suite-> MakeConstr n :: suite); VSLab = (-1) };;

let build_constrs ts params constrs =
 let vars=map (fun i-> i,fraiche_alpha_univ ()) params in
 let rec conv = function
   TSProd (a,b)   -> Type_prod (conv a, conv b)
 | TSFleche (a,b) -> Type_fonct (conv a, conv b)
 | TSConstr (s,p)  -> 
      let c=global_types.find s in
      if c.TSvars=(-1) then
       assoc s types_base
      else
      if c.TSvars=(-2) then
       Type_ref (conv (hd p))
      else
       Type_somme (c, vect_of_list (map conv p))
 | TSVar i -> assoc i vars
 in
 let t = Type_somme (ts,vect_of_list (map snd vars)) in
 let build (id,tso) n = match tso with
   None -> global_constrs.add id (CCst (n,t)); glob id t (LocImmInt n)
 | Some ti -> 
    let arg=conv ti in
    global_constrs.add id (CBloc (n,arg,t));
    glob id (Type_fonct (arg, t)) (mk_loc_constr n)
 in
 let rec aux = fun n (t::q) -> build t n; aux (n+1) q | _ _ -> ()
 in aux 0 constrs;;

let traite_type_decl decls =
  let tss = map (
  fun ((params,id),constrs) ->
  {
   TSid=id;
   TSvars=list_length params;
   TSconstrs=make_vect (list_length constrs) None
  }) decls
  in
  do_list (fun ts -> global_types.add ts.TSid ts) tss;
  do_list2 (fun ts ((params,id),constrs) -> build_constrs
   ts params constrs) tss decls;;