From 8a32b21c043f21cf197cdde3a02ead110302b008 Mon Sep 17 00:00:00 2001
From: alimarin
Date: Thu, 11 Apr 2002 10:01:50 +0000
Subject: support for generic type context like in foo :: a a -> Bool | eq{|*|}
 a

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

(limited to 'frontend/genericsupport.icl')

diff --git a/frontend/genericsupport.icl b/frontend/genericsupport.icl
index b9033e2..2e42006 100644
--- a/frontend/genericsupport.icl
+++ b/frontend/genericsupport.icl
@@ -2,6 +2,21 @@ implementation module genericsupport
 
 import syntax, checksupport
 
+getGenericClassInfo ::
+	!(Global Index)
+	!TypeKind
+	!{#CommonDefs}		
+	!*GenericHeap
+	-> 		
+	( Optional GenericClassInfo
+	, !*GenericHeap					
+	)
+getGenericClassInfo {glob_module, glob_object} kind modules generic_heap
+	#! (gen_def=:{gen_info_ptr}) = modules.[glob_module].com_generic_defs.[glob_object]
+	#! ({gen_classes}, generic_heap) = readPtr gen_info_ptr generic_heap
+	#! opt_class_info = lookupGenericClassInfo kind gen_classes
+	= (opt_class_info, generic_heap)
+
 getGenericMember :: 
 	!(Global Index) 	// generic
 	!TypeKind 			// kind argument
@@ -11,14 +26,31 @@ getGenericMember ::
 	( Optional (Global Index)
 	, !*GenericHeap					
 	)
-getGenericMember {glob_module, glob_object} kind modules generic_heap
-	#! (gen_def=:{gen_info_ptr}) = modules.[glob_module].com_generic_defs.[glob_object]
-	#! ({gen_classes}, generic_heap) = readPtr gen_info_ptr generic_heap
-	= case lookupGenericClassInfo kind gen_classes of
+getGenericMember gen kind modules generic_heap
+	# (opt_class_info, generic_heap) = getGenericClassInfo  gen kind modules generic_heap
+	= case opt_class_info of
 		No -> (No, generic_heap) 
 		Yes {gci_module, gci_member}
 			#! member_glob = {glob_module = gci_module, glob_object = gci_member}
 			-> (Yes member_glob, generic_heap)
+
+getGenericClass :: 
+	!(Global Index) 	// generic
+	!TypeKind 			// kind argument
+	!{#CommonDefs} 		// modules
+	!*GenericHeap
+	-> 		
+	( Optional (Global Index)
+	, !*GenericHeap					
+	)
+getGenericClass gen kind modules generic_heap
+	# (opt_class_info, generic_heap) = getGenericClassInfo  gen kind modules generic_heap
+	= case opt_class_info of
+		No -> (No, generic_heap) 
+		Yes {gci_module, gci_class}
+			#! class_glob = {glob_module = gci_module, glob_object = gci_class}
+			-> (Yes class_glob, generic_heap)
+
 				 
 lookupGenericClassInfo :: !TypeKind !GenericClassInfos	-> !(Optional GenericClassInfo)
 lookupGenericClassInfo kind class_infos
-- 
cgit v1.2.3