From 0adc2f5b87709413a21e681decdb2acd421cf504 Mon Sep 17 00:00:00 2001
From: martinw
Date: Wed, 4 Oct 2000 15:08:52 +0000
Subject: -added position information for let bindings for better error
 messages -bugfix: some SK_LocalMacroFun patterns were missing -bugfix: newly
 generated functions were placed into wrong components -bugfix: functions were
 wrongly specialized

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@246 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
 frontend/StdCompare.icl | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

(limited to 'frontend/StdCompare.icl')

diff --git a/frontend/StdCompare.icl b/frontend/StdCompare.icl
index b772a73..9b25f2e 100644
--- a/frontend/StdCompare.icl
+++ b/frontend/StdCompare.icl
@@ -220,6 +220,34 @@ where
 		compare_arguments (TA tc1 _) (TA tc2 _)	= tc1 =< tc2
 		compare_arguments _ _					= Equal
 
+smallerOrEqual :: !Type !Type -> CompareValue
+smallerOrEqual t1 t2
+		| equal_constructor t1 t2
+			= compare_arguments t1 t2
+		| less_constructor t1 t2
+			= Smaller
+			= Greater
+	where
+		compare_arguments (TA tc1 args1) (TA tc2 args2)
+			# cmp_app_symb = tc1 =< tc2
+			| cmp_app_symb==Equal
+				= args1 =< args2
+			= cmp_app_symb
+		compare_arguments (l1 --> r1) (l2 --> r2)
+			# cmp_app_symb = l1 =< l2
+			| cmp_app_symb==Equal
+				= r1 =< r2
+			= cmp_app_symb
+		compare_arguments (_ :@: args1) (_ :@: args2)
+			= args1 =< args2
+		compare_arguments (TB tb1) (TB tb2)		= tb1 =< tb2 
+		compare_arguments _ _					= Equal
+
+instance =< AType
+where
+	(=<) {at_type=at_type_1} {at_type=at_type_2}
+		= at_type_1 =< at_type_2
+
 instance =< BasicType
 where
 	(=<) bt1 bt2
-- 
cgit v1.2.3