From 64fca779915b315d44ee1ee68ba77ac7b7ed642d Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Mon, 17 Mar 2008 14:56:16 +0100
Subject: [PATCH] Merge EvalType, EvalNode and EvalEq into a single module
GetEff.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
EvalNode.f -> GetEff.node,
EvalType.f -> GetEff.typ,
EvalEq.f -> GetEff.eq
EvalConst.f (val_exp -> const_eff list) should have been put there too,
but in fact EvalConst.f ougth to be splitted in two parts:
- val_exp -> val_exp_eff (but this function already exist)
- val_exp_eff -> const_eff list
Therefore, the signature of EvalConst.f will be changed to:
val_exp_eff -> const_eff list (and will use GetEff.val_exp)
Ditto for eval_array_index.
eval_array_index : CompiledData.id_solver -> SyntaxTreeCore.val_exp -> int -> int
ougth to be splitted into two functions:
- CompiledData.id_solver -> SyntaxTreeCore.val_exp_eff
- SyntaxTreeCore.val_exp_eff -> int -> int
Ditto for eval_array_size
eval_array_size : CompiledData.id_solver -> SyntaxTreeCore.val_exp -> int
ougth to be splitted into two functions:
- CompiledData.id_solver -> SyntaxTreeCore.val_exp_eff
- SyntaxTreeCore.val_exp_eff -> int
arg... evalConst.f est utilisé par GettEff.typ !!!
---
src/Makefile | 8 +-
src/evalConst.ml | 31 +++---
src/evalEq.mli | 9 --
src/evalNode.ml | 97 ----------------
src/evalNode.mli | 5 -
src/evalType.ml | 43 -------
src/evalType.mli | 48 --------
src/{evalEq.ml => getEff.ml} | 161 ++++++++++++++++++++++-----
src/getEff.mli | 22 ++++
src/lazyCompiler.ml | 49 ++++----
src/test/should_work/call/call06.lus | 4 +-
src/test/test.res.exp | 21 ++--
12 files changed, 212 insertions(+), 286 deletions(-)
delete mode 100644 src/evalEq.mli
delete mode 100644 src/evalNode.ml
delete mode 100644 src/evalNode.mli
delete mode 100644 src/evalType.ml
delete mode 100644 src/evalType.mli
rename src/{evalEq.ml => getEff.ml} (50%)
create mode 100644 src/getEff.mli
diff --git a/src/Makefile b/src/Makefile
index 891d48db..f9b4f226 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -33,12 +33,8 @@ SOURCES = \
./syntaxTab.ml \
./evalConst.mli \
./evalConst.ml \
- ./evalType.mli \
- ./evalType.ml \
- ./evalNode.mli \
- ./evalNode.ml \
- ./evalEq.mli \
- ./evalEq.ml \
+ ./getEff.mli \
+ ./getEff.ml \
./lazyCompiler.ml \
./lazyCompiler.mli \
./compile.ml \
diff --git a/src/evalConst.ml b/src/evalConst.ml
index a9e4b440..d77a83d7 100644
--- a/src/evalConst.ml
+++ b/src/evalConst.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 13/03/2008 (at 16:07) by Erwan Jahier> *)
+(** Time-stamp: <modified the 17/03/2008 (at 14:29) by Erwan Jahier> *)
open Printf
@@ -357,20 +357,20 @@ let make_array_const (ops : const_eff list array) = (
[x] -> (
let xtyp = type_of_const_eff x in
match (!expected_type) with
- None -> (
+ | None -> (
expected_type := Some xtyp ;
x
- ) |
- Some t -> (
- if(t = xtyp) then x
- else
- raise (
- EvalConst_error(
- "type error in array, "^
- (string_of_type_eff xtyp)^
- " mixed with " ^string_of_type_eff t
+ )
+ | Some t -> (
+ if(t = xtyp) then x
+ else
+ raise (
+ EvalConst_error(
+ "type error in array, "^
+ (string_of_type_eff xtyp)^
+ " mixed with " ^string_of_type_eff t
))
- )
+ )
)
| _ ->
(* tuple *)
@@ -439,8 +439,8 @@ let make_struct_const
Hashtbl.iter raise_error arg_tab ;
(* ok : tout s'est bien passé ! *)
Struct_const_eff (eff_fields, teff)
- ) |
- _ -> raise (EvalConst_error(
+ )
+ | _ -> raise (EvalConst_error(
sprintf
"struct type expected instead of %s"
(string_of_type_eff teff)
@@ -475,8 +475,7 @@ let rec f
with EvalConst_error msg ->
raise (Compile_error(lxm, "can't eval constant: "^msg))
)
- |
- CallByName ({it=nmop; src=lxm}, nmargs ) -> (
+ | CallByName ({it=nmop; src=lxm}, nmargs ) -> (
try eval_by_name_const nmop lxm nmargs
with EvalConst_error msg ->
raise (Compile_error(lxm, "can't eval constant: "^msg))
diff --git a/src/evalEq.mli b/src/evalEq.mli
deleted file mode 100644
index b43c39f0..00000000
--- a/src/evalEq.mli
+++ /dev/null
@@ -1,9 +0,0 @@
-(** Time-stamp: <modified the 14/03/2008 (at 15:17) by Erwan Jahier> *)
-
-
-
-val f : CompiledData.id_solver -> SyntaxTreeCore.eq_info Lxm.srcflagged ->
- CompiledData.eq_info_eff Lxm.srcflagged
-
-val translate_assertions : CompiledData.id_solver ->
- SyntaxTreeCore.val_exp Lxm.srcflagged -> CompiledData.val_exp_eff Lxm.srcflagged
diff --git a/src/evalNode.ml b/src/evalNode.ml
deleted file mode 100644
index c43accf6..00000000
--- a/src/evalNode.ml
+++ /dev/null
@@ -1,97 +0,0 @@
-(** Time-stamp: <modified the 14/03/2008 (at 10:55) by Erwan Jahier> *)
-
-
-open Lxm
-open SyntaxTree
-open SyntaxTreeCore
-open CompiledData
-
-let finish_me msg = print_string (
- "\n\tXXX evalNode.ml:\n\tXXX "^msg^" -> finish me!\n")
-
-
-let (get_static_params_from_idref : SymbolTab.t -> Lxm.t -> Ident.idref ->
- static_param srcflagged list) =
- fun symbols lxm idref ->
- match SymbolTab.find_node symbols (Ident.name_of_idref idref) lxm with
- | SymbolTab.Here ni -> (
- match ni.it.static_params with
- | None -> [] (* should I raise en error here? *)
- | Some sp -> sp
- )
- | SymbolTab.NotHere imported_node ->
-
- finish_me ((Lxm.details lxm) ^
- ": imported node "^(Ident.string_of_long imported_node)^
- " in static args");
- assert false
-
-
-let rec (f : CompiledData.id_solver -> SyntaxTreeCore.node_exp srcflagged ->
- CompiledData.node_exp_eff) =
- fun id_solver { src = lxm; it=(idref, static_args) } ->
- let static_params = get_static_params_from_idref id_solver.symbols lxm idref in
- let static_args_eff =
- assert(List.length static_params = List.length static_args);
- List.map2 (check_static_arg id_solver)
- static_params
- static_args
- in
- id_solver.id2node idref static_args_eff lxm
-
-
-(** [check_static_arg this pn id sa (symbols, acc)] compile a static arg
- into a static_arg_eff
-*)
-and (check_static_arg : CompiledData.id_solver ->
- SyntaxTreeCore.static_param srcflagged ->
- SyntaxTreeCore.static_arg srcflagged ->
- CompiledData.static_arg_eff) =
- fun node_id_solver sp sa ->
- let sa_eff =
- match sa.it, sp.it with
- | StaticArgIdent idref, StaticParamConst(id, _type_exp) ->
- let ceff = node_id_solver.id2const idref sa.src in
- ConstStaticArgEff (id, ceff)
-
- | StaticArgIdent idref, StaticParamType(id) ->
- let teff = node_id_solver.id2type idref sa.src in
- TypeStaticArgEff (id, teff)
-
- | StaticArgIdent idref, StaticParamNode(id,_,_,_) ->
- let sargs = [] in
- (* We suppose that static arg cannot themselves be
- template calls (eg, f<<g<<3>>>> is forbidden)
- *)
- let neff = node_id_solver.id2node idref sargs sa.src in
- NodeStaticArgEff (id, neff)
-
- | StaticArgConst ce, StaticParamConst(id, _type_exp) -> (
- let ceff = EvalConst.f node_id_solver ce in
- match ceff with
- | [ceff] -> ConstStaticArgEff (id,ceff)
- | _ -> assert false (* should not occur *)
- )
- | StaticArgType te, StaticParamType id ->
- let teff = EvalType.f node_id_solver te in
- TypeStaticArgEff (id, teff)
-
- | StaticArgNode(ne), StaticParamNode(id,_,_,_)->
- let neff = f node_id_solver {src=sa.src; it=ne } in
- NodeStaticArgEff (id, neff)
-
-
- | StaticArgType _, StaticParamNode(id,_,_,_)
- | StaticArgType _, StaticParamConst(id,_)
-
- | StaticArgNode _, StaticParamType(id)
- | StaticArgNode _, StaticParamConst(id,_)
-
- | StaticArgConst _, StaticParamNode(id,_,_,_)
- | StaticArgConst _, StaticParamType(id)
- ->
- finish_me "write a nice error message!";
- assert false (* can it occur actually? Let's wait it occurs...*)
-
- in
- sa_eff
diff --git a/src/evalNode.mli b/src/evalNode.mli
deleted file mode 100644
index a19b698e..00000000
--- a/src/evalNode.mli
+++ /dev/null
@@ -1,5 +0,0 @@
-(** Time-stamp: <modified the 12/03/2008 (at 14:12) by Erwan Jahier> *)
-
-
-val f : CompiledData.id_solver -> SyntaxTreeCore.node_exp Lxm.srcflagged ->
- CompiledData.node_exp_eff
diff --git a/src/evalType.ml b/src/evalType.ml
deleted file mode 100644
index c047795b..00000000
--- a/src/evalType.ml
+++ /dev/null
@@ -1,43 +0,0 @@
-(** Time-stamp: <modified the 05/03/2008 (at 14:49) by Erwan Jahier> *)
-
-open Lxm
-open Errors
-open SyntaxTree
-open SyntaxTreeCore
-open CompiledData
-open EvalConst
-
-exception EvalType_error of string
-
-(*---------------------------------------------------------------------
-eval_type
------------------------------------------------------------------------
-Rôle :
-
-Entrées : id_solver + type_exp
-
-Sorties : type_eff
-
-Effets de bord :
- Compile_error
-----------------------------------------------------------------------*)
-
-let rec (f:CompiledData.id_solver -> SyntaxTreeCore.type_exp -> CompiledData.type_eff)=
- fun env texp ->
- try (
- match texp.it with
- | Bool_type_exp -> Bool_type_eff
- | Int_type_exp -> Int_type_eff
- | Real_type_exp -> Real_type_eff
- | Named_type_exp s -> env.id2type s texp.src
- | Array_type_exp (elt_texp, szexp) -> (
- let elt_teff = f env elt_texp in
- try (
- let sz = EvalConst.eval_array_size env szexp in
- Array_type_eff (elt_teff, sz)
- ) with EvalArray_error msg -> raise(EvalType_error msg)
- )
- )
- with EvalType_error msg ->
- raise (Compile_error(texp.src, "can't eval type: "^msg))
-
diff --git a/src/evalType.mli b/src/evalType.mli
deleted file mode 100644
index 69258966..00000000
--- a/src/evalType.mli
+++ /dev/null
@@ -1,48 +0,0 @@
-(** Time-stamp: <modified the 05/02/2008 (at 11:24) by Erwan Jahier> *)
-
-(*----------------------------------------------------------------------
- module : EvalType
- date :
-------------------------------------------------------------------------
-DESCRIPTION :
-
- Evaluation des expressions de types. Il utilise CheckConst.
-
-PARAMETRES :
- Pour avoir qq chose de générique, les fonctions
- sont paramétrées par un "id_solver", qui contient deux fonctions :
-
- type id_solver = {
- id2const : Ident.t -> Lxm.t -> const_eff
- id2type : Ident.t -> Lxm.t -> type_eff
- }
-
- (N.B. on passe le lexeme pour déventuels messages d'erreurs)
-
-FONCTION PRINCIPALE :
- Elle lève "Compile_error lxm msg"
-
- eval_type
- (env : id_solver)
- (vexp : type_exp)
- -> type_eff
-
- N.B. une expression de type NE PEUT PAS dénoter un tuple.
-
-----------------------------------------------------------------------*)
-
-(*---------------------------------------------------------------------
-eval_type
------------------------------------------------------------------------
-Rôle :
-
-Entrées : id_solver + type_exp
-
-Sorties : type_eff
-
-Effets de bord :
- Compile_error
-----------------------------------------------------------------------*)
-
-
-val f : CompiledData.id_solver -> SyntaxTreeCore.type_exp -> CompiledData.type_eff
diff --git a/src/evalEq.ml b/src/getEff.ml
similarity index 50%
rename from src/evalEq.ml
rename to src/getEff.ml
index 4b20930e..27d208b7 100644
--- a/src/evalEq.ml
+++ b/src/getEff.ml
@@ -1,23 +1,144 @@
-(** Time-stamp: <modified the 14/03/2008 (at 15:17) by Erwan Jahier> *)
+(** Time-stamp: <modified the 17/03/2008 (at 14:10) by Erwan Jahier> *)
+
open Lxm
+open SyntaxTree
open SyntaxTreeCore
open CompiledData
open Errors
-let finish_me msg = print_string ("\n\tXXX evalEq:"^msg^" -> finish me!\n")
+let finish_me msg = print_string (
+ "\n\tXXX getEff.ml:\n\tXXX "^msg^" -> finish me!\n")
+
+
+let (get_static_params_from_idref : SymbolTab.t -> Lxm.t -> Ident.idref ->
+ static_param srcflagged list) =
+ fun symbols lxm idref ->
+ match SymbolTab.find_node symbols (Ident.name_of_idref idref) lxm with
+ | SymbolTab.Here ni -> (
+ match ni.it.static_params with
+ | None -> [] (* should I raise en error here? *)
+ | Some sp -> sp
+ )
+ | SymbolTab.NotHere imported_node ->
+ finish_me ((Lxm.details lxm) ^
+ ": imported node "^(Ident.string_of_long imported_node)^
+ " in static args");
+ assert false
+
+
+(******************************************************************************)
+exception GetEffType_error of string
+
+(* exported *)
+let rec (typ:CompiledData.id_solver -> SyntaxTreeCore.type_exp ->
+ CompiledData.type_eff)=
+ fun env texp ->
+ try (
+ match texp.it with
+ | Bool_type_exp -> Bool_type_eff
+ | Int_type_exp -> Int_type_eff
+ | Real_type_exp -> Real_type_eff
+ | Named_type_exp s -> env.id2type s texp.src
+ | Array_type_exp (elt_texp, szexp) -> (
+ let elt_teff = typ env elt_texp in
+ try (
+ let sz = EvalConst.eval_array_size env szexp in
+ Array_type_eff (elt_teff, sz)
+ ) with EvalConst.EvalArray_error msg -> raise(GetEffType_error msg)
+ )
+ )
+ with GetEffType_error msg ->
+ raise (Compile_error(texp.src, "can't eval type: "^msg))
+
+
+
+(******************************************************************************)
+(* exported *)
+let rec (node : CompiledData.id_solver -> SyntaxTreeCore.node_exp srcflagged ->
+ CompiledData.node_exp_eff) =
+ fun id_solver { src = lxm; it=(idref, static_args) } ->
+ let static_params = get_static_params_from_idref id_solver.symbols lxm idref in
+ let static_args_eff =
+ assert(List.length static_params = List.length static_args);
+ List.map2 (check_static_arg id_solver)
+ static_params
+ static_args
+ in
+ id_solver.id2node idref static_args_eff lxm
+
+
+(** [check_static_arg this pn id sa (symbols, acc)] compile a static arg
+ into a static_arg_eff
+*)
+and (check_static_arg : CompiledData.id_solver ->
+ SyntaxTreeCore.static_param srcflagged ->
+ SyntaxTreeCore.static_arg srcflagged ->
+ CompiledData.static_arg_eff) =
+ fun node_id_solver sp sa ->
+ let sa_eff =
+ match sa.it, sp.it with
+ | StaticArgIdent idref, StaticParamConst(id, _type_exp) ->
+ let ceff = node_id_solver.id2const idref sa.src in
+ ConstStaticArgEff (id, ceff)
+
+ | StaticArgIdent idref, StaticParamType(id) ->
+ let teff = node_id_solver.id2type idref sa.src in
+ TypeStaticArgEff (id, teff)
+
+ | StaticArgIdent idref, StaticParamNode(id,_,_,_) ->
+ let sargs = [] in
+ (* We suppose that static arg cannot themselves be
+ template calls (eg, f<<g<<3>>>> is forbidden)
+ *)
+ let neff = node_id_solver.id2node idref sargs sa.src in
+ NodeStaticArgEff (id, neff)
+
+ | StaticArgConst ce, StaticParamConst(id, _type_exp) -> (
+ let ceff = EvalConst.f node_id_solver ce in
+ match ceff with
+ | [ceff] -> ConstStaticArgEff (id,ceff)
+ | _ -> assert false (* should not occur *)
+ )
+ | StaticArgType te, StaticParamType id ->
+ let teff = typ node_id_solver te in
+ TypeStaticArgEff (id, teff)
+
+ | StaticArgNode(ne), StaticParamNode(id,_,_,_)->
+ let neff = node node_id_solver {src=sa.src; it=ne } in
+ NodeStaticArgEff (id, neff)
+
+ | StaticArgType _, StaticParamNode(id,_,_,_)
+ | StaticArgType _, StaticParamConst(id,_)
+ | StaticArgNode _, StaticParamType(id)
+ | StaticArgNode _, StaticParamConst(id,_)
+
+ | StaticArgConst _, StaticParamNode(id,_,_,_)
+ | StaticArgConst _, StaticParamType(id)
+ ->
+ finish_me "write a nice error message!";
+ assert false (* can it occur actually? Let's wait it occurs...*)
+
+ in
+ sa_eff
+(******************************************************************************)
-let rec (f : id_solver -> eq_info srcflagged -> eq_info_eff srcflagged) =
+(* exported *)
+let rec (eq : id_solver -> eq_info srcflagged -> eq_info_eff srcflagged) =
fun id_solver eq_info ->
let (lpl, ve) = eq_info.it in
- let eq_eff =
- List.map (translate_left_part id_solver) lpl,
- translate_val_exp id_solver ve
+ let lpl_eff = List.map (translate_left_part id_solver) lpl
+ and ve_eff = translate_val_exp id_solver ve
in
- flagit eq_eff eq_info.src
+ (* Type check here? (i.e., check that the left part has the same type as the
+ rigth one).
+ *)
+
+
+ flagit (lpl_eff, ve_eff) eq_info.src
and (translate_left_part : id_solver -> left_part -> left_eff) =
@@ -126,7 +247,7 @@ and (translate_by_pos_op : id_solver -> by_pos_op -> Lxm.t -> by_pos_op_eff) =
| PRE_n -> PRE_eff
| CALL_n node_exp_f ->
- CALL_eff (flagit (EvalNode.f id_solver node_exp_f) node_exp_f.src)
+ CALL_eff (flagit (node id_solver node_exp_f) node_exp_f.src)
| ARROW_n -> ARROW_eff
| FBY_n -> FBY_eff
@@ -139,6 +260,7 @@ and (translate_by_pos_op : id_solver -> by_pos_op -> Lxm.t -> by_pos_op_eff) =
| ARRAY_ACCES_n ve -> ARRAY_ACCES_eff (translate_val_exp id_solver ve)
| ARRAY_SLICE_n si ->
+ finish_me "calcul de ARRAY_SLICE_eff";
assert false
(* ARRAY_SLICE_eff (translate_slice_info id_solver si lxm ???)
@@ -159,27 +281,10 @@ and (translate_slice_info : id_solver -> slice_info -> int -> Lxm.t ->
(**********************************************************************************)
-let (translate_assertions : CompiledData.id_solver ->
- SyntaxTreeCore.val_exp Lxm.srcflagged ->
+(* exported *)
+let (val_exp : CompiledData.id_solver -> SyntaxTreeCore.val_exp Lxm.srcflagged ->
CompiledData.val_exp_eff Lxm.srcflagged) =
fun id_solver vef ->
Lxm.flagit (translate_val_exp id_solver vef.it) vef.src
-(**********************************************************************************)
-
-let (type_check: eq_info_eff srcflagged -> unit) =
- fun eq_eff ->
- assert false
-
-let (clock_check: eq_info_eff srcflagged -> unit) =
- fun eq_eff ->
- assert false
-
-let (type_check_assert: val_exp_eff srcflagged -> unit) =
- fun eq_eff ->
- assert false
-
-let (clock_check_assert: val_exp_eff srcflagged -> unit) =
- fun eq_eff ->
- assert false
-
+(******************************************************************************)
diff --git a/src/getEff.mli b/src/getEff.mli
new file mode 100644
index 00000000..9e30aca0
--- /dev/null
+++ b/src/getEff.mli
@@ -0,0 +1,22 @@
+(** Time-stamp: <modified the 17/03/2008 (at 14:10) by Erwan Jahier> *)
+
+(**
+ A [node_exp] is a name plus a list of static arguments.
+
+ The goal of [f] is to
+ - compute the effective type of static arguments
+ - check they are comptible with the node signature
+ check the type of the static arguments (
+ *)
+
+val node : CompiledData.id_solver -> SyntaxTreeCore.node_exp Lxm.srcflagged ->
+ CompiledData.node_exp_eff
+
+val eq : CompiledData.id_solver -> SyntaxTreeCore.eq_info Lxm.srcflagged ->
+ CompiledData.eq_info_eff Lxm.srcflagged
+
+val val_exp : CompiledData.id_solver -> SyntaxTreeCore.val_exp Lxm.srcflagged ->
+ CompiledData.val_exp_eff Lxm.srcflagged
+
+
+val typ : CompiledData.id_solver -> SyntaxTreeCore.type_exp -> CompiledData.type_eff
diff --git a/src/lazyCompiler.ml b/src/lazyCompiler.ml
index 4e5566ae..ed45560f 100644
--- a/src/lazyCompiler.ml
+++ b/src/lazyCompiler.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 14/03/2008 (at 15:16) by Erwan Jahier> *)
+(** Time-stamp: <modified the 17/03/2008 (at 14:56) by Erwan Jahier> *)
open Lxm
@@ -117,25 +117,26 @@ fun tbl ->
nb: for x in {type, const, node, clock}, there are several functions
that returns [x_eff]:
- [x_check]
- o takes an x_key
+ o tabulates its result
+ o takes an x_key and returns an [x_eff]
o lookups its (syntaxic) definition (x_info) via the symbolTab.t
- o transforms it into a [x_eff] (recursively on the syntax structure)
-
+ o calls evalX.f to translate its sub-terms
+
+ - [GetEff.X]
+ o takes a [x_exp] (i.e., an expression) and returns an [x_eff]
+ o compute the effective static args (for nodes)
+ o calls solve_x_idref (via [id_solver]) to translate its sub-terms
+
+
- [solve_x_idref]
- o takes a idref (plus a «static_arg_eff list» for x=node!)
- o builds an [x_key] to be able to call [x_check] (name resolution)
- o used by evalX.f
+ o takes an idref (plus a «static_arg_eff list» for x=node!)
+ o perform name resolution
+ o calls [x_check] (loop!)
- - [evalX.f]
- o takes a [x_exp] (i.e., an expression)
- o used by [x_check]
nb2: the top-level call is [node_check], on a node that necessarily contains
no static parameters. Then:
- - [node_check] calls [solve_x_idref] to perform name resolution
- and it calls
- nb3:
*)
@@ -364,7 +365,7 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name -
match type_def.it with
| ArrayType _ -> finish_me " array handling "; assert false
| ExternalType s -> External_type_eff (Ident.make_long pack_name s)
- | AliasedType (s, texp) -> EvalType.f id_solver texp
+ | AliasedType (s, texp) -> GetEff.typ id_solver texp
| EnumType (s, clst) -> (
let n = Ident.make_long pack_name s in
let add_pack_name x = Ident.make_long pack_name x.it in
@@ -373,7 +374,7 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name -
| StructType sti -> (
let make_field (fname : Ident.t) = (
let field_def = Hashtbl.find sti.st_ftable fname in
- let teff = EvalType.f id_solver field_def.it.fd_type in
+ let teff = GetEff.typ id_solver field_def.it.fd_type in
match field_def.it.fd_value with
| None -> (fname, (teff, None))
| Some vexp -> (
@@ -433,10 +434,10 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name
match const_def.it with
| ExternalConst (id, texp) ->
Extern_const_eff ((Ident.make_long currpack id),
- EvalType.f id_solver texp)
+ GetEff.typ id_solver texp)
| EnumConst (id, texp) ->
- Enum_const_eff ((Ident.make_long currpack id), EvalType.f id_solver texp)
+ Enum_const_eff ((Ident.make_long currpack id), GetEff.typ id_solver texp)
| DefinedConst (id, texp_opt, vexp ) -> (
match (EvalConst.f id_solver vexp) with
@@ -444,7 +445,7 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name
match texp_opt with
| None -> ceff
| Some texp -> (
- let tdecl = EvalType.f id_solver texp in
+ let tdecl = GetEff.typ id_solver texp in
let teff = type_of_const_eff ceff in
if (tdecl = teff ) then ceff
else
@@ -561,7 +562,7 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
| Some vars ->
let type_args id =
let vi = Hashtbl.find vars.vartable id in
- let t_eff = EvalType.f node_id_solver vi.it.var_type in
+ let t_eff = GetEff.typ node_id_solver vi.it.var_type in
let vi_eff = {
var_name_eff = vi.it.var_name;
var_nature_eff = vi.it.var_nature;
@@ -602,15 +603,15 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
filled
*)
BodyEff {
- asserts_eff =
- List.map (EvalEq.translate_assertions node_id_solver) nb.asserts;
- eqs_eff = List.map (EvalEq.f node_id_solver) nb.eqs;
+ asserts_eff =
+ List.map (GetEff.val_exp node_id_solver) nb.asserts;
+ eqs_eff = List.map (GetEff.eq node_id_solver) nb.eqs;
}
)
)
| Alias node_alias -> (
(* just check that the declared profile (if any) matches with the alias *)
- let res = EvalNode.f node_id_solver node_alias in
+ let res = GetEff.node node_id_solver node_alias in
match node_def.it.vars with
| None -> res
| Some vars ->
@@ -618,7 +619,7 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
List.map (fun id -> Hashtbl.find vars.vartable id) vars.inlist,
List.map (fun id -> Hashtbl.find vars.vartable id) vars.outlist
in
- let aux vi = EvalType.f node_id_solver vi.it.var_type in
+ let aux vi = GetEff.typ node_id_solver vi.it.var_type in
let (il,ol) = CompiledData.profile_of_node_exp_eff res in
if
List.map aux vi_il <> il || List.map aux vi_ol <> ol
diff --git a/src/test/should_work/call/call06.lus b/src/test/should_work/call/call06.lus
index 293cb36b..83148915 100644
--- a/src/test/should_work/call/call06.lus
+++ b/src/test/should_work/call/call06.lus
@@ -4,5 +4,7 @@ extern function bip(x,y : bool) returns (z,t : bool);
node call06(x,y : bool) returns (z,t : bool);
let
assert (x=>z);
- (z,t) = bip(x,y);
+-- (z,t) = bip(x,y);
+ z = 1;
+ (z,t) = bip(1,y); -- i should detect this one during type checking
tel
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index 30384c2e..7d0946e7 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -3018,10 +3018,10 @@ End of Syntax table dump.
const mainPack::n = inter::n (imported)
Exported nodes:
- XXX evalNode.ml:
+ XXX getEff.ml:
XXX in file "should_work/Pascal/newpacks.lus", line 52, col 13 to 22, token 'pint::fby1': imported node preal::fby1 in static args -> finish me!
-*** oops: an internal error occurred in file evalNode.ml, line 27, column 3
+*** oops: an internal error occurred in file getEff.ml, line 27, column 3
*** when compiling lustre program should_work/Pascal/newpacks.lus
----------------------------------------------------------------------
@@ -3246,10 +3246,10 @@ End of Syntax table dump.
const mainPack::n = inter::n (imported)
Exported nodes:
- XXX evalNode.ml:
+ XXX getEff.ml:
XXX in file "should_work/Pascal/p.lus", line 53, col 13 to 22, token 'pint::fby1': imported node preal::fby1 in static args -> finish me!
-*** oops: an internal error occurred in file evalNode.ml, line 27, column 3
+*** oops: an internal error occurred in file getEff.ml, line 27, column 3
*** when compiling lustre program should_work/Pascal/p.lus
----------------------------------------------------------------------
@@ -3340,10 +3340,10 @@ End of Syntax table dump.
const mainPack::Y = inter::Y (imported)
Exported nodes:
- XXX evalNode.ml:
+ XXX getEff.ml:
XXX in file "should_work/Pascal/packs.lus", line 40, col 13 to 22, token 'pint::fby1': imported node preal::fby1 in static args -> finish me!
-*** oops: an internal error occurred in file evalNode.ml, line 27, column 3
+*** oops: an internal error occurred in file getEff.ml, line 27, column 3
*** when compiling lustre program should_work/Pascal/packs.lus
----------------------------------------------------------------------
@@ -4140,7 +4140,10 @@ End of Syntax table dump.
node dummy::copie = dummy::copie(int) returns (int, int) on clock XXX
-*** oops: an internal error occurred in file evalEq.ml, line 142, column 3
+ XXX getEff.ml:
+ XXX calcul de ARRAY_SLICE_eff -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 264, column 3
*** when compiling lustre program should_work/demo/filliter.lus
----------------------------------------------------------------------
@@ -6192,10 +6195,10 @@ End of Syntax table dump.
const mainPack::n = inter::n (imported)
Exported nodes:
- XXX evalNode.ml:
+ XXX getEff.ml:
XXX in file "should_work/packEnvTest/packages.lus", line 53, col 13 to 22, token 'pint::fby1': imported node preal::fby1 in static args -> finish me!
-*** oops: an internal error occurred in file evalNode.ml, line 27, column 3
+*** oops: an internal error occurred in file getEff.ml, line 27, column 3
*** when compiling lustre program should_work/packEnvTest/packages.lus
----------------------------------------------------------------------
--
GitLab