soc: Simplify the naming scheme of soc ident.

src/soc2cIdent.ml

-(* Time-stamp: <modified the 07/10/2014 (at 16:35) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/01/2015 (at 10:31) by Erwan Jahier> *)
 open Soc
 
 let colcol = Str.regexp "::"
@@ -42,19 +42,53 @@ let rec (type_to_short_string : Data.t -> string) =
     in
     str
 
-let (key_op2str : Soc.key_opt -> string) = function
-  | Nomore -> ""
-  | Curr(cc) -> Ident.string_of_long2 cc
-  | Slic(b,e,s) -> Printf.sprintf "_slice_%d_%d_%d" b e s
-  | MemInit(var_expr) ->  "_" ^
-    (* XXX This is wrong because hash is not an injection !!! *)
-    (string_of_int (Hashtbl.hash var_expr))
+(* Associate a unique string to each key, while still returning id
+   for the key (id,l,opt) for the first time a key with "id" is used.
 
+   To do that, I maintain a table of tables, associating a table to
+   each id. The inner table associates a unique string to each pair
+   "Data.t list * key_opt"
+*)
+
+let (key_table: (Soc.ident, (Data.t list * Soc.key_opt, int) Hashtbl.t) Hashtbl.t) = 
+  Hashtbl.create 10
 
 let (get_base_name : Soc.key -> string) =
-  fun (name,tl,opt) -> 
-    let l = List.map type_to_short_string tl in
-    (id2s (Printf.sprintf "%s_%s%s" (id2s name) (String.concat "" l) (key_op2str opt))) 
+  fun (id,l,opt) -> 
+    let id = id2s id in
+    let suff = 
+      try 
+        let inner_tbl = Hashtbl.find key_table id in
+        (try 
+          let cpt = Hashtbl.find inner_tbl (l,opt) in
+          let str = if cpt = 1 then "" else ("_"^(string_of_int cpt)) in
+          str
+         with Not_found ->
+           (* The first time (l,opt) is encountered for id *)
+           let cpt = 1+Hashtbl.length inner_tbl in 
+           let str = "_"^(string_of_int cpt) in
+           Hashtbl.add inner_tbl (l,opt) cpt;
+           str
+        )
+      with Not_found ->
+        (* The first time id is encountered *)
+        let inner_tbl = Hashtbl.create 1 in
+        Hashtbl.add inner_tbl (l,opt) 1;
+        Hashtbl.add key_table id inner_tbl;
+        ""
+    in
+    id ^ suff
+
+(* unit tests *)
+let _ = 
+  assert (get_base_name ("x", [Data.Int],  Soc.Nomore) = "x");
+  assert (get_base_name ("x", [Data.Int],  Soc.Nomore) = "x");
+  assert (get_base_name ("x", [Data.Bool], Soc.Nomore) = "x_2");
+  assert (get_base_name ("x", [Data.Int],  Soc.Nomore) = "x");
+  assert (get_base_name ("x", [Data.Real], Soc.Nomore) = "x_3");
+  assert (get_base_name ("x", [Data.Bool], Soc.Nomore) = "x_2");
+  Hashtbl.clear key_table
+
 
 let (get_ctx_name : Soc.key -> string) =
   fun sk -> (get_base_name sk) ^ "_ctx"

test/Makefile

 # to run the test, one needs to (apt-get) install:
 # dejagnu tcl tcllib
 
-test:reftest
-alltest: clean qtest reftest lus2lic.time 
+all:  clean qtest reftest lus2lic.time 
+test: clean qtest
+rest: reftest lus2lic.time 
 
 TEST_MACHINE=ssh granier
 #TEST_MACHINE=eval

test/lus2lic.sum

 ==> lus2lic0.sum <==
-Test Run By jahier on Mon Jan 26 11:33:16 
+Test Run By jahier on Tue Jan 27 10:37:57 
 Native configuration is x86_64-unknown-linux-gnu
 
 		=== lus2lic0 tests ===
@@ -63,7 +63,7 @@ XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/lecte
 XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/s.lus
 
 ==> lus2lic1.sum <==
-Test Run By jahier on Mon Jan 26 11:33:20 
+Test Run By jahier on Tue Jan 27 10:38:01 
 Native configuration is x86_64-unknown-linux-gnu
 
 		=== lus2lic1 tests ===
@@ -397,7 +397,7 @@ PASS: gcc -o multipar.exec multipar_multipar.c multipar_multipar_loop.c
 PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c multipar.lus  {}
 
 ==> lus2lic2.sum <==
-Test Run By jahier on Mon Jan 26 11:33:54 
+Test Run By jahier on Tue Jan 27 10:38:37 
 Native configuration is x86_64-unknown-linux-gnu
 
 		=== lus2lic2 tests ===
@@ -727,7 +727,7 @@ PASS: gcc -o zzz2.exec zzz2_zzz2.c zzz2_zzz2_loop.c
 PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c zzz2.lus  {}
 
 ==> lus2lic3.sum <==
-Test Run By jahier on Mon Jan 26 11:35:02 
+Test Run By jahier on Tue Jan 27 10:39:48 
 Native configuration is x86_64-unknown-linux-gnu
 
 		=== lus2lic3 tests ===
@@ -1230,7 +1230,7 @@ PASS: ./myec2c {-o multipar.c multipar.ec}
 PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node multipar.lus {}
 
 ==> lus2lic4.sum <==
-Test Run By jahier on Mon Jan 26 11:35:40 
+Test Run By jahier on Tue Jan 27 10:40:27 
 Native configuration is x86_64-unknown-linux-gnu
 
 		=== lus2lic4 tests ===
@@ -1727,13 +1727,13 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node zzz2.lus {}
 ===============================
 # Total number of failures: 14
 lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 4 seconds
-lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 32 seconds
-lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 67 seconds
-lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 37 seconds
-lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 68 seconds
+lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 35 seconds
+lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 71 seconds
+lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 39 seconds
+lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 71 seconds
 * Ref time: 
-0.04user 0.09system 3:32.73elapsed 0%CPU (0avgtext+0avgdata 3016maxresident)k
-0inputs+0outputs (0major+14912minor)pagefaults 0swaps
+0.05user 0.09system 3:41.58elapsed 0%CPU (0avgtext+0avgdata 3016maxresident)k
+0inputs+0outputs (0major+14901minor)pagefaults 0swaps
 * Quick time (-j 4):
-0.04user 0.07system 1:21.78elapsed 0%CPU (0avgtext+0avgdata 3020maxresident)k
-0inputs+0outputs (0major+14923minor)pagefaults 0swaps
+0.05user 0.05system 1:20.56elapsed 0%CPU (0avgtext+0avgdata 3016maxresident)k
+0inputs+0outputs (0major+14920minor)pagefaults 0swaps

test/lus2lic.time

 lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 4 seconds
-lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 32 seconds
-lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 67 seconds
-lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 37 seconds
-lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 68 seconds
+lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 35 seconds
+lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 71 seconds
+lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 39 seconds
+lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 71 seconds
 * Ref time: 
-0.04user 0.09system 3:32.73elapsed 0%CPU (0avgtext+0avgdata 3016maxresident)k
-0inputs+0outputs (0major+14912minor)pagefaults 0swaps
+0.05user 0.09system 3:41.58elapsed 0%CPU (0avgtext+0avgdata 3016maxresident)k
+0inputs+0outputs (0major+14901minor)pagefaults 0swaps
 * Quick time (-j 4):
-0.04user 0.07system 1:21.78elapsed 0%CPU (0avgtext+0avgdata 3020maxresident)k
-0inputs+0outputs (0major+14923minor)pagefaults 0swaps
+0.05user 0.05system 1:20.56elapsed 0%CPU (0avgtext+0avgdata 3016maxresident)k
+0inputs+0outputs (0major+14920minor)pagefaults 0swaps

test/should_work/CURRENT.lus

@@ -3,7 +3,8 @@ returns (z: bool);
 let
   z = current(CURRENT_clk(x,y when x));
 tel
-node CURRENT_clk(x: bool; y: bool when x)
+
+function CURRENT_clk(x: bool; y: bool when x)
 returns (z: bool when x);
 let
   z = y;