From bf652e18c0640a5eee4cb2f376ecceb0d80575e8 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Tue, 21 May 2013 09:36:26 +0200
Subject: [PATCH] Fix the handling of slices in left-hand-side.
nb : #FAILS=84->81
---
Makefile | 2 +-
src/actionsDeps.ml | 5 +++--
src/data.ml | 30 +++++++++++++++++++++++++++++-
src/data.mli | 2 +-
src/lic.ml | 4 ++--
src/lic2soc.ml | 43 ++++++++++++++++++++++++++-----------------
src/soc.ml | 6 ++++--
src/socExecValue.ml | 35 ++++++++++++++++++++++++-----------
src/socPredef.ml | 7 +++----
src/socUtils.ml | 5 +++--
test/lus2lic.sum | 16 ++++++++--------
test/lus2lic.time | 4 ++--
todo.org | 5 -----
todo.org_archive | 14 ++++++++++++++
14 files changed, 120 insertions(+), 58 deletions(-)
diff --git a/Makefile b/Makefile
index 0aff698f..369f8e61 100644
--- a/Makefile
+++ b/Makefile
@@ -188,7 +188,7 @@ diff:
OTAGS=$(HOME)/bin/otags
tags:
- $(OTAGS) -v $(shell $(OCAMLC) -where)/*.mli $(OBJDIR)/*.ml
+ $(OTAGS) -v $(shell $(OCAMLC) -where)/*.mli src/*.ml
log:
rm -f lv6.log; git log > lv6.log
diff --git a/src/actionsDeps.ml b/src/actionsDeps.ml
index 36995c28..dbbe99b4 100644
--- a/src/actionsDeps.ml
+++ b/src/actionsDeps.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 15/05/2013 (at 11:00) by Erwan Jahier> *)
+(** Time-stamp: <modified the 17/05/2013 (at 17:45) by Erwan Jahier> *)
let dbg = (Verbose.get_flag "deps")
@@ -135,10 +135,11 @@ let rec (get_top_var : Soc.var_expr -> Soc.var_expr) =
fun var ->
(* if var = t.[2].field, then it returns (also) t.[2] and t *)
match var with
+ | Soc.Slice(ve,_,_,_,_,_)
| Soc.Field(ve,_,_)
| Soc.Index(ve,_,_) -> get_top_var ve
| Soc.Var(_,vt)
- | Soc.Const(_,vt) -> var
+ | Soc.Const(_,vt) -> var
diff --git a/src/data.ml b/src/data.ml
index ebc89a78..e589c956 100644
--- a/src/data.ml
+++ b/src/data.ml
@@ -79,14 +79,30 @@ let (type_of_string : string -> t) =
type vntl = (string * string) list
type subst = (string * v)
+type access = Idx of int | Fld of ident | Sle of int * int * int * int
-type access = Idx of int | Fld of ident
+
+let get_array_elt a i =
+ match a with
+ | A a -> a.(i)
+ | _ -> assert false
(* exported *)
let rec (update_val : v -> v -> access list -> v) =
fun pre_v v access ->
match pre_v,access with
| _,[] -> v
+ | A a, (Sle(f,l,s,w))::access -> (
+ let j = ref 0 in
+ for i = f to l do
+ if (i - f) mod s = 0 then
+ let v_j = get_array_elt v !j in
+ let a_i = update_val a.(i) v_j access in
+ a.(i) <- a_i;
+ incr j;
+ done;
+ A a
+ )
| A a, (Idx i)::access ->
let a_i = update_val a.(i) v access in
a.(i) <- a_i;
@@ -103,6 +119,18 @@ let rec (create_val : t -> v -> access list -> v) =
fun vt v access ->
match vt,access with
| _,[] -> v
+ | Array(vt,size), (Sle(f,l,s,w))::access -> (
+ let j = ref 0 in
+ let a = Array.make size U in
+ for i = f to l do
+ if (i - f) mod s = 0 then
+ let v_j = get_array_elt v !j in
+ let a_i = create_val vt v_j access in
+ a.(i) <- a_i;
+ incr j;
+ done;
+ A a
+ )
| Array(vt,size), (Idx i)::access ->
let a = Array.make size U in
let a_i = create_val vt v access in
diff --git a/src/data.mli b/src/data.mli
index d12a6733..b91b8de3 100644
--- a/src/data.mli
+++ b/src/data.mli
@@ -21,7 +21,7 @@ val type_of_string : string -> t
type vntl = (string * string) list
type subst = (string * v)
-type access = Idx of int | Fld of ident
+type access = Idx of int | Fld of ident | Sle of int * int * int * int
(* Replace access(pre_v) by v in pre_v *)
val update_val : v -> v -> access list -> v
diff --git a/src/lic.ml b/src/lic.ml
index 000e5d4a..5b47933d 100644
--- a/src/lic.ml
+++ b/src/lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/04/2013 (at 15:16) by Erwan Jahier> *)
+(* Time-stamp: <modified the 16/05/2013 (at 16:02) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. *)
@@ -134,7 +134,7 @@ and left =
N.B. On garde aussi l'info source des idents au cas ou.*)
| LeftVarLic of (var_info * Lxm.t)
| LeftFieldLic of (left * Ident.t * type_)
- | LeftArrayLic of (left * int * type_)
+ | LeftArrayLic of (left * int * type_) (* XXX should be called LeftArrayIndexLic? *)
| LeftSliceLic of (left * slice_info * type_)
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index 9e33e499..206e0eae 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 16/05/2013 (at 09:15) by Erwan Jahier> *)
+(** Time-stamp: <modified the 17/05/2013 (at 17:46) by Erwan Jahier> *)
open Lxm
open Lic
@@ -81,14 +81,14 @@ let is_predefined_const: string -> Lic.type_ option =
(*********************************************************************************)
(* Returns the list of indexes represented by the slice *)
-let (slice_info_to_index_list : Lic.slice_info -> int list) =
- fun si ->
- let (f,l,s) = (si.Lic.se_first, si.Lic.se_last, si.Lic.se_step) in
- let rec aux f =
- if f>l && s > 0 || f<l && s <0 then [] else
- f::(aux (f+s))
- in
- aux f
+(* let (slice_info_to_index_list : Lic.slice_info -> int list) = *)
+(* fun si -> *)
+(* let (f,l,s) = (si.Lic.se_first, si.Lic.se_last, si.Lic.se_step) in *)
+(* let rec aux f = *)
+(* if f>l && s > 0 || f<l && s <0 then [] else *)
+(* f::(aux (f+s)) *)
+(* in *)
+(* aux f *)
let rec (lic2soc_const : Lic.const -> Soc.var_expr list) =
function
@@ -208,11 +208,9 @@ let rec filter_of_left_part: (LicPrg.t -> Lic.left -> Soc.var_expr list) =
List.map (fun lp -> Soc.Index(lp, index, lic_to_data_type t (* type_ ? *))) lpl
)
| Lic.LeftSliceLic(lp,si,t) -> (
- (* we expand left part slices *)
let lpl = filter_of_left_part licprg lp in
- let index_list = slice_info_to_index_list si in
- List.flatten (List.map (
- fun lp -> List.map (fun index -> Soc.Index(lp, index, lic_to_data_type t)) index_list) lpl)
+ List.map (fun lp -> Soc.Slice(lp, si.se_first, si.se_last, si.se_step,
+ si.se_width, lic_to_data_type t)) lpl
)
(*********************************************************************************)
@@ -432,8 +430,17 @@ let by_pos_op_to_soc_ident = function
| _ -> assert false
-let (get_exp_type : Soc.var_expr list -> Data.t list) =
- List.map Soc.data_type_of_var_expr
+let (get_exp_type : Soc.var_expr list -> Data.t list) =
+ fun vl ->
+ let tl = List.map Soc.data_type_of_var_expr vl in
+ tl
+(* let res = *)
+(* match tl with *)
+(* | [] -> assert false *)
+(* | [t] -> t *)
+(* | t::_ -> Data.Array(t, List.length tl) *)
+(* in *)
+(* res *)
let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
Lic.clock -> Soc.var_expr list -> e2a_acc -> Lic.val_exp -> e2a_acc) =
@@ -502,7 +509,8 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
List.map lic_to_data_type
(List.flatten (List.map (fun ve -> ve.ve_typ) val_exp_list))
in
- let res_type = get_exp_type lpl in
+ let res_type = List.map lic_to_data_type expr.ve_typ in
+(* let res_type = get_exp_type lpl in *)
let full_profile = args_types @ res_type in
let si_opt = match by_pos_op_flg.it with
Lic.ARRAY_SLICE si -> Some si | _ -> None
@@ -534,7 +542,8 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
List.map lic_to_data_type
(List.flatten (List.map (fun (_,ve) -> ve.ve_typ) cl))
in
- let res_type = get_exp_type lpl in
+(* let res_type = List.map lic_to_data_type expr.ve_typ in *)
+ let res_type = get_exp_type lpl in
let full_profile = args_types @ res_type in
let sk = make_soc_key_of_node_exp (("Lustre","merge"),[]) None full_profile in
try Soc.SocMap.find sk soc_tbl
diff --git a/src/soc.ml b/src/soc.ml
index 165648af..32f1ca4f 100644
--- a/src/soc.ml
+++ b/src/soc.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 10/05/2013 (at 16:21) by Erwan Jahier> *)
+(* Time-stamp: <modified the 17/05/2013 (at 17:41) by Erwan Jahier> *)
(** Synchronous Object Component *)
@@ -23,13 +23,15 @@ type var_expr =
| Const of var (* useful? *)
| Field of var_expr * ident * Data.t
| Index of var_expr * int * Data.t
+ | Slice of var_expr * int * int * int * int * Data.t (* first, last, step, width *)
let (data_type_of_var_expr : var_expr -> Data.t) =
function
| Var(_,vt)
| Const(_,vt)
| Field(_, _,vt)
- | Index(_,_,vt) -> vt
+ | Index(_,_,vt)
+ | Slice(_,_,_,_,_,vt) -> vt
type atomic_operation =
| Assign (* Wire *)
diff --git a/src/socExecValue.ml b/src/socExecValue.ml
index e062df08..71095d33 100644
--- a/src/socExecValue.ml
+++ b/src/socExecValue.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 15/05/2013 (at 16:22) by Erwan Jahier> *)
+(* Time-stamp: <modified the 21/05/2013 (at 08:13) by Erwan Jahier> *)
let dbg = (Verbose.get_flag "exec")
@@ -40,7 +40,7 @@ let rec (get_top_var_type : Soc.var_expr -> Data.t) =
match ve with
| Var(_,vt) -> vt
| Index(ve,_,_)
- | Field(ve, _, _) -> get_top_var_type ve
+ | Field(ve, _, _) | Slice(ve,_,_,_,_,_) -> get_top_var_type ve
| Const(id,_) -> assert false
@@ -48,11 +48,11 @@ open Data
let rec (get_access : Soc.var_expr -> Data.access list) =
fun ve ->
match ve with
+ | Const(id,_) -> assert false
| Var(id,_) -> []
| Index(ve,i,_) -> (Idx i)::(get_access ve)
| Field(ve, n,_) -> (Fld n)::(get_access ve)
- | Const(id,_) -> assert false
-
+ | Slice(ve,f,l,s,w,_) -> (Sle (f,l,s,w))::(get_access ve)
let (update_leaf : var_expr -> v -> v -> substs) =
fun ve v pre_v ->
@@ -67,12 +67,10 @@ let (create_leaf : var_expr -> v -> substs) =
let new_v = create_val top_vt v access in
Leaf(new_v)
-
-
let rec (get_top_id : Soc.var_expr -> ident) =
function
| Var(id,_) | Const(id,_) -> id
- | Field(ve, _, _) | Index(ve,_,_) -> get_top_id ve
+ | Field(ve, _, _) | Index(ve,_,_) | Slice(ve,_,_,_,_,_) -> get_top_id ve
(* exported *)
let (sadd_partial : substs -> var_expr -> path -> Data.v -> substs) =
@@ -264,14 +262,29 @@ let rec (get_value : ctx -> var_expr -> Data.v) =
)
| _ -> assert false (* should not occur *)
)
-
- | Index(ve,i,vt) ->
+ | Index(ve,i,vt) -> (
let a = get_value ctx ve in
match a with
| A a -> a.(i)
| U -> U
-(* dump_substs ctx.s;flush stdout; *)
-(* failwith ((SocUtils.string_of_filter ve) ^ " not defined\n") *)
+ (* dump_substs ctx.s;flush stdout; *)
+ (* failwith ((SocUtils.string_of_filter ve) ^ " not defined\n") *)
+ | _ -> assert false (* should not occur *)
+ )
+ | Soc.Slice(ve,f,l,s,w,vt) ->
+ let a = get_value ctx ve in
+ match a with
+ | A a ->
+ let slice = Array.sub a f w in
+ let j = ref 0 in
+ for i = f to l do
+ if (i - f) mod s = 0 then (
+ slice.(!j) <- a.(i);
+ incr j
+ )
+ done;
+ A slice
+ | U -> U
| _ -> assert false (* should not occur *)
diff --git a/src/socPredef.ml b/src/socPredef.ml
index 855c2843..43edb98f 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 15/05/2013 (at 16:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 17/05/2013 (at 17:44) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -517,9 +517,8 @@ let (soc_interface_of_pos_op:
let i = (List.length types) in
(make_array_soc i elt_type)
- | Lic.ARRAY_SLICE sinfo, [Array (t, s)], _ ->
-(* assert false *)
- (make_array_slice_soc sinfo s t)
+ | Lic.ARRAY_SLICE sinfo, [Array (t, s)], _ -> (make_array_slice_soc sinfo s t)
+ | Lic.ARRAY_SLICE sinfo, [], _ -> assert false
| Lic.CONCAT, [Array (t1, s1); Array (t2, s2)], _->
assert (t1=t2);
diff --git a/src/socUtils.ml b/src/socUtils.ml
index c49f0a90..7d62d18d 100644
--- a/src/socUtils.ml
+++ b/src/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 26/04/2013 (at 09:42) by Erwan Jahier> *)
+(** Time-stamp: <modified the 17/05/2013 (at 17:43) by Erwan Jahier> *)
open Soc
@@ -88,7 +88,8 @@ let rec string_of_filter_ff: (Soc.var_expr -> Format.formatter -> unit) =
| Var (id,_) -> fprintf ff "%s" id
| Field(f, id,_) -> string_of_filter_ff f ff; fprintf ff ".%s" id
| Index(f, index,_) -> string_of_filter_ff f ff; fprintf ff "[%d]" index
-
+ | Slice(f,fi,la,st,wi,vt) -> string_of_filter_ff f ff; fprintf ff "[%d..%d step %d]" fi la st
+
let string_of_filter: (Soc.var_expr -> string) = fun v ->
call_fun_ff (string_of_filter_ff v)
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 4719f6d5..728de6c7 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Fri May 17 11:06:34 2013
+Test Run By jahier on Tue May 21 09:29:18 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
@@ -304,7 +304,7 @@ PASS: ../utils/test_lus2lic_no_node should_work/ec.lus
PASS: ./lus2lic {-o /tmp/morel3.lic should_work/morel3.lus}
PASS: ./lus2lic {-ec -o /tmp/morel3.ec should_work/morel3.lus}
PASS: ./ec2c {-o /tmp/morel3.c /tmp/morel3.ec}
-FAIL: Try to compare lus2lic -exec and ecexe: ../utils/test_lus2lic_no_node should_work/morel3.lus
+PASS: ../utils/test_lus2lic_no_node should_work/morel3.lus
PASS: ./lus2lic {-o /tmp/fresh_name.lic should_work/fresh_name.lus}
PASS: ./lus2lic {-ec -o /tmp/fresh_name.ec should_work/fresh_name.lus}
PASS: ./ec2c {-o /tmp/fresh_name.c /tmp/fresh_name.ec}
@@ -539,7 +539,7 @@ FAIL: Try to compare lus2lic -exec and ecexe: ../utils/test_lus2lic_no_node shou
PASS: ./lus2lic {-o /tmp/left.lic should_work/left.lus}
PASS: ./lus2lic {-ec -o /tmp/left.ec should_work/left.lus}
PASS: ./ec2c {-o /tmp/left.c /tmp/left.ec}
-PASS: ../utils/test_lus2lic_no_node should_work/left.lus
+UNRESOLVED: Time out: ../utils/test_lus2lic_no_node should_work/left.lus
PASS: ./lus2lic {-o /tmp/ts04.lic should_work/ts04.lus}
PASS: ./lus2lic {-ec -o /tmp/ts04.ec should_work/ts04.lus}
PASS: ./ec2c {-o /tmp/ts04.c /tmp/ts04.ec}
@@ -557,7 +557,7 @@ PASS: ../utils/test_lus2lic_no_node should_work/nc2.lus
PASS: ./lus2lic {-o /tmp/morel.lic should_work/morel.lus}
PASS: ./lus2lic {-ec -o /tmp/morel.ec should_work/morel.lus}
PASS: ./ec2c {-o /tmp/morel.c /tmp/morel.ec}
-FAIL: Try to compare lus2lic -exec and ecexe: ../utils/test_lus2lic_no_node should_work/morel.lus
+PASS: ../utils/test_lus2lic_no_node should_work/morel.lus
PASS: ./lus2lic {-o /tmp/SOURIS.lic should_work/SOURIS.lus}
PASS: ./lus2lic {-ec -o /tmp/SOURIS.ec should_work/SOURIS.lus}
PASS: ./ec2c {-o /tmp/SOURIS.c /tmp/SOURIS.ec}
@@ -653,7 +653,7 @@ PASS: ../utils/test_lus2lic_no_node should_work/iterFibo.lus
PASS: ./lus2lic {-o /tmp/morel2.lic should_work/morel2.lus}
PASS: ./lus2lic {-ec -o /tmp/morel2.ec should_work/morel2.lus}
PASS: ./ec2c {-o /tmp/morel2.c /tmp/morel2.ec}
-FAIL: Try to compare lus2lic -exec and ecexe: ../utils/test_lus2lic_no_node should_work/morel2.lus
+PASS: ../utils/test_lus2lic_no_node should_work/morel2.lus
PASS: ./lus2lic {-o /tmp/minmax1.lic should_work/minmax1.lus}
PASS: ./lus2lic {-ec -o /tmp/minmax1.ec should_work/minmax1.lus}
PASS: ./ec2c {-o /tmp/minmax1.c /tmp/minmax1.ec}
@@ -1039,8 +1039,8 @@ XPASS: Test bad programs (semantics): lus2lic {-o /tmp/bug.lic should_fail/seman
=== lus2lic Summary ===
-# of expected passes 873
-# of unexpected failures 84
+# of expected passes 875
+# of unexpected failures 81
# of unexpected successes 12
# of expected failures 37
-# of unresolved testcases 21
+# of unresolved testcases 22
diff --git a/test/lus2lic.time b/test/lus2lic.time
index 4774bdaf..f1ae924f 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 333 seconds
-testcase ./lus2lic.tests/progression.exp completed in 0 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 313 seconds
+testcase ./lus2lic.tests/progression.exp completed in 2 seconds
diff --git a/todo.org b/todo.org
index 1ff8abc7..8ddc98f1 100644
--- a/todo.org
+++ b/todo.org
@@ -3,11 +3,6 @@
* lus2lic -exec
-** TODO oops: lus2lic internal error
- - State "TODO" from "" [2013-05-10 Fri 17:46]
- File "objlinux/lic2soc.ml", line 680, column 18
- when compiling lustre program should_work/morel3.lus
-
** TODO oops: lus2lic internal error
- State "TODO" from "" [2013-05-10 Fri 18:05]
File "objlinux/lic2soc.ml", line 680, column 18
diff --git a/todo.org_archive b/todo.org_archive
index b369cf7f..71f5b7cb 100644
--- a/todo.org_archive
+++ b/todo.org_archive
@@ -740,6 +740,20 @@ cf file:src/licTab.ml::68
Bon, finalement, j'oblige les gens a ecrire Lustre::gt et puis ca marre.
+* TODO oops: lus2lic internal error
+ - State "TODO" from "" [2013-05-10 Fri 17:46]
+ :PROPERTIES:
+ :ARCHIVE_TIME: 2013-05-21 Tue 09:31
+ :ARCHIVE_FILE: ~/lus2lic/todo.org
+ :ARCHIVE_OLPATH: lus2lic -exec
+ :ARCHIVE_CATEGORY: lv6
+ :ARCHIVE_TODO: TODO
+ :END:
+ File "objlinux/lic2soc.ml", line 680, column 18
+ when compiling lustre program should_work/morel3.lus
+-> It was due to a bad handling in slices apprearinf at the lhs od equations.
+
+
--
GitLab