From 6c06898200913529233d71621a6ea5f39bdb1c43 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Mon, 1 Sep 2008 12:06:26 +0200
Subject: [PATCH] Split when on tuples.
---
src/evalClock.ml | 7 +++----
src/evalType.ml | 12 +++---------
src/getEff.ml | 36 +++++++++++++++++++++++++++++++-----
src/licDump.ml | 10 +++++-----
src/split.ml | 10 +++++++++-
src/test/test.res.exp | 11 +++++++----
6 files changed, 58 insertions(+), 28 deletions(-)
diff --git a/src/evalClock.ml b/src/evalClock.ml
index e1c5bc10..a1091499 100644
--- a/src/evalClock.ml
+++ b/src/evalClock.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 01/09/2008 (at 11:15) by jahier> *)
+(** Time-stamp: <modified the 01/09/2008 (at 11:48) by jahier> *)
open Predef
@@ -295,10 +295,10 @@ and (eval_by_pos_clock : Eff.id_solver -> Eff.by_pos_op -> Lxm.t -> Eff.val_exp
clk_of_exp_clk, s
in
(match f_list id_solver s args with
- | [[exp_clk];_], s ->
+ | [[exp_clk]], s ->
let (exp_clk,s) = aux_when exp_clk s in
([exp_clk], s)
- | [exp_clk_list;_], s ->
+ | [exp_clk_list], s ->
let exp_clk_list, s =
List.fold_left
(fun (acc,s) exp_clk ->
@@ -309,7 +309,6 @@ and (eval_by_pos_clock : Eff.id_solver -> Eff.by_pos_op -> Lxm.t -> Eff.val_exp
exp_clk_list
in
(List.rev exp_clk_list, s)
-
| _ -> assert false (* "(x1,x2) when node (x,y)" *)
)
)
diff --git a/src/evalType.ml b/src/evalType.ml
index cd5b3fd9..7c2085e8 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/08/2008 (at 09:23) by Erwan Jahier> *)
+(** Time-stamp: <modified the 01/09/2008 (at 11:45) by jahier> *)
open Predef
@@ -158,14 +158,8 @@ and (eval_by_pos_type :
| Eff.WHEN _ -> (
let type_args_eff = List.map (f id_solver) args in
match type_args_eff with
- | [teff; [Bool_type_eff]]
- | [teff; [Enum_type_eff _] ] -> teff
- | [_;teff] ->
- let msg ="the type of a clock cannot be " ^
- (String.concat "," (List.map LicDump.string_of_type_eff teff) )
- in
- raise(EvalType_error(msg))
- | _ -> raise(EvalType_error("arity error (2 args expected)"))
+ | [teff] -> teff
+ | _ -> raise(EvalType_error("arity error (1 arg expected)"))
)
| Eff.ARROW
| Eff.FBY -> (
diff --git a/src/getEff.ml b/src/getEff.ml
index 94e4aa81..063f5a09 100644
--- a/src/getEff.ml
+++ b/src/getEff.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/08/2008 (at 10:40) by Erwan Jahier> *)
+(** Time-stamp: <modified the 01/09/2008 (at 12:05) by jahier> *)
open Lxm
@@ -41,6 +41,10 @@ let rec (clock : Eff.id_solver -> SyntaxTreeCore.var_info -> Eff.clock)=
On(v.var_name, id_v.var_clock_eff)
+let rec list_del_last = function
+ |[] | [_] -> []
+ |x::tail -> x::(list_del_last tail)
+
(******************************************************************************)
(* Checks that the left part has the same type as the right one. *)
and (type_check_equation: Eff.id_solver -> Lxm.t -> Eff.left list ->
@@ -237,6 +241,13 @@ and (translate_val_exp : Eff.id_solver -> SyntaxTreeCore.val_exp -> Eff.val_exp)
| CallByPos(by_pos_op, Oper vel) ->
let vel_eff = List.map (translate_val_exp id_solver) vel in
let by_pos_op_eff = translate_by_pos_op id_solver by_pos_op vel in
+ let vel_eff =
+ match by_pos_op_eff with
+ | Eff.WHEN _ | Eff.WHENOT _ -> list_del_last vel_eff
+ (* the last arg correspond to the clock var, that
+ has already been attached to the WHEN constructor. *)
+ | _ -> vel_eff
+ in
CallByPosEff(flagit by_pos_op_eff by_pos_op.src, OperEff vel_eff)
@@ -368,13 +379,28 @@ and (translate_by_pos_op : Eff.id_solver -> SyntaxTreeCore.by_pos_op srcflagged
(match List.map (translate_val_exp id_solver) args with
| [_;CallByPosEff({it=Eff.IDENT id; src=lxm}, _)] ->
let clk = try (id_solver.id2var id lxm) with _ -> assert false in
- Eff.WHEN clk
-
- | [_;CallByPosEff
+ (match clk.var_type_eff with
+ | Eff.Bool_type_eff
+ | Eff.Enum_type_eff _ -> Eff.WHEN clk
+ | _ ->
+ let msg ="the type of a clock cannot be " ^
+ (LicDump.string_of_type_eff clk.var_type_eff)
+ in
+ raise(Compile_error(lxm,msg))
+ )
+ | [_;CallByPosEff
({it=Predef(NOT_n,[])},
OperEff [CallByPosEff({src = lxm; it = Eff.IDENT id}, _)])] ->
let clk = try (id_solver.id2var id lxm) with _ -> assert false in
- Eff.WHENOT clk
+ (match clk.var_type_eff with
+ | Eff.Bool_type_eff
+ | Eff.Enum_type_eff _ -> Eff.WHENOT clk
+ | _ ->
+ let msg ="the type of a clock cannot be " ^
+ (LicDump.string_of_type_eff clk.var_type_eff)
+ in
+ raise(Compile_error(lxm,msg))
+ )
| _ ->
let msg = "syntax error: clock expr expected" in
diff --git a/src/licDump.ml b/src/licDump.ml
index 0e009edd..01eea13a 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/08/2008 (at 16:47) by Erwan Jahier> *)
+(** Time-stamp: <modified the 01/09/2008 (at 11:46) by jahier> *)
open Printf
open Lxm
@@ -376,10 +376,10 @@ and (string_of_by_pos_op_eff: Eff.by_pos_op srcflagged -> Eff.val_exp list -> st
(string_of_val_exp_eff ve1) ^ " -> " ^ (string_of_val_exp_eff ve2)
| FBY, [ve1; ve2] ->
(string_of_val_exp_eff ve1) ^ " fby " ^ (string_of_val_exp_eff ve2)
- | WHEN _, [ve1; ve2] ->
- (string_of_val_exp_eff ve1) ^ " when " ^ (string_of_val_exp_eff ve2)
- | WHENOT _, [ve1; ve2] ->
- (string_of_val_exp_eff ve1) ^ " when not " ^ (string_of_val_exp_eff ve2)
+ | WHEN clk, vel ->
+ (tuple vel) ^ " when " ^ (Ident.to_string clk.var_name_eff)
+ | WHENOT clk, vel ->
+ (tuple vel) ^ " when not " ^ (Ident.to_string clk.var_name_eff)
| CURRENT,_ -> "current " ^ (tuple vel)
| TUPLE,_ -> (tuple vel)
| WITH(ve),_ -> (string_of_val_exp_eff ve)
diff --git a/src/split.ml b/src/split.ml
index 99677616..1686d87e 100644
--- a/src/split.ml
+++ b/src/split.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/08/2008 (at 17:37) by Erwan Jahier> *)
+(** Time-stamp: <modified the 01/09/2008 (at 11:45) by jahier> *)
open Lxm
@@ -38,10 +38,12 @@ let to_be_broken = function
| CallByPosEff({ it = Eff.PRE }, _) -> true
| CallByPosEff({ it = Eff.CURRENT }, _) -> true
| CallByPosEff({ it = Eff.TUPLE }, _) -> true
+ | CallByPosEff({ it = Eff.WHEN _ }, _) -> true
| CallByPosEff({ it = Eff.Predef(Predef.IF_n, []) }, _) -> true
| _ -> false
+
let (break_it : val_exp -> val_exp list) =
function
| CallByPosEff({it=Eff.Predef(Predef.IF_n,[]);src=lxm}, OperEff [c;ve1;ve2]) ->
@@ -56,6 +58,12 @@ let (break_it : val_exp -> val_exp list) =
vel1
vel2
+ | CallByPosEff({it=WHEN clk; src=lxm}, OperEff vel) ->
+ let vel = List.flatten (List.map get_vel_from_tuple vel) in
+ List.map
+ (fun ve -> CallByPosEff({it=WHEN clk ; src=lxm }, OperEff [ve]))
+ vel
+
| CallByPosEff({it=Eff.TUPLE ; src=lxm }, OperEff vel) ->
let vel = List.flatten (List.map get_vel_from_tuple vel) in
List.map
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index b2608335..7acba802 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -9862,7 +9862,9 @@ returns (
b:int when clk;
c:int when clk);
let
- (a, b, c) = x, x, x when clk;
+ a = x when clk;
+ b = x when clk;
+ c = x when clk;
tel
-- end of node when_tuple::titi
extern node when_tuple::toto(u:bool; v:bool) returns (x:bool; y:bool);
@@ -9879,7 +9881,8 @@ var
_v2:bool when a;
let
(x, y) = when_tuple::toto(_v1, _v2);
- (_v1, _v2) = b, c when a;
+ _v1 = b when a;
+ _v2 = c when a;
tel
-- end of node when_tuple::clock
@@ -18426,8 +18429,8 @@ returns (
----------------------------------------------------------------------
====> ../lus2lic -vl 2 --compile-all-items should_fail/clock/clock2.lus
Opening file should_fail/clock/clock2.lus
-*** Error in file "should_fail/clock/clock2.lus", line 6, col 17 to 20, token 'when':
-*** type error: the type of a clock cannot be int
+*** Error in file "should_fail/clock/clock2.lus", line 6, col 22 to 22, token 'a':
+*** the type of a clock cannot be int
----------------------------------------------------------------------
--
GitLab