added constructor/type/field information to generics

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

16 files changed, 1420 insertions, 624 deletions

diff --git a/frontend/StdCompare.icl b/frontend/StdCompare.icl
index 64ba219..f902857 100644
--- a/frontend/StdCompare.icl
+++ b/frontend/StdCompare.icl
@@ -129,6 +129,8 @@ instance == TypeCons where
 	(==) (TypeConsSymb x) (TypeConsSymb y) = x == y 
 	(==) (TypeConsBasic x) (TypeConsBasic y) = x == y 
 	(==) TypeConsArrow TypeConsArrow = True
+	(==) (TypeConsVar x) (TypeConsVar y) = x == y
+	(==) _ _ = False
 
 ::	CompareValue :== Int
 Smaller :== -1
diff --git a/frontend/check.icl b/frontend/check.icl
index cd4cb8a..0e8f0c7 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -53,7 +53,8 @@ where
 		//# (heaps, cs) = check_generic_vars gen_def heaps cs
 
 		# gen_defs = {gen_defs & [index] = gen_def} 
-		# cs = popErrorAdmin cs	
+		# (cs=:{cs_x}) = popErrorAdmin cs
+		#! cs = { cs & cs_x = {cs_x & x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric}}			
 		= (gen_defs, type_defs, class_defs, modules, heaps, cs)
 				//---> ("check_generic", gen_name, gen_def.gen_vars, gen_def.gen_type)
 
@@ -219,7 +220,8 @@ where
 	
 		#! (heaps, cs) = check_star_case gc_type_cons generic_def gindex heaps cs 
 			
-		#! cs = popErrorAdmin cs	
+		#! (cs=:{cs_x}) = popErrorAdmin cs	
+		#! cs = { cs & cs_x = {cs_x & x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric}}			
 		= (gen_case_defs, generic_defs, type_defs, modules, heaps, cs)
 			//---> ("check_generic_case", gc_name, gc_type_cons)
 
@@ -3408,6 +3410,33 @@ where
 				<=< adjustPredefSymbol PD_TypeEITHER			mod_index STE_Type
 				<=< adjustPredefSymbol PD_ConsLEFT				mod_index STE_Constructor
 				<=< adjustPredefSymbol PD_ConsRIGHT				mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_TypeCONS				mod_index STE_Type
+				<=< adjustPredefSymbol PD_ConsCONS				mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_TypeFIELD				mod_index STE_Type
+				<=< adjustPredefSymbol PD_ConsFIELD				mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_GenericInfo			mod_index STE_Type
+				<=< adjustPredefSymbol PD_NoGenericInfo			mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_GenericConsInfo		mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_GenericFieldInfo		mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_TGenericConsDescriptor mod_index STE_Type
+				<=< adjustPredefSymbol PD_CGenericConsDescriptor mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_TGenericFieldDescriptor mod_index STE_Type
+				<=< adjustPredefSymbol PD_CGenericFieldDescriptor mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_TGenericTypeDefDescriptor mod_index STE_Type
+				<=< adjustPredefSymbol PD_CGenericTypeDefDescriptor mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_TGenConsPrio 			mod_index STE_Type
+				<=< adjustPredefSymbol PD_CGenConsNoPrio 		mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_CGenConsPrio 			mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_TGenConsAssoc 		mod_index STE_Type
+				<=< adjustPredefSymbol PD_CGenConsAssocNone 	mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_CGenConsAssocLeft 	mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_CGenConsAssocRight 	mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_TGenType 				mod_index STE_Type
+				<=< adjustPredefSymbol PD_CGenTypeCons 			mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_CGenTypeVar 			mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_CGenTypeArrow 		mod_index STE_Constructor
+				<=< adjustPredefSymbol PD_CGenTypeApp 			mod_index STE_Constructor
+
 				<=< adjustPredefSymbol PD_GenericBimap			mod_index STE_Generic
 				<=< adjustPredefSymbol PD_bimapId				mod_index STE_DclFunction				
 				<=< adjustPredefSymbol PD_TypeGenericDict		mod_index STE_Type				
diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl
index fc8bff4..030921e 100644
--- a/frontend/checkFunctionBodies.icl
+++ b/frontend/checkFunctionBodies.icl
@@ -3,6 +3,7 @@ implementation module checkFunctionBodies
 import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef //, RWSDebug
 import explicitimports, comparedefimp
 from check import checkFunctions,checkDclMacros
+import compilerSwitches
 
 cIsInExpressionList		:== True
 cIsNotInExpressionList	:== False
@@ -1182,25 +1183,46 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
 		check_generic_expr free_vars entry id kind  e_input e_state e_info cs=:{cs_error}
 			= (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "not a generic" cs_error })						
 
-		check_it free_vars mod_index gen_index id kind e_input e_state=:{es_expr_heap} e_info cs
+		check_it free_vars mod_index gen_index id kind e_input e_state=:{es_expr_heap} e_info cs		
+
+			# (generic_info_expr, es_expr_heap, cs) = build_generic_info es_expr_heap cs 
+			#! (app_args, es_expr_heap, cs) = SwitchGenericInfo 
+				([generic_info_expr], es_expr_heap, cs) 
+				([], es_expr_heap, cs) 		
 			#! symb_kind = SK_Generic { glob_object = gen_index, glob_module = mod_index} kind
 		  	#! symbol = { symb_name = id, symb_kind = symb_kind }			
 			#! (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
-			#! app = { app_symb = symbol, app_args = [], app_info_ptr = new_info_ptr }
+			#! app = { app_symb = symbol, app_args = app_args, app_info_ptr = new_info_ptr }
 			#! e_state = { e_state & es_expr_heap = es_expr_heap }
 			#! cs = { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric }
 			= (App app, free_vars, e_state, e_info, cs)
+		where
+			// adds NoGenericInfo argument to each generic call
+			build_generic_info es_expr_heap cs=:{cs_predef_symbols}
+				#! pds_ident = predefined_idents.[PD_NoGenericInfo]
+				#! ({pds_module, pds_def}, cs_predef_symbols) = cs_predef_symbols ! [PD_NoGenericInfo]
+				#! (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
+				#! app = 
+					{ app_symb = 
+						{ symb_name = pds_ident
+						, symb_kind = SK_Constructor {glob_module=pds_module, glob_object=pds_def} 
+						}
+					, app_args = []
+					, app_info_ptr = new_info_ptr
+ 					}
+			 	= (App app, es_expr_heap, {cs & cs_predef_symbols = cs_predef_symbols})	
 
 		add_kind :: !Index !TypeKind !u:{#GenericDef} !*ExpressionState 
 			-> (!u:{#GenericDef}, !*ExpressionState)			
 		add_kind generic_index kind generic_defs e_state=:{es_generic_heap}
-		/*			
+/*
 			#! ({gen_info_ptr}, generic_defs) = generic_defs ! [generic_index]
 			#! (gen_info, es_generic_heap) = readPtr gen_info_ptr es_generic_heap						
 			#! gen_kinds = eqMerge [(kind,NoIndex)] gen_info.gen_kinds   
 			#! es_generic_heap = writePtr gen_info_ptr {gen_info&gen_kinds=gen_kinds} es_generic_heap
-		*/	
+*/
 			= (generic_defs, {e_state & es_generic_heap = es_generic_heap}) 									 
+
 checkExpression free_vars expr e_input e_state e_info cs
 	= abort "checkExpression (checkFunctionBodies.icl, line 868)" // <<- expr
 
diff --git a/frontend/compilerSwitches.dcl b/frontend/compilerSwitches.dcl
index 72a3822..0223018 100644
--- a/frontend/compilerSwitches.dcl
+++ b/frontend/compilerSwitches.dcl
@@ -8,6 +8,7 @@ switch_import_syntax one_point_three two_point_zero :== two_point_zero
 SwitchPreprocessor preprocessor no_preprocessor :== preprocessor
 
 SwitchGenerics on off :== off
+SwitchGenericInfo on off :== on
 
 // MV...
 // - change T_ypeObjectType in StdDynamic (remove DummyModuleName-argument of T_ypeConsSymbol)
diff --git a/frontend/compilerSwitches.icl b/frontend/compilerSwitches.icl
index 09ac960..4a31b5e 100644
--- a/frontend/compilerSwitches.icl
+++ b/frontend/compilerSwitches.icl
@@ -8,6 +8,7 @@ switch_import_syntax one_point_three two_point_zero :== two_point_zero
 SwitchPreprocessor preprocessor no_preprocessor :== preprocessor
 
 SwitchGenerics on off :== off
+SwitchGenericInfo on off :== on
 
 // MV...
 // - change T_ypeObjectType in StdDynamic (remove DummyModuleName-argument of T_ypeConsSymbol)
diff --git a/frontend/generics1.icl b/frontend/generics1.icl
index 5f0ead6..ac7e3d1 100644
--- a/frontend/generics1.icl
+++ b/frontend/generics1.icl
@@ -15,6 +15,7 @@ from transform import Group
 //3.1
 
 import genericsupport
+import compilerSwitches
 
 //****************************************************************************************
 //	tracing
@@ -35,6 +36,26 @@ traceGenerics context message x
 :: Groups :== {!Group}
 :: FunsAndGroups :== (!Index, !Index, ![FunDef], ![Group])
 
+:: *GenericState = 
+	{ gs_modules :: !*Modules
+	, gs_exprh :: !*ExpressionHeap
+	, gs_genh :: !*GenericHeap
+	, gs_varh :: !*VarHeap
+	, gs_tvarh :: !*TypeVarHeap
+	, gs_avarh :: !*AttrVarHeap 
+	, gs_error :: !*ErrorAdmin
+	, gs_symtab :: !*SymbolTable
+	, gs_dcl_modules :: !*DclModules
+	, gs_td_infos :: !*TypeDefInfos
+	, gs_funs :: !*{#FunDef}
+	, gs_groups :: {!Group}
+	// non-unique, read only
+	, gs_predefs :: !PredefinedSymbols
+	, gs_main_module :: !Index
+	, gs_used_modules :: !NumberSet
+	}
+
+
 //**************************************************************************************
 // Exported functions
 //**************************************************************************************
@@ -86,50 +107,72 @@ convertGenerics
 
 	#! td_infos = clearTypeDefInfos td_infos
 		//---> ("used module numbers ", main_dcl_module_n, numberSetToList used_module_numbers)
-	#! (modules, heaps) 
-		= traceGenerics "convertGenerics" "buildGenericRepresentations" 
-			(clearGenericDefs modules heaps) 
-
-	# (iso_range, funs, groups, td_infos, modules, heaps, error)
-		= traceGenerics "convertGenerics" "buildGenericRepresentations" 
-			(buildGenericRepresentations main_dcl_module_n predefs 
-				funs groups td_infos modules heaps error)
-				
-	| not error.ea_ok
-		= (modules, groups, funs, [], td_infos, heaps, hash_table, u_predefs, dcl_modules, error)
-
-	// build classes for each kind of each generic function
-	#! (modules, dcl_modules, heaps, symbol_table, td_infos, error) 
-		= traceGenerics "convertGenerics" "buildClasses" 
-			(buildClasses 
-				main_dcl_module_n used_module_numbers 
-				modules dcl_modules heaps hash_table.hte_symbol_heap td_infos error)
-	#! hash_table = { hash_table & hte_symbol_heap = symbol_table }	
-	| not error.ea_ok
-		= (modules, groups, funs, [], td_infos, heaps, hash_table, u_predefs, dcl_modules, error)
-
-	#! (instance_range, funs, groups, modules, dcl_modules, td_infos, heaps, error)
-		= traceGenerics "convertGenerics" "convertGenericCases"
-			(convertGenericCases main_dcl_module_n used_module_numbers predefs funs groups modules dcl_modules td_infos heaps error)
-
-	| not error.ea_ok
-		= (modules, groups, funs, [], td_infos, heaps, hash_table, u_predefs, dcl_modules, error)
-	
-	
-	#! (funs, modules, dcl_modules, heaps, error)
-		= traceGenerics "convertGenerics" "convertGenericTypeContexts"
-			(convertGenericTypeContexts main_dcl_module_n used_module_numbers predefs funs modules dcl_modules heaps error)
-	
-	| not error.ea_ok
-		= (modules, groups, funs, [], td_infos, heaps, hash_table, u_predefs, dcl_modules, error)
-	
+	#! (modules, heaps) = clearGenericDefs modules heaps
+
+	# {hp_var_heap, hp_generic_heap, hp_type_heaps={th_vars, th_attrs}, hp_expression_heap} = heaps
+	# gs = 
+		{ gs_modules = modules
+		, gs_symtab = hash_table.hte_symbol_heap
+		, gs_dcl_modules = dcl_modules
+		, gs_td_infos = td_infos
+		, gs_exprh = hp_expression_heap	
+		, gs_genh = hp_generic_heap	
+		, gs_varh = hp_var_heap
+		, gs_tvarh = th_vars
+		, gs_avarh = th_attrs
+		, gs_error = error	
+		, gs_funs = funs
+		, gs_groups = groups	
+		, gs_predefs = predefs
+		, gs_main_module = main_dcl_module_n
+		, gs_used_modules = used_module_numbers
+		} 
+
+	# (generic_ranges, gs) = convert_generics gs
+
+	#	{ 	gs_modules = modules, gs_symtab, gs_dcl_modules = dcl_modules, gs_td_infos = td_infos, 
+			gs_genh = hp_generic_heap, gs_varh = hp_var_heap, gs_tvarh = th_vars, gs_avarh = th_attrs, 
+			gs_exprh = hp_expression_heap,	
+			gs_error = error, gs_funs = funs, gs_groups = groups,
+			gs_predefs = predefs, gs_main_module = main_dcl_module_n, gs_used_modules = used_module_numbers} = gs
+	#! hash_table = { hash_table & hte_symbol_heap = gs_symtab }
+	#! heaps = 
+		{ hp_expression_heap = hp_expression_heap
+		, hp_var_heap = hp_var_heap
+		, hp_generic_heap = hp_generic_heap
+		, hp_type_heaps = { th_vars = th_vars, th_attrs = th_attrs }
+		}	
+		
 	//#! funs = dump_funs 0 funs
 	//#! dcl_modules = dump_dcl_modules 0 dcl_modules
 	//#! error = error ---> "************************* generic phase completed ******************** "
 	//| True = abort "generic phase aborted for testing\n"		
-	= (modules, groups, funs, [iso_range, instance_range], td_infos, heaps, hash_table, u_predefs, dcl_modules, error)
+	= (modules, groups, funs, generic_ranges, td_infos, heaps, hash_table, u_predefs, dcl_modules, error)
 where
 
+	convert_generics :: !*GenericState -> (![IndexRange], !*GenericState)
+	convert_generics gs		
+		#! (iso_range, gs) = buildGenericRepresentations gs
+		#! (ok, gs) = gs_ok gs
+		| not ok = ([], gs)	
+		
+		#! gs = buildClasses gs			
+		#! (ok, gs) = gs_ok gs
+		| not ok = ([], gs)	
+
+		#! (instance_range, gs) = convertGenericCases gs
+		#! (ok, gs) = gs_ok gs
+		| not ok = ([], gs)	
+
+		#! gs = convertGenericTypeContexts gs
+
+		= ([iso_range,instance_range], gs)
+
+	gs_ok :: !*GenericState -> (!Bool, !*GenericState)
+	gs_ok gs=:{gs_error} 
+		#! ok = gs_error.ea_ok
+		= (ok, {gs & gs_error = gs_error})
+
 	dump_funs n funs 
 		| n == size funs
 			= funs
@@ -201,126 +244,223 @@ where
 
 // generic representation is built for each type argument of
 // generic cases of the current module
-buildGenericRepresentations ::
-		!Index
-		!PredefinedSymbols
-		!*FunDefs
-		!Groups
-		!*TypeDefInfos
-		!*Modules
-		!*Heaps
-		!*ErrorAdmin
-	->	( !IndexRange
-		, !*FunDefs
-		, !Groups
-		, !*TypeDefInfos
-		, !*Modules
-		, !*Heaps
-		, !*ErrorAdmin
-		) 
-buildGenericRepresentations main_module_index predefs funs groups td_infos modules heaps error
+buildGenericRepresentations :: !*GenericState -> (!IndexRange, !*GenericState)
+buildGenericRepresentations gs=:{gs_main_module, gs_modules, gs_funs, gs_groups}
+	#! (size_funs, gs_funs) = usize gs_funs
+	#! size_groups = size gs_groups
+	#! ({com_gencase_defs}, gs_modules) = gs_modules ! [gs_main_module]
 	
-	#! size_funs = size funs
-	#! size_groups = size groups
-	#! ({com_gencase_defs}, modules) = modules ! [main_module_index]
-			
-	#! ((new_fun_index, new_group_index, new_funs, new_groups), td_infos, modules, heaps, error) 
-		= foldArraySt on_gencase com_gencase_defs ((size_funs, size_groups, [], []), td_infos, modules, heaps, error)
+	#! gs = { gs & gs_modules = gs_modules, gs_funs = gs_funs, gs_groups = gs_groups }			
+	#! ((new_fun_index, new_group_index, new_funs, new_groups), gs) 
+		= foldArraySt on_gencase com_gencase_defs ((size_funs, size_groups, [], []), gs)
 
-	#! funs = arrayPlusRevList funs new_funs
-	#! groups = arrayPlusRevList groups new_groups
+	# {gs_funs, gs_groups} = gs
+	#! gs_funs = arrayPlusRevList gs_funs new_funs
+	#! gs_groups = arrayPlusRevList gs_groups new_groups
 
 	#! range = {ir_from = size_funs, ir_to = new_fun_index}
 
-	= (range, funs, groups, td_infos, modules, heaps, error)
+	= (range, {gs & gs_funs = gs_funs, gs_groups = gs_groups})
 where 
 
-	on_gencase index case_def=:{gc_type_cons,gc_name} st
-		= build_generic_rep_if_needed gc_type_cons st 
-
-	build_generic_rep_if_needed :: 
-			!TypeCons !((!Index,!Index,![FunDef],![Group]), !*TypeDefInfos, !*{#CommonDefs}, !*Heaps, !*ErrorAdmin)	
-		->  (!(!Index, !Index, ![FunDef], ![Group]), !*TypeDefInfos, !*{#CommonDefs}, !*Heaps, !*ErrorAdmin)
-	build_generic_rep_if_needed (TypeConsSymb {type_index={glob_module,glob_object}, type_name}) (funs_and_groups, td_infos, modules, heaps, error)
-		#! (type_def, modules) = modules![glob_module].com_type_defs.[glob_object]
-		#! (td_info, td_infos) = td_infos![glob_module, glob_object]
+	on_gencase index 
+			case_def=:{gc_type_cons=TypeConsSymb {type_index={glob_module,glob_object}, type_name},
+			 	gc_name, gc_body=GCB_FunIndex fun_index, gc_pos} 
+			(funs_and_groups, gs=:{gs_modules, gs_td_infos, gs_funs})
+		#! (type_def, gs_modules) = gs_modules![glob_module].com_type_defs.[glob_object]
+		#! (td_info, gs_td_infos) = gs_td_infos![glob_module, glob_object]
 		#! type_def_gi = {gi_module=glob_module,gi_index=glob_object}
-		= case td_info.tdi_gen_rep of
-			Yes _ 
-				-> (funs_and_groups, td_infos, modules, heaps, error)
-					//---> ("generic representation is already built", type_name)
-			No 
-				#! (gen_type_rep, funs_and_groups, modules, heaps, error)
-					= buildGenericTypeRep type_def_gi main_module_index predefs funs_and_groups modules heaps error
-							
-				#! td_info = {td_info & tdi_gen_rep = Yes gen_type_rep}
-				#! td_infos = {td_infos & [glob_module, glob_object] = td_info} 
-				-> (funs_and_groups, td_infos, modules, heaps, error)					
-					//---> ("build generic representation", type_name)
-	build_generic_rep_if_needed _ st = st 
+		#! ({fun_body}, gs_funs) = gs_funs ! [fun_index]
+		#! gs = {gs & gs_modules = gs_modules, gs_td_infos = gs_td_infos, gs_funs = gs_funs}
+		
+		= case fun_body of
+			TransformedBody _ 
+				// does not need a generic representation
+				-> (funs_and_groups, gs)
+				
+			GeneratedBody	
+				// needs a generic representation
+				
+				-> case type_def.td_rhs of
+					SynType _
+						#  gs_error = reportError gc_name gc_pos ("cannot derive a generic instance for a synonym type " +++ type_def.td_name.id_name) gs.gs_error
+						-> (funs_and_groups, {gs & gs_error = gs_error})	
+					AbstractType _
+						#  gs_error = reportError gc_name gc_pos ("cannot derive a generic instance for an abstract type "  +++ type_def.td_name.id_name) gs.gs_error
+						-> (funs_and_groups, {gs & gs_error = gs_error})	
+					_ 
+						-> case td_info.tdi_gen_rep of
+							Yes _ 
+								-> (funs_and_groups, gs)
+									//---> ("generic representation is already built", type_name)
+							No 
+								#! (gen_type_rep, funs_and_groups, gs)
+									= buildGenericTypeRep type_def_gi funs_and_groups gs
+				
+								#! td_info = {td_info & tdi_gen_rep = Yes gen_type_rep}
+								# {gs_td_infos} = gs	
+								#! gs_td_infos = {gs_td_infos & [glob_module, glob_object] = td_info} 
+								# gs = {gs & gs_td_infos = gs_td_infos }
+								-> (funs_and_groups, gs)					
+									//---> ("build generic representation", type_name)
+	on_gencase _ _ st = st
+
+
+:: ConsInfo = {ci_cons_info :: DefinedSymbol, ci_field_infos :: [DefinedSymbol]}
 	
 buildGenericTypeRep :: 
 		!GlobalIndex 			// type def index
-		!Index 					// main module index 
-		!PredefinedSymbols 	
 		!(!Index,!Index,![FunDef],![Group]) 
-		!*{#CommonDefs} 
-		!*Heaps 
-		!*ErrorAdmin 
+		!*GenericState 
 	->	( !GenericTypeRep
 		, !(!Index, !Index, ![FunDef], ![Group])
-		, !*{#CommonDefs} 
-		, !*Heaps
-		, !*ErrorAdmin
+		, !*GenericState
 		)
-buildGenericTypeRep type_index main_module_index predefs funs_and_groups modules heaps error
-	# (type_def, modules) = modules![type_index.gi_module].com_type_defs.[type_index.gi_index]
-	# (atype, modules,error) = buildStructureType type_index predefs modules error
-	
-	# (from_fun_ds, funs_and_groups, heaps, error)
-		= buildConversionFrom type_index.gi_module type_def main_module_index predefs funs_and_groups heaps error
-
-	# (to_fun_ds, funs_and_groups, heaps, error)
-		= buildConversionTo type_index.gi_module type_def main_module_index predefs funs_and_groups heaps error
-
-	# (iso_fun_ds, funs_and_groups, heaps, error)
-		= buildConversionIso type_def from_fun_ds to_fun_ds main_module_index predefs funs_and_groups heaps error
-
-	= ({gtr_type=atype,gtr_iso=iso_fun_ds}, funs_and_groups, modules, heaps, error)
+buildGenericTypeRep type_index funs_and_groups
+		gs=:{gs_modules, gs_predefs, gs_main_module, gs_error, gs_td_infos,
+			gs_exprh, gs_varh, gs_genh, gs_avarh, gs_tvarh}
+		
+	# heaps = 
+		{ hp_expression_heap = gs_exprh
+		, hp_var_heap = gs_varh
+		, hp_generic_heap = gs_genh
+		, hp_type_heaps = { th_vars = gs_tvarh, th_attrs = gs_avarh }
+		}	
+		
+	# (type_def, gs_modules) = gs_modules![type_index.gi_module].com_type_defs.[type_index.gi_index]
+
+	# (cons_infos, funs_and_groups, gs_modules, heaps, gs_error) 
+		= buildTypeDefInfo type_index.gi_module type_def gs_main_module gs_predefs funs_and_groups gs_modules heaps gs_error
+
+	# (atype, gs_modules, gs_td_infos, gs_error) 
+		= buildStructType type_index cons_infos gs_predefs gs_modules gs_td_infos gs_error
+	
+	# (from_fun_ds, funs_and_groups, heaps, gs_error)
+		= buildConversionFrom type_index.gi_module type_def gs_main_module gs_predefs funs_and_groups heaps gs_error
+
+	# (to_fun_ds, funs_and_groups, heaps, gs_error)
+		= buildConversionTo type_index.gi_module type_def gs_main_module gs_predefs funs_and_groups heaps gs_error
+
+	# (iso_fun_ds, funs_and_groups, heaps, gs_error)
+		= buildConversionIso type_def from_fun_ds to_fun_ds gs_main_module gs_predefs funs_and_groups heaps gs_error
+
+	# {hp_expression_heap, hp_var_heap, hp_generic_heap, hp_type_heaps={th_vars, th_attrs}} = heaps
+	# gs =
+		{ gs 
+		& gs_modules = gs_modules
+		, gs_td_infos = gs_td_infos
+		, gs_error = gs_error
+		, gs_avarh = th_attrs
+		, gs_tvarh = th_vars
+		, gs_varh = hp_var_heap
+		, gs_genh = hp_generic_heap
+		, gs_exprh = hp_expression_heap
+		}
+	= ({gtr_type=atype,gtr_iso=iso_fun_ds}, funs_and_groups, gs)
 		//---> ("buildGenericTypeRep", type_def.td_name, atype)
 	
 //========================================================================================
 //	the structure type
 //========================================================================================
 
-buildStructureType :: 
-		!GlobalIndex				// type definition module 
+convertATypeToGenTypeStruct :: !Ident !Position !AType (!*TypeDefInfos, !*ErrorAdmin) 
+	-> (GenTypeStruct, (!*TypeDefInfos, !*ErrorAdmin))
+convertATypeToGenTypeStruct ident pos type st
+	= convert type st	
+where	
+	convert {at_type=TA type_symb args} st
+		= convert_type_app type_symb args st
+	convert {at_type=TAS type_symb args _} st
+		= convert_type_app type_symb args st
+	convert {at_type=(CV tv) :@: args} st
+		#! (args, st) = mapSt convert args st
+		= (GTSAppVar tv args, st)  
+	convert {at_type=x --> y} st
+		#! (x, st) = convert x st
+		#! (y, st) = convert y st
+		= (GTSAppCons (KindArrow [KindConst, KindConst]) [x,y], st)  
+	convert {at_type=TV tv} st
+		= (GTSVar tv, st)  
+	convert {at_type=TB _} st
+		= (GTSAppCons KindConst [], st)  
+	convert {at_type=type} (td_infos, error) 
+		# error = reportError ident pos ("can not build generic representation for this type", type) error
+		= (GTSE, (td_infos, error))
+
+	convert_type_app {type_index} args (td_infos, error)
+		#! ({tdi_kinds}, td_infos) = td_infos ! [type_index.glob_module,type_index.glob_object]
+		#! kind = if (isEmpty tdi_kinds) KindConst (KindArrow tdi_kinds)
+		#! (args, st) = mapSt  convert args (td_infos, error)
+		= (GTSAppCons kind args, st)  
+
+buildStructType ::
+		!GlobalIndex				// type def global index 
+		![ConsInfo]					// constructor and field info symbols
 		!PredefinedSymbols
 		!*{#CommonDefs}
+		!*TypeDefInfos
 		!*ErrorAdmin
-	-> 	( !AType			// the structure type
+	-> 	( !GenTypeStruct			// the structure type
 		, !*{#CommonDefs}
+		, !*TypeDefInfos
 		, !*ErrorAdmin
 		)
-buildStructureType {gi_module,gi_index} predefs modules error
+buildStructType {gi_module,gi_index} cons_infos predefs modules td_infos error
 	# (type_def=:{td_name}, modules) = modules![gi_module].com_type_defs.[gi_index]	
 	# (common_defs, modules) = modules ! [gi_module]	
-	# (atype, error) = build_type type_def common_defs error	
-	= (atype, modules, error)
+	# (stype, (td_infos, error)) = build_type type_def cons_infos common_defs (td_infos, error)	
+	= (stype, modules, td_infos, error)
 		//---> ("buildStructureType", td_name, atype)	
-where 
-	build_type {td_rhs=(AlgType alts)} common_defs error
-		# cons_defs = [common_defs.com_cons_defs.[ds_index] \\ {ds_index} <- alts]
-		# cons_args = [buildProductType cons_def.cons_type.st_args predefs \\ cons_def <- cons_defs]
-		= (buildSumType cons_args predefs, error) 	
-	build_type {td_rhs=(RecordType {rt_constructor={ds_index}})} common_defs error
-		# cons_def = common_defs.com_cons_defs.[ds_index]
-		= (buildProductType cons_def.cons_type.st_args predefs, error)
-	build_type {td_rhs=(SynType type)} common_defs error
-		= (type /* is that correct ???*/, error)
-	build_type td=:{td_rhs=(AbstractType _),td_name, td_arity, td_args, td_pos} common_defs error
-		= (makeAType TE TA_Multi, 
-			reportError td_name td_pos "cannot build a generic representation of an abstract type" error)
+where
+	build_type {td_rhs=AlgType alts, td_name, td_pos} cons_infos common_defs st
+		# (cons_args, st) = zipWithSt (build_alt td_name td_pos common_defs) alts cons_infos st
+		= (build_sum_type cons_args, st) 
+
+/*
+	build_type {td_rhs=RecordType {rt_constructor}, td_name, td_pos} [cdi] common_defs st		
+		= build_alt td_name td_pos common_defs rt_constructor cdi st
+*/
+	build_type 
+			{td_rhs=RecordType {rt_constructor}, td_name, td_pos} 
+			[{ci_cons_info, ci_field_infos}] 
+			common_defs st		
+		# ({cons_type={st_args}}) = common_defs.com_cons_defs.[rt_constructor.ds_index]	
+		# (args, st) = mapSt (convertATypeToGenTypeStruct td_name td_pos) st_args st
+		
+		# args = SwitchGenericInfo [GTSField fi arg \\ arg <- args & fi <- ci_field_infos] args
+			
+		# prod_type = build_prod_type args		
+		# type = SwitchGenericInfo (GTSCons ci_cons_info prod_type) prod_type		
+		= (type, st)		
+
+		
+	build_type {td_rhs=SynType type,td_name, td_pos} cons_infos common_defs st
+		// ???
+		= convertATypeToGenTypeStruct td_name td_pos type st
+	build_type td=:{td_rhs=(AbstractType _),td_name, td_arity, td_args, td_pos} cdis common_defs (td_infos, error)
+		# error = reportError td_name td_pos "cannot build a generic representation of an abstract type" error
+		= (GTSE, (td_infos, error))
+		
+	build_alt td_name td_pos common_defs cons_def_sym=:{ds_index} {ci_cons_info} st
+		# ({cons_type={st_args}}) = common_defs.com_cons_defs.[ds_index]	
+		# (args, st) = mapSt (convertATypeToGenTypeStruct td_name td_pos) st_args st	
+		# prod_type = build_prod_type args		
+		# type = SwitchGenericInfo (GTSCons ci_cons_info prod_type) prod_type		
+		= (type, st)		
+
+	build_prod_type :: [GenTypeStruct] -> GenTypeStruct
+	build_prod_type types 
+		= listToBin build_pair build_unit types	
+	where
+		build_pair x y = GTSAppCons (KindArrow [KindConst, KindConst]) [x, y]	
+		build_unit = GTSAppCons KindConst []	
+		
+	build_sum_type :: [GenTypeStruct] -> GenTypeStruct
+	build_sum_type types
+		= listToBin build_either build_void types
+	where
+		build_either x y = GTSAppCons (KindArrow [KindConst, KindConst]) [x, y]	
+		build_void = abort "sanity check: no alternatives in a type\n"		
 		
 // build a product of types
 buildProductType :: ![AType] !PredefinedSymbols -> !AType
@@ -355,6 +495,243 @@ buildPredefTypeApp predef_index args predefs
 	# type_symb = MakeTypeSymbIdent global_index pds_ident (length args) 		  
 	= makeAType (TA type_symb args) TA_Multi
 
+
+//========================================================================================
+//	build type infos
+//========================================================================================
+buildTypeDefInfo :: 
+		!Index 				// type def module
+		!CheckedTypeDef		// the type definition
+		!Index				// icl module
+		!PredefinedSymbols		
+		!FunsAndGroups
+		!*Modules
+		!*Heaps
+		!*ErrorAdmin
+	-> 	( ![ConsInfo]
+		, !FunsAndGroups
+		, !*Modules
+		, !*Heaps
+		, !*ErrorAdmin
+		)
+buildTypeDefInfo td_module td=:{td_rhs = AlgType alts} main_module_index predefs funs_and_groups modules heaps error
+	= buildTypeDefInfo2 td_module td alts [] main_module_index predefs funs_and_groups modules heaps error
+
+buildTypeDefInfo td_module td=:{td_rhs=RecordType {rt_constructor, rt_fields}} main_module_index predefs funs_and_groups modules heaps error
+	= buildTypeDefInfo2 td_module td [rt_constructor] [x\\x<-:rt_fields] main_module_index predefs funs_and_groups modules heaps error
+
+buildTypeDefInfo td_module td=:{td_rhs = SynType type, td_name, td_pos} main_module_index predefs funs_and_groups modules heaps error
+	# error = reportError td_name td_pos "cannot build constructor uinformation for a synonym type" error
+	= buildTypeDefInfo2 td_module td [] [] main_module_index predefs funs_and_groups modules heaps error
+
+buildTypeDefInfo td_module td=:{td_rhs = AbstractType _, td_name, td_pos} main_module_index predefs funs_and_groups modules heaps error
+	# error = reportError td_name td_pos "cannot build constructor uinformation for an abstract type" error
+	= buildTypeDefInfo2 td_module td [] [] main_module_index predefs funs_and_groups modules heaps error
+
+buildTypeDefInfo2 td_module td alts fields main_module_index predefs funs_and_groups modules heaps error
+	= SwitchGenericInfo 
+		(buildTypeDefInfo1 td_module td alts fields main_module_index predefs funs_and_groups modules heaps error) 
+		(dummy, funs_and_groups, modules, heaps, error) 
+where
+	dummy_ds = {ds_index = -1, ds_arity = 0, ds_ident = makeIdent "<dummy_generic_info>"} 
+	dummy = (dummy_ds, repeatn (length alts) dummy_ds)
+
+buildTypeDefInfo1 td_module {td_name, td_pos, td_arity} alts fields main_module_index predefs (fun_index, group_index, funs, groups) modules heaps error
+
+	# num_conses = length alts
+	# num_fields = length fields
+	# new_group_index = inc group_index
+
+	# type_def_dsc_index = fun_index
+	# first_cons_dsc_index = fun_index + 1
+	# cons_dsc_indexes = [first_cons_dsc_index .. first_cons_dsc_index + num_conses - 1]
+	# first_field_dsc_index = first_cons_dsc_index + num_conses
+	# field_dsc_indexes = [first_field_dsc_index .. first_field_dsc_index + num_fields - 1]
+	# new_fun_index = first_field_dsc_index + num_fields
+
+	# group = {group_members = [fun_index .. new_fun_index - 1]}
+	# new_groups = [group:groups]
+	
+	# type_def_dsc_ds = {ds_arity=0, ds_ident=makeIdent("tdi_"+++td_name.id_name), ds_index=type_def_dsc_index}
+	# cons_dsc_dss = [ {ds_arity=0, ds_ident=makeIdent("cdi_"+++ds_ident.id_name), ds_index=i} \\ 
+		{ds_ident} <- alts & i <- cons_dsc_indexes]
+	# field_dsc_dss = [ {ds_arity=0, ds_ident=makeIdent("fdi_"+++fs_name.id_name), ds_index=i} \\ 
+		{fs_name} <- fields & i <- field_dsc_indexes]
+	
+	# (type_def_dsc_fun, heaps) = build_type_def_dsc group_index cons_dsc_dss type_def_dsc_ds heaps	
+	
+	# (cons_dsc_funs, (modules, heaps)) = zipWithSt (build_cons_dsc group_index type_def_dsc_ds field_dsc_dss) cons_dsc_dss alts (modules, heaps) 
+	
+	# (field_dsc_funs, (modules, heaps)) = zipWithSt (build_field_dsc group_index (hd cons_dsc_dss)) field_dsc_dss fields (modules, heaps)
+	 
+	// NOTE: reverse order 
+	# new_funs = field_dsc_funs ++ cons_dsc_funs ++ [type_def_dsc_fun] ++ funs 
+	
+	# funs_and_groups = (new_fun_index, new_group_index, new_funs, new_groups)
+	
+	# (cons_info_dss, (funs_and_groups, heaps)) 
+		= mapSt build_cons_info cons_dsc_dss (funs_and_groups, heaps)
+
+	# (field_info_dss, (funs_and_groups, heaps)) 
+		= mapSt build_field_info field_dsc_dss (funs_and_groups, heaps)
+
+	# cons_infos = case (cons_info_dss, field_info_dss) of
+		([cons_info_ds], field_infos) -> [{ci_cons_info = cons_info_ds, ci_field_infos = reverse field_infos}] 	 
+		(cons_info_dss, []) -> [{ci_cons_info=x,ci_field_infos=[]}\\x<-cons_info_dss]
+		_ -> abort "generics.icl sanity check: fields in non-record type\n"
+
+	= (cons_infos, funs_and_groups, modules, heaps, error)
+where
+
+	build_type_def_dsc group_index cons_info_dss {ds_index, ds_ident}  heaps	
+		# td_name_expr = makeStringExpr td_name.id_name
+		# td_arity_expr = makeIntExpr td_arity
+		# (cons_info_exprs, heaps) = mapSt (\x st->buildFunApp main_module_index x [] st) cons_info_dss heaps
+		# (td_conses_expr, heaps) = makeListExpr cons_info_exprs predefs heaps
+		
+		# (body_expr, heaps) = buildPredefConsApp PD_CGenericTypeDefDescriptor 
+			[td_name_expr, td_arity_expr, td_conses_expr] 
+			predefs heaps	
+						
+		# fun = makeFunction ds_ident ds_index group_index [] body_expr No main_module_index td_pos		
+		= (fun, heaps)
+
+	build_cons_dsc group_index type_def_info_ds field_dsc_dss cons_info_ds cons_ds (modules, heaps)
+		# ({cons_symb, cons_type, cons_priority}, modules)	= modules! [td_module].com_cons_defs.[cons_ds.ds_index]  		
+		# name_expr 			 = makeStringExpr cons_symb.id_name
+		# arity_expr 			 = makeIntExpr cons_type.st_arity
+		# (prio_expr, heaps)	 = make_prio_expr cons_priority heaps
+		# (type_def_expr, heaps) = buildFunApp main_module_index type_def_info_ds [] heaps
+		# (type_expr, heaps) 	 = make_type_expr cons_type heaps 			
+		# (field_exprs, heaps)   = mapSt (\x st->buildFunApp main_module_index x [] st) field_dsc_dss heaps
+		# (fields_expr, heaps)   =  makeListExpr field_exprs predefs heaps 
+		# (body_expr, heaps) 
+			= buildPredefConsApp PD_CGenericConsDescriptor 
+				[ name_expr 
+				, arity_expr
+				, prio_expr
+				, type_def_expr
+				, type_expr
+				, fields_expr 
+				]  
+				predefs heaps
+
+		# fun = makeFunction cons_info_ds.ds_ident cons_info_ds.ds_index group_index [] body_expr No main_module_index td_pos		
+		= (fun, (modules, heaps))
+	where
+		make_prio_expr NoPrio heaps
+			= buildPredefConsApp PD_CGenConsNoPrio [] predefs heaps
+		make_prio_expr (Prio assoc prio) heaps
+			# assoc_predef = case assoc of
+				NoAssoc 	-> PD_CGenConsAssocNone 
+				LeftAssoc 	-> PD_CGenConsAssocLeft
+				RightAssoc 	-> PD_CGenConsAssocRight
+			# (assoc_expr, heaps) = buildPredefConsApp assoc_predef [] predefs heaps 	
+			# prio_expr = makeIntExpr prio		
+			= buildPredefConsApp PD_CGenConsPrio [assoc_expr, prio_expr] predefs heaps 
+
+		make_type_expr {st_args, st_result} heaps		
+			# (arg_exprs, heaps) = mapSt make_expr1 st_args heaps		
+			# (result_expr, heaps) = make_expr1 st_result heaps
+			= curry arg_exprs result_expr heaps  
+		where
+		
+			curry [] result_expr heaps 
+				= (result_expr, heaps)
+			curry [x:xs] result_expr heaps
+				# (y, heaps) = curry xs result_expr heaps
+				= make_arrow x y heaps
+		
+			make_expr1 :: !AType !*Heaps -> (!Expression, !*Heaps)
+			make_expr1 {at_type} heaps = make_expr at_type heaps
+		
+			make_expr :: !Type !*Heaps -> (!Expression, !*Heaps)
+			make_expr (TA type_symb arg_types) heaps
+				# (arg_exprs, heaps) = mapSt make_expr1 arg_types heaps
+				# (type_cons, heaps) = make_type_cons type_symb.type_name.id_name heaps 
+				= make_apps type_cons arg_exprs heaps
+			make_expr (TAS type_symb arg_types _) heaps
+				# (arg_exprs, heaps) = mapSt make_expr1 arg_types heaps
+				# (type_cons, heaps) = make_type_cons type_symb.type_name.id_name heaps 
+				= make_apps type_cons arg_exprs heaps
+			make_expr (x --> y) heaps
+				# (x, heaps) = make_expr1 x heaps
+				# (y, heaps) = make_expr1 y heaps				
+				= make_arrow x y heaps
+			make_expr TArrow heaps 
+				= make_type_cons "(->)" heaps
+			make_expr (TArrow1 type) heaps
+				# (arg_expr, heaps) = make_expr1 type heaps 
+				# (arrow_expr, heaps) = make_type_cons "(->)" heaps
+				= make_app arrow_expr arg_expr heaps
+			make_expr (CV {tv_name} :@: arg_types) heaps
+				# (arg_exprs, heaps) = mapSt make_expr1 arg_types heaps
+				# (tv_expr, heaps) = make_type_var tv_name.id_name heaps					
+				= make_apps tv_expr arg_exprs heaps
+			make_expr (TB bt) heaps
+				= make_type_cons (toString bt) heaps	
+			make_expr (TV {tv_name}) heaps 
+				= make_type_var tv_name.id_name heaps 
+			make_expr (GTV {tv_name}) heaps 
+				= make_type_var tv_name.id_name heaps 
+			make_expr (TQV {tv_name}) heaps 
+				= make_type_var tv_name.id_name heaps
+			make_expr TE heaps
+				= make_type_cons "<error>" heaps	 
+			make_expr _ heaps 
+				= abort "type does not match\n"
+		
+			make_apps x [] heaps 
+				= (x, heaps)
+			make_apps x [y:ys] heaps
+				# (z, heaps) = make_app x y heaps	
+				= make_apps z ys heaps 
+		
+			make_type_cons name heaps
+				# name_expr = makeStringExpr name
+				= buildPredefConsApp PD_CGenTypeCons [name_expr] predefs heaps
+			make_type_var name heaps
+				# name_expr = makeStringExpr name
+				= buildPredefConsApp PD_CGenTypeVar [name_expr] predefs heaps									
+			make_arrow x y heaps = buildPredefConsApp PD_CGenTypeArrow [x, y] predefs heaps
+			make_app x y heaps = buildPredefConsApp PD_CGenTypeApp [x, y] predefs heaps 	 
+
+	build_field_dsc group_index cons_dsc_ds field_dsc_ds {fs_name, fs_index} (modules, heaps)
+		# name_expr = makeStringExpr fs_name.id_name
+		# index_expr = makeIntExpr fs_index
+		# (cons_expr, heaps) = buildFunApp main_module_index cons_dsc_ds [] heaps				
+		# (body_expr, heaps) 
+			= buildPredefConsApp PD_CGenericFieldDescriptor 
+				[ name_expr 
+				, index_expr
+				, cons_expr
+				]  
+				predefs heaps
+		# fun = makeFunction field_dsc_ds.ds_ident field_dsc_ds.ds_index group_index [] body_expr No main_module_index td_pos		
+		= (fun, (modules, heaps))
+		
+	build_cons_info cons_dsc_ds (funs_and_groups, heaps)
+		# ident = makeIdent ("g"+++cons_dsc_ds.ds_ident.id_name)	
+
+		# (cons_dsc_expr, heaps) = buildFunApp main_module_index cons_dsc_ds [] heaps
+
+		# (body_expr, heaps) 
+			= buildPredefConsApp PD_GenericConsInfo [cons_dsc_expr] predefs heaps		
+
+		# (def_sym, funs_and_groups) = buildFunAndGroup ident [] body_expr No main_module_index td_pos funs_and_groups
+		= (def_sym, (funs_and_groups, heaps))
+
+	build_field_info field_dsc_ds (funs_and_groups, heaps)
+		# ident = makeIdent ("g"+++field_dsc_ds.ds_ident.id_name)	
+
+		# (field_dsc_expr, heaps) = buildFunApp main_module_index field_dsc_ds [] heaps
+
+		# (body_expr, heaps) 
+			= buildPredefConsApp PD_GenericFieldInfo [field_dsc_expr] predefs heaps		
+
+		# (def_sym, funs_and_groups) = buildFunAndGroup ident [] body_expr No main_module_index td_pos funs_and_groups
+		= (def_sym, (funs_and_groups, heaps))
+
 //========================================================================================
 //	conversions functions
 //========================================================================================
@@ -444,9 +821,9 @@ where
 			, !*ErrorAdmin
 			)
  	build_expr_for_type_rhs type_def_mod type_def_index (AlgType def_symbols) arg_expr heaps error
-		= build_expr_for_conses type_def_mod type_def_index def_symbols arg_expr heaps error
+		= build_expr_for_conses False type_def_mod type_def_index def_symbols arg_expr heaps error
 	build_expr_for_type_rhs type_def_mod type_def_index (RecordType {rt_constructor}) arg_expr heaps error		
-		= build_expr_for_conses type_def_mod type_def_index [rt_constructor] arg_expr  heaps error
+		= build_expr_for_conses True type_def_mod type_def_index [rt_constructor] arg_expr  heaps error
 	build_expr_for_type_rhs type_def_mod type_def_index (AbstractType _) arg_expr  heaps error
 		#! error = checkErrorWithIdentPos (newPosition td_name td_pos) "cannot build isomorphisms for an abstract type" error
 		= (EE, heaps, error)
@@ -455,43 +832,51 @@ where
 		= (EE, heaps, error)
 	
 	// build conversion for constructors of a type def 	
-	build_expr_for_conses type_def_mod type_def_index cons_def_syms arg_expr heaps error
+	build_expr_for_conses is_record type_def_mod type_def_index cons_def_syms arg_expr heaps error
 		# (case_alts, heaps, error) = 
-			build_exprs_for_conses 0 (length cons_def_syms) type_def_mod cons_def_syms  heaps error
+			build_exprs_for_conses is_record 0 (length cons_def_syms) type_def_mod cons_def_syms  heaps error
 		# case_patterns = AlgebraicPatterns {glob_module = type_def_mod, glob_object = type_def_index} case_alts
 		# (case_expr, heaps) = buildCaseExpr arg_expr case_patterns heaps
 		= (case_expr, heaps, error)	
 			//---> (free_vars, case_expr)		
 	
-	// build conversions for a constructor 	
-	build_exprs_for_conses :: !Int !Int !Int ![DefinedSymbol] !*Heaps !*ErrorAdmin
+	// build conversions for constructors 	
+	build_exprs_for_conses :: !Bool !Int !Int !Int ![DefinedSymbol] !*Heaps !*ErrorAdmin
 		-> ([AlgebraicPattern], !*Heaps, !*ErrorAdmin)
-	build_exprs_for_conses i n type_def_mod [] heaps error = ([], heaps, error) 	
-	build_exprs_for_conses i n type_def_mod [cons_def_sym:cons_def_syms] heaps error
-		#! (alt, heaps, error) = build_expr_for_cons i n type_def_mod cons_def_sym heaps error
-		#! (alts, heaps, error) =  build_exprs_for_conses (i+1) n type_def_mod cons_def_syms heaps error 		
+	build_exprs_for_conses is_record i n type_def_mod [] heaps error = ([], heaps, error) 	
+	build_exprs_for_conses is_record i n type_def_mod [cons_def_sym:cons_def_syms] heaps error
+		#! (alt, heaps, error) = build_expr_for_cons is_record i n type_def_mod cons_def_sym heaps error
+		#! (alts, heaps, error) =  build_exprs_for_conses is_record (i+1) n type_def_mod cons_def_syms heaps error 		
 		= ([alt:alts], heaps, error)
 					
 	// build conversion for a constructor	
-	build_expr_for_cons :: !Int !Int !Int !DefinedSymbol !*Heaps !*ErrorAdmin 
+	build_expr_for_cons :: !Bool !Int !Int !Int !DefinedSymbol !*Heaps !*ErrorAdmin 
 		-> (AlgebraicPattern, !*Heaps, !*ErrorAdmin)
-	build_expr_for_cons 	
-		i n type_def_mod def_symbol=:{ds_ident, ds_arity}
-		heaps error
-	
+	build_expr_for_cons is_record i n type_def_mod cons_def_sym=:{ds_ident, ds_arity} heaps error	
 		#! names = ["x" +++ toString (i+1) +++ toString k \\ k <- [1..ds_arity]]
 		#! (var_exprs, vars, heaps) = buildVarExprs names heaps 
-		#! (expr, heaps) = build_prod var_exprs predefs heaps		
+
+		#! (arg_exprs, heaps) = build_fields (SwitchGenericInfo True False && is_record) var_exprs heaps
+			with
+				build_fields False var_exprs heaps = (var_exprs, heaps)
+				build_fields True var_exprs heaps = mapSt build_field var_exprs heaps
+				build_field var_expr heaps = buildPredefConsApp PD_ConsFIELD [var_expr] predefs heaps 
+
+		#! (expr, heaps) = build_prod arg_exprs predefs heaps
+		#! (expr, heaps) = SwitchGenericInfo (build_cons expr heaps) (expr, heaps)
+			with 
+				build_cons expr heaps = buildPredefConsApp PD_ConsCONS [expr] predefs heaps						
 		#! (expr, heaps) = build_sum i n expr predefs heaps
 				
 		#! alg_pattern = {
-			ap_symbol = {glob_module = type_def_mod, glob_object = def_symbol},
+			ap_symbol = {glob_module = type_def_mod, glob_object = cons_def_sym},
 			ap_vars = vars,
 			ap_expr = expr,
 			ap_position = NoPos
 			}
 		= (alg_pattern, heaps, error)	
 	
+	
 	build_sum :: !Int !Int !Expression !PredefinedSymbols !*Heaps -> (!Expression, !*Heaps)
 	build_sum i n expr predefs heaps
 		| n == 0 	= abort "build sum of zero elements\n"
@@ -566,18 +951,21 @@ where
 			, !*ErrorAdmin
 			)		
 	build_expr_for_type_rhs type_def_mod (AlgType def_symbols) heaps error
-		= build_sum type_def_mod def_symbols heaps error
+		= build_sum False type_def_mod def_symbols heaps error
 	build_expr_for_type_rhs type_def_mod (RecordType {rt_constructor}) heaps error				
-		= build_sum type_def_mod [rt_constructor] heaps	error
+		= build_sum True type_def_mod [rt_constructor] heaps	error
 	build_expr_for_type_rhs type_def_mod (AbstractType _) heaps error
 		#! error = reportError td_name td_pos "cannot build isomorphisms for an abstract type" error
-		= (EE, undef, heaps, error)
+		# dummy_fv = {fv_def_level=(-1), fv_count=0, fv_name=makeIdent "dummy", fv_info_ptr=nilPtr}
+		= (EE, dummy_fv, heaps, error)
 	build_expr_for_type_rhs type_def_mod (SynType _) heaps error
 		#! error = reportError td_name td_pos "cannot build isomorphisms for a synonym type" error
-		= (EE, undef, heaps, error)
+		# dummy_fv = {fv_def_level=(-1), fv_count=0, fv_name=makeIdent "dummy", fv_info_ptr=nilPtr}
+		= (EE, dummy_fv, heaps, error)
 	
 	// build expression for sums
-	build_sum :: 
+	build_sum ::
+			!Bool				// is record 
 			!Index 
 			![DefinedSymbol] 
 			!*Heaps 
@@ -587,20 +975,23 @@ where
 			, !*Heaps
 			, !*ErrorAdmin
 			)
-	build_sum type_def_mod [] heaps error
+	build_sum is_record type_def_mod [] heaps error
 		= abort "algebraic type with no constructors!\n"
-	build_sum type_def_mod [def_symbol] heaps error
+	build_sum is_record type_def_mod [def_symbol] heaps error
 		#! (cons_app_expr, cons_arg_vars, heaps) = build_cons_app type_def_mod def_symbol heaps
-		#! (alt_expr, var, heaps) = build_prod cons_app_expr cons_arg_vars heaps 		
+		#! (prod_expr, var, heaps) = build_prod is_record cons_app_expr cons_arg_vars heaps 
+		#! (alt_expr, var, heaps) = SwitchGenericInfo 
+			(build_case_cons var prod_expr heaps)
+			(prod_expr, var, heaps)
 		= (alt_expr, var, heaps, error)
-	build_sum type_def_mod def_symbols heaps error
+	build_sum is_record type_def_mod def_symbols heaps error
 		#! (left_def_syms, right_def_syms) = splitAt ((length def_symbols) /2) def_symbols
 	
 		#! (left_expr, left_var, heaps, error) 
-			= build_sum type_def_mod left_def_syms heaps error
+			= build_sum is_record type_def_mod left_def_syms heaps error
 
 		#! (right_expr, right_var, heaps, error) 
-			= build_sum type_def_mod right_def_syms heaps error
+			= build_sum is_record type_def_mod right_def_syms heaps error
 	
 		#! (case_expr, var, heaps) = 
 			build_case_either left_var left_expr right_var right_expr heaps
@@ -608,6 +999,7 @@ where
 	
 	// build expression for products
 	build_prod :: 
+			!Bool							// is record
 			!Expression   					// result of the case on product
 			![FreeVar] 						// list of variables of the constructor pattern
 			!*Heaps
@@ -615,18 +1007,23 @@ where
 			, !FreeVar						// top variable
 			, !*Heaps
 			)
-	build_prod expr [] heaps
+	build_prod is_record expr [] heaps
 		= build_case_unit expr heaps	
-	build_prod expr [cons_arg_var] heaps
-		= (expr, cons_arg_var, heaps)	
-	build_prod expr cons_arg_vars heaps
+	build_prod is_record expr [cons_arg_var] heaps
+	
+		#! (arg_expr, var, heaps) = SwitchGenericInfo 
+			(case is_record of True -> build_case_field cons_arg_var expr heaps; False -> (expr, cons_arg_var, heaps))
+			(expr, cons_arg_var, heaps)
+		
+		= (arg_expr, var, heaps)	
+	build_prod is_record expr cons_arg_vars heaps
 		#! (left_vars, right_vars) = splitAt ((length cons_arg_vars) /2) cons_arg_vars		 
-		#! (expr, left_var, heaps) = build_prod expr left_vars heaps
-		#! (expr, right_var, heaps) = build_prod expr right_vars heaps		
+		#! (expr, left_var, heaps) = build_prod is_record expr left_vars heaps
+		#! (expr, right_var, heaps) = build_prod is_record expr right_vars heaps		
 		#! (case_expr, var, heaps) = build_case_pair left_var right_var expr heaps		
 		= (case_expr, var, heaps) 
 	
-	// build constructor applicarion expression
+	// build constructor application expression
 	build_cons_app :: !Index !DefinedSymbol !*Heaps 
 		-> (!Expression, ![FreeVar], !*Heaps)
 	build_cons_app cons_mod def_symbol=:{ds_arity} heaps
@@ -655,6 +1052,21 @@ where
 		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [left_pat, right_pat]
 		= build_case_expr case_patterns heaps
 
+	// CONS case
+	build_case_cons var body_expr heaps
+		# pat = buildPredefConsPattern PD_ConsCONS [var] body_expr predefs	
+		# {pds_module, pds_def} = predefs.[PD_TypeCONS]
+		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
+		= build_case_expr case_patterns heaps 
+	
+	// FIELD case
+	build_case_field var body_expr heaps
+		# pat = buildPredefConsPattern PD_ConsFIELD [var] body_expr predefs	
+		# {pds_module, pds_def} = predefs.[PD_TypeFIELD]
+		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
+		= build_case_expr case_patterns heaps 
+	
+		
 	// case with a variable as the selector expression
 	build_case_expr case_patterns heaps
 		# (var_expr, var, heaps) = buildVarExpr "c" heaps
@@ -666,130 +1078,131 @@ where
 // build kind indexed classes 
 //****************************************************************************************
 
-buildClasses :: 
-		!Int
-		!NumberSet 
-		!*{#CommonDefs} 
-		!*{#.DclModule} 
-		!*Heaps 
-		!*SymbolTable 
-		!*TypeDefInfos
-		!*ErrorAdmin 
-	->	(.{#CommonDefs}
-		,.{#DclModule}
-		,.Heaps
-		,.SymbolTable
-		,.TypeDefInfos
-		,.ErrorAdmin
-		)
-buildClasses main_module_index used_module_numbers modules dcl_modules heaps symbol_table td_infos error
-	#! (common_defs=:{com_class_defs, com_member_defs}, modules) = modules ! [main_module_index]
+buildClasses :: !*GenericState -> !*GenericState
+buildClasses gs=:{gs_modules, gs_main_module}
+	#! (common_defs=:{com_class_defs, com_member_defs}, gs_modules) = gs_modules ! [gs_main_module]
 	#! num_classes = size com_class_defs
 	#! num_members = size com_member_defs
 
-/*
-	#! (modules, (classes, members, new_num_classes, new_num_members, heaps, td_infos, error)) 
-		= mapGenericCaseDefs on_gencase modules ([], [], num_classes, num_members, heaps, td_infos, error)
-*/
-	#! (modules, (classes, members, new_num_classes, new_num_members, heaps, td_infos, error)) 
-		= build_modules 0 modules ([], [], num_classes, num_members, heaps, td_infos, error)
+	#! ((classes, members, new_num_classes, new_num_members), gs=:{gs_modules}) 
+		= build_modules 0 ([], [], num_classes, num_members) {gs & gs_modules = gs_modules}
 
 	// obtain common definitions again because com_gencase_defs are updated 
-	#! (common_defs, modules) = modules ! [main_module_index]	
+	#! (common_defs, gs_modules) = gs_modules ! [gs_main_module]	
 	# common_defs = 
 		{ common_defs 
 		& com_class_defs = arrayPlusRevList com_class_defs classes
 		, com_member_defs = arrayPlusRevList com_member_defs members
 		}
 		
-	#! (common_defs, dcl_modules, heaps, symbol_table) 
-		= build_class_dictionaries common_defs dcl_modules heaps symbol_table
+	#! (common_defs, gs=:{gs_modules}) 
+		= build_class_dictionaries common_defs {gs & gs_modules = gs_modules}
 	
-	#! modules = {modules & [main_module_index] = common_defs}	
-	= (modules, dcl_modules, heaps, symbol_table, td_infos, error)  
+	#! gs_modules = {gs_modules & [gs_main_module] = common_defs}	
+	= {gs & gs_modules = gs_modules}  
 where
-	build_modules module_index modules st
-		| module_index == size modules
-			= (modules, st)
-			#! (common_defs=:{com_gencase_defs}, modules) = modules![module_index] 
-			#! (com_gencase_defs, modules, st) 
-				= build_module module_index com_gencase_defs modules st 
-			#! modules = 
-				{ modules 
+	build_modules :: !Index (![ClassDef], ![MemberDef], !Int, !Int) !*GenericState
+		-> ((![ClassDef], ![MemberDef], !Int, !Int), !*GenericState)
+	build_modules module_index st gs=:{gs_modules}
+		| module_index == size gs_modules
+			= (st, {gs & gs_modules = gs_modules})
+			#! (common_defs=:{com_gencase_defs}, gs_modules) = gs_modules![module_index] 
+			#! (com_gencase_defs, st, gs=:{gs_modules}) 
+				= build_module module_index com_gencase_defs st {gs & gs_modules=gs_modules} 
+			#! gs_modules = 
+				{ gs_modules 
 				& [module_index] = {common_defs & com_gencase_defs = com_gencase_defs }
 				} 
-			= build_modules (inc module_index) modules st
+			= build_modules (inc module_index) st {gs & gs_modules = gs_modules}
 
-	build_module module_index com_gencase_defs modules st
-		| inNumberSet module_index used_module_numbers
+	build_module module_index com_gencase_defs st gs=:{gs_used_modules}
+		| inNumberSet module_index gs_used_modules
 			#! com_gencase_defs = {x\\x<-:com_gencase_defs} 
-			= build_module1 module_index 0 com_gencase_defs modules st
-			= (com_gencase_defs, modules, st)
+			= build_module1 module_index 0 com_gencase_defs st gs
+			= (com_gencase_defs, st, gs)
 
-	build_module1 module_index index com_gencase_defs modules st
+	build_module1 module_index index com_gencase_defs st gs
 		| index == size com_gencase_defs
-			= (com_gencase_defs, modules, st)
+			= (com_gencase_defs, st, gs)
 			#! (gencase, com_gencase_defs) = com_gencase_defs ! [index]
-			#! (gencase, modules, st) = on_gencase module_index index gencase modules st
+			#! (gencase, st, gs) = on_gencase module_index index gencase st gs
 			#! com_gencase_defs = {com_gencase_defs & [index] = gencase} 	
-			= build_module1 module_index (inc index) com_gencase_defs modules st
+			= build_module1 module_index (inc index) com_gencase_defs st gs
 
 	on_gencase :: 
 			!Index 
 			!Index 
 			!GenericCaseDef 
-			!*Modules 
-			(![ClassDef], ![MemberDef], !Index, Index, !*Heaps, !*TypeDefInfos, !*ErrorAdmin)
+			(![ClassDef], ![MemberDef], !Index, Index)
+			!*GenericState
 		->  ( !GenericCaseDef
-			, !*Modules 
-			, (![ClassDef], ![MemberDef], !Index, Index, !*Heaps, !*TypeDefInfos, !*ErrorAdmin)
+			, (![ClassDef], ![MemberDef], !Index, Index)
+			, !*GenericState
 			)
 	on_gencase 
 			module_index index 
 			gencase=:{gc_name,gc_generic, gc_type_cons} 
-			modules
-			(classes, members, class_index, member_index, heaps, td_infos, error)
+			st 
+			gs=:{gs_modules, gs_td_infos}
 
-		#! (gen_def, modules) = modules ! [gc_generic.gi_module].com_generic_defs.[gc_generic.gi_index] 
-		#! (kind, td_infos) = get_kind_of_type_cons gc_type_cons td_infos
+		#! (gen_def, gs_modules) = gs_modules ! [gc_generic.gi_module].com_generic_defs.[gc_generic.gi_index] 
+		#! (kind, gs_td_infos) = get_kind_of_type_cons gc_type_cons gs_td_infos
 
-		//#! kinds = partially_applied_kinds kind
-		#! st = build_class_if_needed gen_def kind (classes, members, class_index, member_index, modules, heaps, error)	
+		// To generate all partially applied shorthand instances we need
+		// classes for all partial applications of the gc_kind and for
+		// all the argument kinds
+
+		#! gs = {gs & gs_modules = gs_modules, gs_td_infos = gs_td_infos}
+		#! subkinds = determine_subkinds kind 
+		#! (st, gs) = foldSt (build_class_if_needed gen_def) subkinds (st, gs) 
+		
+/*
+		#! (st, gs) = build_class_if_needed gen_def kind
+				(st, {gs & gs_modules = gs_modules, gs_td_infos = gs_td_infos})	
 
 		// build classes needed for shorthand instances
-		#! (classes, members, class_index, member_index, modules, heaps, error)
+		#! (st, gs)
 			= case kind of 
-				KindConst -> st
+				KindConst -> (st, gs)
 				KindArrow ks
-					-> foldSt (build_class_if_needed gen_def) [KindConst:ks] st 
+					-> foldSt (build_class_if_needed gen_def) [KindConst:ks] (st, gs) 
+*/
 				
 		#! gencase = { gencase & gc_kind = kind }				
-		= (gencase, modules, (classes, members, class_index, member_index, heaps, td_infos, error))
+		= (gencase, st, gs)
 
-	build_class_if_needed gen_def kind (classes, members, class_index, member_index, modules, heaps, error)
-		#! (opt_class_info, heaps) = lookup_generic_class_info gen_def kind heaps
+	build_class_if_needed :: !GenericDef !TypeKind ((![ClassDef], ![MemberDef], !Index, Index), *GenericState)
+		-> ((![ClassDef], ![MemberDef], !Index, Index), *GenericState)		
+	build_class_if_needed gen_def kind ((classes, members, class_index, member_index), gs=:{gs_main_module, gs_genh})
+		#! (opt_class_info, gs_genh) = lookup_generic_class_info gen_def kind gs_genh
+		#! gs = { gs & gs_genh = gs_genh}
 		= case opt_class_info of
 			No 
-				#! (class_def, member_def, modules, heaps, error) 
-					= buildClassAndMember main_module_index class_index member_index kind gen_def modules heaps error 
+				#! (class_def, member_def, gs=:{gs_genh}) 
+					= buildClassAndMember gs_main_module class_index member_index kind gen_def gs 
 				#! class_info = 
 					{	gci_kind = kind
-					,	gci_module = main_module_index
+					,	gci_module = gs_main_module
 					,	gci_class = class_index
 					,	gci_member = member_index
 					}
-				#! heaps = add_generic_class_info gen_def class_info heaps
-				-> ([class_def:classes], [member_def:members], inc class_index, inc member_index, modules, heaps, error)
+				#! gs_genh = add_generic_class_info gen_def class_info gs_genh
+				#! gs = { gs & gs_genh = gs_genh }
+				-> (([class_def:classes], [member_def:members], inc class_index, inc member_index), gs)
 			Yes class_info	
-				-> (classes, members, class_index, member_index, modules, heaps, error)
+				-> ((classes, members, class_index, member_index), gs)
 	
-	partially_applied_kinds KindConst 
+	determine_subkinds KindConst 
 		= [KindConst]
-	partially_applied_kinds (KindArrow kinds) 
+	determine_subkinds (KindArrow kinds) 
 		= do_it kinds
 	where
 		do_it [] = [KindConst]
-		do_it all_ks=:[k:ks] = [(KindArrow all_ks) : do_it ks] 
+		do_it all_ks=:[k:ks] 
+			#! this_kind = KindArrow all_ks
+			#! left_subkinds = determine_subkinds k
+			#! right_subkinds = do_it ks
+			= [this_kind : left_subkinds ++ right_subkinds] 
 				
 	get_kind_of_type_cons :: !TypeCons !*TypeDefInfos -> (!TypeKind, !*TypeDefInfos)
 	get_kind_of_type_cons (TypeConsBasic _) td_infos 
@@ -802,34 +1215,34 @@ where
 	get_kind_of_type_cons (TypeConsVar tv) td_infos
 		= (KindConst, td_infos)
 
-	lookup_generic_class_info {gen_info_ptr} kind heaps=:{hp_generic_heap}
+	lookup_generic_class_info {gen_info_ptr} kind hp_generic_heap
 		#! ({gen_classes}, hp_generic_heap) = readPtr gen_info_ptr hp_generic_heap
-		= (lookupGenericClassInfo kind gen_classes
-			, {heaps & hp_generic_heap = hp_generic_heap})
+		= (lookupGenericClassInfo kind gen_classes, hp_generic_heap)
 
-	add_generic_class_info	{gen_info_ptr} class_info heaps=:{hp_generic_heap}	
-		#! (gen_info=:{gen_classes}, hp_generic_heap) = readPtr gen_info_ptr hp_generic_heap
+	add_generic_class_info	{gen_info_ptr} class_info gs_genh	
+		#! (gen_info=:{gen_classes}, gs_genh) = readPtr gen_info_ptr gs_genh
 		#! gen_classes = addGenericClassInfo class_info gen_classes
-		#! hp_generic_heap = writePtr gen_info_ptr {gen_info&gen_classes=gen_classes} hp_generic_heap
-		= {heaps & hp_generic_heap = hp_generic_heap}
-			
+		#! gs_genh = writePtr gen_info_ptr {gen_info&gen_classes=gen_classes} gs_genh
+		= gs_genh
+	
+	build_class_dictionaries :: !CommonDefs !*GenericState -> (!CommonDefs, !*GenericState) 		
 	build_class_dictionaries			
-			common_defs dcl_modules
-			heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}, hp_var_heap}
-			symbol_table 
+			common_defs  
+			gs=:{gs_varh, gs_tvarh, gs_main_module, gs_symtab, gs_dcl_modules}
 		#! class_defs = { x \\ x <-: common_defs.com_class_defs } // make unique copy
 		#  type_defs = { x \\ x <-: common_defs.com_type_defs } // make unique copy
 		#  cons_defs = { x \\ x <-: common_defs.com_cons_defs } // make unique copy
 		#  selector_defs = { x \\ x <-: common_defs.com_selector_defs } // make unique copy
 		#  (size_type_defs,type_defs) = usize type_defs 
-		#! (new_type_defs, new_selector_defs, new_cons_defs,_,type_defs,selector_defs,cons_defs,class_defs, dcl_modules, th_vars, hp_var_heap, symbol_table) =
+		#! (new_type_defs, new_selector_defs, new_cons_defs,_,type_defs,selector_defs,cons_defs,class_defs, gs_dcl_modules, gs_tvarh, gs_varh, gs_symtab) =
 				createClassDictionaries
 					False 
-					main_module_index 
+					gs_main_module 
 					size_type_defs
 					(size common_defs.com_selector_defs) 
 					(size common_defs.com_cons_defs) 
-					type_defs selector_defs cons_defs class_defs dcl_modules th_vars hp_var_heap symbol_table
+					type_defs selector_defs cons_defs class_defs 
+					gs_dcl_modules gs_tvarh gs_varh gs_symtab
 
 		#! common_defs = { common_defs & 
 			com_class_defs = class_defs, 
@@ -837,39 +1250,67 @@ where
 			com_selector_defs = arrayPlusList selector_defs new_selector_defs,
 			com_cons_defs = arrayPlusList cons_defs new_cons_defs}
 
-		#! heaps = {heaps & hp_var_heap = hp_var_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} 
-		= (common_defs, dcl_modules, heaps, symbol_table)		
+		# gs = 
+			{ gs 
+			& gs_tvarh = gs_tvarh
+			, gs_varh = gs_varh
+			, gs_dcl_modules = gs_dcl_modules
+			, gs_symtab = gs_symtab 
+			}
+		= (common_defs, gs)		
 
 
 // limitations:
 // - context restrictions on generic variables are not allowed
-buildMemberType :: 
-		!GenericDef 
-		!TypeKind 
-		!TypeVar 
-		!*Modules
-		!*TypeHeaps 
-		!*GenericHeap
-		!*ErrorAdmin
-	->	( !SymbolType
-		, !*Modules
-		, !*TypeHeaps
-		, !*GenericHeap
-		, !*ErrorAdmin
-		)
-buildMemberType {gen_name,gen_pos,gen_type,gen_vars} kind class_var modules th gh error
-	#! (kind_indexed_st, gatvs, th, error) 
-		= buildKindIndexedType gen_type gen_vars kind gen_name gen_pos th error
-			//---> ("buildMemberType called for", gen_name, kind, gen_type)
-	#! (member_st, th, error) 
-		= replace_generic_vars_with_class_var kind_indexed_st gatvs kind th error
-
-	#! th = assertSymbolType member_st th
+buildMemberType :: !GenericDef !TypeKind !TypeVar !*GenericState
+	->	( !SymbolType, !*GenericState)
+buildMemberType gen_def=:{gen_name,gen_pos,gen_type,gen_vars} kind class_var gs=:{gs_predefs}
+	#! (gen_type, gs) = add_bimap_contexts gen_def gs 
+
+	#! th = {th_vars = gs.gs_tvarh, th_attrs = gs.gs_avarh}
+	#! (kind_indexed_st, gatvs, th, gs_error) 
+		= buildKindIndexedType gen_type gen_vars kind gen_name gen_pos th gs.gs_error
+		
+	#! (member_st, th, gs_error) 
+		= replace_generic_vars_with_class_var kind_indexed_st gatvs kind th gs_error
+
+	#! (member_st, th) = SwitchGenericInfo (add_generic_info member_st th) (member_st, th)
+	 
+	#! th = assertSymbolType member_st th // just paranoied about cleared variables
 	#! th = assertSymbolType gen_type th
-					
-	= (member_st, modules, th, gh, error)
-		//---> ("buildMemberType returns", gen_name, kind, member_st)
+	
+	# {th_vars, th_attrs} = th
+	#! gs = {gs & gs_avarh = th_attrs, gs_tvarh = th_vars, gs_error = gs_error }
+	= (member_st, gs)
+		---> ("buildMemberType returns", gen_name, kind, member_st)
 where
+	add_bimap_contexts 
+			{gen_type=gen_type=:{st_vars, st_context}, gen_vars, gen_info_ptr} 
+			gs=:{gs_predefs, gs_varh, gs_genh}
+		#! ({gen_var_kinds}, gs_genh) = readPtr gen_info_ptr gs_genh	
+		#! num_gen_vars = length gen_vars
+		#! tvs = st_vars -- gen_vars
+		#! kinds = drop num_gen_vars gen_var_kinds
+		#! (bimap_contexts, gs_varh) = zipWithSt build_context tvs kinds gs_varh 
+		
+		#! gs = {gs & gs_varh = gs_varh, gs_genh = gs_genh}
+		= ({gen_type & st_context = st_context ++ bimap_contexts}, gs)
+	where
+		build_context tv kind gs_varh
+			#! (var_info_ptr, gs_varh) = newPtr VI_Empty gs_varh
+			#! {pds_module, pds_def} = gs_predefs . [PD_GenericBimap]
+			#! pds_ident = predefined_idents . [PD_GenericBimap]
+			# glob_def_sym = 
+				{ glob_module = pds_module
+				, glob_object = {ds_ident=pds_ident, ds_index=pds_def, ds_arity = 1}
+				}	
+			# tc_class = TCGeneric 
+				{ gtc_generic=glob_def_sym
+				, gtc_kind = kind
+				, gtc_class = {glob_module=NoIndex,glob_object={ds_ident=makeIdent "<no generic class>", ds_index=NoIndex, ds_arity=1}}
+				, gtc_dictionary = {glob_module=NoIndex,glob_object={ds_ident=makeIdent "<no generic dictionary>", ds_index=NoIndex, ds_arity=1}}
+				}
+			=({tc_class = tc_class, tc_types = [TV tv], tc_var = var_info_ptr}, gs_varh)	
 
 	replace_generic_vars_with_class_var st atvs kind th error			
 		#! th = subst_gvs atvs th
@@ -884,13 +1325,14 @@ where
 			
 			# th_vars = foldSt subst_tv tvs th_vars
 		
-/*			 			
+/* 		 			
 			# th_attrs = case kind of
 					KindConst -> case avs of 
 						[av:avs] 	-> foldSt (subst_av av) avs th_attrs
 						[] 			-> th_attrs
 					_ -> th_attrs	
 */
+			// all generic vars get the same uniqueness variable
 			# th_attrs = case avs of 
 				[av:avs]	-> foldSt (subst_av av) avs th_attrs
 				[] 			-> th_attrs
@@ -904,34 +1346,47 @@ where
 			= writePtr av_info_ptr (AVI_Attr (TA_Var av)) th_attrs
 				//---> ("(1) writePtr av_info_ptr", ptrToInt av_info_ptr, av)
 
+	// add an argument for generic info at the beginning
+	add_generic_info st=:{st_arity, st_args, st_args_strictness} th=:{th_vars}	
+		#! {pds_module, pds_def} = gs_predefs . [PD_GenericInfo]
+		#! pds_ident = predefined_idents . [PD_GenericInfo]
+		#! type_symb = MakeTypeSymbIdent { glob_module = pds_module, glob_object = pds_def } pds_ident 0
+		#! st = 
+			{ st
+			& st_args = [ makeAType (TA type_symb []) TA_Multi : st_args]
+			, st_arity = st_arity + 1
+			, st_args_strictness = insert_n_strictness_values_at_beginning 1 st_args_strictness	 
+			}
+		= (st, {th & th_vars = th_vars })	
+
+
 buildClassAndMember 
 		module_index class_index member_index kind 
-		gen_def=:{gen_name, gen_pos} modules heaps error
-	#! (class_var, heaps) = fresh_class_var heaps
-	#! (member_def, modules, heaps, error) 
-		= build_class_member class_var modules heaps error	
+		gen_def=:{gen_name, gen_pos} 
+		gs=:{gs_tvarh}
+	# (class_var, gs_tvarh) = freshTypeVar (makeIdent "class_var") gs_tvarh
+	#! (member_def, gs) 
+		= build_class_member class_var {gs & gs_tvarh = gs_tvarh}	
 	#! class_def = build_class class_var member_def
-	= (class_def, member_def, modules, heaps, error)
+	= (class_def, member_def, gs)
 		//---> ("buildClassAndMember", gen_def.gen_name, kind)
 where
-	fresh_class_var heaps=:{hp_type_heaps=th=:{th_vars}}
-		# (tv, th_vars) = freshTypeVar (makeIdent "class_var") th_vars
-		= (tv, {heaps & hp_type_heaps = { th & th_vars = th_vars }})
 
 	class_ident = genericIdentToClassIdent gen_def.gen_name kind 
 	member_ident = genericIdentToMemberIdent gen_def.gen_name kind 
 	class_ds = {ds_index = class_index, ds_ident = class_ident, ds_arity = 1}
 
-	build_class_member class_var modules heaps=:{hp_var_heap, hp_type_heaps, hp_generic_heap} error
-		#! (type_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap 
-		#! (tc_var_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap 
+	build_class_member class_var gs=:{gs_varh}
+		#! (type_ptr, gs_varh) = newPtr VI_Empty gs_varh 
+		#! (tc_var_ptr, gs_varh) = newPtr VI_Empty gs_varh 
+		#! gs = {gs & gs_varh = gs_varh }
 		#! type_context = 
 			{	tc_class = TCClass {glob_module = module_index, glob_object=class_ds}
 			,	tc_types = [ TV class_var ] 
 			,	tc_var = tc_var_ptr 
 			}
-		#! (member_type, modules, hp_type_heaps, hp_generic_heap, error) 
-			= buildMemberType gen_def kind class_var modules hp_type_heaps hp_generic_heap error
+		#! (member_type, gs) 
+			= buildMemberType gen_def kind class_var gs
 		#! member_type = { member_type & st_context = [type_context : member_type.st_context] }
 		#! member_def = {
 			me_symb = member_ident, 
@@ -944,7 +1399,7 @@ where
 			me_priority = NoPrio
 			}
 				//---> ("member_type", member_type)
-		= (member_def, modules, {heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap, hp_generic_heap = hp_generic_heap}, error)
+		= (member_def, gs)
 	build_class class_var member_def=:{me_type}
 		#! class_member = 
 			{ ds_ident = member_ident
@@ -974,58 +1429,62 @@ where
 //****************************************************************************************
 // Convert generic cases 
 //****************************************************************************************
-convertGenericCases ::
-		!Index					// current module
-		!NumberSet				// used module numbers
-		!PredefinedSymbols
-		!*{#FunDef}	
-		!{!Group}			
-		!*{#CommonDefs}
-		!*{#DclModule}
-		!*TypeDefInfos
-		!*Heaps
-		!*ErrorAdmin
-	-> 	( !IndexRange			// created instance functions
-		, !*{#FunDef}			// added instance functions
-		, !{!Group}				// added instance groups
-		, !*{#CommonDefs}		// added instances
-		, !*{#DclModule}			// updated function types
-		, !*TypeDefInfos
-		, !*Heaps
-		, !*ErrorAdmin
-		) 		
+convertGenericCases :: !*GenericState -> (!IndexRange, !*GenericState)
 convertGenericCases 
-		main_module_index used_module_numbers 
-		predefs funs groups modules dcl_modules td_infos heaps error
-
-	#! (first_fun_index, funs) = usize funs
-	#! first_group_index = size groups
+		gs=:{gs_main_module, gs_used_modules, gs_predefs, gs_funs, gs_groups, gs_modules, gs_dcl_modules, gs_td_infos, 
+			gs_avarh, gs_tvarh, gs_varh, gs_genh, gs_exprh,
+			gs_error}
+
+	# heaps = 
+		{ hp_expression_heap = gs_exprh
+		, hp_var_heap = gs_varh
+		, hp_generic_heap = gs_genh
+		, hp_type_heaps = { th_vars = gs_tvarh, th_attrs = gs_avarh }
+		}	
+
+	#! (first_fun_index, gs_funs) = usize gs_funs
+	#! first_group_index = size gs_groups
 	#! fun_info = (first_fun_index, first_group_index, [], [])
 
+	#! (main_common_defs, gs_modules) = gs_modules ! [gs_main_module] 	
+	#! main_module_instances = main_common_defs.com_instance_defs
+
 	#! first_instance_index = size main_module_instances	
 	#! instance_info = (first_instance_index, [])
 	
-	#! (modules1, dcl_modules, (fun_info, instance_info, funs, td_infos, heaps, error)) 
-		= convert_modules 0 modules1 dcl_modules (fun_info, instance_info, funs, td_infos, heaps, error)
+	#! (gs_modules, gs_dcl_modules, (fun_info, instance_info, gs_funs, gs_td_infos, heaps, gs_error)) 
+		= convert_modules 0 gs_modules gs_dcl_modules (fun_info, instance_info, gs_funs, gs_td_infos, heaps, gs_error)
 	
 	#! (fun_index, group_index, new_funs, new_groups) = fun_info
-	#! funs = arrayPlusRevList funs new_funs
-	#! groups = arrayPlusRevList groups new_groups
+	#! gs_funs = arrayPlusRevList gs_funs new_funs
+	#! gs_groups = arrayPlusRevList gs_groups new_groups
 	
 	#! (instance_index, new_instances) = instance_info 
 	#! com_instance_defs = arrayPlusRevList main_module_instances new_instances
 
 	#! main_common_defs = {main_common_defs & com_instance_defs = com_instance_defs}	
-	#! modules1 = {modules1 & [main_module_index] = main_common_defs}
+	#! gs_modules = {gs_modules & [gs_main_module] = main_common_defs}
 	
 	#! instance_fun_range = {ir_from=first_fun_index, ir_to=fun_index}	 
-	= (instance_fun_range, funs, groups, modules1, dcl_modules, td_infos, heaps, error)
-where
 
-	(main_common_defs, modules1) = modules ! [main_module_index]
-	main_module_classes = main_common_defs.com_class_defs
-	main_module_members = main_common_defs.com_member_defs
-	main_module_instances = main_common_defs.com_instance_defs
+	# {hp_expression_heap, hp_var_heap, hp_generic_heap, hp_type_heaps={th_vars, th_attrs}} = heaps
+	# gs =
+		{ gs 
+		& gs_modules = gs_modules
+		, gs_dcl_modules = gs_dcl_modules
+		, gs_td_infos = gs_td_infos
+		, gs_funs = gs_funs
+		, gs_groups = gs_groups
+		, gs_error = gs_error
+		, gs_avarh = th_attrs
+		, gs_tvarh = th_vars
+		, gs_varh = hp_var_heap
+		, gs_genh = hp_generic_heap
+		, gs_exprh = hp_expression_heap
+		}
+
+	= (instance_fun_range, gs)
+where
 
 	convert_modules ::
 			!Index
@@ -1059,7 +1518,7 @@ where
 			= convert_modules (inc module_index) modules dcl_modules st
 
 	convert_module module_index com_gencase_defs dcl_functions modules st
-		| inNumberSet module_index used_module_numbers		 
+		| inNumberSet module_index gs_used_modules		 
 			#! dcl_functions = {x\\x<-:dcl_functions}
 			= foldArraySt (convert_gencase module_index) 
 				com_gencase_defs (dcl_functions, modules, st)
@@ -1091,7 +1550,7 @@ where
 			)					
 	convert_gencase module_index gc_index gencase=:{gc_name, gc_type} st
 		#! st = build_main_instance module_index gc_index gencase st	
-		#! st = build_shorthand_instance_if_needed module_index gc_index gencase st	
+		#! st = build_shorthand_instances module_index gc_index gencase st
 		= st
 			//---> ("convert gencase", gc_name, gc_type)
 
@@ -1102,11 +1561,11 @@ where
 			= get_generic_info gc_generic modules heaps			
 		#  (Yes class_info) 
 			= lookupGenericClassInfo gc_kind gen_classes
-			
-		#! {class_members} 
-			= main_module_classes . [class_info.gci_class] 		
-		#! member_def 
-			= main_module_members . [class_members.[0].ds_index]
+		
+		#! ({class_members}, modules) 
+			= modules ! [class_info.gci_module].com_class_defs.[class_info.gci_class]	
+		#! (member_def, modules) 
+			= modules ! [class_info.gci_module].com_member_defs.[class_members.[0].ds_index]
 
 		#! ins_type = 
 			{	it_vars	= case gc_type_cons of 
@@ -1134,38 +1593,42 @@ where
 		
 		= (dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error))
 
-	build_shorthand_instance_if_needed module_index gc_index gencase=:{gc_kind=KindConst} st
+	build_shorthand_instances module_index gc_index gencase=:{gc_kind=KindConst} st	
 		= st
-	build_shorthand_instance_if_needed 
+	build_shorthand_instances 
 			module_index gc_index 
-			gencase=:{gc_name, gc_generic, gc_kind=KindArrow arg_kinds, gc_type} 
+			gencase=:{gc_kind=KindArrow kinds, gc_type, gc_generic, gc_name, gc_pos} 
+			st		
+		= foldSt build_shorthand_instance [1 .. length kinds] st
+	where 
+		build_shorthand_instance num_args 
 			(dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error))
 
-		#! (star_class_info, (modules, heaps)) 
-			= get_class_for_kind gc_generic KindConst (modules, heaps)
-
-		#! (arg_class_infos, (modules, heaps)) 
-			= mapSt (get_class_for_kind gc_generic) arg_kinds (modules, heaps)
-
-		#! {class_members} 
-			= main_module_classes . [star_class_info.gci_class] 		
-		#! member_def 
-			= main_module_members . [class_members.[0].ds_index]
-
-		#! (ins_type, heaps) 
-			= build_instance_type gc_type arg_class_infos heaps
-
-		#! (fun_type, heaps, error)
-			= determine_type_of_member_instance member_def ins_type heaps error
-		
-		#! (memfun_ds, fun_info, heaps) 
-			= build_shorthand_instance_member module_index gencase fun_type arg_class_infos fun_info heaps
-		
-		#! ins_info 
-			= build_class_instance star_class_info.gci_class gencase memfun_ds ins_type ins_info
-				
-		= (dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error))
-	where
+			#! (consumed_kinds, rest_kinds) = splitAt num_args kinds 		
+			#! this_kind = case rest_kinds of
+				[] -> KindConst
+				_  -> KindArrow rest_kinds 
+	
+			#! (class_info, (modules, heaps)) 
+				= get_class_for_kind gc_generic this_kind (modules, heaps)
+			#! (arg_class_infos, (modules, heaps)) 
+				= mapSt (get_class_for_kind gc_generic) consumed_kinds (modules, heaps)
+			#! ({class_members}, modules) 
+				= modules ! [class_info.gci_module].com_class_defs.[class_info.gci_class]	
+			#! (member_def, modules) 
+				= modules ! [class_info.gci_module].com_member_defs.[class_members.[0].ds_index]
+			#! (ins_type, heaps) 
+				= build_instance_type gc_type arg_class_infos heaps
+			#! (fun_type, heaps, error)
+				= determine_type_of_member_instance member_def ins_type heaps error
+			#! (memfun_ds, fun_info, heaps) 
+				= build_shorthand_instance_member module_index this_kind gencase fun_type arg_class_infos fun_info heaps
+			
+			#! ins_info 
+				= build_class_instance this_kind class_info.gci_class gencase memfun_ds ins_type ins_info
+					
+			= (dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error))
+			
 		build_instance_type type class_infos heaps=:{hp_type_heaps=th=:{th_vars},hp_var_heap}
 			#! arity = length class_infos
 			#! type_var_names = [makeIdent ("a" +++ toString i) \\ i <- [1 .. arity]]
@@ -1194,6 +1657,8 @@ where
 				= TA {type_symb_ident & type_arity = type_arity} type_args 
 			fill_type_args TArrow [arg_type, res_type]
 				= arg_type --> res_type
+			fill_type_args TArrow [arg_type]
+				= TArrow1 arg_type	
 			fill_type_args (TArrow1 arg_type) [res_type]
 				= arg_type --> res_type	 
 			fill_type_args type args
@@ -1215,6 +1680,57 @@ where
 					}
 				= (type_context, hp_var_heap)	
 
+		build_shorthand_instance_member module_index this_kind gencase=:{gc_generic, gc_name, gc_kind, gc_pos} st class_infos fun_info heaps
+			#! arg_var_names = ["x" +++ toString i \\ i <- [1..st.st_arity-SwitchGenericInfo 1 0]]
+			#! (arg_var_exprs, arg_vars, heaps) = buildVarExprs arg_var_names heaps
+					
+			#! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
+			#! heaps = {heaps & hp_expression_heap = hp_expression_heap}
+			#! fun_name = genericIdentToMemberIdent gc_name this_kind
+	
+			# (gen_exprs, heaps) = mapSt (build_generic_app gc_generic gc_name) class_infos heaps
+	
+			#! arg_exprs = gen_exprs ++ arg_var_exprs
+	
+			# (generic_info_expr, generic_info_var 	, heaps) = buildVarExpr "geninfo" heaps
+			# arg_exprs = SwitchGenericInfo [generic_info_expr: arg_exprs] arg_exprs
+			# arg_vars = SwitchGenericInfo [generic_info_var: arg_vars] arg_vars
+				
+			# (body_expr, heaps) 
+				= buildGenericApp gc_generic.gi_module gc_generic.gi_index 
+					gc_name gc_kind arg_exprs heaps
+	
+			#! (st, heaps) = fresh_symbol_type st heaps
+		
+			#! (fun_ds, fun_info) 
+				= buildFunAndGroup fun_name arg_vars body_expr (Yes st) gs_main_module gc_pos fun_info
+	
+			= (fun_ds, fun_info, heaps)		
+				//---> ("shorthand instance body", body_expr)
+		where
+			build_generic_app {gi_module, gi_index} gc_name {gci_kind} heaps			
+				# (generic_info_expr, heaps) = build_generic_info_expr heaps			
+				= buildGenericApp gi_module gi_index gc_name gci_kind (SwitchGenericInfo [generic_info_expr] []) heaps	
+			build_generic_info_expr heaps				
+				= buildPredefConsApp PD_NoGenericInfo [] gs_predefs heaps
+
+		build_class_instance this_kind class_index gencase member_fun_ds ins_type (ins_index, instances) 
+			
+			# {gc_pos, gc_name, gc_kind} = gencase
+			
+			#! class_name = genericIdentToClassIdent gc_name this_kind		
+			#! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_name}
+			#! ins = 
+			 	{	ins_class 	= {glob_module=gs_main_module, glob_object=class_ds}
+				,	ins_ident 	= class_name
+				,	ins_type 	= ins_type
+				,	ins_members	= {member_fun_ds}
+				,	ins_specials = SP_None
+				,	ins_pos		= gc_pos
+				}
+			
+			= (inc ins_index, [ins:instances])
+
 	get_generic_info {gi_module, gi_index} modules heaps=:{hp_generic_heap}
 		#! ({gen_info_ptr}, modules) 
 			= modules ! [gi_module] . com_generic_defs . [gi_index]
@@ -1257,7 +1773,7 @@ where
 				//---> ("update dcl function: not in the dcl module", fun_index)  
 
 	update_icl_function_if_needed module_index fun_index gencase fun_type fun_info fun_defs td_infos modules heaps error
-		| module_index == main_module_index  // current module
+		| module_index == gs_main_module  // current module
 			#! (fi, gi, fs, gs) = fun_info
 			#! (gi, gs, fun_defs, td_infos, modules, heaps, error) 
 				= update_icl_function fun_index gencase fun_type gi gs fun_defs td_infos modules heaps error
@@ -1273,16 +1789,15 @@ where
 		#! (fun=:{fun_body, fun_arity}, fun_defs) = fun_defs ! [fun_index] 		
 		#! fun_ident = genericIdentToFunIdent gc_name gc_type_cons
 		= case fun_body of 
-			TransformedBody tb	// user defined case			
+			TransformedBody tb	// user defined case				
 				| fun_arity <> st.st_arity						
 					# error = reportError gc_name gc_pos 
-						("incorrect arity: " +++ toString st.st_arity +++ " expected") error
+						("incorrect arity " +++ toString fun_arity +++ ", expected " +++ toString st.st_arity) error
 					-> (group_index, groups, fun_defs, td_infos, modules, heaps, error)	
 				#! fun = 
 					{ fun 
 					& fun_symb = fun_ident 
 					, fun_type = Yes st
-					, fun_body = fun_body
 					}
 				#! fun_defs = { fun_defs & [fun_index] = fun }		
 				-> (group_index, groups, fun_defs, td_infos, modules, heaps, error)	
@@ -1290,9 +1805,9 @@ where
 						
 			GeneratedBody		// derived case
 				#! (TransformedBody {tb_args, tb_rhs}, td_infos, modules, heaps, error)  
-						= buildGenericCaseBody main_module_index gencase st predefs td_infos modules heaps error
+						= buildGenericCaseBody gs_main_module gencase st gs_predefs td_infos modules heaps error
 					//---> ("call buildGenericCaseBody\n")
-				#! fun = makeFunction fun_ident fun_index group_index tb_args tb_rhs (Yes st) main_module_index gc_pos
+				#! fun = makeFunction fun_ident fun_index group_index tb_args tb_rhs (Yes st) gs_main_module gc_pos
 				#! fun_defs = { fun_defs & [fun_index] = fun }
 				
 				# group = {group_members=[fun_index]}
@@ -1309,60 +1824,36 @@ where
 			= build_instance_member module_index gencase symbol_type fun_info heaps
 		#! ins_info = build_class_instance class_index gencase memfun_ds ins_type ins_info
 		= (fun_info, ins_info, heaps)
-	
-	// Creates a function that just calls the generic case function
-	// It is needed because the instance member must be in the same
-	// module as the instance itself
-	build_instance_member module_index gencase st fun_info heaps
-	
-		# {gc_name, gc_pos, gc_type_cons, gc_kind, gc_body=GCB_FunIndex fun_index} = gencase
-		#! arg_var_names = ["x" +++ toString i \\ i <- [1..st.st_arity]]
-		#! (arg_var_exprs, arg_vars, heaps) = buildVarExprs arg_var_names heaps
-	
-		#! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
-		#! heaps = {heaps & hp_expression_heap = hp_expression_heap}
-		#! fun_name = genericIdentToFunIdent gc_name gc_type_cons
-		#! expr = App 
-			{ app_symb = 
-				{ symb_name=fun_name
-				, symb_kind=SK_Function {glob_module=module_index, glob_object=fun_index}
-				}
-			, app_args = arg_var_exprs
-			, app_info_ptr = expr_info_ptr
-			}
-	
-		#! (st, heaps) = fresh_symbol_type st heaps
-	
-		#! memfun_name = genericIdentToMemberIdent gc_name gc_kind
-		#! (fun_ds, fun_info) 
-			= buildFunAndGroup memfun_name arg_vars expr (Yes st) main_module_index gc_pos fun_info
-		= (fun_ds, fun_info, heaps)
-	
-	build_shorthand_instance_member module_index gencase=:{gc_generic, gc_name, gc_kind, gc_pos} st class_infos fun_info heaps
-		#! arg_var_names = ["x" +++ toString i \\ i <- [1..st.st_arity]]
-		#! (arg_var_exprs, arg_vars, heaps) = buildVarExprs arg_var_names heaps
-	
-		#! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
-		#! heaps = {heaps & hp_expression_heap = hp_expression_heap}
-		#! fun_name = genericIdentToMemberIdent gc_name KindConst
-
-		# (gen_exprs, heaps) = mapSt (build_generic_app gc_generic gc_name) class_infos heaps
-
-		# (body_expr, heaps) 
-			= buildGenericApp gc_generic.gi_module gc_generic.gi_index 
-				gc_name gc_kind (gen_exprs ++ arg_var_exprs) heaps
-
-		#! (st, heaps) = fresh_symbol_type st heaps
-	
-		#! (fun_ds, fun_info) 
-			= buildFunAndGroup fun_name arg_vars body_expr (Yes st) main_module_index gc_pos fun_info
-
-		= (fun_ds, fun_info, heaps)		
-			//---> ("shorthand instance body", body_expr)
 	where
-		build_generic_app {gi_module, gi_index} gc_name {gci_kind} heaps
-			= buildGenericApp gi_module gi_index gc_name gci_kind [] heaps	
-	
+		
+		// Creates a function that just calls the generic case function
+		// It is needed because the instance member must be in the same
+		// module as the instance itself
+		build_instance_member module_index gencase st fun_info heaps
+		
+			# {gc_name, gc_pos, gc_type_cons, gc_kind, gc_body=GCB_FunIndex fun_index} = gencase
+			#! arg_var_names = ["x" +++ toString i \\ i <- [1..st.st_arity]]
+			#! (arg_var_exprs, arg_vars, heaps) = buildVarExprs arg_var_names heaps
+		
+			#! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
+			#! heaps = {heaps & hp_expression_heap = hp_expression_heap}
+			#! fun_name = genericIdentToFunIdent gc_name gc_type_cons
+			#! expr = App 
+				{ app_symb = 
+					{ symb_name=fun_name
+					, symb_kind=SK_Function {glob_module=module_index, glob_object=fun_index}
+					}
+				, app_args = arg_var_exprs
+				, app_info_ptr = expr_info_ptr
+				}
+		
+			#! (st, heaps) = fresh_symbol_type st heaps
+		
+			#! memfun_name = genericIdentToMemberIdent gc_name gc_kind
+			#! (fun_ds, fun_info) 
+				= buildFunAndGroup memfun_name arg_vars expr (Yes st) gs_main_module gc_pos fun_info
+			= (fun_ds, fun_info, heaps)
+		
 	build_class_instance class_index gencase member_fun_ds ins_type (ins_index, instances) 
 		
 		# {gc_pos, gc_name, gc_kind} = gencase
@@ -1370,7 +1861,7 @@ where
 		#! class_name = genericIdentToClassIdent gc_name gc_kind		
 		#! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_name}
 		#! ins = 
-		 	{	ins_class 	= {glob_module=main_module_index, glob_object=class_ds}
+		 	{	ins_class 	= {glob_module=gs_main_module, glob_object=class_ds}
 			,	ins_ident 	= class_name
 			,	ins_type 	= ins_type
 			,	ins_members	= {member_fun_ds}
@@ -1387,9 +1878,9 @@ where
 			//---> ("fresh_symbol_type")
 		
 buildGenericCaseBody :: 
-		!Index
-		!GenericCaseDef
-		!SymbolType
+		!Index					// current icl module
+		!GenericCaseDef	
+		!SymbolType				// type of the instance function 
 		!PredefinedSymbols
 		!*TypeDefInfos
 		!*{#CommonDefs} 
@@ -1401,73 +1892,136 @@ buildGenericCaseBody ::
 		, !*Heaps
 		, !*ErrorAdmin
 		)
-buildGenericCaseBody main_module_index {gc_name,gc_pos, gc_generic, gc_type_cons=TypeConsSymb {type_index}} st predefs td_infos modules heaps error
+buildGenericCaseBody main_module_index gc=:{gc_name, gc_pos, gc_generic, gc_type_cons=TypeConsSymb {type_name,type_index}} st predefs td_infos modules heaps error
 
 	// get all the data we need
-	#! (gen_def=:{gen_vars, gen_type, gen_bimap}, modules) 	
-		= modules ! [gc_generic.gi_module].com_generic_defs.[gc_generic.gi_index] 
+	#! (gen_def, modules) 	
+		= modules ! [gc_generic.gi_module].com_generic_defs.[gc_generic.gi_index] 		
+			---> ("buildGenericCaseBody for", gc_name, type_name, st)
 	#! (td_info=:{tdi_gen_rep}, td_infos)
 		= td_infos ! [type_index.glob_module, type_index.glob_object]
-	# ({gtr_iso, gtr_type}) = case tdi_gen_rep of
+	# (gen_type_rep=:{gtr_iso, gtr_type}) = case tdi_gen_rep of
 		Yes x -> x
-		No -> abort "no generic representation\n"
+		No -> abort "sanity check: no generic representation\n"
 
-	#! (type_def=:{td_args}, modules) 
+	#! (type_def=:{td_args, td_arity}, modules) 
 		= modules ! [type_index.glob_module].com_type_defs.[type_index.glob_object]
 	
-	#! original_arity 	= gen_type.st_arity 			// arity of generic type
-	#! generated_arity 	= st.st_arity - original_arity	// number of added arguments (arity of the kind)	
-
-	// generate variable names and exprs
-	#! generated_arg_names = [ "f" +++ toString n \\ n <- [1 .. generated_arity]]
-	#! (generated_arg_exprs, generated_arg_vars, heaps) = buildVarExprs generated_arg_names heaps	
-	#! original_arg_names = [ "x" +++ toString n \\ n <- [1 .. original_arity]]  
-	#! (original_arg_exprs, original_arg_vars, heaps) = buildVarExprs original_arg_names heaps	
-	#! arg_vars = generated_arg_vars ++ original_arg_vars
-
-	// create adaptor
-	#! (iso_exprs, heaps) 
-		= unfoldnSt (buildFunApp main_module_index gtr_iso []) (length gen_vars) heaps	
-	#! (bimap_id_exprs, heaps) 
-		= unfoldnSt (buildPredefFunApp PD_bimapId [] predefs) (length (gen_type.st_vars -- gen_vars)) heaps 
-
-	//#! (bimap_expr, heaps) 
-	//	= buildFunApp main_module_index gen_bimap iso_exprs heaps
-	#! spec_env = 
-		[(tv,expr)\\tv <- gen_vars & expr <- iso_exprs]	
-		++
-		[(tv,expr)\\tv <- gen_type.st_vars -- gen_vars & expr <- bimap_id_exprs]
-	#! curried_gen_type = curry_symbol_type gen_type
-	#! {pds_module = bimap_module, pds_def=bimap_index} = predefs.[PD_GenericBimap]
-	
-	#! (bimap_expr, (td_infos, heaps, error)) 
-		= buildSpecializedExpr1 
-			bimap_module bimap_index 
-			curried_gen_type spec_env
-			gc_name gc_pos 
-			(td_infos, heaps, error)	
-					
-	#! adaptor_expr = buildRecordSelectionExpr bimap_expr PD_map_from predefs	
-
-	// create expression for the generic representation
-	#! spec_env = [(atv_variable, expr) \\ {atv_variable} <- td_args & expr <- generated_arg_exprs] 
-	#! (specialized_expr, (td_infos, heaps, error)) 
-		= buildSpecializedExpr1 
-			gc_generic.gi_module gc_generic.gi_index 
-			gtr_type spec_env
-			gc_name gc_pos 
-			(td_infos, heaps, error)
-
-	// create the body expr
-	#! body_expr = if (isEmpty original_arg_exprs)
-		(adaptor_expr @ [specialized_expr]) 
-		((adaptor_expr @ [specialized_expr]) @ original_arg_exprs)
-  
+	#! num_generic_info_args = SwitchGenericInfo 1 0	
+	| td_arity <> st.st_arity - gen_def.gen_type.st_arity - num_generic_info_args
+		= abort "sanity check: td_arity <> added arity of the symbol type\n"
+
+	#! (generated_arg_exprs, original_arg_exprs, arg_vars, heaps)
+		= build_arg_vars gen_def td_args heaps
+
+	# (generic_info_var, heaps) = build_generic_info_arg heaps
+	#! arg_vars = SwitchGenericInfo [generic_info_var:arg_vars] arg_vars  
+
+	#! (adaptor_expr, (td_infos, heaps, error))
+		= build_adaptor_expr gc gen_def gen_type_rep (td_infos, heaps, error)
+	
+	#! (specialized_expr, (td_infos, heaps, error))
+		= build_specialized_expr gc gtr_type td_args generated_arg_exprs (td_infos, heaps, error)
+
+	#! body_expr 
+		= build_body_expr adaptor_expr specialized_expr original_arg_exprs
+	
 	= (TransformedBody {tb_args=arg_vars, tb_rhs=body_expr}, td_infos, modules, heaps, error)	
-		//---> (" buildGenericCaseBody", body_expr)
+		---> ("buildGenericCaseBody", body_expr)
 where
-	curry_symbol_type {st_args, st_result}
-		= foldr (\x y -> makeAType (x --> y) TA_Multi) st_result st_args 	
+
+	build_generic_info_arg heaps=:{hp_var_heap}
+		// generic arg is never referenced in the generated body
+		#! (fv_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap
+		#! fv = {fv_count = 0, fv_name = makeIdent "geninfo", fv_info_ptr = fv_info_ptr, fv_def_level = NotALevel}	
+		= (fv, {heaps & hp_var_heap = hp_var_heap})
+
+	build_arg_vars {gen_name, gen_vars, gen_type} td_args heaps 
+		#! generated_arg_names 
+			= [ gen_name.id_name +++ atv_variable.tv_name.id_name \\ {atv_variable} <- td_args]
+		#! (generated_arg_exprs, generated_arg_vars, heaps) 
+			= buildVarExprs 
+				[ gen_name.id_name +++ atv_variable.tv_name.id_name \\ {atv_variable} <- td_args] 
+				heaps	
+		#! (original_arg_exprs, original_arg_vars, heaps) 
+			= buildVarExprs 
+				[ "x" +++ toString n \\ n <- [1 .. gen_type.st_arity]] 
+				heaps	
+		= (generated_arg_exprs, original_arg_exprs, generated_arg_vars ++ original_arg_vars, heaps)
+
+	// adaptor that converts a function for the generic representation into a 
+	// function for the type itself
+	build_adaptor_expr {gc_name, gc_pos} {gen_type, gen_vars, gen_info_ptr} {gtr_iso} (td_infos, heaps, error)
+		#! (var_kinds, heaps) = get_var_kinds gen_info_ptr heaps		
+		#! non_gen_var_kinds = drop (length gen_vars) var_kinds  
+		
+		#! non_gen_vars = gen_type.st_vars -- gen_vars	
+		#! (gen_env, heaps) 
+			= build_gen_env gtr_iso gen_vars heaps
+		#! (non_gen_env, heaps) 
+			= build_non_gen_env non_gen_vars non_gen_var_kinds heaps
+		#! spec_env = gen_env ++ non_gen_env	
+		#! curried_gen_type = curry_symbol_type gen_type
+
+		#! (struct_gen_type, (td_infos, error)) = convertATypeToGenTypeStruct bimap_ident gc_pos curried_gen_type (td_infos, error)  
+		#! (bimap_expr, state) 
+			= specializeGeneric {gi_module=bimap_module,gi_index=bimap_index} struct_gen_type spec_env bimap_ident gc_pos main_module_index predefs (td_infos, heaps, error)
+
+		#! adaptor_expr 
+			= buildRecordSelectionExpr bimap_expr PD_map_from predefs
+		= (adaptor_expr, state)		
+	where
+		{pds_module = bimap_module, pds_def=bimap_index} 
+			= predefs.[PD_GenericBimap]
+		bimap_ident = predefined_idents.[PD_GenericBimap]	
+		
+		get_var_kinds gen_info_ptr heaps=:{hp_generic_heap}
+			#! ({gen_var_kinds}, hp_generic_heap) = readPtr gen_info_ptr hp_generic_heap
+			= (gen_var_kinds, {heaps & hp_generic_heap = hp_generic_heap})
+		
+		curry_symbol_type {st_args, st_result}
+			= foldr (\x y -> makeAType (x --> y) TA_Multi) st_result st_args 	
+	
+		build_gen_env :: !DefinedSymbol ![TypeVar] !*Heaps -> (![(!TypeVar, !Expression)], !*Heaps)
+		build_gen_env gtr_iso gen_vars heaps 
+			= mapSt build_iso_expr gen_vars heaps
+		where
+			build_iso_expr gen_var heaps 
+				#! (expr, heaps) = buildFunApp main_module_index gtr_iso [] heaps
+				= ((gen_var, expr), heaps)
+			
+		build_non_gen_env :: ![TypeVar] ![TypeKind] !*Heaps -> (![(!TypeVar, !Expression)], !*Heaps)
+		build_non_gen_env non_gen_vars kinds heaps 
+			= zipWithSt build_bimap_expr non_gen_vars kinds heaps
+		where
+			// build application of generic bimap for a specific kind
+			build_bimap_expr non_gen_var kind heaps
+				# (generic_info_expr, heaps) = build_generic_info_expr heaps
+				#! (expr, heaps) 
+					= buildGenericApp bimap_module bimap_index bimap_ident kind (SwitchGenericInfo [generic_info_expr] []) heaps		
+				= ((non_gen_var, expr), heaps)
+
+			build_generic_info_expr heaps
+				= buildPredefConsApp PD_NoGenericInfo [] predefs heaps
+
+			// Old safe variant with bimapId for all non-generic variables.
+			// Works only for type variables of kind star
+			build_bimap_id_expr non_gen_var heaps
+				#! (expr, heaps) = buildPredefFunApp PD_bimapId [] predefs heaps		
+				= ((non_gen_var, expr), heaps)
+											
+	// generic function specialzied to the generic representation of the type
+	build_specialized_expr {gc_name, gc_pos, gc_generic} gtr_type td_args generated_arg_exprs state
+		#! spec_env = [(atv_variable, expr) \\ {atv_variable} <- td_args & expr <- generated_arg_exprs] 		
+		//= buildSpecializedExpr1 gc_generic.gi_module gc_generic.gi_index gtr_type spec_env gc_name gc_pos state
+		= specializeGeneric gc_generic gtr_type spec_env gc_name gc_pos main_module_index predefs state
+			
+	// the body expression
+	build_body_expr adaptor_expr specialized_expr []
+		= adaptor_expr @ [specialized_expr]
+	build_body_expr adaptor_expr specialized_expr original_arg_exprs
+		= (adaptor_expr @ [specialized_expr]) @ original_arg_exprs
+		
 
 //buildGenericCaseBody main_module_index {gc_name,gc_pos, gc_generic, gc_type_cons=TypeConsSymb {type_index}} st predefs td_infos modules heaps error
 buildGenericCaseBody main_module_index {gc_name,gc_pos} st predefs td_infos modules heaps error
@@ -1478,15 +2032,38 @@ buildGenericCaseBody main_module_index {gc_name,gc_pos} st predefs td_infos modu
 //  convert generic type contexts into normal type contexts
 //****************************************************************************************
 
-convertGenericTypeContexts ::
-		!Index !NumberSet !PredefinedSymbols !*FunDefs !*Modules !*DclModules !*Heaps !*ErrorAdmin
-	-> (!*FunDefs, !*Modules, !*DclModules, !*Heaps, !*ErrorAdmin)
-convertGenericTypeContexts main_module_index used_module_numbers predefs funs modules dcl_modules heaps error
-	# (funs, (modules, heaps, error)) = convert_functions 0 funs (modules, heaps, error)
-
-	# (modules, dcl_modules, (heaps, error)) = convert_modules 0 modules dcl_modules (heaps, error)
+convertGenericTypeContexts :: !*GenericState -> !*GenericState
+convertGenericTypeContexts 
+		gs=:{gs_main_module, gs_used_modules, gs_predefs, gs_funs, gs_modules, gs_dcl_modules, gs_error,
+			gs_avarh, gs_tvarh, gs_exprh, gs_varh, gs_genh}
+
+	# heaps = 
+		{ hp_expression_heap = gs_exprh
+		, hp_var_heap = gs_varh
+		, hp_generic_heap = gs_genh
+		, hp_type_heaps = { th_vars = gs_tvarh, th_attrs = gs_avarh }
+		}	
+
+	# (gs_funs, (gs_modules, heaps, gs_error)) = convert_functions 0 gs_funs (gs_modules, heaps, gs_error)
+
+	# (gs_modules, gs_dcl_modules, (heaps, gs_error)) = convert_modules 0 gs_modules gs_dcl_modules (heaps, gs_error)
+
+	# {hp_expression_heap, hp_var_heap, hp_generic_heap, hp_type_heaps={th_vars, th_attrs}} = heaps
+
+	# gs = 
+		{ gs
+		& gs_funs = gs_funs
+		, gs_modules = gs_modules
+		, gs_dcl_modules = gs_dcl_modules
+		, gs_error = gs_error
+		, gs_avarh = th_attrs
+		, gs_tvarh = th_vars
+		, gs_varh = hp_var_heap
+		, gs_genh = hp_generic_heap
+		, gs_exprh = hp_expression_heap
+		}
 
-	= (funs, modules, dcl_modules, heaps, error)
+	= gs
 where
 	convert_functions fun_index funs st
 		| fun_index == size funs 
@@ -1517,7 +2094,7 @@ where
 			!Index !*Modules !*DclModules (!*Heaps, !*ErrorAdmin)
 		-> (!*Modules, !*DclModules, (!*Heaps, !*ErrorAdmin))
 	convert_module module_index modules dcl_modules st
-		| inNumberSet module_index used_module_numbers		 
+		| inNumberSet module_index gs_used_modules		 
 			#! (common_defs, modules) = modules ! [module_index]
 			#! (dcl_module=:{dcl_functions, dcl_common}, dcl_modules) = dcl_modules ! [module_index]
 			
@@ -1620,7 +2197,7 @@ where
 				/* 
 					AA HACK: dummy dictionary
 				*/
-				#! {pds_module, pds_def} = predefs.[PD_TypeGenericDict]
+				#! {pds_module, pds_def} = gs_predefs.[PD_TypeGenericDict]
 				#! pds_ident = predefined_idents.[PD_TypeGenericDict]
 				# dictionary = 
 					{ glob_module = pds_module
@@ -1637,25 +2214,26 @@ where
 //  specialization
 //****************************************************************************************
 
-buildSpecializedExpr1 ::
-		!Index					// generic module
-		!Index					// generic index
-		!AType					// type to specialize to
+specializeGeneric ::
+		!GlobalIndex			// generic index
+		!GenTypeStruct 			// type to specialize to
 		![(TypeVar, Expression)] // specialization environment
 		!Ident					// generic/generic case
 		!Position				// of generic case
+		!Index 					// main_module index
+		!PredefinedSymbols
 		(!*TypeDefInfos, !*Heaps, !*ErrorAdmin)
 	->  ( !Expression
 		, !(!*TypeDefInfos, !*Heaps, !*ErrorAdmin)
 		)
-buildSpecializedExpr1 gen_module gen_index atype spec_env ident pos (td_infos, heaps, error)
-
+specializeGeneric gen_index type spec_env gen_name gen_pos main_module_index predefs (td_infos, heaps, error)
 	#! heaps = set_tvs spec_env heaps
 	#! (expr, (td_infos, heaps, error)) 
-		= buildSpecializedExpr gen_module gen_index atype ident pos (td_infos, heaps, error)
+		= specialize type (td_infos, heaps, error)
 
 	#! heaps = clear_tvs spec_env heaps
 	= (expr, (td_infos, heaps, error))
+		---> ("specializeGeneric", expr)
 where
 	set_tvs spec_env heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}}
 		#! th_vars = foldSt write_tv spec_env th_vars
@@ -1669,76 +2247,58 @@ where
 					= writePtr tv_info_ptr TVI_Empty th_vars		
 		= {heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars }}
 
-// generates an expression that corresponds to a type
-buildSpecializedExpr ::
-		!Index					// generic module index
-		!Index 					// generic index
-		!AType					// type to specialize to
-								// tv_info_ptr of type variables must contain expressions
-								// corresponding to the type variables 
-		!Ident					// for error reporting
-		!Position				// for error reporting
-		!(!*TypeDefInfos, !*Heaps, !*ErrorAdmin)
-	->  ( !Expression			// generated expression
-		, !(!*TypeDefInfos, !*Heaps, !*ErrorAdmin)
-		)
-buildSpecializedExpr gen_module gen_index type gen_name pos gs 
-	= spec_atype type gs
-where
-	spec_atype {at_type} gs = spec_type at_type gs 
-
-	spec_atypes [] gs = ([], gs)
-	spec_atypes [type:types]  gs
-		# (expr, gs) = spec_atype type gs 
-		# (exprs, gs) = spec_atypes types gs 
-		= ([expr:exprs], gs)
-
-	spec_type :: !Type !(!*TypeDefInfos, !*Heaps, !*ErrorAdmin)
-		-> !(Expression, !(!*TypeDefInfos, !*Heaps, !*ErrorAdmin))
-	spec_type (TA {type_index, type_name} args) st
-		# (arg_exprs, st) = spec_atypes args st
-		# (kind, st) = get_kind type_index st 
-		= build_generic_app kind arg_exprs st  
-	spec_type (TAS {type_index, type_name} args _) st
-		# (arg_exprs, st) = spec_atypes args st
-		# (kind, st) = get_kind type_index st 
-		= build_generic_app kind arg_exprs st  
-	spec_type (arg_type --> res_type) st
-		#! (arg_expr, st) = spec_atype arg_type st
-		#! (res_expr, st) = spec_atype res_type st
-		= build_generic_app (KindArrow [KindConst, KindConst]) [arg_expr, res_expr] st
-	spec_type ((CV type_var) :@: args) gs 
-		#! (expr, gs) = spec_type_var type_var gs
-		#! (exprs, gs) = spec_atypes args gs
-		= (expr @ exprs, gs)	
-	spec_type (TB basic_type) st
-		= build_generic_app KindConst [] st
-	spec_type (TFA atvs type) (td_infos, heaps, error) 
-		#! error = reportError gen_name pos "cannot specialize to forall types" error
-		= (EE, (td_infos, heaps, error))
-	spec_type (TV type_var) gs  = spec_type_var type_var gs
-	//spec_type (GTV type_var) gs = spec_type_var type_var gs
-	//spec_type (TQV type_var) gs = spec_type_var type_var gs
-	//spec_type (TLifted type_var) gs = spec_type_var type_var gs
-	spec_type _ (td_infos, heaps, error)
-		#! error = reportError gen_name pos "cannot specialize to this type" error
-		= (EE, (td_infos, heaps, error))
+	specialize (GTSAppCons kind arg_types) st
+		#! (arg_exprs, st) = mapSt specialize arg_types st
+		= build_generic_app kind arg_exprs st
+	specialize (GTSAppVar tv arg_types) st
+		#! (arg_exprs, st) = mapSt specialize arg_types st
+		#! (expr, st) = specialize_type_var tv st 
+		= (expr @ arg_exprs, st)
+	specialize (GTSVar tv) st
+		= specialize_type_var tv st
+
+	specialize (GTSCons cons_info_ds arg_type) st
+		# (arg_expr, (td_infos, heaps, error)) = specialize arg_type st
+
+		#! (generic_info_expr, heaps) = buildFunApp main_module_index cons_info_ds [] heaps 
+		
+		#! (expr, heaps) = buildGenericApp 
+				gen_index.gi_module gen_index.gi_index gen_name 
+				(KindArrow [KindConst]) [generic_info_expr, arg_expr] heaps
+
+		= (expr, (td_infos, heaps, error))
+
+	specialize (GTSField field_info_ds arg_type) st
+		# (arg_expr, (td_infos, heaps, error)) = specialize arg_type st
+
+		#! (generic_info_expr, heaps) = buildFunApp main_module_index field_info_ds [] heaps 
+		
+		#! (expr, heaps) = buildGenericApp 
+				gen_index.gi_module gen_index.gi_index gen_name 
+				(KindArrow [KindConst]) [generic_info_expr, arg_expr] heaps
+
+		= (expr, (td_infos, heaps, error))
 	
-	spec_type_var tv=:{tv_info_ptr} (td_infos, heaps=:{hp_type_heaps=th=:{th_vars}}, error)		
+
+	specialize type (td_infos, heaps, error)
+		#! error = reportError gen_name gen_pos "cannot specialize " error 
+		= (EE, (td_infos, heaps, error))
+
+
+	specialize_type_var tv=:{tv_info_ptr} (td_infos, heaps=:{hp_type_heaps=th=:{th_vars}}, error)		
 		#! (TVI_Expr expr, th_vars) = readPtr tv_info_ptr th_vars
 		= (expr, (td_infos, {heaps & hp_type_heaps = {th & th_vars = th_vars}}, error))
 
+
 	build_generic_app kind arg_exprs (td_infos, heaps, error)
-		# (expr, heaps) 
-			= buildGenericApp gen_module gen_index gen_name kind arg_exprs heaps 
+		# (generic_info_expr, heaps) = buildPredefConsApp PD_NoGenericInfo [] predefs heaps
+		
+		# arg_exprs = SwitchGenericInfo [generic_info_expr:arg_exprs] arg_exprs
+		
+		#! (expr, heaps) 
+			= buildGenericApp gen_index.gi_module gen_index.gi_index gen_name kind arg_exprs heaps 
 		= (expr, (td_infos, heaps, error))
 
-	get_kind {glob_module, glob_object} (td_infos, heaps, error)
-		# (td_info, td_infos) = td_infos ! [glob_module, glob_object]
-		= (make_kind td_info.tdi_kinds, (td_infos, heaps, error))
-	where	
-		make_kind [] = KindConst
-		make_kind ks = KindArrow ks
 		
 //****************************************************************************************
 //	kind indexing of generic types
@@ -2684,21 +3244,16 @@ where
 makeIntExpr :: Int -> Expression
 makeIntExpr value = BasicExpr (BVI (toString value))
 
-makeStringExpr :: String !PredefinedSymbols -> Expression
-makeStringExpr str predefs
-	#! {pds_module, pds_def} = predefs.[PD_StringType]
-	#! pds_ident = predefined_idents.[PD_StringType]
-	#! type_symb = MakeTypeSymbIdent { glob_module = pds_module, glob_object = pds_def } pds_ident 0
-	=  BasicExpr (BVS str)
-	
-/*	
+makeStringExpr :: String -> Expression
+makeStringExpr str
+	=  BasicExpr (BVS ("\"" +++ str +++ "\""))
+		
 makeListExpr :: [Expression] !PredefinedSymbols !*Heaps -> (Expression, !*Heaps)
 makeListExpr [] predefs heaps
 	= buildPredefConsApp PD_NilSymbol [] predefs heaps
 makeListExpr [expr:exprs] predefs heaps 
 	# (list_expr, heaps) = makeListExpr exprs predefs heaps 
 	= buildPredefConsApp PD_ConsSymbol [expr, list_expr] predefs heaps
-*/
 
 buildConsApp :: !Index DefinedSymbol ![Expression] !*Heaps 
 	-> (!Expression, !*Heaps) 
@@ -3214,6 +3769,7 @@ mapSt2 f [x:xs] st1 st2
 
 zipWith f [] [] = []
 zipWith f [x:xs] [y:ys] = [f x y : zipWith f xs ys]
+zipWith f _ _ = abort "zipWith: lists of different length\n"
 
 zipWithSt f [] [] st 
 	= ([], st)
@@ -3221,10 +3777,5 @@ zipWithSt f [x:xs] [y:ys] st
 	# (z, st) = f x y st
 	# (zs, st) = zipWithSt f xs ys st
 	= ([z:zs], st) 
-	
-unfoldnSt :: (.st -> (a, .st)) !Int .st -> ([a], .st)
-unfoldnSt f 0 st = ([], st)
-unfoldnSt f n st
-	#! (x, st) = f st
-	#! (xs, st) = unfoldnSt f (dec n) st
-	= ([x:xs], st)
+zipWithSt f _ _ st = abort "zipWithSt: lists of different length\n"
+	
\ No newline at end of file
diff --git a/frontend/parse.icl b/frontend/parse.icl
index 84ff453..6462d47 100644
--- a/frontend/parse.icl
+++ b/frontend/parse.icl
@@ -495,10 +495,18 @@ where
 		= case token of
 			GenericOpenToken // generic function
 				# (type, pState) = wantType pState
+				# (ident, pState) = stringToIdent name (IC_GenericCase type) pState				
+				# (type_CONS_ident, pState) = stringToIdent "CONS" IC_Type pState
+				# (type_FIELD_ident, pState)= stringToIdent "FIELD" IC_Type pState
+				# (generic_ident, pState) = stringToIdent name IC_Generic pState					
+
 				# (type_cons, pState) = get_type_cons type pState
 					with
-						get_type_cons (TA type_symb []) pState 
-							= (TypeConsSymb type_symb, pState)
+						get_type_cons (TA type_symb []) pState
+								= (TypeConsSymb type_symb, pState)							
+						get_type_cons (TA type_symb _) pState
+							# pState = parseError "generic type, no constructor arguments allowed" No " |}" pState
+							= (abort "no TypeCons", pState)
 						get_type_cons (TB tb) pState 
 							= (TypeConsBasic tb, pState)
 						get_type_cons TArrow pState
@@ -506,19 +514,48 @@ where
 						get_type_cons (TV tv) pState
 							= (TypeConsVar tv, pState)				 
 						get_type_cons _ pState 
-							# pState = parseError "generic type" No " invalid" pState
+							# pState = parseError "generic type" No " |}" pState
 							= (abort "no TypeCons", pState)
-				# pState = wantToken FunctionContext "type argument" GenericCloseToken pState
-				# (ident, pState) = stringToIdent name (IC_GenericCase type) pState					
-				# (generic_ident, pState) = stringToIdent name IC_Generic pState					
 
+				# (token, pState) = nextToken GenericContext pState
+				# (geninfo_arg, pState) = case token of
+					GenericOfToken
+						# (ok, geninfo_arg, pState) = trySimpleLhsExpression pState
+						# pState = wantToken FunctionContext "type argument" GenericCloseToken pState
+						| ok 
+							-> case type_cons of
+								(TypeConsSymb {type_name})
+									| type_name == type_CONS_ident
+										# (cons_CONS_ident, pState) = stringToIdent "GenericConsInfo" IC_Expression pState 
+										-> (PE_List [PE_Ident cons_CONS_ident, geninfo_arg], pState)
+									| type_name == type_FIELD_ident 
+										# (cons_FIELD_ident, pState) = stringToIdent "GenericFieldInfo" IC_Expression pState 
+										-> (PE_List [PE_Ident cons_FIELD_ident, geninfo_arg], pState)							_ 	
+									| otherwise
+										-> (geninfo_arg, pState)
+						| otherwise
+							# pState = parseError "generic case" No "simple lhs expression" pState
+							-> (PE_Empty, pState)
+						 
+					GenericCloseToken
+						# (geninfo_ident, pState) =  stringToIdent "geninfo" IC_Expression pState
+						-> (PE_Ident geninfo_ident, pState)
+					_ 	
+						# pState = parseError "generic type" (Yes token) "of or |}" pState
+						# (geninfo_ident, pState) =  stringToIdent "geninfo" IC_Expression pState
+						-> (PE_Ident geninfo_ident, pState)
+																						
+				//# pState = wantToken FunctionContext "type argument" GenericCloseToken pState
 				# (args, pState) = parseList trySimpleLhsExpression pState
 
+				//# (geninfo_ident, pState) = stringToIdent "geninfo" IC_Expression pState
+				# args = SwitchGenericInfo [geninfo_arg :  args] args
+
 				// must be EqualToken or HashToken or ???
 				//# pState = wantToken FunctionContext "generic definition" EqualToken pState
 				//# pState = tokenBack pState
 
-			  	#(ss_useLayout, pState) = accScanState UseLayout pState
+			  	# (ss_useLayout, pState) = accScanState UseLayout pState
 			    # localsExpected = isNotEmpty args || isGlobalContext parseContext || ~ ss_useLayout
 			    # (rhs, _, pState) = wantRhs localsExpected (ruleDefiningRhsSymbol parseContext) pState
 
@@ -1511,11 +1548,6 @@ wantGenericDefinition parseContext pos pState
 		,	gen_vars = arg_vars
 		,	gen_pos = pos
 		,	gen_info_ptr = nilPtr
-		, 	gen_bimap = 
-			{ ds_ident = {id_name = "", id_info = nilPtr} 
-			, ds_index = NoIndex
-			, ds_arity = 0 
-			}
 		}
 	= (PD_Generic gen_def, pState)	
 	where
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index 40f25b1..d7e4dee 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -1198,20 +1198,20 @@ collectGenericBodies :: !GenericCaseDef ![ParsedDefinition] !*CollectAdmin
 	-> (![ParsedBody], ![ParsedDefinition], !*CollectAdmin)
 collectGenericBodies first_case all_defs=:[PD_GenericCase gc : defs] ca
 	| first_case.gc_name == gc.gc_name && first_case.gc_type_cons == gc.gc_type_cons		
-		# (bodies, rest_defs, ca) = collectGenericBodies first_case defs ca
+		#! (bodies, rest_defs, ca) = collectGenericBodies first_case defs ca
 		# (GCB_ParsedBody args rhs) = gc.gc_body
-		# body = 
+		#! body = 
 			{ pb_args = args
 			, pb_rhs = rhs
 			, pb_position = gc.gc_pos 
 			}
 		| first_case.gc_arity == gc.gc_arity
 			= ([body : bodies ], rest_defs, ca)
-			# msg = "This alternative has " + toString gc.gc_arity + " argument" 
+			#! msg = "This generic alternative has " + toString gc.gc_arity + " argument" 
 				+ (if (gc.gc_arity <> 1) "s" "")+" instead of " + toString first_case.gc_arity
-			# ca = postParseError gc.gc_pos msg ca	
+			#! ca = postParseError gc.gc_pos msg ca	
 			= ([body : bodies ], rest_defs, ca)
-		= ([], all_defs, ca)
+		= ([], all_defs, ca)		
 collectGenericBodies first_case defs ca
 	= ([], defs, ca)
 
diff --git a/frontend/predef.dcl b/frontend/predef.dcl
index 7a53a64..d2f1e7f 100644
--- a/frontend/predef.dcl
+++ b/frontend/predef.dcl
@@ -168,12 +168,41 @@ PD_ConsRIGHT				:== 186
 PD_TypePAIR					:== 187
 PD_ConsPAIR					:== 188
 
-PD_GenericBimap				:== 189
-PD_bimapId					:== 190
-
-PD_TypeGenericDict 			:== 191
-
-PD_NrOfPredefSymbols		:== 192
+// for constructor info
+PD_TypeCONS					:== 189
+PD_ConsCONS					:== 190
+PD_TypeFIELD				:== 191
+PD_ConsFIELD				:== 192
+PD_GenericInfo				:== 193
+PD_NoGenericInfo			:== 194
+PD_GenericConsInfo			:== 195
+PD_GenericFieldInfo			:== 196
+PD_TGenericConsDescriptor 	:== 197
+PD_CGenericConsDescriptor 	:== 198
+PD_TGenericFieldDescriptor 	:== 199
+PD_CGenericFieldDescriptor 	:== 200
+PD_TGenericTypeDefDescriptor :== 201
+PD_CGenericTypeDefDescriptor :== 202
+PD_TGenConsPrio				:== 203 
+PD_CGenConsNoPrio			:== 204
+PD_CGenConsPrio				:== 205
+PD_TGenConsAssoc			:== 206
+PD_CGenConsAssocNone		:== 207
+PD_CGenConsAssocLeft		:== 208
+PD_CGenConsAssocRight		:== 209
+PD_TGenType					:== 210
+PD_CGenTypeCons				:== 211
+PD_CGenTypeVar				:== 212
+PD_CGenTypeArrow			:== 213
+PD_CGenTypeApp				:== 214
+
+
+PD_GenericBimap				:== 215
+PD_bimapId					:== 216
+
+PD_TypeGenericDict 			:== 217
+
+PD_NrOfPredefSymbols		:== 218
 
 GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
 GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
diff --git a/frontend/predef.icl b/frontend/predef.icl
index 162044d..6bdb07c 100644
--- a/frontend/predef.icl
+++ b/frontend/predef.icl
@@ -168,12 +168,42 @@ PD_ConsRIGHT				:== 186
 PD_TypePAIR					:== 187
 PD_ConsPAIR					:== 188
 
-PD_GenericBimap				:== 189
-PD_bimapId					:== 190
+// for constructor info
+PD_TypeCONS					:== 189
+PD_ConsCONS					:== 190
+PD_TypeFIELD				:== 191
+PD_ConsFIELD				:== 192
+PD_GenericInfo				:== 193
+PD_NoGenericInfo			:== 194
+PD_GenericConsInfo			:== 195
+PD_GenericFieldInfo			:== 196
+PD_TGenericConsDescriptor 	:== 197
+PD_CGenericConsDescriptor 	:== 198
+PD_TGenericFieldDescriptor 	:== 199
+PD_CGenericFieldDescriptor 	:== 200
+PD_TGenericTypeDefDescriptor :== 201
+PD_CGenericTypeDefDescriptor :== 202
+PD_TGenConsPrio				:== 203 
+PD_CGenConsNoPrio			:== 204
+PD_CGenConsPrio				:== 205
+PD_TGenConsAssoc			:== 206
+PD_CGenConsAssocNone		:== 207
+PD_CGenConsAssocLeft		:== 208
+PD_CGenConsAssocRight		:== 209
+PD_TGenType					:== 210
+PD_CGenTypeCons				:== 211
+PD_CGenTypeVar				:== 212
+PD_CGenTypeArrow			:== 213
+PD_CGenTypeApp				:== 214
+
+
+PD_GenericBimap				:== 215
+PD_bimapId					:== 216
+
+PD_TypeGenericDict 			:== 217
+
+PD_NrOfPredefSymbols		:== 218
 
-PD_TypeGenericDict 			:== 191
-
-PD_NrOfPredefSymbols		:== 192
 
 (<<=) infixl
 (<<=) symbol_table val
@@ -284,7 +314,7 @@ predefined_idents
 					[PD_TypeID] = i "T_ypeID",
 					[PD_ModuleID] = i "ModuleID",
 				
-					[PD_StdGeneric] = i "StdGeneric2",
+					[PD_StdGeneric] = i "StdGeneric",
 					[PD_TypeBimap] = i "Bimap",
 					[PD_ConsBimap] = i "_Bimap",
 					[PD_map_to] = i "map_to",
@@ -295,7 +325,35 @@ predefined_idents
 					[PD_ConsLEFT] = i "LEFT",
 					[PD_ConsRIGHT] = i "RIGHT",
 					[PD_TypePAIR] = i "PAIR",
-					[PD_ConsPAIR] = i "PAIR",
+					[PD_ConsPAIR] = i "PAIR",					
+					[PD_TypeCONS] = i "CONS",
+					[PD_ConsCONS] = i "CONS",
+					[PD_TypeFIELD] = i "FIELD",
+					[PD_ConsFIELD] = i "FIELD",
+					[PD_GenericInfo] = i "GenericInfo",
+					[PD_NoGenericInfo] = i "NoGenericInfo",
+					[PD_GenericConsInfo] = i "GenericConsInfo",
+					[PD_GenericFieldInfo] = i "GenericFieldInfo",
+					[PD_TGenericConsDescriptor] = i "GenericConsDescriptor",
+					[PD_CGenericConsDescriptor] = i "_GenericConsDescriptor",
+					[PD_TGenericFieldDescriptor] = i "GenericFieldDescriptor",
+					[PD_CGenericFieldDescriptor] = i "_GenericFieldDescriptor",
+					[PD_TGenericTypeDefDescriptor] = i "GenericTypeDefDescriptor",
+					[PD_CGenericTypeDefDescriptor] = i "_GenericTypeDefDescriptor",
+					[PD_TGenConsPrio] = i "GenConsPrio",
+					[PD_CGenConsNoPrio] = i "GenConsNoPrio",
+					[PD_CGenConsPrio] = i "GenConsPrio",
+					[PD_TGenConsAssoc] = i "GenConsAssoc",
+					[PD_CGenConsAssocNone] = i "GenConsAssocNone",
+					[PD_CGenConsAssocLeft] = i "GenConsAssocLeft",
+					[PD_CGenConsAssocRight] = i "GenConsAssocRight",
+					[PD_TGenType] = i "GenType",
+					[PD_CGenTypeCons] = i "GenTypeCons",
+					[PD_CGenTypeVar] = i "GenTypeVar",
+					[PD_CGenTypeArrow] = i "GenTypeArrow",
+					[PD_CGenTypeApp] = i "GenTypeApp",
+														
+					
 					[PD_GenericBimap] = i "bimap",
 					[PD_bimapId] = i "bimapId",
 				
@@ -447,7 +505,34 @@ where
 					<<- (local_predefined_idents,				IC_Expression,	PD_ConsLEFT)
 					<<- (local_predefined_idents,				IC_Expression,	PD_ConsRIGHT)
 					<<- (local_predefined_idents,				IC_Type, 		PD_TypePAIR)					
-					<<- (local_predefined_idents,				IC_Expression,	PD_ConsPAIR)	
+					<<- (local_predefined_idents,				IC_Expression,	PD_ConsPAIR)
+					<<- (local_predefined_idents,				IC_Type, 		PD_TypeCONS)					
+					<<- (local_predefined_idents,				IC_Expression,	PD_ConsCONS)
+					<<- (local_predefined_idents,				IC_Type, 		PD_TypeFIELD)					
+					<<- (local_predefined_idents,				IC_Expression,	PD_ConsFIELD)
+					<<- (local_predefined_idents,				IC_Type, 		PD_GenericInfo)					
+					<<- (local_predefined_idents,				IC_Expression,	PD_NoGenericInfo)
+					<<- (local_predefined_idents,				IC_Expression,	PD_GenericConsInfo)
+					<<- (local_predefined_idents,				IC_Expression,	PD_GenericFieldInfo)
+					<<- (local_predefined_idents,				IC_Type,		PD_TGenericConsDescriptor)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenericConsDescriptor)
+					<<- (local_predefined_idents,				IC_Type,		PD_TGenericFieldDescriptor)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenericFieldDescriptor)
+					<<- (local_predefined_idents,				IC_Type,		PD_TGenericTypeDefDescriptor)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenericTypeDefDescriptor)
+					<<- (local_predefined_idents,				IC_Type,		PD_TGenConsPrio)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenConsNoPrio)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenConsPrio)
+					<<- (local_predefined_idents,				IC_Type,		PD_TGenConsAssoc)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenConsAssocNone)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenConsAssocLeft)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenConsAssocRight)
+					<<- (local_predefined_idents,				IC_Type,		PD_TGenType)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenTypeCons)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenTypeVar)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenTypeArrow)
+					<<- (local_predefined_idents,				IC_Expression,	PD_CGenTypeApp)
+											
 					<<- (local_predefined_idents,				IC_Generic,		PD_GenericBimap)	
 					<<- (local_predefined_idents,				IC_Expression,	PD_bimapId)
 					<<- (local_predefined_idents,				IC_Type,		PD_TypeGenericDict)
diff --git a/frontend/scanner.dcl b/frontend/scanner.dcl
index 6399d2a..88a919e 100644
--- a/frontend/scanner.dcl
+++ b/frontend/scanner.dcl
@@ -110,6 +110,7 @@ instance <<< FilePosition
 	| 	DeriveToken				//		derive
 	|	GenericOpenToken		//		{|
 	|	GenericCloseToken		//		|}
+	|	GenericOfToken			//		of
 
 	|	ExistsToken				//		E.
 	|	ForAllToken				//		A.
@@ -119,6 +120,7 @@ instance <<< FilePosition
 	|	TypeContext
 	|	FunctionContext
 	|	CodeContext
+	| 	GenericContext
 
 ::	Assoc	= LeftAssoc | RightAssoc | NoAssoc
 
diff --git a/frontend/scanner.icl b/frontend/scanner.icl
index bdd168e..5930c1e 100644
--- a/frontend/scanner.icl
+++ b/frontend/scanner.icl
@@ -196,6 +196,7 @@ ScanOptionNoNewOffsideForSeqLetBit:==4;
 	| 	DeriveToken				//		derive
 	|	GenericOpenToken		//		{|
 	|	GenericCloseToken		//		|}
+	|	GenericOfToken			//		of
 
 	|	ExistsToken				//		E.
 	|	ForAllToken				//		A.
@@ -206,6 +207,7 @@ ScanOptionNoNewOffsideForSeqLetBit:==4;
 	|	TypeContext
 	|	FunctionContext
 	|	CodeContext
+	| 	GenericContext
 
 instance == ScanContext
 where
@@ -794,6 +796,7 @@ CheckReserved GeneralContext    s i = CheckGeneralContext s i
 CheckReserved TypeContext       s i = CheckTypeContext s i
 CheckReserved FunctionContext	s i = CheckFunctContext s i
 CheckReserved CodeContext		s i = CheckCodeContext s i
+CheckReserved GenericContext	s i = CheckGenericContext s i
 
 CheckGeneralContext	:: !String !Input -> (!Token, !Input)
 CheckGeneralContext s input
@@ -846,6 +849,7 @@ CheckTypeContext s input
 	"Dynamic"	->	(DynamicTypeToken	, input)
 	"special"	->	(SpecialToken		, input)
 	"from" 		->	(FromToken			, input)
+	"of"		->  (GenericOfToken		, input) // AA
 	s			->	CheckEveryContext s input
 
 CheckFunctContext :: !String !Input -> (!Token, !Input)
@@ -873,6 +877,12 @@ CheckCodeContext s input
 	"inline"	->	(InlineToken		, input)
 	s			->	CheckEveryContext s input	
 
+CheckGenericContext :: !String !Input -> (!Token, !Input)
+CheckGenericContext s input
+ = case s of
+	"of"	->	(GenericOfToken		, input)
+	s			->	CheckEveryContext s input	
+
 GetPrio :: !Input -> (!Optional String, !Int, !Input)
 GetPrio input
 	# (error, c, input) = SkipWhites input
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 136363e..e6baf30 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -292,7 +292,6 @@ cNameLocationDependent :== True
 	,	gen_type		:: !SymbolType	// Generic type (st_vars include generic type vars)
 	,	gen_vars		:: ![TypeVar]	// Generic type variables
 	,	gen_info_ptr	:: !GenericInfoPtr
-	, 	gen_bimap		:: !DefinedSymbol 	// fun def index of the bimap for the generic type 
 	}
 
 :: GenericClassInfo = 
@@ -457,8 +456,17 @@ NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex}
 	}
 
 // AA..
+// type structure is used to specialize a generic to a type
+:: GenTypeStruct 
+	= GTSAppCons TypeKind [GenTypeStruct]
+	| GTSAppVar TypeVar [GenTypeStruct] 
+	| GTSVar TypeVar
+ 	| GTSCons DefinedSymbol GenTypeStruct
+ 	| GTSField DefinedSymbol GenTypeStruct
+ 	| GTSE
+ 
 :: GenericTypeRep = 
-	{ gtr_type :: AType				// generic structure type
+	{ gtr_type :: GenTypeStruct		// generic structure type
 	, gtr_iso  :: DefinedSymbol		// the conversion isomorphism
 	}
 // ..AA
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index 28b9649..a71dc0b 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -286,7 +286,6 @@ cNameLocationDependent :== True
 	,	gen_type		:: !SymbolType	// Generic type (st_vars include generic type vars)
 	,	gen_vars		:: ![TypeVar]	// Generic type variables
 	,	gen_info_ptr	:: !GenericInfoPtr
-	, 	gen_bimap		:: !DefinedSymbol 	// fun def index of the bimap for the generic type 
 	}
 
 :: GenericClassInfo = 
@@ -1038,8 +1037,17 @@ cNotVarNumber :== -1
 	}
 
 // AA..
+// type structure is used to specialize a generic to a type
+:: GenTypeStruct 
+	= GTSAppCons TypeKind [GenTypeStruct]
+	| GTSAppVar TypeVar [GenTypeStruct] 
+	| GTSVar TypeVar
+ 	| GTSCons DefinedSymbol GenTypeStruct
+ 	| GTSField DefinedSymbol GenTypeStruct
+ 	| GTSE
+ 
 :: GenericTypeRep = 
-	{ gtr_type :: AType				// generic structure type
+	{ gtr_type :: GenTypeStruct		//AType				// generic structure type
 	, gtr_iso  :: DefinedSymbol		// the conversion isomorphism
 	}
 // ..AA
diff --git a/frontend/trans.icl b/frontend/trans.icl
index 492bba3..1252de1 100644
--- a/frontend/trans.icl
+++ b/frontend/trans.icl
@@ -4,11 +4,11 @@ import StdEnv
 
 import syntax, transform, checksupport, StdCompare, check, utilities, unitype, typesupport, type
 
-SwitchCaseFusion		fuse dont_fuse :== fuse
-SwitchGeneratedFusion	fuse dont_fuse :== fuse
-SwitchFunctionFusion	fuse dont_fuse :== fuse
-SwitchConstructorFusion	fuse dont_fuse :== fuse
-SwitchCurriedFusion		fuse dont_fuse :== fuse
+SwitchCaseFusion		fuse dont_fuse :== dont_fuse
+SwitchGeneratedFusion	fuse dont_fuse :== dont_fuse
+SwitchFunctionFusion	fuse dont_fuse :== dont_fuse
+SwitchConstructorFusion	fuse dont_fuse :== dont_fuse
+SwitchCurriedFusion		fuse dont_fuse :== dont_fuse
 
 (-!->) infix :: !.a !b -> .a | <<< b
 (-!->) a b = a // ---> b
@@ -2076,8 +2076,23 @@ determine_arg (PR_Class class_app free_vars_and_types class_type) _ {fv_info_ptr
 	  		  , ti_functions = ro.ro_imported_funs
 			  ,	ti_main_dcl_module_n = ro.ro_main_dcl_module_n
 			  }
+	// AA: Dummy generic dictionary does not unify with corresponding class dictionary.
+	// Make it unify 			  		
 	# (succ, das_subst, das_type_heaps)
-	  		= unify class_atype arg_type type_input das_subst das_type_heaps
+	  		//AA: = unify class_atype arg_type type_input das_subst das_type_heaps
+	  		= unify_dict class_atype arg_type type_input das_subst das_type_heaps
+	  	with
+	  		unify_dict class_atype=:{at_type=TA type_symb1 args1} arg_type=:{at_type=TA type_symb2 args2} 
+	  			| type_symb1 == type_symb2 
+	  				= unify class_atype arg_type
+	  			// FIXME: check indexes, not names. Need predefs for that. 	
+	  			| type_symb1.type_name.id_name == "GenericDict"
+	  				= unify {class_atype & at_type = TA type_symb2 args1} arg_type	
+	  			| type_symb2.type_name.id_name == "GenericDict"
+	  				= unify class_atype {arg_type & at_type = TA type_symb1 args2} 	  				
+	  		unify_dict class_atype arg_type 
+	  			= unify class_atype arg_type	
+	  			
 	| not succ
 		= abort ("sanity check nr 93 in module trans failed\n"--->(class_atype,"\n", arg_type))
 	# (free_vars_and_types,das_type_heaps) = mapSt subFVT free_vars_and_types das_type_heaps
diff --git a/frontend/type.icl b/frontend/type.icl
index 09249f4..e260db5 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -1090,6 +1090,7 @@ where
 		# (left, right, is_unique) = split_args (dec n) args
 		= ([ atype : left ], right, is_unique || attr_is_unique at_attribute)
 	
+	
 	attr_is_unique TA_Unique = True
 	attr_is_unique _ = False