generics.icl 177 KB
Newer Older
1 2 3 4 5 6 7 8 9
implementation module generics

import StdEnv
import _aconcat
import hashtable
import checksupport
import checktypes
import check
import analtypes
10 11 12 13 14 15
/*2.0
from transform import ::Group
0.2*/
//1.3
from transform import Group
//3.1
16

17 18
// whether to generate CONS 
// (needed for function that use CONS, like toString) 
Artem Alimarine's avatar
Artem Alimarine committed
19
supportCons :== False
20 21 22

// whether to bind _cons_info to actual constructor info
// (needed for functions that create CONS, like fromString)			
Artem Alimarine's avatar
Artem Alimarine committed
23
supportConsInfo :== True && supportCons
24 25

// whether generate missing alternatives 		
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
supportPartialInstances :== False

:: *GenericState = 
	{	gs_modules				:: !*{#CommonDefs}
	,	gs_fun_defs				:: !*{# FunDef}
	,	gs_groups				:: !{!Group}
	,	gs_td_infos 			:: !*TypeDefInfos
	,	gs_gtd_infos			:: !*GenericTypeDefInfos
	,	gs_heaps				:: !*Heaps
	,	gs_main_dcl_module_n	:: !Index
	,	gs_first_fun			:: !Index
	,	gs_last_fun				:: !Index
	,	gs_first_group			:: !Index
	,	gs_last_group			:: !Index
	,	gs_predefs				:: !PredefinedSymbols
	,	gs_dcl_modules			:: !*{#DclModule}
	,	gs_opt_dcl_icl_conversions :: !*(Optional !*{#Index})
	,	gs_error 				:: !*ErrorAdmin	
44 45 46 47
	}

:: GenericTypeDefInfo  
	= GTDI_Empty 							// no generic rep needed
48
	| GTDI_Generic GenericTypeRep			// generic representataion
49 50 51

:: GenericTypeDefInfos :== {# .{GenericTypeDefInfo}}

52 53 54 55 56 57 58 59
:: GenericTypeRep = 
	{	gtr_type 				:: !AType			// generic type representation
	,	gtr_type_args			:: ![TypeVar]		// same as in td_info
	,	gtr_iso					:: !DefinedSymbol	// isomorphim function index 		
	,	gtr_isomap_group		:: !Index 			// isomap function group
	,	gtr_isomap				:: !DefinedSymbol	// isomap function for the type
 	,	gtr_isomap_from			:: !DefinedSymbol	// from-part of isomap
	,	gtr_isomap_to			:: !DefinedSymbol 	// to-part	
60
	,	gtr_type_info			:: !DefinedSymbol	// type def info
61
	,	gtr_cons_infos			:: ![DefinedSymbol] // constructor informations
62 63 64
	}

EmptyDefinedSymbol :== MakeDefinedSymbol {id_name="",id_info=nilPtr} NoIndex 0	
65 66 67 68 69 70 71 72
EmptyGenericType :== 
	{	gtr_type 		= makeAType TE TA_None
	,	gtr_type_args	= [] 
	,	gtr_iso 		= EmptyDefinedSymbol 
	,	gtr_isomap_group = NoIndex 
	,	gtr_isomap 		= EmptyDefinedSymbol
	,	gtr_isomap_from = EmptyDefinedSymbol
	,	gtr_isomap_to 	= EmptyDefinedSymbol
73
	,	gtr_type_info 	= EmptyDefinedSymbol
74
	,	gtr_cons_infos 	= []
75 76 77 78 79 80
	}

:: IsoDirection = IsoTo | IsoFrom

instance toBool GenericTypeDefInfo where
	toBool GTDI_Empty 		= False
81
	toBool (GTDI_Generic _) = True
82

83 84
convertGenerics :: !{!Group} !Int !{#CommonDefs} !*{# FunDef} !*TypeDefInfos !*Heaps !*HashTable !*PredefinedSymbols !u:{# DclModule} /*!(Optional {#Index})*/ !*ErrorAdmin 
	-> (!{!Group}, !{#CommonDefs}, !*{# FunDef}, !IndexRange, !*TypeDefInfos, !*Heaps, !*HashTable, !*PredefinedSymbols, !u:{# DclModule}, /*!(Optional {#Index}),*/ !*ErrorAdmin)
85 86
convertGenerics 
		groups main_dcl_module_n modules fun_defs td_infos heaps
87
		hash_table predefs dcl_modules 
88
		//opt_dcl_icl_conversions 
89
		error
90 91 92 93 94 95 96

	#! (fun_defs_size, fun_defs) = usize fun_defs 
	#! groups_size = size groups	

	#! (predef_size, predefs) = usize predefs
	#! (gs_predefs, predefs) = arrayCopyBegin predefs predef_size
	
97
	// determine sized of type def_infos:
98 99 100 101 102 103 104 105 106 107 108 109
	// ??? How to map 2-d unique array not so ugly ??? 
	#! (td_infos_sizes, td_infos) = get_sizes 0 td_infos
		with 
			get_sizes :: Int !*TypeDefInfos -> ([Int], !*TypeDefInfos)
			get_sizes n td_infos
				#! td_infos_size = size td_infos
				| n == td_infos_size = ([], td_infos)
				#! row_size = size td_infos.[n]
				# (row_sizes, td_infos) = get_sizes (n + 1) td_infos
				= ([row_size : row_sizes], td_infos)
	#! gtd_infos = { createArray s GTDI_Empty \\ s <- td_infos_sizes } 
								
110 111 112 113 114 115 116 117 118 119 120 121 122 123
	#! gs = 
		{	gs_modules = {m \\m <-: modules} // unique copy
		,	gs_groups = groups
		, 	gs_fun_defs = fun_defs 
		,	gs_td_infos = td_infos
		,	gs_gtd_infos = gtd_infos 
		,	gs_heaps = heaps
		,	gs_main_dcl_module_n = main_dcl_module_n
		,	gs_first_fun = fun_defs_size
		, 	gs_last_fun = fun_defs_size
		,	gs_first_group = groups_size
		, 	gs_last_group = groups_size
		,	gs_predefs = gs_predefs
		,	gs_dcl_modules = { x \\ x <-: dcl_modules } // unique copy
124 125
		,	gs_opt_dcl_icl_conversions = No
/*		
126 127 128
				case opt_dcl_icl_conversions of
				No -> No
				Yes xs -> Yes {x \\ x <-: xs} 	// unique copy
129
*/
130 131
		,	gs_error = error
		} 
132
	
133 134
	
	#! gs = collectInstanceKinds gs
135
		//---> "*** collect kinds used in generic instances and store them in the generics"
136 137
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
138
		= return gs predefs hash_table 
Artem Alimarine's avatar
Artem Alimarine committed
139
			
140 141 142 143
	#! gs = buildClasses gs
		//---> "*** build generic classes for all used kinds"
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
144
		= return gs predefs hash_table 
145 146 147 148 149

	#! (generic_types, gs) = collectGenericTypes gs
		//---> "*** collect types of generics (needed for generic representation)"
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
150
		= return gs predefs hash_table 
151

152
	#! (instance_types, gs) = convertInstances gs
153 154 155
		//---> "*** bind generic instances to classes and collect instance types"
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
156
		= return gs predefs hash_table 
157
	
158 159 160 161 162 163
	#! gs = checkConsInstances gs
		//---> "*** check that cons instances are provided for all generics"
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
		= return gs predefs hash_table 

164 165 166
	#! (cons_funs, cons_groups, gs) = buildConsInstances gs
	| not ok 
		//---> "*** bind function for CONS"
167
		= return gs predefs hash_table 
168
			
169
	#! (td_indexes, gs) = collectGenericTypeDefs generic_types instance_types gs	
Artem Alimarine's avatar
Artem Alimarine committed
170
		//---> "*** collect type definitions for which a generic representation must be created"
171 172
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
173
		= return gs predefs hash_table 
174

175
	#! (iso_funs, iso_groups, gs) = buildIsoFunctions td_indexes gs	
Artem Alimarine's avatar
Artem Alimarine committed
176
		//---> "*** build isomorphisms for type definitions"	
177 178
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
179
		= return gs predefs hash_table 
180

181
	#! (isomap_type_funs, isomap_type_groups, gs) = buildIsomapsForTypeDefs td_indexes gs	
Artem Alimarine's avatar
Artem Alimarine committed
182
		//---> "*** build maps for type definitions"	
183 184
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
185
		= return gs predefs hash_table 
186

187
	#! (isomap_gen_funs, isomap_gen_groups, gs) = buildIsomapsForGenerics gs 		
Artem Alimarine's avatar
Artem Alimarine committed
188
		//---> "*** build maps for generic function types"	
189 190
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
191
		= return gs predefs hash_table 
192

193
	#! (instance_funs, instance_groups, gs) = buildInstances gs
Artem Alimarine's avatar
Artem Alimarine committed
194
		//---> "*** build instances"	
195 196
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
197
		= return gs predefs hash_table 
198

199
	#! (star_funs, star_groups, gs) = buildKindConstInstances gs
Artem Alimarine's avatar
Artem Alimarine committed
200
		//---> "*** build shortcut instances for kind *"	
201 202
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
203
		= return gs predefs hash_table 
Artem Alimarine's avatar
Artem Alimarine committed
204
	
205 206
	// the order in the lists below is important! 
	// Indexes are allocated in that order.
207 208
	#! new_funs = cons_funs ++ iso_funs ++ isomap_type_funs ++ isomap_gen_funs ++ instance_funs ++ star_funs
	#! new_groups = cons_groups ++ iso_groups ++ isomap_type_groups ++ isomap_gen_groups ++ instance_groups ++ star_groups	
209 210

	#! gs = addFunsAndGroups new_funs new_groups gs	
Artem Alimarine's avatar
Artem Alimarine committed
211
		//---> "*** add geenrated functions"
212 213
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
214
		= return gs predefs hash_table 
215

216
	#! gs = determineMemberTypes 0 0 gs
Artem Alimarine's avatar
Artem Alimarine committed
217
		//---> "*** determine types of member instances"	
218 219
	#! (ok,gs) = gs!gs_error.ea_ok
	| not ok 
220
		= return gs predefs hash_table 
221
	
Artem Alimarine's avatar
Artem Alimarine committed
222
	//| True	= abort "-----------------\n"
223
				
224 225 226 227
	# {	gs_modules, gs_groups, gs_fun_defs, gs_td_infos, gs_heaps, gs_dcl_modules, 
		gs_opt_dcl_icl_conversions, 
		gs_error} 
			= gs	
228 229
	
	#! {hte_symbol_heap} = hash_table
230 231 232 233 234 235 236
	#! cs = 
		{	cs_symbol_table = hte_symbol_heap 
		,	cs_predef_symbols = predefs 
		,	cs_error = gs_error 
		,	cs_x = 
			{	x_needed_modules = 0
			,	x_main_dcl_module_n = main_dcl_module_n 
237 238
//			,	x_is_dcl_module = False
//			,	x_type_var_position = 0
239 240 241
			}
		}

242 243
	#! (gs_dcl_modules, gs_modules, gs_heaps, cs_symbol_table) = 
		create_class_dictionaries 0 gs_dcl_modules gs_modules gs_heaps cs.cs_symbol_table
244 245
//		create_class_dictionaries1 main_dcl_module_n dcl_modules gs_modules gs_heaps cs
			//---> "*** create class dictionaries"	
246 247 248

	# hash_table = { hash_table & hte_symbol_heap = cs_symbol_table }	
	
249
	#! index_range = {ir_from = gs.gs_first_fun, ir_to = gs.gs_last_fun}
250 251
		 			
	= (	gs_groups, gs_modules, gs_fun_defs, index_range, gs_td_infos, gs_heaps, hash_table, 
252
		cs.cs_predef_symbols, gs_dcl_modules, /*gs_opt_dcl_icl_conversions,*/ cs.cs_error)
253
where
254 255 256
	return {	gs_modules, gs_groups, gs_fun_defs, gs_td_infos, gs_gtd_infos, 
				gs_heaps, gs_main_dcl_module_n, gs_dcl_modules, gs_opt_dcl_icl_conversions, gs_error} 
				predefs hash_table  
257
		= (	gs_groups, gs_modules, gs_fun_defs, {ir_from=0,ir_to=0}, 
258
			gs_td_infos, gs_heaps, hash_table, predefs, gs_dcl_modules, 
259
			/*gs_opt_dcl_icl_conversions,*/ gs_error)
260

261
	create_class_dictionaries module_index dcl_modules  modules heaps symbol_table 
262 263
		#! size_of_modules = size modules
		| module_index == size_of_modules
264 265 266 267
			= (dcl_modules, modules, heaps, symbol_table)
			#! (dcl_modules, modules, heaps, symbol_table) = 
				create_class_dictionaries1 module_index dcl_modules  modules heaps symbol_table
			= create_class_dictionaries (inc module_index) dcl_modules modules heaps symbol_table		
268 269 270 271

	create_class_dictionaries1
			module_index dcl_modules modules 
			heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}, hp_var_heap}
272
			symbol_table 
273
		#! (common_defs, modules) = modules![module_index]
274 275 276 277 278 279 280
		#! 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) =
				createClassDictionaries
281
					False //(abort "create_class_dictionaries1 True or False ?")
282
					module_index 
283
					size_type_defs
284 285
					(size common_defs.com_selector_defs) 
					(size common_defs.com_cons_defs) 
286
					type_defs selector_defs cons_defs class_defs dcl_modules th_vars hp_var_heap symbol_table
287 288 289

		#! common_defs = { common_defs & 
			com_class_defs = class_defs, 
290 291 292
			com_type_defs = arrayPlusList type_defs new_type_defs,
			com_selector_defs = arrayPlusList selector_defs new_selector_defs,
			com_cons_defs = arrayPlusList cons_defs new_cons_defs}
293 294 295

		#! heaps = {heaps & hp_var_heap = hp_var_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} 
		#! modules = { modules & [module_index] = common_defs } 		
296
		= (dcl_modules, modules, heaps, symbol_table)		
297 298
	
convertInstances :: !*GenericState	
299
	-> (![Global Index], !*GenericState)
300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328
convertInstances gs
	= convert_modules 0 gs 
where

	convert_modules module_index gs=:{gs_modules}
		#! num_modules = size gs_modules
		| module_index == num_modules
			= ([], gs)	
		#! (common_defs, gs_modules) = gs_modules ! [module_index] 
		#! instance_defs = {i \\ i <-: common_defs.com_instance_defs} // make unique copy		

		#! (new_types, instance_defs, gs) =
			convert_instances module_index 0 instance_defs {gs & gs_modules = gs_modules}
		#! (types, gs) = convert_modules (inc module_index) gs
		
		#! {gs_modules} = gs
		#! (common_defs, gs_modules) = gs_modules ! [module_index]
		#! gs_modules = { gs_modules & [module_index] = {common_defs & com_instance_defs = instance_defs}} 
		= (new_types ++ types, {gs & gs_modules = gs_modules})

	convert_instances module_index instance_index instance_defs gs
		#! num_instance_defs = size instance_defs
		| instance_index == num_instance_defs
			= ([], instance_defs, gs)													
		#! (new_types, instance_defs, gs) = convert_instance module_index instance_index instance_defs gs 			
		#! (types, instance_defs, gs) = convert_instances module_index (inc instance_index) instance_defs gs		
		= (new_types ++ types, instance_defs, gs)	
		
	convert_instance :: !Index !Index !*{#ClassInstance} !*GenericState
329
		-> (![Global Index], !*{#ClassInstance}, !*GenericState)	
330 331 332
	convert_instance 
			module_index instance_index instance_defs 
			gs=:{gs_td_infos, gs_modules, gs_error, gs_fun_defs, gs_predefs, gs_heaps}
Artem Alimarine's avatar
Artem Alimarine committed
333 334
//		= abort "generics; convert_instance"

335
		#! (instance_def=:{ins_class,ins_ident}, instance_defs) = instance_defs ! [instance_index]
336
		| not instance_def.ins_is_generic
337 338 339 340 341 342 343 344
			# gs = { gs 
				& 	gs_td_infos = gs_td_infos
				, 	gs_modules = gs_modules
				,	gs_fun_defs = gs_fun_defs
				, 	gs_heaps = gs_heaps
				, 	gs_error = gs_error }	
			= ([], instance_defs, gs)
		
345 346 347
		// determine the kind of the instance type
		#! it_type = hd instance_def.ins_type.it_types
		#! (kind, gs_td_infos) = kindOfType it_type gs_td_infos
348 349 350 351 352 353

		#! (generic_def, gs_modules) = getGenericDef ins_class.glob_module ins_class.glob_object.ds_index gs_modules
		#! (ok, class_ds) = getGenericClassForKind generic_def kind
		| not ok
			= abort ("no class " +++ ins_ident.id_name +++ "for kind" +++ toString kind) 

354
		// bind the instance to the class
355 356 357
		#! instance_def = 
			{ 	instance_def 
			& 	ins_class = {glob_module=ins_class.glob_module, glob_object=class_ds} 
358
			,	ins_ident = makeIdent ins_ident.id_name
359
			}
360
		#! (is_partial, gs_fun_defs) = check_if_partial instance_def gs_predefs gs_fun_defs
361
		 	
362
		# (ok, gs_modules, gs_error) = check_instance_args instance_def gs_modules gs_error
363
		| not ok
364 365
			#! instance_defs = { instance_defs & [instance_index] = instance_def}
			#! gs = { gs 
366 367 368 369
				& 	gs_td_infos = gs_td_infos
				, 	gs_modules = gs_modules
				,	gs_fun_defs = gs_fun_defs
				, 	gs_heaps = gs_heaps
370 371
				, 	gs_error = gs_error 
				}	
372
			= ([], instance_defs, gs)
373

374
		# gs_heaps = check_cons_instance generic_def instance_def it_type gs_predefs gs_heaps 
375
	
376
		# (maybe_td_index, instance_def, gs_modules, gs_error) = 
377
			determine_type_def_index it_type instance_def is_partial gs_modules gs_error
378
		# gs = { gs 
379 380 381 382 383
			& 	gs_td_infos = gs_td_infos
			, 	gs_modules = gs_modules
			,	gs_fun_defs = gs_fun_defs
			, 	gs_heaps = gs_heaps
			, 	gs_error = gs_error }	
384
		#! instance_defs = { instance_defs & [instance_index] = instance_def}
385
		= (maybe_td_index, instance_defs, gs)
Artem Alimarine's avatar
Artem Alimarine committed
386

387
	determine_type_def_index 
388 389 390
			(TA {type_index, type_name} _) 
			instance_def=:{ins_generate, ins_ident, ins_pos}
			is_partial 
391
			gs_modules gs_error
392
		#! ({td_rhs, td_index}, gs_modules) = getTypeDef type_index.glob_module type_index.glob_object gs_modules
393 394 395
		= determine_td_index td_rhs gs_modules gs_error
	where
		determine_td_index (AlgType _) gs_modules gs_error
396
			| ins_generate 
397 398 399 400
				= ([type_index], instance_def, gs_modules, gs_error)
			| supportPartialInstances && is_partial
				= ([type_index], {instance_def & ins_partial = True}, gs_modules, gs_error)
					//---> ("collected partial instance type", type_name, type_index)			
401
			| otherwise
402
				= ([], instance_def, gs_modules, gs_error)
403
		determine_td_index (RecordType _) gs_modules gs_error
404
			| ins_generate 
405 406 407 408
				= ([type_index], instance_def, gs_modules, gs_error)
			| supportPartialInstances && is_partial
				= ([type_index], {instance_def & ins_partial = True}, gs_modules, gs_error)			
					//---> ("collected partial instance type", type_name, type_index)			
409
			| otherwise
410
				= ([], instance_def, gs_modules, gs_error)
411 412 413
		determine_td_index (SynType _) gs_modules gs_error
			# gs_error = checkErrorWithIdentPos 
				(newPosition ins_ident ins_pos) 
414
				"generic instance type cannot be a synonym type" 
415
				gs_error 				 
416
			= ([], instance_def, gs_modules, gs_error)			
417 418 419 420 421 422
		determine_td_index (AbstractType _) gs_modules gs_error
			| ins_generate
				# gs_error = checkErrorWithIdentPos 
					(newPosition ins_ident ins_pos) 
					"cannot generate an instance for an abstract data type" 
					gs_error 				 
423
				= ([], instance_def, gs_modules, gs_error)									
424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448
				= ([], instance_def, gs_modules, gs_error)				
	determine_type_def_index TArrow instance_def=:{ins_generate,ins_ident,ins_pos} _ gs_modules gs_error
		| ins_generate
			# gs_error = checkErrorWithIdentPos 
					(newPosition ins_ident ins_pos) 
					"cannot generate an instance for arrow type" 
					gs_error 	
			= ([], instance_def, gs_modules, gs_error)
			= ([], instance_def, gs_modules, gs_error)
	determine_type_def_index (TArrow1 _) instance_def=:{ins_generate,ins_ident,ins_pos} _ gs_modules gs_error
		| ins_generate
			# gs_error = checkErrorWithIdentPos 
					(newPosition ins_ident ins_pos) 
					"cannot generate an instance for arrow type" 
					gs_error 	
			= ([], instance_def, gs_modules, gs_error)			
			= ([], instance_def, gs_modules, gs_error)		
	determine_type_def_index (TB _) instance_def=:{ins_generate,ins_ident,ins_pos} _ gs_modules gs_error
		| ins_generate
			# gs_error = checkErrorWithIdentPos 
					(newPosition ins_ident ins_pos) 
					"cannot generate an instance for a basic type" 
					gs_error 	
			= ([], instance_def, gs_modules, gs_error)			
			= ([], instance_def, gs_modules, gs_error)			
449 450
	determine_type_def_index _ instance_def=:{ins_ident,ins_pos} _ gs_modules gs_error
		#! gs_error = checkErrorWithIdentPos 
451
			(newPosition ins_ident ins_pos) 
452
			"generic instance type must be a type constructor or a primitive type" 
453
			gs_error 				 
454
		= ([], instance_def, gs_modules, gs_error)
455
	
456 457
	check_if_partial :: !ClassInstance !PredefinedSymbols !*{#FunDef} -> (!Bool, !*{#FunDef})
	check_if_partial instance_def=:{ins_members, ins_ident, ins_type, ins_generate} gs_predefs gs_fun_defs		
458 459
		= 	case supportPartialInstances of
			True
460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492
				| ins_generate
					-> (False, gs_fun_defs)
				| check_if_predef (hd ins_type.it_types) gs_predefs
					-> (False, gs_fun_defs) // PAIR, EITHER, CONS, UNIT
				#! ins_fun_ds = ins_members.[0]
				| ins_fun_ds.ds_index == NoIndex // can this happen?
					-> (False, gs_fun_defs)
				| otherwise					
					#! (fun_def, gs_fun_defs) = gs_fun_defs ! [ins_fun_ds.ds_index]
					#  (TransformedBody {tb_rhs}) = fun_def.fun_body  
					-> case tb_rhs of
						Case {case_default=No} 	-> (True, gs_fun_defs)
						_ 						-> (False, gs_fun_defs)
			False -> (False, gs_fun_defs)
		where
			check_if_predef (TA {type_index={glob_module, glob_object}} _) gs_predefs
			 	# {pds_module, pds_def} = gs_predefs.[PD_TypeUNIT]
			 	| glob_module == pds_module && glob_object == pds_def
			 		= True
			 	# {pds_module, pds_def} = gs_predefs.[PD_TypePAIR]
			 	| glob_module == pds_module && glob_object == pds_def
			 		= True
			 	# {pds_module, pds_def} = gs_predefs.[PD_TypeEITHER]
			 	| glob_module == pds_module && glob_object == pds_def
			 		= True
			 	# {pds_module, pds_def} = gs_predefs.[PD_TypeCONS]
			 	| glob_module == pds_module && glob_object == pds_def
			 		= True
				| otherwise
					= False				
			check_if_predef _ gs_predefs 
				= False						
								
493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508
	check_cons_instance 
			{gen_cons_ptr} {ins_members}
			(TA {type_index={glob_module, glob_object}} _) 
			predefs heaps
		| not supportConsInfo 
			= heaps	
		# {pds_module, pds_def} = predefs.[PD_TypeCONS]
		| glob_module <> pds_module || glob_object <> pds_def
			= heaps
		# {hp_type_heaps=hp_type_heaps=:{th_vars}}=heaps				
		# th_vars = writePtr gen_cons_ptr (TVI_ConsInstance ins_members.[0]) th_vars		
		= {heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}	
	check_cons_instance _ _ _ _ heaps 
		= heaps	
				
	check_instance_args 
509 510 511 512 513 514
			instance_def=:{ins_class={glob_module,glob_object}, ins_ident, ins_pos, ins_type, ins_generate} 
			gs_modules gs_error
		| ins_generate 
			= (True, gs_modules, gs_error)
	
		# (class_def=:{class_members}, gs_modules) =  
515
			getClassDef glob_module glob_object.ds_index gs_modules
516 517
		# (member_def, gs_modules) = 
			getMemberDef glob_module class_def.class_members.[0].ds_index gs_modules
518
		| member_def.me_type.st_arity <> instance_def.ins_members.[0].ds_arity && instance_def.ins_members.[0].ds_arity <> (-1)	
519 520 521
			# gs_error = checkErrorWithIdentPos (newPosition ins_ident ins_pos) "generic instance function has incorrect arity" gs_error
			= (False, gs_modules, gs_error)	
			= (True, gs_modules, gs_error)	
522

523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557
// check that CONS instances are provided for all generics
checkConsInstances :: !*GenericState -> !*GenericState
checkConsInstances gs
	| supportConsInfo
		= check_cons_instances 0 0 gs
		= gs

where
	check_cons_instances module_index generic_index gs=:{gs_modules, gs_heaps, gs_error}
		#! size_gs_modules = size gs_modules
		| module_index == size_gs_modules 
			= {gs & gs_modules = gs_modules} 
		# (generic_defs, gs_modules) = gs_modules ! [module_index].com_generic_defs 
		#! size_generic_defs = size generic_defs
		| generic_index == size_generic_defs
			= check_cons_instances (inc module_index) 0 {gs & gs_modules = gs_modules}
		
		# (gs_heaps, gs_error) = check_generic generic_defs.[generic_index] gs_heaps gs_error
		= check_cons_instances 
			module_index (inc generic_index)
			{gs & gs_modules = gs_modules, gs_heaps = gs_heaps, gs_error = gs_error}
				
	check_generic 
			{gen_cons_ptr, gen_name, gen_pos} 
			gs_heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}}
			gs_error			
		# (info, th_vars) = readPtr gen_cons_ptr th_vars	
		# gs_error = case info of
			TVI_ConsInstance _ 	
				->  gs_error
			_					
				-> reportError gen_name gen_pos "instance on CONS must be provided" gs_error
		= ({gs_heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}, gs_error)


558 559 560 561 562 563 564 565 566 567 568 569
collectGenericTypes :: !*GenericState -> (![Type], !*GenericState)
collectGenericTypes gs=:{gs_modules} 
	# (types, gs_modules) = collect_in_modules 0 0 gs_modules
	= (types, {gs & gs_modules = gs_modules})
where
	collect_in_modules module_index generic_index gs_modules
		#! size_gs_modules = size gs_modules 
		| module_index == size_gs_modules
			= ([], gs_modules) 
		# (generic_defs, gs_modules) = gs_modules ! [module_index].com_generic_defs 
		#! size_generic_defs = size generic_defs
		| generic_index == size_generic_defs
570
			= collect_in_modules (inc module_index) 0 gs_modules	
571
		# {gen_type={gt_type={st_args, st_result}}} = generic_defs . [generic_index]
572 573
		# (types, gs_modules) = collect_in_modules module_index (inc generic_index) gs_modules
		= ([at_type \\ {at_type} <- [st_result:st_args]] ++ types, gs_modules)	
Artem Alimarine's avatar
Artem Alimarine committed
574

575

576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663
buildConsInstances :: !*GenericState -> (![FunDef], ![Group], !*GenericState)
buildConsInstances gs 
	| supportConsInfo
		= build_cons_instances 0 0 gs
		= ([], [], gs)
where
	build_cons_instances module_index generic_index gs=:{gs_modules}
		#! size_gs_modules = size gs_modules 
		| module_index == size_gs_modules
			= ([], [], {gs & gs_modules = gs_modules}) 
		# (generic_defs, gs_modules) = gs_modules ! [module_index].com_generic_defs
		# gs = {gs & gs_modules = gs_modules} 
		#! size_generic_defs = size generic_defs
		| generic_index == size_generic_defs
			= build_cons_instances (inc module_index) 0 gs
		# (fun, group, gs) = build_cons_instance generic_defs.[generic_index] gs				
		# (funs, groups, gs) = build_cons_instances module_index (inc generic_index) gs
		= ([fun:funs], [group:groups], gs)	

	build_cons_instance generic_def gs
		#! (fun_index, group_index, gs) 	= newFunAndGroupIndex gs		
		#! (ins_fun_def_sym, gs) = get_cons_fun generic_def gs		
		#! {gs_fun_defs, gs_predefs, gs_heaps} = gs
		#! fun_def_sym = 
			{	ds_ident = makeIdent (ins_fun_def_sym.ds_ident.id_name +++ ":cons_info")
			,	ds_arity = ins_fun_def_sym.ds_arity + 1
			,	ds_index = fun_index
			}		
		#! gs_heaps = set_cons_fun generic_def fun_def_sym gs_heaps	

		#! (ins_fun_def, gs_fun_defs) = gs_fun_defs ! [ins_fun_def_sym.ds_index]		

		#! (fun_def, gs_heaps) = copyFunDef ins_fun_def fun_index group_index gs_heaps

		#! (fun_def, gs_heaps) = parametrize_with_cons_info fun_def gs_predefs gs_heaps
		
		#! group = {group_members = [fun_index]}
			
		= (fun_def, group, {gs & gs_fun_defs = gs_fun_defs, gs_heaps = gs_heaps})
			//---> ("build_cons_instance", ins_fun_def, fun_def)
	where 
		parametrize_with_cons_info fun_def=:{fun_arity, fun_body} predefs heaps		
			# (var_expr, var, heaps) = buildVarExpr "cons_info" heaps
			# (TransformedBody tb=:{tb_args, tb_rhs}) = fun_body
			# (tb_rhs, heaps) = mapExprSt (replace_cons_info var_expr) tb_rhs  heaps 	
			# fun_def = 
				{ fun_def 
				& fun_arity = fun_arity + 1
				, fun_body = TransformedBody {tb & tb_args = [var:tb_args], tb_rhs = tb_rhs}
				}				
			= (fun_def, heaps) 
		where
			{pds_module,pds_def} = predefs.[PD_cons_info]	
			replace_cons_info 
					var_expr 
					expr=:(App {app_symb={symb_kind=SK_Function {glob_object, glob_module}}}) 
					heaps
				| pds_module == glob_module && pds_def == glob_object			
					= (var_expr, heaps)
						//---> ("replace_cons_info", expr, var_expr)
					= (expr, heaps)
						//---> ("replace_cons_info: App expr1", expr)
							
			replace_cons_info var_expr expr=:(App app) heaps
				= (expr, heaps)
					//--->  ("replace_cons_info: App expr2", expr) 
						 
			replace_cons_info var_expr expr heaps
				= (expr, heaps)
	
	get_cons_fun 
			{gen_cons_ptr, gen_pos, gen_name} 
			gs=:{gs_heaps=gs_heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}}, gs_error}
		# (info, th_vars) = readPtr gen_cons_ptr th_vars
		# gs_heaps = { gs_heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars }}	
		# (fun_def_sym, gs_error) = case info of		
			TVI_ConsInstance fun_def_sym
				-> (fun_def_sym, gs_error)				
			TVI_Empty
				-> (EmptyDefinedSymbol, reportError gen_name gen_pos "no CONS instance provided" gs_error)
		= (fun_def_sym, {gs & gs_heaps = gs_heaps, gs_error = gs_error})						

	set_cons_fun 
			{gen_cons_ptr} fun_def_sym
			gs_heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}}
		# th_vars = writePtr gen_cons_ptr (TVI_ConsInstance fun_def_sym) th_vars
		= { gs_heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars }}	
							
664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698
collectInstanceKinds :: !*GenericState -> !*GenericState
collectInstanceKinds gs
	= collect_instance_kinds 0 0 gs
where
	collect_instance_kinds module_index instance_index gs=:{gs_modules}
		#! size_modules = size gs_modules
		| module_index == size_modules
			= gs
		#! (common_defs, gs_modules) = gs_modules ! [module_index]
		#! size_instance_defs = size common_defs.com_instance_defs
		| instance_index == size_instance_defs
			= collect_instance_kinds (inc module_index) 0 {gs & gs_modules = gs_modules} 
				
		#! gs = collect_instance module_index instance_index {gs & gs_modules = gs_modules}
		
		= collect_instance_kinds module_index (inc instance_index) gs

	collect_instance module_index instance_index gs=:{gs_heaps, gs_modules, gs_td_infos}
		
		#! (instance_def=:{ins_class, ins_is_generic, ins_type}, gs_modules) = 
			getInstanceDef module_index instance_index gs_modules
		| not instance_def.ins_is_generic 
			= {gs & gs_modules = gs_modules, gs_heaps = gs_heaps }

		#! (generic_def, gs_modules) = getGenericDef ins_class.glob_module ins_class.glob_object.ds_index gs_modules		
		#! (kind, gs_td_infos) = kindOfType (hd ins_type.it_types) gs_td_infos		
		#! gs_heaps = update_kind generic_def kind gs_heaps		
		= {gs & gs_modules = gs_modules, gs_heaps = gs_heaps, gs_td_infos = gs_td_infos}
		
	update_kind {gen_kinds_ptr} kind gs_heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}}
		#! (TVI_Kinds kinds, th_vars) = readPtr gen_kinds_ptr th_vars
		#! kinds = eqMerge [kind] kinds
		#! th_vars = writePtr gen_kinds_ptr (TVI_Kinds kinds) th_vars
		= {gs_heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}

Artem Alimarine's avatar
Artem Alimarine committed
699
buildClasses :: !*GenericState -> !*GenericState
700 701
buildClasses gs 
	= build_modules 0 gs
Artem Alimarine's avatar
Artem Alimarine committed
702
where
703
	build_modules module_index gs=:{gs_modules}
Artem Alimarine's avatar
Artem Alimarine committed
704 705
		#! size_gs_modules = size gs_modules 
		| module_index == size_gs_modules
706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733
			= { gs & gs_modules = gs_modules }	 		

		#! common_defs = gs_modules . [module_index]
		#! (common_defs, gs=:{gs_modules}) = build_module module_index common_defs gs	
		#! gs = {gs & gs_modules = {gs_modules & [module_index] = common_defs}}					

		= build_modules (inc module_index) gs	
			
	build_module module_index common_defs gs		 

		#! {com_generic_defs,com_class_defs, com_member_defs} = common_defs 
		
		#! class_index = size com_class_defs
		#! member_index = size com_member_defs
		#! com_generic_defs = {x \\ x <-: com_generic_defs} // make unique copy
			
		# (new_class_defs, new_member_defs, com_generic_defs, _, _, gs) = 
			build_generics module_index 0 class_index member_index com_generic_defs gs	

		# common_defs = 
			{	common_defs 
			&	com_class_defs = arrayPlusRevList com_class_defs new_class_defs
			,	com_member_defs = arrayPlusRevList com_member_defs new_member_defs
			, 	com_generic_defs = com_generic_defs
			}
		= (common_defs, gs)
		
	build_generics module_index generic_index class_index member_index generic_defs gs
Artem Alimarine's avatar
Artem Alimarine committed
734 735
		#! size_generic_defs = size generic_defs
		| generic_index == size_generic_defs
736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755
			= ([], [], generic_defs, class_index, member_index, gs)
		#! (generic_def, generic_defs) = generic_defs ! [generic_index]	
		#! (new_class_defs, new_member_defs, generic_def, class_index, member_index, gs) = 
			build_generic module_index class_index member_index generic_def gs
		#! generic_defs = {generic_defs & [generic_index] = generic_def}
		#! (new_class_defs1, new_member_defs1, generic_defs, class_index, member_index, gs) = 
			build_generics module_index (inc generic_index) class_index member_index generic_defs gs
		= (new_class_defs ++ new_class_defs1, new_member_defs ++ new_member_defs1,
			generic_defs, class_index, member_index, gs)
		
	build_generic module_index class_index member_index generic_def gs		
		# (kinds, gs) = get_kinds generic_def gs
		= build_classes kinds generic_def module_index class_index member_index gs
	
	build_classes :: ![TypeKind] !GenericDef !Index !Index !Index !*GenericState
		-> (![ClassDef], ![MemberDef], !GenericDef, !Index, !Index, !*GenericState)
	build_classes [] generic_def module_index class_index member_index gs 
		= ([], [], generic_def, class_index, member_index, gs)
	build_classes [kind:kinds] generic_def module_index class_index member_index gs 	
		#! (class_def, member_def, generic_def, gs) = 
756
			buildClassDef module_index class_index member_index generic_def kind gs
757 758 759 760 761 762 763 764
		#! (class_defs, member_defs, generic_def, class_index, member_index, gs) = 
			build_classes kinds generic_def module_index (inc class_index) (inc member_index) gs
		= ([class_def:class_defs], [member_def:member_defs], generic_def, class_index, member_index, gs) 			 

	get_kinds {gen_kinds_ptr} gs=:{gs_heaps=gs_heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}}}
		#! (TVI_Kinds kinds, th_vars) = readPtr gen_kinds_ptr th_vars
		#! th_vars = writePtr gen_kinds_ptr TVI_Empty th_vars
		= (kinds, {gs & gs_heaps = {gs_heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}})
765 766
		 				
// find all types whose generic representation is needed
767
collectGenericTypeDefs :: ![Type] [Global Index] !*GenericState
768
	-> (![Global Index], !*GenericState)
769 770 771
collectGenericTypeDefs generic_types instance_td_indexes gs
	# (td_indexes, gs) = collect_in_types generic_types gs
	# (td_indexes, gs) = add_instance_indexes td_indexes instance_td_indexes gs
772 773
	= (map fst td_indexes, gs)
where
774 775 776 777 778 779 780 781 782 783 784
	add_instance_indexes td_indexes [] gs 
		= (td_indexes, gs)
	add_instance_indexes 
			td_indexes 
			[type_index=:{glob_module, glob_object} : itdis] 
			gs=:{gs_gtd_infos, gs_td_infos}
		# (gtd_info, gs_gtd_infos) = gs_gtd_infos ! [glob_module, glob_object]
		# gs_gtd_infos = {gs_gtd_infos & [glob_module, glob_object] = GTDI_Generic EmptyGenericType}
		# (td_info, gs_td_infos) = gs_td_infos ! [glob_module, glob_object]
		# gs = {gs & gs_td_infos = gs_td_infos, gs_gtd_infos = gs_gtd_infos}
		| toBool gtd_info // already marked
785 786
			= add_instance_indexes td_indexes itdis gs
				//---> ("instance type already added", type_index)
787 788
			# gs_gtd_infos = {gs_gtd_infos & [glob_module, glob_object] = GTDI_Generic EmptyGenericType}
			= add_instance_indexes (merge_td_indexes [(type_index, td_info.tdi_group_nr)] td_indexes) itdis gs
789
				//---> ("add instance type index", type_index)
790 791 792 793 794 795 796 797 798 799

	collect_in_types :: ![Type] !*GenericState  
		-> (![(Global Index, Int)], !*GenericState)
	collect_in_types [] gs = ([], gs)
	collect_in_types [type:types] gs
		# (td_indexes1, gs) = collect_in_type type gs
		# (td_indexes2, gs) = collect_in_types types gs
		= (merge_td_indexes td_indexes1 td_indexes2, gs)
		
	collect_in_type :: !Type !*GenericState 
800
		-> (![(Global Index, Int)], !*GenericState)		
801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824
	collect_in_type (TA type_symb arg_types) gs
		# (td_indexes1, gs) = collect_in_atypes arg_types gs
		# (td_indexes2, gs) = collect_in_type_app type_symb gs 
		= (merge_td_indexes td_indexes1 td_indexes2, gs)
	where	
		collect_in_type_app {type_arity=0} gs 
			// types with no arguments do not need mapping to be built:
			// their mapping is identity
			= ([], gs)
		collect_in_type_app 
				{type_index=type_index=:{glob_module, glob_object}, type_name}    
				gs=:{gs_gtd_infos, gs_td_infos, gs_modules}
			# (gtd_info, gs_gtd_infos) = gs_gtd_infos ! [glob_module, glob_object]
			| toBool gtd_info // already marked
				= ([], {gs & gs_gtd_infos = gs_gtd_infos})
					//---> ("already marked type", type_name, type_index)
			| otherwise // not yet marked		
				# gs_gtd_infos = {gs_gtd_infos & [glob_module, glob_object] = GTDI_Generic EmptyGenericType}
				# (td_info, gs_td_infos) = gs_td_infos ! [glob_module, glob_object]
				# (type_def, gs_modules) = getTypeDef glob_module glob_object gs_modules				
				# gs = {gs & gs_td_infos = gs_td_infos, gs_gtd_infos = gs_gtd_infos, gs_modules = gs_modules}
				# (td_indexes1, gs) = collect_in_type_def_rhs glob_module type_def gs
				# td_indexes2 = [(type_index, td_info.tdi_group_nr)]		
				= (merge_td_indexes td_indexes1 td_indexes2, gs)
Artem Alimarine's avatar
Artem Alimarine committed
825
					//---> ("mark type", type_name, type_index)
826 827 828 829 830 831 832

	collect_in_type (arg_type --> res_type) gs
		#! (td_indexes1, gs) = collect_in_atype arg_type gs
		#! (td_indexes2, gs) = collect_in_atype res_type gs
		= (merge_td_indexes td_indexes1 td_indexes2, gs)
	collect_in_type (TArrow1 arg_type) gs
		= collect_in_atype arg_type gs	
833
	collect_in_type (cons_var :@: args) gs
834
		#! types = [ at_type \\ {at_type} <- args] 
835 836 837 838
		= collect_in_types types gs				
	collect_in_type _ gs
		= ([], gs)
	
839 840 841 842 843 844 845 846 847 848 849 850 851
	collect_in_atype :: !AType !*GenericState 
		-> (![(Global Index, Int)], !*GenericState)		
	collect_in_atype {at_type} gs = collect_in_type at_type gs	

	collect_in_atypes :: ![AType] !*GenericState 
		-> (![(Global Index, Int)], !*GenericState)		
	collect_in_atypes [] gs = ([], gs)
	collect_in_atypes [atype:atypes] gs
		# (td_indexes1, gs) = collect_in_atype atype gs
		# (td_indexes2, gs) = collect_in_atypes atypes gs
		# merged_td_indexes = merge_td_indexes td_indexes1 td_indexes2
		= (merged_td_indexes, gs)

Artem Alimarine's avatar
Artem Alimarine committed
852
	collect_in_type_def_rhs :: !Index !CheckedTypeDef !*GenericState 
853
		-> (![(Global Index, Int)], !*GenericState)		 
Artem Alimarine's avatar
Artem Alimarine committed
854
	collect_in_type_def_rhs mod {td_rhs=(AlgType cons_def_symbols)} gs
855
		= collect_in_conses mod cons_def_symbols gs
Artem Alimarine's avatar
Artem Alimarine committed
856
	collect_in_type_def_rhs mod {td_rhs=(RecordType {rt_constructor})}	gs
857
		= collect_in_conses mod [rt_constructor] gs				
Artem Alimarine's avatar
Artem Alimarine committed
858
	collect_in_type_def_rhs mod {td_rhs=(SynType {at_type})}	gs			
859
		= collect_in_type at_type gs 
Artem Alimarine's avatar
Artem Alimarine committed
860
	collect_in_type_def_rhs mod {td_rhs=(AbstractType _), td_name, td_pos} gs=:{gs_error}				
861
		#! gs_error = checkErrorWithIdentPos
Artem Alimarine's avatar
Artem Alimarine committed
862 863 864 865
				(newPosition td_name td_pos) 
				"cannot build generic type representation for an abstract type" 
				gs_error
		= ([], {gs & gs_error = gs_error})
866
		//= ([], {gs & gs_error = checkWarning td_name "abstract data type" gs_error})
867
					
868 869 870 871 872 873
	collect_in_conses :: !Index ![DefinedSymbol] !*GenericState 
		-> (![(Global Index, Int)], !*GenericState)
	collect_in_conses mod [] gs 
		= ([], gs)
	collect_in_conses mod [{ds_index, ds_ident} : cons_def_symbols] gs=:{gs_modules}
		#! ({cons_type={st_args}}, gs_modules) = getConsDef mod ds_index gs_modules
Artem Alimarine's avatar
Artem Alimarine committed
874
			//---> ("mark cons " +++ ds_ident.id_name)
875 876 877 878 879 880
		#! types = [ at_type \\ {at_type} <- st_args] 
		#! (td_indexes1, gs) = collect_in_types types {gs & gs_modules=gs_modules}
		#! (td_indexes2, gs) = collect_in_conses mod cons_def_symbols gs
		= (merge_td_indexes td_indexes1 td_indexes2, gs)

	collect_in_symbol_type {st_args, st_result} gs
881 882
		#! (td_indexes1, gs) = collect_in_types (map (\x->x.at_type) st_args)  gs
		#! (td_indexes2, gs) = collect_in_type st_result.at_type gs
883 884 885 886 887
		= (merge_td_indexes td_indexes1 td_indexes2, gs)
		 
	merge_td_indexes x y 
		= mergeBy (\(_,l) (_,r) ->l < r) x y 

888

889 890 891 892
buildIsoFunctions :: ![Global Index] !*GenericState
	-> (![FunDef], ![Group], !*GenericState)
buildIsoFunctions [] gs = ([], [], gs)
buildIsoFunctions [type_index:type_indexes] gs
893 894
	#! (iso_funs1, iso_groups1, gs) = build_function type_index gs
	#! (iso_funs2, iso_groups2, gs) = buildIsoFunctions type_indexes gs	 
895 896 897
	= (iso_funs1 ++ iso_funs2, iso_groups1 ++ iso_groups2, gs) 
where
	build_function {glob_module, glob_object} gs
898 899 900 901
	
		# (generic_rep_type, gs) = buildGenericRepType glob_module glob_object gs
	
		# (type_info_def_sym, cons_info_def_syms, info_fun_defs, info_groups, gs) = 
902 903
			build_cons_infos glob_module glob_object gs

904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940
		# (iso_def_sym, iso_fun_defs, iso_groups, gs) =
			build_isos glob_module glob_object cons_info_def_syms gs  

		# gs = fill_generic_type_info
			glob_module glob_object 
			generic_rep_type
			iso_def_sym
			type_info_def_sym cons_info_def_syms
			gs	
		
		= (info_fun_defs ++ iso_fun_defs, info_groups ++ iso_groups, gs)	

	fill_generic_type_info 
			module_index type_def_index
			generic_rep_type 
			iso_def_sym 
			type_info_def_sym
			cons_info_def_syms
			gs=:{gs_gtd_infos, gs_modules}

		# (type_def=:{td_args}, gs_modules) = getTypeDef module_index type_def_index gs_modules 
		# gtd_info = GTDI_Generic 
			{ 	gtr_type 		= generic_rep_type
			,	gtr_type_args	= [atv_variable \\ {atv_variable} <- td_args] 
			,	gtr_iso 		= iso_def_sym
			,	gtr_isomap_group= NoIndex
			,	gtr_isomap		= EmptyDefinedSymbol		
			,	gtr_isomap_from	= EmptyDefinedSymbol		
			,	gtr_isomap_to	= EmptyDefinedSymbol
			,	gtr_type_info	= type_info_def_sym		
			,	gtr_cons_infos 	= cons_info_def_syms
			}	
		# gs_gtd_infos = {gs_gtd_infos & [module_index, type_def_index] = gtd_info} 
		= {gs & gs_modules = gs_modules, gs_gtd_infos = gs_gtd_infos}	 	

	build_isos module_index type_def_index cons_infos gs

941 942
		# (from_fun_index, 	from_group_index, gs) 	= newFunAndGroupIndex gs
		# (to_fun_index, 	to_group_index, gs) 	= newFunAndGroupIndex gs
943
		# (iso_fun_index, 	iso_group_index, gs) 	= newFunAndGroupIndex gs