Prepare a little bit the work for compiling node.

src/TODO

@@ -7,6 +7,8 @@ Question : dans syntaxTree.ml, comment marchent les by_name_op ?
 * autoriser le fait le pouvoir donner une valeur par defaut à une constante
  exportée. («provides const : n = 4; »)
 
+ * Here/NotHere -> à renommer.
+
 * LazyCompiler.do_node
 
 * lazyCompiler.ml: 

src/compiledData.ml

-(** Time-stamp: <modified the 12/02/2008 (at 10:18) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:43) by Erwan Jahier> *)
 
 (** 
 
@@ -115,8 +115,9 @@ N.B. On fournit les constructeurs des id_solver courants, voir :
 	const_and_type_id_solver
 ----------------------------------------------------------------------*)
 type id_solver = {
-	id2const : Ident.idref -> Lxm.t -> const_eff ;
-	id2type  : Ident.idref -> Lxm.t -> type_eff ;
+  id2const : Ident.idref -> Lxm.t -> const_eff ;
+  id2type  : Ident.idref -> Lxm.t -> type_eff ;
+  id2node  : Ident.idref -> static_arg_eff list -> Lxm.t -> node_eff ;
 }
 
 (*---------------------------------------------------------------------
@@ -269,6 +270,8 @@ and node_eff = {
   nf_out_types : type_eff list ;
   nf_in_formal_clocks  : int option list ;
   nf_out_formal_clocks : int option list ;
+  nf_asserts : val_eff list;
+  nf_eqs : eq_eff list;
 }
 (*---------------------------------------------------------------------
 Type : XXX_key
@@ -373,7 +376,7 @@ Utilitaire: const_and_type_id_solver
 Rôle :
 	comme son nom l'indique
 Entrées :
-	id2const, id2type	
+	id2const, id2type, id2node
 Sorties :
 	id_solver
 Effets de bord :
@@ -382,10 +385,12 @@ Effets de bord :
 let const_and_type_id_solver
     (i2c : Ident.idref -> Lxm.t -> const_eff)
     (i2t : Ident.idref -> Lxm.t -> type_eff)
+    (i2o : Ident.idref -> static_arg_eff list -> Lxm.t -> node_eff)
     = 
   {
     id2const = i2c ;
     id2type  = i2t ;
+    id2node  = i2o ;
   }
 
 (*---------------------------------------------------------------------

src/lazyCompiler.ml

-(** Time-stamp: <modified the 12/02/2008 (at 16:31) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:49) by Erwan Jahier> *)
 
 
 open Lxm
@@ -71,28 +71,45 @@ fun tbl ->
    types checking
    --------------
    (1) [type_check env type_name lxm]: type check the type id [type_name]
-   (3) [type_check_do]: untabulated version of [type_check] (do the real work).
+   (2) [type_check_do]: untabulated version of [type_check] (do the real work).
 
-   (2) [type_check_interface]: ditto, but for the interface part
-   (2) [type_check_interface_do]: untabulated version (do the real work)
+   (3) [type_check_interface]: ditto, but for the interface part
+   (4) [type_check_interface_do]: untabulated version (do the real work)
 
-   (4) [solve_type_idref] solves constant reference (w.r.t. short/long ident)
+   (5) [solve_type_idref] solves constant reference (w.r.t. short/long ident)
 
    constants checking
    ------------------
-   (5) [const_check env const_name lxm]: eval/check the constant [const_name]
+   (6) [const_check env const_name lxm]: eval/check the constant [const_name]
    (7) [const_check_do] : untabulated version (do the real work)
 
-   (6) [const_check_interface]: ditto, but for the interface part
-   (6) [const_check_interface_do]: untabulated version (do the real work)
+   (8) [const_check_interface]: ditto, but for the interface part
+   (9) [const_check_interface_do]: untabulated version (do the real work)
 
-   (8) [solve_const_idref] solves constant reference (w.r.t. short/long ident)
+   (10) [solve_const_idref] solves constant reference (w.r.t. short/long ident)
+
+
+    nb: for x in {type, const, oper}, there are several functions that returns [x_eff]:
+    - [x_check]
+        o takes an x_key
+        o lookups its (syntaxic) definition (x_info) via the symbolTab.t
+        o transforms it into a [x_eff] (recursively on the syntax structure)
+        
+    - [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
+
+    - [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 perfrom name resolution
+      and it calls 
+    
 
-    nb : the 4 functions dealing with constants duplicate 90% of the
-    code of the 4 functions dealing with types. It is not easy to
-    factorize them out (because of the 10%). I managed to do it for
-    [type_check] and [const_check], but even there, it is not that clear
-    that it was worthwhile...
 *)
 
 (* Before starting, let's define a few utilitary functions. *)
@@ -167,9 +184,10 @@ let (lookup_node_eff:
   lookup_x_eff "node ref "  (fun k -> fst k)
 
 
-(** solving type and constant references *)
+(** From an idref, builds a [x_key] and calls [x_check] *)
 let solve_x_idref
-    x_check_interface x_check find_x x_label to_x_key this symbols currpack idr lxm =
+    x_check_interface x_check find_x x_label to_x_key this symbols currpack idr 
+    sargs lxm =
   let s = Ident.name_of_idref idr in
     match Ident.pack_of_idref idr with
       | Some p -> x_check_interface this (to_x_key p s) lxm
@@ -221,15 +239,15 @@ and (solve_type_idref : t -> SymbolTab.t -> Ident.pack_name -> Ident.idref -> Lx
     solve_x_idref 
       type_check_interface type_check SymbolTab.find_type "type"
       (fun p id -> Ident.make_long p id)
-      this symbols currpack idr lxm
+      this symbols currpack idr [] lxm
 
 and (solve_const_idref : t -> SymbolTab.t -> Ident.pack_name -> Ident.idref -> Lxm.t
       -> CompiledData.const_eff) =
-  fun this symbols currpack idr lxm -> 
-    solve_x_idref 
+  fun this symbols currpack idr lxm ->
+    solve_x_idref
       const_check_interface const_check SymbolTab.find_const "const"
       (fun p id -> Ident.make_long p id)
-      this symbols currpack idr lxm
+      this symbols currpack idr [] lxm
 
 
 (* now the real work! *)
@@ -304,16 +322,17 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name -
       SyntaxTreeCore.type_info srcflagged -> CompiledData.type_eff) =
   fun this type_name lxm symbols pack_name type_def -> 
     try (
-      (* Solveur d'idref pour les  les appels  eval_type/eval_const *)
-      let eval_env = {
-	id2const = (solve_const_idref this symbols pack_name);
-	id2type = (solve_type_idref this symbols pack_name);
+      (* Solveur d'idref pour les appels  eval_type/eval_const *)
+      let id_solver = {
+	id2const = solve_const_idref this symbols pack_name;
+	id2type  = solve_type_idref this symbols pack_name;
+	id2node  = solve_node_idref this symbols pack_name;
       }
       in 
 	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 eval_env texp
+	  | AliasedType (s, texp) -> EvalType.f 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
@@ -322,11 +341,11 @@ 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 eval_env field_def.it.fd_type in
+		let teff = EvalType.f id_solver field_def.it.fd_type in
 		  match field_def.it.fd_value with
 		    | None -> (fname, teff, None)
 		    | Some vexp -> (
-			let veff = EvalConst.f eval_env vexp in
+			let veff = EvalConst.f id_solver vexp in
 			  match veff with
 			    | [v] -> (
 				let tv = type_of_const_eff v in
@@ -371,26 +390,27 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name
     *)
     try (
       (* Solveur d'idref pour les  les appels  eval_type/eval_const *)
-      let eval_env = {
+      let id_solver = {
 	id2const = (solve_const_idref this symbols currpack) ;
 	id2type = (solve_type_idref this symbols currpack) ;
+	id2node  = solve_node_idref this symbols currpack;
       }
       in
 	match const_def.it with
 	  | ExternalConst (id, texp) ->
 	      Extern_const_eff ((Ident.make_long currpack id), 
-				EvalType.f eval_env texp)
+				EvalType.f id_solver texp)
 
 	  | EnumConst (id, texp) ->
-	      Enum_const_eff ((Ident.make_long currpack id), EvalType.f eval_env texp)
+	      Enum_const_eff ((Ident.make_long currpack id), EvalType.f id_solver texp)
 
 	  | DefinedConst (id, texp_opt, vexp ) -> (
-	      match (EvalConst.f eval_env vexp) with
+	      match (EvalConst.f id_solver vexp) with
 		| [ceff] -> (
 		    match texp_opt with
 		      | None -> ceff
 		      | Some texp -> (
-			  let tdecl = EvalType.f eval_env texp in
+			  let tdecl = EvalType.f id_solver texp in
 			  let teff =  type_of_const_eff ceff in
 			    if (tdecl = teff ) then ceff
 			    else 
@@ -423,7 +443,7 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name
 (******************************************************************************)
 
 
-let rec (node_check_interface_do: t -> CompiledData.node_key -> Lxm.t -> 
+and (node_check_interface_do: t -> CompiledData.node_key -> Lxm.t -> 
 	  SymbolTab.t -> Ident.pack_name -> SyntaxTreeCore.node_info srcflagged -> 
 	  CompiledData.node_eff) =
   fun this nk lxm symbols pack_name node_def ->
@@ -446,10 +466,14 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
   fun this nk lxm symbols pack_name node_def ->
     (*
       - verifier les params statiques ?
+      - creer une sorte d'environnement local de compilation, qui
+      permette de gerer les espaces de noms propres aux noeuds
+      (variables, constantes, flots, types) 
     *)
     let id_solver = {
       id2const = solve_const_idref this symbols pack_name;
       id2type  = solve_type_idref  this symbols pack_name;
+      id2node  = solve_node_idref  this symbols pack_name;
     } 
     in
     let make_node_eff itl otl =
@@ -459,6 +483,8 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
 	nf_out_types = otl;
 	nf_in_formal_clocks  = []; (* XXX finish me! *)
 	nf_out_formal_clocks = []; (* XXX finish me! *)
+	nf_asserts = []; (* XXX finish me! *)
+	nf_eqs = []; (* XXX finish me! *)
       }
     in
       match node_def.it with
@@ -468,8 +494,8 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
 		   finish_me "" ; assert false
 
 	       | NodeAlias (None, {src=_;it= CallUsrDef(idref, static_args )}) ->
-		   solve_node_idref 
-		     this symbols pack_name idref id_solver static_args lxm
+		   assert false
+(* 		   id_solver.id2node idref (check_static_arg static_args) lxm *)
 
 	       | NodeAlias (Some (vi_il, vi_ol), _) 
 	       | NodeExtern(vi_il, vi_ol) -> 
@@ -492,24 +518,20 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
 		(List.map aux en.eni_outputs)
 		
 		
-(** solving node references *)
+(** builds and node_key and calls [node_check] *)
 and (solve_node_idref : t -> SymbolTab.t -> Ident.pack_name -> Ident.idref ->
-      CompiledData.id_solver -> static_arg srcflagged list -> Lxm.t -> 
-      CompiledData.node_eff) =
-(* 
-   XXX devrait retourner des oper_eff, non ? 
-*)
-  fun this symbols currpack idr id_solver sargs lxm ->
+      static_arg_eff list -> Lxm.t -> CompiledData.node_eff) =
+  fun this symbols currpack idr sargs lxm ->
     solve_x_idref
       node_check_interface node_check SymbolTab.find_node "node"
       (fun p id ->
-	 let long = Ident.make_long p id 
-	 and sargs_eff = 
-	   List.map (check_static_arg this symbols currpack id_solver id) sargs 
-	 in
-	   (long, sargs_eff)
+	 (* builds a [node_key] from a [pack_name] and a [node] id, 
+	 and a static_arg_eff list *)
+	 let long = Ident.make_long p id in
+	 let node_key = long, sargs in
+	   node_key
       )
-      this symbols currpack idr lxm
+      this symbols currpack idr sargs lxm
 
 and (node_check: t -> CompiledData.node_key -> Lxm.t -> CompiledData.node_eff) =
   fun this nk ->
@@ -526,44 +548,63 @@ and (node_check_interface:
       (fun nk -> Ident.pack_of_long (fst nk))
       (fun nk -> Ident.of_long (fst nk)) this nk
       
-and (check_static_arg : t -> SymbolTab.t -> Ident.pack_name -> 
-      CompiledData.id_solver -> Ident.t -> SyntaxTreeCore.static_arg srcflagged -> 
-      CompiledData.static_arg_eff) =
-  fun this symbols pn id_solver id sa ->
-    match sa.it with
-      | StaticArgIdent idref -> ( (* migth be a const, a type, or a node *)
-	  try 
-	    let sargs = [] in (* ok? *)
-	    let neff = solve_node_idref this symbols pn idref id_solver sargs sa.src in
-	      OperStaticArgEff (id, NodeOper neff)
-	  with Compile_error _ -> 
-	  try 
-	    let teff = solve_type_idref this symbols pn idref sa.src in
-	      TypeStaticArgEff (id, teff)
-	  with Compile_error _ -> 
-	  try 
-	    let ceff = solve_const_idref this symbols pn idref sa.src in
-	      ConstStaticArgEff (id, ceff)
-	  with Compile_error _ -> 
-	    (raise(Compile_error(sa.src,"unbounded ident")))
-	)
-      | StaticArgConst ce ->
-	  let ceff = EvalConst.f id_solver ce in
-	    (match ceff with
-	       | [ceff] -> ConstStaticArgEff (id,ceff)
-	       | _ -> assert false (* should not occur *)
-	    )
-      | StaticArgType te -> (TypeStaticArgEff (id, EvalType.f id_solver te))
-
-      | StaticArgNode (CallPreDef predef_node) ->
-	  finish_me (" node parameter handling - predefined operator " ^
-		       (SyntaxTreeDump.op2string predef_node));
-	  assert false
-
-      | StaticArgNode (CallUsrDef (idref, s_args)) -> 
-	  let neff = solve_node_idref this symbols pn idref id_solver s_args sa.src in
-	    OperStaticArgEff (id, NodeOper neff)
-
+(** [check_static_arg this symbols pn id sa (symbols, acc)] compile a static arg 
+    into a static_arg_eff, and adds it into an accumulator. Also returns a new 
+    [symbols] table, enriched with the binding [id] -> [static_arg_eff]
+*)
+(* and (check_static_arg : t -> Ident.pack_name -> Ident.t -> *)
+(*       SymbolTab.t * CompiledData.static_arg_eff list -> *)
+(*       SyntaxTreeCore.static_arg srcflagged -> *)
+(*       SymbolTab.t * CompiledData.static_arg_eff list) = *)
+(*   fun this pn id (symbols, acc) sa -> *)
+(*     (* XXX le passer en parametre plutot que de le recreer ? *) *)
+(*     let id_solver = { *)
+(*       id2const = solve_const_idref this symbols pn; *)
+(*       id2type  = solve_type_idref  this symbols pn; *)
+(*       id2node  = solve_node_idref  this symbols pn; *)
+(*     } *)
+(*     in *)
+(*     let sa_eff = *)
+(*       match sa.it with *)
+(* 	| StaticArgIdent idref -> ( (* migth be a const, a type, or a node *) *)
+(* 	    try *)
+(* 	      let sargs = [] in (* ok? *) *)
+(* 	      let neff = id_solver.id2node idref id_solver sargs sa.src in *)
+(* 		OperStaticArgEff (id, NodeOper neff) *)
+(* 	    with Compile_error _ -> *)
+(* 	    try *)
+(* 	      let teff = id_solver.id2type idref sa.src in *)
+(* 		TypeStaticArgEff (id, teff) *)
+(* 	    with Compile_error _ ->  *)
+(* 	    try  *)
+(* 	      let ceff = id_solver.id2const idref sa.src in *)
+(* 		ConstStaticArgEff (id, ceff) *)
+(* 	    with Compile_error _ -> *)
+(* 	      (raise(Compile_error(sa.src,"unbounded ident"))) *)
+(* 	  ) *)
+(* 	| StaticArgConst ce -> ( *)
+(* 	    let ceff = EvalConst.f id_solver ce in *)
+(* 	      match ceff with *)
+(* 		| [ceff] -> ConstStaticArgEff (id,ceff) *)
+(* 		| _ -> assert false (* should not occur *) *)
+(* 	  ) *)
+(* 	| StaticArgType te ->  *)
+(* 	    let teff = (TypeStaticArgEff (id, EvalType.f id_solver te)) in *)
+(* 	      teff *)
+(*  *)
+(* 	| StaticArgNode (CallPreDef predef_node) -> *)
+(* 	    finish_me (" node parameter handling - predefined operator " ^ *)
+(* 			 (SyntaxTreeDump.op2string predef_node)); *)
+(* 	    assert false *)
+(*  *)
+(* 	| StaticArgNode (CallUsrDef (idref, s_args)) ->  *)
+(* 	    let neff = id_solver.id2node idref id_solver s_args sa.src in *)
+(* 	      OperStaticArgEff (id, NodeOper neff) *)
+(*     in *)
+(*  *)
+(*       SymbolTab.add_ *)
+(*       XXX      add_type this id  *)
+(*       (symbols, sa_eff::acc) *)
 
     
 (*-------------------------------------------------------------------------

src/lazyCompiler.mli

-(** Time-stamp: <modified the 04/02/2008 (at 15:39) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:08) by Erwan Jahier> *)
 
 (** nb: compiling = type checking + constant evaluation *)
 

src/syntaxTab.ml

-(** Time-stamp: <modified the 07/02/2008 (at 15:22) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:15) by Erwan Jahier> *)
 
 (** 
     Table des infos sources : une couche au dessus de SyntaxTree pour mieux
@@ -292,7 +292,7 @@ init_raw_tabs (this : t) (sl : SyntaxTree.pack_or_model list) =
    une unique table qui sert pour les deux !
 
    Comment ça marche :
-   - on traite en premier les éventuels "use",
+   - on traite en premier les éventuels "use", (= open de ocaml)
    - puis les déclarations locales qui peuvent éventuellement
    masquer les précédentes (warning ?)
 *)

src/syntaxTreeCore.ml

-(** Time-stamp: <modified the 12/02/2008 (at 11:39) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:11) by Erwan Jahier> *)
 
 
 (** (Raw) Abstract syntax tree of source programs. *)
@@ -82,7 +82,6 @@ and slice_info = {
   si_step  : val_exp option ;
 }
 
-(* predef_node = operator *)
 and predef_node =
 (* zeroaire *)
     NULL_exp

src/test/test.res.exp

@@ -135,9 +135,10 @@ End of Syntax table dump.
  * package dummy
 	Exported types:
 	Exported constants:
-*** Error in file "t0.lus", line 11, col 10 to 10, token 'n': unknown constant
-
 	Exported nodes:
+
+*** oops: an internal error occurred in file lazyCompiler.ml, line 499, column 5
+*** when compiling lustre program t0.lus
  
 ----------------------------------------------------------------------
 ====> ../lus2lic -vl 3  t2.lus
@@ -168,9 +169,7 @@ End of Syntax table dump.
 	Exported nodes:
  ### skipping fold_left
 
-	XXX LazyCompiler: node parameter handling - predefined operator and ->  finish me!
-
-*** oops: an internal error occurred in file lazyCompiler.ml, line 561, column 3
+*** oops: an internal error occurred in file lazyCompiler.ml, line 499, column 5
 *** when compiling lustre program t2.lus
  
 ----------------------------------------------------------------------
@@ -284,11 +283,12 @@ End of Syntax table dump.
  * package dummy
 	Exported types:
 	Exported constants:
-*** Error in file "consensus.lus", line 20, col 41 to 41, token 'n': unknown constant
-
 	Exported nodes:
 		oper dummy::main = dummy::main(bool^4) returns (bool) on clock XXX
 
+
+*** oops: an internal error occurred in file lazyCompiler.ml, line 499, column 5
+*** when compiling lustre program consensus.lus
  
 ----------------------------------------------------------------------
 ====> ../lus2lic -vl 3  left.lus