Commit 70b9b43b authored by Pietro Abate's avatar Pietro Abate

Remove gamma from compilation environment

parent f49dc4b9
......@@ -5,7 +5,6 @@ type env = {
cu: Compunit.t option; (* None: toplevel *)
vars: var_loc Env.t; (* Id.t to var_loc *)
sigma : sigma; (* symbolic substitutions (Lambda.sigma) *)
gamma : Types.Node.t IdMap.map; (* map of type variables to types *)
xi : Var.Set.t IdMap.map;
stack_size: int;
max_stack: int ref;
......@@ -15,17 +14,13 @@ type env = {
let pp_vars ppf vars =
Ident.pp_env Lambda.Print.pp_vloc ppf vars
let pp_gamma ppf gamma =
Ident.pp_idmap Types.Print.pp_node ppf gamma
let pp_xi ppf xi =
Ident.pp_idmap Var.Set.pp ppf xi
let pp_env ppf env =
Format.fprintf ppf "{vars=%a,sigma=%a,gamma=%a,xi=%a}"
Format.fprintf ppf "{vars=%a,sigma=%a,xi=%a}"
pp_vars env.vars
Lambda.Print.pp_sigma env.sigma
pp_gamma env.gamma
pp_xi env.xi
let global_size env = env.global_size
......@@ -34,7 +29,6 @@ let mk cu = {
cu = cu;
vars = Env.empty;
sigma = Lambda.Identity;
gamma = IdMap.empty;
xi = IdMap.empty;
stack_size = 0;
max_stack = ref 0;
......@@ -126,8 +120,8 @@ let rec comp s1 s2 = match s1, s2 with
(* from intermediate explicitely typed language to Evaluation language (lambda) *)
(* Typed -> Lambda *)
let rec compile env e = compile_aux env e.Typed.exp_descr
and compile_aux env = function
let rec compile env e = compile_aux env e.Typed.exp_typ e.Typed.exp_descr
and compile_aux env te = function
| Typed.Forget (e,_) -> compile env e
| Typed.Check (t0,e,t) ->
let d = Patterns.Compile.make_checker !t0 (Types.descr t) in
......@@ -135,7 +129,7 @@ and compile_aux env = function
| Typed.Var x -> Var (find x env)
| Typed.TVar x ->
let v = find x env in
let ts = Types.all_vars (Types.descr (IdMap.assoc x env.gamma)) in
let ts = Types.all_vars te in
let is_mono x =
if Var.Set.is_empty ts then true else
let from_xi = try IdMap.assoc x env.xi with Not_found -> Var.Set.empty in
......@@ -184,7 +178,7 @@ and compile_aux env = function
| [] -> [] in
Op (op, aux args)
| Typed.NsTable (ns,e) ->
NsTable (ns, compile_aux env e)
NsTable (ns, compile_aux env te e)
and compile_abstr env a =
let fun_env, fun_name =
......@@ -234,7 +228,6 @@ and compile_abstr env a =
let slots = Array.of_list (List.rev slots) in
let env =
{ env with vars = fun_env;
gamma = IdMap.merge (fun _ v2 -> v2) env.gamma fun_name;
stack_size = 0;
max_stack = ref 0 }
in
......@@ -254,9 +247,6 @@ and compile_branches env (brs : Typed.branches) =
(* Don't compile unused branches, because they have not been type checked. *)
let used = List.filter (fun br -> br.Typed.br_used) brs.Typed.br_branches in
let b = List.map (compile_branch env) used in
(* here I need to pull type information from each pattern and then
* compute for each variable gamma(x) . I should be able to compute gamma(x)
* using the information computed in (disp,rhs) *)
let (disp,rhs) = Patterns.Compile.make_branches brs.Typed.br_typ b in
{ brs_stack_pos = env.stack_size;
brs_accept_chars = not (Types.Char.is_empty brs.Typed.br_accept);
......@@ -264,14 +254,11 @@ and compile_branches env (brs : Typed.branches) =
brs_rhs = rhs
}
(* p_i / t_i -> br.Typed.br_pat / br.Typed.br_type
* p_i / t_i is used here to add elements to env.gamma *)
(* p_i / t_i -> br.Typed.br_pat / br.Typed.br_type *)
and compile_branch env br =
let env = List.fold_left enter_local env (Patterns.fv br.Typed.br_pat) in
let m = Patterns.filter (Types.descr (Patterns.accept br.Typed.br_pat)) br.Typed.br_pat in
let env =
{ env with
gamma = IdMap.merge (fun _ v2 -> v2) env.gamma m;
xi = IdMap.merge (fun _ v2 -> v2) env.xi br.Typed.br_vars_poly
}
in
......@@ -343,28 +330,12 @@ let run_show ~run ~show tenv cenv codes ids =
let let_decl ~run ~show (tenv,cenv,codes) p e =
let (tenv,decl,ids) = Typer.type_let_decl tenv p e in
let (cenv,code) = compile_let_decl cenv decl in
(* XXX I've the impression I'm duplicating information here
* as cenv.gamma == tenv.gamma *)
let cenv = {cenv with gamma =
List.fold_left (fun acc (id,t) ->
(* an old binding is showed by a new one *)
IdMap.add id (Types.cons t) (IdMap.remove id acc)
) cenv.gamma ids;
}
in
run_show ~run ~show tenv cenv code ids;
(tenv,cenv,List.rev_append code codes)
let let_funs ~run ~show (tenv,cenv,codes) funs =
let (tenv,funs,ids) = Typer.type_let_funs tenv funs in
let (cenv,code) = compile_rec_funs cenv funs in
let cenv = {cenv with gamma =
List.fold_left (fun acc (id,t) ->
(* an old binding is showed by a new one *)
IdMap.add id (Types.cons t) (IdMap.remove id acc)
) cenv.gamma ids;
}
in
run_show ~run ~show tenv cenv code ids;
(tenv,cenv,List.rev_append code codes)
......
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