From 490c876c04cf25ee827735f39888aff10b29c5f3 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Wed, 16 Jan 2013 16:19:03 +0100
Subject: [PATCH] Fix a bug when split equations (l2lSplit.ml) preventing
lus2lic -en to work on programs containing equations such as :
b3, b4, b5, b6 = (three_outputs(two_outputs(b1,b2),true), false);
because TUPLES where not correctly inlined (i.e., "...= n((x,y),z)" instead of "...=n(x,y,z)"
---
src/compile.ml | 12 +--
src/l2lExpandNodes.ml | 6 +-
src/l2lSplit.ml | 192 +++++++++++++++++++------------------
src/licPrg.ml | 8 +-
src/licTab.ml | 33 +------
src/mainArgs.ml | 2 +-
src/unifyType.ml | 30 +++---
test/lus2lic.log.ref | 27 +++---
test/lus2lic.sum | 14 +--
test/lus2lic.time | 4 +-
test/should_work/piege.lus | 18 ----
test/should_work/test.lus | 1 +
todo.org | 15 ++-
13 files changed, 172 insertions(+), 190 deletions(-)
delete mode 100644 test/should_work/piege.lus
diff --git a/src/compile.ml b/src/compile.ml
index a7ac7a91..537925d8 100644
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 20/12/2012 (at 15:25) by Erwan Jahier> *)
+(* Time-stamp: <modified the 15/01/2013 (at 10:09) by Erwan Jahier> *)
open Lxm
@@ -50,14 +50,14 @@ let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
in
let zelic =
if
- not !Global.one_op_per_equation
- && not !Global.expand_nodes (* expand performs not fixpoint, so it will work
- only if we have one op per equation...*)
+ !Global.one_op_per_equation
+ || !Global.expand_nodes (* expand performs no fixpoint, so it will work
+ only if we have one op per equation...*)
then
- zelic
- else
(* Split des equations (1 eq = 1 op) *)
L2lSplit.doit zelic
+ else
+ zelic
in
let zelic = if not !Global.expand_nodes then zelic else
L2lExpandNodes.doit zelic
diff --git a/src/l2lExpandNodes.ml b/src/l2lExpandNodes.ml
index 967743c3..6e4f6ded 100644
--- a/src/l2lExpandNodes.ml
+++ b/src/l2lExpandNodes.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 20/12/2012 (at 16:02) by Erwan Jahier> *)
+(* Time-stamp: <modified the 15/01/2013 (at 10:34) by Erwan Jahier> *)
open Lxm
@@ -128,6 +128,7 @@ let (mk_fresh_loc : local_ctx -> var_info -> var_info) =
let (mk_input_subst: local_ctx -> Lxm.t -> var_info list ->
Lic.val_exp list -> acc -> subst * acc) =
fun lctx lxm vl vel acc ->
+ assert(List.length vl = List.length vel);
List.fold_left2
(fun (s,(a_acc,e_acc,v_acc)) v ve ->
(* we create a new var for each node argument, which is a little
@@ -145,6 +146,7 @@ let (mk_input_subst: local_ctx -> Lxm.t -> var_info list ->
let (mk_output_subst : local_ctx -> Lxm.t -> var_info list -> Lic.left list ->
acc -> subst * acc) =
fun lctx lxm vl leftl acc ->
+ assert(List.length vl = List.length leftl);
List.fold_left2
(fun (s,acc) v left ->
match left with
@@ -288,6 +290,8 @@ let (doit : LicPrg.t -> LicPrg.t) =
(** transform nodes *)
let rec (do_node : Lic.node_key -> Lic.node_exp -> LicPrg.t -> LicPrg.t) =
fun nk ne outprg ->
+ Verbose.printf ~flag:dbg "#DBG: expand nodes of '%s'\n"
+ (Lic.string_of_node_key nk);
let lctx = {
idgen = LicPrg.fresh_var_id_generator inprg ne;
node = ne;
diff --git a/src/l2lSplit.ml b/src/l2lSplit.ml
index 66a4d2b7..7dd9f6e7 100644
--- a/src/l2lSplit.ml
+++ b/src/l2lSplit.ml
@@ -35,6 +35,22 @@ let rec (get_vel_from_tuple : val_exp -> val_exp list) =
List.flatten (List.map get_vel_from_tuple vel)
| ve -> [ve]
+let rec (remove_tuple : val_exp list -> val_exp list) =
+ fun vel ->
+ List.flatten (List.map get_vel_from_tuple vel)
+
+let rec (remove_tuple_from_eq : eq_info srcflagged -> eq_info srcflagged) =
+(* transform "...=((x1,x2),x3)" into "...=(x1,x2,x3)" *)
+ fun {src=lxm;it=(lhs,ve)} ->
+ let ve =
+ match ve.ve_core with
+ | CallByPosLic({it=op;src=lxm }, OperLic vel) ->
+ { ve with
+ ve_core = CallByPosLic({it=op;src=lxm}, OperLic (remove_tuple vel)) }
+ | _ -> ve
+ in
+ {src=lxm;it=(lhs,ve)}
+
let to_be_broken = function
(* We are only interested in operators that can deal with tuples! *)
| CallByPosLic({ it = Lic.ARROW }, _) -> true
@@ -47,68 +63,70 @@ let to_be_broken = function
| _ -> false
-let (break_it : val_exp -> val_exp list) =
+
+let (break_it_do : val_exp -> val_exp list) =
fun ve ->
let nvel =
match ve.ve_core with
- | CallByPosLic({it=Lic.PREDEF_CALL(AstPredef.IF_n,[]);src=lxm}, OperLic [c;ve1;ve2]) ->
- let vel1 = get_vel_from_tuple ve1
- and vel2 = get_vel_from_tuple ve2
- in
- List.map2
- (fun ve1 ve2 ->
- { ve_core =
- CallByPosLic({it=Lic.PREDEF_CALL(AstPredef.IF_n,[]);src=lxm},
- OperLic [c;ve1;ve2]);
- ve_typ = ve1.ve_typ;
- ve_clk = ve1.ve_clk;
- }
- )
- vel1
- vel2
-
- | CallByPosLic({it=WHEN clk; src=lxm}, OperLic vel) ->
- let vel = List.flatten (List.map get_vel_from_tuple vel) in
- List.map
- (fun ve ->
- { ve with
- ve_core=CallByPosLic({it=WHEN clk ; src=lxm }, OperLic [ve])})
- vel
-
- | CallByPosLic({it=Lic.TUPLE ; src=lxm }, OperLic vel) ->
- let vel = List.flatten (List.map get_vel_from_tuple vel) in
- List.map
- (fun ve ->
- { ve with
- ve_core=CallByPosLic({it=Lic.TUPLE ; src=lxm }, OperLic [ve])})
- vel
-
- | CallByPosLic({it=op ; src=lxm }, OperLic [ve]) ->
- let vel = get_vel_from_tuple ve in
- List.map
- (fun ve -> { ve with ve_core=CallByPosLic({it=op;src=lxm}, OperLic [ve])})
- vel
-
- | CallByPosLic({it=op ; src=lxm }, OperLic [ve1;ve2]) ->
- let vel1 = get_vel_from_tuple ve1
- and vel2 = get_vel_from_tuple ve2
- in
- List.map2
- (fun ve1 ve2 ->
- { ve_core = CallByPosLic({it=op ; src=lxm }, OperLic [ve1;ve2]);
- ve_typ = ve1.ve_typ;
- ve_clk = ve1.ve_clk }
- )
- vel1
- vel2
-
- | _ -> assert false (* dead code since it is guarded by to_be_broken... *)
+ | CallByPosLic({it=Lic.PREDEF_CALL(AstPredef.IF_n,[]);src=lxm}, OperLic [c;ve1;ve2]) ->
+ let vel1 = get_vel_from_tuple ve1
+ and vel2 = get_vel_from_tuple ve2
+ in
+ assert (List.length vel1 = List.length vel2);
+ List.map2
+ (fun ve1 ve2 ->
+ { ve_core =
+ CallByPosLic({it=Lic.PREDEF_CALL(AstPredef.IF_n,[]);src=lxm},
+ OperLic [c;ve1;ve2]);
+ ve_typ = ve1.ve_typ;
+ ve_clk = ve1.ve_clk;
+ }
+ )
+ vel1
+ vel2
+ | CallByPosLic({it=WHEN clk; src=lxm}, OperLic vel) -> (
+ let vel = List.flatten (List.map get_vel_from_tuple vel) in
+ List.map
+ (fun ve ->
+ { ve with
+ ve_core=CallByPosLic({it=WHEN clk ; src=lxm }, OperLic [ve])})
+ vel
+ )
+ | CallByPosLic({it=Lic.TUPLE ; src=lxm }, OperLic vel) -> (remove_tuple vel)
+ | CallByPosLic({it=op ; src=lxm }, OperLic [ve]) ->
+ let vel = get_vel_from_tuple ve in
+ List.map
+ (fun ve -> { ve with ve_core=CallByPosLic({it=op;src=lxm}, OperLic [ve])})
+ vel
+ | CallByPosLic({it=op ; src=lxm }, OperLic [ve1;ve2]) ->
+ let vel1 = get_vel_from_tuple ve1
+ and vel2 = get_vel_from_tuple ve2
+ in
+ assert (List.length vel1 = List.length vel2);
+ List.map2
+ (fun ve1 ve2 ->
+ { ve_core = CallByPosLic({it=op ; src=lxm }, OperLic [ve1;ve2]);
+ ve_typ = ve1.ve_typ;
+ ve_clk = ve1.ve_clk }
+ )
+ vel1
+ vel2
+ | _ -> [ve]
+ (* assert false (* ougth to be dead code (guarded by to_be_broken...) *) *)
in
let tl = ve.ve_typ
and cl = ve.ve_clk in
- let nvel = List.map2 (fun nve t -> { nve with ve_typ = [t]; ve_clk=cl } ) nvel ve.ve_typ in
- assert(ve.ve_typ = tl);
- nvel
+ assert (List.length ve.ve_typ = List.length nvel);
+ let nvel = List.map2 (fun nve t -> { nve with ve_typ = [t]; ve_clk=cl } ) nvel ve.ve_typ in
+ assert(ve.ve_typ = tl);
+ nvel
+
+let rec (break_it : val_exp -> val_exp list) =
+ fun ve ->
+ let vel = break_it_do ve in
+ if List.length vel = 1 then [ve] else
+ (* fixpoint *)
+ (List.flatten (List.map break_it vel))
let (split_tuples:Lic.eq_info Lxm.srcflagged list -> Lic.eq_info Lxm.srcflagged list) =
fun eql ->
@@ -125,9 +143,8 @@ let (split_tuples:Lic.eq_info Lxm.srcflagged list -> Lic.eq_info Lxm.srcflagged
eqs
else
[eq]
-
in
- List.flatten (List.map split_one_eq eql)
+ List.flatten (List.map split_one_eq eql)
(********************************************************************************)
(* The functions below accumulate
@@ -164,14 +181,12 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
match ve.ve_core with
| CallByPosLic({it=Lic.VAR_REF _}, _) -> ve, ([],[])
| CallByPosLic({it=Lic.CONST_REF _}, _) -> ve, ([],[])
-
| CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.TRUE_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.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
match (List.hd clk) with
@@ -185,8 +200,7 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
| BaseLic -> ve, ([],[])
else
ve, ([],[])
-
- | CallByNameLic (by_name_op_eff, fl) ->
+ | CallByNameLic (by_name_op_eff, fl) -> (
let lxm = by_name_op_eff.src in
let fl, eql, vl =
List.fold_left
@@ -201,9 +215,10 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
if top_level then
rhs, (eql, vl)
else
- (* create the var for the current call *)
+ (* create the var for the current call *)
let clk_l = ve.ve_clk in
let typ_l = ve.ve_typ in
+ assert (List.length typ_l = List.length clk_l);
let nv_l = List.map2 (new_var getid) typ_l clk_l in
let nve = match nv_l with
| [nv] -> { ve with ve_core =
@@ -216,39 +231,34 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
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 *)
+ (* 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 *)
+ (* 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
@@ -258,11 +268,11 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
if top_level || by_pos_op_eff.it = TUPLE then
rhs, (eql, vl)
else
- (* create the var for the current call *)
+ (* create the var for the current call *)
let clk_l = ve.ve_clk in
let typ_l = ve.ve_typ in
+ assert (List.length typ_l = List.length clk_l);
let nv_l = List.map2 (new_var getid) typ_l clk_l in
-
let nve =
match nv_l with
| [nv] -> {
@@ -278,19 +288,18 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
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
- )
+ (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
)
)
@@ -328,8 +337,10 @@ and split_node (getid: LicPrg.id_generator) (n: Lic.node_exp) : Lic.node_exp =
let nasserts,(neqs_asserts,nv_asserts) =
split_val_exp_list false true getid asserts
in
+ assert (List.length nasserts = List.length lxm_asserts);
let nasserts = List.map2 Lxm.flagit nasserts lxm_asserts in
let (neqs, nv) = (neqs@neqs_asserts, nv@nv_asserts) in
+ let neqs = List.map remove_tuple_from_eq neqs in
let nb = { eqs_eff = neqs ; asserts_eff = nasserts } in
{ n with loclist_eff = Some nv; def_eff = BodyLic nb }
in
@@ -355,8 +366,7 @@ 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"
+ 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
diff --git a/src/licPrg.ml b/src/licPrg.ml
index 5c365ccc..65a707fd 100644
--- a/src/licPrg.ml
+++ b/src/licPrg.ml
@@ -100,7 +100,7 @@ let add_const (k:Lic.item_key) (v:Lic.const) (prg:t) : t =
{ prg with consts = ItemKeyMap.add k v prg.consts }
let add_node (k:Lic.node_key) (v:Lic.node_exp) (prg:t) : t =
-Verbose.printf ~level:3 "## LicPrg.add_node %s\n" (LicDump.string_of_node_key_rec k);
+ Verbose.printf ~level:3 "## LicPrg.add_node %s\n" (LicDump.string_of_node_key_rec k);
{ prg with nodes = NodeKeyMap.add k v prg.nodes }
@@ -183,12 +183,14 @@ let to_file (oc: out_channel) (this:t) =
ItemKeyMap.iter
(fun tn te ->
if (not !Global.ec || Lic.is_extern_type te) then
- output_string !Global.oc (LicDump.type_decl tn te))
+ output_string !Global.oc (LicDump.type_decl tn te)
+ )
this.types;
ItemKeyMap.iter
(fun cn ce ->
if (not !Global.ec || Lic.is_extern_const ce) then
- output_string !Global.oc (LicDump.const_decl cn ce))
+ output_string !Global.oc (LicDump.const_decl cn ce)
+ )
this.consts
(* GENERATEUR DE NOM DE VARIABLES *)
diff --git a/src/licTab.ml b/src/licTab.ml
index 5265833c..e242609b 100644
--- a/src/licTab.ml
+++ b/src/licTab.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 20/12/2012 (at 17:21) by Erwan Jahier> *)
+(* Time-stamp: <modified the 15/01/2013 (at 10:53) by Erwan Jahier> *)
open Lxm
@@ -649,27 +649,6 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
"bad constant value: tuple not allowed"))
)
in
- let is_struct_or_array = match const_eff with
- | Struct_const_eff _ -> true
- | Array_const_eff _ -> true
- | _ -> false
- in
- let is_extern_const =
- match const_eff with
- | Enum_const_eff(_) ->
- !Global.expand_enums (* When expanding enums, we treat them as extern const *)
- && not provide_flag (* Avoid to define them twice *)
- | Extern_const_eff(_)
- -> true
- | _ -> false
- in
- if
- (not provide_flag
- && (not (!Global.expand_structs & is_struct_or_array))
- && (not !Global.ec) (* ec does not need constant decl, except extern ones *)
- ) || is_extern_const
- then
- ();
const_eff
) with Recursion_error (root, stack) -> (
(* capte et complete/stoppe les recursions *)
@@ -1357,13 +1336,11 @@ let to_lic_prg (this:t) : LicPrg.t =
| _ -> add_x k (unflag v) prg
in
let add_node k v prg =
- Verbose.printf ~flag:dbg
- "#DBG: licTab.to_lic: node key '%s'\n"
- (Lic.string_of_node_key k)
- ;
+ Verbose.printf ~flag:dbg "#DBG: licTab.to_lic: node key '%s'\n"
+ (Lic.string_of_node_key k);
match Ident.pack_of_long (fst k) with
- (* | "Lustre" -> prg *)
- | _ -> LicPrg.add_node k (unflag v) prg
+(* | "Lustre" -> prg *)
+ | _ -> LicPrg.add_node k (unflag v) prg
in
let res = LicPrg.empty in
let res = Hashtbl.fold (add_item LicPrg.add_type) this.types res in
diff --git a/src/mainArgs.ml b/src/mainArgs.ml
index c7a7889b..86632d54 100644
--- a/src/mainArgs.ml
+++ b/src/mainArgs.ml
@@ -161,7 +161,7 @@ let mkoptab (opt:t) : unit = (
(Arg.String (fun str ->
Global.dont_expand_nodes := str::!Global.dont_expand_nodes
))
- ["Do not expand node (useful in the expand mode only of course)."]
+ ["Do not expand the specified node (meaningful with -en only of course)."]
;
mkopt opt
["-lv4"; "--lustre-v4"]
diff --git a/src/unifyType.ml b/src/unifyType.ml
index 0381a264..0efcb4f5 100644
--- a/src/unifyType.ml
+++ b/src/unifyType.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/12/2012 (at 18:14) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/01/2013 (at 18:22) by Erwan Jahier> *)
(*
12/07. Premier pas vers une méthode un peu plus standard :
@@ -70,6 +70,7 @@ let f (l1: Lic.type_ list) (l2: Lic.type_ list): t =
(** USELESS ??? *)
let fl1 = List.map (fun (_,(te,_)) -> te) fl1
and fl2 = List.map (fun (_,(te,_)) -> te) fl2 in
+ assert(List.length fl1 = List.length fl1);
List.fold_left2 unify_do_acc Equal fl1 fl2
| TypeVar AnyNum, TypeVar Any
| TypeVar Any, TypeVar AnyNum -> Unif (TypeVar AnyNum)
@@ -140,22 +141,23 @@ let try_assoc curmatches tvar t =
let is_matched (expect_l: Lic.type_ list) (given_l: Lic.type_ list) : Lic.type_matches =
(** Traite 1 type, accumule dans curmatches *)
- let rec do_type (curmatches:Lic.type_matches) (expect:Lic.type_) (given:Lic.type_) : Lic.type_matches =
- if (given = expect) then curmatches else
+ let rec do_type (curmatches:Lic.type_matches) (expect:Lic.type_) (given:Lic.type_) : Lic.type_matches =
+ if (given = expect) then curmatches else
match (expect, given) with
- | (TypeVar Any, t) -> try_assoc curmatches Any t
- | (TypeVar AnyNum, Int_type_eff) -> try_assoc curmatches AnyNum Int_type_eff
- | (TypeVar AnyNum, Real_type_eff) -> try_assoc curmatches AnyNum Real_type_eff
- | Array_type_eff(teff_ext1,i1), Array_type_eff(teff_ext2,i2) ->
- if i1 <> i2 then raise (Match_failed("\n*** incompatible array sizes"))
- else do_type curmatches teff_ext1 teff_ext2
+ | (TypeVar Any, t) -> try_assoc curmatches Any t
+ | (TypeVar AnyNum, Int_type_eff) -> try_assoc curmatches AnyNum Int_type_eff
+ | (TypeVar AnyNum, Real_type_eff) -> try_assoc curmatches AnyNum Real_type_eff
+ | Array_type_eff(teff_ext1,i1), Array_type_eff(teff_ext2,i2) ->
+ if i1 <> i2 then raise (Match_failed("\n*** incompatible array sizes"))
+ else do_type curmatches teff_ext1 teff_ext2
(* Dans tous les autres cas échoue *)
- | _ -> raise(Match_failed(
- Printf.sprintf "\n*** %s can't be matched by %s"
+ | _ -> raise(Match_failed(
+ Printf.sprintf "\n*** %s can't be matched by %s"
(teff2str expect) (teff2str given)
- ))
- in
- List.fold_left2 do_type [] expect_l given_l
+ ))
+ in
+ assert(List.length expect_l = List.length given_l);
+ List.fold_left2 do_type [] expect_l given_l
(************************************************************************************)
diff --git a/test/lus2lic.log.ref b/test/lus2lic.log.ref
index e804ace1..c6756cba 100644
--- a/test/lus2lic.log.ref
+++ b/test/lus2lic.log.ref
@@ -1,4 +1,4 @@
-Test Run By jahier on Fri Jan 11 17:44:25 2013
+Test Run By jahier on Wed Jan 16 15:28:50 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
@@ -904,11 +904,6 @@ spawn ./lus2lic -ec -o /tmp/iter.ec should_work/iter.lus
PASS: ./lus2lic {-ec -o /tmp/iter.ec should_work/iter.lus}
spawn ec2c -o /tmp/iter.c /tmp/iter.ec
PASS: ec2c {-o /tmp/iter.c /tmp/iter.ec}
-spawn ./lus2lic -o /tmp/piege.lic should_work/piege.lus
-PASS: ./lus2lic {-o /tmp/piege.lic should_work/piege.lus}
-spawn ./lus2lic -ec -o /tmp/piege.ec should_work/piege.lus
-Fatal error: exception Invalid_argument("List.fold_left2")
-FAIL: Generate ec code : ./lus2lic {-ec -o /tmp/piege.ec should_work/piege.lus}
spawn ./lus2lic -o /tmp/call05.lic should_work/call05.lus
PASS: ./lus2lic {-o /tmp/call05.lic should_work/call05.lus}
spawn ./lus2lic -ec -o /tmp/call05.ec should_work/call05.lus
@@ -949,8 +944,9 @@ PASS: ec2c {-o /tmp/test_node_expand2.c /tmp/test_node_expand2.ec}
spawn ./lus2lic -o /tmp/test.lic should_work/test.lus
PASS: ./lus2lic {-o /tmp/test.lic should_work/test.lus}
spawn ./lus2lic -ec -o /tmp/test.ec should_work/test.lus
-Fatal error: exception Invalid_argument("List.fold_left2")
-FAIL: Generate ec code : ./lus2lic {-ec -o /tmp/test.ec should_work/test.lus}
+PASS: ./lus2lic {-ec -o /tmp/test.ec should_work/test.lus}
+spawn ec2c -o /tmp/test.c /tmp/test.ec
+PASS: ec2c {-o /tmp/test.c /tmp/test.ec}
spawn ./lus2lic -o /tmp/FALLING_EDGE.lic should_work/FALLING_EDGE.lus
PASS: ./lus2lic {-o /tmp/FALLING_EDGE.lic should_work/FALLING_EDGE.lus}
spawn ./lus2lic -ec -o /tmp/FALLING_EDGE.ec should_work/FALLING_EDGE.lus
@@ -15073,8 +15069,9 @@ FAIL: Generate ec code : ./lus2lic {-ec -o /tmp/matrice.ec should_work/matrice.
spawn ./lus2lic -o /tmp/TIME_STABLE.lic should_work/TIME_STABLE.lus
PASS: ./lus2lic {-o /tmp/TIME_STABLE.lic should_work/TIME_STABLE.lus}
spawn ./lus2lic -ec -o /tmp/TIME_STABLE.ec should_work/TIME_STABLE.lus
-Fatal error: exception Invalid_argument("List.fold_left2")
-FAIL: Generate ec code : ./lus2lic {-ec -o /tmp/TIME_STABLE.ec should_work/TIME_STABLE.lus}
+PASS: ./lus2lic {-ec -o /tmp/TIME_STABLE.ec should_work/TIME_STABLE.lus}
+spawn ec2c -o /tmp/TIME_STABLE.c /tmp/TIME_STABLE.ec
+PASS: ec2c {-o /tmp/TIME_STABLE.c /tmp/TIME_STABLE.ec}
spawn ./lus2lic -o /tmp/cpt.lic should_work/cpt.lus
PASS: ./lus2lic {-o /tmp/cpt.lic should_work/cpt.lus}
spawn ./lus2lic -ec -o /tmp/cpt.ec should_work/cpt.lus
@@ -21317,7 +21314,7 @@ spawn ./lus2lic -o /tmp/m.lic should_fail/semantics/m.lus
*** syntax error
XFAIL: Test bad programs (semantics): lus2lic {-o /tmp/m.lic should_fail/semantics/m.lus}
-testcase ./lus2lic.tests/non-reg.exp completed in 137 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 192 seconds
Running ./lus2lic.tests/progression.exp ...
spawn ./lus2lic -o /tmp/when_enum.out should_work/broken/when_enum.lus
*** Error in file "/home/jahier/lus2lic/test/should_work/broken/when_enum.lus", line 10, col 12 to 15, token 'toto':
@@ -21978,13 +21975,13 @@ spawn ./lus2lic -o /tmp/activation1.lic should_fail/semantics/broken/activation1
XPASS: Test bad programs (semantics): lus2lic {-o /tmp/activation1.lic should_fail/semantics/broken/activation1.lus}
spawn ./lus2lic -o /tmp/bug.lic should_fail/semantics/broken/bug.lus
XPASS: Test bad programs (semantics): lus2lic {-o /tmp/bug.lic should_fail/semantics/broken/bug.lus}
-testcase ./lus2lic.tests/progression.exp completed in 13 seconds
+testcase ./lus2lic.tests/progression.exp completed in 15 seconds
=== lus2lic Summary ===
-# of expected passes 637
-# of unexpected failures 108
+# of expected passes 640
+# of unexpected failures 105
# of unexpected successes 8
# of expected failures 26
# of unresolved testcases 6
-runtest completed at Fri Jan 11 17:46:56 2013
+runtest completed at Wed Jan 16 15:32:17 2013
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index a4fe3483..a6871525 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Mon Jan 14 17:52:44 2013
+Test Run By jahier on Wed Jan 16 16:09:48 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
@@ -119,8 +119,6 @@ PASS: ec2c {-o /tmp/predef03.c /tmp/predef03.ec}
PASS: ./lus2lic {-o /tmp/iter.lic should_work/iter.lus}
PASS: ./lus2lic {-ec -o /tmp/iter.ec should_work/iter.lus}
PASS: ec2c {-o /tmp/iter.c /tmp/iter.ec}
-PASS: ./lus2lic {-o /tmp/piege.lic should_work/piege.lus}
-FAIL: Generate ec code : ./lus2lic {-ec -o /tmp/piege.ec should_work/piege.lus}
PASS: ./lus2lic {-o /tmp/call05.lic should_work/call05.lus}
PASS: ./lus2lic {-ec -o /tmp/call05.ec should_work/call05.lus}
PASS: ec2c {-o /tmp/call05.c /tmp/call05.ec}
@@ -140,7 +138,8 @@ PASS: ./lus2lic {-o /tmp/test_node_expand2.lic should_work/test_node_expand2.lus
PASS: ./lus2lic {-ec -o /tmp/test_node_expand2.ec should_work/test_node_expand2.lus}
PASS: ec2c {-o /tmp/test_node_expand2.c /tmp/test_node_expand2.ec}
PASS: ./lus2lic {-o /tmp/test.lic should_work/test.lus}
-FAIL: Generate ec code : ./lus2lic {-ec -o /tmp/test.ec should_work/test.lus}
+PASS: ./lus2lic {-ec -o /tmp/test.ec should_work/test.lus}
+PASS: ec2c {-o /tmp/test.c /tmp/test.ec}
PASS: ./lus2lic {-o /tmp/FALLING_EDGE.lic should_work/FALLING_EDGE.lus}
PASS: ./lus2lic {-ec -o /tmp/FALLING_EDGE.ec should_work/FALLING_EDGE.lus}
PASS: ec2c {-o /tmp/FALLING_EDGE.c /tmp/FALLING_EDGE.ec}
@@ -380,7 +379,8 @@ PASS: ec2c {-o /tmp/o2l_feux_compl.c /tmp/o2l_feux_compl.ec}
PASS: ./lus2lic {-o /tmp/matrice.lic should_work/matrice.lus}
FAIL: Generate ec code : ./lus2lic {-ec -o /tmp/matrice.ec should_work/matrice.lus}
PASS: ./lus2lic {-o /tmp/TIME_STABLE.lic should_work/TIME_STABLE.lus}
-FAIL: Generate ec code : ./lus2lic {-ec -o /tmp/TIME_STABLE.ec should_work/TIME_STABLE.lus}
+PASS: ./lus2lic {-ec -o /tmp/TIME_STABLE.ec should_work/TIME_STABLE.lus}
+PASS: ec2c {-o /tmp/TIME_STABLE.c /tmp/TIME_STABLE.ec}
PASS: ./lus2lic {-o /tmp/cpt.lic should_work/cpt.lus}
PASS: ./lus2lic {-ec -o /tmp/cpt.ec should_work/cpt.lus}
PASS: ec2c {-o /tmp/cpt.c /tmp/cpt.ec}
@@ -797,8 +797,8 @@ XPASS: Test bad programs (semantics): lus2lic {-o /tmp/bug.lic should_fail/seman
=== lus2lic Summary ===
-# of expected passes 637
-# of unexpected failures 108
+# of expected passes 640
+# of unexpected failures 105
# of unexpected successes 8
# of expected failures 26
# of unresolved testcases 6
diff --git a/test/lus2lic.time b/test/lus2lic.time
index c2267cd1..e5790f4c 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 148 seconds
-testcase ./lus2lic.tests/progression.exp completed in 14 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 143 seconds
+testcase ./lus2lic.tests/progression.exp completed in 13 seconds
diff --git a/test/should_work/piege.lus b/test/should_work/piege.lus
deleted file mode 100644
index 3c0033cf..00000000
--- a/test/should_work/piege.lus
+++ /dev/null
@@ -1,18 +0,0 @@
-
--- out depend on out: should be rejected!
-node piege(in : bool) returns (out : bool);
-let
- out = in and aux1(aux2(out,out));
-tel
-
-node aux1(in1, in2 : bool) returns (out : bool);
-let
- out = in1 or (true -> pre(in2));
-tel
-
-node aux2(in1, in2 : bool) returns (out1, out2 : bool);
-let
- out1 = true -> pre(in1);
- out2 = in2;
-tel
-
diff --git a/test/should_work/test.lus b/test/should_work/test.lus
index 764cf6d5..0135534a 100644
--- a/test/should_work/test.lus
+++ b/test/should_work/test.lus
@@ -1,4 +1,5 @@
+-- This is a bit weird but it is valid Lustre...
node test(b1, b2 : bool) returns (b3, b4, b5, b6 : bool);
let
b3, b4, b5, b6 = (three_outputs(two_outputs(b1,b2),true), false);
diff --git a/todo.org b/todo.org
index 108ec857..ace8d790 100644
--- a/todo.org
+++ b/todo.org
@@ -56,10 +56,17 @@ car c'est plus facile dans git pour retrouver ses petits
** TODO y'a un List.fold_left2 qui plante
- State "TODO" from "" [2013-01-11 Fri 10:08]
-Fatal error: exception Invalid_argument("List.fold_left2")
-FAIL: Generate ec code : lus2lic {-ec -o /tmp/piege.ec should_work/piege.lus}
-file:should_work/piege.lus
-file:should_work/test.lus
+
+oops: lus2lic internal error
+File "objlinux/l2lExpandNodes.ml", line 131, column 4
+when compiling lustre program should_work/test.lus
+file:test/should_work/test.lus
+file:~/lus2lic/src/l2lExpandNodes.ml::131
+
+Le problement existant avant (280) en fait...
+Ce programme a-t'il deja marché (en -ec) ?
+
+
** TODO pb dans la verif de définition unique de variable
- State "TODO" from "" [2013-01-11 Fri 09:49]
--
GitLab