Skip to content
Snippets Groups Projects
Commit b97a966e authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Plug back the array expansion.

parent 8d9c3422
No related branches found
No related tags found
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 448 additions and 421 deletions
Makefile
+ 6
− 0
View file @ b97a966e
......@@ -126,6 +126,10 @@ dot:
html:
ocamldoc -I $(OBJDIR) $(MLONLY_SOURCES) -d ocamldoc -html -keep-code
nomli:
rm $(OBJDIR)/*.mli
debug: nomli dc
ln: $(OBJDIR) $(SOURCES)
......@@ -145,6 +149,8 @@ $(OBJDIR)/version.ml:
echo "let commit = \"$(shell utils/get_commit_number)\"" >> $@
echo "let sha_1 = \"$(shell utils/get_sha_1)"\">> $@
echo "let str = (branch ^ \".\" ^ commit)">> $@
echo "let maintainer = \"jahier@imag.fr\"">> $@
all: nc
......
src/compile.ml
+ 9
− 14
View file @ b97a966e
(* Time-stamp: <modified the 13/12/2012 (at 16:51) by Erwan Jahier> *)
(* Time-stamp: <modified the 18/12/2012 (at 14:39) by Erwan Jahier> *)
open Lxm
......@@ -40,21 +40,16 @@ let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
LicTab.compile_node lic_tab main_node
in
let zelic = LicTab.to_lic_prg lic_tab in
(* limination polymorphisme surcharge *)
let zelic = L2lRmPoly.doit zelic in
(* alias des types array *)
let zelic = L2lAliasType.doit zelic in
(* split des equations (1 eq = 1 op) *)
let zelic = if !Global.one_op_per_equation then L2lSplit.doit zelic else zelic in
(* let zelic = *)
(* if !Global.expand_structs *)
(* then L2lExpandArrays.doit id_solver lenv zelic *)
(* else zelic *)
(* in *)
(* XXX node et array expand ! *)
let zelic = if not !Global.one_op_per_equation then zelic else
(* Split des equations (1 eq = 1 op) *)
L2lSplit.doit zelic
in
let zelic = if not !Global.expand_structs then zelic else
(* Array and struct expansion: to do after polymorphism elimination *)
L2lExpandArrays.doit zelic
in
zelic
src/l2lAliasType.ml
+ 93
− 93
View file @ b97a966e
(* Time-stamp: <modified the 13/12/2012 (at 11:48) by Erwan Jahier> *)
(* Time-stamp: <modified the 18/12/2012 (at 10:10) by Erwan Jahier> *)
(**
Source 2 source transformation :
......@@ -13,116 +13,116 @@ open Lic
let doit (inp : LicPrg.t) : LicPrg.t =
(* n.b. on fait un minumum d'effet de bord pour
pas avoir trop d'acummulateur ... *)
let atab = Hashtbl.create 10 in
let res = ref inp in
let atab = Hashtbl.create 10 in
let res = ref inp in
(** UTILE : nommage des alias d'array *)
let array_ident ty sz =
let tid = Lic.ident_of_type ty in
let sfx = Printf.sprintf "%s_%d" (snd tid) sz in
let id = LicPrg.fresh_type_id !res (fst tid) sfx in
id
in
let array_ident ty sz =
let tid = Lic.ident_of_type ty in
let sfx = Printf.sprintf "%s_%d" (snd tid) sz in
let id = LicPrg.fresh_type_id !res (fst tid) sfx in
id
in
(** UTILE : cherche/crée un alias de type *)
let rec alias_type te =
match te with
let rec alias_type te =
match te with
| Array_type_eff (ty, sz) -> (
let ty = alias_type ty in
let te = Array_type_eff (ty, sz) in
try
let ref_te = Hashtbl.find atab te in
(*
Verbose.printf "--> alias_type %s = %s ^ %d FOUND : %s\n"
(LicDump.string_of_type_eff te)
(LicDump.string_of_type_eff ty)
sz
(LicDump.string_of_type_eff ref_te);
*)
ref_te
with Not_found -> (
let id = array_ident ty sz in
let ref_te = Abstract_type_eff (id, te) in
res := LicPrg.add_type id ref_te !res;
Hashtbl.add atab te ref_te;
(*
Verbose.printf "--> alias_type %s = %s ^ %d NOT FOUND, gives: %s\n"
(LicDump.string_of_type_eff te)
(LicDump.string_of_type_eff ty)
sz
(LicDump.string_of_type_eff ref_te);
*)
ref_te
)
let ty = alias_type ty in
let te = Array_type_eff (ty, sz) in
try
let ref_te = Hashtbl.find atab te in
(*
Verbose.printf "--> alias_type %s = %s ^ %d FOUND : %s\n"
(LicDump.string_of_type_eff te)
(LicDump.string_of_type_eff ty)
sz
(LicDump.string_of_type_eff ref_te);
*)
ref_te
with Not_found -> (
let id = array_ident ty sz in
let ref_te = Abstract_type_eff (id, te) in
res := LicPrg.add_type id ref_te !res;
Hashtbl.add atab te ref_te;
(*
Verbose.printf "--> alias_type %s = %s ^ %d NOT FOUND, gives: %s\n"
(LicDump.string_of_type_eff te)
(LicDump.string_of_type_eff ty)
sz
(LicDump.string_of_type_eff ref_te);
*)
ref_te
)
) | _ -> te
in
in
(** TRAITE LES TYPES *)
let do_type k te =
let te' = match te with
let do_type k te =
let te' = match te with
| Array_type_eff (tel, sz) ->
let tel' = alias_type tel in
Array_type_eff (tel', sz)
let tel' = alias_type tel in
Array_type_eff (tel', sz)
| Struct_type_eff (id, fields) ->
let do_field (id, (tf, co)) =
(id, (alias_type tf, co))
in
Struct_type_eff (id, List.map do_field fields)
let do_field (id, (tf, co)) =
(id, (alias_type tf, co))
in
Struct_type_eff (id, List.map do_field fields)
| _ -> te
in
if (te = te') then ()
else
res := LicPrg.add_type k te' !res
in
LicPrg.iter_types do_type inp;
in
if (te = te') then ()
else
res := LicPrg.add_type k te' !res
in
LicPrg.iter_types do_type inp;
(** TRAITE LES CONSTANTES *)
let do_const k ec =
let ec' = match ec with
| Extern_const_eff (i, te) ->
let te' = alias_type te in
Extern_const_eff (i, te')
| Abstract_const_eff (i, te, c, b) ->
let te' = alias_type te in
Abstract_const_eff (i, te', c, b)
| Array_const_eff (cl, te) ->
let te' = alias_type te in
Array_const_eff (cl, te')
| Bool_const_eff _
| Int_const_eff _
| Real_const_eff _
| Enum_const_eff _
| Struct_const_eff _
| Tuple_const_eff _ -> ec
in
if (ec = ec') then ()
else
let do_const k ec =
let ec' = match ec with
| Extern_const_eff (i, te) ->
let te' = alias_type te in
Extern_const_eff (i, te')
| Abstract_const_eff (i, te, c, b) ->
let te' = alias_type te in
Abstract_const_eff (i, te', c, b)
| Array_const_eff (cl, te) ->
let te' = alias_type te in
Array_const_eff (cl, te')
| Bool_const_eff _
| Int_const_eff _
| Real_const_eff _
| Enum_const_eff _
| Struct_const_eff _
| Tuple_const_eff _ -> ec
in
if (ec = ec') then ()
else
(* n.b. add=replace *)
res := LicPrg.add_const k ec' !res
in
LicPrg.iter_consts do_const inp ;
res := LicPrg.add_const k ec' !res
in
LicPrg.iter_consts do_const inp ;
(** TRAITE LES NOEUDS *)
let do_node k en =
let do_node k en =
(* n.b. les Lic.type_ apparraissent uniquement dans les var infos *)
let do_var vi =
let ty = alias_type vi.var_type_eff in
{vi with var_type_eff = ty}
in
let en' = { en with
inlist_eff = (List.map do_var en.inlist_eff);
outlist_eff = (List.map do_var en.outlist_eff);
loclist_eff = (
match en.loclist_eff with
| Some vl -> Some (List.map do_var vl)
| None -> None
)
} in
let do_var vi =
let ty = alias_type vi.var_type_eff in
{vi with var_type_eff = ty}
in
let en' = { en with
inlist_eff = (List.map do_var en.inlist_eff);
outlist_eff = (List.map do_var en.outlist_eff);
loclist_eff = (
match en.loclist_eff with
| Some vl -> Some (List.map do_var vl)
| None -> None
)
} in
(* on fait pas dans la dentelle, on remplace ... *)
res := LicPrg.add_node k en' !res
in
LicPrg.iter_nodes do_node inp;
!res
res := LicPrg.add_node k en' !res
in
LicPrg.iter_nodes do_node inp;
!res
src/l2lExpandArrays.ml
+ 132
− 127
View file @ b97a966e
This diff is collapsed.
src/l2lExpandArrays.mli
+ 2
− 2
View file @ b97a966e
(* Time-stamp: <modified the 13/12/2012 (at 15:58) by Erwan Jahier> *)
(* Time-stamp: <modified the 17/12/2012 (at 16:28) by Erwan Jahier> *)
(** Expand strutures and arrays *)
val doit : Lic.id_solver -> Lic.local_env -> LicPrg.t -> LicPrg.t
val doit : LicPrg.t -> LicPrg.t
src/l2lRmPoly.ml
+ 8
− 21
View file @ b97a966e
(* Time-stamp: <modified the 13/12/2012 (at 11:01) by Erwan Jahier> *)
(* Time-stamp: <modified the 18/12/2012 (at 10:20) by Erwan Jahier> *)
(*
Source 2 source transformation :
élimine polymorphisme et surcharge
CONDITION :
- il est préférable d'appeler
ce module AVANT L2lAliasType,
sinon on risque d'avoir des alias bizarres, du style :
'anynum_4_7_int'
au lieu de
'int_4_7'
Mais bon, normalement c'est quand même correct ...
*)
open Lxm
......@@ -63,22 +55,15 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
| MetaOpLic _
| ExternLic -> ne.def_eff
| AbstractLic _ -> assert false
| BodyLic nb ->
BodyLic (do_body [] nb)
| BodyLic nb -> BodyLic (do_body [] nb)
in
res := LicPrg.add_node k { ne with def_eff = def'} !res
)
(** TRAITEMENT DES BODY *)
and do_body
(m: Lic.type_matches)
(nb: Lic.node_body)
: Lic.node_body =
and do_body (m: Lic.type_matches) (nb: Lic.node_body) : Lic.node_body =
(* parcours les expressions du body
à la recherche d'appel ne noeuds poly *)
let do_assert a =
Lxm.flagit (
do_exp m a.it
) a.src
à la recherche d'appel de noeuds poly *)
let do_assert a = Lxm.flagit (do_exp m a.it) a.src
and do_eq eq =
Lxm.flagit (
fst eq.it,
......@@ -159,7 +144,9 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
(Lic.string_of_type_matches tmatches)
;
let do_var vi =
{ vi with var_type_eff = Lic.subst_matches tmatches vi.var_type_eff }
let nt = Lic.subst_matches tmatches vi.var_type_eff in
assert(not (Lic.type_is_poly nt));
{ vi with var_type_eff = nt }
in
(* nouvelle clé unique = ancienne + tmatches *)
let (nid, sargs) = nk in
......
src/l2lRmPoly.mli
+ 12
− 2
View file @ b97a966e
(* Time-stamp: <modified the 13/12/2012 (at 11:02) by Erwan Jahier> *)
(* Time-stamp: <modified the 18/12/2012 (at 10:13) by Erwan Jahier> *)
(** Remove polymorphism and overloading *)
(** Remove polymorphism and overloading
nb :
- il est préférable d'appeler
ce module AVANT L2lAliasType,
sinon on risque d'avoir des alias bizarres, du style :
'anynum_4_7_int'
au lieu de
'int_4_7'
Mais bon, normalement c'est quand même correct ...
*)
val doit : LicPrg.t -> LicPrg.t
src/l2lSplit.ml
+ 140
− 137
View file @ b97a966e
......@@ -138,16 +138,16 @@ type split_acc = (Lic.eq_info srcflagged) list * Lic.var_info list
let rec (eq : LicPrg.id_generator -> Lic.eq_info Lxm.srcflagged -> split_acc) =
fun getid { src = lxm_eq ; it = (lhs, rhs) } ->
let n_rhs, (neqs, nlocs) = split_val_exp false true getid rhs in
{ src = lxm_eq ; it = (lhs, n_rhs) }::neqs, nlocs
{ src = lxm_eq ; it = (lhs, n_rhs) }::neqs, nlocs
and (split_eq_acc :
LicPrg.id_generator -> split_acc -> Lic.eq_info srcflagged -> split_acc) =
fun getid (eqs, locs) equation ->
let (neqs, nlocs) = eq getid equation in
(split_tuples (eqs@neqs), locs@nlocs)
(split_tuples (eqs@neqs), locs@nlocs)
and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
Lic.val_exp * split_acc) =
Lic.val_exp * split_acc) =
fun when_flag top_level getid ve ->
(* [when_flag] is true is the call is made from a "when" statement.
We need this flag in order to know if it is necessary to add
......@@ -168,171 +168,171 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
| CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.FALSE_n,_)}, _)
| CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.ICONST_n _,_)}, _)
| CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.RCONST_n _,_)}, _)
(* We do not create an intermediary variable for those,
but
*)
(* We do not create an intermediary variable for those,
but
*)
-> if not when_flag then
let clk = ve.ve_clk in
let clk = ve.ve_clk in
match (List.hd clk) with
| On(clock,_) ->
let clk_exp = AstCore.NamedClock (Lxm.flagit clock lxm) in
{ ve with ve_core =
CallByPosLic({src=lxm;it=Lic.WHEN clk_exp},OperLic [ve])},
([],[])
let clk_exp = AstCore.NamedClock (Lxm.flagit clock lxm) in
{ ve with ve_core =
CallByPosLic({src=lxm;it=Lic.WHEN clk_exp},OperLic [ve])},
([],[])
| (ClockVar _) (* should not occur *)
| BaseLic -> ve, ([],[])
else
ve, ([],[])
else
ve, ([],[])
| CallByNameLic (by_name_op_eff, fl) ->
let lxm = by_name_op_eff.src in
let fl, eql, vl =
List.fold_left
(fun (fl_acc, eql_acc, vl_acc) (fn, fv) ->
let fv, (eql, vl) = split_val_exp false false getid fv in
((fn,fv)::fl_acc, eql@eql_acc, vl@vl_acc)
)
([],[],[])
fl
in
let rhs = { ve with ve_core = CallByNameLic (by_name_op_eff, List.rev fl) } in
if top_level then
rhs, (eql, vl)
else
let lxm = by_name_op_eff.src in
let fl, eql, vl =
List.fold_left
(fun (fl_acc, eql_acc, vl_acc) (fn, fv) ->
let fv, (eql, vl) = split_val_exp false false getid fv in
((fn,fv)::fl_acc, eql@eql_acc, vl@vl_acc)
)
([],[],[])
fl
in
let rhs = { ve with ve_core = CallByNameLic (by_name_op_eff, List.rev fl) } in
if top_level then
rhs, (eql, vl)
else
(* create the var for the current call *)
let clk_l = ve.ve_clk in
let typ_l = ve.ve_typ in
let nv_l = List.map2 (new_var getid) typ_l clk_l in
let nve = match nv_l with
| [nv] -> { ve with ve_core =
CallByPosLic(
Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,
OperLic []
)}
| _ -> assert false
in
let lpl = List.map (fun nv -> LeftVarLic(nv, lxm)) nv_l in
let eq = Lxm.flagit (lpl, rhs) lxm in
nve, (eql@[eq], vl@nv_l)
let clk_l = ve.ve_clk in
let typ_l = ve.ve_typ in
let nv_l = List.map2 (new_var getid) typ_l clk_l in
let nve = match nv_l with
| [nv] -> { ve with ve_core =
CallByPosLic(
Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,
OperLic []
)}
| _ -> assert false
in
let lpl = List.map (fun nv -> LeftVarLic(nv, lxm)) nv_l in
let eq = Lxm.flagit (lpl, rhs) lxm in
nve, (eql@[eq], vl@nv_l)
| CallByPosLic(by_pos_op_eff, OperLic vel) -> (
(* recursively split the arguments *)
let lxm = by_pos_op_eff.src in
let (rhs, (eql,vl)) =
match by_pos_op_eff.it with
(* for WITH and HAT, a particular treatment is done because
the val_exp is attached to them *)
| Lic.WITH(ve) ->
let ve, (eql, vl) = split_val_exp false false getid ve in
let by_pos_op_eff = Lxm.flagit (Lic.WITH(ve)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
rhs, (eql, vl)
| Lic.HAT(i,ve) ->
let ve, (eql, vl) = split_val_exp false false getid ve in
let by_pos_op_eff = Lxm.flagit (Lic.HAT(i, ve)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
rhs, (eql, vl)
| Lic.WHEN ve -> (* should we create a var for the clock? *)
let vel,(eql, vl) = split_val_exp_list true false getid vel in
let by_pos_op_eff = Lxm.flagit (Lic.WHEN(ve)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in
rhs, (eql, vl)
| Lic.ARRAY vel ->
let vel, (eql, vl) = split_val_exp_list false false getid vel in
let by_pos_op_eff = Lxm.flagit (Lic.ARRAY(vel)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
rhs, (eql, vl)
| _ ->
let vel, (eql, vl) = split_val_exp_list false false getid vel in
let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in
rhs, (eql, vl)
in
let rhs = { ve with ve_core = rhs } in
if top_level || by_pos_op_eff.it = TUPLE then
rhs, (eql, vl)
else
let lxm = by_pos_op_eff.src in
let (rhs, (eql,vl)) =
match by_pos_op_eff.it with
(* for WITH and HAT, a particular treatment is done because
the val_exp is attached to them *)
| Lic.WITH(ve) ->
let ve, (eql, vl) = split_val_exp false false getid ve in
let by_pos_op_eff = Lxm.flagit (Lic.WITH(ve)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
rhs, (eql, vl)
| Lic.HAT(i,ve) ->
let ve, (eql, vl) = split_val_exp false false getid ve in
let by_pos_op_eff = Lxm.flagit (Lic.HAT(i, ve)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
rhs, (eql, vl)
| Lic.WHEN ve -> (* should we create a var for the clock? *)
let vel,(eql, vl) = split_val_exp_list true false getid vel in
let by_pos_op_eff = Lxm.flagit (Lic.WHEN(ve)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in
rhs, (eql, vl)
| Lic.ARRAY vel ->
let vel, (eql, vl) = split_val_exp_list false false getid vel in
let by_pos_op_eff = Lxm.flagit (Lic.ARRAY(vel)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
rhs, (eql, vl)
| _ ->
let vel, (eql, vl) = split_val_exp_list false false getid vel in
let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in
rhs, (eql, vl)
in
let rhs = { ve with ve_core = rhs } in
if top_level || by_pos_op_eff.it = TUPLE then
rhs, (eql, vl)
else
(* create the var for the current call *)
let clk_l = ve.ve_clk in
let typ_l = ve.ve_typ in
let nv_l = List.map2 (new_var getid) typ_l clk_l in
let nve =
match nv_l with
| [nv] -> {
ve_typ = [nv.var_type_eff];
ve_clk = clk_l;
ve_core = CallByPosLic(
Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,
OperLic [])
}
| _ -> {
ve_typ = List.map (fun v -> v.var_type_eff) nv_l;
ve_clk = clk_l;
ve_core = CallByPosLic(
Lxm.flagit Lic.TUPLE lxm,
OperLic
(List.map (
fun nv ->
let nnv = {
ve_core = CallByPosLic
(Lxm.flagit
(Lic.VAR_REF (nv.var_name_eff)) lxm,
OperLic []);
ve_typ = [nv.var_type_eff];
ve_clk = [snd nv.var_clock_eff]
}
in
nnv
)
nv_l
)
)
}
in
let lpl = List.map (fun nv -> LeftVarLic(nv, lxm)) nv_l in
let eq = Lxm.flagit (lpl, rhs) lxm in
nve, (eql@[eq], vl@nv_l)
)
let clk_l = ve.ve_clk in
let typ_l = ve.ve_typ in
let nv_l = List.map2 (new_var getid) typ_l clk_l in
let nve =
match nv_l with
| [nv] -> {
ve_typ = [nv.var_type_eff];
ve_clk = clk_l;
ve_core = CallByPosLic(
Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,
OperLic [])
}
| _ -> {
ve_typ = List.map (fun v -> v.var_type_eff) nv_l;
ve_clk = clk_l;
ve_core = CallByPosLic(
Lxm.flagit Lic.TUPLE lxm,
OperLic
(List.map (
fun nv ->
let nnv = {
ve_core = CallByPosLic
(Lxm.flagit
(Lic.VAR_REF (nv.var_name_eff)) lxm,
OperLic []);
ve_typ = [nv.var_type_eff];
ve_clk = [snd nv.var_clock_eff]
}
in
nnv
)
nv_l
)
)
}
in
let lpl = List.map (fun nv -> LeftVarLic(nv, lxm)) nv_l in
let eq = Lxm.flagit (lpl, rhs) lxm in
nve, (eql@[eq], vl@nv_l)
)
and (split_val_exp_list : bool ->
bool -> LicPrg.id_generator -> Lic.val_exp list -> Lic.val_exp list * split_acc) =
bool -> LicPrg.id_generator -> Lic.val_exp list -> Lic.val_exp list * split_acc) =
fun when_flag top_level getid vel ->
let vel, accl =
List.split (List.map (split_val_exp when_flag top_level getid) vel)
in
let eqll,vll = List.split accl in
let eql, vl = List.flatten eqll, List.flatten vll in
(vel,(eql,vl))
(vel,(eql,vl))
and split_node (getid: LicPrg.id_generator) (n: Lic.node_exp) : Lic.node_exp =
Verbose.printf ~flag:dbg "*** Splitting node %s\n"
(LicDump.string_of_node_key_iter n.node_key_eff);
let res = match n.def_eff with
| ExternLic
| MetaOpLic _
| AbstractLic None -> n
| AbstractLic (Some pn) ->
Verbose.printf ~flag:dbg "*** Splitting node %s\n"
(LicDump.string_of_node_key_iter n.node_key_eff);
let res = match n.def_eff with
| ExternLic
| MetaOpLic _
| AbstractLic None -> n
| AbstractLic (Some pn) ->
{ n with def_eff = AbstractLic (Some (split_node getid pn)) }
| BodyLic b ->
| BodyLic b ->
let loc = match n.loclist_eff with None -> [] | Some l -> l in
let (neqs, nv) = List.fold_left (split_eq_acc getid) ([], loc) b.eqs_eff in
let asserts = List.map (fun x -> x.it) b.asserts_eff in
let lxm_asserts = List.map (fun x -> x.src) b.asserts_eff in
let nasserts,(neqs_asserts,nv_asserts) =
split_val_exp_list false true getid asserts
split_val_exp_list false true getid asserts
in
let nasserts = List.map2 Lxm.flagit nasserts lxm_asserts in
let (neqs, nv) = (neqs@neqs_asserts, nv@nv_asserts) in
let nb = { eqs_eff = neqs ; asserts_eff = nasserts } in
{ n with loclist_eff = Some nv; def_eff = BodyLic nb }
in
res
{ n with loclist_eff = Some nv; def_eff = BodyLic nb }
in
res
let rec doit (inprg : LicPrg.t) : LicPrg.t =
(* n.b. on fait un minumum d'effet de bord pour
......@@ -354,6 +354,9 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
(** TRAITE LES NOEUDS : *)
let rec do_node k (ne:Lic.node_exp) =
(* On passe en parametre un constructeur de nouvelle variable locale *)
Verbose.printf ~flag:dbg
"#DBG: split equations of '%s'\n"
(Lic.string_of_node_key k);
let getid = LicPrg.fresh_var_id_generator inprg ne in
let ne' = split_node getid ne in
res := LicPrg.add_node k ne' !res
......
src/licPrg.ml
+ 28
− 17
View file @ b97a966e
......@@ -62,6 +62,17 @@ let find_type this k = ItemKeyMap.find k this.types
let find_const this k = ItemKeyMap.find k this.consts
let find_node this k = NodeKeyMap.find k this.nodes
let (find_var : Ident.t -> Lic.node_exp -> Lic.var_info option) =
fun id ne ->
let name_matches vi = vi.Lic.var_name_eff = id in
try Some (List.find name_matches ne.Lic.inlist_eff) with Not_found ->
try Some (List.find name_matches ne.Lic.outlist_eff) with Not_found ->
match ne.Lic.loclist_eff with
| None -> None
| Some vil ->
try Some (List.find name_matches vil)
with Not_found -> None
(** PARCOURS *)
let fold_consts (f: Lic.item_key -> Lic.const -> 'a -> 'a) (this:t) (accin:'a) : 'a =
......@@ -154,30 +165,30 @@ let to_file (oc: out_channel) (this:t) =
type id_generator = string -> string
let fresh_var_id_generator : t -> Lic.node_exp -> id_generator =
fun prg ne ->
let cpt = ref 0 in
let forbidden = Hashtbl.create 100 in
let _ = iter_consts (fun i c -> match c with
fun prg ne ->
let cpt = ref 0 in
let forbidden = Hashtbl.create 100 in
let _ = iter_consts (fun i c -> match c with
| Lic.Extern_const_eff (s,_)
| Lic.Abstract_const_eff (s,_,_,_)
| Lic.Enum_const_eff (s,_) -> Hashtbl.add forbidden (snd s) ()
| _ -> ()
) prg in
let dovar vi = Hashtbl.add forbidden vi.Lic.var_name_eff () in
let _ = List.iter dovar ne.Lic.inlist_eff in
let _ = List.iter dovar ne.Lic.outlist_eff in
let _ = match ne.Lic.loclist_eff with
) prg in
let dovar vi = Hashtbl.add forbidden vi.Lic.var_name_eff () in
let _ = List.iter dovar ne.Lic.inlist_eff in
let _ = List.iter dovar ne.Lic.outlist_eff in
let _ = match ne.Lic.loclist_eff with
| Some l -> List.iter dovar l | None -> ()
in
let rec dogen (pfx: string) : string =
in
let rec dogen (pfx: string) : string =
let id = Printf.sprintf "%s%02d" pfx !cpt in
incr cpt;
try (
let _ = Hashtbl.find forbidden id in
dogen pfx
let _ = Hashtbl.find forbidden id in
dogen pfx
) with Not_found -> (
Hashtbl.add forbidden id ();
id
Hashtbl.add forbidden id ();
id
)
in
dogen
in
dogen
src/licPrg.mli
+ 5
− 1
View file @ b97a966e
(* Time-stamp: <modified the 13/12/2012 (at 11:14) by Erwan Jahier> *)
(* Time-stamp: <modified the 18/12/2012 (at 14:25) by Erwan Jahier> *)
(** The data structure resulting from the compilation process *)
......@@ -43,10 +43,14 @@ val iter_nodes : (Lic.node_key -> Lic.node_exp -> unit) -> t -> unit
val to_file : out_channel -> t -> unit
(* Raises Not_found. *)
val find_type : t -> Lic.item_key -> Lic.type_
val find_const : t -> Lic.item_key -> Lic.const
val find_node : t -> Lic.node_key -> Lic.node_exp
val find_var : Ident.t -> Lic.node_exp -> Lic.var_info option
val fresh_type_id : t -> Ident.pack_name -> string -> Ident.long
(** utile : générateur de noms de flow 'frais'
......
src/main.ml
+ 4
− 4
View file @ b97a966e
(* Time-stamp: <modified the 13/12/2012 (at 10:45) by Erwan Jahier> *)
(* Time-stamp: <modified the 17/12/2012 (at 18:08) by Erwan Jahier> *)
......@@ -232,12 +232,12 @@ let main = (
my_exit 1
| Assert_failure (file, line, col) ->
prerr_string (
"\n*** oops: an internal error (lus2lic) occurred in file "^ file ^
", line " ^ (string_of_int line) ^ ", column " ^
"\n*** oops: lus2lic internal error\n\tFile \""^ file ^
"\", line " ^ (string_of_int line) ^ ", column " ^
(string_of_int col) ^ "\n*** when compiling lustre program" ^
(if List.length !Global.infiles > 1 then "s " else " ") ^
(String.concat ", " !Global.infiles) ^ "\n"^
"\n*** You migth want to sent a bug report to jahier@imag.fr\n") ;
"\n*** You migth want to sent a bug report to "^Version.maintainer ^"\n") ;
my_exit 2
(* | Compile_node_error(nkey,lxm,msg) -> ( *)
......
src/mainArgs.ml
+ 1
− 1
View file @ b97a966e
......@@ -229,7 +229,7 @@ let mkoptab (opt:t) : unit = (
(Arg.Set Global.nonreg_test)
["(internal)"]
;
(* misc degub flag *)
(* misc debug flag *)
mkopt opt ~hide:true
["-dbg"; "--debug"]
(Arg.Symbol
......
todo.org
+ 8
− 2
View file @ b97a966e
......@@ -5,7 +5,7 @@
* Urgent
** TODO rebrancher le nodeExpand.ml et structArrayExpand.ml
SCHEDULED: <2012-12-10 Mon>
SCHEDULED: <2012-12-14 Fri>
- State "TODO" from "" [2012-12-10 Mon 16:55]
file:src/l2lExpandNodes.mli
......@@ -13,9 +13,15 @@ file:src/l2lExpandArrays.mli
que Pascal les a débranché lors de son ménage d'été.
** TODO Pascal a shunté mon LicName dans split. Avait-il (une bonne) raison ?
SCHEDULED: <2012-12-17 Mon>
- State "TODO" from "" [2012-12-17 Mon 16:37]
par ex, file:~/lus2lic/src/l2lExpandArrays.ml::50
dois-je faire comme lui ou comme avant ?
** TODO Refaire marcher les tests de non-reg qui sont cassés
SCHEDULED: <2012-12-10 Mon>
SCHEDULED: <2012-12-14 Fri>
suites aux modifs de Pascal de l'été 2012
- State "TODO" from "" [2012-10-26 Fri 14:59]
......
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