From b3699ebcdac72bc75ef82fcc80375dd2bde7bfec Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Tue, 20 May 2008 12:06:41 +0200
Subject: [PATCH] Add support for the map array iterator.
---
src/TODO | 5 +
src/main.ml | 4 +-
src/predefSemantics.ml | 28 ++++-
src/test/test.res.exp | 265 +++++++++++++++++++++++++++++++++++++++--
4 files changed, 286 insertions(+), 16 deletions(-)
diff --git a/src/TODO b/src/TODO
index d54ae6d7..6a993f39 100644
--- a/src/TODO
+++ b/src/TODO
@@ -96,6 +96,11 @@ lazycompiler.ml:
*** facile
+* bug dans main.ml: le program principal ne peut pas s'appeller "main" à cause
+du (stupide) test que je fais dans set_infile...
+
+* Verifier que les test de map_red couvre les cas tordus.
+
* BUG dans test/should_work/NONREG/Int.lus
la constante 'Int8::zero' a pour type 'bool^8' au lieu de 'Int8::Int'
diff --git a/src/main.ml b/src/main.ml
index e375e318..19225bc5 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 13/05/2008 (at 09:47) by Erwan Jahier> *)
+(** Time-stamp: <modified the 20/05/2008 (at 12:04) by Erwan Jahier> *)
(** Here follows a description of the different modules used by this lus2lic compiler.
@@ -80,7 +80,7 @@ and arg_list = [
( "-o", Arg.String(function x -> _lus2lic_ARGS.outfile <- x),
" <file name> set the output file name"
);
- ( "-n", Arg.String(function x -> _lus2lic_ARGS.main_node <- x),
+ ( "-n", Arg.String(fun x -> _lus2lic_ARGS.main_node <- x),
" <node> set the main node"
);
( "--compile-all-items", Arg.Unit
diff --git a/src/predefSemantics.ml b/src/predefSemantics.ml
index 26f9fc2f..7c2fc2c9 100644
--- a/src/predefSemantics.ml
+++ b/src/predefSemantics.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 20/05/2008 (at 11:33) by Erwan Jahier> *)
+(** Time-stamp: <modified the 20/05/2008 (at 11:42) by Erwan Jahier> *)
open Predef
@@ -204,6 +204,30 @@ let (map_typer : static_arg_eff list -> typer) =
let str_l = List.map CompiledDataDump.string_of_type_eff lti_power_c in
type_error teff_l (String.concat "*" str_l)
+let (red_typer : static_arg_eff list -> typer) =
+ fun sargs teff_ll ->
+ (* Given
+ - a node N of type tau * tau_1 * ... * tau_n -> tau
+ - a constant c (nb : sargs = [N,c])
+ - a list of type teff_l
+
+ This function:
+ - checks that t_eff = [tau; tau_1^c;...; tau_n^c]
+ - returns the list of types [tau]
+ *)
+ let teff_l = List.flatten teff_ll in
+ let (n,c) = get_node_and_constant sargs in
+ let (lti,lto) = CompiledData.profile_of_node_exp_eff n in
+ let lti_power_c =
+ assert (lti <> []);
+ (List.hd lti)::(type_to_array_type (List.tl lti) c)
+ in
+ if lti_power_c = teff_l then
+ (assert (lto <> []); lto)
+ else
+ let str_l = List.map CompiledDataDump.string_of_type_eff lti_power_c in
+ type_error teff_l (String.concat "*" str_l)
+
let (fill_typer : static_arg_eff list -> typer) =
fun sargs teff_ll ->
(* Given
@@ -292,7 +316,7 @@ let (type_eval: op -> static_arg_eff list -> typer) =
| Map -> map_typer sargs
| Fill -> fill_typer sargs
- | Red -> assert false
+ | Red -> red_typer sargs
| MapRed -> mapred_typer sargs
| BoolRed -> boolred_typer
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index 81b60353..aa0850ab 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -7570,8 +7570,35 @@ let
tel
-- end of node iter__plus
-*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
-*** when compiling lustre program should_work/fab_test/iter.lus
+node iter__garcia(
+ accu_in:int;
+ elt_in:int)
+returns (
+ accu_out:int;
+ elt_out:int);
+let
+ accu_out = (accu_in + 1);
+ elt_out = (elt_in + accu_out);
+tel
+-- end of node iter__garcia
+
+node iter__iter(
+ init:int)
+returns (
+ Tab_out:int^5;
+ Red_plus:int;
+ zorroTab:int^5;
+ zorroAcc:int);
+var
+ T_inter:int^5;
+ bidon:int;
+let
+ (bidon, T_inter) = fill<<node iter__filled, const 5>>(init);
+ Tab_out = map<<node iter__mapped, const 5>>(T_inter);
+ Red_plus = red(-(100), Tab_out);
+ (zorroAcc, zorroTab) = map_red(0, [0, 0, 0, 0, 0]);
+tel
+-- end of node iter__iter
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/fab_test/iterate.lus
@@ -7625,8 +7652,59 @@ let
tel
-- end of node iterate__redduced
-*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
-*** when compiling lustre program should_work/fab_test/iterate.lus
+node iterate__filled(
+ accu_in:int)
+returns (
+ accu_out:int;
+ elt_out1:int;
+ elt_out2:int);
+let
+ accu_out = (accu_in + 1);
+ elt_out1 = accu_in;
+ elt_out2 = (accu_in * 2);
+tel
+-- end of node iterate__filled
+
+node iterate__map_redduced(
+ accu_in:int;
+ elt_in1:int;
+ elt_in2:int)
+returns (
+ accu_out:int;
+ elt_out1:int;
+ elt_out2:int;
+ elt_out3:int);
+let
+ accu_out = (accu_in + 1);
+ elt_out1 = elt_in1;
+ elt_out2 = elt_in2;
+ elt_out3 = (elt_in1 + elt_in2);
+tel
+-- end of node iterate__map_redduced
+
+node iterate__iterate(
+ IN1:int^10;
+ IN2:int^10)
+returns (
+ OUT:int^10;
+ out_map1:int^10;
+ out_map2:int^10;
+ out_red1:int;
+ out_fill1:int^10;
+ out_fill2:int^10;
+ out_mapred1:int;
+ out_mapred2:int^10;
+ out_mapred3:int^10);
+var
+ bidon:int;
+let
+ (out_map1, out_map2) = map(IN1, IN2);
+ out_red1 = red<<node iterate__redduced, const 10>>(0, IN1, IN2);
+ (bidon, out_fill1, out_fill2) = fill<<node iterate__filled, const 10>>(0);
+ (out_mapred1, out_mapred2, out_mapred3, OUT) = map_red<<node
+ iterate__map_redduced, const 10>>(0, IN1, IN2);
+tel
+-- end of node iterate__iterate
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/fab_test/lecteur.lus
@@ -9555,8 +9633,19 @@ let
tel
-- end of node FillFollowedByRed__filled
-*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
-*** when compiling lustre program should_work/lionel/FillFollowedByRed.lus
+node FillFollowedByRed__FillFollowedByRed(
+ initFill:real)
+returns (
+ ok:bool);
+var
+ TabOutFill:real^10;
+ bidon:real;
+let
+ (bidon, TabOutFill) = fill<<node FillFollowedByRed__filled, const
+ 10>>(initFill);
+ ok = red(true, TabOutFill);
+tel
+-- end of node FillFollowedByRed__FillFollowedByRed
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/Gyroscope.lus
@@ -9675,8 +9764,36 @@ let
tel
-- end of node shiftFill_ludic__n_selectOneStage
-*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
-*** when compiling lustre program should_work/lionel/ProduitBool/shiftFill_ludic.lus
+node shiftFill_ludic__n_selectElementOfRank_inArray_(
+ i_rankToSelect:int;
+ i_array:bool^10)
+returns (
+ o_elementSelected:bool);
+var
+ v_iterationResult: {currentRank : int; rankToSelect : int; elementSelected : bool};
+let
+ v_iterationResult = red(xxx todo , i_array);
+ o_elementSelected = v_iterationResult.elementSelected;
+tel
+-- end of node shiftFill_ludic__n_selectElementOfRank_inArray_
+
+node shiftFill_ludic__n_shiftFill(
+ i_acc_in: {multiplieur : bool^10;
+ rank : int;
+ actual_rank : int})
+returns (
+ o_acc_out: {multiplieur : bool^10;
+ rank : int;
+ actual_rank : int};
+ o_elt_out:bool);
+let
+ o_acc_out = xxx todo ;
+ o_elt_out = if (((i_acc_in.actual_rank >= i_acc_in.rank) and
+ (i_acc_in.actual_rank < (i_acc_in.rank + c_size)))) then
+ (shiftFill_ludic__n_selectElementOfRank_inArray_(i_acc_in.actual_rank,
+ i_acc_in.multiplieur)) else (false);
+tel
+-- end of node shiftFill_ludic__n_shiftFill
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/ProduitBool/shift_ludic.lus
@@ -9746,8 +9863,49 @@ let
tel
-- end of node shift_ludic__n_selectOneStage
-*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
-*** when compiling lustre program should_work/lionel/ProduitBool/shift_ludic.lus
+node shift_ludic__n_selectElementOfRank_inArray_(
+ i_rankToSelect:int;
+ i_array:bool^10)
+returns (
+ o_elementSelected:bool);
+var
+ v_iterationResult: {currentRank : int; rankToSelect : int; elementSelected : bool};
+let
+ v_iterationResult = red(xxx todo , i_array);
+ o_elementSelected = v_iterationResult.elementSelected;
+tel
+-- end of node shift_ludic__n_selectElementOfRank_inArray_
+
+node shift_ludic__n_shiftFill(
+ i_acc_in: {multiplieur : bool^10;
+ rank : int;
+ actual_rank : int})
+returns (
+ o_acc_out: {multiplieur : bool^10;
+ rank : int;
+ actual_rank : int};
+ o_elt_out:bool);
+let
+ o_acc_out = xxx todo ;
+ o_elt_out = if (((i_acc_in.actual_rank >= i_acc_in.rank) and
+ (i_acc_in.actual_rank < (i_acc_in.rank + c_size)))) then
+ (shift_ludic__n_selectElementOfRank_inArray_(i_acc_in.actual_rank,
+ i_acc_in.multiplieur)) else (false);
+tel
+-- end of node shift_ludic__n_shiftFill
+
+node shift_ludic__n_shift(
+ i_acc_in: {multiplieur : bool^10;
+ rank : int})
+returns (
+ o_ligne:bool^20);
+var
+ v_bidon: {multiplieur : bool^10; rank : int; actual_rank : int};
+let
+ (v_bidon, o_ligne) = fill<<node shift_ludic__n_shiftFill, const 20>>(xxx
+ todo );
+tel
+-- end of node shift_ludic__n_shift
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/arrays.lus
@@ -10391,8 +10549,91 @@ let
tel
-- end of node tri__minFromRank
-*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
-*** when compiling lustre program should_work/packEnvTest/contractForElementSelectionInArray/tri.lus
+node tri__select(
+ accu_in: {RankToFind : int;
+ CurrentRank : int;
+ Val : int};
+ elt:int)
+returns (
+ accu_out: {RankToFind : int;
+ CurrentRank : int;
+ Val : int});
+let
+ accu_out = xxx todo ;
+tel
+-- end of node tri__select
+
+node tri__Exchange_i_j(
+ accu_in: {MinVal : int;
+ MinRank : int;
+ RankFrom : int;
+ CurrentVal : int;
+ Rank : int};
+ eltIn:int)
+returns (
+ accu_out: {MinVal : int;
+ MinRank : int;
+ RankFrom : int;
+ CurrentVal : int;
+ Rank : int};
+ eltOut:int);
+let
+ accu_out = xxx todo ;
+ eltOut = if ((accu_in.Rank = accu_in.MinRank)) then (accu_in.CurrentVal)
+ else ( if ((accu_in.Rank = accu_in.RankFrom)) then (accu_in.MinVal) else
+ (eltIn));
+tel
+-- end of node tri__Exchange_i_j
+
+node tri__UnarySort(
+ accu_in: {CurrentRank : int;
+ Tab : int^10};
+ eltIn:int)
+returns (
+ accu_out: {CurrentRank : int;
+ Tab : int^10});
+var
+ accu_out_select: {RankToFind : int; CurrentRank : int; Val : int};
+ accu_out_min: {MinVal : int; MinRank : int; RankFrom : int; Rank : int};
+ accu_out_exchange: {MinVal : int; MinRank : int; RankFrom : int; CurrentVal : int; Rank : int};
+ localTab:int^10;
+let
+ accu_out_min = red(xxx todo , accu_in.Tab);
+ accu_out_select = red(xxx todo , accu_in.Tab);
+ (accu_out_exchange, localTab) = map_red(xxx todo , accu_in.Tab);
+ accu_out = xxx todo ;
+tel
+-- end of node tri__UnarySort
+node tri__main(TIn:int^10) returns (TSorted:int^10);
+var
+ UnarySort_accu_out: {CurrentRank : int; Tab : int^10};
+let
+ UnarySort_accu_out = red(xxx todo , [7, 8, 4, 3, 2, 9, 1, 10, 2, 7]);
+ TSorted = UnarySort_accu_out.Tab;
+tel
+-- end of node tri__main
+
+node tri__sorted_iter(
+ accu_in: {prev_elt : int;
+ prop_is_tt : bool};
+ elt:int)
+returns (
+ accu_out: {prev_elt : int;
+ prop_is_tt : bool});
+let
+ accu_out = xxx todo ;
+tel
+-- end of node tri__sorted_iter
+node tri__Sorted(TIn:int^10) returns (res:bool);
+var
+ accu_out: {prev_elt : int; prop_is_tt : bool};
+ TSorted:int^10;
+let
+ TSorted = tri__main(TIn);
+ accu_out = red(xxx todo , TSorted);
+ res = accu_out.prop_is_tt;
+tel
+-- end of node tri__Sorted
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/packEnvTest/modelInst.lus
--
GitLab