From eee02be9de63d1a41ba8518c17b73b4ef13f81aa Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 22 May 2019 17:18:50 +0200
Subject: [PATCH] Fix: enum constants now works in -exec mode (fixes #7)
---
lv6-ref-man/lv6-ref-man.pdf | Bin 323624 -> 323624 bytes
src/lic.ml | 4 +-
src/lic2soc.ml | 241 ++++++++++++++++++++----------------
src/licPrg.mli | 2 +-
src/lv6Id.ml | 22 ++--
test/lus2lic.sum | 24 ++--
6 files changed, 157 insertions(+), 136 deletions(-)
diff --git a/lv6-ref-man/lv6-ref-man.pdf b/lv6-ref-man/lv6-ref-man.pdf
index 51edf4cb499a4a029cbdd2435cb95ed68c1a0bef..a17ddd7ac69e75aa91712d9fad3bd035caa58282 100644
GIT binary patch
delta 139
zcmZ4SKzPLi;f5B*7N!>FEi4L`G!4xSO-wDc4UE(c4AeEb^nLSFToOxC6*OF|j0_Ad
z4NQ%UAWF7-USj#d@9gGmVr*&dW?^Vy=;Z9?Vr=AMX69&QXlP+-WNPVVVqm9WLrBT?
JmPag0cma>-B?15d
delta 139
zcmZ4SKzPLi;f5B*7N!>FEi4L`Gz~0G42+Gn4UE(c4AeEb^nLSFToOxC6*OF|j0_Ad
z4NQ%UAWF7-USj#d?`&w|W@PGYX6|TU>S|zQZfIy}X=-BNWNu_)YGmf<=4Pj0LrBT?
JmPag0cmZ{PB%A;M
diff --git a/src/lic.ml b/src/lic.ml
index 228e9f1a..6650c97f 100644
--- a/src/lic.ml
+++ b/src/lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 25/03/2018 (at 22:07) by Erwan Jahier> *)
+(* Time-stamp: <modified the 22/05/2019 (at 16:44) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. By
compiled we mean that constant are propagated, packages are
@@ -227,7 +227,7 @@ and const =
true.
*)
| Enum_const_eff of (Lv6Id.long * type_)
- (* type_ structure : liste (champ,valeur) + type_ structure *)
+ (* type_ tructure : liste (champ,valeur) + type_ structure *)
| Struct_const_eff of ((Lv6Id.t * const) list * type_)
(* type_ tableau : liste des valeurs + type_ des elts + taille
Is it really a good idea to live both with
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index bbba7cd1..aa4f5118 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 21/03/2018 (at 17:22) by Erwan Jahier> *)
+(** Time-stamp: <modified the 22/05/2019 (at 17:14) by Erwan Jahier> *)
(* XXX ce module est mal écrit. A reprendre. (R1) *)
@@ -135,24 +135,26 @@ let rec get_leaf: (LicPrg.t -> Lic.val_exp -> Soc.var_expr list option) =
let v = val_exp.Lic.ve_core in
let type_ = val_exp.Lic.ve_typ in
match v with
- | Lic.CallByNameLic(by_name_op_flg,fl) -> None
- | Lic.Merge(c_flg, cl) -> None
- | Lic.CallByPosLic (by_pos_op_flg, val_exp_list) -> (
+ | Lic.CallByNameLic(by_name_op_flg,fl) -> None
+ | Lic.Merge(c_flg, cl) -> None
+ | Lic.CallByPosLic (by_pos_op_flg, val_exp_list) -> (
match by_pos_op_flg.it with
- | Lic.VAR_REF name ->
- let type_ = (List.hd type_) in
- let translation =
- match is_predefined_const name with
- | Some type_ -> Soc.Const(name, lic_to_data_type type_)
- | None -> Soc.Var(rename_user_var name, lic_to_data_type type_)
- in
- Some [translation]
- | Lic.CONST_REF l -> (
- let type_ = lic_to_data_type (List.hd type_) in
- Some [Soc.Const(Lv6Id.string_of_long false l, type_)]
+ | Lic.VAR_REF name ->
+ let type_ = (List.hd type_) in
+ let translation =
+ match is_predefined_const name with
+ | Some type_ -> Soc.Const(name, lic_to_data_type type_)
+ | None -> Soc.Var(rename_user_var name, lic_to_data_type type_)
+ in
+ Some [translation]
+ | Lic.CONST_REF l -> (
+ (match LicPrg.find_const licprg l with
+ | Some c -> Some(lic2soc_const c)
+ | None -> assert false
+ )
)
- | Lic.CONST c -> Some(lic2soc_const c)
- | Lic.STRUCT_ACCESS(field) -> (
+ | Lic.CONST c -> Some(lic2soc_const c)
+ | Lic.STRUCT_ACCESS(field) -> (
let expr = match val_exp_list with [e] -> e | _ -> assert false in
let type_ = lic_to_data_type (List.hd type_) in
let filter_expr = match get_leaf licprg expr with
@@ -162,7 +164,7 @@ let rec get_leaf: (LicPrg.t -> Lic.val_exp -> Soc.var_expr list option) =
in
Some [Soc.Field(filter_expr, field, type_)]
)
- | Lic.ARRAY_ACCES i -> (
+ | Lic.ARRAY_ACCES i -> (
let expr = match val_exp_list with [e] -> e | _ -> assert false in
let type_ = lic_to_data_type (List.hd type_) in
let filter_expr = match get_leaf licprg expr with
@@ -170,48 +172,48 @@ let rec get_leaf: (LicPrg.t -> Lic.val_exp -> Soc.var_expr list option) =
| None -> assert false
(* should not happen, since the expression should be a leaf *)
| _ -> assert false
- (* We should get only ONE filter, otherwise it doesn't make any sense *)
+ (* We should get only ONE filter, otherwise it doesn't make any sense *)
in
Some [Soc.Index(filter_expr, i, type_)]
)
- | Lic.TUPLE -> (
+ | Lic.TUPLE -> (
let var_values = List.map (get_leaf licprg) val_exp_list in
let del_some = function | None -> assert false | Some x -> x in
Some (List.flatten (List.map del_some var_values))
)
- | Lic.ARRAY_SLICE si -> (
+ | Lic.ARRAY_SLICE si -> (
(* XXX is it a good idea to explode slices?
- let id, t, i = match val_exp_list with
- | [{Lic.ve_core=Lic.CallByPosLic({it=Lic.VAR_REF id},[]);
+ let id, t, i = match val_exp_list with
+ | [{Lic.ve_core=Lic.CallByPosLic({it=Lic.VAR_REF id},[]);
Lic.ve_typ=[Array_type_eff(t,i)]
}] -> id, t, i
- | _ -> assert false
- in
- let t_soc = lic_to_data_type t in
- let type_elt_ref,type_ref = t_soc, Data.Array(t_soc,i) in
- let index_list = slice_info_to_index_list si in
- let exploded_array =
- (* val_exp is a var ident (t) of type array; we want to gen the list
+ | _ -> assert false
+ in
+ let t_soc = lic_to_data_type t in
+ let type_elt_ref,type_ref = t_soc, Data.Array(t_soc,i) in
+ let index_list = slice_info_to_index_list si in
+ let exploded_array =
+ (* val_exp is a var ident (t) of type array; we want to gen the list
t[i1], ...,t[in], where the index are specified by the slice *)
- List.map
+ List.map
(fun i -> Soc.Index(Soc.Const(id, type_ref), i, type_elt_ref))
index_list
- in
-*)
+ in
+ *)
None
-(* Some(exploded_array) *)
+ (* Some(exploded_array) *)
)
- | Lic.PREDEF_CALL _
- | Lic.CALL _
- | Lic.PRE
- | Lic.ARRAY
- | Lic.HAT _
- | Lic.ARROW
- | Lic.FBY
- | Lic.CURRENT _
- | Lic.WHEN(_)
- | Lic.CONCAT
- -> None
+ | Lic.PREDEF_CALL _
+ | Lic.CALL _
+ | Lic.PRE
+ | Lic.ARRAY
+ | Lic.HAT _
+ | Lic.ARROW
+ | Lic.FBY
+ | Lic.CURRENT _
+ | Lic.WHEN(_)
+ | Lic.CONCAT
+ -> None
)
(** Traduction d'une partie gauche d'équation en filtre d'accès soc. *)
let rec filter_of_left_part: (LicPrg.t -> Lic.left -> Soc.var_expr list) =
@@ -324,72 +326,91 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr list) =
| CallByNameLic(by_name_op_flg,fl) -> assert false (* SNO if correctly L2lSpitted *)
| Merge(c_flg, cl) -> assert false (* Should Not Occur if correctly L2lSpitted *)
| CallByPosLic (by_pos_op_flg, val_exp_list) -> (
- match by_pos_op_flg.it with
- | WHEN(e) ->
- (* ignore it. A good idea? Such when should only appear for const *)
- List.flatten (List.map (val_exp_to_filter licprg) val_exp_list)
- | TUPLE ->
- List.flatten (List.map (val_exp_to_filter licprg) val_exp_list)
- | VAR_REF name ->
- let type_ = (List.hd type_) in
- let translation =
- match is_predefined_const name with
- | Some type_ -> Soc.Const(name, lic_to_data_type type_)
- | None -> Soc.Var(rename_user_var name, lic_to_data_type type_)
- in
- [translation]
- | CONST_REF l -> (
- let type_ = lic_to_data_type (List.hd type_) in
- [Soc.Const(Lv6Id.string_of_long false l, type_)]
- )
- | CONST (Bool_const_eff true) -> [Soc.Const("true", Data.Bool)]
- | CONST (Bool_const_eff false) -> [Soc.Const("false", Data.Bool)]
- | CONST (Int_const_eff i) -> [Soc.Const(i, Data.Int)]
- | CONST (Real_const_eff str) -> [Soc.Const(str, Data.Real)]
- | CONST Extern_const_eff _ -> assert false
- | CONST Abstract_const_eff _ -> assert false
- | CONST Enum_const_eff _ -> assert false
- | CONST Struct_const_eff _ -> assert false
- | CONST Array_const_eff _ -> assert false
- | CONST Tuple_const_eff _ -> assert false
-
- | STRUCT_ACCESS(field) -> (
- let expr = match val_exp_list with [e] -> e | _ -> assert false in
- let type_ = match type_ with [t] -> lic_to_data_type t | _ -> assert false in
- let filter_expr = match get_leaf licprg expr with
- | Some [f] -> f
- | None -> assert false
- | _ -> assert false
- in
- [Soc.Field(filter_expr, field, type_)]
- )
- | ARRAY_ACCES i -> (
- let expr = match val_exp_list with [e] -> e | _ -> assert false in
- let type_ = lic_to_data_type (List.hd type_) in
- let filter_expr = match get_leaf licprg expr with
- | Some [f] -> f
- | None -> assert false
- | _ -> assert false
- in
- [Soc.Index(filter_expr, i, type_)]
+ match by_pos_op_flg.it with
+ | WHEN(e) ->
+ (* ignore it. A good idea? Such when should only appear for const *)
+ List.flatten (List.map (val_exp_to_filter licprg) val_exp_list)
+ | TUPLE ->
+ List.flatten (List.map (val_exp_to_filter licprg) val_exp_list)
+ | VAR_REF name ->
+ let type_ = (List.hd type_) in
+ let translation =
+ match is_predefined_const name with
+ | Some type_ -> Soc.Const(name, lic_to_data_type type_)
+ | None -> Soc.Var(rename_user_var name, lic_to_data_type type_)
+ in
+ [translation]
+ | CONST_REF l -> (
+ (match LicPrg.find_const licprg l with
+ | Some c ->
+ let by_pos_op_flg = { by_pos_op_flg with it = CONST c } in
+ val_exp_to_filter licprg
+ ({ val_exp with Lic.ve_core = CallByPosLic (by_pos_op_flg, [])} )
+ | None -> assert false
+ )
+ )
+ | CONST c -> const_to_filter c
+
+ | STRUCT_ACCESS(field) -> (
+ let expr = match val_exp_list with [e] -> e | _ -> assert false in
+ let type_ = match type_ with [t] -> lic_to_data_type t | _ -> assert false in
+ let filter_expr = match get_leaf licprg expr with
+ | Some [f] -> f
+ | None -> assert false
+ | _ -> assert false
+ in
+ [Soc.Field(filter_expr, field, type_)]
+ )
+ | ARRAY_ACCES i -> (
+ let expr = match val_exp_list with [e] -> e | _ -> assert false in
+ let type_ = lic_to_data_type (List.hd type_) in
+ let filter_expr = match get_leaf licprg expr with
+ | Some [f] -> f
+ | None -> assert false
+ | _ -> assert false
+ in
+ [Soc.Index(filter_expr, i, type_)]
+ )
+ | PREDEF_CALL _
+ | CALL _
+ | PRE
+ | ARROW
+ | FBY
+ | CURRENT _
+ | CONCAT
+ | HAT _
+ | ARRAY
+ | ARRAY_SLICE _ ->
+ let lxm = by_pos_op_flg.src in
+ let msg = (Lxm.details lxm) ^
+ ": only one operator per equation is allowed ("^
+ (LicDump.string_of_val_exp_eff false val_exp)^").\n"
+ in
+ raise (Lv6errors.Global_error msg)
)
- | PREDEF_CALL _
- | CALL _
- | PRE
- | ARROW
- | FBY
- | CURRENT _
- | CONCAT
- | HAT _
- | ARRAY
- | ARRAY_SLICE _ ->
- let lxm = by_pos_op_flg.src in
- let msg = (Lxm.details lxm) ^
- ": only one operator per equation is allowed ("^
- (LicDump.string_of_val_exp_eff false val_exp)^").\n"
- in
- raise (Lv6errors.Global_error msg)
- )
+and (const_to_filter : Lic.const -> Soc.var_expr list) =
+ function
+ | (Bool_const_eff true) -> [Soc.Const("true", Data.Bool)]
+ | (Bool_const_eff false) -> [Soc.Const("false", Data.Bool)]
+ | (Int_const_eff i) -> [Soc.Const(i, Data.Int)]
+ | (Real_const_eff str) -> [Soc.Const(str, Data.Real)]
+ | (Enum_const_eff (str, type_)) ->
+ [Soc.Const(Lv6Id.string_of_long false str, lic_to_data_type type_)]
+ | (Array_const_eff (cl, type_)) ->
+ let vell =
+ List.map (fun c ->
+ let vel = const_to_filter c in
+ vel
+ )
+ cl
+ in
+ List.flatten vell
+ | Extern_const_eff (str,type_) ->
+ [Soc.Const(Lv6Id.string_of_long false str, lic_to_data_type type_)]
+
+ | Abstract_const_eff _ -> assert false
+ | Struct_const_eff _ -> assert false
+ | Tuple_const_eff _ -> assert false
(*********************************************************************************)
diff --git a/src/licPrg.mli b/src/licPrg.mli
index 99d5760a..d7b8529c 100644
--- a/src/licPrg.mli
+++ b/src/licPrg.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/03/2015 (at 10:42) by Erwan Jahier> *)
+(* Time-stamp: <modified the 22/05/2019 (at 16:39) by Erwan Jahier> *)
(** The data structure resulting from the compilation process *)
diff --git a/src/lv6Id.ml b/src/lv6Id.ml
index 770907f6..3edcc8af 100644
--- a/src/lv6Id.ml
+++ b/src/lv6Id.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/07/2017 (at 15:59) by Erwan Jahier> *)
+(* Time-stamp: <modified the 22/05/2019 (at 15:44) by Erwan Jahier> *)
(* J'ai appele ca symbol (mais ca remplace le ident) :
c'est juste une couche qui garantit l'unicite en memoire
@@ -65,20 +65,20 @@ let (pack_name_to_string : pack_name -> string) =
let (string_of_long: bool -> long -> string) =
fun forprint (pn, id) ->
- if forprint then
- let sep =
- if Lv6MainArgs.global_opt.Lv6MainArgs.ec || Lv6MainArgs.global_opt.Lv6MainArgs.lv4
- then "__" else "::"
- in
- match pn,id with
+ if forprint then
+ let sep =
+ if Lv6MainArgs.global_opt.Lv6MainArgs.ec || Lv6MainArgs.global_opt.Lv6MainArgs.lv4
+ then "__" else "::"
+ in
+ match pn,id with
| "",id -> id
| "Lustre","true" -> "true"
| "Lustre","false" -> "false"
| _,_ ->
- (* if Lv6MainArgs.global_opt.Lv6MainArgs.no_prefix then id else *)
- Printf.sprintf "%s%s%s" pn sep id
- else if pn = "" then id else
- Printf.sprintf "%s::%s" pn id
+ (* if Lv6MainArgs.global_opt.Lv6MainArgs.no_prefix then id else *)
+ Printf.sprintf "%s%s%s" pn sep id
+ else if pn = "" then id else
+ Printf.sprintf "%s::%s" pn id
let (no_pack_string_of_long : long -> string) =
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 9fa6e06e..8c72fc49 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,5 +1,5 @@
==> lus2lic0.sum <==
-Test run by jahier on Fri May 17 10:42:29
+Test run by jahier on Wed May 22 17:16:22
Native configuration is x86_64-pc-linux-gnu
=== lus2lic0 tests ===
@@ -66,7 +66,7 @@ XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/lecte
XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/s.lus
==> lus2lic1.sum <==
-Test run by jahier on Fri May 17 10:42:30
+Test run by jahier on Wed May 22 17:16:22
Native configuration is x86_64-pc-linux-gnu
=== lus2lic1 tests ===
@@ -409,7 +409,7 @@ PASS: sh multipar.sh
PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c multipar.lus {}
==> lus2lic2.sum <==
-Test run by jahier on Fri May 17 10:42:52
+Test run by jahier on Wed May 22 17:16:45
Native configuration is x86_64-pc-linux-gnu
=== lus2lic2 tests ===
@@ -749,7 +749,7 @@ PASS: sh zzz2.sh
PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c zzz2.lus {}
==> lus2lic3.sum <==
-Test run by jahier on Fri May 17 10:43:19
+Test run by jahier on Wed May 22 17:17:11
Native configuration is x86_64-pc-linux-gnu
=== lus2lic3 tests ===
@@ -1259,7 +1259,7 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node multipar.lus {}
==> lus2lic4.sum <==
-Test run by jahier on Fri May 17 10:43:58
+Test run by jahier on Wed May 22 17:17:50
Native configuration is x86_64-pc-linux-gnu
=== lus2lic4 tests ===
@@ -1777,13 +1777,13 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node zzz2.lus {}
===============================
# Total number of failures: 15
lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 0 seconds
-lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 22 seconds
-lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 27 seconds
+lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 23 seconds
+lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 26 seconds
lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 39 seconds
-lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 15 seconds
+lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 13 seconds
* Ref time:
-53.58user 18.93system 1:43.77elapsed 69%CPU (0avgtext+0avgdata 276760maxresident)k
-32inputs+143296outputs (0major+11000415minor)pagefaults 0swaps
+51.94user 18.17system 1:41.67elapsed 68%CPU (0avgtext+0avgdata 273712maxresident)k
+0inputs+143240outputs (0major+11004706minor)pagefaults 0swaps
* Quick time (-j 4):
-60.95user 19.78system 1:06.88elapsed 120%CPU (0avgtext+0avgdata 276748maxresident)k
-2128inputs+141352outputs (0major+10869510minor)pagefaults 0swaps
+58.56user 19.69system 1:07.46elapsed 116%CPU (0avgtext+0avgdata 273796maxresident)k
+0inputs+142736outputs (0major+10967172minor)pagefaults 0swaps
--
GitLab