diff --git a/src/Makefile b/src/Makefile
index 76206e39745509ee68c1e3efd34b80a3515e3532..00354d0929e2f686190d00e5bcd2f65489a82129 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -38,10 +38,8 @@ SOURCES = \
./unify.ml \
./syntaxTab.mli \
./syntaxTab.ml \
- ./predefEvalClock.mli \
./predefEvalType.mli \
./predefEvalType.ml \
- ./predefEvalClock.ml \
./predefEvalConst.mli \
./predefEvalConst.ml \
./evalConst.mli \
@@ -96,6 +94,8 @@ cia:
ci:
cd ..; make ci
+wc:
+ wc $(SOURCES)
# Specific rule (version)
diff --git a/src/TODO b/src/TODO
index 56629a88a3ee5a3e4bad6a265572327568c95960..0a668b173f3177bf0f90603bf9b6311fcdef501e 100644
--- a/src/TODO
+++ b/src/TODO
@@ -84,6 +84,7 @@ les operateurs aritmetiques, bof.
* Dans les messages d'erreurs, le numero de colonne est faux à cause
des tabulations : y'at'il quelque chose a faire ?
+
***********************************************************************************
***********************************************************************************
*** questions pour bibi
@@ -131,6 +132,12 @@ n'est pas le cas pour l'instant...
*** facile
+* alias sur les node polymorphes impossible. Pourtant, ca devrait
+pouvoir marcher.
+
+* NONRAG/clock.lus: une entré est clockée sur une sortie -> user
+erreur ou bug ?
+
* mettre les operateurs temporels dans Predef ???
* Verifier que les fonctions sont des fonctions etc.
diff --git a/src/compiledData.ml b/src/compiledData.ml
index 65def6c743739be4a077df928fc7af3bcdce01da..5d9ce9b7cc6c5e5347222cfb9116524ce49004b5 100644
--- a/src/compiledData.ml
+++ b/src/compiledData.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 02/06/2008 (at 14:01) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/06/2008 (at 17:14) by Erwan Jahier> *)
(**
@@ -247,17 +247,14 @@ and const_eff =
----------------------------------------------------------------------*)
(* ICI à completer/modifier sans doute *)
and var_info_eff = {
- var_name_eff : Ident.t ;
- var_nature_eff : var_nature ;
- var_type_eff : type_eff ;
- (* var_clock_eff : clock_eff *)
+ var_name_eff : Ident.t;
+ var_nature_eff : var_nature;
+ var_type_eff : type_eff_ext;
+ var_clock_eff : clock_eff;
}
-and clock_eff = (* XXX generalize me!*)
- BaseClockEff
- | VarClockEff of var_info_eff
-
-
-
+and clock_eff =
+ | BaseEff (* it's not bezef... *)
+ | On of var_info_eff (* nb: it is recursive *)
(**********************************************************************************)
(** [node_exp_eff] correspond à une instance de template (ou, cas
@@ -270,12 +267,10 @@ and clock_eff = (* XXX generalize me!*)
type-checking (et pas du clock-checking)
*)
and node_exp_eff = {
- node_key_eff : node_key ;
- inlist_eff : (Ident.t * type_eff_ext) list ;
- outlist_eff : (Ident.t * type_eff_ext) list ;
- loclist_eff : (Ident.t * type_eff) list option; (* None => extern or abstract *)
- clock_inlist_eff : int option list ;
- clock_outlist_eff : int option list ;
+ node_key_eff : node_key;
+ inlist_eff : var_info_eff list;
+ outlist_eff : var_info_eff list;
+ loclist_eff : var_info_eff list option; (* None => extern or abstract *)
def_eff : node_def_eff;
has_mem_eff : bool;
is_safe_eff : bool;
@@ -354,7 +349,8 @@ let rec type_eff_ext_to_type_eff = function
let (profile_of_node_exp_eff :
node_exp_eff -> type_eff_ext list * type_eff_ext list) =
fun ne ->
- (snd (List.split ne.inlist_eff), snd (List.split ne.outlist_eff))
+ List.map (fun vi -> vi.var_type_eff) ne.inlist_eff,
+ List.map (fun vi -> vi.var_type_eff) ne.outlist_eff
(****************************************************************************)
(* currently not used *)
@@ -452,11 +448,15 @@ let (type_eff_are_compatible : type_eff -> type_eff -> bool) =
| External_type_eff _, _ -> true
| t1, t2 -> t1 = t2
-let (type_eff_ext_are_compatible : type_eff_ext -> type_eff_ext -> bool) =
- fun te1 te2 -> match te1, te2 with
- | External_type_eff_ext id1, External_type_eff_ext id2 -> id1 = id2
- | External_type_eff_ext _, _ -> true
- | t1, t2 -> t1 = t2
+let (var_eff_ext_are_compatible : var_info_eff -> var_info_eff -> bool) =
+ fun v1 v2 ->
+ let type_is_ok =
+ match v1.var_type_eff, v2.var_type_eff with
+ | External_type_eff_ext id1, External_type_eff_ext id2 -> id1 = id2
+ | External_type_eff_ext _, _ -> true
+ | t1, t2 -> t1 = t2
+ in
+ type_is_ok && v1.var_clock_eff = v2.var_clock_eff
(****************************************************************************)
(* Utilitaires liés aux node_key *)
@@ -478,7 +478,7 @@ let (type_of_const_eff: const_eff -> type_eff) =
let (type_eff_of_left_eff: left_eff -> type_eff) =
function
- | LeftVarEff (vi_eff,lxm) -> vi_eff.var_type_eff
+ | LeftVarEff (vi_eff,lxm) -> type_eff_ext_to_type_eff vi_eff.var_type_eff
| LeftFieldEff(_, _, t_eff) -> t_eff
| LeftArrayEff(_, _, t_eff) -> t_eff
| LeftSliceEff(_, _, t_eff) -> t_eff
diff --git a/src/compiledDataDump.ml b/src/compiledDataDump.ml
index ec0ee85804703be4e45363fce6a69c4c27f5242d..240722366ac546a4e449febd470496cc7c90c152 100644
--- a/src/compiledDataDump.ml
+++ b/src/compiledDataDump.ml
@@ -98,20 +98,14 @@ and static_arg2string (sa : static_arg_eff) =
and (string_of_var_info_eff: var_info_eff -> string) =
fun x ->
- (Ident.to_string x.var_name_eff) ^ ":"^(string_of_type_eff x.var_type_eff)
+ (Ident.to_string x.var_name_eff) ^ ":"^(string_of_type_eff_ext x.var_type_eff)
-and string_of_decl (id,teff) =
- (Ident.to_string id) ^ ":" ^ (string_of_type_eff teff)
+and string_of_decl_ext var_info_eff =
+ (Ident.to_string var_info_eff.var_name_eff) ^ ":" ^
+ (string_of_type_eff_ext var_info_eff.var_type_eff) ^
+ (string_of_clock var_info_eff.var_clock_eff)
-and (string_of_type_decl_list : (Ident.t * type_eff) list -> string -> string) =
- fun tel sep ->
- let str = String.concat sep (List.map string_of_decl tel) in
- str
-
-and string_of_decl_ext (id,teff) =
- (Ident.to_string id) ^ ":" ^ (string_of_type_eff_ext teff)
-
-and (string_of_type_decl_list_ext : (Ident.t*type_eff_ext) list -> string -> string) =
+and (string_of_type_decl_list_ext : var_info_eff list -> string -> string) =
fun tel sep ->
let str = String.concat sep (List.map string_of_decl_ext tel) in
str
@@ -318,7 +312,7 @@ and (node_of_node_exp_eff: node_exp_eff -> string) =
| BodyEff _ ->
((match neff.loclist_eff with None -> "" | Some [] -> ""
| Some l ->
- "var\n " ^ (string_of_type_decl_list l ";\n ") ^ ";\n") ^
+ "var\n " ^ (string_of_type_decl_list_ext l ";\n ") ^ ";\n") ^
"let\n " ^
(String.concat "\n " (string_of_node_def neff.def_eff)) ^
"\ntel\n-- end of node " ^
@@ -327,11 +321,11 @@ and (node_of_node_exp_eff: node_exp_eff -> string) =
)
-and string_of_clock (ck : clock_eff) = (
+and string_of_clock (ck : clock_eff) =
match ck with
- BaseClockEff -> "<base>"
- | VarClockEff veff -> (Ident.to_string veff.var_name_eff)
-)
+ | BaseEff -> ""
+ | On veff ->" when " ^ (Ident.to_string veff.var_name_eff) ^
+ (string_of_clock veff.var_clock_eff)
diff --git a/src/evalType.ml b/src/evalType.ml
index 410092c35aa3c520bb41e6c186fb5921009d020c..88156fbb1b84e09ca913a77c8d998166d5f05679 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 02/06/2008 (at 14:14) by Erwan Jahier> *)
+(** Time-stamp: <modified the 06/06/2008 (at 10:24) by Erwan Jahier> *)
open Predef
@@ -33,14 +33,18 @@ and (eval_by_pos_type :
PredefEvalType.f op lxm sargs (List.map (f id_solver) args)
| CALL_eff node_exp_eff ->
- let lto = snd (List.split node_exp_eff.it.outlist_eff) in
+ let lto = List.map (fun v -> v.var_type_eff) node_exp_eff.it.outlist_eff in
(try List.map type_eff_ext_to_type_eff lto
- with Polymorphic | Overloaded -> assert false)
+ with Polymorphic | Overloaded -> assert false)
| IDENT_eff id -> (
(* [id] migth be a constant, but also a variable *)
try [type_of_const_eff (id_solver.id2const id lxm)]
- with _ -> [(id_solver.id2var id lxm).var_type_eff]
+ with _ -> [
+ try
+ type_eff_ext_to_type_eff (id_solver.id2var id lxm).var_type_eff
+ with Polymorphic | Overloaded -> assert false
+ ]
)
| WITH_eff -> (
match args with
diff --git a/src/getEff.ml b/src/getEff.ml
index ffadee5cab245ebc137e19dd50eb2fd07a088c6a..c3b5404d360f4269e6f04a718b03ec23510bbf2d 100644
--- a/src/getEff.ml
+++ b/src/getEff.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 05/06/2008 (at 10:45) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/06/2008 (at 17:31) by Erwan Jahier> *)
open Lxm
@@ -8,8 +8,6 @@ open SyntaxTreeCore
open CompiledData
open Errors
-let finish_me msg = print_string (
- "\n\tXXX getEff.ml:\n\tXXX "^msg^" -> finish me!\n")
(******************************************************************************)
exception GetEffType_error of string
@@ -34,6 +32,15 @@ let rec (typ:CompiledData.id_solver -> SyntaxTreeCore.type_exp ->
with GetEffType_error msg ->
raise (Compile_error(texp.src, "can't eval type: "^msg))
+(******************************************************************************)
+(* exported *)
+let rec (clock : CompiledData.id_solver -> SyntaxTreeCore.clock_exp ->
+ CompiledData.clock_eff)=
+ fun id_solver cexp ->
+ match cexp with
+ | Base -> BaseEff
+ | NamedClock id -> On (id_solver.id2var (Ident.to_idref id.it) id.src)
+
(******************************************************************************)
let (get_static_params_from_idref : SymbolTab.t -> Lxm.t -> Ident.idref ->
@@ -119,9 +126,7 @@ and (check_static_arg : CompiledData.id_solver ->
| 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/getEff.mli b/src/getEff.mli
index 399ab549ab3f8eb465582e32d5c9051bb087bca3..20fc2987222c20f3037be3c423dc2141d1447ac9 100644
--- a/src/getEff.mli
+++ b/src/getEff.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 23/05/2008 (at 15:12) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/06/2008 (at 16:11) by Erwan Jahier> *)
(** This module defines functions that translate SyntaxTreeCore datatypes into
@@ -13,7 +13,8 @@
- recursively call itself for translating sub-terms
*)
-val typ : CompiledData.id_solver -> SyntaxTreeCore.type_exp -> CompiledData.type_eff
+val typ : CompiledData.id_solver -> SyntaxTreeCore.type_exp -> CompiledData.type_eff
+val clock: CompiledData.id_solver -> SyntaxTreeCore.clock_exp -> CompiledData.clock_eff
(**
A [node_exp] is a name plus a list of static arguments.
diff --git a/src/lazyCompiler.ml b/src/lazyCompiler.ml
index dc4e95f25d3e08ff478ab7fe2894b2f38012390d..b57df04025a965e6344df6b4694f1252cd0ce161 100644
--- a/src/lazyCompiler.ml
+++ b/src/lazyCompiler.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 05/06/2008 (at 10:45) by Erwan Jahier> *)
+(** Time-stamp: <modified the 06/06/2008 (at 10:35) by Erwan Jahier> *)
open Lxm
@@ -57,17 +57,12 @@ fun tbl ->
prov_consts = Hashtbl.create 0;
prov_nodes = Hashtbl.create 0;
-(* XXX Remplir ces tables avec les infos relatives aux opérateurs prédéfinis !!! *)
-
(* XXX il manque aussi une table pour les clocks !!! *)
}
(******************************************************************************)
-
-(******************************************************************************)
-
(** Type checking + constant checking/evaluation
This is performed (lazily) by 10 mutually recursive functions:
@@ -491,15 +486,13 @@ and (node_check_interface_do: t -> CompiledData.node_key -> Lxm.t ->
(** [types_are_compatible t1 t2] checks that t1 is compatible with t2, i.e.,
if t1 = t2 or t1 is abstract and and t2.
*)
- let type_is_comp (_,t1) (_,t2) = CompiledData.type_eff_ext_are_compatible t1 t2 in
+ let type_is_comp v1 v2 = CompiledData.var_eff_ext_are_compatible v1 v2 in
if
prov_node_exp_eff.node_key_eff = body_node_exp_eff.node_key_eff &&
(List.for_all2 type_is_comp
prov_node_exp_eff.inlist_eff body_node_exp_eff.inlist_eff) &&
(List.for_all2 type_is_comp
prov_node_exp_eff.outlist_eff body_node_exp_eff.outlist_eff) &&
- prov_node_exp_eff.clock_inlist_eff = body_node_exp_eff.clock_inlist_eff &&
- prov_node_exp_eff.clock_outlist_eff = body_node_exp_eff.clock_outlist_eff &&
prov_node_exp_eff.has_mem_eff = body_node_exp_eff.has_mem_eff &&
prov_node_exp_eff.is_safe_eff = body_node_exp_eff.is_safe_eff &&
match prov_node_exp_eff.def_eff, body_node_exp_eff.def_eff with
@@ -568,31 +561,42 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
let type_args id =
let vi = Hashtbl.find vars.vartable id in
let t_eff = GetEff.typ node_id_solver vi.it.var_type in
+ let c_eff = GetEff.clock node_id_solver vi.it.var_clock in
let vi_eff = {
var_name_eff = vi.it.var_name;
var_nature_eff = vi.it.var_nature;
- var_type_eff = t_eff;
+ var_type_eff = type_eff_to_type_eff_ext t_eff;
+ var_clock_eff = c_eff;
}
in
Hashtbl.add local_env.lenv_types id t_eff;
Hashtbl.add local_env.lenv_vars id vi_eff;
- id,t_eff
+ vi_eff
+ in
+ let compare_clock v1 v2 =
+ (* v1 is smaller than v2 if it is clocked by v2. This
+ is used to sort out the var list and make sure that,
+ if v1 is clocked by v2, v2 is handled before. *)
+ let v1_clk = (Hashtbl.find vars.vartable v1).it.var_clock in
+ match v1_clk with
+ | Base -> -1
+ | NamedClock {it=id1} -> if v2 = id1 then 1 else -1
in
- let inlist = List.map type_args vars.inlist
- and outlist = List.map type_args vars.outlist
+ let vars_in_sorted = List.sort (compare_clock) vars.inlist
+ and vars_out_sorted = List.sort (compare_clock) vars.outlist in
+ let inlist = List.map type_args vars_in_sorted
+ and outlist = List.map type_args vars_out_sorted
and loclist =
match vars.loclist with
| None -> None
- | Some loclist -> Some (List.map type_args loclist)
+ | Some loclist ->
+ Some (List.map type_args (List.sort (compare_clock) loclist))
in
- let aux (id,t)= (id, type_eff_to_type_eff_ext t) in
{
node_key_eff = nk;
- inlist_eff = List.map aux inlist;
- outlist_eff = List.map aux outlist;
+ inlist_eff = inlist;
+ outlist_eff = outlist;
loclist_eff = loclist;
- clock_inlist_eff = [];(* XXX finish me! *)
- clock_outlist_eff = [];(* XXX finish me! *)
def_eff = node_def_eff ();
has_mem_eff = node_def.it.has_mem;
is_safe_eff = node_def.it.is_safe;
@@ -603,33 +607,20 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
(* builds a node that calls the aliased node. It looks like:
node alias_node( ins ) returns ( outs );
let
- outs = aliased_node(ins);
+ outs = aliased_node(ins);
tel
*)
- let lxm = Lxm.dummy "aliasing a node" (* more info? *) in
let (outs:left_eff list) =
- List.map
- (fun (id, te) ->
- let var_info_eff = {
- var_name_eff = id ;
- var_nature_eff = VarOutput ;
- var_type_eff =
- try type_eff_ext_to_type_eff te with _ ->
- raise (Compile_error (
- lxm, "Cannot alias overloaded or polymorphic operator"))
- }
- in
- LeftVarEff (var_info_eff, lxm)
- )
- aliased_node.outlist_eff
+ List.map (fun vi -> LeftVarEff (vi, lxm)) aliased_node.outlist_eff
and (aliased_node_call : val_exp_eff) =
CallByPosEff(
(Lxm.flagit (CALL_eff(Lxm.flagit aliased_node lxm)) lxm,
OperEff
(List.map
- (fun (id, _te) -> (* build operands*)
+ (fun vi -> (* build operands*)
CallByPosEff(
- Lxm.flagit (IDENT_eff (Ident.to_idref id)) lxm, OperEff [])
+ Lxm.flagit (IDENT_eff
+ (Ident.to_idref vi.var_name_eff)) lxm, OperEff [])
)
aliased_node.inlist_eff)))
in
@@ -692,8 +683,8 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
|IDENT_n _|ARRAY_n|HAT_n|CONCAT_n|WITH_n|TUPLE_n|WHEN_n
|CURRENT_n|FBY_n|ARROW_n|PRE_n)
->
- (* does it make sense to alias when, pre, etc? *)
- assert false
+ raise (Compile_error (lxm, "can not alias this operator, sorry"))
+ (* does it make sense to alias when, pre, etc? *)
in
let alias_node = make_alias_node aliased_node in
(* Check that the declared profile (if any) matches with the alias *)
diff --git a/src/parser.mly b/src/parser.mly
index 415e6dadc84858f0ba62860659e6c27aacc8ee3b..95e66ceeedcb0a48540ef7df3c36ad335858cc71 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -987,7 +987,7 @@ sxVarDecl:
*/
sxTypedIdents
{
- ([$1], BaseClock)
+ ([$1], Base)
}
|
/*
diff --git a/src/predefEvalClock.ml b/src/predefEvalClock.ml
index 78270764bb00370e75bb21e81f17a2e1b1b8eb01..511a9be2aab6f6919adb7e47714fed1e0059f81f 100644
--- a/src/predefEvalClock.ml
+++ b/src/predefEvalClock.ml
@@ -1,28 +1,30 @@
-(** Time-stamp: <modified the 26/05/2008 (at 14:57) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/06/2008 (at 11:11) by Erwan Jahier> *)
open Predef
open CompiledData
-let finish_me msg = print_string ("\n\tXXX predefSemantics.ml:"^msg^" -> finish me!\n")
-
type clocker = CompiledData.clock_eff Predef.evaluator
let (aa_clocker: clocker) =
function
| [clk1] -> clk1
- | _ -> finish_me "a good error msg"; assert false
+ | _ -> print_string "a good error msg"; assert false
let (aaa_clocker: clocker) =
function
| [clk1; clk2] ->
- if clk1 = clk2 then clk1 else (finish_me "a good error msg"; assert false)
+ if clk1 = clk2 then clk1 else (print_string "a good error msg"; assert false)
| _ ->
- finish_me "a good error msg"; assert false
+ print_string "a good error msg"; assert false
+
+
+(** A few useful clock profiles *)
+(* let bb_profile = [(id "i", b)], [(id "o", b)] *)
(* This table contains the clock profile of predefined operators *)
-let (clocking_tab: op -> clocker) =
+let (f: op -> clocker) =
fun op ->
assert false
diff --git a/src/predefEvalClock.mli b/src/predefEvalClock.mli
index 947d39c55b187bdd53ee57dae82e1acb53108b68..8e5618234b786f60443baf1669c7a3fedef1a69e 100644
--- a/src/predefEvalClock.mli
+++ b/src/predefEvalClock.mli
@@ -1,3 +1,4 @@
-(** Time-stamp: <modified the 26/05/2008 (at 14:57) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/06/2008 (at 11:01) by Erwan Jahier> *)
type clocker = CompiledData.clock_eff Predef.evaluator
+
diff --git a/src/predefEvalType.ml b/src/predefEvalType.ml
index f155c33e07b1af921e590dcc9fa7dc6a114c6983..ffd0ea1901282c892dcb010653fb06e4ca6c9cc2 100644
--- a/src/predefEvalType.ml
+++ b/src/predefEvalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 05/06/2008 (at 10:42) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/06/2008 (at 17:03) by Erwan Jahier> *)
open Predef
open SyntaxTreeCore
@@ -11,9 +11,11 @@ open Unify
(* exported *)
type typer = type_eff Predef.evaluator
+(* exported *)
exception EvalType_error of string
+(* exported *)
let (type_error : type_eff list -> string -> 'a) =
fun tel expect ->
let str_l = List.map CompiledDataDump.string_of_type_eff tel in
@@ -70,10 +72,9 @@ let ooo_profile = [(id "i1",Overload);(id "i2",Overload)], [(id "o",Overload)]
(** iterators profiles *)
(* [type_to_array_type [x1;...;xn] c] returns the array type [x1^c;...;xn^c] *)
-let (type_to_array_type:
- (Ident.t * type_eff_ext) list -> int -> (Ident.t * type_eff_ext) list) =
+let (type_to_array_type: var_info_eff list -> int -> (Ident.t * type_eff_ext) list) =
fun l c ->
- List.map (fun (id, teff) -> id, Array_type_eff_ext(teff,c)) l
+ List.map (fun vi -> vi.var_name_eff, Array_type_eff_ext(vi.var_type_eff,c)) l
(* Extract the node and the constant from a list of static args *)
let (get_node_and_constant:static_arg_eff list -> node_exp_eff * int)=
@@ -96,6 +97,7 @@ let map_profile =
let lto = type_to_array_type n.outlist_eff c in
(lti, lto)
+let get_id_type vi = vi.var_name_eff, vi.var_type_eff
let fillred_profile =
(* Given
@@ -108,8 +110,10 @@ let fillred_profile =
fun lxm sargs ->
let (n,c) = get_node_and_constant sargs in
let _ = assert(n.inlist_eff <> [] && n.outlist_eff <> []) in
- let lti = (List.hd n.inlist_eff)::type_to_array_type (List.tl n.inlist_eff) c in
- let lto = (List.hd n.outlist_eff)::type_to_array_type (List.tl n.outlist_eff) c in
+ let lti = (get_id_type (List.hd n.inlist_eff))::
+ type_to_array_type (List.tl n.inlist_eff) c in
+ let lto = (get_id_type (List.hd n.outlist_eff))::
+ type_to_array_type (List.tl n.outlist_eff) c in
let (id1, t1) = List.hd lti and (id2, t2) = List.hd lto in
if t1 = t2 then (lti,lto) else
(* if they are not equal, they migth be unifiable *)
@@ -194,13 +198,19 @@ let (make_node_exp_eff : op -> Lxm.t -> static_arg_eff list -> node_exp_eff) =
(Ident.pack_name_of_string "Lustre") (Ident.of_string (Predef.op2string op))
in
let (lti,lto) = op2profile op lxm sargs in
+ let to_var_info_eff nature (id, te) =
+ {
+ var_name_eff = id;
+ var_nature_eff = nature;
+ var_type_eff = te;
+ var_clock_eff = BaseEff;
+ }
+ in
{
node_key_eff = id,sargs ;
- inlist_eff = lti;
- outlist_eff = lto;
+ inlist_eff = List.map (to_var_info_eff VarInput) lti;
+ outlist_eff = List.map (to_var_info_eff VarOutput) lto;
loclist_eff = None;
- clock_inlist_eff = [];
- clock_outlist_eff = [];
def_eff = ExternEff;
has_mem_eff = false;
is_safe_eff = true;
@@ -232,8 +242,8 @@ let (f : op -> Lxm.t -> CompiledData.static_arg_eff list -> typer) =
| _ ->
(* general case *)
let node_eff = make_node_exp_eff op lxm sargs in
- let lti = List.map (fun (id,t) -> t) node_eff.inlist_eff
- and lto = List.map (fun (id,t) -> t) node_eff.outlist_eff in
+ let lti = List.map (fun v -> v.var_type_eff) node_eff.inlist_eff
+ and lto = List.map (fun v -> v.var_type_eff) node_eff.outlist_eff in
let rec (subst_type : type_eff -> type_eff_ext -> type_eff) =
fun t teff_ext -> match teff_ext with
(* substitutes [t] in [teff_ext] *)
diff --git a/src/syntaxTreeCore.ml b/src/syntaxTreeCore.ml
index 424ab2a5685bfa041f55ba965b0380005498ed46..bb0e67c146d6ac992b0531a0ee691f6cd415290c 100644
--- a/src/syntaxTreeCore.ml
+++ b/src/syntaxTreeCore.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 02/06/2008 (at 16:27) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/06/2008 (at 16:09) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source programs. *)
@@ -8,9 +8,9 @@ open Lxm
(**********************************************************************************)
type clock_exp =
- | BaseClock
- | NamedClock of Ident.t (* XXX should be Ident.idref !!!*) srcflagged
-
+ | Base
+ | NamedClock of Ident.t srcflagged
+
(**********************************************************************************)
(** [type_exp] is used to type flow, parameters, constants. *)
type type_exp = type_exp_core srcflagged
@@ -40,7 +40,6 @@ and static_param =
and node_vars = {
inlist : Ident.t list;
-
outlist : Ident.t list;
loclist : Ident.t list option; (* abstract/ext node have no body *)
vartable: var_info_table;
diff --git a/src/syntaxTreeDump.ml b/src/syntaxTreeDump.ml
index b4701b374c3b3a8d6f57fdf84ccd2479b94707a8..09207f6ce71349415734c21da1402c1017576b4e 100644
--- a/src/syntaxTreeDump.ml
+++ b/src/syntaxTreeDump.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/05/2008 (at 10:12) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/06/2008 (at 11:10) by Erwan Jahier> *)
open Lxm
@@ -287,7 +287,7 @@ and dump_var_decl (os: Format.formatter) (vinfo: var_info ) = (
fprintf os "%s : %a" (Ident.to_string vinfo.var_name) dump_type_exp vinfo.var_type ;
(
match vinfo.var_clock with
- BaseClock -> ()
+ Base -> ()
| NamedClock {it=id;src=lxm} -> (fprintf os " when %s" (Ident.to_string id))
)
)
diff --git a/src/test/should_fail/semantics/bad_call03.lus b/src/test/should_fail/semantics/bad_call03.lus
index 74fed80cd2b9e7c71c5e6336fd10d013896b8a18..38dd232b498204ca3e891d4883590866c0ba904f 100644
--- a/src/test/should_fail/semantics/bad_call03.lus
+++ b/src/test/should_fail/semantics/bad_call03.lus
@@ -3,14 +3,11 @@ node toto = map<<+, 3>>;
node titi(c,d:real^3)returns(y:real^3);
let
- y = toto(c,d);
+ y = toto(c,d);
tel
-node bad_call03(
- a,b:int^3; c,d:real^3
-) returns (x : int^3; y:real^3
-);
+node bad_call03(a,b:int^3; c,d:real^3) returns (x : int^3; y:real^3);
let
- x = toto(a,b);
- y = titi(c,d);
+ x = toto(a,b);
+ y = titi(c,d);
tel
diff --git a/src/test/should_work/NONREG/PCOND.lus b/src/test/should_work/NONREG/PCOND.lus
index 638d971a00d6ae6dfcd1c7481758a5fd8a63ae32..a11cffdb9ed93ba622484647a211b95fc5e5ac8a 100644
--- a/src/test/should_work/NONREG/PCOND.lus
+++ b/src/test/should_work/NONREG/PCOND.lus
@@ -1,6 +1,11 @@
-node PCOND( h0:bool; hA,hB,hC:bool when h0;
-A:int when hA; B:int when hB; C:bool when hC;
- hD:bool when hC; D:bool when hD)
+node PCOND(
+ h0:bool;
+ hA,hB,hC:bool when h0;
+ A:int when hA;
+ B:int when hB;
+ C:bool when hC;
+ hD:bool when hC;
+ D:bool when hD)
returns (hX:bool when h0; X:int when hX);
let
hX = hC and current(hD) and ( ( hA and
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index 40db3a490c1558b926d8251a5da2b09a496cfc48..192a254587d8a7d8dbc546cd9b68d34f4a5af1ff 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -23,7 +23,7 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-node CURRENT__CURRENT(x:bool; y:bool) returns (z:bool);
+node CURRENT__CURRENT(x:bool; y:bool when x) returns (z:bool when x);
let
z = y;
tel
@@ -128,17 +128,17 @@ End of Syntax table dump.
node PCOND__PCOND(
h0:bool;
- hA:bool;
- hB:bool;
- hC:bool;
- A:int;
- B:int;
- C:bool;
- hD:bool;
- D:bool)
-returns (
- hX:bool;
- X:int);
+ hA:bool when h0;
+ hB:bool when h0;
+ hC:bool when h0;
+ A:int when hA when h0;
+ B:int when hB when h0;
+ C:bool when hC when h0;
+ hD:bool when hC when h0;
+ D:bool when hD when hC when h0)
+returns (
+ hX:bool when h0;
+ X:int when hX when h0);
let
hX = ((hC and current (hD)) and ((hA and current (current (D))) or (hB and
not(current (current (D))))));
@@ -173,16 +173,16 @@ End of Syntax table dump.
node PCOND1__PCOND1(
h0:bool;
- hA:bool;
- hB:bool;
- hC:bool;
- A:int;
- B:int;
- C:bool;
- hD:bool;
- D:bool)
+ hA:bool when h0;
+ hB:bool when h0;
+ hC:bool when h0;
+ A:int when hA when h0;
+ B:int when hB when h0;
+ C:bool when hC when h0;
+ hD:bool when hC when h0;
+ D:bool when hD when hC when h0)
returns (
- hX:bool);
+ hX:bool when h0);
let
hX = ((hC and current (hD)) and h0 when h0);
tel
@@ -841,7 +841,14 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-node X__X(c:bool; n:int) returns (d:bool; m:int; p:int);
+
+node X__X(
+ c:bool;
+ n:int when c)
+returns (
+ d:bool;
+ m:int when c;
+ p:int when d);
let
m = 0 when c -> (pre(m) + n);
d = (c and (current (m) <= 10));
@@ -932,12 +939,12 @@ End of Syntax table dump.
Exported nodes:
node X3__X3(n:int; b:bool) returns (m:int);
var
- c:bool;
- d:bool;
- p:int;
- u:int;
- q:int;
- r:int;
+ c:bool when b;
+ d:bool when c when b;
+ p:int when b;
+ u:int when b;
+ q:int when c when b;
+ r:int when c when b;
let
c = (p >= 0 when b);
p = n when b;
@@ -978,12 +985,12 @@ node X6__X6(
b:bool)
returns (
m:int;
- c:bool;
- d:bool;
- p:int;
- u:int;
- q:int;
- r:int);
+ c:bool when b;
+ d:bool when c when b;
+ p:int when b;
+ u:int when b;
+ q:int when c when b;
+ r:int when c when b);
let
c = (p >= 0 when b);
p = n when b;
@@ -1550,7 +1557,13 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-node ck2__ck2(c:bool; d:bool; e:int) returns (n:int);
+
+node ck2__ck2(
+ c:bool;
+ d:bool when c;
+ e:int when d when c)
+returns (
+ n:int);
let
n = if ((c and current (d))) then (0) else (current (current (e)));
tel
@@ -1579,7 +1592,13 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-node ck3__ck3(a:bool; b:bool; c:bool) returns (x:bool);
+
+node ck3__ck3(
+ a:bool;
+ b:bool when a;
+ c:bool when b when a)
+returns (
+ x:bool);
let
x = current (current (c));
tel
@@ -1608,7 +1627,7 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-node ck4__ck4(a:int; b:bool) returns (c:int);
+node ck4__ck4(b:bool; a:int when b) returns (c:int);
let
c = current (a);
tel
@@ -1675,7 +1694,7 @@ End of Syntax table dump.
Exported constants:
Exported nodes:
extern function ck6__p(d:int) returns (e:int; f:int);
-node ck6__N(a:bool; m:int; n:int) returns (q:int; r:int);
+node ck6__N(a:bool; m:int; n:int) returns (q:int; r:int when a);
let
q = (m + n);
r = q when a;
@@ -1683,11 +1702,11 @@ tel
-- end of node ck6__N
node ck6__ck6(b:bool; c:bool; n:int; m:int) returns (k:int; l:int);
var
- u:int;
- v:int;
- w:int;
- x:int;
- cc:bool;
+ u:int when b;
+ v:int when b;
+ w:int when b;
+ cc:bool when b;
+ x:int when cc when b;
let
(u, v) = ck6__p(n when b);
(w, x) = ck6__N(cc, u, v);
@@ -1720,7 +1739,7 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-node ck7__ck7(a:bool; m:int; n:int) returns (q:int; r:int);
+node ck7__ck7(a:bool; m:int; n:int) returns (q:int; r:int when a);
let
q = (m + n);
r = q when a;
@@ -1755,31 +1774,10 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-extern node clock__inOnOut(b:bool; a:bool) returns (c:bool);
-extern node clock__outOnIn(b:bool; a:bool) returns (c:bool);
-extern node clock__inOnIn(b:bool; a:bool) returns (c:bool);
-extern node clock__outOnOut(b:bool; a:bool) returns (d:bool; c:bool);
-extern node clock__all(b:bool; a:bool) returns (d:bool; c:bool);
-node clock__clock(in:bool) returns (ok:bool);
-var
- v1:bool;
- v2:bool;
- v3:bool;
- v4:bool;
- v5:bool;
- v6:bool;
- v7:bool;
-let
- v1 = clock__inOnIn(in, true when in);
- v2 = in when v4;
- v3 = clock__outOnIn(in, v1);
- (v4, v5) = clock__outOnOut(pre(v4), pre(v4));
- (v6, v7) = clock__all(v4, v5);
- ok = boolred<<const 3, const 3, const 7>>([v1, current (v2), current (v3),
- v4, current (v5), current (current (v6)), current (current (current
- (v7)))]);
-tel
--- end of node clock__clock
+*** Error in file "should_work/NONREG/clock.lus", line 21, col 46 to 46, token 'c':
+*** 'c': Unknown variable.
+*** Current variables are:
+
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/NONREG/cminus.lus
@@ -2485,18 +2483,18 @@ const hanane__c = 3.140000;
node hanane__hanane(
a1:bool;
- b1:int^4^4;
+ b1:int^4^4 when a1;
c1:hanane::structT {x : int;
y : real;
- z : int^4^4^4}^2)
+ z : int^4^4^4}^2 when a1)
returns (
- res:bool);
+ res:bool when a1);
var
h1:int^4;
h2:hanane::structT {x : int; y : real; z : int^4^4^4}^2;
- h3:int;
- h4:real;
- h5:int^4^4^4;
+ h3:int when a1;
+ h4:real when a1;
+ h5:int^4^4^4 when a1;
h6:int^4^4;
let
res = (h1[0] > 1) when a1;
@@ -3381,10 +3379,17 @@ let
s = (x + y);
tel
-- end of node multiclock__moyenne
-node multiclock__multiclock(x:int; y:int; c:bool; z:int) returns (s:int);
+
+node multiclock__multiclock(
+ x:int;
+ y:int;
+ c:bool;
+ z:int when c)
+returns (
+ s:int when c);
var
- h:bool;
- u:int;
+ h:bool when c;
+ u:int when h when c;
let
h = true when c -> ((x + y) when c < z);
u = z when h -> multiclock__moyenne(z when h, pre(u));
@@ -7119,14 +7124,20 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-extern node clock__clock2(v:bool; u:bool) returns (y:bool);
-extern node clock__clock3(u:bool) returns (y:bool; x:bool);
-extern node clock__clock4(v:bool; u:bool) returns (y:bool; x:bool);
-node clock__clock(a:bool; b:bool) returns (c:bool; d:bool);
+extern node clock__clock2(u:bool; v:bool when u) returns (y:bool);
+extern node clock__clock3(u:bool) returns (x:bool; y:bool when x);
+
+extern node clock__clock4(
+ u:bool;
+ v:bool when u)
+returns (
+ x:bool;
+ y:bool when x);
+node clock__clock(a:bool; b:bool) returns (c:bool; d:bool when c);
var
z:bool;
- x:bool;
- y:bool;
+ x:bool when z;
+ y:bool when x when z;
let
y = clock__clock2(a, b when a) when x;
(z, x) = clock__clock3(pre(z));
@@ -7174,7 +7185,7 @@ node clock1_2ms__clock1_2ms(
dummy:bool)
returns (
Clock1ms:bool;
- Clock2ms:bool);
+ Clock2ms:bool when Clock1ms);
let
Clock1ms = clock1_2ms__Clock1ms_node(dummy);
Clock2ms = clock1_2ms__Clock2ms_node(dummy when Clock1ms);
@@ -7424,19 +7435,19 @@ const def__c = 3.140000;
node def__def(
a1:bool;
- b1:int^4^4;
+ b1:int^4^4 when a1;
c1:def::structT {x : int;
y : real;
- z : int^4^4^4}^2;
+ z : int^4^4^4}^2 when a1;
d1:int^23)
returns (
- res:bool);
+ res:bool when a1);
var
h1:int^4;
h2:def::structT {x : int; y : real; z : int^4^4^4}^2;
- h3:int;
- h4:real;
- h5:int^4^4^4;
+ h3:int when a1;
+ h4:real when a1;
+ h5:int^4^4^4 when a1;
h6:int^4^4;
let
res = (pre(h1[0]) > 0) when a1;
@@ -7514,15 +7525,15 @@ tel
node filliter__filliter(
c:bool;
- i1:int;
- i2:int)
+ i1:int when c;
+ i2:int when c)
returns (
- s1:int^3;
- s2:int^3);
+ s1:int^3 when c;
+ s2:int^3 when c);
var
- x:int^4;
- bid1:int;
- bid2:int;
+ x:int^4 when c;
+ bid1:int when c;
+ bid2:int when c;
let
s1 = x[0..2];
(bid1, x) = fill<<node filliter__copie, const 4>>(i1);
@@ -7624,8 +7635,8 @@ node lustre_test1_ok__lustre_test1_ok(
cl1_2:bool;
cl1_4:bool;
In2:real;
- cl2_6:bool;
- In3:bool)
+ cl2_6:bool when cl1_2;
+ In3:bool when cl1_4)
returns (
out1:real;
Out2:real;
@@ -7633,13 +7644,13 @@ returns (
var
Sum:real;
Unit_Delay1:real;
- zoh1:real;
- zoh2:real;
- subsys1_Trigger:bool;
- subsys1_s1:real;
- subsys1_s2:real;
- Unit_Delay1_:real;
- Out2_:real;
+ zoh1:real when cl1_4;
+ zoh2:real when cl2_6 when cl1_2;
+ subsys1_Trigger:bool when cl1_4;
+ subsys1_s1:real when cl1_4;
+ subsys1_s2:real when cl1_4;
+ Unit_Delay1_:real when cl1_2;
+ Out2_:real when cl1_2;
let
Sum = (In1 + Unit_Delay1);
Unit_Delay1_ = if (cl2_6) then (current (zoh2)) else (0.0 when cl1_2 ->
@@ -8087,12 +8098,12 @@ tel
node sample_time_change__sample_time_change(
cl1_4_2:bool;
cl1_12_3:bool;
- In3:real)
+ In3:real when cl1_12_3)
returns (
- Out2:real);
+ Out2:real when cl1_4_2);
var
- Unit_Delay1:real;
- Unit_Delay2:real;
+ Unit_Delay1:real when cl1_12_3;
+ Unit_Delay2:real when cl1_4_2;
let
Unit_Delay1 = 0.0 when cl1_12_3 -> pre(In3);
Unit_Delay2 = 0.0 when cl1_4_2 -> pre(Unit_Delay2);
@@ -8103,7 +8114,7 @@ node sample_time_change__MainNode(In3:real) returns (Out2:real);
var
cl1_4_2:bool;
cl1_12_3:bool;
- Out2_:real;
+ Out2_:real when cl1_4_2;
let
cl1_4_2 = sample_time_change__make_cl1_4_2(true);
cl1_12_3 = sample_time_change__make_cl1_12_3(true);
@@ -8136,7 +8147,7 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-node bob__bob(i:bool) returns (o:bool);
+node bob__bob(i:bool) returns (o:bool when i);
let
assert(true -> (i <> pre(i)));
o = true -> pre(false -> pre(i)) when i;
@@ -10301,7 +10312,7 @@ End of Syntax table dump.
Exported nodes:
node toto__toto(a:bool; b:bool) returns (x:bool);
var
- c:bool;
+ c:bool when b;
let
c = a when b;
x = current (current (a when b when c));
@@ -14123,14 +14134,20 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-extern node clock__clock2(v:bool; u:bool) returns (y:bool);
-extern node clock__clock3(u:bool) returns (y:bool; x:bool);
-extern node clock__clock4(v:bool; u:bool) returns (y:bool; x:bool);
-node clock__clock(a:bool; b:bool) returns (c:bool; d:bool);
+extern node clock__clock2(u:bool; v:bool when u) returns (y:bool);
+extern node clock__clock3(u:bool) returns (x:bool; y:bool when x);
+
+extern node clock__clock4(
+ u:bool;
+ v:bool when u)
+returns (
+ x:bool;
+ y:bool when x);
+node clock__clock(a:bool; b:bool) returns (c:bool; d:bool when c);
var
z:bool;
- x:bool;
- y:bool;
+ x:bool when z;
+ y:bool when x when z;
let
y = clock__clock2(a, b when a) when x;
(z, x) = clock__clock3(z);
@@ -14284,8 +14301,14 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-*** Error in file "should_fail/semantics/bad_call03.lus", line 0, col 0 to 0, token 'aliasing a node': Cannot alias overloaded or polymorphic operator
+function bad_call03__toto(i1:o^3; i2:o^3) returns (o:o^3);
+let
+ o = Lustre__map<<node Lustre__+, const 3>>(i1, i2);
+tel
+-- end of node bad_call03__toto
+*** oops: an internal error occurred in file evalType.ml, line 38, column 39
+*** when compiling lustre program should_fail/semantics/bad_call03.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_fail/semantics/bug.lus