exploiting "reuse unique nodes" option

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@289 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

1 files changed, 74 insertions, 28 deletions

diff --git a/frontend/containers.icl b/frontend/containers.icl
index 362d380..1056c3f 100644
--- a/frontend/containers.icl
+++ b/frontend/containers.icl
@@ -1,4 +1,5 @@
 implementation module containers
+// compile using "reuse unique nodes" option
 
 import StdEnv, utilities, syntax
 
@@ -53,6 +54,44 @@ remove_first_module_number (Numbers module_numbers rest_module_numbers)
 	# bit_n = first_one_bit module_numbers
 	= (bit_n,Numbers (module_numbers bitand (bitnot (1<<bit_n))) rest_module_numbers)
 
+numberSetToList :: !NumberSet -> [Int]
+numberSetToList ns
+	= numberset_to_list ns 0
+  where
+	numberset_to_list :: !NumberSet !Int -> [Int]
+	numberset_to_list EndNumbers i
+		= []
+	numberset_to_list (Numbers n rest_ns) i
+		# rest_l
+				= numberset_to_list rest_ns (i+32)
+		= add_numbers_in_word n i rest_l
+	
+	add_numbers_in_word :: !Int !Int [Int] -> [Int]
+	add_numbers_in_word n i rest_l
+		| n==0
+			= rest_l
+		# (last_i, mask)
+				= last_one_bit n
+		= add_numbers_in_word (n bitand (bitnot mask)) i [last_i+i:rest_l]
+	
+	last_one_bit :: !.Int -> (!Int, !Int)
+	last_one_bit n
+		| n bitand 0xff000000<>0
+			= last_one_bit_in_byte 31 n
+		| n bitand 0xff0000<>0
+			= last_one_bit_in_byte 23 n
+		| n bitand 0xff00<>0
+			= last_one_bit_in_byte 15 n
+		= last_one_bit_in_byte 7 n
+	
+	last_one_bit_in_byte :: !Int !Int -> (!Int, !Int)
+	last_one_bit_in_byte i n
+		# mask
+				= 1<<i
+		| n bitand mask<>0
+			= (i, mask)
+		= last_one_bit_in_byte (i-1) n
+
 first_one_bit module_numbers
 	| module_numbers bitand 0xff<>0
 		= first_one_bit_in_byte 0 module_numbers
@@ -98,15 +137,22 @@ bitvectSet index a
 	   a_bit_index = a.[bit_index]
 	= { a & [bit_index] = a_bit_index bitor (1 << BITNUMBER index)}
 
+bitvectReset :: !Int !*LargeBitvect -> .LargeBitvect
+bitvectReset index a
+	#! bit_index = BITINDEX index
+	   a_bit_index = a.[bit_index]
+	= { a & [bit_index] = a_bit_index bitand (bitnot (1 << BITNUMBER index))}
+
 bitvectCreate :: !Int -> .LargeBitvect 
 bitvectCreate 0 = {}
 bitvectCreate n_elements = createArray ((BITINDEX (n_elements-1)+1)) 0
 
-bitvectReset :: !*LargeBitvect -> .LargeBitvect 
-bitvectReset arr
+bitvectResetAll :: !*LargeBitvect -> .LargeBitvect 
+bitvectResetAll arr
 	#! size
 			= size arr
 	= { arr & [i] = 0 \\ i<-[0..size-1] } // list should be optimized away
+
 bitvectOr :: !u:LargeBitvect !*LargeBitvect -> (!Bool, !u:LargeBitvect, !*LargeBitvect)
 // Boolean result: whether the unique bitvect has changed
 bitvectOr op1 op2
@@ -124,21 +170,17 @@ screw :== 80
 
 :: IntKey :== Int
 
-:: IntKeyHashtable a =
-	{	ikh_rehash_threshold	:: !Int
-	,	ikh_nr_of_entries		:: !Int
-	,	ikh_bitmask				:: !Int
-	,	ikh_entries				:: !.{!.IntKeyTree a}
-	}
+:: IntKeyHashtable a = IntKeyHashtable !Int !Int !Int !.{!.IntKeyTree a}
+//						ikh_rehash_threshold ikh_nr_of_entries ikh_bitmask ikh_entries
+// it's not a record type to prevent it from being unboxed
 	
 :: IntKeyTree a = IKT_Leaf | IKT_Node !IntKey a !.(IntKeyTree a) !.(IntKeyTree a)
 
 ikhEmpty :: .(IntKeyHashtable a)
-ikhEmpty = { ikh_rehash_threshold = 0, ikh_nr_of_entries = 0,
-				ikh_bitmask = 0, ikh_entries = {} }
+ikhEmpty = IntKeyHashtable 0 0 0 {}
 
 ikhInsert :: !Bool !IntKey a !*(IntKeyHashtable a) -> (!Bool, !.IntKeyHashtable a)
-ikhInsert overide int_key value ikh=:{ ikh_rehash_threshold, ikh_nr_of_entries, ikh_bitmask, ikh_entries }
+ikhInsert overide int_key value (IntKeyHashtable ikh_rehash_threshold ikh_nr_of_entries ikh_bitmask ikh_entries)
 	| ikh_rehash_threshold<=ikh_nr_of_entries
 		= ikhInsert overide int_key value (grow ikh_entries)
 	#! hash_value
@@ -147,11 +189,11 @@ ikhInsert overide int_key value ikh=:{ ikh_rehash_threshold, ikh_nr_of_entries,
 			= replace ikh_entries hash_value IKT_Leaf
 	   (is_new, tree)
 	   		= iktUInsert overide int_key value tree 
-	   ikh
-	   		= { ikh & ikh_entries = { ikh_entries & [hash_value] = tree }}
+	   ikh_entries
+	   		= { ikh_entries & [hash_value] = tree }
 	| is_new
-		= (is_new, { ikh & ikh_nr_of_entries = ikh_nr_of_entries+1 })
-	= (is_new, ikh)
+		= (is_new, (IntKeyHashtable ikh_rehash_threshold (ikh_nr_of_entries+1) ikh_bitmask ikh_entries))
+	= (is_new, (IntKeyHashtable ikh_rehash_threshold ikh_nr_of_entries ikh_bitmask ikh_entries))
 
 grow :: !{!*(IntKeyTree a)} -> .(IntKeyHashtable a)
 grow old_entries
@@ -162,8 +204,7 @@ grow old_entries
 	   new_entries
 	   		= { IKT_Leaf \\ i<-[1..new_size] }
 	   ikh
-			= { ikh_rehash_threshold = (new_size*screw)/100, ikh_nr_of_entries = 0,
-				ikh_bitmask = new_size-1, ikh_entries = new_entries }
+	   		= (IntKeyHashtable ((new_size*screw)/100) 0 (new_size-1) new_entries)
 	   (_, ikh)
 	   		= iFoldSt rehashTree 0 size (old_entries, ikh)
 	= ikh
@@ -184,21 +225,21 @@ ikhInsert` overide int_key value ikh
 	= snd (ikhInsert overide int_key value ikh)
 
 ikhSearch :: !IntKey !(IntKeyHashtable a) -> .Optional a
-ikhSearch int_key {	ikh_bitmask, ikh_entries }
+ikhSearch int_key (IntKeyHashtable _ _ ikh_bitmask ikh_entries)
 	| size ikh_entries==0
 		= No
 	= iktSearch int_key ikh_entries.[int_key bitand ikh_bitmask]
 
 ikhSearch` :: !IntKey !(IntKeyHashtable a) -> a
-ikhSearch` int_key {ikh_bitmask, ikh_entries }
+ikhSearch` int_key (IntKeyHashtable _ _ ikh_bitmask ikh_entries)
 	| size ikh_entries==0
 		= abort "ikhSearch`: key not found"
 	= iktSearch` int_key ikh_entries.[int_key bitand ikh_bitmask]
 
 ikhUSearch :: !IntKey !*(IntKeyHashtable a) -> (!.Optional a, !*IntKeyHashtable a)
-ikhUSearch int_key ikh=:{ikh_bitmask, ikh_entries}
+ikhUSearch int_key (IntKeyHashtable ikh_rehash_threshold ikh_nr_of_entries ikh_bitmask ikh_entries)
 	| size ikh_entries==0
-		= (No, ikh)
+		= (No, IntKeyHashtable ikh_rehash_threshold ikh_nr_of_entries ikh_bitmask ikh_entries)
 	# hash_value
 			= int_key bitand ikh_bitmask
 	  (ikt, ikh_entries)
@@ -207,7 +248,7 @@ ikhUSearch int_key ikh=:{ikh_bitmask, ikh_entries}
 			= iktUSearch int_key ikt
 	  ikh_entries
 	  		= { ikh_entries & [hash_value] = ikt }
-	= (opt_result, { ikh & ikh_entries = ikh_entries })
+	= (opt_result, (IntKeyHashtable ikh_rehash_threshold ikh_nr_of_entries ikh_bitmask ikh_entries))
 
 iktUInsert :: !Bool !IntKey a !*(IntKeyTree a) -> (!Bool, !.IntKeyTree a)
 iktUInsert overide int_key value IKT_Leaf
@@ -234,10 +275,10 @@ iktFlatten ikt
 	flatten (IKT_Node int_key value left right) accu
 		= flatten left [(int_key, value) : flatten right accu]
 
-iktUSearch :: !IntKey !*(IntKeyTree a) -> (!.Optional a,.IntKeyTree a)
-iktUSearch int_key leaf=:IKT_Leaf
-	= (No, leaf)
-iktUSearch int_key ikt=:(IKT_Node key2 value left right)
+iktUSearch :: !IntKey !*(IntKeyTree a) -> (!.Optional a,!.IntKeyTree a)
+iktUSearch int_key IKT_Leaf
+	= (No, IKT_Leaf)
+iktUSearch int_key (IKT_Node key2 value left right)
 	| int_key<key2
 		# (opt_result, left)
 			= iktUSearch int_key left
@@ -246,7 +287,12 @@ iktUSearch int_key ikt=:(IKT_Node key2 value left right)
 		# (opt_result, right)
 			= iktUSearch int_key right
 		= (opt_result, IKT_Node key2 value left right)
-	= (Yes value, ikt)
+	# (_, yes_value)
+			= yes value
+	= (yes_value, IKT_Node key2 value left right)
+
+yes :: !x -> (!Bool, !.Optional x) // to minimize allocation
+yes value = (True, Yes value)
 		
 iktSearch :: !IntKey !(IntKeyTree a) -> .Optional a
 iktSearch int_key IKT_Leaf
@@ -298,7 +344,7 @@ instance toString {!a} | toString a
 		
 instance toString (IntKeyHashtable a) |toString a
   where
-	toString { ikh_rehash_threshold, ikh_nr_of_entries, ikh_bitmask, ikh_entries }
+	toString (IntKeyHashtable ikh_rehash_threshold ikh_nr_of_entries ikh_bitmask ikh_entries)
 		= "(IKH "+++toString ikh_rehash_threshold+++" "+++toString ikh_nr_of_entries
 			+++" "+++toString ikh_bitmask+++" "+++toString ikh_entries