predef.icl 31.6 KB
Newer Older
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1
2
implementation module predef

3
import syntax, hashtable
Artem Alimarine's avatar
Artem Alimarine committed
4

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
5
(<<=) infixl
6
7
8
(<<=) symbol_table val
	:==	let (predefined_idents, index) = val
	  	in writePtr predefined_idents.[index].id_info EmptySymbolTableEntry symbol_table
9

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
10
(<<-) infixl
11
12
13
14
(<<-) hash_table val
	:== let (predefined_idents, table_kind, index) = val
		in putPredefinedIdentInHashTable predefined_idents.[index] table_kind hash_table

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
15
16
17
GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
predefined_idents :: {!Ident}
predefined_idents
	# idents = createArray PD_NrOfPredefSymbols {id_name="",id_info=nilPtr}
	# idents = { idents &
					[PD_ConsSymbol] = i PD_ConsSymbol_String,
					[PD_StrictConsSymbol] = i "_!Cons",
					[PD_UnboxedConsSymbol] = i "_#Cons",
					[PD_TailStrictConsSymbol] = i "_Cons!",
					[PD_StrictTailStrictConsSymbol] = i "_!Cons!",
					[PD_UnboxedTailStrictConsSymbol] = i "_#Cons!",
					[PD_OverloadedConsSymbol] = i "_|Cons",
					[PD_NilSymbol] = i PD_NilSymbol_String,
					[PD_StrictNilSymbol] = i "_!Nil",
					[PD_UnboxedNilSymbol] = i "_#Nil",
					[PD_TailStrictNilSymbol] = 	i "_Nil!",
					[PD_StrictTailStrictNilSymbol] = i "_!Nil!",
					[PD_UnboxedTailStrictNilSymbol] = i "_#Nil!",
					[PD_OverloadedNilSymbol] = i "_|Nil",
36
37
38
39
					[PD_JustSymbol] = i "_Just",
					[PD_StrictJustSymbol] = i "_!Just",
					[PD_UnboxedJustSymbol] = i "_#Just",
					[PD_OverloadedJustSymbol] = i "_|Just",
40
41
42
43
					[PD_NoneSymbol] = i "_None",
					[PD_StrictNoneSymbol] = i "_!None",
					[PD_UnboxedNoneSymbol] = i "_#None",
					[PD_OverloadedNoneSymbol] = i "_|None",
John van Groningen's avatar
John van Groningen committed
44
45
					[PD_UnitConsSymbol] = i "_Unit",

46
47
48
49
50
51
52
53
54
55
56
57
					[PD_PredefinedModule] = i "_predefined",
					[PD_StringType] = i "_String",
					[PD_ListType] = i PD_ListType_String,
					[PD_StrictListType] = i "_!List",
					[PD_UnboxedListType] = i "_#List",
					[PD_TailStrictListType] = i "_List!",
					[PD_StrictTailStrictListType] = i "_!List!",
					[PD_UnboxedTailStrictListType] = i "_#List!",
					[PD_OverloadedListType] = i "_|List",
					[PD_LazyArrayType] = i "_Array",
					[PD_StrictArrayType] = i "_!Array",
					[PD_UnboxedArrayType] = i PD_UnboxedArray_String,
58
					[PD_PackedArrayType] = i "_32#Array",
59
60
61
62
					[PD_MaybeType] = i "_Maybe",
					[PD_StrictMaybeType] = i "_!Maybe",
					[PD_UnboxedMaybeType] = i "_#Maybe",
					[PD_OverloadedMaybeType] = i "_|Maybe",
John van Groningen's avatar
John van Groningen committed
63
					[PD_UnitType] = i "_Unit",
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
					[PD_TypeCodeMember] = i "_type_code",
					[PD_DummyForStrictAliasFun] = i "_dummyForStrictAlias"
				}
	# idents = build_tuples 2 32 idents
	# idents = build_variables 0 32 idents
	
	# idents = { idents &
					[PD_StdArray] = i "_SystemArray",
					[PD_StdEnum] = i "StdEnum",
					[PD_StdBool] = i "StdBool",
					[PD_AndOp] = i "&&",
					[PD_OrOp] = i "||",
					[PD_ArrayClass] = i "Array",
					[PD_CreateArrayFun] = i "createArray",
					[PD__CreateArrayFun] = i "_createArray",
					[PD_ArraySelectFun] = i "select",
					[PD_UnqArraySelectFun] = i "uselect",
					[PD_ArrayUpdateFun] = i "update",
					[PD_ArrayReplaceFun] = i "replace",
					[PD_ArraySizeFun] = i "size",
					[PD_UnqArraySizeFun] = i "usize",
85

86
87
88
89
					[PD_StdStrictLists] = i "_SystemStrictLists",
					[PD_cons] = i "_cons",
					[PD_decons] = i "_decons",
					[PD_nil] = i "_nil",
90

91
92
93
					[PD_cons_u] = i "_cons_u",
					[PD_decons_u] = i "_decons_u",
					[PD_nil_u] = i "_nil_u",
94

95
96
97
98
					[PD_cons_uts] = i "_cons_uts",
					[PD_decons_uts] = i "_decons_uts",
					[PD_nil_uts] = i "_nil_uts",

99
100
101
					[PD_ListClass] = i "List",
					[PD_UListClass] = i "UList",
					[PD_UTSListClass] = i "UTSList",
102
103
104
105
106
107
108
109

					[PD_StdStrictMaybes] = i "_SystemStrictMaybes",

					[PD_just] = i "_cJust",
					[PD_from_just] = i "_eJust",
					[PD_just_u] = i "_cJust_u",
					[PD_from_just_u] = i "_eJust_u",

110
111
					[PD_none] = i "_none",
					[PD_none_u] = i "_none_u",
112
113
114
115

					[PD_MaybeClass] = i "Maybe",
					[PD_UMaybeClass] = i "UMaybe",

116
117
118
119
120
121
122
123
124
125
126
127
					[PD_SmallerFun] = i "<",
					[PD_LessOrEqualFun] = i "<=",
					[PD_IncFun] = i "inc",
					[PD_SubFun] = i "-",
				
					[PD_From] = i "_from",
					[PD_FromThen] = i "_from_then",
					[PD_FromTo] = i "_from_to",
					[PD_FromThenTo] = i "_from_then_to",
					
					[PD_TypeCodeClass] = i "TC",
					[PD_StdDynamic] = i UnderscoreSystemDynamicModule_String,
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
128
129
					[PD_Dyn_DynamicTemp] = i DynamicRepresentation_String,

130
					[PD_Dyn_TypeCode] = i "TypeCode",
131
					[PD_Dyn_UnificationEnvironment] = i "_UnificationEnvironment",
132
133
134
135
					[PD_Dyn_TypeScheme] = i "TypeScheme",
					[PD_Dyn_TypeApp] = i "TypeApp",
					[PD_Dyn_TypeVar] = i "TypeVar",
					[PD_Dyn_TypeCons] = i "TypeCons",
136
137
					[PD_Dyn_TypeUnique] = i "TypeUnique",
					[PD_Dyn__TypeFixedVar] = i "_TypeFixedVar",
138
					[PD_Dyn_initial_unification_environment] = i "_initial_unification_environment",
139
					[PD_Dyn_bind_global_type_pattern_var_n] = i "_bind_global_type_pattern_var_n",
140
					[PD_Dyn_unify] = i "_unify",
141
					[PD_Dyn_unify_] = i "_unify_",
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
142
					[PD_Dyn_normalise] = i "_normalise",
143

144
					[PD_Dyn__to_TypeCodeConstructor] = i "_to_TypeCodeConstructor",
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
					[PD_TypeCodeConstructor] = i "TypeCodeConstructor",

					[PD_TC_Int] = i "TC_Int",
					[PD_TC_Char] = i "TC_Char",
					[PD_TC_Real] = i "TC_Real",
					[PD_TC_Bool] = i "TC_Bool",
					[PD_TC_Dynamic] = i "TC_Dynamic",
					[PD_TC_File] = i "TC_File",
					[PD_TC_World] = i "TC_World",

					[PD_TC__Arrow] = i "TC__Arrow",

					[PD_TC__List] = i "TC__List",
					[PD_TC__StrictList] = i "TC__StrictList",
					[PD_TC__UnboxedList] = i "TC__UnboxedList",
					[PD_TC__TailStrictList] = i "TC__TailStrictList",
					[PD_TC__StrictTailStrictList] = i "TC__StrictTailStrictList",
					[PD_TC__UnboxedTailStrictList] = i "TC__UnboxedTailStrictList",

					[PD_TC__Tuple2] = i "TC__Tuple2",
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
					[PD_TC__Tuple2+1] = i "TC__Tuple3",
					[PD_TC__Tuple2+2] = i "TC__Tuple4",
					[PD_TC__Tuple2+3] = i "TC__Tuple5",
					[PD_TC__Tuple2+4] = i "TC__Tuple6",
					[PD_TC__Tuple2+5] = i "TC__Tuple7",
					[PD_TC__Tuple2+6] = i "TC__Tuple8",
					[PD_TC__Tuple2+7] = i "TC__Tuple9",
					[PD_TC__Tuple2+8] = i "TC__Tuple10",
					[PD_TC__Tuple2+9] = i "TC__Tuple11",
					[PD_TC__Tuple2+10] = i "TC__Tuple12",
					[PD_TC__Tuple2+11] = i "TC__Tuple13",
					[PD_TC__Tuple2+12] = i "TC__Tuple14",
					[PD_TC__Tuple2+13] = i "TC__Tuple15",
					[PD_TC__Tuple2+14] = i "TC__Tuple16",
					[PD_TC__Tuple2+15] = i "TC__Tuple17",
					[PD_TC__Tuple2+16] = i "TC__Tuple18",
					[PD_TC__Tuple2+17] = i "TC__Tuple19",
					[PD_TC__Tuple2+18] = i "TC__Tuple20",
					[PD_TC__Tuple2+19] = i "TC__Tuple21",
					[PD_TC__Tuple2+20] = i "TC__Tuple22",
					[PD_TC__Tuple2+21] = i "TC__Tuple23",
					[PD_TC__Tuple2+22] = i "TC__Tuple24",
					[PD_TC__Tuple2+23] = i "TC__Tuple25",
					[PD_TC__Tuple2+24] = i "TC__Tuple26",
					[PD_TC__Tuple2+25] = i "TC__Tuple27",
					[PD_TC__Tuple2+26] = i "TC__Tuple28",
					[PD_TC__Tuple2+27] = i "TC__Tuple29",
					[PD_TC__Tuple2+28] = i "TC__Tuple30",
					[PD_TC__Tuple2+29] = i "TC__Tuple31",
194
195
196
197
198
					[PD_TC__Tuple32] = i "TC__Tuple32",

					[PD_TC__LazyArray] = i "TC__LazyArray",
					[PD_TC__StrictArray] = i "TC__StrictArray",
					[PD_TC__UnboxedArray] = i "TC__UnboxedArray",
199
					[PD_TC__PackedArray] = i "TC__PackedArray",
200

201
202
					[PD_TC__Maybe] = i "TC__Maybe",
					[PD_TC__StrictMaybe] = i "TC__StrictMaybe",
203
					[PD_TC__UnboxedMaybe] = i "TC__UnboxedMaybe",
204

John van Groningen's avatar
John van Groningen committed
205
206
					[PD_TC__Unit] = i "TC__Unit",

207
					[PD_StdGeneric] = i "StdGeneric",
208
209
210
211
212
213
					[PD_TypeUNIT] = i "UNIT",
					[PD_ConsUNIT] = i "UNIT",
					[PD_TypeEITHER] = i "EITHER",
					[PD_ConsLEFT] = i "LEFT",
					[PD_ConsRIGHT] = i "RIGHT",
					[PD_TypePAIR] = i "PAIR",
214
215
216
					[PD_ConsPAIR] = i "PAIR",					
					[PD_TypeCONS] = i "CONS",
					[PD_ConsCONS] = i "CONS",
217
218
					[PD_TypeRECORD] = i "RECORD",
					[PD_ConsRECORD] = i "RECORD",
219
220
					[PD_TypeFIELD] = i "FIELD",
					[PD_ConsFIELD] = i "FIELD",
Artem Alimarine's avatar
Artem Alimarine committed
221
222
					[PD_TypeOBJECT] = i "OBJECT",
					[PD_ConsOBJECT] = i "OBJECT",
223
					[PD_TGenericConsDescriptor] = i "GenericConsDescriptor",
224
					[PD_CGenericConsDescriptor] = i "_GenericConsDescriptor",
225
226
					[PD_TGenericRecordDescriptor] = i "GenericRecordDescriptor",
					[PD_CGenericRecordDescriptor] = i "_GenericRecordDescriptor",
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
					[PD_TGenericFieldDescriptor] = i "GenericFieldDescriptor",
					[PD_CGenericFieldDescriptor] = i "_GenericFieldDescriptor",
					[PD_TGenericTypeDefDescriptor] = i "GenericTypeDefDescriptor",
					[PD_CGenericTypeDefDescriptor] = i "_GenericTypeDefDescriptor",
					[PD_TGenConsPrio] = i "GenConsPrio",
					[PD_CGenConsNoPrio] = i "GenConsNoPrio",
					[PD_CGenConsPrio] = i "GenConsPrio",
					[PD_TGenConsAssoc] = i "GenConsAssoc",
					[PD_CGenConsAssocNone] = i "GenConsAssocNone",
					[PD_CGenConsAssocLeft] = i "GenConsAssocLeft",
					[PD_CGenConsAssocRight] = i "GenConsAssocRight",
					[PD_TGenType] = i "GenType",
					[PD_CGenTypeCons] = i "GenTypeCons",
					[PD_CGenTypeVar] = i "GenTypeVar",
					[PD_CGenTypeArrow] = i "GenTypeArrow",
					[PD_CGenTypeApp] = i "GenTypeApp",
243
				
244
					[PD_GenericBimap] = i "bimap",
245
246
				
					[PD_TypeGenericDict] = i "GenericDict",
247
					[PD_TypeGenericDict0] = i "GenericDict0",
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
248

249
250
251
252
					[PD_StdMisc] = i "StdMisc",
					[PD_abort] = i "abort",
					[PD_undef] = i "undef",
					
253
254
					[PD_Start] = i "Start",

255
256
					[PD__SystemEnumStrict] = i "_SystemEnumStrict",

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
					[PD_FromS]= i "_from_s",
					[PD_FromTS]= i "_from_ts",
					[PD_FromSTS]= i "_from_sts",
					[PD_FromU]= i "_from_u",
					[PD_FromUTS]= i "_from_uts",
					[PD_FromO]= i "_from_o",

					[PD_FromThenS]= i "_from_then_s",
					[PD_FromThenTS]= i "_from_then_ts",
					[PD_FromThenSTS]= i "_from_then_sts",
					[PD_FromThenU]= i "_from_then_u",
					[PD_FromThenUTS]= i "_from_then_uts",
					[PD_FromThenO]= i "_from_then_o",

					[PD_FromToS]= i "_from_to_s",
					[PD_FromToTS]= i "_from_to_ts",
					[PD_FromToSTS]= i "_from_to_sts",
					[PD_FromToU]= i "_from_to_u",
					[PD_FromToUTS]= i "_from_to_uts",
					[PD_FromToO]= i "_from_to_o",

					[PD_FromThenToS]= i "_from_then_to_s",
					[PD_FromThenToTS]= i "_from_then_to_ts",
					[PD_FromThenToSTS]= i "_from_then_to_sts",
					[PD_FromThenToU]= i "_from_then_to_u",
					[PD_FromThenToUTS]= i "_from_then_to_uts",
283
					[PD_FromThenToO]= i "_from_then_to_o"
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
		}
	=: idents
	where
		i s = { id_name = s, id_info = allocPtr };

		build_tuples tup_arity max_arity idents
			| tup_arity > max_arity
				= idents
				# tup_name = "_Tuple" +++ toString tup_arity
				# idents = {idents & [GetTupleTypeIndex tup_arity]=i tup_name, [GetTupleConsIndex tup_arity]=i tup_name}
				= build_tuples (inc tup_arity) max_arity idents

		build_variables var_number max_arity idents
			| var_number == max_arity
				= idents
299
300
				# var_ident = "a" +++ toString var_number
				# idents = {idents & [PD_TypeVar_a0 + var_number] = i var_ident}
301
302
303
304
305
306
				= build_variables (inc var_number) max_arity idents

init_identifiers :: !*SymbolTable !*World -> (!*SymbolTable,!*World)
init_identifiers heap world
	# local_predefined_idents = predefined_idents
	# (heap,world) = init_predefined_idents 0 heap world
307
		with
308
309
310
311
312
313
314
315
			init_predefined_idents i heap world
				| i<size local_predefined_idents
					| size local_predefined_idents.[i].id_name>0
						# (heap,world) = initPtr local_predefined_idents.[i].id_info EmptySymbolTableEntry heap world
						= init_predefined_idents (i+1) heap world
						= init_predefined_idents (i+1) heap world
					= (heap,world)
	= (heap,world)
316

317
318
319
320
321
322
323
put_predefined_idents_in_hash_table :: !Int !Int !IdentClass !{!Ident} !*HashTable -> *HashTable
put_predefined_idents_in_hash_table index last_index table_kind local_predefined_idents hash_table
	| index<=last_index
		# hash_table = putPredefinedIdentInHashTable predefined_idents.[index] table_kind hash_table
		= put_predefined_idents_in_hash_table (index+1) last_index table_kind local_predefined_idents hash_table
		= hash_table

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
324
325
buildPredefinedSymbols :: !*HashTable -> (!.PredefinedSymbols,!*HashTable)
buildPredefinedSymbols hash_table=:{hte_symbol_heap}
326
327
328
	# predef_symbol_table = createArray PD_NrOfPredefSymbols { pds_module = NoIndex, pds_def = NoIndex }
	  hte_symbol_heap = fill_table_without_hashing hte_symbol_heap
	= (predef_symbol_table,fill_table_with_hashing { hash_table & hte_symbol_heap = hte_symbol_heap })
329
where
330
	local_predefined_idents = predefined_idents
331
	
332
333
334
335
336
337
338
339
340
341
342
343
344
345
	fill_table_without_hashing hash_table
		= build_variables 0 32 (build_tuples 2 32 hash_table)
			<<= (local_predefined_idents, PD_PredefinedModule)
			<<= (local_predefined_idents, PD_StringType)
			<<= (local_predefined_idents, PD_ListType) <<= (local_predefined_idents, PD_ConsSymbol)<<= (local_predefined_idents, PD_NilSymbol)
			<<= (local_predefined_idents, PD_StrictListType) <<= (local_predefined_idents, PD_StrictConsSymbol) <<= (local_predefined_idents, PD_StrictNilSymbol)
			<<= (local_predefined_idents, PD_UnboxedListType) <<= (local_predefined_idents, PD_UnboxedConsSymbol) <<= (local_predefined_idents, PD_UnboxedNilSymbol)
			<<= (local_predefined_idents, PD_TailStrictListType) <<= (local_predefined_idents, PD_TailStrictConsSymbol) <<= (local_predefined_idents, PD_TailStrictNilSymbol)
			<<= (local_predefined_idents, PD_StrictTailStrictListType) <<= (local_predefined_idents, PD_StrictTailStrictConsSymbol) <<= (local_predefined_idents, PD_StrictTailStrictNilSymbol)
			<<= (local_predefined_idents, PD_UnboxedTailStrictListType) <<= (local_predefined_idents, PD_UnboxedTailStrictConsSymbol) <<= (local_predefined_idents, PD_UnboxedTailStrictNilSymbol)
			<<= (local_predefined_idents, PD_OverloadedListType) <<= (local_predefined_idents, PD_OverloadedConsSymbol) <<= (local_predefined_idents, PD_OverloadedNilSymbol)
			<<= (local_predefined_idents, PD_LazyArrayType)
			<<= (local_predefined_idents, PD_StrictArrayType)
			<<= (local_predefined_idents, PD_UnboxedArrayType)
346
			<<= (local_predefined_idents, PD_PackedArrayType)
347
348
349
350
			<<= (local_predefined_idents, PD_MaybeType) <<= (local_predefined_idents, PD_JustSymbol) <<= (local_predefined_idents, PD_NoneSymbol)
			<<= (local_predefined_idents, PD_StrictMaybeType) <<= (local_predefined_idents, PD_StrictJustSymbol) <<= (local_predefined_idents, PD_StrictNoneSymbol)
			<<= (local_predefined_idents, PD_UnboxedMaybeType) <<= (local_predefined_idents, PD_UnboxedJustSymbol) <<= (local_predefined_idents, PD_UnboxedNoneSymbol)
			<<= (local_predefined_idents, PD_OverloadedMaybeType) <<= (local_predefined_idents, PD_OverloadedJustSymbol) <<= (local_predefined_idents, PD_OverloadedNoneSymbol)
John van Groningen's avatar
John van Groningen committed
351
			<<= (local_predefined_idents, PD_UnitType) <<= (local_predefined_idents, PD_UnitConsSymbol)
352
353
			<<= (local_predefined_idents, PD_TypeCodeMember)
			<<= (local_predefined_idents, PD_DummyForStrictAliasFun) // MW++
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
354
	where
355
		build_tuples tup_arity max_arity hash_table
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
356
			| tup_arity > max_arity
357
358
359
				= hash_table
				= build_tuples (inc tup_arity) max_arity (hash_table <<= (local_predefined_idents, GetTupleTypeIndex tup_arity)
						<<= (local_predefined_idents, GetTupleConsIndex tup_arity))
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
360

361
		build_variables var_number max_arity hash_table
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
362
			| var_number == max_arity
363
364
365
366
367
				= hash_table
				= build_variables (inc var_number) max_arity (hash_table <<= (local_predefined_idents, PD_TypeVar_a0 + var_number))

	fill_table_with_hashing hash_table
		# hash_table = hash_table
368
369
370
					<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdArray)
					<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdEnum)
					<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdBool)
371
372
373
374
375
376
377
378
379
380
381
382
					<<- (local_predefined_idents, IC_Expression, PD_AndOp)
					<<- (local_predefined_idents, IC_Expression, PD_OrOp)
					<<- (local_predefined_idents, IC_Class, PD_ArrayClass)
					<<- (local_predefined_idents, IC_Expression, PD_CreateArrayFun)
					<<- (local_predefined_idents, IC_Expression, PD__CreateArrayFun)
					<<- (local_predefined_idents, IC_Expression, PD_ArraySelectFun)
					<<- (local_predefined_idents, IC_Expression, PD_UnqArraySelectFun)
					<<- (local_predefined_idents, IC_Expression, PD_ArrayUpdateFun)
					<<- (local_predefined_idents, IC_Expression, PD_ArrayReplaceFun)
					<<- (local_predefined_idents, IC_Expression, PD_ArraySizeFun)
					<<- (local_predefined_idents, IC_Expression, PD_UnqArraySizeFun)

383
					<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdStrictLists)
384
					<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD__SystemEnumStrict)
385
					<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdStrictMaybes)
386
		# hash_table = put_predefined_idents_in_hash_table PD_cons PD_nil_uts IC_Expression local_predefined_idents hash_table
387
388
389
					<<- (local_predefined_idents, IC_Class, PD_ListClass)
					<<- (local_predefined_idents, IC_Class, PD_UListClass)
					<<- (local_predefined_idents, IC_Class, PD_UTSListClass)
390
		# hash_table = put_predefined_idents_in_hash_table PD_just_u PD_from_just IC_Expression local_predefined_idents hash_table
391
392
					<<- (local_predefined_idents, IC_Class, PD_MaybeClass)
					<<- (local_predefined_idents, IC_Class, PD_UMaybeClass)
393
394
395
396
397
398
399
400
401
					<<- (local_predefined_idents, IC_Expression, PD_SmallerFun)
					<<- (local_predefined_idents, IC_Expression, PD_LessOrEqualFun)
					<<- (local_predefined_idents, IC_Expression, PD_IncFun)
					<<- (local_predefined_idents, IC_Expression, PD_SubFun)

					<<- (local_predefined_idents, IC_Expression, PD_From)
					<<- (local_predefined_idents, IC_Expression, PD_FromThen)
					<<- (local_predefined_idents, IC_Expression, PD_FromTo)
					<<- (local_predefined_idents, IC_Expression, PD_FromThenTo)
402
					
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
403
					<<- (local_predefined_idents,	IC_Class, PD_TypeCodeClass)
404

405
					<<- (local_predefined_idents,	IC_Module NoQualifiedIdents, PD_StdDynamic)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
406
407

					<<- (local_predefined_idents,	IC_Type, PD_Dyn_DynamicTemp)
408
					<<- (local_predefined_idents,	IC_Type, PD_Dyn_TypeCode)
409
					<<- (local_predefined_idents,	IC_Type, PD_Dyn_UnificationEnvironment)
410
		# hash_table = put_predefined_idents_in_hash_table PD_Dyn_TypeScheme PD_Dyn_normalise IC_Expression local_predefined_idents hash_table
411
412
					<<- (local_predefined_idents,	IC_Expression, PD_Dyn__to_TypeCodeConstructor)

413
414
					<<- (local_predefined_idents,	IC_Type, PD_TypeCodeConstructor)

415
					<<- (local_predefined_idents,	IC_Module NoQualifiedIdents, PD_StdGeneric)
John van Groningen's avatar
John van Groningen committed
416
		# hash_table = put_predefined_idents_in_hash_table PD_TC_Int PD_TC__Unit IC_Expression local_predefined_idents hash_table
417

418
		# hash_table = put_predefined_idents_in_hash_table PD_TypeUNIT PD_TypeGenericDict0 IC_Type local_predefined_idents hash_table
419
		# hash_table = put_predefined_idents_in_hash_table PD_ConsUNIT PD_CGenTypeApp IC_Expression local_predefined_idents hash_table
420
					<<- (local_predefined_idents,	IC_Generic,		PD_GenericBimap)	
421
		# hash_table = hash_table
422
					<<- (local_predefined_idents,	IC_Module NoQualifiedIdents, PD_StdMisc)
423
424
425
426
427
428
429
430

					<<- (local_predefined_idents,	IC_Expression, 	PD_abort)
					<<- (local_predefined_idents,	IC_Expression, 	PD_undef)					

					<<- (local_predefined_idents,	IC_Expression, PD_Start)

		# hash_table = put_predefined_idents_in_hash_table PD_FromS PD_FromThenToO IC_Expression local_predefined_idents hash_table

431
		= hash_table
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
432

433
MakeTupleConsSymbIndex arity 	:== arity - 2 + (PD_Arity2TupleSymbol-FirstConstructorPredefinedSymbolIndex)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
434
435
436
437
438
439
440
441
442

MaxTupleArity				:== 32

cTCClassSymbIndex			:== 0

cTCMemberSymbIndex			:== 0

cTCInstanceSymbIndex		:== 0

443
444
make_type_def :: !Int ![TypeVar] !a !*{#PredefinedSymbol} -> (!TypeDef a,!.{#PredefinedSymbol})
make_type_def type_cons_index type_vars type_rhs pre_def_symbols
445
	# type_cons_ident = predefined_idents.[type_cons_index]
446
	= (MakeTypeDef type_cons_ident (map (\tv -> MakeAttributedTypeVar tv) type_vars) type_rhs TA_None NoPos, pre_def_symbols)
447

448
449
make_list_definition :: Int Int Int Ident TypeVar AType StrictnessList *{#PredefinedSymbol} -> (!TypeDef TypeRhs,!ConsDef,!ConsDef,!.{#PredefinedSymbol})
make_list_definition list_type_pre_def_symbol_index cons_pre_def_symbol_index nil_pre_def_symbol_index pre_mod_id type_var type_var_with_attr cons_strictness pre_def_symbols
450
451
452
453
	# cons_ident = predefined_idents.[cons_pre_def_symbol_index]
	  nil_ident = predefined_idents.[nil_pre_def_symbol_index]
	  list_ident = predefined_idents.[list_type_pre_def_symbol_index] 
	  
454
	  cons_ds = { ds_ident = cons_ident, ds_arity = 2, ds_index = cons_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex }
455
	  nil_symb = { ds_ident = nil_ident, ds_arity=0 ,ds_index = nil_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex }
456
	  (list_def, pre_def_symbols) = make_type_def list_type_pre_def_symbol_index [type_var] (AlgType [cons_ds,nil_symb]) pre_def_symbols	
457
	  list_type = MakeAttributedType (TA (MakeNewTypeSymbIdent list_ident 1) [type_var_with_attr])
458
	  cons_def = {	pc_cons_ident = cons_ident, pc_cons_arity = 2, pc_arg_types = [type_var_with_attr, list_type], pc_context = [],
459
				 	pc_args_strictness=cons_strictness,	pc_cons_prio =  NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
460
	  nil_def = {	pc_cons_ident = nil_ident, pc_cons_arity = 0, pc_arg_types = [], pc_args_strictness=NotStrict, pc_context = [],
461
	  				pc_cons_prio =  NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
462
463
464
	= (list_def,ParsedConstructorToConsDef cons_def,ParsedConstructorToConsDef nil_def,pre_def_symbols)

make_maybe_definition :: Int Int Int Ident TypeVar AType StrictnessList *{#PredefinedSymbol} -> (!TypeDef TypeRhs,!ConsDef,!ConsDef,!.{#PredefinedSymbol})
465
make_maybe_definition maybe_type_pre_def_symbol_index just_pre_def_symbol_index none_pre_def_symbol_index pre_mod_id type_var type_var_with_attr just_strictness pre_def_symbols
466
	# just_ident = predefined_idents.[just_pre_def_symbol_index]
467
	  none_ident = predefined_idents.[none_pre_def_symbol_index]
468
469
470
	  maybe_ident = predefined_idents.[maybe_type_pre_def_symbol_index]
	  
	  just_ds = { ds_ident = just_ident, ds_arity = 1, ds_index = just_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex }
471
472
	  none_ds = { ds_ident = none_ident, ds_arity = 0, ds_index = none_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex }
	  (maybe_def, pre_def_symbols) = make_type_def maybe_type_pre_def_symbol_index [type_var] (AlgType [just_ds,none_ds]) pre_def_symbols
473
474
	  just_def = {	pc_cons_ident = just_ident, pc_cons_arity = 1, pc_arg_types = [type_var_with_attr], pc_context = [],
					pc_args_strictness=just_strictness,	pc_cons_prio =  NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
475
476
477
	  none_def = {	pc_cons_ident = none_ident, pc_cons_arity = 0, pc_arg_types = [], pc_args_strictness=NotStrict, pc_context = [],
					pc_cons_prio =  NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
	= (maybe_def,ParsedConstructorToConsDef just_def,ParsedConstructorToConsDef none_def,pre_def_symbols)
478

John van Groningen's avatar
John van Groningen committed
479
480
481
482
483
484
485
486
487
make_unit_definition :: Ident *{#PredefinedSymbol} -> (!TypeDef TypeRhs,!ConsDef,!.{#PredefinedSymbol})
make_unit_definition pre_mod_id pre_def_symbols
	# unit_cons_ident = predefined_idents.[PD_UnitConsSymbol]
	  unit_cons_symb = {ds_ident = unit_cons_ident, ds_arity=0 ,ds_index = PD_UnitConsSymbol-FirstConstructorPredefinedSymbolIndex}
	  (unit_type_def, pre_def_symbols) = make_type_def PD_UnitType [] (AlgType [unit_cons_symb]) pre_def_symbols	
	  unit_cons_def = {pc_cons_ident = unit_cons_ident, pc_cons_arity = 0, pc_arg_types = [], pc_args_strictness=NotStrict, pc_context = [],
		  			   pc_cons_prio =  NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
	= (unit_type_def,ParsedConstructorToConsDef unit_cons_def,pre_def_symbols);

488
489
buildPredefinedModule :: !Bool !*PredefinedSymbols -> (!ScannedModule, !.PredefinedSymbols)
buildPredefinedModule support_dynamics pre_def_symbols 
490
491
492
493
494
495
496
	# type_var_ident = predefined_idents.[PD_TypeVar_a0]
	  string_ident = predefined_idents.[PD_StringType]
	  unb_array_ident = predefined_idents.[PD_UnboxedArrayType]
	  pre_mod_ident = predefined_idents.[PD_PredefinedModule]
	  alias_dummy_ident = predefined_idents.[PD_DummyForStrictAliasFun]

	  type_var						= MakeTypeVar type_var_ident
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
497
	  type_var_with_attr			= MakeAttributedType (TV type_var)
498
	  unb_arr_of_char_type			= MakeAttributedType (TA (MakeNewTypeSymbIdent unb_array_ident 1) [MakeAttributedType (TB BT_Char)])
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
499
500
501

	  (string_def, pre_def_symbols)	= make_type_def PD_StringType [] (SynType unb_arr_of_char_type) pre_def_symbols
	
502
	  (list_def,cons_def,nil_def,pre_def_symbols)
503
		= make_list_definition PD_ListType PD_ConsSymbol PD_NilSymbol pre_mod_ident type_var type_var_with_attr NotStrict pre_def_symbols
504
	  (strict_list_def,strict_cons_def,strict_nil_def,pre_def_symbols)
505
		= make_list_definition PD_StrictListType PD_StrictConsSymbol PD_StrictNilSymbol pre_mod_ident type_var type_var_with_attr (Strict 1) pre_def_symbols
506
	  (unboxed_list_def,unboxed_cons_def,unboxed_nil_def,pre_def_symbols)
507
		= make_list_definition PD_UnboxedListType PD_UnboxedConsSymbol PD_UnboxedNilSymbol pre_mod_ident type_var type_var_with_attr (Strict 1) pre_def_symbols
508
	  (tail_strict_list_def,tail_strict_cons_def,tail_strict_nil_def,pre_def_symbols)
509
		= make_list_definition PD_TailStrictListType PD_TailStrictConsSymbol PD_TailStrictNilSymbol pre_mod_ident type_var type_var_with_attr (Strict 2) pre_def_symbols
510
	  (strict_tail_strict_list_def,strict_tail_strict_cons_def,strict_tail_strict_nil_def,pre_def_symbols)
511
		= make_list_definition PD_StrictTailStrictListType PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol pre_mod_ident type_var type_var_with_attr (Strict 3) pre_def_symbols
512
	  (unboxed_tail_strict_list_def,unboxed_tail_strict_cons_def,unboxed_tail_strict_nil_def,pre_def_symbols)
513
		= make_list_definition PD_UnboxedTailStrictListType PD_UnboxedTailStrictConsSymbol PD_UnboxedTailStrictNilSymbol pre_mod_ident type_var type_var_with_attr (Strict 3) pre_def_symbols
514
	  (overloaded_list_def,overloaded_cons_def,overloaded_nil_def,pre_def_symbols)
515
		= make_list_definition PD_OverloadedListType PD_OverloadedConsSymbol PD_OverloadedNilSymbol pre_mod_ident type_var type_var_with_attr NotStrict pre_def_symbols
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
516
517

	  (array_def, pre_def_symbols)		= make_type_def PD_LazyArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
518
519
	  (strict_def, pre_def_symbols)		= make_type_def PD_StrictArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
	  (unboxed_def, pre_def_symbols)	= make_type_def PD_UnboxedArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
520
	  (packed_def, pre_def_symbols)	= make_type_def PD_PackedArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
521

522
523
524
525
526
527
528
529
	  (maybe_def,just_def,none_def,pre_def_symbols)
		= make_maybe_definition PD_MaybeType PD_JustSymbol PD_NoneSymbol pre_mod_ident type_var type_var_with_attr NotStrict pre_def_symbols
	  (strict_maybe_def,strict_just_def,strict_none_def,pre_def_symbols)
		= make_maybe_definition PD_StrictMaybeType PD_StrictJustSymbol PD_StrictNoneSymbol pre_mod_ident type_var type_var_with_attr (Strict 1) pre_def_symbols
	  (unboxed_maybe_def,unboxed_just_def,unboxed_none_def,pre_def_symbols)
		= make_maybe_definition PD_UnboxedMaybeType PD_UnboxedJustSymbol PD_UnboxedNoneSymbol pre_mod_ident type_var type_var_with_attr (Strict 1) pre_def_symbols
	  (overloaded_maybe_def,overloaded_just_def,overloaded_none_def,pre_def_symbols)
		= make_maybe_definition PD_OverloadedMaybeType PD_OverloadedJustSymbol PD_OverloadedNoneSymbol pre_mod_ident type_var type_var_with_attr NotStrict pre_def_symbols
530

John van Groningen's avatar
John van Groningen committed
531
532
	  (unit_type_def,unit_cons_def,pre_def_symbols) = make_unit_definition pre_mod_ident pre_def_symbols

533
534
	  array_and_unit_type_defs
		= [array_def,strict_def,unboxed_def,packed_def,maybe_def,strict_maybe_def,unboxed_maybe_def,overloaded_maybe_def,unit_type_def]
535
536
	  cons_defs = [just_def,none_def,strict_just_def,strict_none_def,
				   unboxed_just_def,unboxed_none_def,overloaded_just_def,overloaded_none_def,unit_cons_def]
537
538
	  (type_defs, cons_defs, pre_def_symbols)
		= add_tuple_defs pre_mod_ident MaxTupleArity array_and_unit_type_defs cons_defs pre_def_symbols
John van Groningen's avatar
John van Groningen committed
539

540
	  alias_dummy_type = make_identity_fun_type alias_dummy_ident type_var
541
	  (def_classes, def_members) = make_predefined_classes_and_members support_dynamics 
John van Groningen's avatar
John van Groningen committed
542
	= ({ mod_ident = pre_mod_ident, mod_modification_time = "", mod_type = MK_System, mod_imports = [],mod_foreign_exports=[], mod_imported_objects = [],
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
543
		 mod_defs = {
544
545
546
			def_types = [string_def, list_def,strict_list_def,unboxed_list_def,tail_strict_list_def,strict_tail_strict_list_def,unboxed_tail_strict_list_def,overloaded_list_def : type_defs],
						def_constructors = [cons_def,strict_cons_def,unboxed_cons_def,tail_strict_cons_def,strict_tail_strict_cons_def,unboxed_tail_strict_cons_def,overloaded_cons_def,
											nil_def,strict_nil_def,unboxed_nil_def,tail_strict_nil_def,strict_tail_strict_nil_def,unboxed_tail_strict_nil_def,overloaded_nil_def : cons_defs],
547
548
						def_selectors = [], def_classes = def_classes,
			def_macro_indices= { ir_from = 0, ir_to = 0 },def_macros=[],def_members = def_members, def_funtypes = [alias_dummy_type], def_instances = [], 
549
			def_generics = [], def_generic_cases = []}}, pre_def_symbols)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
550
where
551

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
552
553
554
	add_tuple_defs pre_mod_id tup_arity type_defs cons_defs pre_def_symbols
		| tup_arity >= 2
			# (type_vars, pre_def_symbols)		= make_type_vars tup_arity [] pre_def_symbols
555
556
			  tuple_ident = predefined_idents.[GetTupleConsIndex tup_arity]
			  tuple_cons_symb					= { ds_ident = tuple_ident, ds_index = MakeTupleConsSymbIndex tup_arity, ds_arity = tup_arity }
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
557
558
			  
			  (tuple_type_def, pre_def_symbols)	= make_type_def (GetTupleTypeIndex tup_arity) type_vars (AlgType [tuple_cons_symb]) pre_def_symbols
559
			  tuple_cons_def	= { pc_cons_ident = tuple_ident, pc_cons_arity = tup_arity, pc_cons_pos = PreDefPos pre_mod_id,
560
			  						pc_arg_types = [ MakeAttributedType (TV tv) \\ tv <- type_vars],
561
			  						pc_args_strictness = NotStrict, pc_context = [],
562
			  						pc_cons_prio =  NoPrio, pc_exi_vars = []}
563
			= add_tuple_defs pre_mod_id (dec tup_arity) [tuple_type_def : type_defs] [ParsedConstructorToConsDef tuple_cons_def : cons_defs] pre_def_symbols
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
564
565
566
567
568
569
			= (type_defs, cons_defs, pre_def_symbols)
	where
		make_type_vars nr_of_vars type_vars pre_def_symbols
			| nr_of_vars == 0
				= (type_vars, pre_def_symbols)
				# nr_of_vars = dec nr_of_vars
570
571
				# var_ident = predefined_idents.[PD_TypeVar_a0 + nr_of_vars]
				= make_type_vars nr_of_vars [MakeTypeVar var_ident : type_vars] pre_def_symbols
572
573
574
575
576
577
578
579
580

	make_predefined_classes_and_members support_dynamics
		| not support_dynamics
			= ([], []);
			# tc_class_name = predefined_idents.[PD_TypeCodeClass]
			  type_var_ident = predefined_idents.[PD_TypeVar_a0]
			  tc_member_name = predefined_idents.[PD_TypeCodeMember]
			
			  class_var = MakeTypeVar type_var_ident
581

582
583
584
585
586
			  me_type = { st_vars = [], st_args = [], st_args_strictness=NotStrict, st_arity = 0,
						  st_result = { at_attribute = TA_None, at_type = TV class_var },
						  st_context = [ {tc_class = TCClass {glob_module = NoIndex, glob_object = {ds_ident = tc_class_name, ds_arity = 1, ds_index = NoIndex }},
						   				tc_types = [ TV class_var ], tc_var = nilPtr}],
						  st_attr_vars = [], st_attr_env = [] }
587

588
			  tc_member_def = { me_ident = tc_member_name, me_type = me_type, me_pos = NoPos, me_priority = NoPrio, me_default_implementation = NoMemberDefault,
589
								me_offset = NoIndex, me_class_vars = NoClassArgs, me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr }
590
			
591
			  tc_class_def = { class_ident = tc_class_name, class_arity = 1, class_args = ClassArg class_var NoClassArgs, class_context = [],
592
			  				   class_members = {{ds_ident = tc_member_name, ds_index = cTCMemberSymbIndex, ds_arity = 0 }}, class_cons_vars = 0,
593
			  				   class_macro_members = {},
594
595
596
597
							   class_dictionary = { ds_ident = { tc_class_name & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_pos = NoPos
							 }
	
			= ([tc_class_def], [tc_member_def])
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
598

599
	make_identity_fun_type alias_dummy_id type_var
600
601
		# a = { at_attribute = TA_Anonymous, at_type = TV type_var }
		  id_symbol_type = { st_vars = [], st_args = [a], st_args_strictness = Strict 1, st_arity = 1, st_result = a, st_context = [], 
602
							st_attr_vars = [], st_attr_env = [] } // !.a -> .a
603
		= { ft_ident = alias_dummy_id, ft_arity = 1, ft_priority = NoPrio, ft_type = id_symbol_type, ft_pos = NoPos,
604
			ft_specials = FSP_None, ft_type_ptr = nilPtr }
Martijn Vervoort's avatar
Martijn Vervoort committed
605

606
DynamicRepresentation_String			:== "DynamicTemp" // "_DynamicTemp"		
607

Martijn Vervoort's avatar
Martijn Vervoort committed
608