explicitimports.icl 33.5 KB
Newer Older
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1
implementation module explicitimports
2
// compile with reuse unique nodes option
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
3
4
5

import StdEnv

6
7
8
9
10
11
12
13
:: FilterState =
	{	fs_wanted_symbols	:: ![Ident]
	,	fs_modules			:: !.{#DclModule}
	,	fs_symbol_table		:: !.SymbolTable
	,	fs_error			:: !.ErrorAdmin
	}

import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, RWSDebug, cheat
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
14

15
16
possiblyFilterExplImportedDecls :: ![ImportDeclaration] u:[w:(.Index,y:Declarations)] Position *{#DclModule} !*CheckState
				-> (!v:[x:(Index,z:Declarations)],!.{#DclModule},!.CheckState), [y <= z, w <= x, u <= v]
17
possiblyFilterExplImportedDecls [] decls_of_imported_module _ modules cs // implicit import
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
18
	= (decls_of_imported_module, modules, cs)
19
possiblyFilterExplImportedDecls import_declarations decls_of_imported_module import_statement_pos modules cs=:{cs_error, cs_symbol_table}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
20
	// explicit import
21
22
23
	# cs_error = pushErrorAdmin (newPosition { id_name="", id_info=nilPtr } import_statement_pos) cs_error
	  (wanted_symbols, cs_symbol_table, cs_error)
	  		= foldSt add_wanted_symbol_to_symbol_table import_declarations ([], cs_symbol_table, cs_error)
24
25
26
27
28
29
	  fs = { fs_wanted_symbols = wanted_symbols, fs_modules = modules,
	  		fs_symbol_table = cs_symbol_table, fs_error = cs_error }
	  (imported_decls, { fs_wanted_symbols, fs_modules, fs_symbol_table, fs_error })
	  		= foldSt (filter_decls_per_module import_statement_pos) decls_of_imported_module ([], fs)
	  cs = foldSt (switch_import_syntax restore_symbol_table_old_syntax restore_symbol_table) fs_wanted_symbols
	  			{ cs & cs_symbol_table = fs_symbol_table, cs_error = fs_error }
30
	  cs = { cs & cs_error = popErrorAdmin cs.cs_error }
31
	= (imported_decls, fs_modules, cs)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
32
  where
33
34
35
	add_wanted_symbol_to_symbol_table import_declaration=:(ID_OldSyntax idents) (wanted_symbols_accu, cs_symbol_table, cs_error)
		// this alternative is only for old syntax
		= foldSt (add_symbols import_declaration) idents (wanted_symbols_accu, cs_symbol_table, cs_error)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
36
	  where
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
		add_symbols import_declaration ident=:{id_info} (wanted_symbols_accu, cs_symbol_table, cs_error)
			# (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
	  		= case ste_kind of
  				STE_ExplImp _ _ _ _
  					-> (wanted_symbols_accu, cs_symbol_table, cs_error)
  				_	# new_ste_kind = STE_ExplImp False (Yes import_declaration) STE_Empty False
					  new_ste = { ste & ste_kind = new_ste_kind, ste_previous = ste }
					  cs_symbol_table = writePtr id_info new_ste cs_symbol_table //--->("writing", ident)
					-> ([ident:wanted_symbols_accu], cs_symbol_table, cs_error)
	add_wanted_symbol_to_symbol_table import_declaration (wanted_symbols_accu, cs_symbol_table, cs_error)
		// "wanted" means: a symbol is listed in an explicit import statement
		# (ident=:{id_info}) = get_ident import_declaration
		  (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
  		= case ste_kind of
  			STE_ExplImp _ _ _ _
  				-> (wanted_symbols_accu, cs_symbol_table,
  					checkError ident "appeared twice in one explicit import statement" cs_error)
  			_	# new_ste_kind = STE_ExplImp False (Yes import_declaration) (imp_decl_to_ste_kind import_declaration) False
				  new_ste = { ste & ste_kind = new_ste_kind, ste_previous = ste }
				  cs_symbol_table = writePtr id_info new_ste cs_symbol_table
				-> ([ident:wanted_symbols_accu], cs_symbol_table, cs_error)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
58
	  where
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
		imp_decl_to_ste_kind (ID_Function _)				= STE_FunctionOrMacro []
		imp_decl_to_ste_kind (ID_Class _ _)					= STE_Class
		imp_decl_to_ste_kind (ID_Type _ _)					= STE_Type
		imp_decl_to_ste_kind (ID_Record _ _)				= STE_Type
		imp_decl_to_ste_kind (ID_Instance {ii_ident} _ _)	= STE_Instance ii_ident
		
	add_bracket_symbol_to_symbol_table ste_kind all_bracket_ids_are_wanted ident=:{id_info} symbol_table
		# (ste=:{ste_kind}, symbol_table) = readPtr id_info symbol_table
		  new_ste_kind = STE_ExplImp all_bracket_ids_are_wanted No ste_kind (not all_bracket_ids_are_wanted)
		  new_ste = { ste & ste_kind = new_ste_kind, ste_previous = ste }
		  symbol_table = writePtr id_info new_ste symbol_table //--->("writing", ident)
		= symbol_table

	get_ident (ID_Function {ii_ident})						= ii_ident
	get_ident (ID_Class {ii_ident} _)						= ii_ident
	get_ident (ID_Type {ii_ident} _)						= ii_ident
	get_ident (ID_Record {ii_ident} _)						= ii_ident
	get_ident (ID_Instance class_ident instance_ident _)	= instance_ident

	restore_symbol_table id=:{id_info} cs=:{ cs_symbol_table, cs_error }
		# (ste, cs_symbol_table) = readPtr id_info cs_symbol_table
		  cs_symbol_table = writePtr id_info ste.ste_previous cs_symbol_table //--->("restoring", id)
		  cs_error = case ste.ste_kind of
		  				STE_ExplImp success _ ste_kind _
		  					| success
		  						-> cs_error
		  					-> checkError id ("not exported as a "+++toString ste_kind+++
		  															" by the specified module") cs_error
		  				_	-> abort "assertion 1 failed in module explicitimports"
		= { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
89
	
90
91
92
93
94
95
96
97
98
99
100
101
	restore_symbol_table_old_syntax id=:{id_info} cs=:{ cs_symbol_table }
		# (ste, cs_symbol_table) = readPtr id_info cs_symbol_table
		  cs_symbol_table = writePtr id_info ste.ste_previous cs_symbol_table //--->("restoring", id)
		  cs = { cs & cs_symbol_table = cs_symbol_table }
		= case ste.ste_kind of
			STE_ExplImp success opt_id _ _
				| success
					-> cs
				# cs_symbol_table = opt_make_partners_succesful opt_id cs.cs_symbol_table
				  cs_error = checkError id "not exported by the specified module" cs.cs_error
				-> { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }
		  	_	-> abort "assertion 54 failed in module explicitimports"
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
102
	  where
103
104
105
106
107
108
109
110
111
112
113
114
115
116
		opt_make_partners_succesful No cs_symbol_table
			= cs_symbol_table
		opt_make_partners_succesful (Yes (ID_OldSyntax partners)) cs_symbol_table
			= foldSt make_partner_succesful partners cs_symbol_table

		make_partner_succesful {id_info} cs_symbol_table
			// set the success bit for the partner entries, because an error message has been
			// given already
			# (ste, cs_symbol_table) = readPtr id_info cs_symbol_table
			= case ste.ste_kind of
				STE_ExplImp _ a b c
					-> writePtr id_info { ste & ste_kind = STE_ExplImp True a b c } cs_symbol_table
				_	-> cs_symbol_table
			
117
118
	filter_decls_per_module import_statement_pos (mod_index, {dcls_import, dcls_local}) (imported_decls_per_module, fs)
		# (dcls_import, fs)
119
				= iMapFilterYesSt (i_filter_possibly_imported_decl mod_index dcls_import)
120
121
122
						0 (size dcls_import) fs
		  (dcls_local, fs)
		  		= mapFilterYesSt (filter_possibly_imported_decl mod_index) dcls_local fs
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
		  dcls_import_array
		  		= { el \\ el <- dcls_import}
		  size_dia
		  		= size dcls_import_array
		  dcls_local_for_import
		  		= {local_declaration_for_import decl mod_index \\ decl<-dcls_local}
		  dcls_explicit
		  		= { ExplicitImport 
		  				(if (i<size_dia) dcls_import_array.[i] dcls_local_for_import.[i-size_dia])
		  				import_statement_pos 
		  			\\ i <- [0..size_dia+size dcls_local_for_import-1] }
		= ( [ (mod_index, { dcls_import = dcls_import_array, dcls_local = dcls_local,
							dcls_local_for_import = dcls_local_for_import,
							dcls_explicit = dcls_explicit })
			:imported_decls_per_module
			],
139
			fs)
140

141
142
	i_filter_possibly_imported_decl :: !Int !{!Declaration} !Int !*FilterState
									-> (!Optional Declaration, !.FilterState)
143
144
145
	i_filter_possibly_imported_decl mod_index dcls_import i state
		= filter_possibly_imported_decl mod_index dcls_import.[i] state
		
146
	filter_possibly_imported_decl :: !Int !Declaration !*FilterState -> (!Optional Declaration, !.FilterState)
147
148
149
150
151
	filter_possibly_imported_decl _ decl=:{dcl_kind=STE_Imported ste_kind mod_index} state
		= filter_decl mod_index decl ste_kind state
	filter_possibly_imported_decl mod_index decl=:{dcl_kind} state
		= filter_decl mod_index decl dcl_kind state

152
153
	filter_decl :: !Int !Declaration !STE_Kind !*FilterState -> (!Optional Declaration, !.FilterState)
	filter_decl mod_index decl (STE_Instance class_ident) fs
154
155
		// this alternative is only for old syntax
		| switch_import_syntax True False
156
157
158
159
			= filter_instance_decl mod_index decl class_ident fs
	filter_decl mod_index decl=:{dcl_ident={id_info}} dcl_kind fs=:{fs_symbol_table}
		# (ste=:{ste_kind}, fs_symbol_table) = readPtr id_info fs_symbol_table
		  fs = { fs & fs_symbol_table = fs_symbol_table }
160
161
162
		= case ste_kind of
			STE_ExplImp _ opt_import_declaration ste_kind_2 _
				// the symbol is wanted (see above).
163
				# fs_symbol_table 
164
						= writePtr id_info { ste & ste_kind = STE_ExplImp True opt_import_declaration ste_kind_2 False}
165
									fs.fs_symbol_table //--->("setting True", decl.dcl_ident)
166
						// mark this symbol as being succesfully imported
167
				  fs = { fs & fs_symbol_table = fs_symbol_table}
168
		  		-> case opt_import_declaration of
169
					No	-> (Yes decl, fs)
170
					Yes import_declaration
171
172
173
						# fs = switch_import_syntax (mark_partners import_declaration fs) fs
						-> (Yes decl, add_bracketed_symbols_to_symbol_table import_declaration decl dcl_kind mod_index fs)
			_	-> (No, fs)
174
175

	// only for old syntax
176
177
178
	filter_instance_decl mod_index decl=:{dcl_index} class_ident fs=:{fs_symbol_table}
		# (ste=:{ste_kind}, fs_symbol_table) = readPtr class_ident.id_info fs_symbol_table
		  fs = { fs & fs_symbol_table = fs_symbol_table }
179
180
		= case ste_kind of
			STE_ExplImp _ _ _ _
181
182
				-> (Yes decl, fs)
			_	-> (No, fs)
183
184

	// only for old syntax
185
186
187
	mark_partners (ID_OldSyntax partners) fs=:{fs_symbol_table}
		# fs_symbol_table = foldSt mark_partner partners fs_symbol_table
		= { fs & fs_symbol_table = fs_symbol_table }
188
	  where
189
190
191
		mark_partner {id_info} fs_symbol_table
			# (ste=:{ste_kind=STE_ExplImp _ a b c}, fs_symbol_table) = readPtr id_info fs_symbol_table
			= writePtr id_info { ste & ste_kind = STE_ExplImp True a b c } fs_symbol_table
192
		
193
194
	add_bracketed_symbols_to_symbol_table import_declaration decl dcl_kind mod_index fs
		# (opt_bracket_info, fs=:{fs_symbol_table})
195
				= (switch_import_syntax get_opt_bracket_info_old_syntax get_opt_bracket_info)
196
					import_declaration decl dcl_kind mod_index fs
197
		| isNo opt_bracket_info
198
			= { fs & fs_symbol_table = fs_symbol_table }
199
200
201
202
		# (Yes (all_bracket_ids, wanted_bracket_ids, structure_name, ste_kind)) 
				= opt_bracket_info
		  all_bracket_ids_are_wanted
		  		= isEmpty wanted_bracket_ids
203
		  fs_symbol_table
204
				= foldSt (add_bracket_symbol_to_symbol_table ste_kind all_bracket_ids_are_wanted) all_bracket_ids
205
206
																  fs_symbol_table
		  fs = { fs & fs_symbol_table = fs_symbol_table }
207
208
		| all_bracket_ids_are_wanted
			// "import class C (..)" or "import :: T (..)" or "import :: T {..}" 
209
			= { fs & fs_wanted_symbols = all_bracket_ids++fs.fs_wanted_symbols }
210
211
212
		// "import class C (m1, m2)" or "import :: T (C1, C2)" or "import :: T {f1, f2}" 
		// currently all bracket symbols have (STE_ExplImp _ _ _ True). Mark those that are really wanted False
		// and overwrite the remaining again with STE_Empty
213
214
215
216
217
		# fs = foldSt (check_wanted_idents structure_name) wanted_bracket_ids fs
		  fs_symbol_table = foldSt overwrite_wanted_idents wanted_bracket_ids fs.fs_symbol_table
		  (fs_wanted_symbols, fs_symbol_table)
		  		= foldSt remove_and_collect all_bracket_ids (fs.fs_wanted_symbols, fs_symbol_table)
		= { fs & fs_wanted_symbols = fs_wanted_symbols, fs_symbol_table = fs_symbol_table }
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
218
	  where
219
220
	  	isNo No = True
	  	isNo _  = False
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
221

222
223
224
	get_opt_bracket_info (ID_Class _ (Yes wanted_members)) {dcl_kind, dcl_index} mod_index fs
		# (dcl_module, module_entry, fs)
				= get_module_and_entry dcl_kind mod_index fs
225
226
227
228
229
230
		  class_def = case module_entry.ste_kind of
						STE_OpenModule _ modul
							-> modul.mod_defs.def_classes!!dcl_index
						STE_ClosedModule
							-> dcl_module.dcl_common.com_class_defs.[dcl_index]
		  all_member_idents = [ ds_ident \\ {ds_ident} <-: class_def.class_members ]
231
232
233
234
		= (Yes (all_member_idents, wanted_members, class_def.class_name, STE_Member), fs)
	get_opt_bracket_info (ID_Type ii (Yes wanted_constructors)) {dcl_kind, dcl_index} mod_index fs
		# (dcl_module, module_entry, fs)
				= get_module_and_entry dcl_kind mod_index fs
235
236
237
238
239
240
		  type_def = case module_entry.ste_kind of
						STE_OpenModule _ modul
							-> modul.mod_defs.def_types!!dcl_index
						STE_ClosedModule
							-> dcl_module.dcl_common.com_type_defs.[dcl_index]
		| not (isAlgType type_def.td_rhs)
241
242
			# fs = { fs & fs_error = checkError ii.ii_ident "is not an algebraic type" fs.fs_error }
			= (No, fs)
243
244
		# (AlgType constructors) = type_def.td_rhs
		  all_constructor_idents = [ ds_ident \\ {ds_ident} <- constructors ]
245
		= (Yes (all_constructor_idents, wanted_constructors, type_def.td_name, STE_Constructor), fs)
246
247
248
	  where
		isAlgType (AlgType _) = True
		isAlgType _ = False
249
250
251
	get_opt_bracket_info (ID_Record ii (Yes wanted_fields)) {dcl_kind, dcl_index} mod_index fs
		# (dcl_module, module_entry, fs)
				= get_module_and_entry dcl_kind mod_index fs
252
253
254
255
256
257
		  type_def = case module_entry.ste_kind of
						STE_OpenModule _ modul
							-> modul.mod_defs.def_types!!dcl_index
						STE_ClosedModule
							-> dcl_module.dcl_common.com_type_defs.[dcl_index]
		| not (isRecordType type_def.td_rhs)
258
259
			# fs = { fs & fs_error = checkError ii.ii_ident "is not a record type" fs.fs_error }
			= (No, fs)
260
261
		# (RecordType {rt_fields}) = type_def.td_rhs
		  all_field_idents = [ fs_name \\ {fs_name} <-: rt_fields ]
262
		= (Yes (all_field_idents, wanted_fields, type_def.td_name, STE_Field (hd all_field_idents)), fs)
263
264
265
	  where
		isRecordType (RecordType _) = True
		isRecordType _ = False
266
267
	get_opt_bracket_info _ _ _ fs
		= (No, fs)
268
269

	// this function is only for old syntax
270
271
272
	get_opt_bracket_info_old_syntax _ {dcl_index} STE_Class mod_index fs
		# (dcl_module, module_entry, fs)
				= get_module_and_entry STE_Class mod_index fs
273
274
275
276
277
278
		  class_def = case module_entry.ste_kind of
						STE_OpenModule _ modul
							-> modul.mod_defs.def_classes!!dcl_index
						STE_ClosedModule
							-> dcl_module.dcl_common.com_class_defs.[dcl_index]
		  all_member_idents = [ ds_ident \\ {ds_ident} <-: class_def.class_members ]
279
280
281
282
283
284
		  (all_member_idents_2, fs_symbol_table)
		  		= foldSt filter_member all_member_idents ([], fs.fs_symbol_table)
		= (Yes (all_member_idents_2, [], class_def.class_name, STE_Member), { fs & fs_symbol_table = fs_symbol_table })
	get_opt_bracket_info_old_syntax _ {dcl_index} STE_Type mod_index fs
		# (dcl_module, module_entry, fs)
				= get_module_and_entry STE_Type mod_index fs
285
286
287
288
289
290
291
292
		  type_def = case module_entry.ste_kind of
						STE_OpenModule _ modul
							-> modul.mod_defs.def_types!!dcl_index
						STE_ClosedModule
							-> dcl_module.dcl_common.com_type_defs.[dcl_index]
		= case type_def.td_rhs of
			RecordType {rt_fields}
				# all_field_idents = [ fs_name \\ {fs_name} <-: rt_fields ]
293
294
295
296
				-> (Yes (all_field_idents, [], type_def.td_name, STE_Field (hd all_field_idents)), fs)
			_	-> (No, fs)
	get_opt_bracket_info_old_syntax _ _ _ _ fs
		= (No, fs)
297
	
298
	// only for old syntax
299
	filter_member member_id=:{id_info} (accu, fs_symbol_table)
300
301
302
		// it is possible that a member that had to be added the the list of wanted
		// symbols is already in there because an identifier with the same name was
		// explicitly imported. Special case: class and member have the same name
303
		# ({ste_kind}, fs_symbol_table) = readPtr id_info fs_symbol_table
304
305
		= case ste_kind of
			STE_ExplImp _ _ _ _
306
307
				-> (accu, fs_symbol_table)
			_	-> ([member_id:accu], fs_symbol_table)
308
			
309
	get_module_and_entry dcl_kind mod_index fs=:{fs_modules, fs_symbol_table}
310
311
312
313
314
		# index_mod_with_def = case dcl_kind of
								STE_Imported _ index_mod_with_def
									-> abort "assertion 2 failed in module explicitimports"
								_	-> mod_index
							// get the index of the module where the symbol is defined
315
316
317
		  (dcl_module=:{dcl_name=dcl_name=:{id_info}}, fs_modules) = fs_modules![index_mod_with_def]
		  (module_entry, fs_symbol_table) = readPtr id_info fs_symbol_table
		= (dcl_module, module_entry, { fs & fs_modules = fs_modules, fs_symbol_table = fs_symbol_table })
318

319
320
321
	check_wanted_idents structure_name {ii_ident=ii_ident=:{id_info}} fs=:{fs_symbol_table}
		# (ste=:{ste_kind}, fs_symbol_table) = readPtr id_info fs_symbol_table
		  fs = { fs & fs_symbol_table = fs_symbol_table }
322
323
		= case ste_kind of
			STE_ExplImp a b _ True
324
325
				-> fs 
			_	-> { fs & fs_error = checkError ii_ident ("does not belong to "+++toString structure_name) fs.fs_error}
326

327
328
	overwrite_wanted_idents {ii_ident={id_info}} fs_symbol_table
		# (ste=:{ste_kind}, fs_symbol_table) = readPtr id_info fs_symbol_table
329
330
		= case ste_kind of
			STE_ExplImp a b c _
331
				-> writePtr id_info { ste & ste_kind = STE_ExplImp a b c False } fs_symbol_table
332
			STE_Empty
333
				-> fs_symbol_table
334
		
335
336
	remove_and_collect ident=:{id_info} (wanted_symbols_accu, fs_symbol_table)
		# (ste=:{ste_kind=STE_ExplImp _ _ _ is_unwanted}, fs_symbol_table) = readPtr id_info fs_symbol_table
337
		| is_unwanted
338
339
			= (wanted_symbols_accu, writePtr id_info { ste & ste_kind = STE_Empty } fs_symbol_table)
		= ([ident:wanted_symbols_accu], fs_symbol_table)
340

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
341

342
343
344
345
346
347
348
349
350
:: CheckCompletenessState =
	{	ccs_dcl_modules				:: !.{#DclModule}
	,	ccs_icl_functions			:: !.{#FunDef}
	,	ccs_set_of_visited_icl_funs	:: !.{#Bool}		// ccs_set_of_visited_icl_funs.[i] <=> function nr i has been considered
	,	ccs_expr_heap				:: !.ExpressionHeap
	,	ccs_symbol_table			:: !.SymbolTable
	,	ccs_error					:: !.ErrorAdmin
	,	ccs_heap_changes_accu		:: ![SymbolPtr]
	}
351

352
353
354
:: *CheckCompletenessStateBox = { box_ccs :: !*CheckCompletenessState }

:: CheckCompletenessInput =
355
356
	{	cci_import_position		:: !Position
	,	cci_main_dcl_module_n	:: !Int
357
	}
358

359
360
:: CheckCompletenessInputBox = { box_cci :: !CheckCompletenessInput }

361
checkExplicitImportCompleteness :: !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState 
362
				-> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState)
363
checkExplicitImportCompleteness main_dcl_module_n dcls_explicit dcl_modules icl_functions expr_heap 
364
365
366
367
368
369
								cs=:{cs_symbol_table, cs_error}
	#! nr_icl_functions = size icl_functions
	   box_ccs = { ccs_dcl_modules = dcl_modules, ccs_icl_functions = icl_functions,
	   			ccs_set_of_visited_icl_funs = createArray nr_icl_functions False,
				ccs_expr_heap = expr_heap, ccs_symbol_table = cs_symbol_table,
				ccs_error = cs_error, ccs_heap_changes_accu = [] }
370
	   ccs = foldSt checkCompleteness dcls_explicit { box_ccs = box_ccs }
371
372
373
374
375
376
	   { ccs_dcl_modules, ccs_icl_functions, ccs_expr_heap, ccs_symbol_table, ccs_error, ccs_heap_changes_accu }
	   		= ccs.box_ccs
	// repair heap contents
	   ccs_symbol_table = foldSt replace_ste_with_previous ccs_heap_changes_accu ccs_symbol_table
	   cs = { cs & cs_symbol_table = ccs_symbol_table, cs_error = ccs_error }
	= (ccs_dcl_modules, ccs_icl_functions, ccs_expr_heap, cs)
377
  where
378
	checkCompleteness :: !ExplicitImport !*CheckCompletenessStateBox -> *CheckCompletenessStateBox
379
380
381
382
383
	checkCompleteness (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_FunctionOrMacro _} import_position) ccs 
		= checkCompletenessOfMacro dcl_ident dcl_index main_dcl_module_n import_position ccs
	checkCompleteness (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_Imported (STE_FunctionOrMacro _) mod_index} import_position) ccs 
		= checkCompletenessOfMacro dcl_ident dcl_index main_dcl_module_n import_position ccs
	checkCompleteness (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_Imported expl_imp_kind mod_index} import_position) ccs 
384
		#! ({dcl_common,dcl_functions}, ccs) = ccs!box_ccs.ccs_dcl_modules.[mod_index]
385
		   cci = { box_cci = { cci_import_position = import_position, cci_main_dcl_module_n=main_dcl_module_n }}
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
		= continuation expl_imp_kind dcl_common dcl_functions cci ccs
	  where
		continuation :: !STE_Kind CommonDefs !{# FunType} !CheckCompletenessInputBox !*CheckCompletenessStateBox
					-> *CheckCompletenessStateBox
		continuation STE_Type dcl_common dcl_functions cci ccs
			= check_completeness dcl_common.com_type_defs.[dcl_index] cci ccs
		continuation STE_Constructor dcl_common dcl_functions cci ccs
			= check_completeness dcl_common.com_cons_defs.[dcl_index] cci ccs
		continuation (STE_Field _) dcl_common dcl_functions cci ccs
			= check_completeness dcl_common.com_selector_defs.[dcl_index] cci ccs
		continuation STE_Class dcl_common dcl_functions cci ccs
			= check_completeness dcl_common.com_class_defs.[dcl_index] cci ccs
		continuation STE_Member dcl_common dcl_functions cci ccs
			= check_completeness dcl_common.com_member_defs.[dcl_index] cci ccs
		continuation (STE_Instance _) dcl_common dcl_functions cci ccs
			= check_completeness dcl_common.com_instance_defs.[dcl_index] cci ccs
		continuation STE_DclFunction dcl_common dcl_functions cci ccs
			= check_completeness dcl_functions.[dcl_index] cci ccs

	checkCompletenessOfMacro :: !Ident !Index !Int !Position !*CheckCompletenessStateBox -> *CheckCompletenessStateBox
406
	checkCompletenessOfMacro dcl_ident dcl_index main_dcl_module_n import_position ccs
407
408
		#! ({fun_body}, ccs) = ccs!box_ccs.ccs_icl_functions.[dcl_index]
		   ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[dcl_index] = True }
409
		   cci = { box_cci = { cci_import_position = import_position, cci_main_dcl_module_n=main_dcl_module_n }}
410
411
412
413
414
415
		= check_completeness fun_body cci ccs

	replace_ste_with_previous :: !SymbolPtr !*SymbolTable -> .SymbolTable
	replace_ste_with_previous changed_ste_ptr symbol_table
		#! ({ste_previous}, symbol_table) = readPtr changed_ste_ptr symbol_table
		= writePtr changed_ste_ptr ste_previous symbol_table
416

417
418
419
420
421
422
423
instance toString STE_Kind where
	toString (STE_FunctionOrMacro _)	= "function/macro"
	toString STE_Type 					= "type"
	toString STE_Constructor 			= "constructor"
	toString (STE_Field _) 				= "field"
	toString STE_Class 					= "class"
	toString STE_Member 				= "class member"
424
	toString (STE_Instance _)			= "instance"
425
426
427
428
429
430
431
432
433

check_whether_ident_is_imported :: !Ident !STE_Kind !CheckCompletenessInputBox !*CheckCompletenessStateBox 
								-> *CheckCompletenessStateBox
check_whether_ident_is_imported ident wanted_ste_kind cci ccs=:{box_ccs=box_ccs=:{ccs_symbol_table}}
	#! (ste=:{ste_kind}, ccs_symbol_table) = readPtr ident.id_info ccs_symbol_table
	   ccs = { ccs & box_ccs = { box_ccs & ccs_symbol_table = ccs_symbol_table } }
	| is_imported ste_kind wanted_ste_kind
		= ccs
	#! (ccs=:{box_ccs=box_ccs=:{ccs_symbol_table, ccs_error, ccs_heap_changes_accu}}) = ccs
434
435
436
	   {box_cci={cci_import_position}} = cci
	   ccs_error = checkErrorWithIdentPos (newPosition { id_name="import", id_info=nilPtr } cci_import_position)
	   				(" "+++toString wanted_ste_kind+++" "+++toString ident.id_name+++" not imported") ccs_error
437
438
439
440
	   // pretend that the unimported symbol was imported to prevent doubling error mesages
	   ccs_symbol_table = writePtr ident.id_info { ste & ste_kind = wanted_ste_kind, ste_previous = ste } ccs_symbol_table
	= { ccs & box_ccs = { box_ccs & ccs_error = ccs_error, ccs_symbol_table = ccs_symbol_table, 
									ccs_heap_changes_accu = [ident.id_info:ccs_heap_changes_accu] }}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
441
  where
442
443
444
445
	is_imported (STE_Imported ste_kind _) wanted_ste_kind
		= ste_kind==wanted_ste_kind
	is_imported ste_kind wanted_ste_kind
		= ste_kind==wanted_ste_kind
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
446

447
class check_completeness x :: !x !CheckCompletenessInputBox !*CheckCompletenessStateBox -> *CheckCompletenessStateBox
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
448

449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
instance check_completeness App where
	check_completeness {app_symb, app_args}	cci ccs
		= check_completeness app_symb cci
		  (check_completeness app_args cci ccs)
	
instance check_completeness AlgebraicPattern where
	check_completeness {ap_symbol, ap_expr} cci ccs
		= check_completeness ap_expr cci
		  (check_whether_ident_is_imported ap_symbol.glob_object.ds_ident STE_Constructor cci ccs)

instance check_completeness AType where
	check_completeness {at_type} cci ccs
		= check_completeness at_type cci ccs

instance check_completeness BasicPattern where
	check_completeness {bp_expr} cci ccs
		= check_completeness bp_expr cci ccs

467
468
469
instance check_completeness LetBind where
	check_completeness {lb_src} cci ccs
		= check_completeness lb_src cci ccs
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487

instance check_completeness Case where
	check_completeness { case_expr, case_guards, case_default } cci ccs
		= ( (check_completeness case_expr cci)
		  o (check_completeness case_guards cci)
		  o (check_completeness case_default cci)
		  ) ccs

instance check_completeness CasePatterns where
	check_completeness (AlgebraicPatterns _ algebraicPatterns) cci ccs
		= check_completeness algebraicPatterns cci ccs
	check_completeness (BasicPatterns _ basicPatterns) cci ccs
		= check_completeness basicPatterns cci ccs
	check_completeness (DynamicPatterns dynamicPatterns) cci ccs
		= check_completeness dynamicPatterns cci ccs
	check_completeness NoPattern _ ccs
		= ccs

488
489
490
491
instance check_completeness CheckedAlternative where
	check_completeness {ca_rhs} cci ccs
		= check_completeness ca_rhs cci ccs

492
493
494
495
496
497
498
499
500
501
502
503
504
instance check_completeness CheckedBody where
	check_completeness {cb_rhs} cci ccs
		= check_completeness cb_rhs cci ccs

instance check_completeness ClassDef where
	check_completeness {class_context} cci ccs
		= check_completeness class_context cci ccs

instance check_completeness ClassInstance where
	check_completeness {ins_type} cci ccs
		= check_completeness ins_type cci ccs

instance check_completeness ConsDef
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
505
  where
506
507
	check_completeness {cons_type} cci ccs
		= check_completeness cons_type cci ccs
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
508

509
510
511
512
513
514
515
516
517
518
519
520
521
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
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
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
instance check_completeness DynamicPattern where
	check_completeness { dp_rhs, dp_type } cci ccs
		= check_completeness dp_rhs cci
		  (check_completeness_of_dyn_expr_ptr dp_type cci ccs)
	
instance check_completeness DynamicExpr where
	check_completeness { dyn_expr, dyn_opt_type } cci ccs
		= check_completeness dyn_expr cci
		  (check_completeness dyn_opt_type cci ccs)

instance check_completeness DynamicType where
	check_completeness { dt_type } cci ccs
		= check_completeness dt_type cci ccs

instance check_completeness Expression where
	check_completeness (Var _) cci ccs
		= ccs
	check_completeness (App app) cci ccs
		= check_completeness app cci ccs
	check_completeness (expression @ expressions) cci ccs
		= check_completeness expression cci
		  (check_completeness expressions cci ccs)
	check_completeness (Let lad) cci ccs
		= check_completeness lad cci ccs
	check_completeness (Case keesje) cci ccs
		= check_completeness keesje cci ccs
	check_completeness (Selection _ expression selections) cci ccs
		= check_completeness expression cci
		  (check_completeness selections cci ccs)
	check_completeness (TupleSelect _ _ expression) cci ccs
		= check_completeness expression cci ccs
	check_completeness (BasicExpr _ _) _ ccs
		= ccs
	check_completeness (AnyCodeExpr _ _ _) _ ccs
		= ccs
	check_completeness (ABCCodeExpr _ _) _ ccs
		= ccs
	check_completeness (MatchExpr _ constructor expression) cci ccs
		= check_completeness expression cci
		  (check_whether_ident_is_imported constructor.glob_object.ds_ident STE_Constructor cci ccs)
	check_completeness (FreeVar _) _ ccs
		= ccs
	check_completeness (DynamicExpr dynamicExpr) cci ccs
		= check_completeness dynamicExpr cci ccs
	check_completeness EE _ ccs
		= ccs
	check_completeness (Update expr1 selections expr2) cci ccs
		= ( (check_completeness expr1 cci)
		  o (check_completeness selections cci)
		  o (check_completeness expr2) cci
		  ) ccs
	check_completeness expr _ _
		= abort "explicitimports:check_completeness (Expression) does not match" <<- expr

instance check_completeness FunctionBody where
	check_completeness (CheckedBody body) cci ccs
		= check_completeness body cci ccs
	check_completeness (TransformedBody body) cci ccs
		= check_completeness body cci ccs
	check_completeness (RhsMacroBody body) cci ccs
		= check_completeness body cci ccs
			
instance check_completeness FunDef where
	check_completeness {fun_type, fun_body, fun_info} cci ccs
		= ( (check_completeness fun_type cci)
		  o (check_completeness fun_body cci)
		  o (foldSt (flipM check_completeness_of_dyn_expr_ptr cci) fun_info.fi_dynamics)
		  ) ccs

instance check_completeness FunType where
	check_completeness {ft_type} cci ccs
		= check_completeness ft_type cci ccs

instance check_completeness (Global x) | check_completeness x where
	check_completeness { glob_object } cci ccs
		= check_completeness glob_object cci ccs

instance check_completeness InstanceType where
	check_completeness {it_types, it_context} cci ccs
		= check_completeness it_types cci
		  (check_completeness it_context cci ccs)

instance check_completeness Let where
	check_completeness { let_strict_binds, let_lazy_binds, let_expr } cci ccs
  		= ( (check_completeness let_expr cci)
  		  o (check_completeness let_strict_binds cci)
  		  o (check_completeness let_lazy_binds cci)
  		  ) ccs

instance check_completeness MemberDef where
  	check_completeness {me_type} cci ccs 
  		= check_completeness me_type cci ccs

instance check_completeness (Optional x) | check_completeness x where
	check_completeness (Yes x) cci ccs
		= check_completeness x cci ccs
	check_completeness No _ ccs
		= ccs

instance check_completeness Selection where
	check_completeness (RecordSelection {glob_object,glob_module} _) cci ccs
		#! ({dcl_common}, ccs)	= ccs!box_ccs.ccs_dcl_modules.[glob_module]	// the selector's filed has to be looked up
		   ({sd_field}) = dcl_common.com_selector_defs.[glob_object.ds_index]
		= check_whether_ident_is_imported sd_field ste_field cci ccs
	check_completeness (ArraySelection _ _ index_expr) cci ccs
		= check_completeness index_expr cci ccs
	check_completeness (DictionarySelection _ selections _ index_expr) cci ccs
		= check_completeness selections cci
		  (check_completeness index_expr cci ccs)

instance check_completeness SelectorDef where
	check_completeness {sd_type} cci ccs
		= check_completeness sd_type cci ccs

instance check_completeness SymbIdent where
	check_completeness {symb_name, symb_kind} cci ccs
		= case symb_kind of
			SK_Constructor _
				-> check_whether_ident_is_imported symb_name STE_Constructor cci ccs
			SK_Function global_index
				-> check_completeness_for_function symb_name global_index ste_fun_or_macro cci ccs
630
631
			SK_LocalMacroFunction function_index
				-> check_completeness_for_local_macro_function symb_name function_index ste_fun_or_macro cci ccs
632
633
634
635
636
637
			SK_OverloadedFunction global_index
				-> check_completeness_for_function symb_name global_index STE_Member cci ccs
  			SK_Macro global_index
  				-> check_completeness_for_function symb_name global_index ste_fun_or_macro cci ccs
  	  where
		check_completeness_for_function symb_name {glob_object,glob_module} wanted_ste_kind cci ccs
638
			| glob_module<>cci.box_cci.cci_main_dcl_module_n
639
640
641
642
643
644
645
646
647
648
649
650
				// the function that is referred from within a macro is a DclFunction
				// -> must be global -> has to be imported
				= check_whether_ident_is_imported symb_name wanted_ste_kind cci ccs
			#! (fun_def, ccs)	= ccs!box_ccs.ccs_icl_functions.[glob_object]
			// otherwise the function was defined locally in a macro
			// it is not a consequence, but it's type and body are consequences !
			#! (already_visited, ccs) = ccs!box_ccs.ccs_set_of_visited_icl_funs.[glob_object]
			| already_visited
				= ccs
			#! ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[glob_object] = True }
			= check_completeness fun_def cci ccs

651
652
653
654
655
656
657
658
659
660
		check_completeness_for_local_macro_function symb_name glob_object wanted_ste_kind cci ccs
			#! (fun_def, ccs)	= ccs!box_ccs.ccs_icl_functions.[glob_object]
			// otherwise the function was defined locally in a macro
			// it is not a consequence, but it's type and body are consequences !
			#! (already_visited, ccs) = ccs!box_ccs.ccs_set_of_visited_icl_funs.[glob_object]
			| already_visited
				= ccs
			#! ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[glob_object] = True }
			= check_completeness fun_def cci ccs

661
662
663
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
699
700
instance check_completeness SymbolType where
	check_completeness {st_args, st_result, st_context} cci ccs
		= ( (check_completeness st_args cci)
		  o (check_completeness st_result cci)
		  o (check_completeness st_context cci)
		  ) ccs

instance check_completeness TransformedBody where
	check_completeness {tb_rhs} cci ccs
		= check_completeness tb_rhs cci ccs

instance check_completeness Type where
	check_completeness (TA {type_name} arguments) cci ccs
		= check_completeness arguments cci
		  (check_whether_ident_is_imported type_name STE_Type cci ccs)
	check_completeness (l --> r) cci ccs
		= check_completeness l cci
		  (check_completeness r cci ccs)
	check_completeness (_ :@: arguments) cci ccs
		= check_completeness arguments cci ccs
	check_completeness _ _ ccs
		= ccs

instance check_completeness TypeContext where
	check_completeness {tc_class, tc_types} cci ccs
		= check_completeness tc_types cci
		  (check_whether_ident_is_imported tc_class.glob_object.ds_ident STE_Class cci ccs)

instance check_completeness (TypeDef TypeRhs) where
	check_completeness {td_rhs, td_context}	cci ccs
		= check_completeness td_rhs cci 
		  (check_completeness td_context cci ccs)

instance check_completeness TypeRhs where
	check_completeness (SynType aType) cci ccs
		= check_completeness aType cci ccs
	check_completeness _ _ ccs
		= ccs

instance check_completeness [a]	| check_completeness a
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
701
  where
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
	check_completeness [] _ ccs
		= ccs
	check_completeness [h:t] cci ccs
		= check_completeness h cci
		  (check_completeness t cci ccs)

check_completeness_of_dyn_expr_ptr :: !ExprInfoPtr !CheckCompletenessInputBox !*CheckCompletenessStateBox
								-> *CheckCompletenessStateBox 
check_completeness_of_dyn_expr_ptr dyn_expr_ptr cci ccs=:{box_ccs=box_ccs=:{ccs_expr_heap}}
	#! (expr_info, ccs_expr_heap) = readPtr dyn_expr_ptr ccs_expr_heap
	   ccs = { ccs & box_ccs = { box_ccs & ccs_expr_heap = ccs_expr_heap }}
 	= case expr_info of
		(EI_Dynamic No)	
			-> ccs
		(EI_Dynamic (Yes dynamic_type))
			-> check_completeness dynamic_type cci ccs
		(EI_DynamicType dynamic_type further_dynamic_ptrs)
			-> check_completeness dynamic_type cci
			   (foldSt (flipM check_completeness_of_dyn_expr_ptr cci) further_dynamic_ptrs ccs)
		(EI_DynamicTypeWithVars _ dynamic_type further_dynamic_ptrs)
			-> check_completeness dynamic_type cci
			   (foldSt (flipM check_completeness_of_dyn_expr_ptr cci) further_dynamic_ptrs ccs)

flipM f a b :== f b a

// STE_Kinds just for comparision
ste_field =: STE_Field { id_name="", id_info=nilPtr }
ste_fun_or_macro =: STE_FunctionOrMacro []
730