explicitimports.icl 33.8 KB
Newer Older
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1
2
3
4
5
6
implementation module explicitimports

import StdEnv

import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, RWSDebug

7
8
9
possiblyFilterExplImportedDecls :: ![ImportDeclaration] u:[w:(.Index,y:Declarations)] Position u0:{#DclModule} !*CheckState
				-> (!v:[x:(Index,z:Declarations)],!u0:{#DclModule},!.CheckState), [y <= z, w <= x, u <= v]
possiblyFilterExplImportedDecls [] decls_of_imported_module _ modules cs // implicit import
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
10
	= (decls_of_imported_module, modules, cs)
11
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
12
	// explicit import
13
14
15
16
17
18
19
20
21
22
	# 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)
	  (imported_decls, wanted_symbols, modules, cs=:{cs_error, cs_symbol_table})
	  		= foldSt (filter_decls_per_module import_statement_pos) decls_of_imported_module
	  					([], wanted_symbols, modules, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table })
	  cs = { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }
	  cs = foldSt (switch_import_syntax restore_symbol_table_old_syntax restore_symbol_table) wanted_symbols cs
	  cs = { cs & cs_error = popErrorAdmin cs.cs_error }
	= (imported_decls, modules, cs)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
23
  where
24
25
26
	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
27
	  where
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
		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
49
	  where
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
		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
80
	
81
82
83
84
85
86
87
88
89
90
91
92
	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
93
	  where
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
		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
			
	filter_decls_per_module import_statement_pos (mod_index, {dcls_import, dcls_local}) (imported_decls_per_module, wanted_symbols, modules, cs)
		# (dcls_import, (wanted_symbols, modules, cs))
				= iMapFilterYesSt (i_filter_possibly_imported_decl mod_index dcls_import)
						0 (size dcls_import) (wanted_symbols, modules, cs)
		  (dcls_local, (wanted_symbols, modules, cs))
		  		= mapFilterYesSt (filter_possibly_imported_decl mod_index) dcls_local (wanted_symbols, modules, cs)
		  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
			],
			wanted_symbols, modules, cs)

	i_filter_possibly_imported_decl mod_index dcls_import i state
		= filter_possibly_imported_decl mod_index dcls_import.[i] state
		
	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

//	filter_decl :: !Int !Declaration !STE_Kind !(!v:[Ident],!u:{#DclModule},!*CheckState)
//			-> (!Optional Declaration,!(!w:[Ident],!u:{#DclModule},!.CheckState)), [v<=w]
	filter_decl mod_index decl (STE_Instance class_ident) state
		// this alternative is only for old syntax
		| switch_import_syntax True False
			= filter_instance_decl mod_index decl class_ident state
	filter_decl mod_index decl=:{dcl_ident={id_info}} dcl_kind (wanted_symbols_accu, modules, cs=:{cs_symbol_table})
		# (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
		  cs = { cs & cs_symbol_table = cs_symbol_table }
		= case ste_kind of
			STE_ExplImp _ opt_import_declaration ste_kind_2 _
				// the symbol is wanted (see above).
				# cs_symbol_table 
						= writePtr id_info { ste & ste_kind = STE_ExplImp True opt_import_declaration ste_kind_2 False}
									cs.cs_symbol_table //--->("setting True", decl.dcl_ident)
						// mark this symbol as being succesfully imported
				  cs = { cs & cs_symbol_table = cs_symbol_table}
		  		-> case opt_import_declaration of
					No	-> (Yes decl, (wanted_symbols_accu, modules, cs))
					Yes import_declaration
						# cs = switch_import_syntax (mark_partners import_declaration cs) cs
						-> (Yes decl, add_bracketed_symbols_to_symbol_table import_declaration decl dcl_kind mod_index
												 (wanted_symbols_accu, modules, cs))
			_	-> (No, (wanted_symbols_accu, modules, cs))

	// only for old syntax
	filter_instance_decl mod_index decl=:{dcl_index} class_ident
							(wanted_symbols_accu, modules, cs=:{cs_symbol_table})
		# (ste=:{ste_kind}, cs_symbol_table) = readPtr class_ident.id_info cs_symbol_table
		  cs = { cs & cs_symbol_table = cs_symbol_table }
		= case ste_kind of
			STE_ExplImp _ _ _ _
				-> (Yes decl, (wanted_symbols_accu, modules, cs))
			_	-> (No, (wanted_symbols_accu, modules, cs))

	// only for old syntax
	mark_partners (ID_OldSyntax partners) cs=:{cs_symbol_table}
		# cs_symbol_table = foldSt mark_partner partners cs_symbol_table
		= { cs & cs_symbol_table = cs_symbol_table }
	  where
		mark_partner {id_info} cs_symbol_table
			# (ste=:{ste_kind=STE_ExplImp _ a b c}, cs_symbol_table) = readPtr id_info cs_symbol_table
			= writePtr id_info { ste & ste_kind = STE_ExplImp True a b c } cs_symbol_table
		
	add_bracketed_symbols_to_symbol_table import_declaration decl dcl_kind mod_index
										(wanted_symbols_accu, modules, cs)
		# (opt_bracket_info, modules, cs=:{cs_symbol_table})
				= (switch_import_syntax get_opt_bracket_info_old_syntax get_opt_bracket_info)
					import_declaration decl dcl_kind mod_index modules cs
		| isNo opt_bracket_info
			= (wanted_symbols_accu, modules, { cs & cs_symbol_table = cs_symbol_table })
		# (Yes (all_bracket_ids, wanted_bracket_ids, structure_name, ste_kind)) 
				= opt_bracket_info
		  all_bracket_ids_are_wanted
		  		= isEmpty wanted_bracket_ids
		  cs_symbol_table
				= foldSt (add_bracket_symbol_to_symbol_table ste_kind all_bracket_ids_are_wanted) all_bracket_ids
																  cs_symbol_table
		  cs = { cs & cs_symbol_table = cs_symbol_table }
		| all_bracket_ids_are_wanted
			// "import class C (..)" or "import :: T (..)" or "import :: T {..}" 
			= (all_bracket_ids++wanted_symbols_accu, modules, cs)
		// "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
		# cs = foldSt (check_wanted_idents structure_name) wanted_bracket_ids cs
		  cs_symbol_table = foldSt overwrite_wanted_idents wanted_bracket_ids cs.cs_symbol_table
		  (wanted_symbols_accu, cs_symbol_table)
		  		= foldSt remove_and_collect all_bracket_ids (wanted_symbols_accu, cs_symbol_table)
		= (wanted_symbols_accu, modules, { cs & cs_symbol_table = cs_symbol_table })
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
210
	  where
211
212
	  	isNo No = True
	  	isNo _  = False
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
213

214
215
	add_bracketed_symbols_to_symbol_table _ _ _ mod_index states
		= states
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
216
	
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
	get_opt_bracket_info (ID_Class _ (Yes wanted_members)) {dcl_kind, dcl_index} mod_index modules cs=:{cs_symbol_table}
		# (dcl_module, module_entry, modules, cs_symbol_table)
				= get_module_and_entry dcl_kind mod_index modules cs_symbol_table
		  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 ]
		= (Yes (all_member_idents, wanted_members, class_def.class_name, STE_Member),
			modules, { cs & cs_symbol_table = cs_symbol_table })
	get_opt_bracket_info (ID_Type ii (Yes wanted_constructors)) {dcl_kind, dcl_index} mod_index modules cs=:{cs_symbol_table}
		# (dcl_module, module_entry, modules, cs_symbol_table)
				= get_module_and_entry dcl_kind mod_index modules cs_symbol_table
		  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)
			# cs = { cs & cs_error = checkError ii.ii_ident "is not an algebraic type" cs.cs_error,
							cs_symbol_table = cs_symbol_table }
			= (No, modules, cs)
		# (AlgType constructors) = type_def.td_rhs
		  all_constructor_idents = [ ds_ident \\ {ds_ident} <- constructors ]
		  cs = { cs & cs_symbol_table = cs_symbol_table }
		= (Yes (all_constructor_idents, wanted_constructors, type_def.td_name, STE_Constructor), modules, cs)
	  where
		isAlgType (AlgType _) = True
		isAlgType _ = False
	get_opt_bracket_info (ID_Record ii (Yes wanted_fields)) {dcl_kind, dcl_index} mod_index modules cs=:{cs_symbol_table}
		# (dcl_module, module_entry, modules, cs_symbol_table)
				= get_module_and_entry dcl_kind mod_index modules cs_symbol_table
		  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)
			# cs = { cs & cs_error = checkError ii.ii_ident "is not a record type" cs.cs_error,
							cs_symbol_table = cs_symbol_table }
			= (No, modules, cs)
		# (RecordType {rt_fields}) = type_def.td_rhs
		  all_field_idents = [ fs_name \\ {fs_name} <-: rt_fields ]
		  cs = { cs & cs_symbol_table = cs_symbol_table }
		= (Yes (all_field_idents, wanted_fields, type_def.td_name, STE_Field (hd all_field_idents)), modules, cs)
	  where
		isRecordType (RecordType _) = True
		isRecordType _ = False
	get_opt_bracket_info _ _ _ modules cs
		= (No, modules, cs)

	// this function is only for old syntax
	get_opt_bracket_info_old_syntax _ {dcl_index} STE_Class mod_index modules cs=:{cs_symbol_table}
		# (dcl_module, module_entry, modules, cs_symbol_table)
				= get_module_and_entry STE_Class mod_index modules cs_symbol_table
		  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 ]
		  (all_member_idents_2, cs_symbol_table)
		  		= foldSt filter_member all_member_idents ([], cs_symbol_table)
		= (Yes (all_member_idents_2, [], class_def.class_name, STE_Member),
			modules, { cs & cs_symbol_table = cs_symbol_table })
	get_opt_bracket_info_old_syntax _ {dcl_index} STE_Type mod_index modules cs=:{cs_symbol_table}
		# (dcl_module, module_entry, modules, cs_symbol_table)
				= get_module_and_entry STE_Type mod_index modules cs_symbol_table
		  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]
		  cs = { cs & cs_symbol_table = cs_symbol_table }
		= case type_def.td_rhs of
			RecordType {rt_fields}
				# all_field_idents = [ fs_name \\ {fs_name} <-: rt_fields ]
				-> (Yes (all_field_idents, [], type_def.td_name, STE_Field (hd all_field_idents)), modules, cs)
			_	-> (No, modules, cs)
	get_opt_bracket_info_old_syntax _ _ _ _ modules cs
		= (No, modules, cs)
299
	
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
329
330
331
332
333
334
335
336
337
338
339
340
341
	// only for old syntax
	filter_member member_id=:{id_info} (accu, cs_symbol_table)
		// 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
		# ({ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
		= case ste_kind of
			STE_ExplImp _ _ _ _
				-> (accu, cs_symbol_table)
			_	-> ([member_id:accu], cs_symbol_table)
			
	get_module_and_entry dcl_kind mod_index modules cs_symbol_table
		# 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
		  (dcl_module=:{dcl_name=dcl_name=:{id_info}}, modules) = modules![index_mod_with_def]
		  (module_entry, cs_symbol_table) = readPtr id_info cs_symbol_table
		= (dcl_module, module_entry, modules, cs_symbol_table)

	check_wanted_idents structure_name {ii_ident=ii_ident=:{id_info}} cs=:{cs_symbol_table}
		# (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
		  cs = { cs & cs_symbol_table = cs_symbol_table }
		= case ste_kind of
			STE_ExplImp a b _ True
				-> cs 
			_	-> { cs & cs_error = checkError ii_ident ("does not belong to "+++toString structure_name) cs.cs_error}

	overwrite_wanted_idents {ii_ident={id_info}} cs_symbol_table
		# (ste=:{ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
		= case ste_kind of
			STE_ExplImp a b c _
				-> writePtr id_info { ste & ste_kind = STE_ExplImp a b c False } cs_symbol_table
			STE_Empty
				-> cs_symbol_table
		
	remove_and_collect ident=:{id_info} (wanted_symbols_accu, cs_symbol_table)
		# (ste=:{ste_kind=STE_ExplImp _ _ _ is_unwanted}, cs_symbol_table) = readPtr id_info cs_symbol_table
		| is_unwanted
			= (wanted_symbols_accu, writePtr id_info { ste & ste_kind = STE_Empty } cs_symbol_table)
		= ([ident:wanted_symbols_accu], cs_symbol_table)
342

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
343

344
345
346
347
348
349
350
351
352
:: 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]
	}
353

354
355
356
:: *CheckCompletenessStateBox = { box_ccs :: !*CheckCompletenessState }

:: CheckCompletenessInput =
357
358
	{	cci_import_position		:: !Position
	,	cci_main_dcl_module_n	:: !Int
359
	}
360

361
362
:: CheckCompletenessInputBox = { box_cci :: !CheckCompletenessInput }

363
checkExplicitImportCompleteness :: !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState 
364
				-> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState)
365
checkExplicitImportCompleteness main_dcl_module_n dcls_explicit dcl_modules icl_functions expr_heap 
366
367
368
369
370
371
								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 = [] }
372
	   ccs = foldSt checkCompleteness dcls_explicit { box_ccs = box_ccs }
373
374
375
376
377
378
	   { 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)
379
  where
380
381
382
383
384
385
	checkCompleteness :: !ExplicitImport *CheckCompletenessStateBox -> *CheckCompletenessStateBox
	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 
386
		#! ({dcl_common,dcl_functions}, ccs) = ccs!box_ccs.ccs_dcl_modules.[mod_index]
387
		   cci = { box_cci = { cci_import_position = import_position, cci_main_dcl_module_n=main_dcl_module_n }}
388
389
390
391
392
393
		= case expl_imp_kind of
			STE_Type			-> check_completeness dcl_common.com_type_defs.[dcl_index] cci ccs
			STE_Constructor		-> check_completeness dcl_common.com_cons_defs.[dcl_index] cci ccs
			(STE_Field _)		-> check_completeness dcl_common.com_selector_defs.[dcl_index] cci ccs
			STE_Class			-> check_completeness dcl_common.com_class_defs.[dcl_index] cci ccs
			STE_Member			-> check_completeness dcl_common.com_member_defs.[dcl_index] cci ccs
394
			(STE_Instance _)	-> check_completeness dcl_common.com_instance_defs.[dcl_index] cci ccs
395
			STE_DclFunction		-> check_completeness dcl_functions.[dcl_index] cci ccs
396

397
398
	checkCompletenessOfMacro :: !Ident !Index !Int !Position *CheckCompletenessStateBox -> *CheckCompletenessStateBox
	checkCompletenessOfMacro dcl_ident dcl_index main_dcl_module_n import_position ccs
399
400
		#! ({fun_body}, ccs) = ccs!box_ccs.ccs_icl_functions.[dcl_index]
		   ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[dcl_index] = True }
401
		   cci = { box_cci = { cci_import_position = import_position, cci_main_dcl_module_n=main_dcl_module_n }}
402
403
404
405
406
407
		= 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
408

409
410
411
412
413
414
415
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"
416
	toString (STE_Instance _)			= "instance"
417
418
419
420
421
422
423
424
425

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
426
427
428
	   {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
429
430
431
432
	   // 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
433
  where
434
435
436
437
	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
438

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

441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
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

459
460
461
instance check_completeness LetBind where
	check_completeness {lb_src} cci ccs
		= check_completeness lb_src cci ccs
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479

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

480
481
482
483
instance check_completeness CheckedAlternative where
	check_completeness {ca_rhs} cci ccs
		= check_completeness ca_rhs cci ccs

484
485
486
487
488
489
490
491
492
493
494
495
496
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
497
  where
498
499
	check_completeness {cons_type} cci ccs
		= check_completeness cons_type cci ccs
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
500

501
502
503
504
505
506
507
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
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
622
623
			SK_LocalMacroFunction function_index
				-> check_completeness_for_local_macro_function symb_name function_index ste_fun_or_macro cci ccs
624
625
626
627
628
629
			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
630
			| glob_module<>cci.box_cci.cci_main_dcl_module_n
631
632
633
634
635
636
637
638
639
640
641
642
				// 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

643
644
645
646
647
648
649
650
651
652
		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

653
654
655
656
657
658
659
660
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
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
693
  where
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
	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 []