pass generic info only to instances for OBJECT, CONS and FIELD,

call instance functions for OBJECT, CONS and FIELD directly, with generic info

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

4 files changed, 342 insertions, 262 deletions

diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl
index 8ca5e2f..c0cea8b 100644
--- a/frontend/checkFunctionBodies.icl
+++ b/frontend/checkFunctionBodies.icl
@@ -1162,38 +1162,16 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
 		check_generic_expr free_vars entry=:{ste_kind=STE_Empty} id kind e_input e_state e_info cs=:{cs_error}
 			= (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "undefined generic" cs_error })
 		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 })						
+			= (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
-			#! (app_args, es_expr_heap, cs)
-				= case kind of
-					KindArrow [KindConst]
-						# (generic_info_expr, es_expr_heap, cs) = build_generic_info es_expr_heap cs 
-						-> ([generic_info_expr], es_expr_heap, cs) 
-					_
-						-> ([], es_expr_heap, cs)
-			#! symb_kind = SK_Generic { glob_object = gen_index, glob_module = mod_index} kind
+			#! symb_kind = SK_Generic {glob_object = gen_index, glob_module = mod_index} kind
 		  	#! symbol = { symb_ident = id, symb_kind = symb_kind }			
 			#! (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
-			#! app = { app_symb = symbol, app_args = app_args, app_info_ptr = new_info_ptr }
+			#! app = { app_symb = symbol, 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.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_ident = 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})	
 
 checkExpression free_vars (PE_TypeSignature array_kind expr) e_input e_state e_info cs
 	# (expr,free_vars,e_state,e_info,cs) = checkExpression free_vars expr e_input e_state e_info cs
diff --git a/frontend/checkgenerics.icl b/frontend/checkgenerics.icl
index ff86927..1615d32 100644
--- a/frontend/checkgenerics.icl
+++ b/frontend/checkgenerics.icl
@@ -44,6 +44,7 @@ where
 		# initial_info = 
 			{ gen_classes = createArray 32 []
 			, gen_var_kinds = []
+			, gen_OBJECT_CONS_FIELD_indices = createArray 3 {ocf_module = -1,ocf_index = -1,ocf_ident={id_name="",id_info=nilPtr}}
 			}
 		# (gen_info_ptr, hp_generic_heap) = newPtr initial_info hp_generic_heap 
 		= (	{gen_def & gen_info_ptr = gen_info_ptr}, 
diff --git a/frontend/generics1.icl b/frontend/generics1.icl
index b9aa85b..0c97b31 100644
--- a/frontend/generics1.icl
+++ b/frontend/generics1.icl
@@ -153,6 +153,7 @@ where
 // clear stuff that might have been left over
 // from compilation of other icl modules
 
+clearTypeDefInfos :: !*{#*{#TypeDefInfo}} -> *{#*{#TypeDefInfo}}
 clearTypeDefInfos td_infos
 	= clear_modules 0 td_infos
 where
@@ -171,6 +172,7 @@ where
 			#! td_infos = {td_infos & [n] = {td_info & tdi_gen_rep = No}}
 			= clear_td_infos (inc n) td_infos 
 
+clearGenericDefs :: !*{#CommonDefs} !*Heaps -> (!*{#CommonDefs},!*Heaps)
 clearGenericDefs modules heaps
 	= clear_module 0 modules  heaps
 where	
@@ -656,7 +658,7 @@ buildTypeDefInfo1 td_module {td_ident, td_pos, td_arity} alts fields main_module
 
 	= (type_info_ds, cons_infos, funs_and_groups, modules, heaps, error)
 where
-	build_type_def_dsc group_index cons_info_dss {ds_index, ds_ident}  heaps	
+	build_type_def_dsc group_index cons_info_dss {ds_ident}  heaps	
 		# td_name_expr = makeStringExpr td_ident.id_name
 		# td_arity_expr = makeIntExpr td_arity
 		# num_conses_expr = makeIntExpr (length alts)
@@ -672,7 +674,7 @@ where
 			] 
 			predefs heaps
 
-		# fun = makeFunction ds_ident ds_index group_index [] body_expr No main_module_index td_pos		
+		# fun = makeFunction ds_ident 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)
@@ -698,7 +700,7 @@ where
 				]  
 				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 = makeFunction cons_info_ds.ds_ident group_index [] body_expr No main_module_index td_pos		
 		= (fun, (modules, heaps))
 	where
 		make_prio_expr NoPrio heaps
@@ -807,7 +809,7 @@ where
 				, 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 = makeFunction field_dsc_ds.ds_ident group_index [] body_expr No main_module_index td_pos		
 		= (fun, (modules, heaps))
 		
 	build_cons_info cons_dsc_ds (funs_and_groups, heaps)
@@ -1221,8 +1223,25 @@ where
 			, KindArrow [KindConst, KindConst] 
 			: subkinds]
 		#! (st, gs) = foldSt (build_class_if_needed gen_def) kinds (st, gs)
-		#! gencase = {gencase & gc_kind = kind}				
-		= (gencase, st, gs)
+		#! gencase = {gencase & gc_kind = kind}
+
+		#! type_index = index_OBJECT_CONS_FIELD_type gencase.gc_type gs.gs_predefs
+		| type_index>=0		
+			# ({gc_body = GCB_FunIndex fun_index}) = gencase
+			  gen_info_ptr = gen_def.gen_info_ptr
+
+			  fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
+			  ocf_index = {ocf_module=module_index,ocf_index=fun_index,ocf_ident=fun_ident}
+
+			  (gen_info,generic_heap) = readPtr gen_info_ptr gs.gs_genh
+			  gen_OBJECT_CONS_FIELD_indices = {gi\\gi<-:gen_info.gen_OBJECT_CONS_FIELD_indices}
+			  gen_OBJECT_CONS_FIELD_indices = {gen_OBJECT_CONS_FIELD_indices & [type_index]=ocf_index}
+			  gen_info = {gen_info & gen_OBJECT_CONS_FIELD_indices=gen_OBJECT_CONS_FIELD_indices}
+			  generic_heap = writePtr gen_info_ptr gen_info generic_heap
+			  gs = {gs & gs_genh=generic_heap}
+			= (gencase, st, gs)
+
+			= (gencase, st, gs)
 
 	build_class_if_needed :: !GenericDef !TypeKind ((![ClassDef], ![MemberDef], !Index, Index), *GenericState)
 		-> ((![ClassDef], ![MemberDef], !Index, Index), *GenericState)		
@@ -1309,8 +1328,7 @@ where
 
 // limitations:
 // - context restrictions on generic variables are not allowed
-buildMemberType :: !GenericDef !TypeKind !TypeVar !*GenericState
-	->	( !SymbolType, !*GenericState)
+buildMemberType :: !GenericDef !TypeKind !TypeVar !*GenericState -> ( !SymbolType, !*GenericState)
 buildMemberType gen_def=:{gen_ident,gen_pos,gen_type,gen_vars} kind class_var gs=:{gs_predefs}
 	#! (gen_type, gs) = add_bimap_contexts gen_def gs 
 
@@ -1319,15 +1337,8 @@ buildMemberType gen_def=:{gen_ident,gen_pos,gen_type,gen_vars} kind class_var gs
 		= buildKindIndexedType gen_type gen_vars kind gen_ident 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)
-		= case kind of
-			KindArrow [KindConst]
-				-> add_generic_info member_st th
-			_
-				-> (member_st, th)
-	 
+		= replace_generic_vars_with_class_var kind_indexed_st gatvs th gs_error
+
 	#! th = assertSymbolType member_st th // just paranoied about cleared variables
 	#! th = assertSymbolType gen_type th
 	
@@ -1372,26 +1383,17 @@ where
 				}
 			=({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			
+	replace_generic_vars_with_class_var st atvs th error			
 		#! th = subst_gvs atvs th
-			//---> ("replace_generic_vars_with_class_var called for", atvs, st)
 		#! (new_st, th) = applySubstInSymbolType st th
 		= (new_st, th, error)
-			//---> ("replace_generic_vars_with_class_var returns", new_st)
 	where
 		subst_gvs atvs th=:{th_vars, th_attrs}
 			#! tvs = [atv_variable \\ {atv_variable} <- atvs ]
 			#! avs = [av \\ {atv_attribute=TA_Var av} <- atvs ]
 			
 			# 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
@@ -1404,18 +1406,6 @@ where
 
 		subst_av av {av_info_ptr} th_attrs
 			= 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_lazy_values_at_beginning 1 st_args_strictness	 
-				}
-		= (st, {th & th_vars = th_vars})
 
 buildClassAndMember :: Int Int Int TypeKind GenericDef *GenericState -> (ClassDef,MemberDef,*GenericState)
 buildClassAndMember
@@ -1504,8 +1494,13 @@ convertGenericCases bimap_functions
 	#! first_instance_index = size main_module_instances	
 	#! instance_info = (first_instance_index, [])
 
+	#! (gs_modules, gs_dcl_modules, (fun_info, instance_info, heaps, gs_error)) 
+		= build_exported_main_instances_in_modules 0 gs_modules gs_dcl_modules (fun_info, instance_info, heaps, gs_error)
+
+	#! first_main_instance_fun_index = fun_info.fg_fun_index
+
 	#! (gs_modules, gs_dcl_modules, (fun_info, instance_info, gs_funs, gs_td_infos, heaps, gs_error)) 
-		= build_main_instances_in_modules 0 gs_modules gs_dcl_modules (fun_info, instance_info, gs_funs, gs_td_infos, heaps, gs_error)
+		= build_main_instances_in_main_module gs_main_module gs_modules gs_dcl_modules (fun_info, instance_info, gs_funs, gs_td_infos, heaps, gs_error)
 
 	#! first_shorthand_function_index = fun_info.fg_fun_index
 
@@ -1516,13 +1511,13 @@ convertGenericCases bimap_functions
 	#! gs_funs = arrayPlusRevList gs_funs new_funs
 	#! gs_groups = arrayPlusRevList gs_groups new_groups
 
-	#! (instance_index, new_instances) = instance_info 
+	#! (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}	
 	#! gs_modules = {gs_modules & [gs_main_module] = main_common_defs}
 	
-	#! instance_fun_range = {ir_from=first_fun_index, ir_to=first_shorthand_function_index}
+	#! instance_fun_range = {ir_from=first_main_instance_fun_index, ir_to=first_shorthand_function_index}
 
 	# {hp_expression_heap, hp_var_heap, hp_generic_heap, hp_type_heaps={th_vars, th_attrs}} = heaps
 	# gs = {gs	& gs_modules = gs_modules
@@ -1539,53 +1534,129 @@ convertGenericCases bimap_functions
 		   }
 	= (instance_fun_range, gs)
 where
-	build_main_instances_in_modules :: !Index
-			!*{#CommonDefs} !*{#DclModule} (FunsAndGroups, (!Index, ![ClassInstance]), !*{#FunDef}, !*TypeDefInfos, !*Heaps, !*ErrorAdmin)
-		-> (!*{#CommonDefs}, *{#DclModule},(FunsAndGroups, (!Index, ![ClassInstance]), !*{#FunDef}, !*TypeDefInfos, !*Heaps, !*ErrorAdmin))
-	build_main_instances_in_modules module_index modules dcl_modules st
+	build_exported_main_instances_in_modules :: !Index
+			!*{#CommonDefs} !*{#DclModule} !(FunsAndGroups, !(!Index, ![ClassInstance]), !*Heaps, !*ErrorAdmin)
+		-> (!*{#CommonDefs},!*{#DclModule},!(FunsAndGroups, !(!Index, ![ClassInstance]), !*Heaps, !*ErrorAdmin))
+	build_exported_main_instances_in_modules module_index modules dcl_modules st
 		| module_index == size modules
 			= (modules, dcl_modules, st)
-		| not (inNumberSet module_index gs_used_modules)
-			= build_main_instances_in_modules (inc module_index) modules dcl_modules st
+		| not (inNumberSet module_index gs_used_modules) || module_index==gs_main_module
+			= build_exported_main_instances_in_modules (module_index+1) modules dcl_modules st
 			#! (com_gencase_defs,modules) = modules![module_index].com_gencase_defs
+			| size com_gencase_defs==0
+				= build_exported_main_instances_in_modules (module_index+1) modules dcl_modules st
 			#! (dcl_functions,dcl_modules) = dcl_modules![module_index].dcl_functions
 			#! (dcl_functions, modules, st)
-				= build_main_instances_in_module module_index com_gencase_defs {x\\x<-:dcl_functions} modules st  
+				= build_exported_main_instances_in_module module_index com_gencase_defs {x\\x<-:dcl_functions} modules st  
 			#! dcl_modules = {dcl_modules & [module_index].dcl_functions = dcl_functions} 
-			= build_main_instances_in_modules (inc module_index) modules dcl_modules st
+			= build_exported_main_instances_in_modules (module_index+1) modules dcl_modules st
 	where
-		build_main_instances_in_module module_index com_gencase_defs dcl_functions modules st
-			= foldArraySt (build_main_instance module_index) com_gencase_defs (dcl_functions, modules, st)
+		build_exported_main_instances_in_module module_index com_gencase_defs dcl_functions modules st
+			= foldArraySt (build_exported_main_instance module_index) com_gencase_defs (dcl_functions, modules, st)
+
+		build_exported_main_instance :: !Index !GenericCaseDef
+				(!*{#FunType} ,!*Modules, !(FunsAndGroups, !(!Index, ![ClassInstance]), !*Heaps, !*ErrorAdmin))
+			->	(!*{#FunType} ,!*Modules, !(FunsAndGroups, !(!Index, ![ClassInstance]), !*Heaps, !*ErrorAdmin))					
+		build_exported_main_instance module_index
+				gencase=:{gc_ident, gc_kind, gc_generic, gc_pos, gc_type, gc_type_cons, gc_body = GCB_FunIndex fun_index} 
+				(dcl_functions, modules, (fun_info, ins_info, heaps, error))
+			#! (class_info, (modules, heaps)) = get_class_for_kind gc_generic gc_kind (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]
 
-	build_main_instance :: !Index !GenericCaseDef
-			(!*{#FunType} ,!*Modules, (FunsAndGroups, (!Index, ![ClassInstance]), !*{#FunDef}, !*TypeDefInfos, !*Heaps, !*ErrorAdmin))
-		->	(!*{#FunType} ,!*Modules, (FunsAndGroups, (!Index, ![ClassInstance]), !*{#FunDef}, !*TypeDefInfos, !*Heaps, !*ErrorAdmin))					
-	build_main_instance module_index 
-			gencase=:{gc_ident, gc_kind, gc_generic, gc_pos, gc_type, gc_type_cons, gc_body = GCB_FunIndex fun_index} 
-			(dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error))
-		#! (class_info, (modules, heaps)) = get_class_for_kind gc_generic gc_kind (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]
+			#! has_generic_info = is_OBJECT_CONS_FIELD_type gc_type gs_predefs
+			#! ins_type = {it_vars = instance_vars_from_type_cons gc_type_cons, it_types = [gc_type], it_attr_vars = [], it_context = []}
+			#! (fun_type, heaps, error)
+				= determine_type_of_member_instance member_def ins_type heaps error
 
-		# it_vars = case gc_type_cons of 
-						TypeConsVar tv 	-> [tv]
-						_				-> []
-		#! ins_type = {it_vars = it_vars, it_types = [gc_type], it_attr_vars = [], it_context = []}
-		#! (fun_type, heaps, error)
-			= determine_type_of_member_instance member_def ins_type heaps error
+			#! fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
+
+			| not has_generic_info
+				#! (dcl_functions, heaps)
+					= update_dcl_function fun_index fun_ident fun_type dcl_functions heaps
+
+				# class_instance_member = {cim_ident=fun_ident,cim_arity=module_index,cim_index= -1-fun_index}
+				#! ins_info = build_class_instance class_info.gci_class gc_ident gc_pos gc_kind class_instance_member ins_type ins_info
+				= (dcl_functions, modules, (fun_info, ins_info, heaps, error))
+
+				# (fun_type_with_generic_info,type_heaps)
+					= add_generic_info_to_type fun_type gs_predefs heaps.hp_type_heaps
+				# heaps = {heaps & hp_type_heaps=type_heaps}
+
+				#! (dcl_functions, heaps)
+					= update_dcl_function fun_index fun_ident fun_type_with_generic_info dcl_functions heaps
+
+				#! ({ds_ident,ds_arity,ds_index}, fun_info, heaps)
+					= build_instance_member_with_generic_info module_index gc_ident gc_pos gc_kind fun_ident fun_index fun_type gs_predefs fun_info heaps
+				# class_instance_member = {cim_ident=ds_ident,cim_arity=ds_arity,cim_index=ds_index}
+
+				#! ins_info = build_class_instance class_info.gci_class gc_ident gc_pos gc_kind class_instance_member ins_type ins_info
+				= (dcl_functions, modules, (fun_info, ins_info, heaps, error))
+
+	build_main_instances_in_main_module :: !Index
+			!*{#CommonDefs} !*{#DclModule} !(FunsAndGroups, !(!Index, ![ClassInstance]), !*{#FunDef}, !*TypeDefInfos, !*Heaps, !*ErrorAdmin)
+		-> (!*{#CommonDefs},!*{#DclModule},!(FunsAndGroups, !(!Index, ![ClassInstance]), !*{#FunDef}, !*TypeDefInfos, !*Heaps, !*ErrorAdmin))
+	build_main_instances_in_main_module gs_main_module modules dcl_modules st
+		#! (com_gencase_defs,modules) = modules![gs_main_module].com_gencase_defs
+		| size com_gencase_defs==0
+			= (modules,dcl_modules,st)
+		#! (dcl_functions,dcl_modules) = dcl_modules![gs_main_module].dcl_functions
+		#! (dcl_functions, modules, st)
+			= foldArraySt (build_main_instance gs_main_module) com_gencase_defs ({x\\x<-:dcl_functions}, modules, st)
+		#! dcl_modules = {dcl_modules & [gs_main_module].dcl_functions = dcl_functions} 
+		= (modules,dcl_modules,st)
+	where
+		build_main_instance :: !Index !GenericCaseDef
+				(!*{#FunType}, !*Modules, !(FunsAndGroups, !(!Index, ![ClassInstance]), !*{#FunDef}, !*TypeDefInfos, !*Heaps, !*ErrorAdmin))
+			->	(!*{#FunType}, !*Modules, !(FunsAndGroups, !(!Index, ![ClassInstance]), !*{#FunDef}, !*TypeDefInfos, !*Heaps, !*ErrorAdmin))					
+		build_main_instance module_index
+				gencase=:{gc_ident, gc_kind, gc_generic, gc_pos, gc_type, gc_type_cons, gc_body = GCB_FunIndex fun_index} 
+				(dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error))
+			#! (class_info, (modules, heaps)) = get_class_for_kind gc_generic gc_kind (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 = {it_vars = instance_vars_from_type_cons gc_type_cons, it_types = [gc_type], it_attr_vars = [], it_context = []}
+			#! has_generic_info = is_OBJECT_CONS_FIELD_type gc_type gs_predefs
+			#! (fun_type, heaps, error)
+				= determine_type_of_member_instance member_def ins_type heaps error
+
+			#! fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
+
+			| not has_generic_info
+				#! (dcl_functions, heaps)
+					= update_dcl_function fun_index fun_ident fun_type dcl_functions heaps
+
+				#! (fun_info, fun_defs, td_infos, modules, heaps, error)
+					= update_icl_function fun_index fun_ident gencase fun_type has_generic_info
+						fun_info fun_defs td_infos modules heaps error
+
+				# class_instance_member = {cim_ident=fun_ident,cim_arity=module_index,cim_index= -1-fun_index}
+				#! ins_info = build_class_instance class_info.gci_class gc_ident gc_pos gc_kind class_instance_member ins_type ins_info
+				= (dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error))
 
-		# fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
+				# (fun_type_with_generic_info,type_heaps)
+					= add_generic_info_to_type fun_type gs_predefs heaps.hp_type_heaps
+				# heaps = {heaps & hp_type_heaps=type_heaps}
 
-		#! (dcl_functions, heaps) 
-			= update_dcl_function fun_index fun_ident fun_type dcl_functions heaps
+				#! (dcl_functions, heaps)
+					= update_dcl_function fun_index fun_ident fun_type_with_generic_info dcl_functions heaps
 
-		#! (fun_info, fun_defs, td_infos, modules, heaps, error)
-			= update_icl_function_if_needed module_index fun_index fun_ident gencase fun_type
-				fun_info fun_defs td_infos modules heaps error
+				#! (fun_info, fun_defs, td_infos, modules, heaps, error)
+					= update_icl_function fun_index fun_ident gencase fun_type_with_generic_info has_generic_info
+						fun_info fun_defs td_infos modules heaps error
 
-		#! ins_info = build_exported_class_instance class_info.gci_class gc_ident gc_pos gc_kind fun_ident fun_index module_index ins_type ins_info
+				#! ({ds_ident,ds_arity,ds_index}, fun_info, heaps)
+					= build_instance_member_with_generic_info module_index gc_ident gc_pos gc_kind fun_ident fun_index fun_type gs_predefs fun_info heaps
+				# class_instance_member = {cim_ident=ds_ident,cim_arity=ds_arity,cim_index=ds_index}
+	
+				#! ins_info = build_class_instance class_info.gci_class gc_ident gc_pos gc_kind class_instance_member ins_type ins_info
+				= (dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error))
 
-		= (dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error))
+	instance_vars_from_type_cons (TypeConsVar tv)
+		= [tv]
+	instance_vars_from_type_cons _
+		= []
 
 	build_shorthand_instances_in_modules :: !Index
 			!*{#CommonDefs} !*{#DclModule} (FunsAndGroups, (!Index, ![ClassInstance]), !*Heaps, !*ErrorAdmin)
@@ -1594,11 +1665,11 @@ where
 		| module_index == size modules
 			= (modules, dcl_modules, st)
 		| not (inNumberSet module_index gs_used_modules)
-			= build_shorthand_instances_in_modules (inc module_index) modules dcl_modules st
+			= build_shorthand_instances_in_modules (module_index+1) modules dcl_modules st
 			#! (com_gencase_defs,modules) = modules![module_index].com_gencase_defs
 			#! (modules, st)
 				= build_shorthand_instances_in_module module_index com_gencase_defs modules st  
-			= build_shorthand_instances_in_modules (inc module_index) modules dcl_modules st
+			= build_shorthand_instances_in_modules (module_index+1) modules dcl_modules st
 	where
 		build_shorthand_instances_in_module module_index com_gencase_defs modules st
 			= foldArraySt (build_shorthand_instances module_index) com_gencase_defs (modules, st)
@@ -1609,7 +1680,7 @@ where
 	build_shorthand_instances module_index gencase=:{gc_kind=KindConst} st	
 		= st
 	build_shorthand_instances module_index
-			gencase=:{gc_kind=KindArrow kinds,gc_body=GCB_FunIndex fun_index,gc_type,gc_type_cons,gc_generic,gc_ident,gc_pos}
+			gencase=:{gc_kind=gc_kind=:KindArrow kinds,gc_body=GCB_FunIndex fun_index,gc_type,gc_type_cons,gc_generic,gc_ident,gc_pos}
 			st		
 		= foldSt build_shorthand_instance [1 .. length kinds] st
 	where
@@ -1626,19 +1697,19 @@ where
 				= 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) 
+			#! (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
 
 			# fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
 
-			#! (memfun_ds, fun_info, heaps) 
-				= build_shorthand_instance_member module_index this_kind gencase fun_index fun_ident 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
-					
+			#! has_generic_info = is_OBJECT_CONS_FIELD_type gc_type gs_predefs
+
+			#! (memfun_ds, fun_info, heaps)
+				= build_shorthand_instance_member module_index this_kind gc_generic has_generic_info fun_index fun_ident gc_pos fun_type arg_class_infos fun_info heaps
+
+			#! ins_info = build_shorthand_class_instance this_kind class_info.gci_class gc_ident gc_pos memfun_ds ins_type ins_info
 			= (modules, (fun_info, ins_info, heaps, error))
 			
 		build_instance_type type class_infos heaps=:{hp_type_heaps=th=:{th_vars},hp_var_heap}
@@ -1690,9 +1761,10 @@ where
 					}
 				= (type_context, hp_var_heap)	
 
-		build_shorthand_instance_member module_index this_kind {gc_generic, gc_ident, gc_kind, gc_pos} fun_index fun_ident st class_infos fun_info heaps
-			# function_has_generic_info_arg = case this_kind of KindArrow [KindConst] -> True ; _ -> False 
-			#! arg_var_names = ["x" +++ toString i \\ i <- [1..st.st_arity-(if function_has_generic_info_arg 1 0)]]
+		build_shorthand_instance_member :: Int TypeKind GlobalIndex Bool Int Ident Position SymbolType [GenericClassInfo] !FunsAndGroups !*Heaps
+										-> (!DefinedSymbol,!FunsAndGroups,!*Heaps)
+		build_shorthand_instance_member module_index this_kind gc_generic has_generic_info fun_index fun_ident 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
@@ -1702,23 +1774,11 @@ where
 			# (gen_exprs, heaps) = mapSt (build_generic_app gc_generic gc_ident) class_infos heaps
 	
 			#! arg_exprs = gen_exprs ++ arg_var_exprs
-
-			# (arg_vars,heaps)
-				= case function_has_generic_info_arg of
-					True
-						#! (fv_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap
-						#! fv = {fv_count = 0, fv_ident = makeIdent "geninfo", fv_info_ptr = fv_info_ptr, fv_def_level = NotALevel}	
-						-> ([fv : arg_vars], {heaps & hp_var_heap = hp_var_heap})
-					False
-						-> (arg_vars, heaps)
-
 			# (body_expr, heaps)
-				= case gc_kind of
-					KindArrow [KindConst]
-						# (generic_info_expr, heaps) = buildPredefConsApp PD_NoGenericInfo [] gs_predefs heaps			
-						-> buildFunApp2 module_index fun_index fun_ident [generic_info_expr:arg_exprs] heaps
-					_
-						-> buildFunApp2 module_index fun_index fun_ident arg_exprs heaps
+				= if has_generic_info
+					(let (generic_info_expr, heaps2) = buildPredefConsApp PD_NoGenericInfo [] gs_predefs heaps			
+					 in buildFunApp2 module_index fun_index fun_ident [generic_info_expr:arg_exprs] heaps2)
+					(buildFunApp2 module_index fun_index fun_ident arg_exprs heaps)
 	
 			#! (st, heaps) = fresh_symbol_type st heaps
 
@@ -1727,15 +1787,12 @@ where
 
 			= (fun_ds, fun_info, heaps)
 		where
-			build_generic_app {gi_module, gi_index} gc_ident {gci_kind=gci_kind=:KindArrow [KindConst]} heaps
-				# (generic_info_expr, heaps) = buildPredefConsApp PD_NoGenericInfo [] gs_predefs heaps
-				= buildGenericApp gi_module gi_index gc_ident gci_kind [generic_info_expr] heaps
 			build_generic_app {gi_module, gi_index} gc_ident {gci_kind} heaps
 				= buildGenericApp gi_module gi_index gc_ident gci_kind [] heaps
 
-		build_class_instance this_kind class_index gencase {ds_ident,ds_arity,ds_index} ins_type (ins_index, instances)
-			# {gc_pos, gc_ident, gc_kind} = gencase			
-			#! class_ident = genericIdentToClassIdent gc_ident.id_name this_kind		
+		build_shorthand_class_instance :: TypeKind Int Ident Position DefinedSymbol InstanceType !(!Int,![ClassInstance]) -> (!Int,![ClassInstance])
+		build_shorthand_class_instance this_kind class_index gc_ident gc_pos {ds_ident,ds_arity,ds_index} ins_type (ins_index, instances)
+			#! class_ident = genericIdentToClassIdent gc_ident.id_name this_kind
 			#! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_ident}
 			#! ins = 
 			 	{	ins_class 	= {glob_module=gs_main_module, glob_object=class_ds}
@@ -1745,7 +1802,7 @@ where
 				,	ins_specials = SP_None
 				,	ins_pos		= gc_pos
 				}
-			= (inc ins_index, [ins:instances])
+			= (ins_index+1, [ins:instances])
 
 	get_class_for_kind :: !GlobalIndex !TypeKind !(!*{#CommonDefs},!*Heaps) -> (!GenericClassInfo,!(!*{#CommonDefs},!*Heaps))
 	get_class_for_kind {gi_module, gi_index} kind (modules,heaps=:{hp_generic_heap})
@@ -1777,74 +1834,134 @@ where
 			= (dcl_functions, heaps)
 			= (dcl_functions, heaps)
 
-	update_icl_function_if_needed module_index fun_index fun_ident gencase fun_type funs_and_groups fun_defs td_infos modules heaps error
-		| module_index == gs_main_module  // current module
-			= update_icl_function fun_index fun_ident gencase fun_type funs_and_groups fun_defs td_infos modules heaps error
-			= (funs_and_groups, fun_defs, td_infos, modules, heaps, error)
-
-	update_icl_function :: !Index !Ident !GenericCaseDef !SymbolType
+	update_icl_function :: !Index !Ident !GenericCaseDef !SymbolType !Bool
 			!FunsAndGroups !*{#FunDef} !*TypeDefInfos !*{#CommonDefs} !*Heaps !*ErrorAdmin 
 		-> (!FunsAndGroups,!*{#FunDef},!*TypeDefInfos,!*{#CommonDefs},!*Heaps,!*ErrorAdmin)
-	update_icl_function fun_index fun_ident gencase=:{gc_ident,gc_type_cons,gc_kind,gc_pos} st funs_and_groups fun_defs td_infos modules heaps error
+	update_icl_function fun_index fun_ident gencase=:{gc_ident,gc_type_cons,gc_kind,gc_pos} st has_generic_info funs_and_groups fun_defs td_infos modules heaps error
 		#! (st, heaps) = fresh_symbol_type st heaps
 		#! (fun=:{fun_body, fun_arity}, fun_defs) = fun_defs![fun_index] 		
 		= case fun_body of 
 			TransformedBody {tb_args,tb_rhs}	// user defined case
-				-> case gc_kind of
-					KindArrow [KindConst]
-						| fun_arity<>st.st_arity
-							# error = reportError gc_ident gc_pos ("incorrect arity " +++ toString (fun_arity-1)
-																	+++ ", expected " +++ toString (st.st_arity-1)) error
-							-> (funs_and_groups, fun_defs, td_infos, modules, heaps, error)	
-						#! fun = {fun & fun_ident = fun_ident, fun_type = Yes st}
-						#! fun_defs = {fun_defs & [fun_index] = fun}
-						-> (funs_and_groups, fun_defs, td_infos, modules, heaps, error)
-					_
-						# fun_body = TransformedBody {tb_args = tl tb_args, tb_rhs = tb_rhs}
-						| fun_arity-1<>st.st_arity
-							# error = reportError gc_ident gc_pos ("incorrect arity " +++ toString (fun_arity-1)
-																	+++ ", expected " +++ toString st.st_arity) error
-							-> (funs_and_groups, fun_defs, td_infos, modules, heaps, error)	
-						#! fun = {fun & fun_ident = fun_ident, fun_body = fun_body, fun_type = Yes st}
-						#! fun_defs = {fun_defs & [fun_index] = fun}
-						-> (funs_and_groups, fun_defs, td_infos, modules, heaps, error)
+				| has_generic_info
+					| fun_arity<>st.st_arity
+						# error = reportError gc_ident gc_pos ("incorrect arity " +++ toString (fun_arity-1)
+																+++ ", expected " +++ toString (st.st_arity-1)) error
+						-> (funs_and_groups, fun_defs, td_infos, modules, heaps, error)	
+					#! fun = {fun & fun_ident = fun_ident, fun_type = Yes st}
+					#! fun_defs = {fun_defs & [fun_index] = fun}
+					-> (funs_and_groups, fun_defs, td_infos, modules, heaps, error)
+					# fun_body = TransformedBody {tb_args = tl tb_args, tb_rhs = tb_rhs}
+					| fun_arity-1<>st.st_arity
+						# error = reportError gc_ident gc_pos ("incorrect arity " +++ toString (fun_arity-1)
+																+++ ", expected " +++ toString st.st_arity) error
+						-> (funs_and_groups, fun_defs, td_infos, modules, heaps, error)	
+					#! fun = {fun & fun_ident = fun_ident, fun_body = fun_body, fun_type = Yes st}
+					#! fun_defs = {fun_defs & [fun_index] = fun}
+					-> (funs_and_groups, fun_defs, td_infos, modules, heaps, error)
 			GeneratedBody		// derived case
 				#! (TransformedBody {tb_args, tb_rhs}, funs_and_groups, td_infos, modules, heaps, error)
-						= buildGenericCaseBody gs_main_module gencase st gs_predefs funs_and_groups td_infos modules heaps error
+						= buildGenericCaseBody gs_main_module gencase has_generic_info st gs_predefs funs_and_groups td_infos modules heaps error
 				# {fg_group_index,fg_groups} = funs_and_groups
-				#! fun = makeFunction fun_ident fun_index fg_group_index tb_args tb_rhs (Yes st) gs_main_module gc_pos
+				#! fun = makeFunction fun_ident fg_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]}
 				  funs_and_groups = {funs_and_groups & fg_group_index=fg_group_index+1,fg_groups=[group:fg_groups]}
 				-> (funs_and_groups, fun_defs, td_infos, modules, heaps, error)
 
-	build_exported_class_instance class_index gc_ident gc_pos gc_kind fun_ident fun_index fun_module_index ins_type (ins_index, instances)
+	build_class_instance :: Int Ident Position TypeKind ClassInstanceMember InstanceType !(!Int,![ClassInstance]) -> (!Int,![ClassInstance])
+	build_class_instance class_index gc_ident gc_pos gc_kind class_instance_member ins_type (ins_index, instances)
 		# class_ident = genericIdentToClassIdent gc_ident.id_name gc_kind
 		# class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_ident}
-		#! ins = 
+		#! ins =
 		 	{	ins_class 	= {glob_module=gs_main_module, glob_object=class_ds}
 			,	ins_ident 	= class_ident
 			,	ins_type 	= ins_type
-			,	ins_members	= {{cim_ident=fun_ident,cim_arity=fun_module_index,cim_index= -1-fun_index}}
+			,	ins_members	= {class_instance_member}
 			,	ins_specials = SP_None
 			,	ins_pos		= gc_pos
 			}
-		= (inc ins_index, [ins:instances])
+		= (ins_index+1, [ins:instances])
+
+	// Creates a function that just calls the generic case function, but with an extra NoGenericInfo argument
+	build_instance_member_with_generic_info module_index gc_ident gc_pos gcf_kind fun_ident fun_index st predefs 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
+
+		# (generic_info_expr, heaps) = buildPredefConsApp PD_NoGenericInfo [] predefs heaps
+		# arg_var_exprs = [generic_info_expr:arg_var_exprs]
+
+		#! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
+		#! heaps = {heaps & hp_expression_heap = hp_expression_heap}
+		#! expr = App 
+			{ app_symb = 
+				{ symb_ident=fun_ident
+				, 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_ident.id_name gcf_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)
 
 	fresh_symbol_type :: !SymbolType !*Heaps -> (!SymbolType, !*Heaps)	
 	fresh_symbol_type st heaps=:{hp_type_heaps}
 		# (fresh_st, hp_type_heaps) = freshSymbolType st hp_type_heaps
 		= (fresh_st, {heaps & hp_type_heaps = hp_type_heaps})	
 
+// add an argument for generic info at the beginning
+add_generic_info_to_type :: !SymbolType !{#PredefinedSymbol} !*TypeHeaps -> (!SymbolType,!*TypeHeaps)
+add_generic_info_to_type st=:{st_arity, st_args, st_args_strictness} predefs th=:{th_vars}
+	#! {pds_module, pds_def} = 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_lazy_values_at_beginning 1 st_args_strictness	 
+			}
+	= (st, {th & th_vars = th_vars})
+
+index_OBJECT_CONS_FIELD_type :: !Type !{#PredefinedSymbol} -> Int
+index_OBJECT_CONS_FIELD_type (TA {type_index={glob_module,glob_object}} []) predefs
+	# {pds_module,pds_def} = predefs.[PD_TypeOBJECT]
+	| glob_module==pds_module && pds_def==glob_object
+		= 0
+	# {pds_module,pds_def} = predefs.[PD_TypeCONS]
+	| glob_module==pds_module && pds_def==glob_object
+		= 1
+	# {pds_module,pds_def} = predefs.[PD_TypeFIELD]
+	| glob_module==pds_module && pds_def==glob_object
+		= 2
+		= -1
+index_OBJECT_CONS_FIELD_type _ predefs
+	= -1
+
+is_OBJECT_CONS_FIELD_type :: !Type !{#PredefinedSymbol} -> Bool
+is_OBJECT_CONS_FIELD_type (TA {type_index={glob_module,glob_object}} []) predefs
+	# {pds_module,pds_def} = predefs.[PD_TypeOBJECT]
+	| glob_module==pds_module && pds_def==glob_object
+		= True
+	# {pds_module,pds_def} = predefs.[PD_TypeCONS]
+	| glob_module==pds_module && pds_def==glob_object
+		= True
+	# {pds_module,pds_def} = predefs.[PD_TypeFIELD]
+	| glob_module==pds_module && pds_def==glob_object
+		= True
+		= False
+is_OBJECT_CONS_FIELD_type _ predefs
+	= False
+
 buildGenericCaseBody :: 
 		!Index					// current icl module
-		!GenericCaseDef	
+		!GenericCaseDef	!Bool
 		!SymbolType				// type of the instance function 
 		!PredefinedSymbols
 		!FunsAndGroups !*TypeDefInfos !*{#CommonDefs} !*Heaps !*ErrorAdmin 
 	-> (!FunctionBody,
 		!FunsAndGroups, !*TypeDefInfos,!*{#CommonDefs},!*Heaps,!*ErrorAdmin)
-buildGenericCaseBody main_module_index gc=:{gc_type_cons=TypeConsSymb {type_ident,type_index},gc_kind,gc_generic} st predefs
+buildGenericCaseBody main_module_index gc=:{gc_type_cons=TypeConsSymb {type_ident,type_index},gc_kind,gc_generic} has_generic_info st predefs
 					funs_and_groups td_infos modules heaps error
 	#! (gen_def, modules) = modules![gc_generic.gi_module].com_generic_defs.[gc_generic.gi_index]
 	#! (td_info=:{tdi_gen_rep}, td_infos) = td_infos![type_index.glob_module,type_index.glob_object]
@@ -1857,19 +1974,19 @@ buildGenericCaseBody main_module_index gc=:{gc_type_cons=TypeConsSymb {type_iden
 		= build_arg_vars gen_def td_args heaps
 
 	# (arg_vars,heaps)
-		= case gc_kind of
-			KindArrow [KindConst]
+		= case has_generic_info of
+			True
 				# (generic_info_var, heaps) = build_generic_info_arg heaps
 				#! arg_vars = [generic_info_var:arg_vars]
 				-> (arg_vars,heaps)
-			_
+			False
 				-> (arg_vars,heaps)
 
 	#! (optional_adaptor_expr, adapted_arg_exprs, original_arg_exprs, funs_and_groups, modules, td_infos, heaps, error)
 		= build_adaptor_expr gc gen_def gen_type_rep original_arg_exprs funs_and_groups modules td_infos heaps error
 
 	#! (specialized_expr, funs_and_groups, td_infos, heaps, error)
-		= build_specialized_expr gc gtr_type td_args generated_arg_exprs funs_and_groups td_infos heaps error
+		= build_specialized_expr gc gtr_type td_args generated_arg_exprs gen_def.gen_info_ptr funs_and_groups td_infos heaps error
 
 	# body_expr = build_body_expr optional_adaptor_expr specialized_expr adapted_arg_exprs original_arg_exprs
 	= (TransformedBody {tb_args=arg_vars, tb_rhs=body_expr}, funs_and_groups, td_infos, modules, heaps, error)	
@@ -1893,7 +2010,7 @@ where
 
 	// adaptor that converts a function for the generic representation into a 
 	// function for the type itself
-	build_adaptor_expr {gc_ident, gc_pos} {gen_type, gen_vars, gen_info_ptr} {gtr_iso,gtr_to,gtr_from} original_arg_exprs funs_and_groups modules td_infos heaps error
+	build_adaptor_expr {gc_pos} {gen_type, gen_vars, gen_info_ptr} {gtr_iso,gtr_to,gtr_from} original_arg_exprs funs_and_groups modules td_infos heaps error
 		#! (var_kinds, heaps) = get_var_kinds gen_info_ptr heaps		
 		#! non_gen_var_kinds = drop (length gen_vars) var_kinds  
 		
@@ -1943,21 +2060,15 @@ where
 				# (expr, funs_and_groups, heaps)
 					= bimap_id_expression main_module_index predefs funs_and_groups heaps
 				= ((non_gen_var, TVI_Expr expr), funs_and_groups, heaps)
-			build_bimap_expr non_gen_var kind=:(KindArrow [KindConst]) funs_and_groups heaps
-				# (generic_info_expr, heaps) = build_generic_info_expr heaps
-				#! (expr, heaps)
-					= buildGenericApp bimap_module bimap_index bimap_ident kind [generic_info_expr] heaps		
-				= ((non_gen_var, TVI_Expr expr), funs_and_groups, heaps)
 			build_bimap_expr non_gen_var kind funs_and_groups heaps
 				#! (expr, heaps)
 					= buildGenericApp bimap_module bimap_index bimap_ident kind [] heaps		
 				= ((non_gen_var, TVI_Expr expr), funs_and_groups, heaps)
 
-			build_generic_info_expr heaps
-				= buildPredefConsApp PD_NoGenericInfo [] predefs heaps
-
 	// generic function specialzied to the generic representation of the type
-	build_specialized_expr {gc_ident, gc_pos, gc_generic} gtr_type td_args generated_arg_exprs funs_and_groups td_infos heaps error
+	build_specialized_expr :: GenericCaseDef GenTypeStruct [ATypeVar] [Expression] GenericInfoPtr !FunsAndGroups !*TypeDefInfos !*Heaps !*ErrorAdmin
+																				  -> (!Expression,!FunsAndGroups,!*TypeDefInfos,!*Heaps,!*ErrorAdmin)
+	build_specialized_expr {gc_ident, gc_pos, gc_generic} gtr_type td_args generated_arg_exprs gen_info_ptr funs_and_groups td_infos heaps error
 		#! spec_env = [(atv_variable, TVI_Expr expr) \\ {atv_variable} <- td_args & expr <- generated_arg_exprs]
 		# generic_bimap = predefs.[PD_GenericBimap]
 		| gc_generic.gi_module==generic_bimap.pds_module && gc_generic.gi_index==generic_bimap.pds_def
@@ -1968,7 +2079,12 @@ where
 			# (expr,funs_and_groups,heaps,error)
 				= specialize_generic_bimap gc_generic gtr_type spec_env gc_ident gc_pos main_module_index predefs funs_and_groups heaps error
 			= (expr,funs_and_groups,td_infos,heaps,error)
-			# (expr,td_infos,heaps,error) = specializeGeneric gc_generic gtr_type spec_env gc_ident gc_pos main_module_index predefs td_infos heaps error
+
+			# ({gen_OBJECT_CONS_FIELD_indices},generic_heap) = readPtr gen_info_ptr heaps.hp_generic_heap
+			  heaps = {heaps & hp_generic_heap=generic_heap}
+
+			# (expr,td_infos,heaps,error)
+				= specializeGeneric gc_generic gtr_type spec_env gc_ident gc_pos gen_OBJECT_CONS_FIELD_indices main_module_index td_infos heaps error
 			= (expr,funs_and_groups,td_infos,heaps,error)
 
 	// the body expression
@@ -1989,7 +2105,7 @@ where
 	build_body_expr (Yes adaptor_expr) specialized_expr adapted_arg_exprs original_arg_exprs
 		= (adaptor_expr @ [specialized_expr @ adapted_arg_exprs]) @ original_arg_exprs
 
-buildGenericCaseBody main_module_index {gc_ident,gc_pos} st predefs funs_and_groups td_infos modules heaps error
+buildGenericCaseBody main_module_index {gc_ident,gc_pos} has_generic_info st predefs funs_and_groups td_infos modules heaps error
 	# error = reportError gc_ident gc_pos "cannot specialize to this type" error
 	= (TransformedBody {tb_args=[], tb_rhs=EE}, funs_and_groups, td_infos, modules, heaps, error)
 
@@ -2048,9 +2164,8 @@ where
 			# (modules, dcl_modules, st) = convert_module module_index modules dcl_modules st
 			= convert_modules (inc module_index) modules dcl_modules st
 	
-	convert_module :: 
-			!Index !*Modules !*DclModules (!*Heaps, !*ErrorAdmin)
-		-> (!*Modules, !*DclModules, (!*Heaps, !*ErrorAdmin))
+	convert_module :: !Index !*Modules !*DclModules (!*Heaps, !*ErrorAdmin)
+						 -> (!*Modules,!*DclModules,(!*Heaps, !*ErrorAdmin))
 	convert_module module_index modules dcl_modules st
 		| inNumberSet module_index gs_used_modules		 
 			#! (common_defs, modules) = modules ! [module_index]
@@ -2059,14 +2174,8 @@ where
 			#! (common_defs, modules, st) = convert_common_defs common_defs modules st
 			#! (dcl_common, modules, st) = convert_common_defs dcl_common modules st
 			#! (dcl_functions, modules, st) = convert_dcl_functions {x\\x<-:dcl_functions} modules st
-						
-			# dcl_modules = 
-				{ dcl_modules & [module_index] = 
-					{ dcl_module 
-					& dcl_functions = dcl_functions
-					, dcl_common = dcl_common
-					}
-				}
+
+			# dcl_modules = {dcl_modules & [module_index] = {dcl_module & dcl_functions = dcl_functions, dcl_common = dcl_common}}
 			# modules = {modules & [module_index] = common_defs}
 			= (modules, dcl_modules, st)
 		| otherwise
@@ -2080,7 +2189,7 @@ where
 		# (com_instance_defs, (modules, heaps, error))
 			= updateArraySt convert_instance {x\\x<-:com_instance_defs} st
 		
-		# common_defs = { common_defs 
+		# common_defs = { common_defs
 			& com_class_defs = com_class_defs
 			, com_member_defs = com_member_defs
 			, com_instance_defs = com_instance_defs
@@ -2163,12 +2272,12 @@ specializeGeneric ::
 		![(TypeVar, TypeVarInfo)] // specialization environment
 		!Ident					// generic/generic case
 		!Position				// of generic case
+		!{#OBJECT_CONS_FIELD_index}
 		!Index 					// main_module index
-		!PredefinedSymbols
 		!*TypeDefInfos !*Heaps !*ErrorAdmin
 	-> (!Expression,
 		!*TypeDefInfos,!*Heaps,!*ErrorAdmin)
-specializeGeneric gen_index type spec_env gen_ident gen_pos main_module_index predefs td_infos heaps error
+specializeGeneric gen_index type spec_env gen_ident gen_pos gen_OBJECT_CONS_FIELD_indices main_module_index td_infos heaps error
 	#! heaps = set_tvs spec_env heaps
 	#! (expr, (td_infos, heaps, error)) 
 		= specialize type (td_infos, heaps, error)
@@ -2177,7 +2286,7 @@ specializeGeneric gen_index type spec_env gen_ident gen_pos main_module_index pr
 where
 	specialize (GTSAppCons kind arg_types) st
 		#! (arg_exprs, st) = mapSt specialize arg_types st
-		= build_generic_app kind arg_exprs gen_index gen_ident predefs st
+		= build_generic_app kind arg_exprs gen_index gen_ident st
 	specialize (GTSAppVar tv arg_types) st
 		#! (arg_exprs, st) = mapSt specialize arg_types st
 		#! (expr, st) = specialize_type_var tv st 
@@ -2187,33 +2296,51 @@ where
 	specialize (GTSArrow x y) st
 		#! (x, st) = specialize x st
 		#! (y, st) = specialize y st
-		= build_generic_app_no_info (KindArrow [KindConst, KindConst]) [x,y] gen_index gen_ident predefs st
+		= build_generic_app (KindArrow [KindConst, KindConst]) [x,y] gen_index gen_ident st
 	specialize (GTSPair x y) st
 		#! (x, st) = specialize x st
 		#! (y, st) = specialize y st
-		= build_generic_app_no_info (KindArrow [KindConst, KindConst]) [x,y] gen_index gen_ident predefs st
+		= build_generic_app (KindArrow [KindConst, KindConst]) [x,y] gen_index gen_ident st
 	specialize (GTSEither x y) st
 		#! (x, st) = specialize x st
 		#! (y, st) = specialize y st
-		= build_generic_app_no_info (KindArrow [KindConst, KindConst]) [x,y] gen_index gen_ident predefs st
+		= build_generic_app (KindArrow [KindConst, KindConst]) [x,y] gen_index gen_ident 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_ident (KindArrow [KindConst]) [generic_info_expr, arg_expr] heaps
-		= (expr, (td_infos, heaps, error))
+		#! (generic_info_expr, heaps) = buildFunApp main_module_index cons_info_ds [] heaps		
+		# gen_CONS_index = gen_OBJECT_CONS_FIELD_indices.[1]
+		| gen_CONS_index.ocf_module>=0
+			#! (expr, heaps)
+				= buildFunApp2 gen_CONS_index.ocf_module gen_CONS_index.ocf_index gen_CONS_index.ocf_ident [generic_info_expr, arg_expr] heaps
+			= (expr, (td_infos, heaps, error))
+			// no instance for CONS, report error here ?
+			#! (expr, heaps)
+				= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident (KindArrow [KindConst]) [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_ident (KindArrow [KindConst]) [generic_info_expr, arg_expr] heaps
-		= (expr, (td_infos, heaps, error))
+		# gen_FIELD_index = gen_OBJECT_CONS_FIELD_indices.[2]
+		| gen_FIELD_index.ocf_module>=0
+			#! (expr, heaps)
+				= buildFunApp2 gen_FIELD_index.ocf_module gen_FIELD_index.ocf_index gen_FIELD_index.ocf_ident [generic_info_expr, arg_expr] heaps
+			= (expr, (td_infos, heaps, error))
+			// no instance for FIELD, report error here ?
+ 			#! (expr, heaps)
+				= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident (KindArrow [KindConst]) [arg_expr] heaps
+			= (expr, (td_infos, heaps, error))
 	specialize (GTSObject type_info_ds arg_type) st
 		# (arg_expr, (td_infos, heaps, error)) = specialize arg_type st
 		#! (generic_info_expr, heaps) = buildFunApp main_module_index type_info_ds [] heaps
-		#! (expr, heaps)
-			= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident (KindArrow [KindConst]) [generic_info_expr, arg_expr] heaps
-		= (expr, (td_infos, heaps, error))
+		# gen_OBJECT_index = gen_OBJECT_CONS_FIELD_indices.[0]
+		| gen_OBJECT_index.ocf_module>=0
+			#! (expr, heaps)
+				= buildFunApp2 gen_OBJECT_index.ocf_module gen_OBJECT_index.ocf_index gen_OBJECT_index.ocf_ident [generic_info_expr, arg_expr] heaps
+			= (expr, (td_infos, heaps, error))
+		// no instance for OBJECT, report error here ?
+	 		#! (expr, heaps)
+				= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident (KindArrow [KindConst]) [arg_expr] heaps
+			= (expr, (td_infos, heaps, error))
 	specialize type (td_infos, heaps, error)
 		#! error = reportError gen_ident gen_pos "cannot specialize " error 
 		= (EE, (td_infos, heaps, error))
@@ -2228,16 +2355,7 @@ where
 				# (expr,heaps) = buildFunApp main_module_index iso_ds [] heaps
 				-> (expr, (td_infos, heaps, error))
 
-	build_generic_app kind=:(KindArrow [KindConst]) arg_exprs gen_index gen_ident predefs (td_infos, heaps, error)
-		# (generic_info_expr, heaps) = buildPredefConsApp PD_NoGenericInfo [] predefs heaps		
-		# arg_exprs = [generic_info_expr:arg_exprs]
-		#! (expr, heaps)
-			= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident kind arg_exprs heaps 
-		= (expr, (td_infos, heaps, error))
-	build_generic_app kind arg_exprs gen_index gen_ident predefs (td_infos, heaps, error)
-		= build_generic_app_no_info kind arg_exprs gen_index gen_ident predefs (td_infos, heaps, error)
-
-	build_generic_app_no_info kind arg_exprs gen_index gen_ident predefs (td_infos, heaps, error)
+	build_generic_app kind arg_exprs gen_index gen_ident (td_infos, heaps, error)
 		#! (expr, heaps)
 			= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident kind arg_exprs heaps 
 		= (expr, (td_infos, heaps, error))
@@ -2266,7 +2384,7 @@ where
 		= (expr ,(funs_and_groups, heaps, error))
 	specialize (GTSAppCons kind arg_types) st
 		#! (arg_exprs, st) = mapSt specialize arg_types st
-		= build_generic_app kind arg_exprs gen_index gen_ident predefs st
+		= build_generic_app kind arg_exprs gen_index gen_ident st
 	specialize (GTSAppVar tv arg_types) st
 		#! (arg_exprs, st) = mapSt specialize arg_types st
 		#! (expr, st) = specialize_type_var tv st 
@@ -2339,13 +2457,7 @@ where
 				# (expr,heaps) = buildFunApp main_module_index iso_ds [] heaps
 				-> (expr, (funs_and_groups, heaps, error))
 
-	build_generic_app kind=:(KindArrow [KindConst]) arg_exprs gen_index gen_ident predefs (funs_and_groups, heaps, error)
-		# (generic_info_expr, heaps) = buildPredefConsApp PD_NoGenericInfo [] predefs heaps		
-		# arg_exprs = [generic_info_expr:arg_exprs]
-		#! (expr, heaps)
-			= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident kind arg_exprs heaps 
-		= (expr, (funs_and_groups, heaps, error))
-	build_generic_app kind arg_exprs gen_index gen_ident predefs (funs_and_groups, heaps, error)
+	build_generic_app kind arg_exprs gen_index gen_ident (funs_and_groups, heaps, error)
 		#! (expr, heaps)
 			= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident kind arg_exprs heaps 
 		= (expr, (funs_and_groups, heaps, error))
@@ -2510,13 +2622,13 @@ where
 		#! (arg_exprs, st) = mapSt specialize arg_types st
 		# (funs_and_groups, heaps, error) = st
 		  (expr, heaps)
-		  	= build_generic_app kind arg_exprs gen_index gen_ident predefs heaps
+		  	= build_generic_app kind arg_exprs gen_index gen_ident heaps
 		= (expr, (funs_and_groups, heaps, error))
 	specialize (GTSAppBimap kind arg_types) st
 		#! (arg_exprs, st) = mapSt specialize arg_types st
 		# (funs_and_groups, heaps, error) = st
 		  (expr, heaps)
-		  	= build_generic_app kind arg_exprs gen_index gen_ident predefs heaps
+		  	= build_generic_app kind arg_exprs gen_index gen_ident heaps
 		= (expr, (funs_and_groups, heaps, error))
 	specialize (GTSAppVar tv arg_types) st
 		#! (arg_exprs, st) = mapSt specialize arg_types st
@@ -2561,11 +2673,7 @@ where
 				# (expr,heaps) = buildFunApp main_module_index iso_ds [] heaps
 				-> (expr, (funs_and_groups, heaps, error))
 
-	build_generic_app kind=:(KindArrow [KindConst]) arg_exprs gen_index gen_ident predefs heaps
-		# (generic_info_expr, heaps) = buildPredefConsApp PD_NoGenericInfo [] predefs heaps		
-		# arg_exprs = [generic_info_expr:arg_exprs]
-		= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident kind arg_exprs heaps 
-	build_generic_app kind arg_exprs gen_index gen_ident predefs heaps
+	build_generic_app kind arg_exprs gen_index gen_ident heaps
 		= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident kind arg_exprs heaps 
 
 is_bimap_id_expression (TVI_Expr (App {app_symb={symb_kind=SK_Function fun_glob},app_args=[]})) main_module_index {fg_bimap_functions={bimap_id_function={fii_index}}}
@@ -3515,9 +3623,7 @@ where
  		#! atype = makeAType (arg --> res) (TA_Var av)
 		= (atype, [av:avs], inc av_num, th_attrs)
 
-//----------------------------------------------------------------------------------------
 // write empty value in the variable heaps 
-//----------------------------------------------------------------------------------------
 
 clearType t th 
 	= foldType clear_type clear_atype t th
@@ -3772,7 +3878,6 @@ where
 		#! th_attrs = foldSt (\{av_info_ptr} h->writePtr av_info_ptr AVI_Empty h) avs th_attrs
 		= {th & th_attrs = th_attrs}				
 
-
 expandSynonymType :: !CheckedTypeDef !TypeAttribute ![AType] !*TypeHeaps -> (!Type, !*TypeHeaps)
 expandSynonymType {td_rhs=SynType {at_type}, td_args, td_attribute} ta_attr ta_args th
 	#! th_attrs = bind_attribute td_attribute ta_attr th.th_attrs
@@ -3802,16 +3907,12 @@ expandSynonymType td ta_attr ta_args th = abort "expanding not a synonym type\n"
 
 //	Function Helpers
 
-makeFunction :: !Ident !Index !Index ![FreeVar] !Expression !(Optional SymbolType) !Index !Position
-	-> FunDef
-makeFunction ident fun_index group_index arg_vars body_expr opt_sym_type main_dcl_module_n fun_pos
-	
+makeFunction :: !Ident !Index ![FreeVar] !Expression !(Optional SymbolType) !Index !Position -> FunDef
+makeFunction ident group_index arg_vars body_expr opt_sym_type main_dcl_module_n fun_pos	
 	#! (arg_vars, local_vars, free_vars) = collectVars body_expr arg_vars	
 	| not (isEmpty free_vars)
-		= abort "makeFunction: free_vars is not empty\n"  
-				
-	#! fun_def =	
-		{ fun_ident = ident
+		= abort "makeFunction: free_vars is not empty\n"
+	=	{ fun_ident = ident
 		, fun_arity = length arg_vars
 		, fun_priority = NoPrio
 		, fun_body = TransformedBody {tb_args = arg_vars, tb_rhs = body_expr }
@@ -3829,14 +3930,12 @@ makeFunction ident fun_index group_index arg_vars body_expr opt_sym_type main_dc
 			, fi_properties = 0
 			}	
 		}
-	= fun_def				
-		//---> ("makeFunction", ident, fun_index, main_dcl_module_n, fun_def.fun_info.fi_calls)
 
 buildFunAndGroup :: !Ident ![FreeVar] !Expression !(Optional SymbolType) !Index !Position !FunsAndGroups -> (!DefinedSymbol, FunsAndGroups)
 buildFunAndGroup 
 		ident arg_vars body_expr opt_sym_type main_dcl_module_n fun_pos 
 		funs_and_groups=:{fg_fun_index,fg_group_index,fg_funs,fg_groups}
-	# fun = makeFunction ident fg_fun_index fg_group_index arg_vars body_expr opt_sym_type main_dcl_module_n fun_pos	
+	# fun = makeFunction ident fg_group_index arg_vars body_expr opt_sym_type main_dcl_module_n fun_pos
 	# group = {group_members = [fg_fun_index]}
 	# def_sym = {ds_ident=ident, ds_arity=fun.fun_arity, ds_index=fg_fun_index}
 	  funs_and_groups = {funs_and_groups & fg_fun_index=fg_fun_index+1, fg_group_index=fg_group_index+1, fg_funs=[fun:fg_funs], fg_groups=[group:fg_groups]}
@@ -3844,16 +3943,14 @@ buildFunAndGroup
 
 buildFunAndGroup2 :: !Ident ![FreeVar] !Expression !Index !FunsAndGroups -> (!Index, !FunsAndGroups)
 buildFunAndGroup2 ident arg_vars body_expr main_dcl_module_n funs_and_groups=:{fg_fun_index,fg_group_index,fg_funs,fg_groups}
-	# fun = makeFunction ident fg_fun_index fg_group_index arg_vars body_expr No main_dcl_module_n NoPos	
+	# fun = makeFunction ident fg_group_index arg_vars body_expr No main_dcl_module_n NoPos
 	  group = {group_members = [fg_fun_index]}
 	  funs_and_groups = {funs_and_groups & fg_fun_index=fg_fun_index+1, fg_group_index=fg_group_index+1, fg_funs=[fun:fg_funs], fg_groups=[group:fg_groups]}
 	= (fg_fun_index, funs_and_groups)
 	
 //	Expr Helpers
 
-//========================================================================================
 // Primitive expressions
-//========================================================================================
 
 makeIntExpr :: Int -> Expression
 makeIntExpr value = BasicExpr (BVI (toString value))
@@ -3996,9 +4093,7 @@ buildRecordSelectionExpr record_expr predef_field field_n predefs
 		glob_object = {ds_ident = pds_ident, ds_index = pds_def, ds_arity = 1}}
 	= Selection NormalSelector record_expr [RecordSelection selector field_n]
 
-//=============================================================================
 // variables
-//=============================================================================
 
 // build a new variable and an expression associated with it
 buildVarExpr :: 
@@ -4023,10 +4118,8 @@ buildVarExprs [x:xs] heaps
 	# (y, z, heaps) = buildVarExpr x heaps
 	# (ys, zs, heaps) = buildVarExprs xs heaps
 	= ([y:ys], [z:zs], heaps)
-	 
-//=============================================================================
+
 // recursion over expressions
-//=============================================================================
 
 //-----------------------------------------------------------------------------
 // fold expression applies a function to each node of an expression
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 39af652..22aedd1 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -392,7 +392,15 @@ cNameLocationDependent :== True
 :: GenericInfo = 
 	{	gen_classes		:: !GenericClassInfos
 	,	gen_var_kinds	:: ![TypeKind]  	// kinds of all st_vars of the gen_type
+	,	gen_OBJECT_CONS_FIELD_indices	:: !{#OBJECT_CONS_FIELD_index}
 	}
+
+::	OBJECT_CONS_FIELD_index =
+	{	ocf_module	:: !Int
+	,	ocf_index	:: !Int
+	,	ocf_ident	:: !Ident
+	}
+
 :: GenericInfoPtr :== Ptr GenericInfo	
 :: GenericHeap :== Heap GenericInfo
 
@@ -550,7 +558,7 @@ NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex}
 	| GTSAppBimap TypeKind [GenTypeStruct]		// for optimizing bimaps
 	| GTSPair !GenTypeStruct !GenTypeStruct		// for optimizing bimaps
 	| GTSEither !GenTypeStruct !GenTypeStruct	// for optimizing bimaps
- 
+
 :: GenericTypeRep = 
 	{ gtr_type :: GenTypeStruct		// generic structure type
 	, gtr_iso  :: !DefinedSymbol	// the conversion isomorphism