Merge /home/raymond/git/lus2lic into u0

src/parser.mly

@@ -453,24 +453,37 @@ TypedValuedIdent :
 
 /* constantes */
 
-ConstDecl: TK_CONST ConstDeclList {} ;
+ConstDecl: TK_CONST ConstDeclList {
+	treat_const_decl_list $2
+} ;
 
 ConstDeclList: 
- | OneConstDecl TK_SEMICOL {}
- | ConstDeclList OneConstDecl TK_SEMICOL {} ;
-
+ | OneConstDecl TK_SEMICOL {
+		$1
+	}
+ | ConstDeclList OneConstDecl TK_SEMICOL {
+		$1 @ $2
+	}
+ ;
+
+/* Retourne une liste (lxm, const_info) */
 OneConstDecl: 
-/* Les listes d'idents en partie gauche sont 
-   acceptes pour les constantes externes : */
- | Ident TK_COLON Type { (treat_external_const_list [$1] $3 ) }
- | Ident TK_COMA IdentList TK_COLON Type 
-{ (treat_external_const_list ($1::(List.rev $3)) $5) }
+/* Les listes d'idents en partie gauche sont acceptées
+	pour les constantes externes : */
+ | Ident TK_COLON Type {
+		(make_external_const_list [$1] $3 ) 
+	}
+ | Ident TK_COMA IdentList TK_COLON Type {
+		(make_external_const_list ($1::(List.rev $3)) $5)
+	}
 /* Mais pas pour les constantes dfinies : */
-|  Ident TK_COLON Type TK_EQ Expression
-{ (treat_defined_const $1 (Some $3) $5)  }
-|  Ident TK_EQ Expression
-                        { (treat_defined_const $1 (None) $3 ) }
-        ; 
+ |  Ident TK_COLON Type TK_EQ Expression {
+		[ (make_defined_const $1 (Some $3) $5) ]
+	}
+ |  Ident TK_EQ Expression {
+		[ (make_defined_const $1 (None) $3 ) ]
+	}
+; 
 
 
 /* types */
@@ -539,10 +552,10 @@ NodeDecl: LocalNode {};
 
 LocalNode:
 | TK_NODE Ident StaticParams Params TK_RETURNS Params OptSemicol
-                Locals Body OptEndNode
+                 LocalDecls Body OptEndNode
         { treat_node_decl true $2 $3 $4 $6 $8 (fst $9) (snd $9) }
 | TK_FUNCTION Ident StaticParams Params TK_RETURNS Params OptSemicol
-                 Locals Body OptEndNode
+                 LocalDecls Body OptEndNode
         { treat_node_decl false $2 $3 $4 $6 $8 (fst $9) (snd $9) }
 | TK_NODE Ident StaticParams NodeProfileOpt TK_EQ EffectiveNode OptSemicol 
         { treat_node_alias true $2 $3 $4 $6 } ;
@@ -624,13 +637,49 @@ Params:
                         { (List.rev $2) }
         ;
 
+/* Déclarations ocales(2010/07/02)
+concret: liste de var(s) ou const
+abstrait: couple liste de vars * list de consts
+*/
+LocalDecls:
+	/* nada */
+	{ ([],[]) }
+|	LocalDeclList
+	{ $1 }
+;
+
+LocalDeclList:
+	OneLocalDecl
+		{ $1 }
+|  LocalDeclList OneLocalDecl
+		{
+			match ($1,$2) with
+			|	( (vl1, cl1) , (vl2, cl2)) ->
+				( vl2 @ vl1, cl2 @ cl1)
+		}
+;
+
+OneLocalDecl:
+	LocalVars
+		{ ($1, []) }
+|	LocalConsts
+		{ ([], $1) }
+;
+
+/* Déclaration de constantes locale (2010/07/02)
+uniquement des constantes définies
+*/
+LocalConsts:
+TK_CONST ConstDeclList
+	{ $2 }
+;
+
 /* variables locales */
-Locals:       /* empty */
-                        { [] }
-        |    TK_VAR VarDeclList TK_SEMICOL
-                  /* WARNING ! il faut remettre la liste  l'endroit */
-                        { (List.rev $2) }
-        ;
+LocalVars:
+	TK_VAR VarDeclList TK_SEMICOL
+	/* WARNING ! il faut remettre la liste  l'endroit */
+	{ (List.rev $2) }
+;
 
 
 /* liste de dclarations de vars types et clockes */

src/parserUtils.ml

@@ -227,6 +227,22 @@ let id_valopt_list_of_id_list (idlist : Lxm.t list) (texp : type_exp) =
 let id_valopt_of_id_val (id : Lxm.t) (texp : type_exp) (vexp : val_exp) = (* -> unit *)
   (id, texp, Some vexp)
 
+
+let make_external_const_list lst typ = (* -> (lxm * const_info) list *)
+  let f = function lxm -> (lxm,  (ExternalConst ((Lxm.id lxm), typ, None)))
+  in List.map f lst
+
+let make_defined_const lxm typ exp = (* -> (lxm * const_info) *)
+	(lxm, (DefinedConst ((Lxm.id lxm) , typ, exp)))
+
+let treat_const_decl_list clst =
+  let f = function (lxm, cinfo) ->
+    add_info const_table "constant" lxm cinfo;
+    def_list := (ConstItem (Lxm.id lxm)) :: !def_list
+  in 
+    List.iter f clst
+
+(* obsolete 
 let treat_external_const_list lst typ = (* -> unit *)
   let f = function lxm ->
     add_info const_table "constant" lxm (ExternalConst ((Lxm.id lxm), typ, None));
@@ -238,6 +254,7 @@ let treat_external_const_list lst typ = (* -> unit *)
 let treat_defined_const lxm typ exp = (* -> unit *)
   add_info const_table "constant" lxm (DefinedConst ((Lxm.id lxm) , typ, exp));
   def_list := (ConstItem (Lxm.id lxm)) :: !def_list
+*)
 
 let treat_external_type_list lxmlst = (* -> unit *)
   let f = function lxm ->
@@ -246,7 +263,6 @@ let treat_external_type_list lxmlst = (* -> unit *)
   in
     List.iter f lxmlst 
 
-
 let treat_aliased_type lxm typexp = (*  -> unit *)
   add_info type_table "type" lxm (AliasedType ((Lxm.id lxm), typexp));
   def_list := (TypeItem (Lxm.id lxm)) :: !def_list
@@ -339,15 +355,22 @@ let (clocked_ids_to_var_infos : var_nature ->
 
 
 (**********************************************************************************)
+(*
+2010/07/02
+les dclarations locales comportent :
+- une liste de vars * une liste de consts
+*)
 let (treat_node_decl : bool -> Lxm.t -> static_param srcflagged list -> 
       clocked_ids list (* entres *) -> 
       clocked_ids list (* sorties *) -> 
-      clocked_ids list (* locales *) -> 
+      (* clocked_ids list (* locales *) ->  *)
+		(clocked_ids list * (Lxm.t * const_info) list) ->
       (val_exp srcflagged) list (* assserts *) -> 
       (eq_info srcflagged) list (* liste des equations *) -> 
       unit
     ) =
-  fun has_memory nlxm statics indefs outdefs locdefs asserts eqs -> 
+  fun has_memory nlxm statics indefs outdefs locdecls asserts eqs -> 
+    let (locdefs, locconsts) = locdecls in
     let vtable = Hashtbl.create 50 in
     let rec (treat_vars : clocked_ids list -> var_nature -> var_info srcflagged list) =
       (* Procedure de traitement des in, out ou loc, paramtre par la [var_nature] *)

src/syntaxTreeCore.ml

@@ -27,6 +27,7 @@ and node_info = {
   name    : Ident.t;
   static_params : static_param srcflagged list;
   vars    : node_vars option;  (* aliased node may have no i/o decl *)
+  (* consts  : ICI A FAIRE *)
   def     : node_def;
   has_mem : bool;
   is_safe : bool;

src/test/Makefile

@@ -91,7 +91,7 @@ errors:errors_nb
 
 
 test_ec: 
-	rm test_ec.res
+	rm -f test_ec.res
 	for d in ${OK_LUS}; do \
 		echo -e "\n$(NL)====> $(LC) -ec $$d -o /tmp/xx.ec" >> test_ec.res; \
 		$(LC0) -ec $$d -o /tmp/xx.ec >> test_ec.res 2>&1 ;\

src/test/should_fail/clock/when_enum.lus

+
+
+type t = enum {A,  B,  C};
+
+node clock(a : t ; b,  c: bool) returns (x: bool when a; y: bool when a);
+var
+  clk :  bool;
+let 
+  clk = tutu(a);
+  (x, y) = toto(b when clk, c when A(a)); -- clock error !
+
+tel
+
+
+extern node toto(u: bool; v: bool) returns (x: bool; y: bool);
+extern node tutu(u: t) returns (x: bool);
+

src/test/should_fail/type/packages.lus

+-----------------------------
+-- modSimple: un model simple 
+--    * necessite : un type
+--    * fournit : un noeud 
+----------------------------
+model modSimple
+  needs type t;
+  provides
+    node fby1(init, fb: t) returns (next: t);
+body
+  node fby1(init, fb: t) returns (next: t);
+  let
+    next = init -> pre fb;
+  tel
+end
+
+-----------------------
+-- qq instances de modSimple
+-----------------------
+package pint is modSimple(t=int);
+package pbool is modSimple(t=bool);
+package preal is modSimple(t=real);
+
+
+--------------------------
+-- un package intermediaire
+-------------------------
+package inter
+  uses pbool, pint, preal;
+  provides 
+    node preced(in: int) returns (out, out2: selType);
+    const n : int;
+    type selType;
+body
+   
+  type selType = { i: int; b: bool; r: real };
+
+  -----------------------
+  -- qq instances de modSimple
+  -----------------------
+   --package pint is modSimple(int);
+   --package pbool is modSimple(bool);
+   --package preal is modSimple(real);
+
+   --package pSel is modSimple( { i: int; b: bool; r: real } );
+        
+	const n: int = -4;
+	node preced(in: selType) returns (out, out2: selType);
+	let
+                out2 = selType { i = 0; b = true; r = 0.}; --pSel::fby1(in);
+  		out.i = pint::fby1(out2.i, in.i);
+  		out.b = pbool::fby1(out2.b, in.b);
+  		out.r = preal::fby1(out2.r, in.r);
+	tel 
+end
+---------------------------
+-- le package principal
+--------------------------
+package mainPack
+        uses inter;
+        provides 
+                node preced(in: inter::selType) returns (out: inter::selType); 
+body
+  
+     type  T = int^N;
+     const X = N;
+           N : int = -2 * inter::n;
+ 
+       -- node preced(in: bool) returns (out: bool);
+        node preced(in: inter::selType) returns (out: inter::selType);
+        var out2 : inter::selType;
+        let
+                out, out2 =  inter::preced( in );
+        tel 
+end
+

src/test/should_fail/type/parametric_node.lus

+
+
+node toto_n<<node f(a, b: int) returns (x: int); const n : int>>(a: int) 
+returns (x: int^n);
+var v : int;
+let
+  v = f(a, 1);
+  x =  v ^ n;
+tel
+
+node toto_3 = toto_n<<Lustre::iplus, 3.0>>;
+--                                  ^^^^ bad type here...

src/test/should_fail/type/parametric_node2.lus

+
+ 
+node toto_n<<node f(a, b: int) returns (x: real); const n : int>>(a: int) 
+--                                     ^^^^^^^^ should be an int
+returns (x: int^n);
+var v : int;
+let
+  v = f(a, 1);
+  x =  v ^ n;
+tel
+
+node toto_3 = toto_n<<Lustre::iplus, 3>>;
+

src/test/should_fail/type/parametric_node3.lus

+
+-- A node parametrized by a node
+
+node toto_n<<type t; const x: t; const n: int>>(a:t) 
+returns (res: t^n);
+let
+  res =  a ^ n;
+tel
+
+node toto_int3 = toto_n<<int, 3>>; -- one arg is missing
+

src/test/should_fail/type/parametric_node4.lus

+
+ 
+node toto_n<<node f(a, b: int) returns (x: int); const n : int>>(a: int) 
+returns (x: int^n);
+var v : int;
+let
+  v = f(a, 1);
+  x =  v ^ n;
+tel
+
+const x: real = 3.0;
+
+node toto_3 = toto_n<<Lustre::iplus, x>>;
+

src/test/should_work/NONREG/FALLING_EDGE.lus

+node FALLING_EDGE (X: bool) returns (Y: bool);
+let
+ Y = EDGE(not X);
+tel
+node EDGE (X: bool) returns (Y: bool); let Y = false -> X and not pre(X); tel -- del
\ No newline at end of file

src/test/should_work/NONREG/STABLE.lus

+node STABLE (set: bool; delay: int) returns (level: bool);
+var count: int;
+let
+  level = (count > 0);
+  count = 
+      if set then delay
+      else if false -> pre(level) then pre(count)-1
+      else 0;
+tel
\ No newline at end of file

src/test/should_work/NONREG/integrator.lus

+node integrator(F,STEP,init: real) returns (Y: real);
+let
+ Y = init -> pre(Y) + ((F + pre(F))*STEP)/2.0;
+tel

src/test/should_work/NONREG/param_node2.lus

+---- A node parametrized by a type and a constant
+node mk_tab<<type t; const init: t; const size: int>>
+       (a:t) returns (res: t^size);
+let
+  res =  init ^ size;
+tel ---
+node tab_int3 = mk_tab<<int, 0, 3>>; ---
+node tab_bool4 = mk_tab<<bool, true, 4>>;

src/test/should_work/NONREG/param_node3.lus

+---- A node parametrized by a type and a constant
+node mk_tab<<type t; const init: t; const size: int>>
+       (a:t) returns (res: t^size);
+let
+  res =  init ^ size;
+tel ---
+
+--node tab_int3 = mk_tab<<int, 0, 3>>; ---
+--node tab_bool4 = mk_tab<<bool, true, 4>>;
+
+
+node titi<<type t>>(a:t) returns (res: t^3);
+let
+  res = mk_tab<<t, 0, 3>>(a);
+tel
+
+node xxx = titi<<int>>
\ No newline at end of file

src/test/should_work/NONREG/param_node4.lus

+---- A node parametrized by a node and a const 
+node toto_n<<
+   node f(a, b: int) returns (x: int); 
+   const n : int
+  >>(a: int) returns (x: int^n);
+var v : int;
+let
+  v = f(a, 1);
+  x =  v ^ n;
+tel ---
+
+node monplus = Lustre::iplus;
+node toto_3 = toto_n<<monplus, 3>>;

src/test/should_work/NONREG/param_struct.lus

+--- A node parametrized by a constant structure
+node mk_tab<<type t; const init: t; const size: int>>
+       (a:t) returns (res: t^size);
+let
+  res =  init ^ size;
+tel
+
+type toto = struct  {a : int; b : int};
+const c = toto {a = 1; b=1 };
+
+node tab_toto = mk_tab<<toto, c, 3>>;

src/test/should_work/NONREG/speedcontrol.lus

+node speedcontrol(c:bool;) returns (counter:int);
+let
+ counter=(0)->f(counter);
+tel
+
+node f(x:int) returns (y:int;);
+let
+ y=0->pre(x)+1;
+tel

src/test/should_work/demo/mapinf.lus

+node mapinf (t1, t2: int^10) returns (res :  bool^10);
+let
+  res = map<< lt,  10>>(t1, t2);
+tel