From 8f4b99d70c8fada96fe1d385bb02fdb54989f5fc Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Tue, 2 Sep 2008 11:13:52 +0200
Subject: [PATCH] Support full expressions after a when.
---
src/TODO | 6 ----
src/eff.ml | 5 ++-
src/evalClock.ml | 11 +++---
src/evalType.ml | 15 ++++++--
src/getEff.ml | 37 ++++----------------
src/licDump.ml | 7 ++--
src/split.ml | 9 ++++-
src/test/should_work/clock/when_enum.lus | 2 +-
src/test/test.res.exp | 44 +++++++++++++++++++-----
9 files changed, 75 insertions(+), 61 deletions(-)
diff --git a/src/TODO b/src/TODO
index 8e2efa75..1359158a 100644
--- a/src/TODO
+++ b/src/TODO
@@ -175,12 +175,6 @@ mais est-ce souhaitable ?)
*** moins facile
----------------
-* toutes les equations suivantes levent une erreur (differente) !
- (a, b, c) = current(titi(x) when clk);
- (a, b, c) = current(titi(x when clk));
- (a, b, c) = current(titi(x) when true);
- (a, b, c) = current(titi(x when true));
-
* le merge
diff --git a/src/eff.ml b/src/eff.ml
index 20b7ad41..65caaea3 100644
--- a/src/eff.ml
+++ b/src/eff.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 28/08/2008 (at 17:19) by Erwan Jahier> *)
+(** Time-stamp: <modified the 02/09/2008 (at 11:12) by Erwan Jahier> *)
(**
@@ -183,8 +183,7 @@ and by_pos_op =
| FBY
| CURRENT
- | WHEN of var_info
- | WHENOT of var_info
+ | WHEN of val_exp
| TUPLE
| WITH of val_exp
diff --git a/src/evalClock.ml b/src/evalClock.ml
index a1091499..25c6abd0 100644
--- a/src/evalClock.ml
+++ b/src/evalClock.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 01/09/2008 (at 11:48) by jahier> *)
+(** Time-stamp: <modified the 02/09/2008 (at 11:13) by Erwan Jahier> *)
open Predef
@@ -272,9 +272,12 @@ and (eval_by_pos_clock : Eff.id_solver -> Eff.by_pos_op -> Lxm.t -> Eff.val_exp
| [On(_,clk)] -> [clk],s
| _ -> assert false
)
- | Eff.WHENOT clk_var -> assert false (* use merge when it is implemented *)
- | Eff.WHEN clk_var -> (
- let clk = var_info_eff_to_clock_eff clk_var in
+ | Eff.WHEN clk_expr -> (
+ let clk_list,s = f_aux id_solver s clk_expr in
+ let clk = match clk_list with
+ | [clk] -> clk
+ | _ -> raise (Compile_error(lxm, "Bad clock"))
+ in
let aux_when exp_clk s =
match is_a_sub_clock lxm s exp_clk clk with
| None ->
diff --git a/src/evalType.ml b/src/evalType.ml
index 7c2085e8..01478c13 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 01/09/2008 (at 11:45) by jahier> *)
+(** Time-stamp: <modified the 02/09/2008 (at 10:56) by Erwan Jahier> *)
open Predef
@@ -154,9 +154,18 @@ and (eval_by_pos_type :
[Array_type_eff(List.hd teff_elt, List.length args)]
- | Eff.WHENOT _
- | Eff.WHEN _ -> (
+ | Eff.WHEN clk_exp -> (
+ let type_clk_exp = f id_solver clk_exp in
let type_args_eff = List.map (f id_solver) args in
+ (match type_clk_exp with
+ | [Eff.Bool_type_eff] | [Eff.Enum_type_eff _] -> ()
+ | [teff] ->
+ let msg =
+ "the type of a clock cannot be "^(LicDump.string_of_type_eff teff)
+ in
+ raise(Compile_error(lxm,msg))
+ | _ -> assert false
+ );
match type_args_eff with
| [teff] -> teff
| _ -> raise(EvalType_error("arity error (1 arg expected)"))
diff --git a/src/getEff.ml b/src/getEff.ml
index 063f5a09..0771a43e 100644
--- a/src/getEff.ml
+++ b/src/getEff.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 01/09/2008 (at 12:05) by jahier> *)
+(** Time-stamp: <modified the 02/09/2008 (at 11:12) by Erwan Jahier> *)
open Lxm
@@ -243,7 +243,7 @@ and (translate_val_exp : Eff.id_solver -> SyntaxTreeCore.val_exp -> Eff.val_exp)
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
+ | Eff.WHEN _ -> list_del_last vel_eff
(* the last arg correspond to the clock var, that
has already been attached to the WHEN constructor. *)
| _ -> vel_eff
@@ -377,34 +377,11 @@ and (translate_by_pos_op : Eff.id_solver -> SyntaxTreeCore.by_pos_op srcflagged
| WHEN_n ->
(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
- (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
- (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
- raise (Compile_error(lxm, msg))
+ | _::clk_exp::[] -> Eff.WHEN clk_exp
+ | l -> let msg = "Bad arity: two arguments are expected, whereas " ^
+ (string_of_int (List.length l)) ^ " are provided"
+ in
+ raise (Compile_error(lxm, msg))
)
| ARRAY_ACCES_n ve_index ->
let teff =
diff --git a/src/licDump.ml b/src/licDump.ml
index 01eea13a..25789231 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 01/09/2008 (at 11:46) by jahier> *)
+(** Time-stamp: <modified the 02/09/2008 (at 10:49) by Erwan Jahier> *)
open Printf
open Lxm
@@ -376,10 +376,7 @@ 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 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)
+ | WHEN clk, vel -> (tuple vel) ^ " when " ^ (string_of_val_exp_eff clk)
| 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 1686d87e..847d1c43 100644
--- a/src/split.ml
+++ b/src/split.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 01/09/2008 (at 11:45) by jahier> *)
+(** Time-stamp: <modified the 02/09/2008 (at 11:07) by Erwan Jahier> *)
open Lxm
@@ -159,6 +159,13 @@ and (split_val_exp : bool -> Eff.val_exp -> Eff.val_exp * split_acc) =
let rhs = CallByPosEff(by_pos_op_eff, OperEff []) in
rhs, [ve], (eql, vl)
+ | Eff.WHEN ve ->
+ let ve, (eql, vl) = split_val_exp false ve in
+ let vel,(eql2, vl2) = split_val_exp_list false vel in
+ let by_pos_op_eff = Lxm.flagit (Eff.WHEN(ve)) lxm in
+ let rhs = CallByPosEff(by_pos_op_eff, OperEff vel) in
+ rhs, vel, (eql@eql2, vl@vl2)
+
| _ ->
let vel, (eql, vl) = split_val_exp_list false vel in
let rhs = CallByPosEff(by_pos_op_eff, OperEff vel) in
diff --git a/src/test/should_work/clock/when_enum.lus b/src/test/should_work/clock/when_enum.lus
index af8b57e2..69cfb9fe 100644
--- a/src/test/should_work/clock/when_enum.lus
+++ b/src/test/should_work/clock/when_enum.lus
@@ -5,7 +5,7 @@ type t = enum {A, B, C};
node clock(a : t ; b, c: bool) returns (x: bool when a; y: bool when a);
let
- -- We should accet that!
+ -- We should accept that!
(x, y) = toto(b when tutu(a), c when A(a));
tel
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index 7acba802..a8c5294f 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -9823,18 +9823,38 @@ tel
====> ../lus2lic -vl 2 --compile-all-items should_work/clock/when_enum.lus
Opening file should_work/clock/when_enum.lus
type _when_enum::t = enum {when_enum::A, when_enum::B, when_enum::C};
-*** Error in file "should_work/clock/when_enum.lus", line 9, col 19 to 22, token 'when':
-*** syntax error: clock expr expected
+*** Error in file "should_work/clock/when_enum.lus", line 9, col 40 to 40, token 'A':
+*** unknown node (A)
extern node when_enum::tutu(u:bool) returns (x:bool);
----------------------------------------------------------------------
====> ../lus2lic -vl 2 --compile-all-items should_work/clock/when_node.lus
Opening file should_work/clock/when_node.lus
-*** Error in file "should_work/clock/when_node.lus", line 6, col 19 to 22, token 'when':
-*** syntax error: clock expr expected
-
extern node when_node::tutu(u:bool) returns (x:bool);
+extern node when_node::toto(u:bool; v:bool) returns (x:bool; y:bool);
+
+node when_node::clock(
+ a:bool;
+ b:bool;
+ c:bool)
+returns (
+ x:bool when a;
+ y:bool when a);
+var
+ _v1:bool;
+ _v2:bool when x;
+ _v3:bool;
+ _v4:bool when x;
+let
+ (x, y) = when_node::toto(_v2, _v4);
+ _v1 = when_node::tutu(a);
+ _v2 = b when _v1;
+ _v3 = when_node::tutu(a);
+ _v4 = c when _v3;
+tel
+-- end of node when_node::clock
+
----------------------------------------------------------------------
====> ../lus2lic -vl 2 --compile-all-items should_work/clock/when_not.lus
@@ -9846,9 +9866,17 @@ extern node when_not::clock4(
returns (
clock4_x:bool;
clock4_y:bool when clock4_x);
+node when_not::clock(a:bool; b:bool) returns (c:bool; d:bool when c);
+var
+ _v1:bool;
+ _v2:bool when a;
+let
+ (c, d) = when_not::clock4(a, _v2);
+ _v1 = not a;
+ _v2 = b when _v1;
+tel
+-- end of node when_not::clock
-*** oops: an internal error occurred in file evalClock.ml, line 275, column 31
-*** when compiling lustre program should_work/clock/when_not.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 2 --compile-all-items should_work/clock/when_tuple.lus
@@ -18429,7 +18457,7 @@ 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 22 to 22, token 'a':
+*** Error in file "should_fail/clock/clock2.lus", line 6, col 17 to 20, token 'when':
*** the type of a clock cannot be int
--
GitLab