src/lazyCompiler.ml:

   Sligtly generalise  x_check, and  x_check_interface to be  able to
   define      tabulated      version      of     node_check      and
   node_check_interface.  More   precisely,  add  2   fonctions  that
   extracts the name and the package name of a x_key.

   Ditto for lookup_x_eff.

src/lazyCompiler.mli:
   s/do_node/node_check/

Makefile

@@ -20,4 +20,7 @@ test:
 
 
 ci:
+	make test && git commit -F log
+
+cia:
 	make test && git commit -a -F log
\ No newline at end of file

src/TODO

 
 
-* autoriser le fait le pouvoir donner une valeur par defaut à une constant
+* autoriser le fait le pouvoir donner une valeur par defaut à une constante
  exportée. («provides const : n = 4; »)
 
 * LazyCompiler.do_node
 
+* lazyCompiler.ml: 
+	mettre les x_check, x_check_interface, etc, dans un module à part (?)
 
 * Dans les messages d'erreurs, le numero de colonne est faux à cause des tabulations
 
-
+* symbolTal.ml et ailleurs : sed s/oper/node/ ?
+parce que dans lazyCompile.ml, ca s'appele "do_node" ...
 
 * finir de rédiger le manuel
 

src/lazyCompiler.ml

-(** Time-stamp: <modified the 31/01/2008 (at 14:45) by Erwan Jahier> *)
+(** Time-stamp: <modified the 04/02/2008 (at 15:31) by Erwan Jahier> *)
 
 
 open Lxm
@@ -97,35 +97,37 @@ fun tbl ->
     is common to type and constant checking, and is performed by the
     2 following functions.
 
-    Since [x] is meant to stand for [type] or [const], those 2
-    functions will lead to the definition of 4 functions:
-    [type_check], [const_check], [type_check_interface],
-    [const_check_interface].
+    Since [x] is meant to stand for [type], [const], or [node], those 2
+    functions will lead to the definition of 6 functions:
+    [type_check], [const_check], [node_check],
+    [type_check_interface], [const_check_interface], [node_check_interface].
 *)
-let x_check tab find_x x_check_do lookup_x_eff this x_long_name lxm =
-  try lookup_x_eff tab x_long_name lxm 
+let x_check 
+    tab find_x x_check_do lookup_x_eff pack_of_x_key name_of_x_key this x_key lxm =
+  try lookup_x_eff tab x_key lxm 
   with Not_found ->
-    Hashtbl.add tab x_long_name Checking;
-    let (x_pack,xn) = (Ident.pack_of_long x_long_name, Ident.of_long x_long_name) in
+    Hashtbl.add tab x_key Checking;
+    let (x_pack,xn) = (pack_of_x_key x_key, name_of_x_key x_key) in
     let x_pack_symbols = SyntaxTab.pack_body_env this.src_tab x_pack in
     let x_def = match find_x x_pack_symbols xn with
       | SymbolTab.Here x_def -> x_def
       | SymbolTab.NotHere _ -> assert false
     in
-    let res = x_check_do this x_long_name lxm x_pack_symbols x_pack x_def in
-      Hashtbl.replace tab x_long_name (Checked res);
+    let res = x_check_do this x_key lxm x_pack_symbols x_pack x_def in
+      Hashtbl.replace tab x_key (Checked res);
       res
 
 let x_check_interface 
-    tab find_x x_check x_check_interface_do lookup_x_eff this x_long_name lxm =
-  try lookup_x_eff tab x_long_name lxm
+    tab find_x x_check x_check_interface_do lookup_x_eff 
+    pack_of_x_key name_of_x_key this x_key lxm =
+  try lookup_x_eff tab x_key lxm
   with Not_found ->
-    Hashtbl.add tab x_long_name Checking;
-    let (xp,xn) = (Ident.pack_of_long x_long_name, Ident.of_long x_long_name) in
+    Hashtbl.add tab x_key Checking;
+    let (xp,xn) = (pack_of_x_key x_key, name_of_x_key x_key) in
     let xp_prov_symbols_opt = SyntaxTab.pack_prov_env this.src_tab xp in
     let res = (* [xp] migth have no provided symbol table *)
       match xp_prov_symbols_opt with
-	| None -> x_check this x_long_name lxm
+	| None -> x_check this x_key lxm
 	    (* if [xp] have no provided symbol table, the whole
 	       package is exported. *)
 	| Some xp_prov_symbols ->
@@ -133,26 +135,31 @@ let x_check_interface
 	      | SymbolTab.Here x -> x
 	      | SymbolTab.NotHere _ -> assert false
 	    in
-	      x_check_interface_do this x_long_name lxm xp_prov_symbols xp x_def
+	      x_check_interface_do this x_key lxm xp_prov_symbols xp x_def
     in
-      Hashtbl.replace tab x_long_name (Checked res);
+      Hashtbl.replace tab x_key (Checked res);
       res
 
 (* Returns the tabulated [type] or [const], if it has already been computed;
    otherwise, raise [Not_found] otherwise. *)
-let lookup_x_eff x_label types_tab x_long_name lxm  =
-    match Hashtbl.find types_tab x_long_name with
+let lookup_x_eff x_label id_of_x_key x_tab x_key lxm  =
+    match Hashtbl.find x_tab x_key with
       | Checked res -> res
-      | Checking -> raise (Recursion_error (x_long_name, [x_label^(Lxm.details lxm)]))
+      | Checking -> raise (Recursion_error (id_of_x_key x_key, [x_label^(Lxm.details lxm)]))
       | Incorrect -> raise (BadCheckRef_error)
 
 let (lookup_type_eff: (item_key, CompiledData.type_eff check_flag) Hashtbl.t -> 
       Ident.long -> Lxm.t -> CompiledData.type_eff) = 
-  lookup_x_eff "type ref "
+  lookup_x_eff "type ref "  (fun k -> k)
 
 let (lookup_const_eff:(item_key, CompiledData.const_eff check_flag) Hashtbl.t -> 
       Ident.long -> Lxm.t -> CompiledData.const_eff) = 
-  lookup_x_eff "const ref " 
+  lookup_x_eff "const ref " (fun k -> k)
+
+let (lookup_node_eff:
+       (CompiledData.node_key, CompiledData.node_eff check_flag) Hashtbl.t -> 
+      CompiledData.node_key -> Lxm.t -> CompiledData.node_eff) = 
+  lookup_x_eff "node ref "  (fun k -> fst k)
 
 
 (** solving type and constant references *)
@@ -178,26 +185,28 @@ let solve_x_idref
 (** Tabulated version of [type_check_do]. *)
 let rec (type_check : t -> Ident.long -> Lxm.t -> CompiledData.type_eff) =
   fun this -> 
-  x_check this.types SymbolTab.find_type type_check_do lookup_type_eff this
+    x_check this.types SymbolTab.find_type type_check_do lookup_type_eff 
+      Ident.pack_of_long Ident.of_long this
 
 (** Tabulated version of [const_check_do]. *)
 and (const_check : t -> Ident.long -> Lxm.t -> CompiledData.const_eff) =
   fun this -> 
-  x_check this.consts SymbolTab.find_const const_check_do lookup_const_eff this
+  x_check this.consts SymbolTab.find_const const_check_do lookup_const_eff 
+    Ident.pack_of_long Ident.of_long this
 
 (** Tabulated version of [type_check_interface_do]. *)
 and (type_check_interface: t -> Ident.long -> Lxm.t -> CompiledData.type_eff) =
   fun this -> 
   x_check_interface 
     this.prov_types SymbolTab.find_type type_check type_check_interface_do 
-    lookup_type_eff this
+    lookup_type_eff Ident.pack_of_long Ident.of_long this
 
 (** Tabulated version of [const_check_interface_do]. *)
 and (const_check_interface: t -> Ident.long -> Lxm.t -> CompiledData.const_eff) =
   fun this -> 
     x_check_interface 
       this.prov_consts SymbolTab.find_const const_check const_check_interface_do
-      lookup_const_eff this
+      lookup_const_eff Ident.pack_of_long Ident.of_long this
 
 (** solving type and constant references *)
 and (solve_type_idref : t -> SymbolTab.t -> Ident.pack_name -> Ident.idref -> Lxm.t
@@ -412,23 +421,52 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name
   
 
 (******************************************************************************)
-(* exported *)
-let (do_node: t -> CompiledData.node_key -> CompiledData.node_eff) =
+
+let (node_check_interface_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t -> 
+      Ident.pack_name -> SyntaxTree.oper_info srcflaged -> CompiledData.node_eff) =
+  fun this nk lxm symbols pack_name node_def ->
+    assert false
+
+let (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t -> 
+      Ident.pack_name -> SyntaxTree.oper_info srcflaged -> CompiledData.node_eff) =
+  fun this nk lxm symbols pack_name node_def ->
+    (* 
+       checker un noeud = 
+           - checked les types de ses arguments
+    *)
+    
+    match node_def.it with
+      | Node node_info -> 
+
+	  let itl = [] in
+	  let otl = [] in
+	  let icl = [] in
+	  let ocl = [] in      
+	    {
+	      nf_key = nk ;
+	      nf_in_types = itl;
+	      nf_out_types = otl;
+	      nf_in_formal_clocks = icl;
+	      nf_out_formal_clocks = ocl;
+	    }
+
+      | Func func_info -> 
+	  assert false
+
+let (node_check: t -> CompiledData.node_key -> Lxm.t -> CompiledData.node_eff) =
   fun this nk ->
-(* XXX finish me ! *)
-    let itl = [] in
-    let otl = [] in
-    let icl = [] in
-    let ocl = [] in
-      
-    assert false;
-      {
-	nf_key = nk ;
-	nf_in_types = itl;
-	nf_out_types = otl;
-	nf_in_formal_clocks = icl;
-	nf_out_formal_clocks = ocl;
-      }
+    x_check this.nodes SymbolTab.find_oper node_check_do lookup_node_eff 
+      (fun nk -> Ident.pack_of_long (fst nk)) 
+      (fun nk -> Ident.of_long (fst nk))
+      this nk
+
+let (node_check_interface: 
+       t -> CompiledData.node_key -> Lxm.t -> CompiledData.node_eff) =
+  fun this nk ->
+    x_check_interface this.nodes SymbolTab.find_oper node_check 
+      node_check_interface_do lookup_node_eff 
+      (fun nk -> Ident.pack_of_long (fst nk)) 
+      (fun nk -> Ident.of_long (fst nk)) this nk
 
 (*-------------------------------------------------------------------------
  Test/debug
@@ -459,7 +497,7 @@ let test (this: t) = (
     in
     let test_types = test_item "type" type_check_interface string_of_type_eff in
     let test_constants = test_item "const" const_check_interface string_of_const_eff in
-(*     let test_operators = test_item "" in *)
+(*     let test_operators = test_item "oper"  in *)
       Verbose.print_string "\tExported types:\n";
       SymbolTab.iter_types prov_symbols test_types ;
       Verbose.print_string "\tExported constants:\n";

src/lazyCompiler.mli

-(** Time-stamp: <modified the 30/01/2008 (at 11:26) by Erwan Jahier> *)
+(** Time-stamp: <modified the 04/02/2008 (at 15:39) by Erwan Jahier> *)
 
 (** nb: compiling = type checking + constant evaluation *)
 
@@ -15,7 +15,7 @@ val create : SyntaxTab.t -> t
 
 
 (** Compiles one node *)
-val do_node : t -> CompiledData.node_key -> CompiledData.node_eff
+val node_check : t -> CompiledData.node_key -> Lxm.t -> CompiledData.node_eff
 
 
 (* Test/debug des types et constantes statiques associées *)