frontend.icl 24.4 KB
Newer Older
1
2
implementation module frontend

3
import scanner, parse, postparse, check, type, trans, partition, convertcases, overloading, utilities, convertDynamics,
4
		convertimportedtypes, analtypes, generics1,
5
		typereify, compare_types
John van Groningen's avatar
John van Groningen committed
6

7
8
9
10
instance == FrontEndPhase where
	(==) a b
		=	equal_constructor a b

11
frontSyntaxTree cached_dcl_macros cached_dcl_mods main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_and_list_instances heaps
12
13
14
15
	:== (Yes {
				fe_icl = {icl_mod & icl_functions=fun_defs }
			,	fe_dcls = dcl_mods
			,	fe_components = components
16
			,	fe_iaci = {	iaci_array_and_list_instances = array_and_list_instances,
17
18
19
							iaci_start_index_generic_classes = 0,
							iaci_not_exported_generic_classes = {}
						  }
20
			},cached_dcl_macros,cached_dcl_mods,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps
21
22
		)

23
24
defaultFrontEndOptions :: FrontEndOptions
defaultFrontEndOptions
25
	= { feo_up_to_phase = FrontEndPhaseAll,
26
27
		feo_fusion = { compile_with_fusion = False, generic_fusion = False, strip_unused = False } }

28
29
30
31
32
frontEndInterface :: !(Optional (*File,{#Char},{#Char})) !FrontEndOptions !Ident !SearchPaths !{#DclModule} !*{#*{#FunDef}} !(Optional Bool) !Bool (ModTimeFunction *Files)
																		 !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File !(Optional *File) !*Heaps
	-> (!Optional *FrontEndSyntaxTree,!*{#*{#FunDef}},!{#DclModule},!Int,!*PredefinedSymbols,!*HashTable,!*Files,!*File,!*File,!*File, !Optional *File, !*Heaps)
frontEndInterface opt_file_dir_time options mod_ident search_paths cached_dcl_modules cached_dcl_macros list_inferred_types support_dynamics modtimefunction
		predef_symbols hash_table files error io out tcl_file heaps
33
34
35
36
	| case opt_file_dir_time of No -> True; _ -> False
		# error = moduleCouldNotBeImportedError True mod_ident NoPos error
		= (No,{},{},0,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
	# (Yes (mod_file,mod_dir,mod_time)) = opt_file_dir_time
37
	# (ok,dynamic_type_used,mod,hash_table,error,files)
38
		= wantModule mod_file mod_time cWantIclFile mod_ident support_dynamics hash_table error files
39
	| not ok
40
		= (No,{},{},0,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
John van Groningen's avatar
John van Groningen committed
41
	# cached_module_idents = [dcl_mod.dcl_name \\ dcl_mod<-:cached_dcl_modules]
42
	# (ok, mod, global_fun_range, mod_functions, optional_dcl_mod, modules, dcl_module_n_in_cache,hash_table, error, files)
43
		= scanModule mod cached_module_idents support_dynamics hash_table error search_paths modtimefunction files
44

45
46
//	# hash_table = {hash_table & hte_entries={}}
	# hash_table = remove_icl_symbols_from_hash_table hash_table
47

48
	| not ok
49
		= (No,{},{},0,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
50
  	# symbol_table = hash_table.hte_symbol_heap
John van Groningen's avatar
John van Groningen committed
51
  	#! n_cached_dcl_modules=size cached_dcl_modules
52
53


54
  	# (ok, icl_mod, dcl_mods, groups, cached_dcl_macros,main_dcl_module_n,heaps, predef_symbols, symbol_table, error, directly_imported_dcl_modules)
55
  	  	= checkModule mod global_fun_range mod_functions support_dynamics dynamic_type_used dcl_module_n_in_cache optional_dcl_mod modules cached_dcl_modules cached_dcl_macros predef_symbols symbol_table error heaps
56

57
	  hash_table & hte_symbol_heap = symbol_table
58

59
	| not ok
60
		= (No,{},dcl_mods,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
61
62
63
64
65
66

	#! (icl_functions,icl_mod) = select_and_remove_icl_functions_from_record icl_mod
		with
			select_and_remove_icl_functions_from_record :: !*IclModule -> (!.{#FunDef},!.IclModule)
			select_and_remove_icl_functions_from_record icl_mod=:{icl_functions} = (icl_functions,{icl_mod & icl_functions={}})

67
	# {icl_common,icl_function_indices,icl_name,icl_imported_instances,icl_imported_objects,icl_foreign_exports,icl_used_module_numbers} = icl_mod
68
/*
69
	  (_,f,files) = fopen "components" FWriteText files
70
	  (groups, icl_functions, f) = showGroups groups 0 True icl_functions f
71
72
73
74
75
	/*	
	  (n_functions,icl_functions) = usize icl_functions
	  (icl_functions,f) = showFunctions {ir_from=0,ir_to=n_functions} icl_functions f
	  (cached_dcl_macros,f) = showMacros cached_dcl_macros f
	*/
76
77
78
	  (ok,files) = fclose f files
	| ok<>ok
		= abort "";
79
*/
80

81
//	# dcl_mods = {{dcl_mod & dcl_declared={dcls_import={},dcls_local=[],dcls_local_for_import={},dcls_explicit={}}}\\ dcl_mod<-:dcl_mods}
82

83
	# type_heaps = heaps.hp_type_heaps
84
85
	  fun_defs = icl_functions

86
	| options.feo_up_to_phase == FrontEndPhaseCheck
87
		# array_and_list_instances = {ali_instances_range={ir_from=0,ir_to=0},ali_array_first_instance_indices=[],ali_list_first_instance_indices=[],ali_tail_strict_list_first_instance_indices=[],ali_unboxed_maybe_first_instance_indices=[]}
88
		=	frontSyntaxTree cached_dcl_macros dcl_mods main_dcl_module_n
89
							predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs (groups_to_components groups) array_and_list_instances heaps
90

91
	# error_admin = {ea_file = error, ea_loc = [], ea_ok = True }
92
/*
93
94
	# (ti_common_defs, dcl_mods) = get_common_defs dcl_mods
	  ti_common_defs = { ti_common_defs & [main_dcl_module_n] = icl_common }
95
96
97
98
99
100
*/

	# (cached_dcl_mods, dcl_mods) = copy_dcl_modules dcl_mods
	
	# (type_groups, ti_common_defs, td_infos, icl_common, dcl_mods, type_heaps, error_admin)
			= partionateAndExpandTypes icl_used_module_numbers main_dcl_module_n icl_common dcl_mods type_heaps error_admin
101
102
103
//	  ti_common_defs = { ti_common_defs & [main_dcl_module_n] = icl_common }
//	# (td_infos, th_vars, error_admin) = analyseTypeDefs ti_common_defs type_groups td_infos type_heaps.th_vars error_admin
	  ({com_type_defs}, ti_common_defs) = replace ti_common_defs main_dcl_module_n icl_common
104
105

	# hp_var_heap = heaps.hp_var_heap
John van Groningen's avatar
John van Groningen committed
106
107
	#! n_types_with_type_functions = size ti_common_defs.[main_dcl_module_n].com_type_defs
	#! n_constructors_with_type_functions = size ti_common_defs.[main_dcl_module_n].com_cons_defs
108
	#! ea_ok = error_admin.ea_ok
109
	# (fun_defs, predef_symbols, hp_var_heap, type_heaps)
110
		= if (support_dynamics && ea_ok)
John van Groningen's avatar
John van Groningen committed
111
112
113
114
			(buildTypeFunctions main_dcl_module_n fun_defs ti_common_defs predef_symbols hp_var_heap type_heaps)
			(fun_defs, predef_symbols, hp_var_heap, type_heaps)
	# (td_infos, th_vars, error_admin)
		= analyseTypeDefs ti_common_defs type_groups com_type_defs main_dcl_module_n td_infos type_heaps.th_vars error_admin
115
	# (class_infos, td_infos, th_vars, error_admin)
John van Groningen's avatar
John van Groningen committed
116
		= determineKindsOfClasses icl_used_module_numbers ti_common_defs td_infos th_vars error_admin
117
118
119

	# icl_global_functions=icl_function_indices.ifi_global_function_indices

120
	# (fun_defs, dcl_mods, td_infos, th_vars, hp_expression_heap, gen_heap, error_admin)
John van Groningen's avatar
John van Groningen committed
121
		= checkKindsOfCommonDefsAndFunctions n_cached_dcl_modules main_dcl_module_n icl_used_module_numbers
122
				(icl_global_functions++[icl_function_indices.ifi_local_function_indices,icl_function_indices.ifi_specials_indices])
123
				ti_common_defs fun_defs dcl_mods td_infos class_infos th_vars heaps.hp_expression_heap heaps.hp_generic_heap error_admin
124

125
      type_heaps = { type_heaps & th_vars = th_vars }
126

127
	# heaps & hp_type_heaps = type_heaps, hp_expression_heap = hp_expression_heap, hp_generic_heap = gen_heap, hp_var_heap=hp_var_heap
128
129
130
131

	| not error_admin.ea_ok
		= (No,{},dcl_mods,main_dcl_module_n,predef_symbols, hash_table, files, error_admin.ea_file, io, out, tcl_file, heaps)

132
133
	#! start_index_generic_classes = size icl_common.com_class_defs;

134
135
	# (ti_common_defs,dcl_mods) = copy_common_defs_from_dcl_modules dcl_mods
	# (saved_main_dcl_common, ti_common_defs) = replace ti_common_defs main_dcl_module_n icl_common
136

137
138
139
	#! (ti_common_defs,groups,fun_defs,td_infos,heaps,hash_table,predef_symbols,dcl_mods,cached_dcl_macros,error_admin)
		= convertGenerics main_dcl_module_n icl_used_module_numbers ti_common_defs groups fun_defs
									   td_infos heaps hash_table predef_symbols dcl_mods cached_dcl_macros error_admin
140

141
	# (icl_common, ti_common_defs) = replace ti_common_defs main_dcl_module_n saved_main_dcl_common
142

143
	# dcl_mods & [module_n].dcl_common = common \\ common <-: ti_common_defs & module_n<-[0..]
144
145

	# icl_mod = {icl_mod & icl_common = icl_common} 
146
		
147
	# error = error_admin.ea_file
148
149

/*
150
151
	# (_,genout,files) = fopen "genout" FWriteText files
	# (n_fun_defs,fun_defs) = usize fun_defs
152
	# (fun_defs, genout) = show_group [0..n_fun_defs-1] True fun_defs genout
153
	# (ok,files) = fclose genout files
154
	| not ok = abort "could not write genout" 
155
*/
156
157
	#! ok = error_admin.ea_ok
	| not ok
158
		= (No,{},{},main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
159

160
	# (ok, fun_defs, array_and_list_instances, common_defs, imported_funs, type_def_infos, heaps, predef_symbols, error,out)
161
162
		= typeProgram groups main_dcl_module_n fun_defs icl_function_indices.ifi_specials_indices list_inferred_types icl_common icl_imported_instances dcl_mods icl_used_module_numbers
			td_infos heaps predef_symbols error out
163

164
	| not ok
165
		= (No,{},{},main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
166
167

	# icl_gencase_indices = icl_function_indices.ifi_gencase_indices
168
	# icl_function_indices = {icl_function_indices & ifi_gencase_indices = icl_gencase_indices }
169

170
	# (fun_def_size, fun_defs) = usize fun_defs
John van Groningen's avatar
John van Groningen committed
171
172
	# (components, fun_defs)
		= partitionateFunctions fun_defs (icl_global_functions++icl_function_indices.ifi_instance_indices
173
174
											++[icl_function_indices.ifi_specials_indices
											  : icl_gencase_indices++icl_function_indices.ifi_type_function_indices])
175
		
176
	| options.feo_up_to_phase == FrontEndPhaseTypeCheck
177
		=	frontSyntaxTree cached_dcl_macros cached_dcl_mods main_dcl_module_n
178
							predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_and_list_instances heaps
179

John van Groningen's avatar
John van Groningen committed
180
181
182
183
	# (dcl_types, components, fun_defs, predef_symbols, var_heap, type_heaps, expression_heap, tcl_file)
  		= convertDynamicPatternsIntoUnifyAppls common_defs main_dcl_module_n dcl_mods icl_mod directly_imported_dcl_modules
			n_types_with_type_functions n_constructors_with_type_functions
				  components fun_defs predef_symbols heaps.hp_var_heap heaps.hp_type_heaps heaps.hp_expression_heap tcl_file
184

185
	| options.feo_up_to_phase == FrontEndPhaseConvertDynamics
186
		# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap, hp_generic_heap=newHeap}
187
		=	frontSyntaxTree cached_dcl_macros cached_dcl_mods main_dcl_module_n
188
							predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_and_list_instances heaps
189

190
191
	#! stdStrictLists_module_n = predef_symbols.[PD_StdStrictLists].pds_def
	#! stdStrictMaybes_module_n = predef_symbols.[PD_StdStrictMaybes].pds_def
192

193
	# (cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap)
194
195
196
		= analyseGroups common_defs imported_funs array_and_list_instances.ali_instances_range
							main_dcl_module_n stdStrictLists_module_n stdStrictMaybes_module_n
							   components  fun_defs  var_heap  expression_heap
197

198
199
200
	# (def_max, acc_args)		= usize acc_args
	# (def_min, fun_defs)		= usize fun_defs

201
	  (components, used_conses, fun_defs, dcl_types, var_heap, type_heaps, expression_heap, error, predef_symbols)
202
		= transformGroups cleanup_info main_dcl_module_n def_min def_max components acc_args
203
	  						common_defs imported_funs type_def_infos dcl_mods options.feo_fusion
204
								fun_defs  dcl_types  var_heap  type_heaps  expression_heap  error  predef_symbols
205
206

	# error_admin = {ea_file = error, ea_loc = [], ea_ok = True }
207
	# {dcl_instances,dcl_specials,dcl_gencases,dcl_type_funs} = dcl_mods.[main_dcl_module_n]
208
	# (start_function_index,predef_symbols) = get_index_of_start_rule main_dcl_module_n predef_symbols
209

210
211
	# (error_admin,fun_defs)
		= checkForeignExportedFunctionTypes icl_foreign_exports error_admin fun_defs	
John van Groningen's avatar
John van Groningen committed
212
	
213
	# [icl_exported_global_functions,icl_not_exported_global_functions:_] = icl_global_functions
214
	# exported_global_functions = case start_function_index of
215
216
				NoIndex	-> [icl_exported_global_functions]
				sri		-> [{ir_from=sri,ir_to=inc sri},icl_exported_global_functions]
217
	# exported_functions = exported_global_functions ++  [dcl_instances,dcl_specials,dcl_gencases,dcl_type_funs]
218
	# (components, fun_defs, predef_symbols, var_heap, expression_heap, error_admin) 
219
220
		= partitionateFunctions` fun_defs (exported_functions ++ [icl_function_indices.ifi_type_function_indices!!1])
								main_dcl_module_n def_min def_max predef_symbols var_heap expression_heap error_admin
221
222
223
	# error = error_admin.ea_file
	| not error_admin.ea_ok
		# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap,hp_generic_heap=heaps.hp_generic_heap}
224
		= (No,{},{},main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
225

226
	| options.feo_up_to_phase == FrontEndPhaseTransformGroups
227
		# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap,hp_generic_heap=heaps.hp_generic_heap}
228
		=	frontSyntaxTree cached_dcl_macros cached_dcl_mods main_dcl_module_n
229
							predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_and_list_instances heaps
230

231
232
	# generic_heap = heaps.hp_generic_heap
	#! first_not_exported_generic_def_index = size dcl_mods.[main_dcl_module_n].dcl_common.com_generic_defs;
233
	# (not_exported_generic_classes,dcl_types,used_conses,var_heap,type_heaps,generic_heap)
234
235
		= convertIclModule main_dcl_module_n start_index_generic_classes first_not_exported_generic_def_index common_defs dcl_types used_conses
			var_heap type_heaps generic_heap
236
	# (used_conses,var_heap,predef_symbols)
237
238
		= mark_imported_unboxed_class array_and_list_instances.ali_list_first_instance_indices PD_UListClass
										main_dcl_module_n common_defs used_conses var_heap predef_symbols
239
	# (used_conses,var_heap,predef_symbols)
240
241
242
243
244
		= mark_imported_unboxed_class array_and_list_instances.ali_tail_strict_list_first_instance_indices PD_UTSListClass
										main_dcl_module_n common_defs used_conses var_heap predef_symbols
	# (used_conses,var_heap,predef_symbols)
		= mark_imported_unboxed_class array_and_list_instances.ali_unboxed_maybe_first_instance_indices PD_UMaybeClass
										main_dcl_module_n common_defs used_conses var_heap predef_symbols
245

246
	# (dcl_types,used_conses,var_heap,type_heaps) = convertDclModule main_dcl_module_n dcl_mods common_defs dcl_types used_conses var_heap type_heaps
247
248

//	  (components, fun_defs, out) = showComponents components 0 False fun_defs out
249

250
	| options.feo_up_to_phase == FrontEndPhaseConvertModules
251
		# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap,hp_generic_heap=generic_heap}
252
		=	frontSyntaxTree cached_dcl_macros cached_dcl_mods main_dcl_module_n
253
							predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_and_list_instances heaps
254

255
256
//	  (components, fun_defs, out) = showComponents components 0 False fun_defs out
	# (used_funs, components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
257
	  		= convertCasesOfFunctions components main_dcl_module_n imported_funs common_defs fun_defs dcl_types used_conses
258
					var_heap type_heaps expression_heap
259

260
	#! (type_heaps, var_heap)
261
262
		= convertMemberTypesAndImportedTypeSpecifications main_dcl_module_n start_index_generic_classes icl_used_module_numbers
			dcl_mods imported_funs common_defs used_conses used_funs dcl_types type_heaps var_heap
263
264
265
//	# (components, fun_defs, error)	= showTypes components 0 fun_defs error
//	# (dcl_mods, out) = showDclModules dcl_mods out
//	# (components, fun_defs, out) = showComponents components 0 False fun_defs out
266

267
268
269
270
271
272
273
/*
	# (_,f,files) = fopen "components2" FWriteText files
	  (components, fun_defs, f) = showComponents components 0 False fun_defs f
	  (ok,files) = fclose f files
	| ok<>ok
		= abort "";
*/
274

275
276
//	# (fun_defs,out,var_heap,predef_symbols) = sa components main_dcl_module_n dcl_mods fun_defs out var_heap predef_symbols;

277
	# heaps = {hp_var_heap = var_heap, hp_expression_heap=expression_heap, hp_type_heaps=type_heaps,hp_generic_heap=generic_heap}
278
	# 	fe ={	fe_icl = {icl_functions=fun_defs, icl_function_indices=icl_function_indices, icl_common=icl_common,
279
						 icl_imported_instances=icl_imported_instances, icl_imported_objects=icl_imported_objects,
280
						 icl_foreign_exports=icl_foreign_exports,icl_name=icl_name,icl_used_module_numbers=icl_used_module_numbers,
281
						 icl_modification_time=icl_mod.icl_modification_time }
282
283
			,	fe_dcls = dcl_mods
			,	fe_components = components
284
			,	fe_iaci = {	iaci_array_and_list_instances = array_and_list_instances,
285
286
287
							iaci_start_index_generic_classes = start_index_generic_classes,
							iaci_not_exported_generic_classes = not_exported_generic_classes
						  }
288
			}
289

290
	# cached_dcl_macros = clear_group_indices_of_macros cached_dcl_macros
291
	= (Yes fe,cached_dcl_macros,cached_dcl_mods,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps)
292
	where
293
		copy_dcl_modules :: !*{#DclModule} -> *(!*{#DclModule},!*{#DclModule})
294
295
296
		copy_dcl_modules dcl_mods
			#! nr_of_dcl_mods = size dcl_mods
			= arrayCopyBegin dcl_mods nr_of_dcl_mods
297

298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
		copy_common_defs_from_dcl_modules :: !*{#DclModule} -> (!*{#CommonDefs},!*{#DclModule})
		copy_common_defs_from_dcl_modules dcl_mods
			# (n_dcl_mods,dcl_mods) = usize dcl_mods
			| n_dcl_mods==0
				= ({#},dcl_mods)
				# (common_defs_0,dcl_mods) = dcl_mods![0].dcl_common
				= copy_common_defs 1 (createArray n_dcl_mods common_defs_0) dcl_mods

		copy_common_defs :: !Int !*{#CommonDefs} !*{#DclModule} -> (!*{#CommonDefs},!*{#DclModule})
		copy_common_defs module_n common_defs dcl_mods
			| module_n<size dcl_mods
				# (common_def,dcl_mods) = dcl_mods![module_n].dcl_common
				# common_defs & [module_n] = common_def
				= copy_common_defs (module_n+1) common_defs dcl_mods
				= (common_defs,dcl_mods)

314
315
		clear_group_indices_of_macros :: !*{#*{#FunDef}} -> *{#*{#FunDef}}
		clear_group_indices_of_macros cached_dcl_macros
316
			= clear_group_indices1 0 cached_dcl_macros
317
		where
318
319
			clear_group_indices1 :: !Int !*{#*{#u:FunDef}} -> *{#*{#FunDef}}
			clear_group_indices1 i cached_dcl_macros
320
321
				| i==size cached_dcl_macros
					= cached_dcl_macros
322
					# (cached_dcl_macros_i,cached_dcl_macros) = cached_dcl_macros![i]
323
					# cached_dcl_macros_i = clear_group_indices2 0 cached_dcl_macros_i
324
325
					# cached_dcl_macros = {cached_dcl_macros & [i]=cached_dcl_macros_i}
					= clear_group_indices1 (i+1) cached_dcl_macros
326
327
328
329
330
331
332

			clear_group_indices2 j cached_dcl_macros_i
				| j==size cached_dcl_macros_i
					= cached_dcl_macros_i
					# cached_dcl_macros_i = {cached_dcl_macros_i & [j].fun_info.fi_group_index= (-1)}
					= clear_group_indices2 (j+1) cached_dcl_macros_i	

333
334
335
336
337
338
		get_index_of_start_rule main_dcl_module_n predef_symbols
			# ({pds_def, pds_module}, predef_symbols) = predef_symbols![PD_Start]
			| pds_def <> NoIndex && pds_module == main_dcl_module_n
				= (pds_def, predef_symbols)
				= (NoIndex, predef_symbols)

339
340
341
342
343
	groups_to_components groups
		= {{component_members=group_members_to_component_members group_members} \\ {group_members}<-:groups}
	where
		group_members_to_component_members [e:l] = ComponentMember e (group_members_to_component_members l)
		group_members_to_component_members [] = NoComponentMembers
344

345
346
347
mark_imported_unboxed_class :: ![Int] !Int !Int !{#CommonDefs} !ImportedConstructors !*VarHeap !*PredefinedSymbols
															-> (!ImportedConstructors,!*VarHeap,!*PredefinedSymbols)
mark_imported_unboxed_class [] predef_index main_dcl_module_n common_defs used_conses var_heap predef_symbols
348
	= (used_conses,var_heap,predef_symbols)
349
mark_imported_unboxed_class _ predef_index main_dcl_module_n common_defs used_conses var_heap predef_symbols
350
351
352
	# ({pds_module,pds_def},predef_symbols) = predef_symbols![predef_index]
	# (used_conses,var_heap) = mark_imported_class pds_module pds_def main_dcl_module_n common_defs used_conses var_heap
	= (used_conses,var_heap,predef_symbols)
353

Sjaak Smetsers's avatar
Sjaak Smetsers committed
354
355
356
357
358
359
360
showFunctions :: !IndexRange !*{# FunDef} !*File  -> (!*{# FunDef},!*File)
showFunctions {ir_from, ir_to} fun_defs file
	= iFoldSt show_function ir_from ir_to (fun_defs, file)
where
	show_function fun_index (fun_defs, file)
		# (fd, fun_defs) = fun_defs![fun_index]
		= (fun_defs, file <<< fun_index <<< fd <<< '\n')
361

362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
showMacros :: !*{#*{#FunDef}} !*File -> (!*{#*{#FunDef}},!*File)
showMacros macro_defs file
	#! n_dcl_modules=size macro_defs
	= iFoldSt showMacrosInModule 0 n_dcl_modules (macro_defs,file)

showMacrosInModule :: !Int (!*{#*{#FunDef}},!*File) -> (!*{#*{#FunDef}},!*File)
showMacrosInModule dcl_index (macro_defs,file)
	# file=file <<< dcl_index <<< '\n'
	#! n_macros=size macro_defs.[dcl_index]
	= iFoldSt show_macro 0 n_macros (macro_defs,file)
	where
		show_macro macro_index (macro_defs, file)
			# (macro,macro_defs) = macro_defs![dcl_index,macro_index]
			= (macro_defs, file <<< macro_index <<< macro <<< '\n')

377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
showGroups :: !u:{! Group} !Int !Bool !*{# FunDef} !*File  -> (!u:{! Group}, !*{# FunDef},!*File)
showGroups comps comp_index show_types fun_defs file
	| comp_index >= size comps
		= (comps, fun_defs, file)
		# (comp, comps) = comps![comp_index]
		# (fun_defs, file) = show_group comp.group_members show_types fun_defs (file <<< "component " <<< comp_index <<< '\n')
		= showGroups comps (inc comp_index) show_types fun_defs file

show_group [] show_types fun_defs file
	= (fun_defs, file <<< '\n')
show_group [fun:funs] show_types fun_defs file
	# (fun_def, fun_defs) = fun_defs![fun]
	# file=file<<<fun<<<'\n'
	| show_types
		= show_group funs show_types fun_defs (file <<< fun_def.fun_type <<< '\n' <<< fun_def)
		= show_group funs show_types fun_defs (file <<< fun_def)
//		= show_group funs show_types fun_defs (file <<< fun_def.fun_ident)

showComponents :: !u:{!Component} !Int !Bool !*{# FunDef} !*File  -> (!u:{!Component}, !*{# FunDef},!*File)
396
397
398
399
showComponents comps comp_index show_types fun_defs file
	| comp_index >= size comps
		= (comps, fun_defs, file)
		# (comp, comps) = comps![comp_index]
400
		# (fun_defs, file) = show_component comp.component_members show_types fun_defs (file <<< "component " <<< comp_index <<< '\n')
401
402
		= showComponents comps (inc comp_index) show_types fun_defs file

403
show_component NoComponentMembers show_types fun_defs file
404
	= (fun_defs, file <<< '\n')
405
406
407
408
409
410
411
412
show_component (ComponentMember fun funs) show_types fun_defs file
	# (fun_def, fun_defs) = fun_defs![fun]
	# file=file<<<fun<<<'\n'
	| show_types
		= show_component funs show_types fun_defs (file <<< fun_def.fun_type <<< '\n' <<< fun_def)
		= show_component funs show_types fun_defs (file <<< fun_def)
//		= show_component funs show_types fun_defs (file <<< fun_def.fun_ident)
show_component (GeneratedComponentMember fun _ funs) show_types fun_defs file
413
414
415
416
417
418
	# (fun_def, fun_defs) = fun_defs![fun]
	# file=file<<<fun<<<'\n'
	| show_types
		= show_component funs show_types fun_defs (file <<< fun_def.fun_type <<< '\n' <<< fun_def)
		= show_component funs show_types fun_defs (file <<< fun_def)
//		= show_component funs show_types fun_defs (file <<< fun_def.fun_ident)
419
420
421
422
423
424
425
426
427
428
429
430

showTypes :: !*{! Group} !Int !*{# FunDef} !*File  -> (!*{! Group}, !*{# FunDef},!*File)
showTypes comps comp_index fun_defs file
	| comp_index >= size comps
		= (comps, fun_defs, file)
		# (comp, comps) = comps![comp_index]
		# (fun_defs, file) = show_types comp.group_members fun_defs (file <<< "component " <<< comp_index <<< '\n')
		= showTypes comps (inc comp_index) fun_defs file
where
	show_types [] fun_defs file
		= (fun_defs, file <<< '\n')
	show_types [fun:funs] fun_defs file
431
		# (fun_def, fun_defs) = fun_defs![fun]
432
433
		# properties = { form_properties = cAttributed bitor cAnnotated, form_attr_position = No }
		  (Yes ftype) = fun_def.fun_type
434
		= show_types funs fun_defs (file <<< fun_def.fun_ident <<< " :: " <:: (properties, ftype, No) <<< '\n' )
435
436
437
438
439
440
441
442
443

showDclModules :: !u:{#DclModule} !*File -> (!u:{#DclModule}, !*File)
showDclModules dcl_mods file
	= show_dcl_mods 0 dcl_mods file
where
	show_dcl_mods mod_index dcl_mods file
		# (size_dcl_mods, dcl_mods) = usize dcl_mods
		| mod_index == size_dcl_mods
			= (dcl_mods, file)
444
			# (dcl_mod, dcl_mods) = dcl_mods![mod_index]
445
			# file = show_dcl_mod dcl_mod file
446
			= show_dcl_mods (mod_index+1) dcl_mods file
447
448
449
450
451
452
453
454
455
456
457
			
	show_dcl_mod {dcl_name, dcl_functions} file
		# file = file <<< dcl_name <<< ":\n"
		# file = show_dcl_functions 0 dcl_functions file
		= file <<< "\n"
	show_dcl_functions fun_index dcl_functions file					 				
		| fun_index == size dcl_functions
			= file
		| otherwise
			# file = show_dcl_function dcl_functions.[fun_index] file
			= show_dcl_functions (inc fun_index) dcl_functions file 
458
459
	show_dcl_function {ft_ident, ft_type} file
		= file <<< ft_ident <<< " :: " <<< ft_type <<< "\n"			
460
		
461
462
463
464
465
466
467
468
469
470
471
instance == ListTypesKind where
	(==) ListTypesNone ListTypesNone
		=	True
	(==) ListTypesInferred ListTypesInferred
		=	True
	(==) ListTypesStrictExports ListTypesStrictExports
		=	True
	(==) ListTypesAll ListTypesAll
		=	True
	(==) _ _
		=	False