classify.icl 75.8 KB
Newer Older
1
2
3
implementation module classify

SwitchMultimatchClassification multi no_multi	:== multi
4
SwitchNewOld new old							:== new
5

6
import syntax
7
from checksupport import ::Component(..),::ComponentMembers(..)
8
9
from containers import arg_is_strict
import utilities
10
import StdStrictLists
11
from StdOverloadedList import !!$
12
13
14
15
16
17
18
19
20
21
22
23
24
25

::	CleanupInfo :== [ExprInfoPtr]

setExtendedExprInfo :: !ExprInfoPtr !ExtendedExprInfo !*ExpressionHeap -> *ExpressionHeap
setExtendedExprInfo expr_info_ptr extension expr_info_heap
	# (expr_info, expr_info_heap) = readPtr expr_info_ptr expr_info_heap
	= case expr_info of
		EI_Extended _ ei
			-> expr_info_heap <:= (expr_info_ptr, EI_Extended extension ei)
		ei	-> expr_info_heap <:= (expr_info_ptr, EI_Extended extension ei)
		
is_nil_cons_or_decons_of_UList_or_UTSList glob_object glob_module imported_funs
	:== not (isEmpty imported_funs.[glob_module].[glob_object].ft_type.st_context);

26
//	ANALYSIS: only determines consumerClass; producerClasses are determined after each group is transformed.
27
28
29
30
31
32

IsAVariable cons_class	:== cons_class >= 0

combineClasses :: !ConsClass !ConsClass -> ConsClass
combineClasses cc1 cc2
	| IsAVariable cc1
33
		= CAccumulating
34
	| IsAVariable cc2
35
		= CAccumulating
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
		= min cc1 cc2
 
aiUnifyClassifications cc1 cc2 ai
	:== {ai & ai_class_subst = unifyClassifications cc1 cc2 ai.ai_class_subst}

unifyClassifications :: !ConsClass !ConsClass !*ConsClassSubst -> *ConsClassSubst
unifyClassifications cc1 cc2 subst
	#  (cc1,subst) = skip_indirections_of_variables cc1 subst
	   (cc2,subst) = skip_indirections_of_variables cc2 subst
	= combine_cons_classes cc1 cc2 subst
where		   
	skip_indirections_of_variables :: !ConsClass !*ConsClassSubst -> (!ConsClass,!*ConsClassSubst)
	skip_indirections_of_variables cc subst
		| IsAVariable cc
			#! cc = skip_indirections cc subst
			= (cc, subst)
			= (cc, subst)
	where	
		skip_indirections cons_var subst
			#! redir = subst.[cons_var]
			| IsAVariable redir
				= skip_indirections redir subst
				= cons_var
John van Groningen's avatar
John van Groningen committed
59

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
	combine_cons_classes :: !ConsClass !ConsClass !*ConsClassSubst -> *ConsClassSubst
	combine_cons_classes cc1 cc2 subst
		| cc1 == cc2
			= subst
		| IsAVariable cc1
			#! cc_val1 = subst.[cc1]
			| IsAVariable cc2
				#! cc_val2 = subst.[cc2]
				= { subst & [cc2] = cc1, [cc1] = combine_cons_constants cc_val1 cc_val2 }

				= { subst & [cc1] = combine_cons_constants cc_val1 cc2 }
		| IsAVariable cc2
			#! cc_val2 = subst.[cc2]
			= { subst & [cc2] = combine_cons_constants cc1 cc_val2 }
			= subst
John van Groningen's avatar
John van Groningen committed
75

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
	combine_cons_constants :: !ConsClass !ConsClass -> ConsClass
	combine_cons_constants cc1 cc2
		= min cc1 cc2

determine_classification :: !ConsClasses !.ConsClassSubst -> ConsClasses
determine_classification cc class_subst
	# (cc_size, cc_args) = mapAndLength (skip_indirections class_subst) cc.cc_args
	= { cc & cc_size = cc_size, cc_args = cc_args }
where
	mapAndLength f [x : xs]
		#! x = f x
		   (length, xs) = mapAndLength f xs
		=  (inc length, [x : xs])
	mapAndLength f []
		= (0, [])
Diederik van Arkel's avatar
Diederik van Arkel committed
91
	
92
93
94
95
96
97
98
	skip_indirections subst cc
		| IsAVariable cc
			= skip_indirections subst subst.[cc]
			= cc

//@ Consumer Analysis datatypes...

99
:: RefCounts :== {!RefCount}
100

101
:: RefCount
102
103
104
105
106
107
108
109
110
111
112
113
	= Par !Int !.[!.RefCount!]
	| Seq !Int !.[!.RefCount!]
	| Dep !FunIndex !ArgIndex

:: FunIndex	:== Int
:: ArgIndex :== Int

replace_global_idx_by_group_idx table rcs
	= {{replace rc \\ rc <-: frcs} \\ frcs <-: rcs}
where
	replace rc
		= case rc of
114
115
			Par i d		-> Par i [|replace rc \\ rc <|- d]
			Seq i d		-> Seq i [|replace rc \\ rc <|- d]
116
117
			Dep f a		-> Dep (get_index f 0 table) a

118
119
120
121
122
	get_index f x (ComponentMember t ts)
		| t == f
			= x
			= get_index f (x+1) ts
	get_index f x (GeneratedComponentMember t _ ts)
123
124
125
		| t == f
			= x
			= get_index f (x+1) ts
126
127
	get_index f x NoComponentMembers
		= abort "classify:get_index: no index for function\n"
128
129
130
131
132
133
134
135
136
137
138
139
140

Max a m [|]
	= a + m
Max a m [|d:ds]
	| a + m >= 2
		= 2
	# s = score d
	| s > m
		= Max a s ds
		= Max a m ds

score (Par i d)		= Max i 0 d
score (Seq i d)		= Sum i d
141
142
143
144
145
146
147
where
	Sum a [|]
		= a
	Sum a [|d:ds]
		| a >= 2
			= 2
			= Sum (a + score d) ds
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
score (Dep f a)		= 0

Max` a m [|]
	= a + m
Max` a m [|d:ds]
	| a + m >= 2
		= 2
	# s = score` d
	| s > m
		= Max` a s ds
		= Max` a m ds

Sum` a [|]
	= a
Sum` a [|d:ds]
	| a >= 2
		= 2
		= Sum` (a + score` d) ds

score` (Par i d)	= Max` i 0 d
score` (Seq i d)	= Sum` i d
score` (Dep f a)	= 1

substitute_dep :: ![(!FunIndex,!ArgIndex)] !u:RefCount -> u:RefCount
substitute_dep subs (Par i d)
	= Par i [|substitute_dep subs rc \\ rc <|- d]
substitute_dep subs (Seq i d)
	= Seq i [|substitute_dep subs rc \\ rc <|- d]
substitute_dep subs rc=:(Dep f a)
	| isMember (f,a) subs
		= Seq 1 [|]
		= Dep f a

n_zero_counts n
	:== createArray n (Seq 0 [|])
n_twos_counts n
	:== createArray n (Seq 2 [|])

inc_ref_count :: !RefCount -> RefCount
inc_ref_count rc
	= case rc of
		Par i d	-> if (i > 0) (Seq 2 [|]) (Par (i+1) d)
		Seq i d -> if (i > 0) (Seq 2 [|]) (Seq (i+1) d)
		_ -> abort "classify:inc_ref_count: unexpected Dep\n"

add_dep_count :: !(!Int,!Int) !RefCount -> RefCount
add_dep_count (fi,ai) rc
	= case rc of
		Par i d	-> Par i [|Dep fi ai:d]
		Seq i d -> Seq i [|Dep fi ai:d]
		_ -> abort "classify:add_dep_count: unexpected Dep\n"

200
combine_counts :: !RefCounts !*RefCounts -> *RefCounts
201
combine_counts c1 c2
202
203
204
205
	# s2 = size c2
	| s2==0
		= c2
		= combine1 c1.[0] 1 c2 c1
206
where
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
	combine1 :: !RefCount !Int !*RefCounts !RefCounts -> *RefCounts
	combine1 (Seq 0 [|]) i a c1
		| i<size a
			= combine1 c1.[i] (i+1) a c1
			= a
	combine1 rc1 i a c1
		#! c2i = a.[i-1]
		= combine2 rc1 c2i i a c1

	combine2 :: !RefCount !RefCount !Int !*RefCounts !RefCounts -> *RefCounts
	combine2 rc1 (Seq 0 [|]) i a c1
		| i<size a
			= combine1 c1.[i] (i+1) {a & [i-1]=rc1} c1
			= {a & [i-1]=rc1}
	combine2 (Seq i1 [|]) (Seq i2 l) i a c1
		| i<size a
			= combine1 c1.[i] (i+1) {a & [i-1]=Seq (i1+i2) l} c1
			= {a & [i-1]=Seq (i1+i2) l}
	combine2 (Seq i1 l) (Seq i2 [|]) i a c1
		| i<size a
			= combine1 c1.[i] (i+1) {a & [i-1]=Seq (i1+i2) l} c1
			= {a & [i-1]=Seq (i1+i2) l}
	combine2 rc1 rc2 i a c1
		| i<size a
			= combine1 c1.[i] (i+1) {a & [i-1]=Seq 0 [|rc1,rc2]} c1
			= {a & [i-1]=Seq 0 [|rc1,rc2]}

unify_counts :: !RefCounts !*RefCounts -> *RefCounts
235
unify_counts c1 c2
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
	# s2 = size c2
	| s2==0
		= c2
		= unify1 c1.[0] 1 c2 c1
where
	unify1 :: !RefCount !Int !*RefCounts !RefCounts -> *RefCounts
	unify1 (Seq 0 [|]) i a c1
		| i<size a
			= unify1 c1.[i] (i+1) a c1
			= a
	unify1 rc1 i a c1
		#! c2i = a.[i-1]
		= unify2 rc1 c2i i a c1

	unify2 :: !RefCount !RefCount !Int !*RefCounts !RefCounts -> *RefCounts
	unify2 rc1 (Seq 0 [|]) i a c1
		| i<size a
			= unify1 c1.[i] (i+1) {a & [i-1]=rc1} c1
			= {a & [i-1]=rc1}
	unify2 rc1=:(Seq i1 [|]) rc2=:(Seq i2 [|]) i a c1
		| i1>=i2
			| i<size a
				= unify1 c1.[i] (i+1) {a & [i-1]=rc1} c1
				= {a & [i-1]=rc1}
			| i<size a
				= unify1 c1.[i] (i+1) a/*{a & [i-1]=rc2}*/ c1
				= a//{a & [i-1]=rc2}
	unify2 rc1 rc2 i a c1
		| i<size a
			= unify1 c1.[i] (i+1) {a & [i-1]=Par 0 [|rc1,rc2]} c1
			= {a & [i-1]=Par 0 [|rc1,rc2]}

unify_and_zero_counts :: !*RefCounts !*RefCounts -> (!*RefCounts,!*RefCounts)
unify_and_zero_counts c1 c2
	# s2 = size c2
	| s2==0
		= (c1,c2)
		#! c10 = c1.[0]
		= unify1 c10 1 c2 c1 (Seq 0 [|])
275
where
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
	unify1 :: !RefCount !Int !*RefCounts !*RefCounts !RefCount -> (!*RefCounts,!*RefCounts)
	unify1 (Seq 0 [|]) i a c1 rc0
		| i<size a
			#! c1i = c1.[i]
			= unify1 c1i (i+1) a c1 rc0
			= (c1,a)
	unify1 rc1 i a c1 rc0
		#! c2i = a.[i-1]
		= unify2 rc1 c2i i a c1 rc0

	unify2 :: !RefCount !RefCount !Int !*RefCounts !*RefCounts !RefCount -> (!*RefCounts,!*RefCounts)
	unify2 rc1 (Seq 0 [|]) i a c1 rc0
		| i<size a
			# c1 & [i-1] = rc0
			#! c1i = c1.[i]
			= unify1 c1i (i+1) {a & [i-1]=rc1} c1 rc0
			# c1 & [i-1] = rc0
			= (c1,{a & [i-1]=rc1})
	unify2 rc1=:(Seq i1 [|]) rc2=:(Seq i2 [|]) i a c1 rc0
295
		| i1>=i2
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
			| i<size a
				# c1 & [i-1] = rc0
				#! c1i = c1.[i]
				= unify1 c1i (i+1) {a & [i-1]=rc1} c1 rc0
				# c1 & [i-1] = rc0
				= (c1,{a & [i-1]=rc1})
			| i<size a
				# c1 & [i-1] = rc0
				#! c1i = c1.[i]
				= unify1 c1i (i+1) a/*{a & [i-1]=rc2}*/ c1 rc0
				# c1 & [i-1] = rc0
				= (c1,a/*{a & [i-1]=rc2}*/)
	unify2 rc1 rc2 i a c1 rc0
		| i<size a
			# c1 & [i-1] = rc0
			#! c1i = c1.[i]
			= unify1 c1i (i+1) {a & [i-1]=Par 0 [|rc1,rc2]} c1 rc0
			# c1 & [i-1] = rc0
			= (c1,{a & [i-1]=Par 0 [|rc1,rc2]})
315

316
/*
317
318
show_counts component_members group_counts
	# (_,group_counts) = foldSt show component_members (0,group_counts)
319
320
321
322
323
324
325
326
327
328
329
	= group_counts
where
	show fun (fun_index,group_counts)
		# (fun_counts,group_counts) = group_counts![fun_index]
		= (fun_index+1,group_counts) 
			--->	( fun_index,fun
					, [score rc \\ rc <-: fun_counts]
					, [score` rc \\ rc <-: fun_counts]
					, [is_non_zero rc \\ rc <-: fun_counts]
					, fun_counts
					)
330
*/
331
332
333
334
335
336
337
338
instance <<< [!a!] | <<< a
where
	(<<<) s a = s <<< [e \\ e <|- a]
	
instance <<< {a} | <<< a
where
	(<<<) s a = s <<< [e \\ e <-: a]
	
339
340
::	*AnalyseInfo =
	{	ai_var_heap						:: !*VarHeap
Diederik van Arkel's avatar
Diederik van Arkel committed
341
	,	ai_cons_class					:: !*{!ConsClasses}
342
	,	ai_cur_ref_counts				:: !*RefCounts // for each variable 0,1 or 2
Diederik van Arkel's avatar
Diederik van Arkel committed
343
	,	ai_class_subst					:: !*ConsClassSubst
344
345
	,	ai_next_var						:: !Int
	,	ai_next_var_of_fun				:: !Int
346
	,	ai_cases_of_vars_for_function	:: ![(!Bool,!Case)]
Diederik van Arkel's avatar
Diederik van Arkel committed
347
	,	ai_fun_heap						:: !*FunctionHeap
348
349
	,	ai_fun_defs						:: !*{#FunDef}

350
	,	ai_group_members				:: !ComponentMembers
351
	,	ai_group_counts					:: !*{!RefCounts}
352
353
	}

354
355
356
357
358
359
CUnusedLazy				:== -1
CUnusedStrict			:== -2
CPassive   				:== -3
CActive					:== -4
CAccumulating   		:== -5
CVarOfMultimatchCase	:== -6
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397

/*
	NOTE: ordering of above values is relevant since unification
	is defined later as:
	
	combine_cons_constants :: !ConsClass !ConsClass -> ConsClass
	combine_cons_constants cc1 cc2
		= min cc1 cc2
*/

::	ConsClassSubst	:== {# ConsClass}

cNope			:== -1

/*
	The argument classification (i.e. 'accumulating', 'active' or 'passive') of consumers
	is represented by a negative integer value.
	Positive classifications are used to identify variables.
	Unification of classifications is done on-the-fly
*/

:: ConsumerAnalysisRO = ConsumerAnalysisRO !ConsumerAnalysisRORecord;

:: ConsumerAnalysisRORecord =
	{ common_defs				:: !{# CommonDefs}
	, imported_funs				:: !{#{#FunType}}
	, main_dcl_module_n			:: !Int
	, stdStrictLists_module_n	:: !Int
	}

::	UnsafePatternBool :== Bool

not_an_unsafe_pattern (cc, _, ai) = (cc, False, ai)

class consumerRequirements a :: !a !ConsumerAnalysisRO !AnalyseInfo -> (!ConsClass, !UnsafePatternBool, !AnalyseInfo)

instance consumerRequirements BoundVar
where
398
	consumerRequirements {var_ident,var_info_ptr} _ ai=:{ai_var_heap}
399
		# (var_info, ai_var_heap)	= readPtr var_info_ptr ai_var_heap
John van Groningen's avatar
John van Groningen committed
400
		  ai						= {ai & ai_var_heap=ai_var_heap}
401
402
403
		= case var_info of
			VI_AccVar temp_var arg_position
				#! (ref_count,ai)	= ai!ai_cur_ref_counts.[arg_position] 
John van Groningen's avatar
John van Groningen committed
404
				   ai				= {ai & ai_cur_ref_counts.[arg_position] = inc_ref_count ref_count}
405
406
				-> (temp_var, False, ai)
			_
407
				-> abort ("consumerRequirements [BoundVar] " ---> (var_ident,var_info_ptr))
408
409
410
411
412
413
414
415

instance consumerRequirements Expression where
	consumerRequirements (Var var) common_defs ai
		= consumerRequirements var common_defs ai
	consumerRequirements (App app) common_defs ai
		= consumerRequirements app common_defs ai
	consumerRequirements (fun_expr @ exprs) common_defs ai
		# (cc_fun, _, ai)			= consumerRequirements fun_expr common_defs ai
416
		  ai						= aiUnifyClassifications CActive cc_fun ai
417
418
419
420
421
		= consumerRequirements exprs common_defs ai
	consumerRequirements (Let {let_strict_binds, let_lazy_binds,let_expr}) common_defs ai=:{ai_next_var,ai_next_var_of_fun,ai_var_heap}
		# let_binds					= let_strict_binds ++ let_lazy_binds
		# (new_next_var, new_ai_next_var_of_fun, ai_var_heap)
									= init_variables let_binds ai_next_var ai_next_var_of_fun ai_var_heap
John van Groningen's avatar
John van Groningen committed
422
		# ai						= {ai & ai_next_var = new_next_var, ai_next_var_of_fun = new_ai_next_var_of_fun, ai_var_heap = ai_var_heap}
423
		# ai						= acc_requirements_of_let_binds let_binds ai_next_var common_defs ai
John van Groningen's avatar
John van Groningen committed
424
		= consumerRequirements let_expr common_defs ai
425
426
427
428
429
430
431
432
		where
			init_variables [{lb_dst={fv_count, fv_info_ptr}} : binds] ai_next_var ai_next_var_of_fun ai_var_heap
				| fv_count > 0
					# ai_var_heap = writePtr fv_info_ptr (VI_AccVar ai_next_var ai_next_var_of_fun) ai_var_heap
					= init_variables binds (inc ai_next_var) (inc ai_next_var_of_fun) ai_var_heap
					= init_variables binds ai_next_var ai_next_var_of_fun ai_var_heap
			init_variables [] ai_next_var ai_next_var_of_fun ai_var_heap
				= (ai_next_var, ai_next_var_of_fun, ai_var_heap)
John van Groningen's avatar
John van Groningen committed
433

434
435
436
437
438
439
440
441
442
443
444
			acc_requirements_of_let_binds [ {lb_src, lb_dst} : binds ] ai_next_var common_defs ai
				| lb_dst.fv_count > 0
					# (bind_var, _, ai) = consumerRequirements lb_src common_defs ai
			  		  ai = aiUnifyClassifications ai_next_var bind_var ai
					= acc_requirements_of_let_binds binds (inc ai_next_var) common_defs ai
					= acc_requirements_of_let_binds binds ai_next_var common_defs ai
			acc_requirements_of_let_binds [] ai_next_var _ ai
				= ai
	consumerRequirements (Case case_expr) common_defs ai
		= consumerRequirements case_expr common_defs ai
	consumerRequirements (BasicExpr _) _ ai
445
		= (CPassive, False, ai)
446
447
	consumerRequirements (Selection _ expr selectors) common_defs ai
		# (cc, _, ai) = consumerRequirements expr common_defs ai
448
		  ai = aiUnifyClassifications CActive cc ai
449
		  ai = requirementsOfSelectors selectors common_defs ai
450
		= (CPassive, False, ai)
451
452
453
454
	consumerRequirements (Update expr1 selectors expr2) common_defs ai
		# (cc, _, ai) = consumerRequirements expr1 common_defs ai
		  ai = requirementsOfSelectors selectors common_defs ai
		  (cc, _, ai) = consumerRequirements expr2 common_defs ai
455
		= (CPassive, False, ai)
456
457
458
	consumerRequirements (RecordUpdate cons_symbol expression expressions) common_defs ai
		# (cc, _, ai) = consumerRequirements expression common_defs ai
		  (cc, _, ai) = consumerRequirements expressions common_defs ai
459
		= (CPassive, False, ai)
460
461
	consumerRequirements (TupleSelect tuple_symbol arg_nr expr) common_defs ai
		= consumerRequirements expr common_defs ai
462
463
464
465
	consumerRequirements (MatchExpr _ expr) common_defs ai
		= consumerRequirements expr common_defs ai
	consumerRequirements (IsConstructor expr _ _ _ _ _) common_defs ai
		= consumerRequirements expr common_defs ai
466
467
	consumerRequirements (AnyCodeExpr _ _ _) _ ai=:{ai_cur_ref_counts}
		#! s							= size ai_cur_ref_counts
468
		   twos_array					= n_twos_counts s
469
470
471
472
		   ai							= { ai & ai_cur_ref_counts=twos_array }
		= (CPassive, False, ai)
	consumerRequirements (ABCCodeExpr _ _) _ ai=:{ai_cur_ref_counts}
		#! s							= size ai_cur_ref_counts
473
		   twos_array					= n_twos_counts s
474
475
		   ai							= { ai & ai_cur_ref_counts=twos_array }
		= (CPassive, False, ai)
476
477
478
	consumerRequirements (DynamicExpr dynamic_expr) common_defs ai
		= consumerRequirements dynamic_expr common_defs ai
	consumerRequirements (TypeCodeExpression _) _ ai
479
		= (CPassive, False, ai)
480
	consumerRequirements EE _ ai
481
		= (CPassive, False, ai)
482
	consumerRequirements (NoBind _) _ ai
483
		= (CPassive, False, ai)
484
485
	consumerRequirements (FailExpr _) _ ai
		= (CPassive, False, ai)
486
	consumerRequirements expr _ ai
487
		= abort ("consumerRequirements [Expression]" ---> expr)
488
489
490
491
492
493
494
495
496
497

requirementsOfSelectors selectors common_defs ai
	= foldSt (reqs_of_selector common_defs) selectors ai
where
	reqs_of_selector common_defs (ArraySelection _ _ index_expr) ai
		# (_, _, ai) = consumerRequirements index_expr common_defs ai
		= ai
	reqs_of_selector common_defs (DictionarySelection dict_var _ _ index_expr) ai
		# (_, _, ai) = consumerRequirements index_expr common_defs ai
		  (cc_var, _, ai) = consumerRequirements dict_var common_defs ai
498
		= aiUnifyClassifications CActive cc_var ai
John van Groningen's avatar
John van Groningen committed
499
	reqs_of_selector common_defs (RecordSelection _ _) ai
500
		= ai
John van Groningen's avatar
John van Groningen committed
501

502
instance consumerRequirements App where
503
	consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object},symb_ident}, app_args}
504
			common_defs=:(ConsumerAnalysisRO {main_dcl_module_n,stdStrictLists_module_n,imported_funs})
505
			ai=:{ai_cons_class,ai_group_members}
506
507

		| glob_module == main_dcl_module_n
508
			| glob_object < size ai_cons_class
509
				# (fun_class, ai) = ai!ai_cons_class.[glob_object]
510
				| isComponentMember glob_object ai_group_members
511
512
513
					= reqs_of_args glob_object 0 fun_class.cc_args app_args CPassive common_defs ai
				= reqs_of_args (-1) 0 fun_class.cc_args app_args CPassive common_defs ai
			= consumerRequirements app_args common_defs ai
514

Diederik van Arkel's avatar
Diederik van Arkel committed
515
		| glob_module == stdStrictLists_module_n && (not (isEmpty app_args))
516
				&& is_nil_cons_or_decons_of_UList_or_UTSList glob_object glob_module imported_funs
John van Groningen's avatar
John van Groningen committed
517
			# [app_arg:app_args]=app_args
518
			# (cc, _, ai) = consumerRequirements app_arg common_defs ai
519
			# ai = aiUnifyClassifications CActive cc ai
520
			= consumerRequirements app_args common_defs ai
521
/*
522
523
524
525
526
527
528
529
530
531
532
533
534
535
// SPECIAL...
		# num_specials = case imported_funs.[glob_module].[glob_object].ft_specials of
			(SP_ContextTypes [sp:_])	-> length sp.spec_types
			_	-> 0
		| num_specials > 0 && num_specials <= length app_args
			= activeArgs num_specials app_args common_defs ai
			with
				activeArgs 0 app_args common_defs ai
					= consumerRequirements app_args common_defs ai			// treat remaining args normally...
				activeArgs n [app_arg:app_args] common_defs ai
					# (cc, _, ai)	= consumerRequirements app_arg common_defs ai
					# ai			= aiUnifyClassifications CActive cc ai	// make args for which specials exist active...
					= activeArgs (n-1) app_args common_defs ai
// ...SPECIAL
536
537
538
*/
// ACTIVATE DICTIONARIES... [SUBSUMES SPECIAL]
		# num_dicts = length imported_funs.[glob_module].[glob_object].ft_type.st_context
539
540
541
542
543
544

		# num_specials = case imported_funs.[glob_module].[glob_object].ft_specials of
			(SP_ContextTypes [sp:_])	-> length sp.spec_types
			_	-> 0
//		# num_dicts = num_dicts ---> ("NUM_DICTS",num_dicts,num_specials)

545
		| num_dicts > 0 && num_dicts <= length app_args
546
			= reqs_of_args (-1) 0 (repeatn num_dicts CActive ++ repeatn (imported_funs.[glob_module].[glob_object].ft_arity) CPassive) app_args CPassive common_defs ai
547
/* wrong version...
548
549
550
551
552
553
554
555
			= activeArgs num_dicts app_args common_defs ai
			with
				activeArgs 0 app_args common_defs ai
					= consumerRequirements app_args common_defs ai
				activeArgs n [app_arg:app_args] common_defs ai
					# (cc, _, ai)	= consumerRequirements app_arg common_defs ai
					# ai			= aiUnifyClassifications CActive cc ai
					= activeArgs (n-1) app_args common_defs ai
556
...*/
557
558
// ...ACTIVATE DICTIONARIES
		= consumerRequirements app_args common_defs ai
559
	consumerRequirements {app_symb={symb_kind = SK_LocalMacroFunction glob_object,symb_ident}, app_args}
560
			common_defs=:(ConsumerAnalysisRO {main_dcl_module_n})
561
			ai=:{ai_cons_class,ai_group_members}
562
		| glob_object < size ai_cons_class
563
			# (fun_class, ai) = ai!ai_cons_class.[glob_object]
564
			| isComponentMember glob_object ai_group_members
565
566
567
				= reqs_of_args glob_object 0 fun_class.cc_args app_args CPassive common_defs ai
			= reqs_of_args (-1) 0 fun_class.cc_args app_args CPassive common_defs ai
		= consumerRequirements app_args common_defs ai
Diederik van Arkel's avatar
Diederik van Arkel committed
568
569
	
	// new alternative for generated function + reanalysis...
570
	consumerRequirements {app_symb={symb_kind = SK_GeneratedFunction fun_info_ptr index,symb_ident}, app_args}
Diederik van Arkel's avatar
Diederik van Arkel committed
571
			common_defs
572
573
			ai=:{ai_group_members}
		# (FI_Function {gf_cons_args={cc_args,cc_linear_bits},gf_fun_def}, ai_fun_heap)
Diederik van Arkel's avatar
Diederik van Arkel committed
574
			= readPtr fun_info_ptr ai.ai_fun_heap
575
		# ai = {ai & ai_fun_heap = ai_fun_heap}
576
		| isComponentMember index ai_group_members
577
578
			= reqs_of_args index 0 cc_args app_args CPassive common_defs ai
		= reqs_of_args (-1) 0 cc_args app_args CPassive common_defs ai
John van Groningen's avatar
John van Groningen committed
579

580
581
582
	consumerRequirements {app_args} common_defs ai
		=  not_an_unsafe_pattern (consumerRequirements app_args common_defs ai)

583
584
585
586
587
588
589
isComponentMember index (ComponentMember member members)
	= index==member || isComponentMember index members
isComponentMember index (GeneratedComponentMember member _ members)
	= index==member || isComponentMember index members
isComponentMember index NoComponentMembers
	= False

590
591
592
instance <<< TypeContext
where
	(<<<) file co = file <<< co.tc_class <<< " " <<< co.tc_types <<< " <" <<< co.tc_var <<< '>'
John van Groningen's avatar
John van Groningen committed
593

594
595
596
instance <<< (Ptr a)
where
	(<<<) file p = file <<< ptrToInt p
Diederik van Arkel's avatar
Diederik van Arkel committed
597

598
599
reqs_of_args :: !Int !Int ![ConsClass] !.[Expression] ConsClass ConsumerAnalysisRO !*AnalyseInfo -> *(!ConsClass,!.Bool,!*AnalyseInfo)
reqs_of_args _ _ _ [] cumm_arg_class _ ai
600
	= (cumm_arg_class, False, ai)
601
reqs_of_args _ _ [] _ cumm_arg_class _ ai
602
	= (cumm_arg_class, False, ai)
John van Groningen's avatar
John van Groningen committed
603
reqs_of_args fun_idx arg_idx [form_cc : ccs] [Var arg : args] cumm_arg_class common_defs ai
604
605
606
607
	| fun_idx >= 0
		# (act_cc, _, ai) = consumerRequirements` arg common_defs ai
		  ai = aiUnifyClassifications form_cc act_cc ai
		= reqs_of_args fun_idx (inc arg_idx) ccs args (combineClasses act_cc cumm_arg_class) common_defs ai
608
where
609
	consumerRequirements` {var_info_ptr,var_ident} _ ai
610
611
612
613
		# (var_info, ai_var_heap)	= readPtr var_info_ptr ai.ai_var_heap
		  ai						= { ai & ai_var_heap=ai_var_heap }
		= case var_info of
			VI_AccVar temp_var arg_position
John van Groningen's avatar
John van Groningen committed
614
				#! (ref_count,ai)	= ai!ai_cur_ref_counts.[arg_position]
615
616
617
				   ai				= { ai & ai_cur_ref_counts.[arg_position] = add_dep_count (fun_idx,arg_idx) ref_count }
				-> (temp_var, False, ai)
			_
618
				-> abort "reqs_of_args [BoundVar]"
619
620
621
622
623

reqs_of_args fun_idx arg_idx [form_cc : ccs] [arg : args] cumm_arg_class common_defs ai
	# (act_cc, _, ai) = consumerRequirements arg common_defs ai
	  ai = aiUnifyClassifications form_cc act_cc ai
	= reqs_of_args fun_idx (inc arg_idx) ccs args (combineClasses act_cc cumm_arg_class) common_defs ai
624
625
reqs_of_args _ _ cc xp _ _ _
	= abort "classify:reqs_of_args doesn't match"
626
627

instance consumerRequirements Case where
Diederik van Arkel's avatar
Diederik van Arkel committed
628
	consumerRequirements kees=:{case_expr,case_guards,case_default,case_info_ptr,case_explicit}
629
630
				ro=:(ConsumerAnalysisRO {common_defs=common_defs_parameter}) ai=:{ai_cur_ref_counts}
		#  (cce, _, ai)					= consumerRequirements case_expr ro ai
Diederik van Arkel's avatar
Diederik van Arkel committed
631
632
		#! env_counts					= ai.ai_cur_ref_counts
		   (s,env_counts)				= usize env_counts
633
		   zero_array					= n_zero_counts s
Diederik van Arkel's avatar
Diederik van Arkel committed
634
		   ai							= {ai & ai_cur_ref_counts = zero_array}
635
		   (ccd, default_is_unsafe, ai)	= consumerRequirements case_default ro ai
636
637
638
639
640
641
642
643
644
645

		# (pattern_exprs,ai) = get_pattern_exprs_and_bind_pattern_vars case_guards ai
		  (ok_pattern_type,sorted_constructors_and_pattern_exprs)
		  	= sort_pattern_constructors_and_exprs pattern_exprs case_guards
		  (ccgs, constructors_and_unsafe_bits, ai)
			= caseAltsConsumerRequirements has_default ok_pattern_type sorted_constructors_and_pattern_exprs case_guards ro ai
		  ref_counts = ai.ai_cur_ref_counts

		  (every_constructor_appears_in_safe_pattern, may_be_active)
		  								= inspect_patterns common_defs_parameter has_default case_guards constructors_and_unsafe_bits
646
		  ref_counts = combine_counts ref_counts env_counts
647
		  ai = {ai & ai_cur_ref_counts = ref_counts }
Diederik van Arkel's avatar
Diederik van Arkel committed
648
649
650
651
652
		  safe = case_explicit || (has_default && not default_is_unsafe) || every_constructor_appears_in_safe_pattern
		  ai = aiUnifyClassifications (SwitchMultimatchClassification
		  		(if may_be_active CActive CVarOfMultimatchCase) 
		  		CActive)
		  		cce ai
653
654
		  ai = case case_expr of
				Var {var_info_ptr}
655
656
657
658
659
660
661
662
					| SwitchMultimatchClassification may_be_active True
						-> { ai & ai_cases_of_vars_for_function=[(safe,kees):ai.ai_cases_of_vars_for_function] }
						-> ai
// N-WAY...
//				_	-> ai
				_
					| SwitchMultimatchClassification may_be_active True
						-> { ai & ai_cases_of_vars_for_function=[(safe,kees):ai.ai_cases_of_vars_for_function] }
663
						-> ai
664
// ...N-WAY
665
		# ai = handle_overloaded_list_patterns case_guards ai
666
667
		= (combineClasses ccgs ccd, not safe, ai)
	  where
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
		handle_overloaded_list_patterns
					(OverloadedListPatterns (OverloadedList _ _ _ _) decons_expr=:(App {app_symb={symb_kind=SK_Function _},app_args=[app_arg]}) patterns)
					ai
						// decons_expr will be optimized to a decons_u Selector in transform
						# (cc, _, ai)	= consumerRequirements app_arg ro ai
						# ai = aiUnifyClassifications CActive cc ai
						= ai
		handle_overloaded_list_patterns
					(OverloadedListPatterns _ decons_expr _) ai
						# (_,_,ai) = consumerRequirements decons_expr ro ai
						= ai
		handle_overloaded_list_patterns
					_ ai
						= ai
		
Diederik van Arkel's avatar
Diederik van Arkel committed
683
684
685
		has_default					= case case_default of
										  		Yes _ -> True
										  		_ -> False
686

687
688
		inspect_patterns :: !{#CommonDefs} !Bool !CasePatterns ![(Int,Bool)] -> (!Bool,!Bool)
		inspect_patterns common_defs has_default (AlgebraicPatterns {glob_object,glob_module} _) constructors_and_unsafe_bits
Diederik van Arkel's avatar
Diederik van Arkel committed
689
690
691
692
693
694
695
696
			# type_def						= common_defs.[glob_module].com_type_defs.[glob_object]
			  defined_symbols				= case type_def.td_rhs of
													AlgType defined_symbols		-> defined_symbols
													RecordType {rt_constructor}	-> [rt_constructor]
			  all_constructors				= [ ds_index \\ {ds_index}<-defined_symbols ]
			  all_sorted_constructors		= if (is_sorted all_constructors)
			  										all_constructors
			  										(sortBy (<) all_constructors)
697
698
699
700
			= (appearance_loop all_sorted_constructors constructors_and_unsafe_bits, not (multimatch_loop has_default constructors_and_unsafe_bits))
		inspect_patterns common_defs has_default (BasicPatterns BT_Bool _) constructors_and_unsafe_bits
			= (appearance_loop [0,1] constructors_and_unsafe_bits, not (multimatch_loop has_default constructors_and_unsafe_bits))
		inspect_patterns common_defs has_default (OverloadedListPatterns overloaded_list _ _) constructors_and_unsafe_bits
701
			# type_def = case overloaded_list of
702
							UnboxedList {glob_module,glob_object} _ _ _
703
								-> common_defs.[glob_module].com_type_defs.[glob_object]
704
							UnboxedTailStrictList {glob_object,glob_module} _ _ _
705
								-> common_defs.[glob_module].com_type_defs.[glob_object]
706
							OverloadedList {glob_object,glob_module} _ _ _
707
708
709
710
711
712
								-> common_defs.[glob_module].com_type_defs.[glob_object]
			  defined_symbols = case type_def.td_rhs of
									AlgType defined_symbols		-> defined_symbols
									RecordType {rt_constructor}	-> [rt_constructor]
			  all_constructors = [ ds_index \\ {ds_index}<-defined_symbols ]
			  all_sorted_constructors = if (is_sorted all_constructors) all_constructors (sortBy (<) all_constructors)
713
			= (appearance_loop all_sorted_constructors constructors_and_unsafe_bits, not (multimatch_loop has_default constructors_and_unsafe_bits))
714
715
716
717
718
719
720
		inspect_patterns _ _ _ _
			= (False, False)

		is_sorted [x]
			= True
		is_sorted [h1:t=:[h2:_]]
			= h1 < h2 && is_sorted t
721
722
		is_sorted []
			= True
723
724
725
726
727

		appearance_loop [] _
			= True
		appearance_loop _ []
			= False
728
		appearance_loop l1=:[constructor_in_type:constructors_in_type] [(constructor_in_pattern,is_unsafe_pattern):constructors_in_pattern]
729
730
731
732
733
734
735
			| constructor_in_type < constructor_in_pattern
				= False
			// constructor_in_type==constructor_in_pattern
			| is_unsafe_pattern
				 // maybe there is another pattern that is safe for this constructor
				= appearance_loop l1 constructors_in_pattern
			// the constructor will match safely. Skip over patterns with the same constructor and test the following constructor
736
			= appearance_loop constructors_in_type (dropWhile (\(ds_index,_)->ds_index==constructor_in_pattern) constructors_in_pattern)
737
738
739

		multimatch_loop has_default []
			= False
740
		multimatch_loop has_default [(cip, iup):t]
741
742
743
744
			= a_loop has_default cip iup t
		  where
			a_loop has_default cip iup []
				= iup && has_default
745
			a_loop has_default cip iup [(constructor_in_pattern, is_unsafe_pattern):constructors_in_pattern]
746
747
748
749
750
751
				| cip<constructor_in_pattern
					| iup && has_default
						= True
					= a_loop has_default constructor_in_pattern is_unsafe_pattern constructors_in_pattern
				| iup
					= True
752
				= multimatch_loop has_default (dropWhile (\(ds_index,_)->ds_index==cip) constructors_in_pattern)
753

754
sort_pattern_constructors_and_exprs pattern_exprs case_guards
755
	| not ok_pattern_type
756
757
		= (False,[(i,i,pattern_expr) \\ pattern_expr<-pattern_exprs & i<-[0..]])
		= (True,sort pattern_constructors pattern_exprs)
758
where
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
	ok_pattern_type
		= case case_guards of
			AlgebraicPatterns _ _
				-> True
			BasicPatterns BT_Bool _
				-> True
			BasicPatterns BT_Int _
				-> True
//			BasicPatterns (BT_String _) basic_patterns)
//				-> [ string \\ {bp_value=BVS string}<-basic_patterns ] ---> ("BasicPatterns String")
			OverloadedListPatterns overloaded_list _ algebraic_patterns
				-> True
			_
				-> False

	pattern_constructors
		= case case_guards of
			AlgebraicPatterns _ algebraic_patterns
				-> [glob_object.ds_index \\ {ap_symbol={glob_object}}<-algebraic_patterns]
			BasicPatterns BT_Bool basic_patterns
				-> [if bool 1 0 \\ {bp_value=BVB bool}<-basic_patterns ]
			BasicPatterns BT_Int basic_patterns
				-> [int \\ {bp_value=BVInt int}<-basic_patterns ]
//			BasicPatterns (BT_String _) basic_patterns
//				-> [string \\ {bp_value=BVS string}<-basic_patterns]
			OverloadedListPatterns overloaded_list _ algebraic_patterns
				-> [glob_object.ds_index \\ {ap_symbol={glob_object}}<-algebraic_patterns]

	sort constr_indices pattern_exprs
		= sortBy smaller [(e1,e2,e3) \\ e1<-constr_indices & e2<-[0..] & e3<-pattern_exprs]
789
	  where
790
		smaller (i1,si1,_) (i2,si2,_)
791
792
793
			| i1<i2		= True
			| i1>i2		= False
						= si1<si2
794
795
796
797
798

get_pattern_exprs_and_bind_pattern_vars :: !CasePatterns !*AnalyseInfo -> *(![Expression],!*AnalyseInfo)
get_pattern_exprs_and_bind_pattern_vars (AlgebraicPatterns type patterns) ai
	# pattern_exprs = [ap_expr \\ {ap_expr}<-patterns]
	  pattern_vars = flatten [ ap_vars \\ {ap_vars}<-patterns]
Diederik van Arkel's avatar
Diederik van Arkel committed
799
800
	  (ai_next_var, ai_next_var_of_fun, ai_var_heap)
	  		= bindPatternVars pattern_vars ai.ai_next_var ai.ai_next_var_of_fun ai.ai_var_heap
801
802
803
804
805
806
807
808
	  ai = { ai & ai_var_heap=ai_var_heap, ai_next_var=ai_next_var, ai_next_var_of_fun = ai_next_var_of_fun }
	= (pattern_exprs,ai)
get_pattern_exprs_and_bind_pattern_vars (BasicPatterns type patterns) ai
	# pattern_exprs = [bp_expr \\ {bp_expr}<-patterns]
	= (pattern_exprs,ai)
get_pattern_exprs_and_bind_pattern_vars (OverloadedListPatterns type _ patterns) ai
	# pattern_exprs = [ap_expr \\ {ap_expr}<-patterns]
	  pattern_vars = flatten [ ap_vars \\ {ap_vars}<-patterns]
Diederik van Arkel's avatar
Diederik van Arkel committed
809
810
	  (ai_next_var, ai_next_var_of_fun, ai_var_heap)
	  		= bindPatternVars pattern_vars ai.ai_next_var ai.ai_next_var_of_fun ai.ai_var_heap
811
812
813
814
	  ai = { ai & ai_var_heap=ai_var_heap, ai_next_var=ai_next_var, ai_next_var_of_fun = ai_next_var_of_fun }
	= (pattern_exprs,ai)
get_pattern_exprs_and_bind_pattern_vars NoPattern ai
	= ([],ai)
815
816
817
818

bindPatternVars :: !.[FreeVar] !Int !Int !*VarHeap -> (!Int,!Int,!*VarHeap)
bindPatternVars [fv=:{fv_info_ptr,fv_count} : vars] next_var next_var_of_fun var_heap
	| fv_count > 0
819
820
821
822
823
		# var_heap	= writePtr fv_info_ptr (VI_AccVar next_var next_var_of_fun) var_heap
		= bindPatternVars vars (inc next_var) (inc next_var_of_fun) var_heap
	// otherwise
		# var_heap	= writePtr fv_info_ptr (VI_Count 0 False) var_heap
		= bindPatternVars vars next_var next_var_of_fun var_heap
824
825
826
bindPatternVars [] next_var next_var_of_fun var_heap
	= (next_var, next_var_of_fun, var_heap)

827
828
829
830
831
832
833
834
835
caseAltsConsumerRequirements :: !Bool !Bool ![(Int,Int,Expression)] !CasePatterns !ConsumerAnalysisRO !*AnalyseInfo
	-> (!ConsClass,![(Int,Bool)],!*AnalyseInfo)
caseAltsConsumerRequirements _ ok_pattern_type=:False exprs case_guards info ai
	# (constructors_and_unsafe_bits,(cc,ai))
		= mapSt (cons_reqs_not_ok_pattern_type info) exprs (CPassive, ai)
	  cur_ref_counts = ai.ai_cur_ref_counts
	  ref_counts = n_twos_counts (size cur_ref_counts)
	  ai & ai_cur_ref_counts = ref_counts
	= (cc,constructors_and_unsafe_bits,ai)
Diederik van Arkel's avatar
Diederik van Arkel committed
836
where
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
	cons_reqs_not_ok_pattern_type :: !ConsumerAnalysisRO !(Int,Int,Expression) !*(!Int,!*AnalyseInfo) -> *(!(!Int,!Bool),!*(!Int,!*AnalyseInfo))
	cons_reqs_not_ok_pattern_type info (c_index,_,expr) (cc,ai)
		# (cce, unsafe, ai) = consumerRequirements expr info ai
		# cc = combineClasses cce cc
		# ref_counts = ai.ai_cur_ref_counts
		#! count_size = size ref_counts
		# seq_0 = Seq 0 [|]
		# zero_array = {ref_counts & [i]=seq_0 \\ i<-[0..count_size-1]}
		= ((c_index,unsafe),(cc, {ai & ai_cur_ref_counts=zero_array}))
caseAltsConsumerRequirements has_default=:False True exprs case_guards info ai
	= cons_reqs exprs CPassive info ai
where
	cons_reqs :: ![(Int,Int,Expression)] !Int !ConsumerAnalysisRO !*AnalyseInfo -> *(!Int,![(Int,Bool)],!*AnalyseInfo)
	cons_reqs [(c_index,_,expr)] cc info ai
		# (cce, unsafe, ai) = consumerRequirements expr info ai
		  cc = combineClasses cce cc
		= (cc, [(c_index,unsafe)], ai)
	cons_reqs [(c_index,_,expr):exprs] cc info ai
		# (cce, unsafe, ai) = consumerRequirements expr info ai
		  cc = combineClasses cce cc
		# (cc,constructors_and_unsafe_bits,ai) = cons_reqs1 c_index cc unsafe exprs info ai
		= (cc,[(c_index,unsafe):constructors_and_unsafe_bits],ai)
	cons_reqs [] cc info ai
		= (cc,[],ai)

	// ai.ai_cur_ref_counts contains reference counts of previous alt(s) with same index
	cons_reqs1 :: !Int !Int !Bool ![(Int,Int,Expression)] !ConsumerAnalysisRO !*AnalyseInfo -> *(!Int,![(Int,Bool)],!*AnalyseInfo)
	cons_reqs1 c_index cc unsafe [(c_index2,_,expr2)] info ai
		# ref_counts = ai.ai_cur_ref_counts
		#! count_size = size ref_counts
		# ai & ai_cur_ref_counts = n_zero_counts count_size
		  (cce, unsafe2, ai) = consumerRequirements expr2 info ai
		  cc = combineClasses cce cc
		| c_index<>c_index2
			# ref_counts = unify_counts ai.ai_cur_ref_counts ref_counts
			  ai & ai_cur_ref_counts = ref_counts
			= (cc, [(c_index2,unsafe2)], ai)
			| not unsafe
				# ai & ai_cur_ref_counts = ref_counts
				= (cc, [(c_index2,unsafe2)], ai)
				# ai & ai_cur_ref_counts = combine_counts ai.ai_cur_ref_counts ref_counts
				= (cc, [(c_index2,unsafe2)], ai)				
	cons_reqs1 c_index cc unsafe [(c_index2,_,expr2):exprs] info ai
		# ref_counts = ai.ai_cur_ref_counts
		#! count_size = size ref_counts
		# ai & ai_cur_ref_counts = n_zero_counts count_size
		  (cce, unsafe2, ai) = consumerRequirements expr2 info ai
		  cc = combineClasses cce cc
		| c_index<>c_index2
			# (cc,constructors_and_unsafe_bits,ai) = cons_reqs2 c_index2 cc unsafe2 exprs ref_counts info ai
			= (cc,[(c_index2,unsafe2):constructors_and_unsafe_bits],ai)
			| not unsafe
				# ai & ai_cur_ref_counts = ref_counts
				  (cc,constructors_and_unsafe_bits,ai) = cons_reqs1 c_index cc unsafe exprs info ai				
				= (cc, [(c_index2,unsafe2):constructors_and_unsafe_bits], ai)
				# ai & ai_cur_ref_counts = combine_counts ai.ai_cur_ref_counts ref_counts
				  (cc,constructors_and_unsafe_bits,ai) = cons_reqs1 c_index cc unsafe2 exprs info ai				
				= (cc, [(c_index2,unsafe2):constructors_and_unsafe_bits], ai)

	// ai.ai_cur_ref_counts contains reference counts of previous alt(s) with same index
	cons_reqs2 :: !Int !Int !Bool ![(Int,Int,Expression)] !*RefCounts !ConsumerAnalysisRO !*AnalyseInfo -> *(!Int,![(Int,Bool)],!*AnalyseInfo)
	cons_reqs2 c_index cc unsafe [] ref_counts info ai
		# ai & ai_cur_ref_counts = unify_counts ai.ai_cur_ref_counts ref_counts
		= (cc, [], ai)
	cons_reqs2 c_index cc unsafe [(c_index2,_,expr2):exprs] ref_counts info ai
		| c_index2<>c_index
			# (zero_counts,ref_counts) = unify_and_zero_counts ai.ai_cur_ref_counts ref_counts
			  ai & ai_cur_ref_counts = zero_counts  
			  (cce, unsafe2, ai) = consumerRequirements expr2 info ai
			  cc = combineClasses cce cc
			  (cc,constructors_and_unsafe_bits,ai) = cons_reqs2 c_index2 cc unsafe2 exprs ref_counts info ai
			= (cc,[(c_index2,unsafe2):constructors_and_unsafe_bits],ai)
			# alt_ref_counts = ai.ai_cur_ref_counts
			#! count_size = size ref_counts
			# zero_array = n_zero_counts count_size
			  ai & ai_cur_ref_counts = zero_array
			  (cce, unsafe2, ai) = consumerRequirements expr2 info ai
			  cc = combineClasses cce cc
			| not unsafe
				# ai & ai_cur_ref_counts = alt_ref_counts
				  (cc,constructors_and_unsafe_bits,ai) = cons_reqs2 c_index cc unsafe exprs ref_counts info ai
				= (cc,[(c_index2,unsafe2):constructors_and_unsafe_bits],ai)
				# ai & ai_cur_ref_counts = combine_counts ai.ai_cur_ref_counts alt_ref_counts
				  (cc,constructors_and_unsafe_bits,ai) = cons_reqs2 c_index cc unsafe2 exprs ref_counts info ai
				= (cc,[(c_index2,unsafe2):constructors_and_unsafe_bits],ai)
caseAltsConsumerRequirements has_default=:True True exprs case_guards info ai
	# default_counts = ai.ai_cur_ref_counts
	  (initial_counts,default_counts) = arrayCopy default_counts
	  (count_size,default_counts) = usize default_counts
	  ai & ai_cur_ref_counts = n_zero_counts count_size
	= cons_reqs exprs CPassive initial_counts default_counts info ai
where
	cons_reqs :: ![(Int,Int,Expression)] !Int !*RefCounts !RefCounts !ConsumerAnalysisRO !*AnalyseInfo -> *(!Int,![(Int,Bool)],!*AnalyseInfo)
	cons_reqs [(c_index,unsafe,expr)] cc ref_counts default_counts info ai
		# (cce, unsafe, ai) = consumerRequirements expr info ai
		  cc = combineClasses cce cc
		  alt_ref_counts = ai.ai_cur_ref_counts
		  alt_ref_counts = if unsafe (combine_counts default_counts alt_ref_counts) alt_ref_counts
		  ai & ai_cur_ref_counts = unify_counts alt_ref_counts ref_counts
		= (cc, [(c_index,unsafe)], ai)
	cons_reqs [(c_index,_,expr):exprs] cc ref_counts default_counts info ai
		# (cce, unsafe, ai) = consumerRequirements expr info ai
		  cc = combineClasses cce cc
		  (cc,constructors_and_unsafe_bits,ai) = cons_reqs2 c_index cc unsafe exprs ref_counts default_counts info ai
		= (cc, [(c_index,unsafe):constructors_and_unsafe_bits], ai)
	cons_reqs [] cc ref_counts default_counts info ai
		# ai & ai_cur_ref_counts = ref_counts
		= (cc,[],ai)

	// ai.ai_cur_ref_counts contains reference counts of previous alt(s) with same index
	cons_reqs2 :: !Int !Int !Bool ![(Int,Int,Expression)] !*RefCounts !RefCounts !ConsumerAnalysisRO !*AnalyseInfo -> *(!Int,![(Int,Bool)],!*AnalyseInfo)
	cons_reqs2 c_index cc unsafe [] ref_counts default_counts info ai
		# alt_ref_counts = ai.ai_cur_ref_counts
		  alt_ref_counts = if unsafe (combine_counts default_counts alt_ref_counts) alt_ref_counts
		  ai & ai_cur_ref_counts = unify_counts alt_ref_counts ref_counts
		= (cc, [], ai)
	cons_reqs2 c_index cc unsafe [(c_index2,_,expr2):exprs] ref_counts default_counts info ai
		| c_index2<>c_index
			# alt_ref_counts = ai.ai_cur_ref_counts
			  alt_ref_counts = if unsafe (combine_counts default_counts alt_ref_counts) alt_ref_counts
			  (zero_ref_counts,ref_counts) = unify_and_zero_counts alt_ref_counts ref_counts
			  ai & ai_cur_ref_counts = zero_ref_counts
			  (cce, unsafe2, ai) = consumerRequirements expr2 info ai
			  cc = combineClasses cce cc
			  (cc,constructors_and_unsafe_bits,ai) = cons_reqs2 c_index2 cc unsafe2 exprs ref_counts default_counts info ai
			= (cc, [(c_index2,unsafe2):constructors_and_unsafe_bits], ai)
			# alt_ref_counts = ai.ai_cur_ref_counts
			#! count_size = size ref_counts
			# zero_array = n_zero_counts count_size
			  ai & ai_cur_ref_counts = zero_array
			  (cce, unsafe2, ai) = consumerRequirements expr2 info ai
			  cc = combineClasses cce cc
			| not unsafe
				# ai & ai_cur_ref_counts = alt_ref_counts
				  (cc,constructors_and_unsafe_bits,ai) = cons_reqs2 c_index cc unsafe exprs ref_counts default_counts info ai
				= (cc, [(c_index2,unsafe2):constructors_and_unsafe_bits], ai)
				# ai & ai_cur_ref_counts = combine_counts ai.ai_cur_ref_counts alt_ref_counts
				  (cc,constructors_and_unsafe_bits,ai) = cons_reqs2 c_index2 cc unsafe2 exprs ref_counts default_counts info ai
				= (cc,[(c_index2,unsafe2):constructors_and_unsafe_bits],ai)
Diederik van Arkel's avatar
Diederik van Arkel committed
976

977
978
979
980
981
982
983
984
985
986
987
988
instance consumerRequirements DynamicExpr where
	consumerRequirements {dyn_expr} common_defs ai
		= consumerRequirements dyn_expr common_defs ai

instance consumerRequirements BasicPattern where
	consumerRequirements {bp_expr} common_defs ai
		= consumerRequirements bp_expr common_defs ai

instance consumerRequirements (Optional a) | consumerRequirements a where
	consumerRequirements (Yes x) common_defs ai
		= consumerRequirements x common_defs ai
	consumerRequirements No _ ai
989
		= (CPassive, False, ai)
990
991
992
993
994
995

instance consumerRequirements (!a,!b) | consumerRequirements a & consumerRequirements b where
	consumerRequirements (x, y) common_defs ai
		# (ccx, _, ai) = consumerRequirements x common_defs ai
		  (ccy, _, ai) = consumerRequirements y common_defs ai
		= (combineClasses ccx ccy, False, ai)
John van Groningen's avatar
John van Groningen committed
996

997
998
instance consumerRequirements [a] | consumerRequirements a where
	consumerRequirements [x : xs] common_defs ai
Diederik van Arkel's avatar
Diederik van Arkel committed
999
		# (ccx,  _, ai) = consumerRequirements x  common_defs ai
1000
		  (ccxs, _, ai) = consumerRequirements xs common_defs ai
For faster browsing, not all history is shown. View entire blame