change the order of instances with type variables, type variables are assigned...

change the order of instances with type variables, type variables are assigned increasing numbers based on the position of the first occurence from left to right, currently only used if IF_ALLOW_NON_TERMINATING_AND_OVERLAPPING_INSTANCES is enabled (default not)

frontend/compare_types.icl

@@ -169,7 +169,6 @@ where
 instance =< SymbIdent
 where
 	(=<) {symb_kind=symb_kind1} {symb_kind=symb_kind2} = symb_kind1 =< symb_kind2
-			
 
 instance =< App
 where
@@ -202,7 +201,7 @@ where
 		| s1 < s2
 			= Smaller
 			= Greater
-	
+
 instance =< Expression
 where
 	(=<) expr1 expr2
@@ -211,9 +210,9 @@ where
 		with
 			compare_arguments (App app1) (App app2)						= app1 =< app2
 			compare_arguments (Var v1) (Var v2)							= v1 =< v2
-			compare_arguments (fun1 @ args1) (fun2 @ args2)				= (fun1,args1) =< (fun2,args2) 
-			compare_arguments EE EE										= Equal		
-			compare_arguments _ _										= Greater		
+			compare_arguments (fun1 @ args1) (fun2 @ args2)				= (fun1,args1) =< (fun2,args2)
+			compare_arguments EE EE										= Equal
+			compare_arguments _ _										= Greater
 		| less_constructor expr1 expr2
 			= Smaller
 			= Greater
@@ -355,85 +354,92 @@ instance < MemberDef
 where
 	(<) md1 md2 = md1.me_ident.id_name < md2.me_ident.id_name
 
-(CAND) infix 3 :: !(!CompareValue, ![Ident], ![Ident]) (CompareValue, ![Ident], ![Ident]) -> (CompareValue,  ![Ident], ![Ident])
-(CAND) (cv1,vlist1a,vlist1b) cl2
+(CAND) infix 3 :: !(!CompareValue, ![(Ident,Ident)]) (CompareValue, ![(Ident,Ident)]) -> (CompareValue,  ![(Ident,Ident)])
+(CAND) (cv1,vlist1) cl2
 	| cv1 == Equal
 		= case cl2 of
-			(cv2,vlist2a,vlist2b)
+			(cv2,vlist2)
 				| cv2 == Equal
-					-> (Equal, vlist1a ++ vlist2a, vlist1b ++ vlist2b)
-					-> cl2
-		= (cv1,vlist1a,vlist1b)
+					-> compare_and_add_variables vlist1 vlist2
+					-> (cv2,[])
+		= (cv1,[])
+
+compare_and_add_variables :: ![(Ident,Ident)] ![(Ident,Ident)] -> (!CompareValue,![(Ident,Ident)])
+compare_and_add_variables vlist1 []
+	= (Equal, vlist1)
+compare_and_add_variables vlist1 [v2=:(v2a,v2b):vlist2]
+	# (cv,not_found) = compare_variable vlist1 v2a v2b
+	| cv==Equal
+		| not_found
+			= compare_and_add_variables (vlist1++[v2]) vlist2
+			= compare_and_add_variables vlist1 vlist2
+		= (cv, [])
+
+compare_variable :: ![(Ident,Ident)] !Ident !Ident -> (!CompareValue,!Bool)
+compare_variable [(v1a,v1b):vlist1] v2a v2b
+	| v1a==v2a
+		| v1b==v2b
+			= (Equal,False)
+			= (Smaller,False)
+		| v1b==v2b
+			= (Greater,False)
+			= compare_variable vlist1 v2a v2b
+compare_variable [] v2a v2b
+	= (Equal,True)
 
 compareInstances :: ![Type] ![Type] -> CompareValue
 compareInstances types1 types2
-	# (cv, vlist1, vlist2) = compare_lists types1 types2
-	| cv == Equal
-		 # l1 = length (removeDup vlist1)
-		 # l2 = length (removeDup vlist2)
-		 | l1 == l2
-		 	= Equal
-		 | l1 < l2
-		 	= Smaller
-		 	= Greater
-		 = cv
+	# (cv, vlist) = compare_lists types1 types2
+	 = cv
 where
 	compare_lists [type1:types1] [type2:types2]
 		= compareInstanceTypes type1 type2 CAND compare_lists types1 types2
 	compare_lists [] []
-		= (Equal, [],[])
+		= (Equal, [])
 	compare_lists [] types
-		= (Smaller, [],[])
+		= (Smaller, [])
 	compare_lists types []
-		= (Greater, [],[])
+		= (Greater, [])
 
 compareFunDepInstances :: ![Type] ![Type] !BITVECT -> CompareValue
 compareFunDepInstances types1 types2 fun_dep_vars
-	# (cv, vlist1, vlist2) = compare_lists types1 types2 fun_dep_vars
-	| cv == Equal
-		 # l1 = length (removeDup vlist1)
-		 # l2 = length (removeDup vlist2)
-		 | l1 == l2
-		 	= Equal
-		 | l1 < l2
-		 	= Smaller
-		 	= Greater
-		 = cv
+	# (cv, vlist) = compare_lists types1 types2 fun_dep_vars
+	 = cv
 where
 	compare_lists [type1:types1] [type2:types2] fun_dep_vars
 		| fun_dep_vars bitand 1==0
 			= compareInstanceTypes type1 type2 CAND compare_lists types1 types2 (fun_dep_vars>>1)
 			= compare_lists types1 types2 (fun_dep_vars>>1)
 	compare_lists [] [] fun_dep_vars
-		= (Equal, [],[])
+		= (Equal, [])
 	compare_lists [] types fun_dep_vars
-		= (Smaller, [],[])
+		= (Smaller, [])
 	compare_lists types [] fun_dep_vars
-		= (Greater, [],[])
+		= (Greater, [])
 
-compareInstanceTypes (TA tc1 a1)    (TA tc2 a2)		= (tc1 =< tc2,[],[]) CAND compareArguments a1 a2
-compareInstanceTypes (TA tc1 a1)    (TAS tc2 a2 _)	= (tc1 =< tc2,[],[]) CAND compareArguments a1 a2
-compareInstanceTypes (TAS tc1 a1 _) (TA tc2 a2)		= (tc1 =< tc2,[],[]) CAND compareArguments a1 a2
-compareInstanceTypes (TAS tc1 a1 _) (TAS tc2 a2 _)	= (tc1 =< tc2,[],[]) CAND compareArguments a1 a2
+compareInstanceTypes (TA tc1 a1)    (TA tc2 a2)		= (tc1 =< tc2,[]) CAND compareArguments a1 a2
+compareInstanceTypes (TA tc1 a1)    (TAS tc2 a2 _)	= (tc1 =< tc2,[]) CAND compareArguments a1 a2
+compareInstanceTypes (TAS tc1 a1 _) (TA tc2 a2)		= (tc1 =< tc2,[]) CAND compareArguments a1 a2
+compareInstanceTypes (TAS tc1 a1 _) (TAS tc2 a2 _)	= (tc1 =< tc2,[]) CAND compareArguments a1 a2
 compareInstanceTypes t1 t2
 	| equal_constructor t1 t2
 		= compare_arguments t1 t2
 	| less_constructor t1 t2
-		= (Smaller, [],[])
-		= (Greater, [],[])
+		= (Smaller, [])
+		= (Greater, [])
 where
-		compare_arguments (TB tb1) (TB tb2)				= (tb1 =< tb2, [],[])
+		compare_arguments (TB tb1) (TB tb2)				= (tb1 =< tb2, [])
 		compare_arguments (t1a --> t1r) (t2a --> t2r)	= compareInstanceTypes t1a.at_type t2a.at_type CAND compareInstanceTypes t1r.at_type t2r.at_type
 		compare_arguments (TArrow1 t1) (TArrow1 t2)		= compareInstanceTypes t1.at_type t2.at_type
-		compare_arguments (TV tv1) (TV tv2)				= (Equal, [tv1.tv_ident],[tv2.tv_ident])
-		compare_arguments type1 type2 				    = (Equal, [],[])
+		compare_arguments (TV tv1) (TV tv2)				= (Equal, [(tv1.tv_ident,tv2.tv_ident)])
+		compare_arguments type1 type2 				    = (Equal, [])
 			
 compareArguments [{at_type=type1}:types1] [{at_type=type2}:types2]
 	= compareInstanceTypes type1 type2 CAND compareArguments types1 types2
 compareArguments [] []
-	= (Equal, [],[])
+	= (Equal, [])
 compareArguments [] types
-	= (Smaller, [],[])
+	= (Smaller, [])
 compareArguments types []
-	= (Greater, [],[])
+	= (Greater, [])