checkFunctionBodies.icl 130 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
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
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
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
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
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
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
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
implementation module checkFunctionBodies

import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef //, RWSDebug
import explicitimports, comparedefimp

cIsInExpressionList		:== True
cIsNotInExpressionList	:== False

cEndWithUpdate			:== True
cEndWithSelection		:== False

::	ExpressionState =
	{	es_expr_heap	:: !.ExpressionHeap
	,	es_var_heap			:: !.VarHeap
	,	es_type_heaps		:: !.TypeHeaps
	,	es_calls			:: ![FunCall]
	,	es_dynamics			:: ![ExprInfoPtr]
	,	es_fun_defs			:: !.{# FunDef}
	}
	
::	ExpressionInput =
	{	ei_expr_level	:: !Level
	,	ei_fun_index	:: !Index
	,	ei_fun_level	:: !Level
	,	ei_mod_index	:: !Index
//	,	ei_fun_kind		:: !FunKind
	}

::	PatternState =
	{	ps_var_heap :: !.VarHeap
	,	ps_fun_defs :: !.{# FunDef}
	}

::	PatternInput =
	{	pi_def_level		:: !Int
	,	pi_mod_index		:: !Index
	,	pi_is_node_pattern	:: !Bool
	}
	
::	ArrayPattern =
	{	ap_opt_var		:: !Optional (Bind Ident VarInfoPtr)
	,	ap_array_var	:: !FreeVar
	,	ap_selections	:: ![Bind FreeVar [ParsedExpr]]
	}

::	UnfoldMacroState =
	{	ums_var_heap	:: !.VarHeap
	,	ums_modules		:: !.{# DclModule}
	,	ums_cons_defs	:: !.{# ConsDef}
	,	ums_error		:: !.ErrorAdmin
	}

::	RecordKind = RK_Constructor | RK_Update | RK_UpdateToConstructor ![AuxiliaryPattern]

checkFunctionBodies :: !FunctionBody !.ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState -> (FunctionBody,[FreeVar],!.ExpressionState,.ExpressionInfo,!.CheckState);
checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}, pb_position} : bodies]) e_input=:{ei_expr_level,ei_mod_index}
		e_state=:{es_var_heap, es_fun_defs} e_info cs
	# (aux_patterns, (var_env, array_patterns), {ps_var_heap, ps_fun_defs}, e_info, cs)
			= check_patterns pb_args {pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False} ([], [])
							{ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs 
	  (rhs_expr, free_vars, e_state, e_info, cs)
	  		= checkRhs [] rhs_alts rhs_locals e_input { e_state & es_var_heap = ps_var_heap, es_fun_defs = ps_fun_defs } e_info cs
	  (dynamics_in_rhs, e_state)
	  		= e_state!es_dynamics
	  (expr_with_array_selections, free_vars, e_state=:{es_var_heap}, e_info, cs)
			= addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs
	  cs_symbol_table = removeLocalIdentsFromSymbolTable ei_expr_level var_env cs.cs_symbol_table
	  (cb_args, es_var_heap) = mapSt determine_function_arg aux_patterns es_var_heap
	  (rhss, free_vars, e_state=:{es_dynamics,es_expr_heap,es_var_heap}, e_info, cs)
	  		= check_function_bodies free_vars cb_args bodies e_input { e_state & es_dynamics = [], es_var_heap = es_var_heap } e_info
	  								{ cs & cs_symbol_table = cs_symbol_table }
	  (rhs, position, es_var_heap, es_expr_heap, dynamics_in_patterns, cs)
	  		= transform_patterns_into_cases aux_patterns cb_args expr_with_array_selections pb_position es_var_heap es_expr_heap
	  										dynamics_in_rhs cs
	= (CheckedBody { cb_args = cb_args, cb_rhs = [{ ca_rhs = rhs, ca_position = position } : rhss] }, free_vars,
		{ e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap, es_dynamics = dynamics_in_patterns ++ es_dynamics }, e_info, cs)
where
	check_patterns [pattern : patterns] p_input accus var_store e_info cs
		# (aux_pat, accus, var_store, e_info, cs) = checkPattern pattern No p_input accus var_store e_info cs
		  (aux_pats, accus, var_store, e_info, cs) = check_patterns patterns p_input accus var_store e_info cs
		= ([aux_pat : aux_pats], accus, var_store, e_info, cs)
	check_patterns [] p_input accus var_store e_info cs
		= ([], accus, var_store, e_info, cs)

	determine_function_arg (AP_Variable name var_info (Yes {bind_src, bind_dst})) var_store
		= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store)
	determine_function_arg (AP_Variable name var_info No) var_store
		= ({ fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, var_store)
	determine_function_arg (AP_Algebraic _ _ _ opt_var) var_store
		# ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
		= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store)
	determine_function_arg (AP_Basic _ opt_var) var_store
		# ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
		= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store)
	determine_function_arg (AP_Dynamic _ _ opt_var) var_store
		# ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
		= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store)
	determine_function_arg _ var_store
		# ({bind_src,bind_dst}, var_store) = determinePatternVariable No var_store
		= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store)
	
	check_function_bodies free_vars fun_args [{pb_args,pb_rhs={rhs_alts,rhs_locals},pb_position} : bodies]
							e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap,es_fun_defs} e_info cs
		# (aux_patterns, (var_env, array_patterns), {ps_var_heap, ps_fun_defs}, e_info, cs)
				= check_patterns pb_args { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], [])
					{ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs
		  e_state = { e_state & es_var_heap = ps_var_heap, es_fun_defs = ps_fun_defs}
		  (rhs_expr, free_vars, e_state, e_info, cs) = checkRhs free_vars rhs_alts rhs_locals e_input e_state e_info cs
		  (rhs_expr, free_vars, e_state=:{es_dynamics=dynamics_in_rhs}, e_info, cs)
				= addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs
	 	  cs_symbol_table = removeLocalIdentsFromSymbolTable ei_expr_level var_env cs.cs_symbol_table
		  (rhs_exprs, free_vars, e_state=:{es_dynamics,es_expr_heap,es_var_heap}, e_info, cs)
		  		= check_function_bodies free_vars fun_args bodies e_input { e_state & es_dynamics = [] } e_info { cs & cs_symbol_table = cs_symbol_table }
		  (rhs_expr, position, es_var_heap, es_expr_heap, dynamics_in_patterns, cs)
		  		= transform_patterns_into_cases aux_patterns fun_args rhs_expr pb_position
		  										 es_var_heap es_expr_heap dynamics_in_rhs cs
		= ([{ ca_rhs = rhs_expr, ca_position = position } : rhs_exprs], free_vars,
			{ e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap,
			es_dynamics = dynamics_in_patterns ++ es_dynamics }, e_info, cs)
	check_function_bodies free_vars fun_args [] e_input e_state e_info cs
		= ([], free_vars, e_state, e_info, cs) 
		
	transform_patterns_into_cases [pattern : patterns] [fun_arg : fun_args] result_expr pattern_position
									var_store expr_heap opt_dynamics cs
		# (patterns_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
				= transform_succeeding_patterns_into_cases patterns fun_args result_expr pattern_position
															var_store expr_heap opt_dynamics cs
		= transform_pattern_into_cases pattern fun_arg patterns_expr pattern_position var_store expr_heap opt_dynamics cs
	where
		transform_succeeding_patterns_into_cases [] _ result_expr pattern_position var_store expr_heap opt_dynamics cs
			= (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
		transform_succeeding_patterns_into_cases [pattern : patterns] [fun_arg : fun_args] result_expr pattern_position
												var_store expr_heap opt_dynamics cs
			# (patterns_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
				= transform_succeeding_patterns_into_cases patterns fun_args result_expr pattern_position
															var_store expr_heap opt_dynamics cs
			= transform_pattern_into_cases pattern fun_arg patterns_expr pattern_position var_store expr_heap opt_dynamics cs

	transform_patterns_into_cases [] _ result_expr pattern_position var_store expr_heap opt_dynamics cs
		= (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)

	transform_pattern_into_cases :: !AuxiliaryPattern !FreeVar !Expression !Position !*VarHeap !*ExpressionHeap ![DynamicPtr] !*CheckState
		-> (!Expression, !Position, !*VarHeap, !*ExpressionHeap, ![DynamicPtr], !*CheckState)
	transform_pattern_into_cases (AP_Variable name var_info opt_var) fun_arg=:{fv_info_ptr,fv_name} result_expr pattern_position
									var_store expr_heap opt_dynamics cs
		= case opt_var of
			Yes {bind_src, bind_dst}
				| bind_dst == fv_info_ptr
					# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
					  (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
					-> (Let { let_strict_binds = [], let_lazy_binds= [
								{ lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr },
									lb_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 },
									lb_position = NoPos }],
							  let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos }, 
						pattern_position, var_store, expr_heap, opt_dynamics, cs)
					# (var_expr_ptr1, expr_heap) = newPtr EI_Empty expr_heap
					  (var_expr_ptr2, expr_heap) = newPtr EI_Empty expr_heap
					  (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
					-> (Let { let_strict_binds = [], let_lazy_binds= [
								{ lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr1 },
									lb_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 },
									lb_position = NoPos },
								{ lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 },
									lb_dst = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 },
									lb_position = NoPos }],
							  let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos }, 
						pattern_position, var_store, expr_heap, opt_dynamics, cs)
			No
				| var_info == fv_info_ptr
					-> (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
					# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
					  (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
					-> (Let { let_strict_binds = [], let_lazy_binds=
									[{ lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr },
										 lb_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 },
										 lb_position = NoPos }],
							  let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos },
						pattern_position, var_store, expr_heap, opt_dynamics, cs)

	transform_pattern_into_cases (AP_Algebraic cons_symbol type_index args opt_var) fun_arg result_expr pattern_position
									var_store expr_heap opt_dynamics cs
		# (var_args, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
				= convertSubPatterns args result_expr pattern_position var_store expr_heap opt_dynamics cs
		  type_symbol = {glob_module = cons_symbol.glob_module, glob_object = type_index}
	  	  (act_var, result_expr, expr_heap) = transform_pattern_variable fun_arg opt_var result_expr expr_heap
		  alg_pattern = { ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = pattern_position }
	  	  case_guards = AlgebraicPatterns type_symbol [alg_pattern]
		  (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
		= (Case { case_expr = act_var, case_guards = case_guards, case_default = No, case_ident = No,
				case_info_ptr = case_expr_ptr, case_default_pos = NoPos },
				NoPos, var_store, expr_heap, opt_dynamics, cs)	
	transform_pattern_into_cases (AP_Basic basic_val opt_var) fun_arg result_expr pattern_position var_store expr_heap opt_dynamics cs
		# (basic_type, cs) = typeOfBasicValue basic_val cs
	  	  (act_var, result_expr, expr_heap) = transform_pattern_variable fun_arg opt_var result_expr expr_heap
		  case_guards = BasicPatterns basic_type [{ bp_value = basic_val, bp_expr = result_expr, bp_position = pattern_position }]
		  (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
		= (Case { case_expr = act_var, case_guards = case_guards, case_default = No, case_ident = No,
					case_info_ptr = case_expr_ptr, case_default_pos = NoPos },
			NoPos, var_store, expr_heap, opt_dynamics, cs)	
	transform_pattern_into_cases (AP_Dynamic pattern type opt_var) fun_arg result_expr pattern_position var_store expr_heap opt_dynamics cs
		# (var_arg, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
				= convertSubPattern pattern result_expr pattern_position var_store expr_heap opt_dynamics cs
		  (type_case_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
		  (dynamic_info_ptr, expr_heap) = newPtr (EI_DynamicType type opt_dynamics) expr_heap
	  	  (act_var, result_expr, expr_heap) = transform_pattern_variable fun_arg opt_var result_expr expr_heap
	  	  type_case_patterns = [{ dp_var = var_arg, dp_type	= dynamic_info_ptr,	dp_rhs = result_expr, dp_type_patterns_vars = [],
	  	  							dp_type_code = TCE_Empty, dp_position = pattern_position }]
		= (buildTypeCase act_var type_case_patterns No type_case_info_ptr, NoPos, var_store, expr_heap, [dynamic_info_ptr], cs)	
	transform_pattern_into_cases (AP_WildCard _) fun_arg result_expr pattern_position var_store expr_heap opt_dynamics cs
		= (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)	
	transform_pattern_into_cases (AP_Empty name) fun_arg result_expr pattern_position var_store expr_heap opt_dynamics cs
		= (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)

	transform_pattern_variable :: !FreeVar !(Optional !(Bind Ident VarInfoPtr)) !Expression !*ExpressionHeap
		-> (!Expression, !Expression, !*ExpressionHeap)
	transform_pattern_variable {fv_info_ptr,fv_name} (Yes {bind_src,bind_dst}) result_expr expr_heap
		| bind_dst == fv_info_ptr
			# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
			= (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, result_expr, expr_heap)
			# (var_expr_ptr1, expr_heap) = newPtr EI_Empty expr_heap
			  (var_expr_ptr2, expr_heap) = newPtr EI_Empty expr_heap
			  (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
			= (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr1 },
						Let { let_strict_binds = [], let_lazy_binds =
						 		[{ lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 },
									lb_dst = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 },
									lb_position = NoPos }],
							  let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos }, expr_heap)
	transform_pattern_variable {fv_info_ptr,fv_name} No result_expr expr_heap
		# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
		= (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, result_expr, expr_heap)

checkRhs :: [FreeVar] OptGuardedAlts LocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
checkRhs free_vars rhs_alts rhs_locals e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
	# ei_expr_level = inc ei_expr_level
	  (loc_defs, (var_env, array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index rhs_locals e_state e_info cs
	  (es_fun_defs, e_info, heaps, cs)
	  		= checkLocalFunctions ei_mod_index ei_expr_level rhs_locals e_state.es_fun_defs e_info
	  			{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs
	  (rhs_expr, free_vars, e_state, e_info, cs) 
	  		= check_opt_guarded_alts free_vars rhs_alts { e_input & ei_expr_level = ei_expr_level }
	  			{ e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap, es_expr_heap = heaps.hp_expression_heap,
					es_type_heaps = heaps.hp_type_heaps } e_info cs
	  (expr, free_vars, e_state, e_info, cs)
			= addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs
	  (expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs expr e_input e_state e_info cs
	  (es_fun_defs, cs_symbol_table) = removeLocalsFromSymbolTable ei_expr_level var_env rhs_locals e_state.es_fun_defs cs.cs_symbol_table
	= (expr, free_vars, { e_state & es_fun_defs = es_fun_defs}, e_info, { cs & cs_symbol_table = cs_symbol_table })
where
	check_opt_guarded_alts free_vars (GuardedAlts guarded_alts default_expr) e_input e_state e_info cs
		# (let_vars_list, rev_guarded_exprs, last_expr_level, free_vars, e_state, e_info, cs)
				= check_guarded_expressions free_vars guarded_alts [] [] e_input e_state e_info cs
		  (default_expr, free_vars, e_state, e_info, cs)
		  		= check_default_expr free_vars default_expr { e_input & ei_expr_level = last_expr_level } e_state e_info cs
		  cs = { cs & cs_symbol_table = remove_seq_let_vars e_input.ei_expr_level let_vars_list cs.cs_symbol_table }
	  	  (_, result_expr, es_expr_heap) = convert_guards_to_cases rev_guarded_exprs default_expr e_state.es_expr_heap
	  	= (result_expr, free_vars, { e_state & es_expr_heap = es_expr_heap }, e_info, cs)
	check_opt_guarded_alts free_vars (UnGuardedExpr unguarded_expr) e_input e_state e_info cs
		= check_unguarded_expression free_vars unguarded_expr e_input e_state e_info cs

	check_default_expr free_vars (Yes default_expr) e_input e_state e_info cs
		# (expr, free_vars, e_state, e_info, cs) = check_unguarded_expression free_vars default_expr e_input e_state e_info cs
		= (Yes expr, free_vars, e_state, e_info, cs)
	check_default_expr free_vars No e_input e_state e_info cs
		= (No, free_vars, e_state, e_info, cs)
		
	convert_guards_to_cases [(let_binds, guard, expr, guard_ident)] result_expr es_expr_heap
		# (case_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
		  basic_pattern = {bp_value = (BVB True), bp_expr = expr, bp_position = NoPos }
		  case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [basic_pattern],
		  		case_default = result_expr, case_ident = Yes guard_ident,
		  		case_info_ptr = case_expr_ptr, case_default_pos = NoPos }
		= build_sequential_lets let_binds case_expr NoPos es_expr_heap
	convert_guards_to_cases [(let_binds, guard, expr, guard_ident) : rev_guarded_exprs] result_expr es_expr_heap
		# (case_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
		  basic_pattern = {bp_value = (BVB True), bp_expr = expr, bp_position = NoPos }
		  case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [basic_pattern],
		  		case_default = result_expr, case_ident = Yes guard_ident,
		  		case_info_ptr = case_expr_ptr, case_default_pos = NoPos }
		  (_, result_expr, es_expr_heap) = build_sequential_lets let_binds case_expr NoPos es_expr_heap
		= convert_guards_to_cases rev_guarded_exprs (Yes result_expr) es_expr_heap
	
	check_guarded_expressions free_vars [gexpr : gexprs] let_vars_list rev_guarded_exprs e_input e_state e_info cs
		# (let_vars_list, rev_guarded_exprs, ei_expr_level, free_vars, e_state, e_info, cs)
				= check_guarded_expression free_vars gexpr let_vars_list rev_guarded_exprs e_input e_state e_info cs
		= check_guarded_expressions free_vars gexprs let_vars_list rev_guarded_exprs { e_input & ei_expr_level = ei_expr_level } e_state e_info cs
	check_guarded_expressions free_vars [] let_vars_list rev_guarded_exprs {ei_expr_level} e_state e_info cs
		= (let_vars_list, rev_guarded_exprs, ei_expr_level, free_vars, e_state, e_info, cs)

	check_guarded_expression free_vars {alt_nodes,alt_guard,alt_expr,alt_ident,alt_position}
			let_vars_list rev_guarded_exprs e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
		# (let_binds, let_vars_list, ei_expr_level, free_vars, e_state, e_info, cs) = check_sequential_lets free_vars alt_nodes let_vars_list
		  		{ e_input & ei_expr_level = inc ei_expr_level } e_state e_info cs
		  e_input = { e_input & ei_expr_level = ei_expr_level }
		  cs = pushErrorAdmin2 "guard" alt_position cs
	  	  (guard, free_vars, e_state, e_info, cs) = checkExpression free_vars alt_guard e_input e_state e_info cs
		  cs = popErrorAdmin cs
		  (expr, free_vars, e_state, e_info, cs) = check_opt_guarded_alts free_vars alt_expr e_input e_state e_info cs
	  	= (let_vars_list, [(let_binds, guard, expr, alt_ident) : rev_guarded_exprs], ei_expr_level, free_vars, e_state, e_info,  cs )

	check_unguarded_expression :: [FreeVar] ExprWithLocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
	check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals,ewl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
		# this_expr_level = inc ei_expr_level
		  (loc_defs, (var_env, array_patterns), e_state, e_info, cs)
		 		= checkLhssOfLocalDefs this_expr_level ei_mod_index ewl_locals e_state e_info cs
		  (binds, let_vars_list, rhs_expr_level, free_vars, e_state, e_info, cs) = check_sequential_lets free_vars ewl_nodes [] { e_input & ei_expr_level = this_expr_level } e_state e_info cs
		  cs = pushErrorAdmin2 "" ewl_position cs
	  	  (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars ewl_expr { e_input & ei_expr_level = rhs_expr_level } e_state e_info cs
		  cs = popErrorAdmin cs
		  (expr, free_vars, e_state, e_info, cs)
				= addArraySelections array_patterns expr free_vars e_input e_state e_info cs
		  cs = { cs & cs_symbol_table = remove_seq_let_vars rhs_expr_level let_vars_list cs.cs_symbol_table }
		  (_, seq_let_expr, es_expr_heap) = build_sequential_lets binds expr ewl_position e_state.es_expr_heap
	  	  (expr, free_vars, e_state, e_info, cs)
				= checkRhssAndTransformLocalDefs free_vars loc_defs seq_let_expr e_input { e_state & es_expr_heap = es_expr_heap} e_info cs
	  	  (es_fun_defs, e_info, heaps, cs)
	  	  		= checkLocalFunctions ei_mod_index rhs_expr_level ewl_locals e_state.es_fun_defs e_info 
	  	  		{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs
		  (es_fun_defs, cs_symbol_table) = removeLocalsFromSymbolTable this_expr_level var_env ewl_locals es_fun_defs cs.cs_symbol_table
	  	= (expr, free_vars, {e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap,
	  			es_expr_heap = heaps.hp_expression_heap, es_type_heaps = heaps.hp_type_heaps }, e_info, { cs & cs_symbol_table = cs_symbol_table} )
	
	remove_seq_let_vars level [] symbol_table
		= symbol_table
	remove_seq_let_vars level [let_vars : let_vars_list] symbol_table
		= remove_seq_let_vars (dec level) let_vars_list (removeLocalIdentsFromSymbolTable level let_vars symbol_table)
	
	check_sequential_lets :: [FreeVar] [NodeDefWithLocals] u:[[Ident]] !ExpressionInput *ExpressionState *ExpressionInfo *CheckState 
						-> *(![.([LetBind],![LetBind])],!u:[[Ident]],!Int,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
	check_sequential_lets free_vars [seq_let:seq_lets] let_vars_list e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
		# ei_expr_level
				= inc ei_expr_level
		  e_input
		  		= { e_input & ei_expr_level = ei_expr_level }
		  (src_expr, pattern_expr, (let_vars, array_patterns), free_vars, e_state, e_info, cs)
		  		= check_sequential_let free_vars seq_let e_input e_state e_info cs
	      (binds, loc_envs, max_expr_level, free_vars, e_state, e_info, cs)
	      		= check_sequential_lets free_vars seq_lets [let_vars : let_vars_list] e_input e_state e_info cs
		  (let_binds, es_var_heap, es_expr_heap, e_info, cs)
				= transfromPatternIntoBind ei_mod_index ei_expr_level pattern_expr src_expr seq_let.ndwl_position
						e_state.es_var_heap e_state.es_expr_heap e_info cs
		  e_state
		  		= { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap }
		  (strict_array_pattern_binds, lazy_array_pattern_binds, free_vars, e_state, e_info, cs)
				= foldSt (buildSelections e_input) array_patterns ([], [], free_vars, e_state, e_info, cs)
		  all_binds
		  		= [if seq_let.ndwl_strict (s, l) ([],let_binds), (strict_array_pattern_binds, lazy_array_pattern_binds) : binds]
		    with (l,s) = splitAt ((length let_binds)-1) let_binds
	    = (all_binds, loc_envs, max_expr_level, free_vars, e_state, e_info, cs)
	check_sequential_lets free_vars [] let_vars_list e_input=:{ei_expr_level} e_state e_info cs
		= ([], let_vars_list, ei_expr_level, free_vars, e_state, e_info, cs)

	check_sequential_let :: [FreeVar] NodeDefWithLocals ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,!AuxiliaryPattern,!(![Ident],![ArrayPattern]),![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
	check_sequential_let free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals, ndwl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
		# cs = pushErrorAdmin (newPosition {id_name="node definition", id_info=nilPtr} ndwl_position) cs
		  (loc_defs, (loc_env, loc_array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index ndwl_locals e_state e_info cs
		  (src_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars bind_src e_input e_state e_info cs
		  (src_expr, free_vars, e_state, e_info, cs)
				= addArraySelections loc_array_patterns src_expr free_vars e_input e_state e_info cs
		  (src_expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs src_expr e_input e_state e_info cs
		  (es_fun_defs, e_info, {hp_var_heap,hp_expression_heap,hp_type_heaps}, cs)
				= checkLocalFunctions ei_mod_index ei_expr_level ndwl_locals e_state.es_fun_defs e_info
	  				{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs
	  	  (es_fun_defs, cs_symbol_table) = removeLocalsFromSymbolTable ei_expr_level loc_env ndwl_locals es_fun_defs cs.cs_symbol_table
		  (pattern, accus, {ps_fun_defs,ps_var_heap}, e_info, cs)
				= checkPattern bind_dst No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = True } ([], []) 
					{ps_var_heap = hp_var_heap, ps_fun_defs = es_fun_defs } e_info { cs & cs_symbol_table = cs_symbol_table }
		  e_state = { e_state & es_var_heap = ps_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps, es_fun_defs = ps_fun_defs }
		= (src_expr, pattern, accus, free_vars, e_state, e_info, popErrorAdmin cs)
	
	build_sequential_lets :: ![(![LetBind],![LetBind])] !Expression !Position !*ExpressionHeap -> (!Position, !Expression, !*ExpressionHeap)
	build_sequential_lets [] expr let_expr_position expr_heap
		= (let_expr_position, expr, expr_heap)
	build_sequential_lets [(strict_binds, lazy_binds) : seq_lets] expr let_expr_position expr_heap
		# (let_expr_position, let_expr, expr_heap) = build_sequential_lets seq_lets expr let_expr_position expr_heap
	  	  (let_expr, expr_heap) = buildLetExpression strict_binds lazy_binds let_expr let_expr_position expr_heap
		= (if (isEmpty strict_binds && isEmpty lazy_binds) let_expr_position NoPos, let_expr, expr_heap)

checkExpression :: ![FreeVar] !ParsedExpr !ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState
	-> *(!Expression, ![FreeVar], !*ExpressionState, !*ExpressionInfo, !*CheckState);
checkExpression free_vars (PE_List exprs) e_input e_state e_info cs	
	# (exprs, free_vars, e_state, e_info, cs) = check_expressions free_vars exprs e_input e_state e_info cs
	  (expr, e_state, cs_error) = build_expression exprs e_state cs.cs_error
	= (expr, free_vars, e_state, e_info, { cs & cs_error = cs_error })

where
	check_expressions free_vars [expr : exprs] e_input e_state e_info cs
		# (exprs, free_vars, e_state, e_info, cs) = check_expressions free_vars exprs e_input e_state e_info cs
		= case expr of
			PE_Ident id
				# (expr, free_vars, e_state, e_info, cs) = checkIdentExpression cIsInExpressionList free_vars id e_input e_state e_info cs
 				-> ([expr : exprs], free_vars, e_state, e_info, cs)
 			_
				# (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
 				-> ([expr : exprs], free_vars, e_state, e_info, cs)
 	check_expressions free_vars [] e_input e_state e_info cs
		= ([], free_vars, e_state, e_info, cs)

	first_argument_of_infix_operator_missing
		= "first argument of infix operator missing"

	build_expression [Constant symb _ (Prio _ _) _ , _: _] e_state cs_error
		= (EE, e_state, checkError symb.symb_name first_argument_of_infix_operator_missing cs_error)
	build_expression [Constant symb arity _ is_fun] e_state cs_error
		= buildApplication symb arity 0 is_fun [] e_state cs_error
	build_expression [expr] e_state cs_error
		= (expr, e_state, cs_error)
	build_expression [expr : exprs] e_state cs_error
		# (opt_opr, left, e_state, cs_error) = split_at_operator [expr] exprs e_state cs_error
		  (left_expr, e_state, cs_error) = combine_expressions left [] 0 e_state cs_error
		= case opt_opr of
			Yes (symb, prio, is_fun, right)
				-> case right of
					[Constant symb _ (Prio _ _) _:_]
						-> (EE, e_state, checkError symb.symb_name first_argument_of_infix_operator_missing cs_error)
					_
						-> build_operator_expression [] left_expr (symb, prio, is_fun) right e_state cs_error
			No
				-> (left_expr, e_state, cs_error)
	where
		split_at_operator left [Constant symb arity NoPrio is_fun : exprs] e_state cs_error
			# (appl_exp, e_state, cs_error) = buildApplication symb arity 0 is_fun [] e_state cs_error
			= split_at_operator [appl_exp : left] exprs e_state cs_error
		split_at_operator left [Constant symb arity (Prio _ _) is_fun] e_state cs_error
			= (No, left, e_state, checkError symb.symb_name "second argument of infix operator missing" cs_error)
		split_at_operator left [Constant symb arity prio is_fun] e_state cs_error
			# (appl_exp, e_state, cs_error) = buildApplication symb arity 0 is_fun [] e_state cs_error
			= (No, [appl_exp : left], e_state, cs_error)
		split_at_operator left [expr=:(Constant symb _ prio is_fun) : exprs] e_state cs_error
			= (Yes (symb, prio, is_fun, exprs), left, e_state, cs_error)
		split_at_operator left [expr : exprs] e_state cs_error
			= split_at_operator [expr : left] exprs e_state cs_error
		split_at_operator exp [] e_state cs_error
			= (No, exp, e_state, cs_error)

		combine_expressions [first_expr] args arity e_state cs_error
			= case first_expr of
				Constant symb form_arity _ is_fun
					# (app_exp, e_state, cs_error) = buildApplication symb form_arity arity is_fun args e_state cs_error
					-> (app_exp, e_state, cs_error)
				_
					| arity == 0
						-> (first_expr, e_state, cs_error)
						-> (first_expr @ args, e_state, cs_error)
		combine_expressions [rev_arg : rev_args] args arity e_state cs_error
			= combine_expressions rev_args [rev_arg : args] (inc arity) e_state cs_error
		

 		build_operator_expression left_appls left1 (symb1, prio1, is_fun1) [re : res] e_state cs_error
			# (opt_opr, left2, e_state, cs_error) = split_at_operator [re] res e_state cs_error
			= case opt_opr of
				Yes (symb2, prio2, is_fun2, right)
					# optional_prio = determinePriority prio1 prio2
					-> case optional_prio of
						Yes priority
							| priority
						  		# (middle_exp, e_state, cs_error) = combine_expressions left2 [] 0 e_state cs_error
								  (new_left, e_state, cs_error) = buildApplication symb1 2 2 is_fun1 [left1,middle_exp] e_state cs_error
								  (left_appls, new_left, e_state, cs_error) = build_left_operand left_appls prio2 new_left e_state cs_error
								-> build_operator_expression left_appls new_left (symb2, prio2, is_fun2) right e_state cs_error
						  		# (middle_exp, e_state, cs_error) = combine_expressions left2 [] 0 e_state cs_error
								-> build_operator_expression [(symb1, prio1, is_fun1, left1) : left_appls]
										middle_exp (symb2, prio2, is_fun2) right e_state cs_error
						No
							-> (EE, e_state, checkError symb1.symb_name "conflicting priorities" cs_error)
				No
					# (right, e_state, cs_error) = combine_expressions left2 [] 0 e_state cs_error
					  (result_expr, e_state, cs_error) = buildApplication symb1 2 2 is_fun1 [left1,right] e_state cs_error
					-> build_final_expression left_appls result_expr e_state cs_error

		build_left_operand [] _ result_expr e_state cs_error
			= ([], result_expr, e_state, cs_error)		
		build_left_operand la=:[(symb, priol, is_fun, left) : left_appls] prior result_expr e_state cs_error
			# optional_prio = determinePriority priol prior
			= case optional_prio of
				Yes priority
					| priority
						# (result_expr, e_state, cs_error) = buildApplication symb 2 2 is_fun [left,result_expr] e_state cs_error
						-> build_left_operand left_appls prior result_expr e_state cs_error
						-> (la, result_expr, e_state, cs_error)
				No
					-> (la, EE, e_state, checkError symb.symb_name "conflicting priorities" cs_error)
		
		build_final_expression [] result_expr e_state cs_error
			= (result_expr, e_state, cs_error)		
		build_final_expression [(symb, _, is_fun, left) : left_appls] result_expr e_state cs_error
			# (result_expr, e_state, cs_error) = buildApplication symb 2 2 is_fun [left,result_expr] e_state cs_error
			= build_final_expression left_appls result_expr e_state cs_error
					
checkExpression free_vars (PE_Let strict let_locals expr) e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
	# ei_expr_level = inc ei_expr_level
	  (loc_defs, (var_env, array_patterns), e_state, e_info, cs)
	  		= checkLhssOfLocalDefs ei_expr_level ei_mod_index let_locals e_state e_info cs
	  e_input = { e_input & ei_expr_level = ei_expr_level }
	  (let_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
	  (expr, free_vars, e_state=:{es_dynamics,es_expr_heap,es_var_heap}, e_info, cs)
			= addArraySelections array_patterns let_expr free_vars e_input e_state e_info cs
	  (expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs expr e_input e_state e_info cs
	  (es_fun_defs, e_info, heaps, cs)
			= checkLocalFunctions ei_mod_index ei_expr_level let_locals e_state.es_fun_defs e_info
	  			{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs
	  (es_fun_defs, cs_symbol_table) = removeLocalsFromSymbolTable ei_expr_level var_env let_locals es_fun_defs cs.cs_symbol_table
	= (expr, free_vars,
		{ e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap, es_expr_heap = heaps.hp_expression_heap,
			es_type_heaps = heaps.hp_type_heaps }, e_info, { cs & cs_symbol_table = cs_symbol_table })

checkExpression free_vars (PE_Case case_ident expr alts) e_input e_state e_info cs
	# (pattern_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
	  (guards, _, pattern_variables, defaul, free_vars, e_state, e_info, cs) = check_guarded_expressions free_vars alts [] case_ident.id_name e_input e_state e_info cs
	  (pattern_expr, binds, es_expr_heap) = bind_pattern_variables pattern_variables pattern_expr e_state.es_expr_heap
	  (case_expr, es_expr_heap) = build_case guards defaul pattern_expr case_ident es_expr_heap
	  (result_expr, es_expr_heap) = buildLetExpression [] binds case_expr NoPos es_expr_heap
	= (result_expr, free_vars, { e_state & es_expr_heap = es_expr_heap }, e_info, cs)
	
where
	check_guarded_expressions free_vars [g] pattern_variables case_name e_input=:{ei_expr_level} e_state e_info cs
		# e_input = { e_input & ei_expr_level = inc ei_expr_level }
		= check_guarded_expression free_vars g NoPattern NoPattern pattern_variables No case_name e_input e_state e_info cs 
	check_guarded_expressions free_vars [g : gs] pattern_variables case_name e_input=:{ei_expr_level} e_state e_info cs
		# e_input = { e_input & ei_expr_level = inc ei_expr_level }
		  (gs, pattern_scheme, pattern_variables, defaul, free_vars, e_state, e_info, cs)
		  	= check_guarded_expressions free_vars gs pattern_variables case_name e_input e_state e_info cs
		= check_guarded_expression free_vars g gs pattern_scheme pattern_variables defaul case_name e_input e_state e_info cs 
	check_guarded_expression free_vars {calt_pattern,calt_rhs={rhs_alts,rhs_locals}} patterns pattern_scheme pattern_variables defaul case_name 
				e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_fun_defs,es_var_heap} e_info cs
		# (pattern, (var_env, array_patterns), {ps_fun_defs,ps_var_heap}, e_info, cs)
				= checkPattern calt_pattern No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], [])
					{ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs
		  e_state = { e_state & es_var_heap = ps_var_heap, es_fun_defs = ps_fun_defs }
		  (rhs_expr, free_vars, e_state, e_info, cs)
		  		= checkRhs free_vars rhs_alts rhs_locals e_input e_state e_info cs
		  (expr_with_array_selections, free_vars, e_state=:{es_dynamics,es_expr_heap,es_var_heap}, e_info, cs)
				= addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs
		  cs_symbol_table = removeLocalIdentsFromSymbolTable ei_expr_level var_env cs.cs_symbol_table
		  (guarded_expr, pattern_scheme, pattern_variables, defaul, es_var_heap, es_expr_heap, dynamics_in_patterns, cs)
		  		= transform_pattern pattern patterns pattern_scheme pattern_variables defaul expr_with_array_selections case_name
		  									es_var_heap es_expr_heap es_dynamics { cs & cs_symbol_table = cs_symbol_table }
		= (guarded_expr, pattern_scheme, pattern_variables, defaul, free_vars,
			{ e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap, es_dynamics = dynamics_in_patterns },
				e_info, cs)

	transform_pattern :: !AuxiliaryPattern !CasePatterns !CasePatterns !(Env Ident VarInfoPtr) !(Optional (!Optional FreeVar, !Expression)) !Expression
			!String !*VarHeap !*ExpressionHeap ![DynamicPtr] !*CheckState
				-> (!CasePatterns, !CasePatterns, !Env Ident VarInfoPtr, !Optional (!Optional FreeVar,!Expression), !*VarHeap, !*ExpressionHeap, ![DynamicPtr], !*CheckState)
	transform_pattern (AP_Algebraic cons_symbol type_index args opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ var_store expr_heap opt_dynamics cs
		# (var_args, result_expr, _, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr NoPos var_store expr_heap opt_dynamics cs
		  type_symbol = { glob_module = cons_symbol.glob_module, glob_object = type_index}
		  pattern = { ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = NoPos}
		  pattern_variables = cons_optional opt_var pattern_variables
		= case pattern_scheme of
			AlgebraicPatterns alg_type _
				| type_symbol == alg_type
					# alg_patterns = case patterns of
							AlgebraicPatterns _ alg_patterns -> alg_patterns
							NoPattern -> []
					-> (AlgebraicPatterns type_symbol [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
					-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
								{ cs & cs_error = checkError cons_symbol.glob_object.ds_ident "incompatible types of patterns" cs.cs_error })
			NoPattern
				-> (AlgebraicPatterns type_symbol [pattern], AlgebraicPatterns type_symbol [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
			_
				-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
						{ cs & cs_error = checkError cons_symbol.glob_object.ds_ident "illegal combination of patterns" cs.cs_error })
	transform_pattern (AP_Basic basic_val opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ var_store expr_heap opt_dynamics cs
		# pattern = { bp_value = basic_val, bp_expr = result_expr, bp_position = NoPos}
		  pattern_variables = cons_optional opt_var pattern_variables
		  (type_symbol, cs) = typeOfBasicValue basic_val cs
		= case pattern_scheme of
			BasicPatterns basic_type _
				| type_symbol == basic_type
					# basic_patterns = case patterns of
							BasicPatterns _ basic_patterns
								-> basic_patterns
							NoPattern
								-> [] 
					-> (BasicPatterns basic_type [pattern : basic_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
					-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
							{ cs & cs_error = checkError basic_val "incompatible types of patterns" cs.cs_error })
			NoPattern
				-> (BasicPatterns type_symbol [pattern], BasicPatterns type_symbol [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
			_
				-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
						{ cs & cs_error = checkError basic_val "illegal combination of patterns" cs.cs_error})
	transform_pattern (AP_Dynamic pattern type opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ var_store expr_heap opt_dynamics cs
		# (var_arg, result_expr, _, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr NoPos var_store expr_heap opt_dynamics cs
		  (dynamic_info_ptr, expr_heap) = newPtr (EI_DynamicType type opt_dynamics) expr_heap
		  pattern = { dp_var = var_arg, dp_type	= dynamic_info_ptr,	dp_rhs = result_expr, dp_type_patterns_vars = [],
		  				dp_type_code = TCE_Empty, dp_position = NoPos }
		  pattern_variables = cons_optional opt_var pattern_variables
		= case pattern_scheme of
			DynamicPatterns _
				# dyn_patterns = case patterns of 
										DynamicPatterns dyn_patterns
											-> dyn_patterns
										NoPattern
											-> []
				-> (DynamicPatterns [pattern : dyn_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, [dynamic_info_ptr], cs)
			NoPattern
				-> (DynamicPatterns [pattern], DynamicPatterns [], pattern_variables, defaul, var_store, expr_heap, [dynamic_info_ptr], cs)
			_
				-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
						{ cs & cs_error = checkError "<dynamic pattern>" "illegal combination of patterns" cs.cs_error })
	transform_pattern (AP_Variable name var_info opt_var) NoPattern pattern_scheme pattern_variables No result_expr _ var_store expr_heap opt_dynamics cs
		= ( NoPattern, pattern_scheme, cons_optional opt_var pattern_variables, 
		  	Yes (Yes { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr),
			var_store, expr_heap, opt_dynamics, cs)		
	transform_pattern (AP_Variable name var_info opt_var) patterns pattern_scheme pattern_variables defaul result_expr case_name var_store expr_heap opt_dynamics cs
		# free_var = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }
		  (new_bound_var, expr_heap) = allocate_bound_var free_var expr_heap
		  case_ident = { id_name = case_name, id_info = nilPtr }
		  (new_case, expr_heap) = build_case patterns defaul (Var new_bound_var) case_ident expr_heap
		  new_defaul = insert_as_default new_case result_expr
		= (NoPattern, pattern_scheme, (cons_optional opt_var pattern_variables), Yes (Yes free_var, new_defaul),
			var_store, expr_heap, opt_dynamics, cs)
	transform_pattern (AP_WildCard (Yes opt_var)) patterns pattern_scheme pattern_variables defaul result_expr case_name var_store expr_heap opt_dynamics cs
		= transform_pattern (AP_Variable opt_var.bind_src opt_var.bind_dst No) patterns pattern_scheme pattern_variables defaul
							result_expr case_name var_store expr_heap opt_dynamics cs
	transform_pattern (AP_WildCard no) NoPattern pattern_scheme pattern_variables No result_expr _ var_store expr_heap opt_dynamics cs
		= (NoPattern, pattern_scheme, pattern_variables, Yes (No, result_expr), var_store, expr_heap, opt_dynamics, cs)
	transform_pattern (AP_WildCard _) patterns pattern_scheme pattern_variables defaul result_expr case_name var_store expr_heap opt_dynamics cs
		# (new_info_ptr, var_store) = newPtr VI_Empty var_store
		= transform_pattern (AP_Variable (newVarId "wc") new_info_ptr No) patterns pattern_scheme pattern_variables defaul
							result_expr case_name var_store expr_heap opt_dynamics cs
	transform_pattern (AP_Empty name) patterns pattern_scheme pattern_variables defaul result_expr _ var_store expr_heap opt_dynamics cs
		= (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)


	insert_as_default :: !Expression !Expression -> Expression
	insert_as_default to_insert (Let lad=:{let_expr})
		= Let { lad & let_expr = insert_as_default to_insert let_expr }
	insert_as_default to_insert (Case kees=:{case_default})
		= case case_default of
			No			-> Case { kees & case_default = Yes to_insert }
			Yes defaul	-> Case { kees & case_default = Yes (insert_as_default to_insert defaul)}
	insert_as_default _ expr = expr // checkWarning "pattern won't match"

	build_case NoPattern defaul expr case_ident expr_heap
		= case defaul of
			Yes (opt_var, result)
				-> case opt_var of
					Yes var
						# (let_expression, expr_heap) = bind_default_variable expr var result expr_heap
						-> (let_expression, expr_heap)
					No
						-> (result, expr_heap)
			No
				-> (EE, expr_heap)
	build_case (DynamicPatterns patterns) defaul expr case_ident expr_heap
		= case defaul of
			Yes (opt_var, result)
				-> case opt_var of
					Yes var
						# (type_case_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
						  (bound_var, expr_heap) = allocate_bound_var var expr_heap
						  result = buildTypeCase (Var bound_var) patterns (Yes result) type_case_info_ptr
						  (case_expression, expr_heap) = bind_default_variable expr var result expr_heap
					 	-> (case_expression, expr_heap)
					No
						# (type_case_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
						-> (buildTypeCase expr patterns (Yes result) type_case_info_ptr, expr_heap)
			No
				# (type_case_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
				-> (buildTypeCase expr patterns No type_case_info_ptr, expr_heap)
	build_case patterns (Yes (opt_var,result)) expr case_ident expr_heap
		= case opt_var of
			Yes var
				# (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
				  (bound_var, expr_heap) = allocate_bound_var var expr_heap
				  result = Case {case_expr = Var bound_var, case_guards = patterns, case_default = Yes result,
								 case_ident = Yes case_ident, case_info_ptr = case_expr_ptr,
								 case_default_pos = NoPos }
				  (case_expression, expr_heap) = bind_default_variable expr var result expr_heap
				-> (case_expression, expr_heap)
			No
				#  (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
				-> (Case {case_expr = expr, case_guards = patterns, case_default = Yes result,
						case_ident = Yes case_ident, case_info_ptr = case_expr_ptr, case_default_pos = NoPos }, expr_heap)
	build_case patterns No expr case_ident expr_heap
		# (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
		= (Case {case_expr = expr, case_guards = patterns, case_default = No, case_ident = Yes case_ident,
			case_info_ptr = case_expr_ptr, case_default_pos = NoPos }, expr_heap)

	bind_default_variable lb_src lb_dst result_expr expr_heap
		#  (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
		= (Let {let_strict_binds = [], let_lazy_binds = [{ lb_src = lb_src, lb_dst = lb_dst, lb_position = NoPos }],
				let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos }, expr_heap)

	bind_pattern_variables [] pattern_expr expr_heap
		= (pattern_expr, [], expr_heap)
	bind_pattern_variables [{bind_src,bind_dst} : variables] this_pattern_expr expr_heap
		# free_var = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }
		  (bound_var, expr_heap) = allocate_bound_var free_var expr_heap
		  (pattern_expr, binds, expr_heap) = bind_pattern_variables variables (Var bound_var) expr_heap
		= (pattern_expr, [{lb_src = this_pattern_expr, lb_dst = free_var, lb_position = NoPos } : binds], expr_heap)

	cons_optional (Yes var) variables
		= [ var : variables ]
	cons_optional No variables
		= variables

checkExpression free_vars (PE_Selection is_unique expr [PS_Array index_expr]) e_input e_state e_info cs	
	# (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
	| is_unique
		# (glob_select_symb, cs) = getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs
		  (selector, free_vars, e_state, e_info, cs) = checkArraySelection glob_select_symb free_vars index_expr e_input e_state e_info cs
		= (Selection No expr [selector], free_vars, e_state, e_info, cs)
		# (glob_select_symb, cs) = getPredefinedGlobalSymbol PD_ArraySelectFun PD_StdArray STE_Member 2 cs
		  (selector, free_vars, e_state, e_info, cs) = checkArraySelection glob_select_symb free_vars index_expr e_input e_state e_info cs
		= (Selection No expr [selector], free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_Selection is_unique expr selectors) e_input e_state e_info cs	
	# (selectors, free_vars, e_state, e_info, cs) = checkSelectors cEndWithSelection free_vars selectors e_input e_state e_info cs
	  (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
	| is_unique
		# (tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex 2) PD_PredefinedModule STE_Type 2 cs
		= (Selection (Yes tuple_type) expr selectors, free_vars, e_state, e_info, cs)
		= (Selection No expr selectors, free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_Update expr1 selectors expr2) e_input e_state e_info cs	
	# (expr1, free_vars, e_state, e_info, cs) = checkExpression free_vars expr1 e_input e_state e_info cs
	  (selectors, free_vars, e_state, e_info, cs) = checkSelectors cEndWithUpdate free_vars selectors e_input e_state e_info cs
	  (expr2, free_vars, e_state, e_info, cs) = checkExpression free_vars expr2 e_input e_state e_info cs
	= (Update expr1 selectors expr2, free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_Tuple exprs) e_input e_state e_info cs
	# (exprs, arity, free_vars, e_state, e_info, cs) = check_expression_list free_vars exprs e_input e_state e_info cs
	  ({glob_object={ds_ident,ds_index, ds_arity},glob_module}, cs)
	  		= getPredefinedGlobalSymbol (GetTupleConsIndex arity) PD_PredefinedModule STE_Constructor arity cs
	= (App { app_symb = { symb_name = ds_ident, symb_arity = ds_arity,
						  symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }},
			 app_args = exprs, app_info_ptr = nilPtr }, free_vars, e_state, e_info, cs)
where
	check_expression_list free_vars [] e_input e_state e_info cs
		= ([], 0, free_vars, e_state, e_info, cs)
	check_expression_list free_vars [expr : exprs] e_input e_state e_info cs
		# (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
		  (exprs, length, free_vars, e_state, e_info, cs) = check_expression_list free_vars exprs e_input e_state e_info cs
		= ([expr : exprs], inc length, free_vars, e_state, e_info, cs)

checkExpression free_vars rec=:(PE_Record record opt_type fields) e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
	# (opt_record_and_fields, e_info, cs) = checkFields ei_mod_index fields opt_type e_info cs
	= case opt_record_and_fields of
		Yes (cons=:{glob_module, glob_object}, _, new_fields)
			# {ds_ident,ds_index,ds_arity} = glob_object
			  rec_cons = { symb_name = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }, symb_arity = ds_arity }
			-> case record of
				PE_Empty
					# (exprs, free_vars, e_state, e_info, cs) = check_field_exprs free_vars new_fields 0 RK_Constructor e_input e_state e_info cs
					-> (App { app_symb = rec_cons, app_args = remove_fields exprs, app_info_ptr = nilPtr }, free_vars, e_state, e_info, cs)
				_
					# (rec_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars record e_input e_state e_info cs
					-> case rec_expr of
						Var {var_info_ptr,var_name}
							# (var_info, es_var_heap) = readPtr var_info_ptr e_state.es_var_heap
							  e_state = { e_state & es_var_heap = es_var_heap }
							-> case var_info of
								VI_Record fields
									# (exprs, free_vars, e_state, e_info, cs) 
											= check_field_exprs free_vars new_fields 0 (RK_UpdateToConstructor fields) e_input e_state e_info cs
									-> (App { app_symb = rec_cons, app_args = remove_fields exprs, app_info_ptr = nilPtr }, free_vars, e_state, e_info, cs)
								_ 
									# (exprs, free_vars, e_state, e_info, cs)
											= check_field_exprs free_vars new_fields 0 RK_Update e_input e_state e_info cs
									-> (RecordUpdate cons rec_expr exprs, free_vars, e_state, e_info, cs)
						_ 
							# (exprs, free_vars, e_state, e_info, cs)
									= check_field_exprs free_vars new_fields 0 RK_Update e_input e_state e_info cs
							-> (RecordUpdate cons rec_expr exprs, free_vars, e_state, e_info, cs)
		No
			-> (EE, free_vars, e_state, e_info, cs)
where
	remove_fields binds = [ bind_src \\ {bind_src} <- binds ]

	check_field_exprs :: [FreeVar] [Bind ParsedExpr (Global FieldSymbol)] Int RecordKind ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState -> *(![.Bind Expression (Global FieldSymbol)],![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
	check_field_exprs free_vars [] field_nr record_kind e_input e_state e_info cs
		= ([], free_vars, e_state, e_info, cs)
	check_field_exprs free_vars [field_expr : field_exprs] field_nr record_kind e_input e_state e_info cs
		# (expr, free_vars, e_state, e_info, cs)
			= check_field_expr free_vars field_expr field_nr record_kind e_input e_state e_info cs
		  (exprs, free_vars, e_state, e_info, cs) = check_field_exprs free_vars field_exprs (inc field_nr) record_kind e_input e_state e_info cs
		= ([expr : exprs], free_vars, e_state, e_info, cs)

	check_field_expr :: [FreeVar] (Bind ParsedExpr (Global FieldSymbol)) Int RecordKind ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!.Bind Expression (Global FieldSymbol),![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
	check_field_expr free_vars field=:{bind_src = PE_Empty, bind_dst={glob_object={fs_var,fs_name,fs_index},glob_module}} field_nr record_kind e_input e_state e_info cs
		# (expr, free_vars, e_state, e_info, cs)
			= checkIdentExpression cIsNotInExpressionList free_vars fs_var e_input e_state e_info cs
		= ({ field & bind_src = expr }, free_vars, e_state, e_info, cs)
	check_field_expr free_vars field=:{bind_src = PE_WildCard, bind_dst={glob_object=fs_name}} field_nr RK_Constructor e_input e_state e_info cs
		= ({ field & bind_src = NoBind nilPtr }, free_vars, e_state, e_info, { cs & cs_error = checkError fs_name "field not specified" cs.cs_error })
	check_field_expr free_vars field=:{bind_src = PE_WildCard} field_nr RK_Update e_input e_state=:{es_expr_heap} e_info cs
		# (bind_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
		= ({ field & bind_src = NoBind bind_expr_ptr }, free_vars, { e_state & es_expr_heap = es_expr_heap }, e_info, cs)
	check_field_expr free_vars field=:{bind_src = PE_WildCard} field_nr (RK_UpdateToConstructor fields) e_input e_state=:{es_expr_heap} e_info cs
		# (var_name, var_info_ptr) = get_field_var (fields !! field_nr)
		  (var_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
		= ({ field & bind_src = Var { var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr }}, free_vars,
				{ e_state & es_expr_heap = es_expr_heap }, e_info, cs)
	check_field_expr free_vars field=:{bind_src} field_nr upd_record e_input e_state e_info cs
		# (expr, free_vars, e_state, e_info, cs)
			= checkExpression free_vars bind_src e_input e_state e_info cs
		= ({ field & bind_src = expr }, free_vars, e_state, e_info, cs)
	
	get_field_var (AP_Algebraic _ _ _ (Yes {bind_src,bind_dst}))
		= (bind_src, bind_dst)
	get_field_var (AP_Basic _ (Yes {bind_src,bind_dst}))
		= (bind_src, bind_dst)
	get_field_var (AP_Dynamic _ _ (Yes {bind_src,bind_dst}))
		= (bind_src, bind_dst)
	get_field_var (AP_Variable id var_ptr _)
		= (id, var_ptr)
	get_field_var (AP_WildCard (Yes {bind_src,bind_dst}))
		= (bind_src, bind_dst)
	get_field_var _
		= ({ id_name = "** ERRONEOUS **", id_info = nilPtr }, nilPtr)

checkExpression free_vars (PE_Dynamic expr opt_type) e_input e_state=:{es_expr_heap,es_dynamics} e_info cs=:{cs_x}
	# (dyn_info_ptr, es_expr_heap) = newPtr (EI_Dynamic opt_type) es_expr_heap
	  (dyn_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input
	  		{e_state & es_dynamics = [dyn_info_ptr : es_dynamics], es_expr_heap = es_expr_heap } e_info cs
	= (DynamicExpr { dyn_expr = dyn_expr, dyn_opt_type = opt_type, dyn_info_ptr = dyn_info_ptr, dyn_type_code = TCE_Empty, dyn_uni_vars = [] },
			free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdDynamics }) 

checkExpression free_vars (PE_Basic basic_value) e_input e_state e_info cs
	# (basic_type, cs) = typeOfBasicValue basic_value cs
	= (BasicExpr basic_value basic_type, free_vars, e_state, e_info, cs)

checkExpression free_vars (PE_ABC_Code code_sequence do_inline) e_input e_state e_info cs
	= (ABCCodeExpr code_sequence do_inline, free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_Any_Code ins outs code_sequence) e_input e_state e_info cs
	# (ins, (free_vars, e_state, e_info, cs)) = check_in_parameters e_input ins (free_vars, e_state, e_info, cs)
	  (new_outs, (e_state, cs)) = check_out_parameters e_input.ei_expr_level outs (e_state, cs)
	  cs_symbol_table = remove_out_parameters_from_symbol_table e_input.ei_expr_level outs cs.cs_symbol_table
	= (AnyCodeExpr ins new_outs code_sequence, free_vars, e_state, e_info, { cs & cs_symbol_table = cs_symbol_table })
where
	check_in_parameters e_input params fv_es_ei_cs
		= mapSt (check_in_parameter e_input) params fv_es_ei_cs

	check_in_parameter e_input { bind_src, bind_dst } (free_vars, e_state, e_info, cs)
		# (id_expr, free_vars, e_state, e_info, cs) = checkIdentExpression cIsNotInExpressionList free_vars bind_dst e_input e_state e_info cs
		= case id_expr of
			Var var
				-> ({ bind_dst = var, bind_src = bind_src }, (free_vars, e_state, e_info, cs))
			_
				-> ({ bind_dst = { var_name = bind_dst, var_info_ptr = nilPtr, var_expr_ptr = nilPtr }, bind_src = bind_src }, (free_vars, e_state, e_info,
						{ cs & cs_error = checkError bind_src "bound variable expected" cs.cs_error }))

	check_out_parameters expr_level params es_cs
		= mapSt (check_out_parameter expr_level) params es_cs

	check_out_parameter expr_level bind=:{ bind_src, bind_dst } (e_state, cs)
		| isLowerCaseName bind_dst.id_name
			# (entry, cs_symbol_table) = readPtr bind_dst.id_info cs.cs_symbol_table
			# (new_info_ptr, es_var_heap) = newPtr VI_Empty e_state.es_var_heap
			  cs = checkPatternVariable expr_level entry bind_dst new_info_ptr { cs & cs_symbol_table = cs_symbol_table }
			= (	{ bind & bind_dst = { fv_def_level = expr_level, fv_name = bind_dst, fv_info_ptr = new_info_ptr, fv_count = 0 }},
					( { e_state & es_var_heap = es_var_heap }, cs))
			= ( { bind & bind_dst = { fv_def_level = expr_level, fv_name = bind_dst, fv_info_ptr = nilPtr, fv_count = 0 }},
					( e_state, { cs & cs_error = checkError bind_src "variable expected" cs.cs_error }))

	remove_out_parameters_from_symbol_table expr_level idents symbol_table
		= foldSt (\{bind_dst} -> removeIdentFromSymbolTable expr_level bind_dst) idents symbol_table

checkExpression free_vars (PE_Ident id) e_input e_state e_info cs
	= checkIdentExpression cIsNotInExpressionList free_vars id e_input e_state e_info cs
863
864
865
866
867
868
869
870
871
872
// AA..
checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_state e_info cs=:{cs_symbol_table, cs_x}
	//= checkIdentExpression cIsNotInExpressionList free_vars id e_input e_state e_info cs
	# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
	= check_generic_expr free_vars entry id kind e_input e_state e_info {cs & cs_symbol_table = cs_symbol_table}
	where 
		check_generic_expr :: ![FreeVar] !SymbolTableEntry !Ident !TypeKind !ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState
			-> (!Expression, ![FreeVar], !*ExpressionState, !*ExpressionInfo, !*CheckState)
		check_generic_expr 
				free_vars entry=:{ste_kind=STE_Generic,ste_index} id  kind  
Artem Alimarine's avatar
Artem Alimarine committed
873
874
875
				e_input=:{ei_mod_index}  e_state 
				e_info=:{ef_generic_defs} cs
			//#! e_info = {e_info & ef_generic_defs = add_kind ef_generic_defs ste_index kind}	
876
877
878
			= check_it free_vars ei_mod_index ste_index id kind e_input e_state e_info cs	
		check_generic_expr 
				free_vars entry=:{ste_kind=STE_Imported STE_Generic mod_index, ste_index} id kind  
Artem Alimarine's avatar
Artem Alimarine committed
879
880
881
882
883
884
885
886
887
888
889
				e_input e_state 
				e_info=:{ef_modules} cs
			
			//#! (dcl_module, ef_modules) = ef_modules ! [mod_index]
			//#! (dcl_common, dcl_module) = dcl_module ! dcl_common 
			//#! (com_generic_defs, dcl_common) = dcl_common ! com_generic_defs
			//#! dcl_common = {dcl_common & com_generic_defs = add_kind com_generic_defs ste_index kind}
			//#! dcl_module = {dcl_module & dcl_common = dcl_common}
			//#! ef_modules = {ef_modules & [mod_index] = dcl_module} 
			//#! e_info = { e_info & ef_modules = ef_modules }

890
891
892
893
894
895
896
897
898
899
900
901
902
903
			= check_it free_vars mod_index ste_index id kind e_input e_state e_info cs	
		check_generic_expr free_vars  entry=:{ste_kind=STE_Empty} id kind  e_input e_state e_info cs=:{cs_error}
			= (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "undefined generic" cs_error })
		check_generic_expr free_vars entry id kind  e_input e_state e_info cs=:{cs_error}
			= (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "not a generic" cs_error })						

		check_it free_vars mod_index gen_index id kind e_input e_state=:{es_expr_heap} e_info cs
			#! symb_kind = SK_Generic { glob_object = gen_index, glob_module = mod_index} kind
		  	#! symbol = { symb_name = id, symb_kind = symb_kind, symb_arity = 0 }			
			#! (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
			#! app = { app_symb = symbol, app_args = [], app_info_ptr = new_info_ptr }
			#! e_state = { e_state & es_expr_heap = es_expr_heap }
			#! cs = { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric }
			= (App app, free_vars, e_state, e_info, cs)
Artem Alimarine's avatar
Artem Alimarine committed
904
905
906
907
908
909

		add_kind :: !*{#GenericDef} !Index !TypeKind -> !*{#GenericDef}			
		add_kind generic_defs generic_index kind
			# (generic_def, generic_defs) = generic_defs ! [generic_index]		
			= {generic_defs & [generic_index] = addGenericKind generic_def kind}
			 									 
910
// ..AA
911
checkExpression free_vars expr e_input e_state e_info cs
912
	= abort "checkExpression (checkFunctionBodies.icl, line 868)" // <<- expr
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


checkIdentExpression :: !Bool ![FreeVar] !Ident !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState
	-> (!Expression, ![FreeVar], !*ExpressionState, !u:ExpressionInfo, !*CheckState)
checkIdentExpression is_expr_list free_vars id=:{id_info} e_input e_state e_info cs=:{cs_symbol_table}
	# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
	= check_id_expression entry is_expr_list free_vars id e_input e_state e_info { cs & cs_symbol_table = cs_symbol_table }
where
	check_id_expression :: !SymbolTableEntry !Bool ![FreeVar] !Ident !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState
		-> (!Expression, ![FreeVar], !*ExpressionState, !u:ExpressionInfo, !*CheckState)

	check_id_expression {ste_kind = STE_Empty} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error,cs_predef_symbols,cs_x}
		# ({pds_ident=from_ident}) = cs_predef_symbols.[PD_From]
		  ({pds_ident=from_then_ident}) = cs_predef_symbols.[PD_FromThen]
		  ({pds_ident=from_to_ident}) = cs_predef_symbols.[PD_FromTo]
		  ({pds_ident=from_then_to_ident}) = cs_predef_symbols.[PD_FromThenTo]
		| id==from_ident || id==from_then_ident || id==from_to_ident || id==from_then_to_ident
			= (EE, free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdEnum})
				// instead of giving an error message remember that StdEnum should have been imported.
				// Error will be given in function check_needed_modules_are_imported
		# ({pds_ident=createArray_ident}) = cs_predef_symbols.[PD__CreateArrayFun]
		  ({pds_ident=uselect_ident}) = cs_predef_symbols.[PD_UnqArraySelectFun]
		  ({pds_ident=update_ident}) = cs_predef_symbols.[PD_ArrayUpdateFun]
		  ({pds_ident=usize_ident}) = cs_predef_symbols.[PD_UnqArraySizeFun]
		| id==createArray_ident || id==uselect_ident || id==update_ident || id==usize_ident
			= (EE, free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdArray})
				// instead of giving an error message remember that StdArray should have been be imported.
				//  Error will be given in function check_needed_modules_are_imported
		= (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "undefined" cs_error })
	check_id_expression {ste_kind = STE_Variable info_ptr,ste_def_level} is_expr_list free_vars id e_input=:{ei_fun_level} e_state=:{es_expr_heap} e_info cs
		| ste_def_level < ei_fun_level
			# free_var = { fv_def_level = ste_def_level, fv_name = id, fv_info_ptr = info_ptr, fv_count = 0 }
			  (free_var_added, free_vars) = newFreeVariable free_var free_vars
			= (FreeVar free_var, free_vars, e_state, e_info, cs)
			#! (var_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
			= (Var {var_name = id, var_info_ptr = info_ptr, var_expr_ptr = var_expr_ptr}, free_vars,
					{e_state & es_expr_heap = es_expr_heap}, e_info, cs)
	check_id_expression entry is_expr_list free_vars id=:{id_info} e_input e_state e_info cs
		# (symb_kind, arity, priority, is_a_function, e_state, e_info, cs) = determine_info_of_symbol entry id_info e_input e_state e_info cs
		  symbol = { symb_name = id, symb_kind = symb_kind, symb_arity = 0 }
  		| is_expr_list
			= (Constant symbol arity priority is_a_function, free_vars, e_state, e_info, cs)
			# (app_expr, e_state, cs_error) = buildApplication symbol arity 0 is_a_function [] e_state cs.cs_error
			= (app_expr, free_vars, e_state, e_info, { cs & cs_error = cs_error })

	determine_info_of_symbol :: !SymbolTableEntry !SymbolPtr !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState
		-> (!SymbKind, !Int, !Priority, !Bool, !*ExpressionState, !u:ExpressionInfo,!*CheckState)
	determine_info_of_symbol entry=:{ste_kind=STE_FunctionOrMacro calls,ste_index,ste_def_level} symb_info
961
				e_input=:{ei_fun_index, ei_mod_index} e_state=:{es_fun_defs,es_calls} e_info cs=:{cs_symbol_table,cs_x}
962
		# ({fun_symb,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}, es_fun_defs) = es_fun_defs![ste_index]
963
964
965
966
		# index = { glob_object = ste_index, glob_module = cs_x.x_main_dcl_module_n }
		| is_called_before ei_fun_index calls
			| case fun_kind of FK_DefMacro->True ; FK_ImpMacro->True; _ -> False
				= (SK_Macro index, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs)
967
				# symbol_kind = if (fi_properties bitand FI_IsMacroFun <> 0) (SK_LocalMacroFunction ste_index) (SK_Function index)
968
969
970
971
972
973
974
975
976
				= (symbol_kind, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs)
			# cs = { cs & cs_symbol_table = cs_symbol_table <:= (symb_info, { entry & ste_kind = STE_FunctionOrMacro [ ei_fun_index : calls ]})}
			  e_state = { e_state & es_fun_defs = es_fun_defs, es_calls = [{ fc_index = ste_index, fc_level = ste_def_level} : es_calls ]}
			# symbol_kind = case fun_kind of
				FK_DefMacro
					-> SK_Macro index;
				FK_ImpMacro
					-> SK_Macro index;
				_
977
					| fi_properties bitand FI_IsMacroFun <> 0
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
						-> SK_LocalMacroFunction ste_index
						-> SK_Function index
			= (symbol_kind, fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs)
	where
		is_called_before caller_index []
			= False
		is_called_before caller_index [called_index : calls]
			= caller_index == called_index || is_called_before caller_index calls

	determine_info_of_symbol entry=:{ste_kind=STE_Imported kind mod_index,ste_index} symb_index e_input e_state e_info=:{ef_modules} cs
		# (mod_def, ef_modules) = ef_modules![mod_index]
		# (kind, arity, priotity, is_fun) = ste_kind_to_symbol_kind kind ste_index mod_index mod_def
		= (kind, arity, priotity, is_fun, e_state, { e_info & ef_modules = ef_modules }, cs)
	where
		ste_kind_to_symbol_kind :: !STE_Kind !Index !Index !DclModule -> (!SymbKind, !Int, !Priority, !Bool);
		ste_kind_to_symbol_kind STE_DclFunction def_index mod_index {dcl_functions,dcl_conversions}
			# {ft_type={st_arity},ft_priority} = dcl_functions.[def_index]
			# def_index = convertIndex def_index (toInt STE_DclFunction) dcl_conversions
			= (SK_Function { glob_object = def_index, glob_module = mod_index }, st_arity, ft_priority, cIsAFunction)
		ste_kind_to_symbol_kind STE_Member def_index mod_index {dcl_common={com_member_defs},dcl_conversions}
			# {me_type={st_arity},me_priority} = com_member_defs.[def_index]
			# def_index = convertIndex def_index (toInt STE_Member) dcl_conversions
			= (SK_OverloadedFunction { glob_object = def_index, glob_module = mod_index }, st_arity, me_priority, cIsAFunction)
For faster browsing, not all history is shown. View entire blame