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: ...@@ -126,6 +126,10 @@ dot:
html: html:
ocamldoc -I $(OBJDIR) $(MLONLY_SOURCES) -d ocamldoc -html -keep-code ocamldoc -I $(OBJDIR) $(MLONLY_SOURCES) -d ocamldoc -html -keep-code
nomli:
rm $(OBJDIR)/*.mli
debug: nomli dc
ln: $(OBJDIR) $(SOURCES) ln: $(OBJDIR) $(SOURCES)
...@@ -145,6 +149,8 @@ $(OBJDIR)/version.ml: ...@@ -145,6 +149,8 @@ $(OBJDIR)/version.ml:
echo "let commit = \"$(shell utils/get_commit_number)\"" >> $@ echo "let commit = \"$(shell utils/get_commit_number)\"" >> $@
echo "let sha_1 = \"$(shell utils/get_sha_1)"\">> $@ echo "let sha_1 = \"$(shell utils/get_sha_1)"\">> $@
echo "let str = (branch ^ \".\" ^ commit)">> $@ echo "let str = (branch ^ \".\" ^ commit)">> $@
echo "let maintainer = \"jahier@imag.fr\"">> $@
all: nc 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 open Lxm
...@@ -40,21 +40,16 @@ let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) = ...@@ -40,21 +40,16 @@ let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
LicTab.compile_node lic_tab main_node LicTab.compile_node lic_tab main_node
in in
let zelic = LicTab.to_lic_prg lic_tab in let zelic = LicTab.to_lic_prg lic_tab in
(* limination polymorphisme surcharge *) (* limination polymorphisme surcharge *)
let zelic = L2lRmPoly.doit zelic in let zelic = L2lRmPoly.doit zelic in
(* alias des types array *) (* alias des types array *)
let zelic = L2lAliasType.doit zelic in let zelic = L2lAliasType.doit zelic in
let zelic = if not !Global.one_op_per_equation then zelic else
(* split des equations (1 eq = 1 op) *) (* Split des equations (1 eq = 1 op) *)
let zelic = if !Global.one_op_per_equation then L2lSplit.doit zelic else zelic in L2lSplit.doit zelic
(* let zelic = *) in
(* if !Global.expand_structs *) let zelic = if not !Global.expand_structs then zelic else
(* then L2lExpandArrays.doit id_solver lenv zelic *) (* Array and struct expansion: to do after polymorphism elimination *)
(* else zelic *) L2lExpandArrays.doit zelic
(* in *) in
(* XXX node et array expand ! *)
zelic 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 : Source 2 source transformation :
...@@ -13,116 +13,116 @@ open Lic ...@@ -13,116 +13,116 @@ open Lic
let doit (inp : LicPrg.t) : LicPrg.t = let doit (inp : LicPrg.t) : LicPrg.t =
(* n.b. on fait un minumum d'effet de bord pour (* n.b. on fait un minumum d'effet de bord pour
pas avoir trop d'acummulateur ... *) pas avoir trop d'acummulateur ... *)
let atab = Hashtbl.create 10 in let atab = Hashtbl.create 10 in
let res = ref inp in let res = ref inp in
(** UTILE : nommage des alias d'array *) (** UTILE : nommage des alias d'array *)
let array_ident ty sz = let array_ident ty sz =
let tid = Lic.ident_of_type ty in let tid = Lic.ident_of_type ty in
let sfx = Printf.sprintf "%s_%d" (snd tid) sz in let sfx = Printf.sprintf "%s_%d" (snd tid) sz in
let id = LicPrg.fresh_type_id !res (fst tid) sfx in let id = LicPrg.fresh_type_id !res (fst tid) sfx in
id id
in in
(** UTILE : cherche/crée un alias de type *) (** UTILE : cherche/crée un alias de type *)
let rec alias_type te = let rec alias_type te =
match te with match te with
| Array_type_eff (ty, sz) -> ( | Array_type_eff (ty, sz) -> (
let ty = alias_type ty in let ty = alias_type ty in
let te = Array_type_eff (ty, sz) in let te = Array_type_eff (ty, sz) in
try try
let ref_te = Hashtbl.find atab te in let ref_te = Hashtbl.find atab te in
(* (*
Verbose.printf "--> alias_type %s = %s ^ %d FOUND : %s\n" Verbose.printf "--> alias_type %s = %s ^ %d FOUND : %s\n"
(LicDump.string_of_type_eff te) (LicDump.string_of_type_eff te)
(LicDump.string_of_type_eff ty) (LicDump.string_of_type_eff ty)
sz sz
(LicDump.string_of_type_eff ref_te); (LicDump.string_of_type_eff ref_te);
*) *)
ref_te ref_te
with Not_found -> ( with Not_found -> (
let id = array_ident ty sz in let id = array_ident ty sz in
let ref_te = Abstract_type_eff (id, te) in let ref_te = Abstract_type_eff (id, te) in
res := LicPrg.add_type id ref_te !res; res := LicPrg.add_type id ref_te !res;
Hashtbl.add atab te ref_te; Hashtbl.add atab te ref_te;
(* (*
Verbose.printf "--> alias_type %s = %s ^ %d NOT FOUND, gives: %s\n" Verbose.printf "--> alias_type %s = %s ^ %d NOT FOUND, gives: %s\n"
(LicDump.string_of_type_eff te) (LicDump.string_of_type_eff te)
(LicDump.string_of_type_eff ty) (LicDump.string_of_type_eff ty)
sz sz
(LicDump.string_of_type_eff ref_te); (LicDump.string_of_type_eff ref_te);
*) *)
ref_te ref_te
) )
) | _ -> te ) | _ -> te
in in
(** TRAITE LES TYPES *) (** TRAITE LES TYPES *)
let do_type k te = let do_type k te =
let te' = match te with let te' = match te with
| Array_type_eff (tel, sz) -> | Array_type_eff (tel, sz) ->
let tel' = alias_type tel in let tel' = alias_type tel in
Array_type_eff (tel', sz) Array_type_eff (tel', sz)
| Struct_type_eff (id, fields) -> | Struct_type_eff (id, fields) ->
let do_field (id, (tf, co)) = let do_field (id, (tf, co)) =
(id, (alias_type tf, co)) (id, (alias_type tf, co))
in in
Struct_type_eff (id, List.map do_field fields) Struct_type_eff (id, List.map do_field fields)
| _ -> te | _ -> te
in in
if (te = te') then () if (te = te') then ()
else else
res := LicPrg.add_type k te' !res res := LicPrg.add_type k te' !res
in in
LicPrg.iter_types do_type inp; LicPrg.iter_types do_type inp;
(** TRAITE LES CONSTANTES *) (** TRAITE LES CONSTANTES *)
let do_const k ec = let do_const k ec =
let ec' = match ec with let ec' = match ec with
| Extern_const_eff (i, te) -> | Extern_const_eff (i, te) ->
let te' = alias_type te in let te' = alias_type te in
Extern_const_eff (i, te') Extern_const_eff (i, te')
| Abstract_const_eff (i, te, c, b) -> | Abstract_const_eff (i, te, c, b) ->
let te' = alias_type te in let te' = alias_type te in
Abstract_const_eff (i, te', c, b) Abstract_const_eff (i, te', c, b)
| Array_const_eff (cl, te) -> | Array_const_eff (cl, te) ->
let te' = alias_type te in let te' = alias_type te in
Array_const_eff (cl, te') Array_const_eff (cl, te')
| Bool_const_eff _ | Bool_const_eff _
| Int_const_eff _ | Int_const_eff _
| Real_const_eff _ | Real_const_eff _
| Enum_const_eff _ | Enum_const_eff _
| Struct_const_eff _ | Struct_const_eff _
| Tuple_const_eff _ -> ec | Tuple_const_eff _ -> ec
in in
if (ec = ec') then () if (ec = ec') then ()
else else
(* n.b. add=replace *) (* n.b. add=replace *)
res := LicPrg.add_const k ec' !res res := LicPrg.add_const k ec' !res
in in
LicPrg.iter_consts do_const inp ; LicPrg.iter_consts do_const inp ;
(** TRAITE LES NOEUDS *) (** TRAITE LES NOEUDS *)
let do_node k en = let do_node k en =
(* n.b. les Lic.type_ apparraissent uniquement dans les var infos *) (* n.b. les Lic.type_ apparraissent uniquement dans les var infos *)
let do_var vi = let do_var vi =
let ty = alias_type vi.var_type_eff in let ty = alias_type vi.var_type_eff in
{vi with var_type_eff = ty} {vi with var_type_eff = ty}
in in
let en' = { en with let en' = { en with
inlist_eff = (List.map do_var en.inlist_eff); inlist_eff = (List.map do_var en.inlist_eff);
outlist_eff = (List.map do_var en.outlist_eff); outlist_eff = (List.map do_var en.outlist_eff);
loclist_eff = ( loclist_eff = (
match en.loclist_eff with match en.loclist_eff with
| Some vl -> Some (List.map do_var vl) | Some vl -> Some (List.map do_var vl)
| None -> None | None -> None
) )
} in } in
(* on fait pas dans la dentelle, on remplace ... *) (* on fait pas dans la dentelle, on remplace ... *)
res := LicPrg.add_node k en' !res res := LicPrg.add_node k en' !res
in in
LicPrg.iter_nodes do_node inp; LicPrg.iter_nodes do_node inp;
!res !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 *) (** 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 : Source 2 source transformation :
élimine polymorphisme et surcharge é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 open Lxm
...@@ -63,22 +55,15 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t = ...@@ -63,22 +55,15 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
| MetaOpLic _ | MetaOpLic _
| ExternLic -> ne.def_eff | ExternLic -> ne.def_eff
| AbstractLic _ -> assert false | AbstractLic _ -> assert false
| BodyLic nb -> | BodyLic nb -> BodyLic (do_body [] nb)
BodyLic (do_body [] nb)
in in
res := LicPrg.add_node k { ne with def_eff = def'} !res res := LicPrg.add_node k { ne with def_eff = def'} !res
) )
(** TRAITEMENT DES BODY *) (** TRAITEMENT DES BODY *)
and do_body and do_body (m: Lic.type_matches) (nb: Lic.node_body) : Lic.node_body =
(m: Lic.type_matches)
(nb: Lic.node_body)
: Lic.node_body =
(* parcours les expressions du body (* parcours les expressions du body
à la recherche d'appel ne noeuds poly *) à la recherche d'appel de noeuds poly *)
let do_assert a = let do_assert a = Lxm.flagit (do_exp m a.it) a.src
Lxm.flagit (
do_exp m a.it
) a.src
and do_eq eq = and do_eq eq =
Lxm.flagit ( Lxm.flagit (
fst eq.it, fst eq.it,
...@@ -159,7 +144,9 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t = ...@@ -159,7 +144,9 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
(Lic.string_of_type_matches tmatches) (Lic.string_of_type_matches tmatches)
; ;
let do_var vi = 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 in
(* nouvelle clé unique = ancienne + tmatches *) (* nouvelle clé unique = ancienne + tmatches *)
let (nid, sargs) = nk in 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 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 ...@@ -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) = let rec (eq : LicPrg.id_generator -> Lic.eq_info Lxm.srcflagged -> split_acc) =
fun getid { src = lxm_eq ; it = (lhs, rhs) } -> fun getid { src = lxm_eq ; it = (lhs, rhs) } ->
let n_rhs, (neqs, nlocs) = split_val_exp false true getid rhs in 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 : and (split_eq_acc :
LicPrg.id_generator -> split_acc -> Lic.eq_info srcflagged -> split_acc) = LicPrg.id_generator -> split_acc -> Lic.eq_info srcflagged -> split_acc) =
fun getid (eqs, locs) equation -> fun getid (eqs, locs) equation ->
let (neqs, nlocs) = eq getid equation in 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 -> 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 -> fun when_flag top_level getid ve ->
(* [when_flag] is true is the call is made from a "when" statement. (* [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 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 -> ...@@ -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.FALSE_n,_)}, _)
| CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.ICONST_n _,_)}, _) | CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.ICONST_n _,_)}, _)
| CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.RCONST_n _,_)}, _) | CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.RCONST_n _,_)}, _)
(* We do not create an intermediary variable for those, (* We do not create an intermediary variable for those,
but but
*) *)
-> if not when_flag then -> if not when_flag then
let clk = ve.ve_clk in let clk = ve.ve_clk in
match (List.hd clk) with match (List.hd clk) with
| On(clock,_) -> | On(clock,_) ->
let clk_exp = AstCore.NamedClock (Lxm.flagit clock lxm) in let clk_exp = AstCore.NamedClock (Lxm.flagit clock lxm) in
{ ve with ve_core = { ve with ve_core =
CallByPosLic({src=lxm;it=Lic.WHEN clk_exp},OperLic [ve])}, CallByPosLic({src=lxm;it=Lic.WHEN clk_exp},OperLic [ve])},
([],[]) ([],[])
| (ClockVar _) (* should not occur *) | (ClockVar _) (* should not occur *)
| BaseLic -> ve, ([],[]) | BaseLic -> ve, ([],[])
else else
ve, ([],[]) ve, ([],[])
| CallByNameLic (by_name_op_eff, fl) -> | CallByNameLic (by_name_op_eff, fl) ->
let lxm = by_name_op_eff.src in let lxm = by_name_op_eff.src in
let fl, eql, vl = let fl, eql, vl =
List.fold_left List.fold_left
(fun (fl_acc, eql_acc, vl_acc) (fn, fv) -> (fun (fl_acc, eql_acc, vl_acc) (fn, fv) ->
let fv, (eql, vl) = split_val_exp false false getid fv in let fv, (eql, vl) = split_val_exp false false getid fv in
((fn,fv)::fl_acc, eql@eql_acc, vl@vl_acc) ((fn,fv)::fl_acc, eql@eql_acc, vl@vl_acc)
) )
([],[],[]) ([],[],[])
fl fl
in in
let rhs = { ve with ve_core = CallByNameLic (by_name_op_eff, List.rev fl) } in let rhs = { ve with ve_core = CallByNameLic (by_name_op_eff, List.rev fl) } in
if top_level then if top_level then
rhs, (eql, vl) rhs, (eql, vl)
else else
(* create the var for the current call *) (* create the var for the current call *)
let clk_l = ve.ve_clk in let clk_l = ve.ve_clk in
let typ_l = ve.ve_typ in let typ_l = ve.ve_typ in
let nv_l = List.map2 (new_var getid) typ_l clk_l in let nv_l = List.map2 (new_var getid) typ_l clk_l in
let nve = match nv_l with let nve = match nv_l with
| [nv] -> { ve with ve_core = | [nv] -> { ve with ve_core =
CallByPosLic( CallByPosLic(
Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm, Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,
OperLic [] OperLic []
)} )}
| _ -> assert false | _ -> assert false
in in
let lpl = List.map (fun nv -> LeftVarLic(nv, lxm)) nv_l in let lpl = List.map (fun nv -> LeftVarLic(nv, lxm)) nv_l in
let eq = Lxm.flagit (lpl, rhs) lxm in let eq = Lxm.flagit (lpl, rhs) lxm in
nve, (eql@[eq], vl@nv_l) nve, (eql@[eq], vl@nv_l)
| CallByPosLic(by_pos_op_eff, OperLic vel) -> ( | CallByPosLic(by_pos_op_eff, OperLic vel) -> (
(* recursively split the arguments *) (* recursively split the arguments *)
let lxm = by_pos_op_eff.src in let lxm = by_pos_op_eff.src in
let (rhs, (eql,vl)) = let (rhs, (eql,vl)) =
match by_pos_op_eff.it with match by_pos_op_eff.it with
(* for WITH and HAT, a particular treatment is done because (* for WITH and HAT, a particular treatment is done because
the val_exp is attached to them *) the val_exp is attached to them *)
| Lic.WITH(ve) -> | Lic.WITH(ve) ->
let ve, (eql, vl) = split_val_exp false false getid ve in 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 by_pos_op_eff = Lxm.flagit (Lic.WITH(ve)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
rhs, (eql, vl) rhs, (eql, vl)
| Lic.HAT(i,ve) -> | Lic.HAT(i,ve) ->
let ve, (eql, vl) = split_val_exp false false getid ve in 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 by_pos_op_eff = Lxm.flagit (Lic.HAT(i, ve)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
rhs, (eql, vl) rhs, (eql, vl)
| Lic.WHEN ve -> (* should we create a var for the clock? *) | 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 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 by_pos_op_eff = Lxm.flagit (Lic.WHEN(ve)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in
rhs, (eql, vl) rhs, (eql, vl)
| Lic.ARRAY vel -> | Lic.ARRAY vel ->
let vel, (eql, vl) = split_val_exp_list false false getid vel in 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 by_pos_op_eff = Lxm.flagit (Lic.ARRAY(vel)) lxm in
let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
rhs, (eql, vl) rhs, (eql, vl)
| _ -> | _ ->
let vel, (eql, vl) = split_val_exp_list false false getid vel in let vel, (eql, vl) = split_val_exp_list false false getid vel in
let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in
rhs, (eql, vl) rhs, (eql, vl)
in in
let rhs = { ve with ve_core = rhs } in let rhs = { ve with ve_core = rhs } in
if top_level || by_pos_op_eff.it = TUPLE then if top_level || by_pos_op_eff.it = TUPLE then
rhs, (eql, vl) rhs, (eql, vl)
else else
(* create the var for the current call *) (* create the var for the current call *)
let clk_l = ve.ve_clk in let clk_l = ve.ve_clk in
let typ_l = ve.ve_typ in let typ_l = ve.ve_typ in
let nv_l = List.map2 (new_var getid) typ_l clk_l in let nv_l = List.map2 (new_var getid) typ_l clk_l in
let nve = let nve =
match nv_l with match nv_l with
| [nv] -> { | [nv] -> {
ve_typ = [nv.var_type_eff]; ve_typ = [nv.var_type_eff];
ve_clk = clk_l; ve_clk = clk_l;
ve_core = CallByPosLic( ve_core = CallByPosLic(
Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm, Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,
OperLic []) OperLic [])
} }
| _ -> { | _ -> {
ve_typ = List.map (fun v -> v.var_type_eff) nv_l; ve_typ = List.map (fun v -> v.var_type_eff) nv_l;
ve_clk = clk_l; ve_clk = clk_l;
ve_core = CallByPosLic( ve_core = CallByPosLic(
Lxm.flagit Lic.TUPLE lxm, Lxm.flagit Lic.TUPLE lxm,
OperLic OperLic
(List.map ( (List.map (
fun nv -> fun nv ->
let nnv = { let nnv = {
ve_core = CallByPosLic ve_core = CallByPosLic
(Lxm.flagit (Lxm.flagit
(Lic.VAR_REF (nv.var_name_eff)) lxm, (Lic.VAR_REF (nv.var_name_eff)) lxm,
OperLic []); OperLic []);
ve_typ = [nv.var_type_eff]; ve_typ = [nv.var_type_eff];
ve_clk = [snd nv.var_clock_eff] ve_clk = [snd nv.var_clock_eff]
} }
in in
nnv nnv
) )
nv_l nv_l
) )
) )
} }
in in
let lpl = List.map (fun nv -> LeftVarLic(nv, lxm)) nv_l in let lpl = List.map (fun nv -> LeftVarLic(nv, lxm)) nv_l in
let eq = Lxm.flagit (lpl, rhs) lxm in let eq = Lxm.flagit (lpl, rhs) lxm in
nve, (eql@[eq], vl@nv_l) nve, (eql@[eq], vl@nv_l)
) )
and (split_val_exp_list : bool -> 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 -> fun when_flag top_level getid vel ->
let vel, accl = let vel, accl =
List.split (List.map (split_val_exp when_flag top_level getid) vel) List.split (List.map (split_val_exp when_flag top_level getid) vel)
in in
let eqll,vll = List.split accl in let eqll,vll = List.split accl in
let eql, vl = List.flatten eqll, List.flatten vll 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 = and split_node (getid: LicPrg.id_generator) (n: Lic.node_exp) : Lic.node_exp =
Verbose.printf ~flag:dbg "*** Splitting node %s\n" Verbose.printf ~flag:dbg "*** Splitting node %s\n"
(LicDump.string_of_node_key_iter n.node_key_eff); (LicDump.string_of_node_key_iter n.node_key_eff);
let res = match n.def_eff with let res = match n.def_eff with
| ExternLic | ExternLic
| MetaOpLic _ | MetaOpLic _
| AbstractLic None -> n | AbstractLic None -> n
| AbstractLic (Some pn) -> | AbstractLic (Some pn) ->
{ n with def_eff = AbstractLic (Some (split_node getid 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 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 (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 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 lxm_asserts = List.map (fun x -> x.src) b.asserts_eff in
let nasserts,(neqs_asserts,nv_asserts) = let nasserts,(neqs_asserts,nv_asserts) =
split_val_exp_list false true getid asserts split_val_exp_list false true getid asserts
in in
let nasserts = List.map2 Lxm.flagit nasserts lxm_asserts in let nasserts = List.map2 Lxm.flagit nasserts lxm_asserts in
let (neqs, nv) = (neqs@neqs_asserts, nv@nv_asserts) in let (neqs, nv) = (neqs@neqs_asserts, nv@nv_asserts) in
let nb = { eqs_eff = neqs ; asserts_eff = nasserts } in let nb = { eqs_eff = neqs ; asserts_eff = nasserts } in
{ n with loclist_eff = Some nv; def_eff = BodyLic nb } { n with loclist_eff = Some nv; def_eff = BodyLic nb }
in in
res res
let rec doit (inprg : LicPrg.t) : LicPrg.t = let rec doit (inprg : LicPrg.t) : LicPrg.t =
(* n.b. on fait un minumum d'effet de bord pour (* n.b. on fait un minumum d'effet de bord pour
...@@ -354,6 +354,9 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t = ...@@ -354,6 +354,9 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
(** TRAITE LES NOEUDS : *) (** TRAITE LES NOEUDS : *)
let rec do_node k (ne:Lic.node_exp) = let rec do_node k (ne:Lic.node_exp) =
(* On passe en parametre un constructeur de nouvelle variable locale *) (* 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 getid = LicPrg.fresh_var_id_generator inprg ne in
let ne' = split_node getid ne in let ne' = split_node getid ne in
res := LicPrg.add_node k ne' !res 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 ...@@ -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_const this k = ItemKeyMap.find k this.consts
let find_node this k = NodeKeyMap.find k this.nodes 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 *) (** PARCOURS *)
let fold_consts (f: Lic.item_key -> Lic.const -> 'a -> 'a) (this:t) (accin:'a) : 'a = 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) = ...@@ -154,30 +165,30 @@ let to_file (oc: out_channel) (this:t) =
type id_generator = string -> string type id_generator = string -> string
let fresh_var_id_generator : t -> Lic.node_exp -> id_generator = let fresh_var_id_generator : t -> Lic.node_exp -> id_generator =
fun prg ne -> fun prg ne ->
let cpt = ref 0 in let cpt = ref 0 in
let forbidden = Hashtbl.create 100 in let forbidden = Hashtbl.create 100 in
let _ = iter_consts (fun i c -> match c with let _ = iter_consts (fun i c -> match c with
| Lic.Extern_const_eff (s,_) | Lic.Extern_const_eff (s,_)
| Lic.Abstract_const_eff (s,_,_,_) | Lic.Abstract_const_eff (s,_,_,_)
| Lic.Enum_const_eff (s,_) -> Hashtbl.add forbidden (snd s) () | Lic.Enum_const_eff (s,_) -> Hashtbl.add forbidden (snd s) ()
| _ -> () | _ -> ()
) prg in ) prg in
let dovar vi = Hashtbl.add forbidden vi.Lic.var_name_eff () 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.inlist_eff in
let _ = List.iter dovar ne.Lic.outlist_eff in let _ = List.iter dovar ne.Lic.outlist_eff in
let _ = match ne.Lic.loclist_eff with let _ = match ne.Lic.loclist_eff with
| Some l -> List.iter dovar l | None -> () | Some l -> List.iter dovar l | None -> ()
in in
let rec dogen (pfx: string) : string = let rec dogen (pfx: string) : string =
let id = Printf.sprintf "%s%02d" pfx !cpt in let id = Printf.sprintf "%s%02d" pfx !cpt in
incr cpt; incr cpt;
try ( try (
let _ = Hashtbl.find forbidden id in let _ = Hashtbl.find forbidden id in
dogen pfx dogen pfx
) with Not_found -> ( ) with Not_found -> (
Hashtbl.add forbidden id (); Hashtbl.add forbidden id ();
id id
) )
in in
dogen 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 *) (** The data structure resulting from the compilation process *)
...@@ -43,10 +43,14 @@ val iter_nodes : (Lic.node_key -> Lic.node_exp -> unit) -> t -> unit ...@@ -43,10 +43,14 @@ val iter_nodes : (Lic.node_key -> Lic.node_exp -> unit) -> t -> unit
val to_file : out_channel -> t -> unit val to_file : out_channel -> t -> unit
(* Raises Not_found. *)
val find_type : t -> Lic.item_key -> Lic.type_ val find_type : t -> Lic.item_key -> Lic.type_
val find_const : t -> Lic.item_key -> Lic.const val find_const : t -> Lic.item_key -> Lic.const
val find_node : t -> Lic.node_key -> Lic.node_exp 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 val fresh_type_id : t -> Ident.pack_name -> string -> Ident.long
(** utile : générateur de noms de flow 'frais' (** 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 = ( ...@@ -232,12 +232,12 @@ let main = (
my_exit 1 my_exit 1
| Assert_failure (file, line, col) -> | Assert_failure (file, line, col) ->
prerr_string ( prerr_string (
"\n*** oops: an internal error (lus2lic) occurred in file "^ file ^ "\n*** oops: lus2lic internal error\n\tFile \""^ file ^
", line " ^ (string_of_int line) ^ ", column " ^ "\", line " ^ (string_of_int line) ^ ", column " ^
(string_of_int col) ^ "\n*** when compiling lustre program" ^ (string_of_int col) ^ "\n*** when compiling lustre program" ^
(if List.length !Global.infiles > 1 then "s " else " ") ^ (if List.length !Global.infiles > 1 then "s " else " ") ^
(String.concat ", " !Global.infiles) ^ "\n"^ (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 my_exit 2
(* | Compile_node_error(nkey,lxm,msg) -> ( *) (* | Compile_node_error(nkey,lxm,msg) -> ( *)
......
src/mainArgs.ml
+ 1
− 1
View file @ b97a966e
...@@ -229,7 +229,7 @@ let mkoptab (opt:t) : unit = ( ...@@ -229,7 +229,7 @@ let mkoptab (opt:t) : unit = (
(Arg.Set Global.nonreg_test) (Arg.Set Global.nonreg_test)
["(internal)"] ["(internal)"]
; ;
(* misc degub flag *) (* misc debug flag *)
mkopt opt ~hide:true mkopt opt ~hide:true
["-dbg"; "--debug"] ["-dbg"; "--debug"]
(Arg.Symbol (Arg.Symbol
......
todo.org
+ 8
− 2
View file @ b97a966e
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
* Urgent * Urgent
** TODO rebrancher le nodeExpand.ml et structArrayExpand.ml ** 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] - State "TODO" from "" [2012-12-10 Mon 16:55]
file:src/l2lExpandNodes.mli file:src/l2lExpandNodes.mli
...@@ -13,9 +13,15 @@ file:src/l2lExpandArrays.mli ...@@ -13,9 +13,15 @@ file:src/l2lExpandArrays.mli
que Pascal les a débranché lors de son ménage d'été. 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 ** 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 suites aux modifs de Pascal de l'été 2012
- State "TODO" from "" [2012-10-26 Fri 14:59] - 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