optimisation: compareDefImp now only compares those definitions that are

really redundant, but not those which are added automatically by the compiler
to the icl module


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

3 files changed, 35 insertions, 16 deletions

diff --git a/frontend/check.icl b/frontend/check.icl
index 81bb88d..1daf18a 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -2597,7 +2597,8 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
 	  				{ cs_symbol_table = symbol_table, cs_predef_symbols = predef_symbols, cs_error = error, cs_needed_modules = 0 }
 	  
 	  init_dcl_modules = [ initialDclModule scanned_module \\ scanned_module <- scanned_modules ]
-	  (dcl_modules, local_defs, cdefs, sizes, cs)
+	  (icl_sizes_without_added_dcl_defs, sizes) = memcpy sizes
+	  (dcl_modules, local_defs, cdefs, _, cs)
 	  		= combineDclAndIclModule mod_type { dcl_module \\ dcl_module <- init_dcl_modules } local_defs cdefs sizes cs
 
 	  icl_common = createCommonDefinitions cdefs
@@ -2674,7 +2675,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
 		  heaps = { heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}
 
 		  (dcl_modules, icl_mod, heaps, cs_error)
-		  		= compareDefImp untransformed_fun_bodies dcl_modules icl_mod heaps cs_error
+		  		= compareDefImp icl_sizes_without_added_dcl_defs untransformed_fun_bodies dcl_modules icl_mod heaps cs_error
 
 		= (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file)
 		# icl_common	= { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs,
@@ -2890,6 +2891,12 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
 			# new = createArray size NoBody
 			= iFoldSt (\i (dst, src=:{[i]=src_i})->({ dst & [i] = src_i.fun_body }, src)) 0 size (new, fun_defs)
 
+		memcpy :: !a:{#Int} -> (!.{#Int}, !a:{#Int})
+		memcpy src
+			#! size = size src
+			# new = createArray size 0
+			= iFoldSt (\i (dst, src=:{[i]=src_i})->({ dst & [i] = src_i }, src)) 0 size (new, src)
+
 check_needed_modules_are_imported mod_name extension cs=:{cs_needed_modules}
 	# cs = case cs_needed_modules bitand cNeedStdDynamics of
 			0 -> cs
diff --git a/frontend/comparedefimp.dcl b/frontend/comparedefimp.dcl
index 8727005..5750f6e 100644
--- a/frontend/comparedefimp.dcl
+++ b/frontend/comparedefimp.dcl
@@ -4,6 +4,6 @@ import syntax, checksupport
 
 // compare definition and implementation module
 
-compareDefImp :: !{!FunctionBody} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin 
+compareDefImp :: !{#Int} !{!FunctionBody} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin 
 				-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
 
diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl
index 27ecbca..741aa69 100644
--- a/frontend/comparedefimp.icl
+++ b/frontend/comparedefimp.icl
@@ -84,9 +84,11 @@ class CorrespondenceNumber a where
 
 initial_hwn hwn_heap = { hwn_heap = hwn_heap, hwn_number = 0 }
 
-compareDefImp :: !{!FunctionBody} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin 
+compareDefImp :: !{#Int} !{!FunctionBody} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin 
 				-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
-compareDefImp untransformed dcl_modules icl_module heaps error_admin
+compareDefImp size_uncopied_icl_defs untransformed dcl_modules icl_module heaps error_admin
+	// icl definitions with indices >= size_uncopied_icl_defs.[def_type] don't have to be compared,
+	// because they are copies of definitions that appear exclusively in the dcl module
 	# (main_dcl_module, dcl_modules) = dcl_modules![cIclModIndex]
 	= case main_dcl_module.dcl_conversions of
 		No	-> (dcl_modules, icl_module, heaps, error_admin)
@@ -110,22 +112,28 @@ compareDefImp untransformed dcl_modules icl_module heaps error_admin
 						, tc_visited_syn_types = createArray (size dcl_common.com_type_defs) False
 						}
 			  (icl_com_type_defs, tc_state, error_admin)
-					= compareWithConversions conversion_table.[cTypeDefs]
+					= compareWithConversions 
+						size_uncopied_icl_defs.[cTypeDefs] conversion_table.[cTypeDefs]
 						dcl_common.com_type_defs icl_com_type_defs tc_state error_admin
 			  (icl_com_cons_defs, tc_state, error_admin)
-					= compareWithConversions conversion_table.[cConstructorDefs]
+					= compareWithConversions 
+						size_uncopied_icl_defs.[cConstructorDefs] conversion_table.[cConstructorDefs]
 						dcl_common.com_cons_defs icl_com_cons_defs tc_state error_admin
 			  (icl_com_selector_defs, tc_state, error_admin)
-					= compareWithConversions conversion_table.[cSelectorDefs]
+					= compareWithConversions
+						size_uncopied_icl_defs.[cSelectorDefs] conversion_table.[cSelectorDefs]
 						dcl_common.com_selector_defs icl_com_selector_defs tc_state error_admin
 			  (icl_com_class_defs, tc_state, error_admin)
-					= compareWithConversions conversion_table.[cClassDefs]
+					= compareWithConversions
+						size_uncopied_icl_defs.[cClassDefs] conversion_table.[cClassDefs]
 						dcl_common.com_class_defs icl_com_class_defs tc_state error_admin
 			  (icl_com_member_defs, tc_state, error_admin)
-					= compareWithConversions conversion_table.[cMemberDefs]
+					= compareWithConversions
+						size_uncopied_icl_defs.[cMemberDefs] conversion_table.[cMemberDefs]
 						dcl_common.com_member_defs icl_com_member_defs tc_state error_admin
 			  (icl_com_instance_defs, tc_state, error_admin)
-					= compareWithConversions conversion_table.[cInstanceDefs]
+					= compareWithConversions
+						size_uncopied_icl_defs.[cInstanceDefs] conversion_table.[cInstanceDefs]
 						dcl_common.com_instance_defs icl_com_instance_defs tc_state error_admin
 			  (icl_functions, hp_var_heap, hp_expression_heap, tc_state, error_admin)
 					= compareMacrosWithConversion conversion_table.[cMacroDefs] dcl_macros untransformed
@@ -151,10 +159,11 @@ compareDefImp untransformed dcl_modules icl_module heaps error_admin
 		# new = createArray size (abort "don't make that array strict !")
 		= iFoldSt (\i (dst, src=:{[i]=src_i}) -> ({ dst & [i] = src_i }, src)) 0 size (new, original)
 
-compareWithConversions conversions dclDefs iclDefs tc_state error_admin 
-	= iFoldSt (compareWithConversion conversions dclDefs) 0 (size conversions) (iclDefs, tc_state, error_admin)
+compareWithConversions size_uncopied_icl_defs conversions dclDefs iclDefs tc_state error_admin 
+	= iFoldSt (compareWithConversion size_uncopied_icl_defs conversions dclDefs) 0 (size conversions)
+			(iclDefs, tc_state, error_admin)
 
-compareWithConversion :: !{#Int} !(b c) !Int !(!u:(b c), !*TypesCorrespondState, !*ErrorAdmin)
+compareWithConversion :: !Int !{#Int} !(b c) !Int !(!u:(b c), !*TypesCorrespondState, !*ErrorAdmin)
 						-> (!v:(b c), !.TypesCorrespondState, !.ErrorAdmin)
 //1.3
 						| Array .b & getIdentPos , select_u , t_corresponds , uselect_u c, [u <= v]
@@ -162,8 +171,11 @@ compareWithConversion :: !{#Int} !(b c) !Int !(!u:(b c), !*TypesCorrespondState,
 /*2.0
 						| Array b c & t_corresponds, getIdentPos c, [u <= v]
 0.2*/
-compareWithConversion conversions dclDefs dclIndex (iclDefs, tc_state, error_admin)
-	# (iclDef, iclDefs) = iclDefs![conversions.[dclIndex]]
+compareWithConversion size_uncopied_icl_defs conversions dclDefs dclIndex (iclDefs, tc_state, error_admin)
+	# icl_index = conversions.[dclIndex]
+	| icl_index>=size_uncopied_icl_defs
+		= (iclDefs, tc_state, error_admin)
+	# (iclDef, iclDefs) = iclDefs![icl_index]
 	  (corresponds, tc_state) = t_corresponds dclDefs.[dclIndex] iclDef tc_state
 	| corresponds
 		= (iclDefs, tc_state, error_admin)