#open "divers";;
#open "types";;
#open "am";;




type LocVar =
  LocGlobal of int         (* Pile globale (acces absolu) *)
| LocImmInt of int         (* Entier immédiat *)
| LocSpecial of VarSpecial
| LocStack of int          (* Pile locale (acces relatif) *)
| LocEnv of int            (* Environnent *)
| LocDummy of int*int      (* Pour la création des fermetures recursives *)

and
VarSpecial =
{
 VSCode:AmInstr list->AmInstr list;   (* Code qui evalue l'argument dans l'accu; utilisé
lorsque la valeur est en position de fonction appelée (constructeur, hd, fst,
etc ...) *)
 mutable VSLab : int; (* Adresse (Label) du code généré une fois
pour toute, utilisé lorsque la valeur n'est pas utilisée immédiatement;
-1 initialement indique que le code n'a pas été généré *)
}
;;


let global_types = make_table ();;

let globalsp = ref 0;;


type GlobalVar = {typ:TypeExpr; loc:LocVar};;

let dummy_type = fraiche_alpha ();;

let global_ids = make_table ();;
let global_constrs = make_table ();;

let dummy_constr = CCst (0,dummy_type);;
global_constrs.add "" dummy_constr;;


let create_op i =
  LocSpecial {VSLab=(-1); VSCode=(fun suite -> i :: suite)};;

let glob n t l =
  global_ids.add n {typ=t; loc=l};;

let init_global () =
   global_types.clear();
   global_ids.clear();
let a = fraiche_alpha_univ ()
and b = fraiche_alpha_univ ()
in
let tla = Type_liste a
and tpab = Type_prod (a,b)
in
let spec_fst = create_op First
and spec_snd = create_op Second
and spec_ref = create_op MakeRef
in
 glob "hd"  (Type_fonct(tla, a)) spec_fst;
 glob "tl"  (Type_fonct(tla,tla)) spec_snd;
 glob "fst" (Type_fonct(tpab,a)) spec_fst;
 glob "snd" (Type_fonct(tpab,b)) spec_snd;
 glob "ref" (Type_fonct(a,Type_ref a)) spec_ref;
 glob "print_int" (Type_fonct(base_int, base_unit)) (create_op PrintInt);
 glob "print_string" (Type_fonct(base_chaine, base_unit)) (create_op PrintStr);

 do_list (fun (id,_) -> global_types.add id {TSid=id; TSvars=(-1); TSconstrs=[||]}) types_base;
 global_types.add "ref" {TSid="ref"; TSvars=(-2); TSconstrs=[||]};
;;