convertimportedtypes.icl 14.5 KB
Newer Older
1
2
implementation module convertimportedtypes

3
import syntax, expand_types, utilities
4
from containers import inNumberSet
5

6
cDontRemoveAnnotations :== False
7

8
9
10
11
12
13
14
15
16
17
convertIclModule :: !Int !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
									 -> (!*{#{# CheckedTypeDef}},!ImportedConstructors,!*VarHeap,!*TypeHeaps)
convertIclModule main_dcl_module_n common_defs imported_types imported_conses var_heap type_heaps
	#! types_and_heaps = convertConstructorTypes common_defs.[main_dcl_module_n].com_cons_defs main_dcl_module_n common_defs (imported_types, imported_conses, var_heap, type_heaps)
	# (imported_types,imported_conses,var_heap,type_heaps)
		= convertSelectorTypes common_defs.[main_dcl_module_n].com_selector_defs main_dcl_module_n common_defs types_and_heaps
	# {com_class_defs,com_type_defs,com_cons_defs,com_selector_defs,com_member_defs} = common_defs.[main_dcl_module_n]
	= convert_member_types_of_module 0 com_class_defs com_type_defs com_cons_defs com_selector_defs com_member_defs main_dcl_module_n common_defs
											imported_types imported_conses var_heap type_heaps

18
convertDclModule :: !Int !{# DclModule} !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
19
													-> (!*{#{# CheckedTypeDef}},!ImportedConstructors,!*VarHeap,!*TypeHeaps)
20
convertDclModule main_dcl_module_n dcl_mods common_defs imported_types imported_conses var_heap type_heaps
21
22
23
24
25
26
27
28
29
30
	# {dcl_functions,dcl_common=dcl_common=:{com_type_defs,com_cons_defs,com_selector_defs},dcl_has_macro_conversions} = dcl_mods.[main_dcl_module_n]
	| dcl_has_macro_conversions
		#!(icl_type_defs, imported_types) = imported_types![main_dcl_module_n]
		  common_defs = { common \\ common <-: common_defs }
		  common_defs = { common_defs & [main_dcl_module_n] = dcl_common }
		  types_and_heaps = convert_dcl_functions dcl_functions common_defs ( { imported_types & [main_dcl_module_n] = com_type_defs }, imported_conses, var_heap, type_heaps)
		  types_and_heaps = convertConstructorTypes com_cons_defs main_dcl_module_n common_defs types_and_heaps
		  (imported_types, imported_conses, var_heap, type_heaps) = convertSelectorTypes com_selector_defs main_dcl_module_n common_defs types_and_heaps
		= ({ imported_types & [main_dcl_module_n] = icl_type_defs}, imported_conses, var_heap, type_heaps)
		= (imported_types, imported_conses, var_heap, type_heaps)
31
32
33
34
35
where
	convert_dcl_functions dcl_functions common_defs types_and_heaps
		= iFoldSt (convert_dcl_function dcl_functions common_defs) 0 (size dcl_functions) types_and_heaps

	convert_dcl_function dcl_functions common_defs dcl_index (imported_types, imported_conses, var_heap, type_heaps)
36
		#!{ft_type, ft_type_ptr, ft_ident} = dcl_functions.[dcl_index]
37
		  (ft_type, imported_types, imported_conses, type_heaps, var_heap)
38
		  	= convertSymbolType cDontRemoveAnnotations common_defs ft_type main_dcl_module_n imported_types imported_conses type_heaps var_heap
39
40
41
42
43
44
		= (imported_types, imported_conses, var_heap <:= (ft_type_ptr, VI_ExpandedType ft_type), type_heaps)

convertConstructorTypes cons_defs main_dcl_module_n common_defs types_and_heaps
	= iFoldSt (convert_constructor_type common_defs cons_defs) 0 (size cons_defs) types_and_heaps
where
	convert_constructor_type common_defs cons_defs cons_index (imported_types, imported_conses, var_heap, type_heaps)  
45
		#!{cons_type_ptr, cons_type, cons_ident} = cons_defs.[cons_index]
46
		  (cons_type, imported_types, imported_conses, type_heaps, var_heap)
47
				= convertSymbolType cDontRemoveAnnotations common_defs cons_type main_dcl_module_n imported_types imported_conses type_heaps var_heap
48
49
50
51
52
53
		= (imported_types, imported_conses, var_heap <:= (cons_type_ptr, VI_ExpandedType cons_type), type_heaps)

convertSelectorTypes selector_defs main_dcl_module_n common_defs types_and_heaps
	= iFoldSt (convert_selector_type common_defs selector_defs) 0 (size selector_defs) types_and_heaps
where
	convert_selector_type common_defs selector_defs sel_index (imported_types, imported_conses, var_heap, type_heaps)  
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
54
		#!{sd_type_ptr, sd_type, sd_ident} = selector_defs.[sel_index]
55
		  (sd_type, imported_types, imported_conses, type_heaps, var_heap)
56
				= convertSymbolType cDontRemoveAnnotations common_defs sd_type main_dcl_module_n imported_types imported_conses type_heaps var_heap
57
58
59
60
61
62
63
64
		  (sd_type_ptr_v,var_heap) = readPtr sd_type_ptr var_heap
		= case sd_type_ptr_v of
			VI_ExpandedMemberType expanded_member_type _
				# var_heap = writePtr sd_type_ptr (VI_ExpandedMemberType expanded_member_type (VI_ExpandedType sd_type)) var_heap
				-> (imported_types, imported_conses, var_heap, type_heaps)
			_
				# var_heap = writePtr sd_type_ptr (VI_ExpandedType sd_type) var_heap
				-> (imported_types, imported_conses, var_heap, type_heaps)
65

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
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
convertMemberTypes :: !Int !{#DclModule} !{#CommonDefs} !NumberSet !*{#{#CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
															   -> (!*{#{#CheckedTypeDef}},!ImportedConstructors,!*VarHeap,!*TypeHeaps)
convertMemberTypes main_dcl_module_n dcl_mods common_defs used_module_numbers imported_types imported_conses var_heap type_heaps
	= convert_member_types 0 main_dcl_module_n dcl_mods common_defs used_module_numbers imported_types imported_conses var_heap type_heaps

convert_member_types module_i main_dcl_module_n dcl_mods common_defs used_module_numbers imported_types imported_conses var_heap type_heaps
	| module_i==size dcl_mods
		= (imported_types,imported_conses,var_heap,type_heaps)
	| inNumberSet module_i used_module_numbers
		# {dcl_common={com_class_defs,com_type_defs,com_cons_defs,com_selector_defs,com_member_defs}} = dcl_mods.[module_i]
		# (imported_types,imported_conses,var_heap,type_heaps)
			= convert_member_types_of_module 0 com_class_defs com_type_defs com_cons_defs com_selector_defs com_member_defs main_dcl_module_n common_defs
												imported_types imported_conses var_heap type_heaps
		= convert_member_types (module_i+1) main_dcl_module_n dcl_mods common_defs used_module_numbers imported_types imported_conses var_heap type_heaps
		= convert_member_types (module_i+1) main_dcl_module_n dcl_mods common_defs used_module_numbers imported_types imported_conses var_heap type_heaps

convert_member_types_of_module :: !Int !{#ClassDef} !{#CheckedTypeDef} !{#ConsDef} !{#SelectorDef} !{#MemberDef} !Int !{#CommonDefs}
										!*{#{#CheckedTypeDef}} ![Global Int] !*VarHeap !*TypeHeaps
									-> (!*{#{#CheckedTypeDef}},![Global Int],!*VarHeap,!*TypeHeaps)
convert_member_types_of_module class_i class_defs type_defs cons_defs selector_defs member_defs main_dcl_module_n common_defs
								imported_types imported_conses var_heap type_heaps
	| class_i==size class_defs
		= (imported_types,imported_conses,var_heap,type_heaps)
		# {class_dictionary,class_members} = class_defs.[class_i]
		  {td_rhs=RecordType {rt_constructor,rt_fields}} = type_defs.[class_dictionary.ds_index]
		  {cons_ident,cons_type_ptr} = cons_defs.[rt_constructor.ds_index]
		  (cons_type_ptr_v,var_heap) = readPtr cons_type_ptr var_heap
		| case cons_type_ptr_v of VI_Used -> True; VI_ExpandedType _  -> True; _ -> False;
			# (imported_types,imported_conses,var_heap,type_heaps)
				= convert_member_types_of_class 0 class_members rt_fields selector_defs member_defs main_dcl_module_n common_defs
												imported_types imported_conses var_heap type_heaps
			= convert_member_types_of_module (class_i+1) class_defs type_defs cons_defs selector_defs member_defs main_dcl_module_n common_defs
												imported_types imported_conses var_heap type_heaps
			= convert_member_types_of_module (class_i+1) class_defs type_defs cons_defs selector_defs member_defs main_dcl_module_n common_defs
												imported_types imported_conses var_heap type_heaps

convert_member_types_of_class :: !Int !{#DefinedSymbol} !{#FieldSymbol} !{#SelectorDef} !{#MemberDef} !Int !{#CommonDefs}
										!*{#{#CheckedTypeDef}} ![Global Int] !*VarHeap !*TypeHeaps
									-> (!*{#{#CheckedTypeDef}},![Global Int],!*VarHeap,!*TypeHeaps)
convert_member_types_of_class i class_members rt_fields selector_defs member_defs main_dcl_module_n common_defs
								imported_types imported_conses var_heap type_heaps
	| i<size class_members
		# class_member_index = class_members.[i].ds_index
		  {fs_ident,fs_index} = rt_fields.[i]
		  {me_ident,me_type} = member_defs.[class_member_index]
		  {sd_ident,sd_type_ptr} = selector_defs.[fs_index]
		  (sd_type_ptr_v,var_heap) = readPtr sd_type_ptr var_heap
		= case sd_type_ptr_v of
			VI_ExpandedMemberType _ _
				-> convert_member_types_of_class (i+1) class_members rt_fields selector_defs member_defs main_dcl_module_n common_defs
														imported_types imported_conses var_heap type_heaps
			VI_ExpandedType _
				# (converted_me_type, imported_types,imported_conses,type_heaps,var_heap)
					= convertSymbolType cDontRemoveAnnotations common_defs me_type main_dcl_module_n
										imported_types imported_conses type_heaps var_heap
				  var_heap = writePtr sd_type_ptr (VI_ExpandedMemberType converted_me_type sd_type_ptr_v) var_heap
				-> convert_member_types_of_class (i+1) class_members rt_fields selector_defs member_defs main_dcl_module_n common_defs
														imported_types imported_conses var_heap type_heaps
			_
				# (converted_me_type, imported_types,imported_conses,type_heaps,var_heap)
					= convertSymbolType cDontRemoveAnnotations common_defs me_type main_dcl_module_n imported_types imported_conses type_heaps var_heap
				  var_heap = writePtr sd_type_ptr (VI_ExpandedMemberType converted_me_type VI_Empty) var_heap
				-> convert_member_types_of_class (i+1) class_members rt_fields selector_defs member_defs main_dcl_module_n common_defs
														imported_types imported_conses var_heap type_heaps
		= (imported_types,imported_conses,var_heap,type_heaps)
131
132
133
134

convertImportedTypeSpecifications :: !Int !{# DclModule}  !{# {# FunType} } !{# CommonDefs} !ImportedConstructors !ImportedFunctions
	!*{# {#CheckedTypeDef}} !*TypeHeaps !*VarHeap -> (!*{#{#CheckedTypeDef}}, !*TypeHeaps, !*VarHeap)
convertImportedTypeSpecifications main_dcl_module_n dcl_mods dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap
135
136
137
138
139
140
141
142
143
144
145
146
	# {dcl_common={com_type_defs},dcl_has_macro_conversions} = dcl_mods.[main_dcl_module_n]
	| dcl_has_macro_conversions
		# abstract_type_indexes = iFoldSt (determine_abstract_type com_type_defs) 0 (size com_type_defs) []
		| isEmpty abstract_type_indexes
			= convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap
			#!(icl_type_defs, imported_types) = imported_types![main_dcl_module_n]
			  type_defs = foldSt insert_abstract_type abstract_type_indexes { icl_type_def \\ icl_type_def <-: icl_type_defs }
			  (imported_types, type_heaps, var_heap)
			  		= convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions
						{ imported_types & [main_dcl_module_n] = type_defs } type_heaps var_heap
			= ({ imported_types & [main_dcl_module_n] = icl_type_defs }, type_heaps, var_heap)
		= convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap
147
148
149
150
151
152
153
154
155
where
	determine_abstract_type dcl_type_defs type_index abstract_type_indexes
		# {td_rhs} = dcl_type_defs.[type_index]
		= case td_rhs of
			AbstractType _
				-> [type_index : abstract_type_indexes]
			_
				-> abstract_type_indexes
					
156
	insert_abstract_type type_index type_defs
157
158
		# icl_index=type_index
		# (type_def, type_defs) = type_defs![icl_index]
159
160
161
162
163
164
165
166
		= { type_defs & [icl_index] = { type_def & td_rhs = AbstractType cAllBitsClear }}

	convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap
		# (imported_types, imported_conses, type_heaps, var_heap)
				= foldSt (convert_imported_function dcl_functions common_defs) imported_functions (imported_types, imported_conses, type_heaps, var_heap)
		= convert_imported_constructors common_defs imported_conses imported_types type_heaps var_heap

	convert_imported_function dcl_functions common_defs {glob_object,glob_module} (imported_types, imported_conses, type_heaps, var_heap)
167
		#!{ft_type_ptr,ft_type,ft_ident} = dcl_functions.[glob_module].[glob_object]
168
		  (ft_type, imported_types, imported_conses, type_heaps, var_heap)
169
				= convertSymbolType cDontRemoveAnnotations common_defs ft_type main_dcl_module_n imported_types imported_conses type_heaps var_heap
170
		= (imported_types, imported_conses, type_heaps, var_heap <:= (ft_type_ptr, VI_ExpandedType ft_type))
171
			
172
173
174
	convert_imported_constructors common_defs [] imported_types type_heaps var_heap
		= (imported_types, type_heaps, var_heap)
	convert_imported_constructors common_defs [ {glob_module, glob_object} : conses ] imported_types type_heaps var_heap 
175
		#!{com_cons_defs,com_selector_defs} = common_defs.[glob_module]
176
		  {cons_type_ptr,cons_type,cons_type_index,cons_ident} = common_defs.[glob_module].com_cons_defs.[glob_object]
177
		  (cons_type, imported_types, conses, type_heaps, var_heap)
178
		  		= convertSymbolType cDontRemoveAnnotations common_defs cons_type main_dcl_module_n imported_types conses type_heaps var_heap
179
180
		  var_heap = var_heap <:= (cons_type_ptr, VI_ExpandedType cons_type)
		  ({td_rhs}, imported_types) = imported_types![glob_module].[cons_type_index]
181
				//---> ("convert_imported_constructors", cons_ident, cons_type)
182
183
184
185
186
187
188
189
190
191
		= case td_rhs of
			RecordType {rt_fields}
				# (imported_types, conses, type_heaps, var_heap)
						= iFoldSt (convert_type_of_imported_field glob_module com_selector_defs rt_fields) 0 (size rt_fields)
							(imported_types, conses, type_heaps, var_heap)
				-> convert_imported_constructors common_defs conses imported_types type_heaps var_heap
			_
				-> convert_imported_constructors common_defs conses imported_types type_heaps var_heap
		where
			convert_type_of_imported_field module_index selector_defs fields field_index (imported_types, conses, type_heaps, var_heap)
192
				#!field_index = fields.[field_index].fs_index
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
193
				  {sd_type_ptr,sd_type,sd_ident} = selector_defs.[field_index]
194
				  (sd_type, imported_types, conses, type_heaps, var_heap)
195
				  		= convertSymbolType cDontRemoveAnnotations common_defs sd_type main_dcl_module_n imported_types conses type_heaps var_heap
196
197
198
199
200
201
202
203
				  (sd_type_ptr_v,var_heap) = readPtr sd_type_ptr var_heap
				= case sd_type_ptr_v of
					VI_ExpandedMemberType expanded_member_type _
						# var_heap = writePtr sd_type_ptr (VI_ExpandedMemberType expanded_member_type (VI_ExpandedType sd_type)) var_heap
						-> (imported_types, conses, type_heaps, var_heap)
					_
						# var_heap = writePtr sd_type_ptr (VI_ExpandedType sd_type) var_heap
						-> (imported_types, conses, type_heaps, var_heap)