From 6263cf9a2edeaf416196f07f95a58028f8587666 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Tue, 20 May 2008 11:34:10 +0200
Subject: [PATCH] Add support for the map array iterator.
---
src/predefSemantics.ml | 45 ++++++++++++++++++++++++++++++++----------
src/test/test.res.exp | 28 ++++++++++++++++++++------
2 files changed, 57 insertions(+), 16 deletions(-)
diff --git a/src/predefSemantics.ml b/src/predefSemantics.ml
index fb3f097e..26f9fc2f 100644
--- a/src/predefSemantics.ml
+++ b/src/predefSemantics.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 20/05/2008 (at 10:20) by Erwan Jahier> *)
+(** Time-stamp: <modified the 20/05/2008 (at 11:33) by Erwan Jahier> *)
open Predef
@@ -168,14 +168,13 @@ let (boolred_typer : typer) =
(*
Given
- - a list of types [tau; teta_1;...; teta_l]
+ - a list of types [teta_1;...; teta_l]
- and a integer c,
- returns the list of types: [tau; teta_1^c;...; teta_l^c]
+ returns the list of types: [teta_1^c;...; teta_l^c]
*)
let (type_to_array_type: type_eff list -> int -> type_eff list) =
- fun l c ->
- assert (l<>[]);
- (List.hd l)::(List.map (fun t -> Array_type_eff(t,c)) (List.tl l))
+ fun l c ->
+ List.map (fun t -> Array_type_eff(t,c)) l
let (get_node_and_constant:static_arg_eff list -> node_exp_eff * int)=
fun sargs ->
@@ -184,6 +183,27 @@ let (get_node_and_constant:static_arg_eff list -> node_exp_eff * int)=
| _ -> assert false
+let (map_typer : static_arg_eff list -> typer) =
+ fun sargs teff_ll ->
+ (* Given
+ - a node n of type tau_1 * ... * tau_n -> teta_1 * ... * teta_l
+ - a constant c (nb : sargs = [n,c])
+ - a list of type teff_l
+
+ This function:
+ - checks that t_eff = [tau_1^c;...; tau_n^c]
+ - returns the list of types [teta_1^c;...; teta_l^c]
+ *)
+ 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 = type_to_array_type lti c in
+ if lti_power_c = teff_l then
+ type_to_array_type lto c
+ 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
@@ -198,7 +218,7 @@ let (fill_typer : static_arg_eff list -> typer) =
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
- if lti = teff_l then type_to_array_type lto c
+ if lti = teff_l then (List.hd lto)::(type_to_array_type (List.tl lto) c)
else
let str_l = List.map CompiledDataDump.string_of_type_eff lti in
type_error teff_l (String.concat "*" str_l)
@@ -218,8 +238,13 @@ let (mapred_typer : static_arg_eff list -> typer) =
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 = type_to_array_type lti c in
- if lti_power_c = teff_l then type_to_array_type lto c
+ 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 <> []);
+ (List.hd lto)::(type_to_array_type (List.tl lto) c)
+ )
else
let str_l = List.map CompiledDataDump.string_of_type_eff lti_power_c in
type_error teff_l (String.concat "*" str_l)
@@ -265,7 +290,7 @@ let (type_eval: op -> static_arg_eff list -> typer) =
| NOR_n
| DIESE_n -> boolred_typer
- | Map -> assert false
+ | Map -> map_typer sargs
| Fill -> fill_typer sargs
| Red -> assert false
| MapRed -> mapred_typer sargs
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index 19dd1393..81b60353 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -7564,8 +7564,13 @@ let
elt_out = (elt_in + 1);
tel
-- end of node iter__mapped
+node iter__plus(accu_in:int; elt_in:int) returns (accu_out:int);
+let
+ accu_out = (accu_in + elt_in);
+tel
+-- end of node iter__plus
-*** oops: an internal error occurred in file predefSemantics.ml, line 268, column 11
+*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
*** when compiling lustre program should_work/fab_test/iter.lus
----------------------------------------------------------------------
@@ -7609,7 +7614,18 @@ let
tel
-- end of node iterate__mapped
-*** oops: an internal error occurred in file predefSemantics.ml, line 268, column 11
+node iterate__redduced(
+ accu_in:int;
+ elt_in1:int;
+ elt_in2:int)
+returns (
+ accu_out:int);
+let
+ accu_out = ((accu_in + elt_in1) + elt_in2);
+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
----------------------------------------------------------------------
@@ -9539,7 +9555,7 @@ let
tel
-- end of node FillFollowedByRed__filled
-*** oops: an internal error occurred in file predefSemantics.ml, line 270, column 11
+*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
*** when compiling lustre program should_work/lionel/FillFollowedByRed.lus
----------------------------------------------------------------------
@@ -9659,7 +9675,7 @@ let
tel
-- end of node shiftFill_ludic__n_selectOneStage
-*** oops: an internal error occurred in file predefSemantics.ml, line 270, column 11
+*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
*** when compiling lustre program should_work/lionel/ProduitBool/shiftFill_ludic.lus
----------------------------------------------------------------------
@@ -9730,7 +9746,7 @@ let
tel
-- end of node shift_ludic__n_selectOneStage
-*** oops: an internal error occurred in file predefSemantics.ml, line 270, column 11
+*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
*** when compiling lustre program should_work/lionel/ProduitBool/shift_ludic.lus
----------------------------------------------------------------------
@@ -10375,7 +10391,7 @@ let
tel
-- end of node tri__minFromRank
-*** oops: an internal error occurred in file predefSemantics.ml, line 270, column 11
+*** oops: an internal error occurred in file predefSemantics.ml, line 295, column 11
*** when compiling lustre program should_work/packEnvTest/contractForElementSelectionInArray/tri.lus
----------------------------------------------------------------------
--
GitLab