Initial import

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@2 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

68 files changed, 27751 insertions, 0 deletions

diff --git a/frontend/Debug.dcl b/frontend/Debug.dcl
new file mode 100644
index 0000000..2e0af9f
--- /dev/null
+++ b/frontend/Debug.dcl
@@ -0,0 +1,17 @@
+definition module Debug
+
+:: DebugShowFunction a :== !a -> [{#Char}]
+
+debugBefore :: !.a !(DebugShowFunction .a) .b -> .b
+debugAfter :: !.a !(DebugShowFunction .a) !.b -> .b
+debugValue :: !(DebugShowFunction .a) !.a -> .a
+
+debugShow :: DebugShowFunction .a
+debugShowWithOptions :: [DebugShowOption] -> DebugShowFunction .a
+
+:: DebugShowOption 
+	=	DebugMaxDepth !Int			// default MaxInt
+	|	DebugMaxBreadth !Int		// default MaxInt
+	|	DebugMaxChars !Int			// default MaxInt
+	|	DebugTerminator !{#Char}	// default "\n"
+
diff --git a/frontend/Debug.icl b/frontend/Debug.icl
new file mode 100644
index 0000000..75092ad
--- /dev/null
+++ b/frontend/Debug.icl
@@ -0,0 +1,173 @@
+implementation module Debug
+
+import StdArray, StdEnum
+from StdFile	import <<<, ferror, stderr
+from StdMisc	import abort
+from StdTuple	import fst
+from StdList	import ++
+from StdBool	import && 
+from StdString	import %
+
+import	Wrap, ShowWrapped
+
+print :: ![{#Char}] .b -> .b
+print debugStrings value
+	| fst (ferror (stderr <<< debugStrings))
+		=	abort "Debug, print: couldn't write to stderr"
+	// otherwise
+		=	value
+
+debugBefore :: !.a !(DebugShowFunction .a) .b -> .b
+debugBefore debugValue show value
+	=	print (show debugValue) value
+
+debugAfter :: !.a !(DebugShowFunction .a) !.b -> .b
+debugAfter debugValue show value
+	=	print (show debugValue) value
+
+debugValue :: !(DebugShowFunction .a) !.a -> .a
+debugValue show value
+	=	print (show copy1) copy2
+	where
+		(copy1, copy2)
+			=	copyUniqueValue value
+
+		copyUniqueValue :: !.a -> (!.a, !.a)
+		copyUniqueValue value
+			=	code {
+				.o 1 0
+					push_a	0				
+				.d 2 0
+				}
+
+:: DebugShowFunction a :== !a -> [{#Char}]
+
+debugShow :: DebugShowFunction .a
+debugShow
+	=	\debugValue -> ShowWrapped (Wrap debugValue) ++ ["\n"]
+
+
+:: DebugOptionRecord
+	=	{maxDepth :: !Int, maxBreadth :: !Int, maxChars :: !Int, terminator :: !{#Char}}
+DebugDefaultOptions
+	:== {maxDepth = MaxInt, maxBreadth = MaxInt, maxChars = MaxInt, terminator = "\n"}
+
+MaxInt
+	:== (1<<31)-1
+
+:: DebugShowOption 
+	=	DebugMaxDepth !Int			// default MaxInt
+	|	DebugMaxBreadth !Int		// default MaxInt
+	|	DebugMaxChars !Int			// default MaxInt
+	|	DebugTerminator !{#Char}	// default "\n"
+
+debugShowWithOptions :: [DebugShowOption] -> DebugShowFunction .a
+debugShowWithOptions debugOptions 
+	=	\debug -> chop maxChars (ShowWrapped (pruneWrappedNode maxDepth maxBreadth (Wrap debug))) ++ [terminator]
+	where
+		{maxDepth, maxBreadth, maxChars, terminator}
+			=	set debugOptions DebugDefaultOptions
+			where
+				set [] options
+					=	options
+				set [DebugMaxDepth maxDepth:t] options
+					=	set t {options & maxDepth=maxDepth}
+				set [DebugMaxBreadth maxBreadth:t] options
+					=	set t {options & maxBreadth=maxBreadth}
+				set [DebugMaxChars maxChars:t] options
+					=	set t {options & maxChars=maxChars}
+				set [DebugTerminator terminator:t] options
+					=	set t {options & terminator=terminator}
+
+:: Indicators
+	=	...
+	|	.+.
+
+MaxCharsString
+	:== ".."
+MaxBreadthString
+	:== "..."
+MaxBreadthIndicator
+	:==	Wrap ...
+MaxDepthIndicator
+	:==	Wrap .+.
+
+pruneWrappedNode :: !Int !Int !WrappedNode -> !WrappedNode
+pruneWrappedNode maxDepth maxBreadth value
+	=	prune 0 value
+	where
+		prune :: !Int WrappedNode -> WrappedNode
+		prune depth value
+			| depth == maxDepth
+				=	MaxDepthIndicator
+		prune depth (WrappedIntArray a)
+			=	pruneBasicArray depth a
+		prune depth (WrappedBoolArray a)
+			=	pruneBasicArray depth a
+		prune depth (WrappedRealArray a)
+			=	pruneBasicArray depth a
+		prune depth (WrappedFileArray a)
+			=	pruneBasicArray depth a
+		prune depth (WrappedString a)
+			| size a > maxBreadth
+				=	WrappedString ((a % (0, maxBreadth-1)) +++ MaxBreadthString)
+		prune depth (WrappedArray a)
+			=	WrappedArray (pruneArray depth a)
+		prune depth (WrappedRecord descriptor args)
+			=	WrappedRecord descriptor (pruneArray depth args)
+		prune depth (WrappedOther WrappedDescriptorCons args)
+			| size args == 2
+				=	WrappedOther WrappedDescriptorCons
+						{prune (depth+1) args.[0], prune depth args.[1]}
+		prune depth (WrappedOther WrappedDescriptorTuple args)
+			=	WrappedOther WrappedDescriptorTuple (pruneArray depth args)
+		prune depth (WrappedOther descriptor args)
+			=	WrappedOther descriptor (pruneArray depth args)
+		prune _ a
+			=	a
+
+		pruneArray :: !Int !{WrappedNode} -> {WrappedNode}
+		pruneArray depth a
+			| size a > maxBreadth
+				=	{{prune (depth+1) e \\ e <-: a & i <- [0 .. maxBreadth]}
+						& [maxBreadth] = MaxBreadthIndicator}
+			// otherwise
+				=	{prune (depth+1) e \\ e <-: a}
+
+		pruneBasicArray :: !Int !(a b) -> WrappedNode | Array .a & ArrayElem b
+		pruneBasicArray depth a
+			| size a > maxBreadth
+				=	WrappedArray (pruneArray depth {Wrap e \\ e <-: a & i <- [0 .. maxBreadth]})
+			// otherwise
+				=	WrappedArray {Wrap e \\ e <-: a}
+
+chop :: !Int ![{#Char}] -> [{#Char}]
+chop _ []
+	=	[]
+chop maxSize list=:[string:strings]
+	| maxSize < stringSize + sizeMaxCharsString
+		| fits maxSize list
+			=	list
+		| stringSize > sizeMaxCharsString
+			=	[string % (0, maxSize-sizeMaxCharsString-1), MaxCharsString]
+		// otherwise
+			=	[MaxCharsString]
+	// otherwise
+		=	[string : chop (maxSize - stringSize) strings]
+	where
+		fits _ []
+			=	True
+		fits maxSize [h : t]
+			=	maxSize >= size h && fits (maxSize - size h) t
+
+		stringSize
+			=	size string
+		sizeMaxCharsString
+			=	size MaxCharsString
+
+instance <<< [a] | <<< a where
+	(<<<) :: *File [a] -> *File | <<< a
+	(<<<) file []
+		=	file
+	(<<<) file [h:t]
+		=	file <<< h <<< t
diff --git a/frontend/Heap.dcl b/frontend/Heap.dcl
new file mode 100644
index 0000000..bf855d9
--- /dev/null
+++ b/frontend/Heap.dcl
@@ -0,0 +1,31 @@
+definition module Heap
+
+import StdEnv
+
+:: Heap v = {heap::!.HeapN v}
+:: HeapN v
+:: Ptr v = {pointer::!.(PtrN v)};
+:: PtrN v = Ptr !v !(HeapN v);
+
+newHeap		:: .Heap v
+
+nilPtr		:: Ptr v
+
+isNilPtr 	:: !(Ptr v) -> Bool
+
+newPtr		:: !v !*(Heap v) -> (!.Ptr v,!.Heap v)
+
+readPtr		:: !(Ptr v) !*(Heap v) -> (!v,!.Heap v)
+
+writePtr	:: !(Ptr v) !v !*(Heap v) -> .Heap v
+
+sreadPtr	:: !(Ptr v) !(Heap v) -> v
+
+ptrToInt 	:: !(Ptr w) -> Int
+
+(<:=) infixl 
+(<:=) heap ptr_and_val :== writePtr ptr val heap 
+where
+	(ptr, val) = ptr_and_val
+
+instance == Ptr a
diff --git a/frontend/Heap.icl b/frontend/Heap.icl
new file mode 100644
index 0000000..a50b10a
--- /dev/null
+++ b/frontend/Heap.icl
@@ -0,0 +1,139 @@
+implementation module Heap;
+
+import StdOverloaded;
+
+:: Heap v = {heap::!.(HeapN v)};
+:: HeapN v = Heap !Int;
+:: Ptr v = {pointer::!.(PtrN v)};
+:: PtrN v = Ptr !v !(HeapN v);
+
+newHeap :: .Heap v;
+newHeap = {heap=Heap 0};
+
+newPtr :: !v !*(Heap v) -> (!.Ptr v,!.Heap v);
+newPtr v h = code {
+	build_r e_Heap_kPtr 2 0 0 0
+	update_a 0 1
+	pop_a 1
+};
+/*
+nilPtr :: !v -> .Ptr v;
+nilPtr v = code {
+	build _Nil 0 _hnf
+	push_a 1
+	update_a 1 2
+	update_a 0 1
+	pop_a 1
+	build_r e_Heap_kPtr 2 0 0 0
+	update_a 0 2
+	pop_a 2
+};
+*/
+nilPtr :: Ptr v;
+nilPtr = code {
+	build _Nil 0 _hnf
+	push_a 0
+	build_r e_Heap_kPtr 2 0 0 0
+	update_a 0 2
+	pop_a 2
+};
+
+isNilPtr :: !(Ptr v) -> Bool;
+isNilPtr p = code {
+	repl_args 2 2
+	pop_a 1
+	eq_desc _Nil 0 0
+	pop_a 1
+};
+
+
+readPtr :: !(Ptr v) !*(Heap v) -> (!v,!.Heap v);
+readPtr p h = code {
+	push_a_b 1
+	push_r_args_b 0 1 1 1 1
+	eqI
+	jmp_false read_heap_error
+	repl_r_args_a 2 0 1 1
+.d 2 0
+	rtn
+:read_heap_error
+	print "readPtr: Not a pointer of this heap"
+	halt
+};
+
+sreadPtr :: !(Ptr v) !(Heap v) -> v;
+sreadPtr p h = code {
+	push_a_b 1
+	push_r_args_b 0 1 1 1 1
+	eqI
+	jmp_false sread_heap_error
+	repl_r_args_a 2 0 1 1
+	update_a 0 1
+	pop_a 1
+.d 1 0
+	rtn
+:sread_heap_error
+	print "sreadPtr: Not a pointer of this heap"
+	halt
+};
+
+writePtr :: !(Ptr v) !v !*(Heap v) -> .Heap v;
+writePtr p v h = code {
+	push_a_b 2
+	push_r_args_b 0 1 1 1 1
+	eqI
+	jmp_false write_heap_error
+	push_a 1
+	fill1_r e_Heap_kPtr 2 0 1 010
+.keep 0 2
+	pop_a 2 
+.d 1 0
+	rtn
+:write_heap_error
+	print "writePtr: Not a pointer of this heap"
+	halt
+};
+
+(<:=) infixl;
+(<:=) heap ptr_and_val :== writePtr ptr val heap ;
+{
+	(ptr, val) = ptr_and_val;
+}
+
+ptrToInt :: !(Ptr v) -> Int;
+ptrToInt p = code {
+	push_a_b 0
+	pop_a 1
+	build _Nil 0 _hnf
+	push_a_b 0
+	pop_a 1
+	push_b 1
+	eqI
+	jmp_false not_nil
+	pop_b 1
+	pushI 0
+.d 0 1 b
+	rtn
+:not_nil
+.d 0 1 b
+	rtn	
+};
+
+instance == Ptr a
+where
+{	(==) p1 p2 = code {
+	push_r_args_b 1 1 1 1 1
+	push_r_args_b 0 1 1 1 1
+	eqI
+	jmp_false equal_pointer_error
+	push_a_b 1
+	push_a_b 0
+	pop_a 2
+	eqI
+.d 0 1 b
+	rtn	
+:equal_pointer_error
+	print "equal_pointer: Pointers to different heaps"
+	halt	
+	}
+};
\ No newline at end of file
diff --git a/frontend/RWSDebug.dcl b/frontend/RWSDebug.dcl
new file mode 100644
index 0000000..b59baf6
--- /dev/null
+++ b/frontend/RWSDebug.dcl
@@ -0,0 +1,5 @@
+definition module RWSDebug
+
+(->>) :: !.a !.b -> .a
+(<<-) :: .a !.b -> .a
+<<->> :: !.a -> .a
\ No newline at end of file
diff --git a/frontend/RWSDebug.icl b/frontend/RWSDebug.icl
new file mode 100644
index 0000000..9d7639d
--- /dev/null
+++ b/frontend/RWSDebug.icl
@@ -0,0 +1,18 @@
+implementation module RWSDebug
+
+import Debug
+
+show
+	=	debugShowWithOptions [] // [DebugMaxChars 80, DebugMaxDepth 5]
+
+(->>) :: !.a !.b -> .a
+(->>) value debugValue
+	=	debugAfter debugValue show value
+
+(<<-) :: .a !.b -> .a
+(<<-) value debugValue
+	=	debugBefore debugValue show value
+
+<<->> :: !.a -> .a
+<<->> value
+	=	debugValue show value
diff --git a/frontend/ShowWrapped.dcl b/frontend/ShowWrapped.dcl
new file mode 100644
index 0000000..3bcc251
--- /dev/null
+++ b/frontend/ShowWrapped.dcl
@@ -0,0 +1,5 @@
+definition module ShowWrapped
+
+from Wrap import WrappedNode
+
+ShowWrapped :: WrappedNode -> [{#Char}]
\ No newline at end of file
diff --git a/frontend/ShowWrapped.icl b/frontend/ShowWrapped.icl
new file mode 100644
index 0000000..82b72a1
--- /dev/null
+++ b/frontend/ShowWrapped.icl
@@ -0,0 +1,80 @@
+implementation module ShowWrapped
+
+import StdEnv
+import Wrap
+
+ShowWrapped :: WrappedNode -> [{#Char}]
+ShowWrapped node
+	=	Show False node
+
+Show _ (WrappedInt i)
+	=	[toString i]
+Show _ (WrappedChar c)
+	=	["\'" +++ toString c +++ "\'"]
+Show _ (WrappedBool b)
+	=	[toString b]
+Show _ (WrappedReal r)
+	=	[toString r]
+Show _ (WrappedFile f)
+	=	[toString f]
+Show _ (WrappedString s)
+	=	["\"" +++ s +++ "\""]
+Show _ (WrappedIntArray a)
+	=	ShowBasicArray a
+Show _ (WrappedBoolArray a)
+	=	ShowBasicArray a
+Show _ (WrappedRealArray a)
+	=	ShowBasicArray a
+Show _ (WrappedFileArray a)
+	=	ShowBasicArray a
+Show _ (WrappedArray a)
+	=	["{" : flatten (Separate [", "] [Show False el \\ el <-: a])] ++ ["}"]
+Show _ (WrappedRecord descriptor args)
+	=	["{" : flatten (Separate [" "] [[ShowDescriptor descriptor] : [Show True arg \\ arg <-: args]])] ++ ["}"]
+Show _ (WrappedOther WrappedDescriptorCons args)
+	| size args == 2
+	=	["[" : flatten [Show False args.[0] : ShowTail args.[1]]] ++ ["]"]
+	where
+		ShowTail (WrappedOther WrappedDescriptorCons args)
+			| size args == 2
+				=	[[", "], Show False args.[0] : ShowTail args.[1]]
+		ShowTail (WrappedOther WrappedDescriptorNil args)
+			| size args == 0
+				=	[]
+		ShowTail graph // abnormal list
+			=	[[" : " : Show False graph]]
+Show _ (WrappedOther WrappedDescriptorTuple args)
+	=	["(" : flatten (Separate [", "] [Show False arg \\ arg <-: args])] ++ [")"]
+Show pars (WrappedOther descriptor args)
+	| pars && size args > 0
+		=	["(" : application] ++ [")"]
+	// otherwise
+		=	application
+	where
+		application
+			=	flatten (Separate [" "] [[ShowDescriptor descriptor] : [Show True arg \\ arg <-: args]])
+
+ShowDescriptor (WrappedDescriptorOther id)
+	=	toString id
+ShowDescriptor WrappedDescriptorNil
+	=	"[]"
+ShowDescriptor WrappedDescriptorCons
+	=	"[:]"
+ShowDescriptor WrappedDescriptorTuple
+	=	"(..)"
+
+ShowBasicArray a
+	=	["{" : Separate ", " [toString el \\ el <-: a]] ++ ["}"]
+ShowWrappedArray a
+	=	["{" : flatten (Separate [", "] [Show False el \\ el <-: a])] ++ ["}"]
+
+Separate :: a [a] -> [a]
+Separate separator [a : t=:[b : _]]
+	=	[a, separator : Separate separator t]
+Separate _ l
+	=	l
+
+instance toString File
+where
+	toString _
+		=	"File"
diff --git a/frontend/StdCompare.dcl b/frontend/StdCompare.dcl
new file mode 100644
index 0000000..67fff22
--- /dev/null
+++ b/frontend/StdCompare.dcl
@@ -0,0 +1,21 @@
+definition module StdCompare
+
+import syntax, compare_constructor
+
+::	CompareValue :== Int
+Smaller :== -1
+Greater	:== 1
+Equal	:== 0
+
+class (=<) infix 4 a :: !a !a -> CompareValue
+
+instance =< Int, Expression, {# Char}, Ident, [a] | =< a, BasicType //, Global a | =< a
+
+instance =< Type
+
+instance == BasicType, TypeVar, TypeSymbIdent, DefinedSymbol, TypeContext , BasicValue, FunKind, Global a | == a
+
+export == Int
+
+instance < MemberDef
+
diff --git a/frontend/StdCompare.icl b/frontend/StdCompare.icl
new file mode 100644
index 0000000..a8c3f92
--- /dev/null
+++ b/frontend/StdCompare.icl
@@ -0,0 +1,219 @@
+implementation module StdCompare
+
+import StdEnv, compare_constructor
+import syntax
+
+instance == TypeVar
+where
+	(==) varid1 varid2 = varid1.tv_name == varid2.tv_name
+
+instance == FunKind
+where
+	(==) fk1 fk2 = equal_constructor fk1 fk2
+
+instance == Global a | == a
+where
+	(==) g1 g2
+		= g1.glob_module == g2.glob_module && g1.glob_object == g2.glob_object
+
+
+instance == TypeSymbIdent
+where
+	(==) tsymb_id1 tsymb_id2
+		= tsymb_id1.type_index == tsymb_id2.type_index
+
+
+instance == AType
+where
+	(==) atype1 atype2 = atype1.at_type == atype2.at_type
+
+instance == ConsVariable
+where
+	(==) (CV tv1) (CV tv2)			= tv1 == tv2
+	(==) (TempCV tv1) (TempCV tv2)	= tv1 == tv2
+	(==) cv1 cv2					= False
+
+
+instance == TypeContext
+where
+ (==) tc1 tc2 = tc1.tc_class == tc2.tc_class && tc1.tc_types == tc2.tc_types
+
+instance == BasicType
+where
+	(==) bt1 bt2 = equal_constructor bt1 bt2
+
+instance == BasicValue
+where
+	(==) (BVI int1) (BVI int2)			= int1 == int2
+	(==) (BVC char1) (BVC char2)		= char1 == char2
+	(==) (BVB bool1) (BVB bool2)		= bool1 == bool2
+	(==) (BVR real1) (BVR real2)		= real1 == real2
+	(==) (BVS string1) (BVS string2)	= string1 == string2
+	(==) _ _							= False
+			
+instance == DefinedSymbol
+where
+	(==) ds1 ds2
+		= ds1.ds_ident == ds2.ds_ident && ds1.ds_index == ds2.ds_index
+
+instance == Type
+where
+	(==) t1 t2 = equal_constructor t1 t2 && equal_constructor_args t1 t2
+	where
+		equal_constructor_args (TV varid1) (TV varid2)
+			= varid1 == varid2
+		equal_constructor_args (TempV varid1) (TempV varid2)
+			= varid1 == varid2
+		equal_constructor_args (arg_type1 --> restype1) (arg_type2 --> restype2)
+			= arg_type1 == arg_type2 && restype1 == restype2
+		equal_constructor_args (TA tc1 types1) (TA tc2 types2)
+			= tc1 == tc2 && types1 == types2
+		equal_constructor_args (TB tb1) (TB tb2)
+			= tb1 == tb2
+		equal_constructor_args (TA tc1 types1) (TA tc2 types2)
+			= tc1 == tc2 && types1 == types2
+		equal_constructor_args (type1 :@: types1) (type2 :@: types2)
+			= type1 == type2 && types1 == types2
+		equal_constructor_args (TQV varid1) (TQV varid2)
+			= varid1 == varid2
+		equal_constructor_args type1 type2
+			= True
+
+::	CompareValue :== Int
+Smaller :== -1
+Greater	:== 1
+Equal	:== 0
+
+class (=<) infix 4 a :: !a !a -> CompareValue
+
+instance =< Int
+where
+	(=<) i1 i2
+		| i1 == i2
+			= Equal
+		| i1 < i2
+			= Smaller
+			= Greater
+
+instance =< SymbKind
+where
+	(=<) symb1 symb2
+		| equal_constructor symb1 symb2
+			= compare_indexes  symb1 symb2
+		with
+			compare_indexes (SK_Function i1) (SK_Function i2)						= i1 =< i2
+//			compare_indexes (SK_ClassRecord i1) (SK_ClassRecord i2)					= i1 =< i2
+			compare_indexes (SK_Constructor i1) (SK_Constructor i2)					= i1 =< i2
+//			compare_indexes (SK_DeltaFunction i1) (SK_DeltaFunction i2)				= i1 =< i2
+//			compare_indexes (SK_InternalFunction i1) (SK_InternalFunction i2)		= i1 =< i2
+			compare_indexes (SK_OverloadedFunction i1) (SK_OverloadedFunction i2)	= i1 =< i2
+			compare_indexes (SK_GeneratedFunction _ i1) (SK_GeneratedFunction _ i2)	= i1 =< i2
+
+		| less_constructor symb1 symb2
+			= Smaller
+			= Greater
+
+instance =< SymbIdent
+where
+	(=<) {symb_kind=symb_kind1} {symb_kind=symb_kind2} = symb_kind1 =< symb_kind2
+			
+
+instance =< App
+where
+	(=<) app1 app2
+		# cmp = app1.app_symb =< app2.app_symb
+		| cmp == Equal
+			= app1.app_args =< app2.app_args
+			= cmp
+
+instance =< (a,b) | =< a & =< b
+where
+	(=<) (x1,y1) (x2,y2)
+		# cmp = x1 =< x2
+		| cmp == Equal
+			= y1 =< y2
+			= cmp
+	
+instance =< [a] | =< a
+where
+	(=<) [x:xs] [y:ys]	= (x,xs) =< (y,ys)
+	(=<) [] []			= Equal
+	(=<) [] _			= Smaller
+	(=<) _ _			= Greater
+
+instance =< {# Char}
+where
+	(=<) s1 s2
+		| s1 == s2
+			= Equal
+		| s1 < s2
+			= Smaller
+			= Greater
+	
+instance =< Expression
+where
+	(=<) expr1 expr2
+		| equal_constructor expr1 expr2
+			= compare_arguments  expr1 expr2
+		with
+			compare_arguments (App app1) (App app2)						= app1 =< app2
+			compare_arguments (Var v1) (Var v2)							= v1 =< v2
+			compare_arguments (fun1 @ args1) (fun2 @ args2)				= (fun1,args1) =< (fun2,args2) 
+			compare_arguments (Lambda vars1 expr1) (Lambda vars2 expr2)	= (vars1,expr1) =< (vars2,expr2)
+			compare_arguments EE EE										= Equal		
+			compare_arguments _ _										= Greater		
+		| less_constructor expr1 expr2
+			= Smaller
+			= Greater
+
+instance =< BoundVar
+where
+	(=<) bv1 bv2
+		= bv1.var_name =< bv2.var_name
+	
+instance =< FreeVar
+where
+	(=<) fv1 fv2
+		= fv1.fv_name =< fv2.fv_name
+	
+instance =< Ident
+where
+	(=<) id1 id2
+		= id1.id_name =< id2.id_name
+
+instance =< Global a | =< a
+where
+	(=<) g1 g2
+		= (g1.glob_module,g1.glob_object) =< (g2.glob_module,g2.glob_object)
+
+instance =< TypeSymbIdent
+where
+	(=<) s1 s2
+		= s1.type_name =< s2.type_name
+
+instance =< Type
+where
+	(=<) t1 t2
+		| equal_constructor t1 t2
+			= compare_arguments t1 t2
+		| less_constructor t1 t2
+			= Smaller
+			= Greater
+	where
+		compare_arguments (TB tb1) (TB tb2)		= tb1 =< tb2 
+		compare_arguments (TA tc1 _) (TA tc2 _)	= tc1 =< tc2
+		compare_arguments _ _					= Equal
+
+instance =< BasicType
+where
+	(=<) bt1 bt2
+		| equal_constructor bt1 bt2
+			= Equal
+		| less_constructor bt1 bt2
+			= Smaller
+			= Greater
+
+instance < MemberDef
+where
+	(<) md1 md2 = md1.me_symb.id_name < md2.me_symb.id_name
+
diff --git a/frontend/Wrap.dcl b/frontend/Wrap.dcl
new file mode 100644
index 0000000..e5c4b41
--- /dev/null
+++ b/frontend/Wrap.dcl
@@ -0,0 +1,43 @@
+definition module Wrap
+
+/*
+	Wrap arbitrary Clean nodes (for debugging purposes).
+*/
+
+from StdOverloaded import toString 
+
+::	WrappedDescriptorId
+
+instance toString WrappedDescriptorId
+
+::	WrappedDescriptor
+    =   WrappedDescriptorCons
+    |   WrappedDescriptorNil
+    |   WrappedDescriptorTuple
+    |   WrappedDescriptorOther !WrappedDescriptorId
+
+::  WrappedNode
+	//	basic types
+    =   WrappedInt !Int
+    |   WrappedChar !Char
+    |   WrappedBool !Bool
+    |   WrappedReal !Real
+    |   WrappedFile !File
+
+	// unboxed arrays of basic types
+    |   WrappedString !{#Char}
+    |   WrappedIntArray !{#Int}
+    |   WrappedBoolArray !{#Bool}
+    |   WrappedRealArray !{#Real}
+    |   WrappedFileArray !{#File}
+
+	// other arrays
+    |   WrappedArray !{WrappedNode}
+
+	// records
+    |   WrappedRecord !WrappedDescriptor !{WrappedNode}
+
+	// other nodes
+    |   WrappedOther !WrappedDescriptor !{WrappedNode}
+
+Wrap :: !.a -> WrappedNode
\ No newline at end of file
diff --git a/frontend/Wrap.icl b/frontend/Wrap.icl
new file mode 100644
index 0000000..eeb36d8
--- /dev/null
+++ b/frontend/Wrap.icl
@@ -0,0 +1,659 @@
+implementation module Wrap
+
+import	StdOverloaded
+
+::	WrappedDescriptorId = {descriptorId :: !Int}
+
+::  WrappedDescriptor
+    =   WrappedDescriptorCons
+    |   WrappedDescriptorNil
+    |   WrappedDescriptorTuple
+    |   WrappedDescriptorOther !WrappedDescriptorId
+
+::  WrappedNode
+    =   WrappedInt !Int
+    |   WrappedChar !Char
+    |   WrappedBool !Bool
+    |   WrappedReal !Real
+    |   WrappedFile !File
+    |   WrappedString !{#Char}
+    |   WrappedIntArray !{#Int}
+    |   WrappedBoolArray !{#Bool}
+    |   WrappedRealArray !{#Real}
+    |   WrappedFileArray !{#File}
+    |   WrappedArray !{WrappedNode}
+    |   WrappedRecord !WrappedDescriptor !{WrappedNode}
+    |   WrappedOther !WrappedDescriptor !{WrappedNode}
+
+instance toString WrappedDescriptorId where
+	toString :: WrappedDescriptorId -> {#Char}
+	toString {descriptorId}
+		=	descriptorIDtoString descriptorId
+	where
+		descriptorIDtoString :: !Int -> {#Char}
+		descriptorIDtoString id
+			=	code
+			{
+			.d 0 1 i
+				jsr DtoAC
+			.o 1 0
+			}
+
+Wrap :: !.a -> WrappedNode
+Wrap node
+	=	code
+	{
+					| A: <node> <result>
+					| B:
+		eq_desc	BOOL 0 0
+		jmp_false	not_a_bool
+		pushB_a	0
+		pop_a	1
+		fill_r	e_Wrap_kWrappedBool 0 1 0 0 0
+		pop_b	1
+	.d 1 0
+		rtn
+	:not_a_bool
+
+		eq_desc	INT 0 0
+		jmp_false	not_an_int
+
+		pushI_a	0
+		pop_a	1
+		fill_r	e_Wrap_kWrappedInt 0 1 0 0 0
+		pop_b	1
+	.d 1 0
+		rtn
+	:not_an_int
+
+		eq_desc	CHAR 0 0
+		jmp_false	not_a_char
+
+		pushC_a	0
+		pop_a	1
+		fill_r	e_Wrap_kWrappedChar 0 1 0 0 0
+		pop_b	1
+	.d 1 0
+		rtn
+	:not_a_char
+
+		eq_desc	REAL 0 0
+		jmp_false	not_a_real
+
+		pushR_a	0
+		pop_a	1
+		fill_r	e_Wrap_kWrappedReal 0 2 0 0 0
+		pop_b	2
+	.d 1 0
+		rtn
+	:not_a_real
+
+		eq_desc	FILE 0 0
+		jmp_false	not_a_file
+
+		pushF_a	0
+		pop_a	1
+		fill_r	e_Wrap_kWrappedFile 0 2 0 0 0
+		pop_b	2
+	.d 1 0
+		rtn
+	:not_a_file
+
+		eq_desc	ARRAY 1 0
+		jmp_true	wrap_array
+
+		eq_desc	_ARRAY_ 0 0
+		jmp_true	wrap__array
+
+		eq_desc	_STRING_ 0 0
+		jmp_true	wrap__string
+
+		is_record	0
+	.d 2 0
+		jmp_true	wrap_record
+
+		get_node_arity	0
+					| B: <n>
+		eqI_b	0 0
+		jmp_true	wrap_no_args
+
+	:wrap_args
+		push_a	0
+		push_b	0
+		push_b	0
+		repl_args_b
+					| A: <arg_1 .. arg_n> <node> <result>
+		push_b	0
+		create_array_	_ 1 0
+					| A: <_{args}> <arg_1 .. arg_n> <node> <result>
+		pushI	0
+
+	:wrap_args_loop
+					| A: <_{args}> <arg_(i+1) .. arg_n> <node> <result>
+					| B: <i> <n>
+		| wrap arg
+		push_a	1
+		build	e_Wrap_sWrap 1 e_Wrap_nWrap
+		update_a	0 2
+		pop_a	1
+
+		| update i-th element of _args array with wrapped arg
+		push_b	0
+		update	_ 1 0
+
+		| increment index
+		incI
+
+		push_b	0
+		push_b	2
+		eqI
+		jmp_false	wrap_args_loop
+
+		pop_b	2
+					| A: <_{args}> <node> <result>
+					| B:
+	.d 3 0
+		jmp	wrap_descriptor
+
+	:wrap_no_args
+					| A: <node> <result>
+					| B: <0>
+		create_array_	_ 1 0
+
+	.o 3 0
+	:wrap_descriptor
+					| A: <_{args}> <node> <result>
+		push_a	1
+		update_a	1 2
+		update_a	0 1
+		pop_a	1
+					| A: <node> <_{args}> <result>
+		eq_nulldesc	_Tuple 0
+		jmp_false	not_a_tuple
+		build	e_Wrap_dWrappedDescriptorTuple 0 _hnf
+	.d 4 0
+		jmp	wrap_other
+	:not_a_tuple
+
+		eq_nulldesc	_Cons 0
+		jmp_false	not_a_cons
+		build	e_Wrap_dWrappedDescriptorCons 0 _hnf
+		jmp	wrap_other
+	:not_a_cons
+
+		eq_desc	_Nil 0 0
+		jmp_false	not_a_nil
+		build	e_Wrap_dWrappedDescriptorNil 0 _hnf
+		jmp	wrap_other
+	:not_a_nil
+
+					| A: <node> <_{args}> <result>
+		pushD_a	0
+		build_r	e_Wrap_rWrappedDescriptorId 0 1 0 0
+		pop_b	1
+
+		build_r	e_Wrap_kWrappedDescriptorOther 1 0 0 0
+		update_a	0 1
+		pop_a	1
+	.o 4 0
+	:wrap_other
+					| A: <descriptor> <node> <_{args}> <result>
+		update_a	0 1
+		pop_a	1
+					| A: <descriptor> <_{args}> <result>
+		fill_r	e_Wrap_kWrappedOther 2 0 2 0 0
+		pop_a	2
+					| A: <result>
+	.d 1 0
+		rtn
+
+	.o 2 0
+	:wrap_record
+		pushI	0
+		pushD_a	0
+					| A: <node> <result>
+					| B: <desc> <return>
+		push_t_r_args
+
+	:wrap_record_fields
+					| A: <afield_1 .. afield_m> <result>
+					| B: <l> <bfield_1 .. bfield_n> <desc> <return>
+					| (l: points to record layout,
+					|	desc: record descriptor
+					|	return: return selector)
+		push_b	0
+
+	:count_fields_loop
+					| A: <afield_1 .. afield_m> <result>
+					| B: <p> <l> <bfield_1 .. bfield_n> <desc> <return> 
+					| (p=l+offset)
+		push_b	0
+		push_r_arg_t
+		eqI_b	0 0
+		jmp_true	end_count_record_fields
+		pop_b	1
+		incI
+		jmp	count_fields_loop
+
+	:end_count_record_fields
+		pop_b	1
+		push_b	0
+		update_b	2 1
+		subI
+					| A: <afield_1 .. afield_m> <result>
+					| B: <n+m> <l> <bfield_1 .. bfield_n> <desc> <return>
+		create_array_	_ 1 0
+		pushI	0
+		push_b	1
+		update_b	1 2
+		update_b	0 1
+		pop_b	1
+
+	:wrap_fields_loop
+					| A: <_{fields}> <afield_ .. afield_m> <result>
+					| B: <p> <i> <bfield_ .. bfield_n> <desc> <return>
+		push_b	0
+		push_r_arg_t
+		eqI_b	0 0
+		jmp_true	end_wrap_record_fields
+		eqC_b	'i' 0
+		jmp_true	wrap_int_field
+		eqC_b	'c' 0
+		jmp_true	wrap_char_field
+		eqC_b	'r' 0
+		jmp_true	wrap_real_field
+		eqC_b	'b' 0
+		jmp_true	wrap_bool_field
+		eqC_b	'f' 0
+		jmp_true	wrap_file_field
+		eqC_b	'a' 0
+		jmp_true	wrap_graph_field
+		print_sc	"Wrap: unimplemented record field type\n"
+		halt
+
+	:wrap_int_field
+		pop_b	1
+
+		| create and fill int node
+		create
+		fillI_b	2 0
+		push_a	1
+		update_a	1 2
+		update_a	0 1
+		pop_a	1
+
+		update_b	1 2
+		update_b	0 1
+		pop_b	1
+
+		jmp	wrap_field
+
+	:wrap_char_field
+		pop_b	1
+
+		| create and fill char node
+		create
+		fillC_b	2 0
+		push_a	1
+		update_a	1 2
+		update_a	0 1
+		pop_a	1
+
+		update_b	1 2
+		update_b	0 1
+		pop_b	1
+
+		jmp	wrap_field
+
+	:wrap_bool_field
+		pop_b	1
+
+		| create and fill bool node
+		create
+		fillB_b	2 0
+		push_a	1
+		update_a	1 2
+		update_a	0 1
+		pop_a	1
+
+		update_b	1 2
+		update_b	0 1
+		pop_b	1
+
+		jmp	wrap_field
+
+
+	:wrap_real_field
+		pop_b	1
+
+		| create and fill real node
+		create
+		fillR_b	2 0
+		push_a	1
+		update_a	1 2
+		update_a	0 1
+		pop_a	1
+
+		update_b	1 3
+		update_b	0 2
+		pop_b	2
+
+		jmp	wrap_field
+
+	:wrap_file_field
+		pop_b	1
+
+		| create and fill file node
+		create
+		fillF_b	2 0
+		push_a	1
+		update_a	1 2
+		update_a	0 1
+		pop_a	1
+
+		update_b	1 3
+		update_b	0 2
+		pop_b	2
+
+		jmp	wrap_field
+
+	:wrap_graph_field
+		pop_b	1
+		jmp	wrap_field
+
+	:wrap_field
+					| A: <_{fields}> <field> <afield_ .. afield_m>
+		| wrap field
+		push_a	1
+		build	e_Wrap_sWrap 1 e_Wrap_nWrap
+		update_a	0 2
+		pop_a	1
+
+		| update i-th element of _fields array with wrapped field
+		push_b	1
+		update _ 1 0
+					| A: <_{fields}> <afield_ .. afield_m> <result>
+					| B: <p> <i> <bfield_ .. bfield_n> <desc> <return>
+
+		| increment index
+		push_b	1
+		incI
+		update_b	0 2
+
+		| increment pointer in layout string
+		pop_b	1
+		incI
+
+		jmp	wrap_fields_loop
+
+	:end_wrap_record_fields
+					| A: <_{fields}> <result>
+					| B: <i=0> <p> <i> <desc> <return>
+		pop_b	3
+					| A: <_{fields}> <result>
+					| B: <desc> <return>
+
+		| create WrappedDescriptorOther node
+		build_r	e_Wrap_rWrappedDescriptorId 0 1 0 0
+		pop_b	1
+		build_r	e_Wrap_kWrappedDescriptorOther 1 0 0 0
+		update_a	0 1
+		pop_a 1
+					| A: <descriptor> <{fields}> <result>
+
+		| fill result node
+		fill_r	e_Wrap_kWrappedRecord 2 0 2 0 0
+		pop_a	2
+
+					| A: <result>
+					| B: <return>
+		| return to caller (determined by the return selector)
+		eqI_b	0 0
+		jmp_true	wrap_record_return_node
+		eqI_b	1 0
+		jmp_true	wrap_record_array_return
+		print_sc	"Wrap: (record fields) unknown return selector\n"
+		halt
+
+	:wrap_record_return_node
+					| A: <result>
+					| B: <return>
+		pop_b	1
+	.d 1 0
+					| A: <result>
+					| B:
+		rtn
+
+	:wrap_array
+					| A: <array> <result>
+		| replace ARRAY by _ARRAY_
+		pushA_a	0
+		update_a	0 1
+		pop_a		1
+
+	:wrap__array
+					| A: <_array> <result>
+		eq_desc	_STRING_ 0 0
+		jmp_false	not_a_string
+
+	:wrap__string
+		| fill result node
+		fill_r	e_Wrap_kWrappedString 1 0 1 0 0
+		pop_a	1
+	.d 1 0
+					| A: <result>
+		rtn
+	:not_a_string
+	
+		| push array element descriptor
+		push_r_args_b	0 0 2 2 1
+					| A: <_array> <result>
+					| B: <desc>
+		push_b	0
+		eq_desc_b	BOOL 0
+		jmp_true	wrap_bool_array
+		push_b	0
+		eq_desc_b	INT 0
+		jmp_true	wrap_int_array
+		push_b	0
+		eq_desc_b	REAL 0
+		jmp_true	wrap_real_array
+		push_b	0
+		eq_desc_b	FILE 0
+		jmp_true	wrap_file_array
+
+		pushI	0
+		push_a	0
+		push_arraysize	_ 0 1
+					| A: <_array> <result>
+					| B: <n> <i> <desc>
+		push_b	2
+		update_b	2 3
+		update_b	1 2
+		update_b	0 1
+		pop_b	1
+					| B: <desc> <n> <i>
+		pushI	0
+		eqI
+					| B: <n> <i>
+		jmp_false	wrap_record_array
+
+		push_b	0
+		create_array_	_ 1 0
+					| A: <_wrapped_array> <_array> <result>
+					| B: <n> <i>
+	.d 3 2 i i
+		jmp	wrap_array_test
+
+	.o 3 2 i i
+	:wrap_array_elements
+					| A: <_wrapped_array> <_array> <result>
+					| B: <n> <i>
+
+		| wrap element
+		push_b	1
+		push_a	1
+		select	_ 1 0
+		build	e_Wrap_sWrap 1 e_Wrap_nWrap
+					| A: <element> <_wrapped_array> <_array> <result>
+					| B: <n> <i>
+		| update i-th element of _wrapped_array with wrapped element
+		push_a	1
+		push_b	1
+		update	_ 1 0
+		update_a	0 1
+		pop_a	1
+					| B: <n> <i>
+		| increment index
+		push_b	1
+		incI
+		update_b	0 2
+
+		| decrement n
+		pop_b	1
+		decI
+
+	.o 3 2 i i
+	:wrap_array_test
+					| B: <n> <i>
+		eqI_b	0 0
+	.d 3 2 i i
+		jmp_false	wrap_array_elements
+					| A: <_wrapped_array> <_array> <result>
+					| B: <n> <i>
+		pop_b	2
+		update_a	0 1
+		pop_a	1
+					| A: <_wrapped_array> <result>
+					| B:
+		| fill result node
+		fill_r	e_Wrap_kWrappedArray 1 0 1 0 0
+		pop_a	1
+	.d 1 0
+					| A: <result>
+					| B:
+		rtn
+
+
+	:wrap_bool_array
+					| A: <_array> <result>
+					| B: <desc>
+		pop_b	1
+
+		| fill result node
+		fill_r	e_Wrap_kWrappedBoolArray 1 0 1 0 0
+		pop_a	1
+    .d 1 0
+                    | A: <result>
+                    | B:
+        rtn
+
+	:wrap_int_array
+					| A: <_array> <result>
+					| B: <desc>
+		pop_b	1
+
+		| fill result node
+		fill_r	e_Wrap_kWrappedIntArray 1 0 1 0 0
+		pop_a	1
+	.d 1 0
+					| A: <result>
+					| B:
+		rtn
+
+	:wrap_real_array
+					| A: <_array> <result>
+					| B: <desc>
+		pop_b	1
+
+		| fill result node
+		fill_r	e_Wrap_kWrappedRealArray 1 0 1 0 0
+		pop_a	1
+	.d 1 0
+					| A: <result>
+					| B:
+		rtn
+
+	:wrap_file_array
+					| A: <_array> <result>
+					| B: <desc>
+		pop_b	1
+
+		| fill result node
+		fill_r	e_Wrap_kWrappedFileArray 1 0 1 0 0
+		pop_a	1
+	.d 1 0
+					| A: <result>
+					| B:
+		rtn
+
+	:wrap_record_array
+					| A: <_array> <result>
+					| B: <n> <i>
+		push_b	0
+		create_array_	_ 1 0
+					| A: <_wrapped_array> <_array> <result>
+					| B: <n> <i>
+
+		jmp	wrap_record_array_test
+
+	:wrap_record_array_loop
+					| B: <n> <i>
+		pushI	1
+		| push record element descriptor
+		push_r_args_b	1 0 2 2 1
+					| B: <desc> <return> <n> <i>
+
+		| create result node for wrap_record_fields
+		create
+
+		| push fields from i-th array element
+		push_b	3
+		push_a	2
+		push_a_r_args
+					| A: <afield_1 .. afield_m> <elresult> <_wrapped_array> <_array> <result>
+					| B: <l> <bfieldb_1 .. bfield_n> <desc> <return> <n> <i>
+		| wrap record element
+		jmp	wrap_record_fields
+	:wrap_record_array_return
+					| A: <element> <_wrapped_array> <_array> <result>
+					| B: <return> <n> <i>
+		pop_b	1
+					| A: <element> <_wrapped_array> <_array> <result>
+					| B: <n> <i> 
+		| update i-th of _wrapped_array with wrapped record element
+		push_a	1
+		push_b	1
+		update	_ 1 0
+		update_a	0 1
+		pop_a	1
+					| A: <_wrapped_array> <_array> <result>
+					| B: <n> <i>
+		| increment index
+		push_b	1
+		incI
+		update_b	0 2
+		pop_b	1
+
+		| decrement n
+		decI
+
+	:wrap_record_array_test
+		eqI_b	0 0
+		jmp_false	wrap_record_array_loop
+					| A: <_wrapped_array> <_array> <result>
+					| B: <n> <i>
+		pop_b	2
+					| B:
+
+		update_a	0 1
+		pop_a	1
+					| A: <_wrapped_array> <result>
+		| fill result node
+		fill_r	e_Wrap_kWrappedArray 1 0 1 0 0
+		pop_a	1
+	.d 1 0
+					| A: <result>
+					| B:
+		rtn
+	}
diff --git a/frontend/analtypes.dcl b/frontend/analtypes.dcl
new file mode 100644
index 0000000..ae9b48d
--- /dev/null
+++ b/frontend/analtypes.dcl
@@ -0,0 +1,8 @@
+definition module analtypes
+
+import checksupport, typesupport
+
+
+analTypeDefs :: !{#CommonDefs} !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
+
+instance <<< TypeKind
diff --git a/frontend/analtypes.icl b/frontend/analtypes.icl
new file mode 100644
index 0000000..2793a43
--- /dev/null
+++ b/frontend/analtypes.icl
@@ -0,0 +1,487 @@
+implementation module analtypes
+
+import StdEnv
+import syntax, checksupport, checktypes, check, typesupport, utilities, RWSDebug
+
+::	UnifyKindsInfo = 
+	{	uki_kind_heap	::!.KindHeap
+	,	uki_error		::!.ErrorAdmin
+	}
+	
+AS_NotChecked :== -1
+
+instance <<< TypeKind
+where
+	(<<<) file tk = file <<< toString (toKindInfo tk)
+
+instance toString KindInfo
+where
+	toString (KI_Var ptr) 		= "*" +++ toString (ptrToInt ptr)
+	toString (KI_Const) 		= "*"
+	toString (KI_Arrow kinds)	= kind_list_to_string kinds
+	where
+		kind_list_to_string [] = " ?????? "
+		kind_list_to_string [k] = "* -> *"
+		kind_list_to_string [k:ks] = "* -> " +++ kind_list_to_string ks
+
+
+kindError kind1 kind2 error
+	= checkError "conflicting kinds: " (toString kind1 +++ " and " +++ toString kind2) error
+
+unifyKinds  :: !KindInfo !KindInfo !*UnifyKindsInfo -> *UnifyKindsInfo
+unifyKinds (KI_Indirection kind1) kind2 uni_info=:{uki_kind_heap}
+	= unifyKinds kind1 kind2 uni_info
+unifyKinds kind1 (KI_Indirection kind2) uni_info=:{uki_kind_heap}
+	= unifyKinds kind1 kind2 uni_info
+unifyKinds (KI_Var info_ptr1) kind=:(KI_Var info_ptr2) uni_info=:{uki_kind_heap}
+	| info_ptr1 == info_ptr2
+		= uni_info
+		= { uni_info & uki_kind_heap = writePtr info_ptr1 (KI_Indirection kind) uki_kind_heap }
+unifyKinds k1=:(KI_Var info_ptr1) kind uni_info=:{uki_kind_heap,uki_error}
+	| contains_kind_ptr info_ptr1 uki_kind_heap kind
+		= { uni_info & uki_error = kindError k1 kind uki_error }
+		= { uni_info & uki_kind_heap = writePtr info_ptr1 (KI_Indirection kind) uki_kind_heap }
+where
+	contains_kind_ptr info_ptr uki_kind_heap (KI_Arrow kinds) 
+		= any (contains_kind_ptr info_ptr uki_kind_heap) kinds
+	contains_kind_ptr info_ptr uki_kind_heap (KI_Indirection kind_info)
+		= contains_kind_ptr info_ptr uki_kind_heap kind_info
+	contains_kind_ptr info_ptr uki_kind_heap (KI_Var kind_info_ptr)
+		= info_ptr1 == kind_info_ptr
+	contains_kind_ptr info_ptr uki_kind_heap (KI_Const)
+		= False
+
+unifyKinds kind k1=:(KI_Var info_ptr1) uni_info
+	= unifyKinds k1 kind  uni_info
+unifyKinds kind1=:(KI_Arrow kinds1) kind2=:(KI_Arrow kinds2) uni_info=:{uki_error}
+	| length kinds1 == length kinds2
+		= foldr2 unifyKinds uni_info kinds1 kinds2
+		= { uni_info & uki_error = kindError kind1 kind2 uki_error }
+unifyKinds KI_Const KI_Const uni_info
+	= uni_info
+unifyKinds kind1 kind2 uni_info=:{uki_error}
+	= { uni_info & uki_error = kindError kind1 kind2 uki_error }
+
+class toKindInfo a :: !a -> KindInfo
+
+instance toKindInfo TypeKind
+where
+	toKindInfo (KindVar info_ptr)
+		= KI_Var info_ptr
+	toKindInfo KindConst
+		= KI_Const
+	toKindInfo (KindArrow arity)
+		= KI_Arrow [ KI_Const \\ i <- [1 .. arity]]
+//			---> ("toKindInfo", arity)
+
+
+::	VarBind =
+	{	vb_var 	::	!KindInfoPtr
+	,	vb_vars	::	![KindInfoPtr]
+	}
+
+::	Conditions =
+	{	con_top_var_binds	:: ![KindInfoPtr]
+	,	con_var_binds		:: ![VarBind]
+	}
+
+
+	
+::	AnalState =
+	{	as_td_infos			:: !.TypeDefInfos
+	,	as_heaps			:: !.TypeHeaps
+	,	as_kind_heap		:: !.KindHeap
+	,	as_check_marks		:: !.{# .{# Int}}
+	,	as_next_num			:: !Int
+	,	as_deps				:: ![Global Index]
+//	,	as_groups			:: ![[Global Index]]
+	,	as_next_group_num	:: !Int
+	,	as_error			:: !.ErrorAdmin
+	}
+
+::	TypeProperties	:== BITVECT
+
+combineTypeProperties prop1 prop2 :== (combineHyperstrictness prop1 prop2) bitor (combineCoercionProperties prop1 prop2)
+
+condCombineTypeProperties has_root_attr prop1 prop2
+	| has_root_attr
+		= combineTypeProperties prop1 prop2
+		= combineTypeProperties prop1 (prop2 bitand (bitnot cIsNonCoercible))
+
+combineCoercionProperties prop1 prop2	:== (prop1 bitor prop2) bitand cIsNonCoercible
+combineHyperstrictness prop1 prop2		:== (prop1 bitand prop2) bitand cIsHyperStrict
+
+class analTypes type :: !Bool !{#CommonDefs} ![KindInfoPtr] !type !(!Conditions, !*AnalState)
+	-> (!Int, !KindInfo, TypeProperties, !(!Conditions, !*AnalState))
+
+cDummyBool :== False
+
+instance analTypes AType
+where
+	analTypes _ modules form_tvs atype=:{at_attribute,at_type} conds_as
+		= analTypes (has_root_attr at_attribute) modules form_tvs at_type conds_as
+	where
+		has_root_attr (TA_RootVar _)	= True
+		has_root_attr _ 				= False
+		
+instance analTypes TypeVar
+where
+	analTypes has_root_attr modules form_tvs {tv_info_ptr}  (conds=:{con_var_binds}, as=:{as_heaps, as_kind_heap})
+		# (TVI_TypeKind kind_info_ptr, th_vars) = readPtr tv_info_ptr as_heaps.th_vars
+		  (kind_info, as_kind_heap) = readPtr kind_info_ptr as_kind_heap
+		  kind_info = skip_indirections kind_info
+		| isEmpty form_tvs
+			= (cMAXINT, kind_info, cIsHyperStrict, (conds, { as & as_heaps = { as_heaps & th_vars = th_vars }, as_kind_heap = as_kind_heap }))
+			= (cMAXINT, kind_info, cIsHyperStrict, ({ conds & con_var_binds = [{vb_var = kind_info_ptr, vb_vars = form_tvs } : con_var_binds] },
+						 { as & as_heaps = { as_heaps & th_vars = th_vars }, as_kind_heap = as_kind_heap }))
+	where
+		skip_indirections (KI_Indirection kind)
+			= skip_indirections kind
+		skip_indirections kind
+			= kind
+
+instance analTypes Type
+where
+	analTypes has_root_attr modules form_tvs (TV tv) conds_as
+		= analTypes has_root_attr modules form_tvs tv conds_as
+	analTypes has_root_attr modules form_tvs type=:(TA {type_index={glob_module,glob_object},type_arity} types) conds_as
+		# (ldep, (conds, as)) = anal_type_def modules glob_module glob_object conds_as
+		  {td_arity} = modules.[glob_module].com_type_defs.[glob_object]
+		  ({tdi_kinds, tdi_properties}, as) = as!as_td_infos.[glob_module].[glob_object]
+		  kind = if (td_arity == type_arity) KI_Const (KI_Arrow [ toKindInfo tk \\ tk <- drop type_arity tdi_kinds ])
+		| ldep < cMAXINT /* hence we have a recursive type application */ // ---> ("analTypes", toString kind)
+			# (ldep2, type_props, conds_as)
+					= anal_types_of_rec_type_cons modules form_tvs types tdi_kinds (conds, as)
+			= (min ldep ldep2, kind, type_props, conds_as)
+			# (ldep2, type_props, conds_as)
+					= anal_types_of_type_cons modules form_tvs types tdi_kinds (conds, as)
+//							 ---> (types, tdi_kinds)
+			= (min ldep ldep2, kind, condCombineTypeProperties has_root_attr type_props tdi_properties, conds_as)
+	where
+		anal_types_of_rec_type_cons modules form_tvs [] _ conds_as
+			= (cMAXINT, cIsHyperStrict, conds_as)
+		anal_types_of_rec_type_cons modules form_tvs [type : types] [(KindVar kind_info_ptr) : tvs] conds_as
+			# (ldep, type_kind, type_props, (conds, as=:{as_kind_heap,as_error})) = analTypes has_root_attr modules [ kind_info_ptr : form_tvs ] type conds_as
+			  (kind, as_kind_heap) = readPtr kind_info_ptr as_kind_heap
+			  {uki_kind_heap, uki_error} = unifyKinds type_kind kind {uki_kind_heap = as_kind_heap, uki_error = as_error}
+			| is_type_var type
+				# (min_dep, other_type_props, conds_as) = 
+						anal_types_of_rec_type_cons modules form_tvs types tvs (conds, { as & as_kind_heap = uki_kind_heap, as_error = uki_error })
+				= (min ldep min_dep, combineTypeProperties type_props other_type_props, conds_as)
+				# (min_dep, other_type_props, conds_as) = 
+						anal_types_of_rec_type_cons modules form_tvs types tvs
+							({ conds & con_top_var_binds = [kind_info_ptr : conds.con_top_var_binds]}, { as & as_kind_heap = uki_kind_heap, as_error = uki_error })
+
+				# (min_dep, other_type_props, conds_as) = 
+						anal_types_of_rec_type_cons modules form_tvs types tvs 
+							({ conds & con_top_var_binds = [kind_info_ptr : conds.con_top_var_binds]}, { as & as_kind_heap = uki_kind_heap, as_error = uki_error })
+				= (min ldep min_dep, combineTypeProperties type_props other_type_props, conds_as)
+		where
+			is_type_var {at_type = TV _}
+				= True
+			is_type_var _
+				= False
+			
+		anal_types_of_type_cons modules form_tvs [] _ conds_as
+			= (cMAXINT, cIsHyperStrict, conds_as)
+		anal_types_of_type_cons modules form_tvs [type : types] [tk : tks] conds_as
+			# (ldep, type_kind, type_props, (conds, as=:{as_kind_heap,as_error})) = analTypes has_root_attr modules form_tvs type conds_as
+			  {uki_kind_heap, uki_error} = unifyKinds type_kind (toKindInfo tk) {uki_kind_heap = as_kind_heap, uki_error = as_error}
+			  (min_dep, other_type_props, conds_as)
+					=  anal_types_of_type_cons modules form_tvs types tks (conds, { as & as_kind_heap = uki_kind_heap, as_error = uki_error })
+			= (min ldep min_dep, combineTypeProperties type_props other_type_props, conds_as)
+		anal_types_of_type_cons modules form_tvs types tks conds_as
+			= abort ("anal_types_of_type_cons (analtypes.icl)" ---> (types, tks))
+		
+		anal_type_def modules module_index type_index (conds, as=:{as_check_marks})
+			#! mark = as_check_marks.[module_index].[type_index]
+			| mark == AS_NotChecked
+				# (mark, ({con_var_binds,con_top_var_binds}, as)) = analTypeDef modules module_index type_index as
+				= (mark, ({con_top_var_binds = con_top_var_binds ++ conds.con_top_var_binds, con_var_binds = con_var_binds ++ conds.con_var_binds}, as))
+				= (mark, (conds, as))
+	
+	analTypes has_root_attr modules form_tvs (arg_type --> res_type) conds_as
+		# (arg_ldep, arg_kind, arg_type_props, conds_as) = analTypes has_root_attr modules form_tvs arg_type conds_as
+		  (res_ldep, res_kind, res_type_props, (conds, as=:{as_kind_heap,as_error})) = analTypes has_root_attr modules form_tvs res_type conds_as
+		  {uki_kind_heap, uki_error} = unifyKinds res_kind KI_Const (unifyKinds arg_kind KI_Const {uki_kind_heap = as_kind_heap, uki_error = as_error})
+		  type_props = if	has_root_attr
+							(combineCoercionProperties arg_type_props res_type_props bitor cIsNonCoercible)
+							(combineCoercionProperties arg_type_props res_type_props)
+		= (min arg_ldep res_ldep, KI_Const, type_props, (conds, {as & as_kind_heap = uki_kind_heap, as_error = uki_error }))
+	analTypes has_root_attr modules form_tvs (CV tv :@: types) conds_as
+		# (ldep1, type_kind, cv_props, conds_as) = analTypes has_root_attr modules form_tvs tv conds_as
+		  (ldep2, type_kinds, is_non_coercible, (conds, as=:{as_kind_heap,as_error})) = check_type_list modules form_tvs types conds_as
+		  {uki_kind_heap, uki_error} = unifyKinds type_kind (KI_Arrow type_kinds) {uki_kind_heap = as_kind_heap, uki_error = as_error}
+		  type_props = if (is_non_coercible || has_root_attr) cIsNonCoercible (cv_props bitand cIsNonCoercible)
+		= (min ldep1 ldep2, KI_Const, type_props, (conds, {as & as_kind_heap = uki_kind_heap, as_error = uki_error }))
+
+	where
+		check_type_list modules form_tvs [] conds_as
+			= (cMAXINT, [], False, conds_as)
+		check_type_list modules form_tvs [type : types] conds_as
+			# (ldep1, tk, type_props, (conds, as=:{as_kind_heap,as_error})) = analTypes has_root_attr modules form_tvs type conds_as
+			  {uki_kind_heap, uki_error} = unifyKinds tk KI_Const {uki_kind_heap = as_kind_heap, uki_error = as_error}
+			  (ldep2, tks, is_non_coercible, conds_as) = check_type_list modules form_tvs types (conds, {as & as_kind_heap = uki_kind_heap, as_error = uki_error })
+			= (min ldep1 ldep2, [tk : tks], is_non_coercible || (type_props bitand cIsNonCoercible <> 0), conds_as)
+	analTypes has_root_attr modules form_tvs type conds_as
+		= (cMAXINT, KI_Const, cIsHyperStrict, conds_as)
+	
+/*
+analTypesOfConstructor :: !Index !Index ![TypeVar] ![AttributeVar] !AType ![DefinedSymbol] !Bool !Index !Level !TypeAttribute !Conditions !*TypeSymbols !*TypeInfo !*CheckState
+	-> *(!TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState)
+*/
+analTypesOfConstructor modules cons_defs [{ds_index}:conses] (conds, as=:{as_heaps,as_kind_heap})
+	# {cons_exi_vars,cons_type} = cons_defs.[ds_index]
+	  (coercible, th_vars, as_kind_heap) = new_local_kind_variables cons_exi_vars (as_heaps.th_vars, as_kind_heap)
+	  (cons_ldep, cons_properties, conds_as) = anal_types_of_cons modules cons_type.st_args
+			(conds, { as & as_heaps = { as_heaps & th_vars = th_vars }, as_kind_heap = as_kind_heap })
+	  (conses_ldep, other_properties, conds_as) = analTypesOfConstructor modules cons_defs conses conds_as
+	  properties = combineTypeProperties cons_properties other_properties
+	= (min cons_ldep conses_ldep, if coercible properties (properties bitor cIsNonCoercible), conds_as)
+where
+/*
+	check_types_of_cons :: ![AType] !Bool !Index  !Level ![TypeVar] !TypeAttribute ![AttrInequality] !Conditions !*TypeSymbols !*TypeInfo !*CheckState
+		-> *(![AType], ![[ATypeVar]], ![AttrInequality], !TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState)
+*/
+	new_local_kind_variables td_args (type_var_heap, as_kind_heap)
+		= foldSt new_kind td_args (True, type_var_heap, as_kind_heap)
+	where
+		new_kind {atv_variable={tv_info_ptr},atv_attribute} (coercible, type_var_heap, kind_heap)
+			# (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap
+			= (coercible && is_not_a_variable atv_attribute, type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr),
+				kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr))
+
+		is_not_a_variable (TA_RootVar var)	= False
+		is_not_a_variable attr				= True
+			
+	anal_types_of_cons modules [] conds_as
+		= (cMAXINT, cIsHyperStrict, conds_as)
+	anal_types_of_cons modules [type : types] conds_as
+		# (ldep1, other_type_props, conds_as) = anal_types_of_cons modules types conds_as
+		  (ldep2, type_kind, cv_props, (conds, as=:{as_kind_heap, as_error})) = analTypes cDummyBool modules [] type conds_as
+		  {uki_kind_heap, uki_error} = unifyKinds type_kind KI_Const {uki_kind_heap = as_kind_heap, uki_error = as_error}
+		  cons_props = if	(type_is_strict type.at_annotation)
+							(combineTypeProperties cv_props other_type_props)
+							(combineCoercionProperties cv_props other_type_props)
+		= (min ldep1 ldep2, cons_props, (conds, { as & as_kind_heap = uki_kind_heap, as_error = uki_error }))
+
+	where 
+		type_is_strict AN_Strict
+			= True
+		type_is_strict annot
+			= False
+
+analTypesOfConstructor _ _ [] conds_as
+	= (cMAXINT, cIsHyperStrict, conds_as)
+
+/*
+analRhsOfTypeDef :: !CheckedTypeDef ![AttributeVar] !Bool !Index !Level !TypeAttribute !Index !Conditions !*TypeSymbols !*TypeInfo !*CheckState
+	-> (!TypeRhs, !TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState)
+*/
+
+analRhsOfTypeDef modules com_cons_defs (AlgType conses) conds_as
+	= analTypesOfConstructor modules com_cons_defs conses conds_as
+analRhsOfTypeDef modules com_cons_defs (RecordType {rt_constructor}) conds_as
+	= analTypesOfConstructor modules com_cons_defs [rt_constructor] conds_as
+analRhsOfTypeDef modules _ (SynType type) conds_as
+	# (ldep, type_kind, cv_props, (conds, as=:{as_kind_heap, as_error})) = analTypes cDummyBool modules [] type conds_as
+	  {uki_kind_heap, uki_error} = unifyKinds type_kind KI_Const {uki_kind_heap = as_kind_heap, uki_error = as_error}
+	= (ldep, cv_props, (conds, { as & as_kind_heap = as_kind_heap, as_error = as_error }))
+
+emptyIdent name :== { id_name = name, id_info = nilPtr }
+
+newKindVariables td_args (type_var_heap, as_kind_heap)
+	= mapSt new_kind td_args (type_var_heap, as_kind_heap)
+where
+	new_kind {atv_variable={tv_info_ptr}} (type_var_heap, kind_heap)
+		# (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap
+		= (KindVar kind_info_ptr, (type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr)))
+
+
+/*
+checkTypeDef :: !Bool !Index !Index  !Level !*TypeSymbols !*TypeInfo !*CheckState -> (!Int, !Conditions, !*TypeSymbols, !*TypeInfo, !*CheckState);
+checkTypeDef is_main_dcl type_index module_index level ts=:{ts_type_defs} ti=:{ti_kind_heap,ti_heaps} cs=:{cs_error}
+*/
+analTypeDef modules type_module type_index as=:{as_error,as_heaps,as_kind_heap,as_td_infos}
+	# {com_type_defs,com_cons_defs} = modules.[type_module]
+	  {td_name,td_pos,td_args,td_rhs} = com_type_defs.[type_index]
+	  (is_abs_type, abs_type_properties) = is_abstract_type td_rhs
+	| is_abs_type
+		# (tdi, as_td_infos) = as_td_infos![type_module].[type_index]
+		= (cMAXINT, ({con_top_var_binds = [], con_var_binds = [] }, 
+				{ as & as_td_infos = { as_td_infos & [type_module].[type_index] = { tdi & tdi_kinds = [ KindConst \\ _ <- td_args ], tdi_group_vars = [ i \\ _ <- td_args & i <- [0..]],
+																						  tdi_properties = abs_type_properties }}}))
+		# position = newPosition td_name td_pos
+		  as_error = pushErrorAdmin position as_error
+		  (tdi_kinds, (th_vars, as_kind_heap)) = newKindVariables td_args (as_heaps.th_vars, as_kind_heap)
+		  (ldep, type_properties, (conds, as)) = analRhsOfTypeDef modules com_cons_defs td_rhs ({ con_top_var_binds = [], con_var_binds = [] },
+				push_on_dep_stack type_module type_index
+					{ as &	as_heaps = { as_heaps & th_vars = th_vars }, as_kind_heap = as_kind_heap, as_error = as_error,
+							as_td_infos = { as_td_infos & [type_module].[type_index].tdi_kinds = tdi_kinds }})
+//								---> (td_name, td_args, tdi_kinds)
+		= try_to_close_group modules type_module type_index ldep (conds,
+				{ as & as_error = popErrorAdmin as.as_error,  as_td_infos = { as.as_td_infos & [type_module].[type_index].tdi_properties = type_properties }})
+//					---> ("analTypeDef", td_name, type_module, type_index)
+where
+	is_abstract_type (AbstractType properties)
+		= (True, properties)
+	is_abstract_type _
+		= (False, cAllBitsClear)
+
+	push_on_dep_stack module_index type_index as=:{as_deps,as_check_marks,as_next_num}
+		= { as &
+				as_deps = [{glob_module = module_index, glob_object = type_index } : as_deps],
+				as_check_marks = { as_check_marks & [module_index].[type_index] = as_next_num },
+				as_next_num = inc as_next_num }
+
+	try_to_close_group modules type_module type_index ldep (conds=:{con_top_var_binds,con_var_binds},
+		as=:{as_check_marks,as_deps,as_next_group_num,as_kind_heap,as_heaps,as_td_infos})
+		#! my_mark = as_check_marks.[type_module].[type_index]
+		| (ldep == cMAXINT || ldep == my_mark)
+			# (as_deps, as_check_marks, group) = close_group type_module type_index as_deps as_check_marks [] 
+			  (kinds, (type_properties, as_kind_heap, as_td_infos)) = determine_kinds_and_properties_of_group group as_kind_heap as_td_infos
+			  kind_heap = unify_var_binds con_var_binds as_kind_heap
+			  (normalized_top_vars, (kind_var_store, as_kind_heap)) = normalize_top_vars con_top_var_binds 0 as_kind_heap
+			  (as_kind_heap, as_td_infos) = update_type_group_info group kinds type_properties normalized_top_vars group as_next_group_num kind_var_store as_kind_heap as_td_infos
+			= (cMAXINT, ({con_top_var_binds = [], con_var_binds = [] },
+				 { as & as_check_marks = as_check_marks, as_deps = as_deps, as_kind_heap = as_kind_heap,
+						as_td_infos = as_td_infos, as_next_group_num = inc as_next_group_num }))
+			= (min my_mark ldep, (conds, as))
+
+	close_group first_module first_index [d:ds] marks group
+		# marks = { marks & [d.glob_module].[d.glob_object] = cMAXINT }
+		| d.glob_module == first_module && d.glob_object == first_index
+			= (ds, marks, [d : group])
+			= close_group first_module first_index ds marks [d : group]
+
+	determine_kinds_and_properties_of_group group kind_heap as_td_infos
+		= mapSt determine_kinds group (cIsHyperStrict, kind_heap, as_td_infos)
+	where
+		determine_kinds {glob_module,glob_object} (type_properties, kind_heap, as_td_infos)
+			# ({tdi_properties,tdi_kinds}, as_td_infos) = as_td_infos![glob_module].[glob_object]
+			  (kinds, kind_heap) = mapSt retrieve_kind tdi_kinds kind_heap
+			= (kinds, (combineTypeProperties type_properties tdi_properties, kind_heap, as_td_infos))
+				
+		retrieve_kind (KindVar kind_info_ptr) kind_heap
+			#! kind_info = sreadPtr kind_info_ptr kind_heap
+			= (determine_kind kind_info, kind_heap)
+		where
+			determine_kind (KI_Indirection kind) 
+				= determine_kind kind
+			determine_kind (KI_Arrow kinds)
+				= KindArrow (length kinds)
+			determine_kind kind
+				= KindConst
+			   
+	unify_var_binds :: ![VarBind] !*KindHeap -> *KindHeap
+	unify_var_binds binds kind_heap
+		= foldr unify_var_bind kind_heap binds
+
+	unify_var_bind :: !VarBind !*KindHeap -> *KindHeap
+	unify_var_bind {vb_var, vb_vars} kind_heap
+		#! kind_info = sreadPtr vb_var kind_heap
+		# (vb_var, kind_heap) = determine_var_bind vb_var kind_info kind_heap
+		= redirect_vars vb_var vb_vars kind_heap
+	where	
+		redirect_vars kind_info_ptr [var_info_ptr : var_info_ptrs] kind_heap
+			#! kind_info = sreadPtr var_info_ptr kind_heap
+			# (var_info_ptr, kind_heap) = determine_var_bind var_info_ptr kind_info kind_heap
+			| kind_info_ptr == var_info_ptr
+				= redirect_vars kind_info_ptr var_info_ptrs kind_heap
+				= redirect_vars kind_info_ptr var_info_ptrs (writePtr kind_info_ptr (KI_VarBind var_info_ptr) kind_heap)
+		redirect_vars kind_info_ptr [] kind_heap
+			= kind_heap
+			
+		determine_var_bind _ (KI_VarBind kind_info_ptr) kind_heap
+			#! kind_info = sreadPtr kind_info_ptr kind_heap
+			= determine_var_bind kind_info_ptr  kind_info kind_heap
+		determine_var_bind kind_info_ptr kind_info kind_heap
+			= (kind_info_ptr, kind_heap)
+
+	nomalize_var :: !KindInfoPtr !KindInfo !(!Int,!*KindHeap) -> (!Int,!(!Int,!*KindHeap))
+	nomalize_var orig_kind_info (KI_VarBind kind_info_ptr) (kind_store, kind_heap)
+		#! kind_info = sreadPtr kind_info_ptr kind_heap
+		= nomalize_var kind_info_ptr kind_info (kind_store, kind_heap)
+	nomalize_var kind_info_ptr (KI_NormVar var_number) (kind_store, kind_heap)
+		= (var_number, (kind_store, kind_heap))
+	nomalize_var kind_info_ptr kind (kind_store, kind_heap)
+		= (kind_store, (inc kind_store, writePtr kind_info_ptr (KI_NormVar kind_store) kind_heap))
+	
+	normalize_top_vars top_vars kind_store kind_heap
+		= mapSt normalize_top_var top_vars (kind_store, kind_heap)
+	where
+		normalize_top_var :: !KindInfoPtr !(!Int,!*KindHeap) -> (!Int,!(!Int,!*KindHeap))
+		normalize_top_var kind_info_ptr (kind_store, kind_heap)
+			#! kind_info = sreadPtr kind_info_ptr kind_heap
+			= nomalize_var kind_info_ptr kind_info (kind_store, kind_heap)
+			
+//	update_type_group_info :: ![Index] ![[TypeKind]] !TypeProperties ![Int] ![Int] !Int !*KindHeap !*{# CheckedTypeDef} -> (!*KindHeap,!*{# CheckedTypeDef})
+	update_type_group_info [td:tds] [td_kinds : tds_kinds] type_properties top_vars group group_nr kind_store kind_heap td_infos
+		# (kind_store, kind_heap, td_infos) = update_type_def_info td td_kinds type_properties top_vars group group_nr kind_store kind_heap td_infos
+		= update_type_group_info tds tds_kinds type_properties top_vars group group_nr kind_store kind_heap td_infos
+	update_type_group_info [] [] type_properties top_vars group group_nr kind_store kind_heap td_infos
+		= (kind_heap, td_infos)
+
+//	update_type_def_info :: !Int ![TypeKind] !TypeProperties ![Int] ![Int] !Int !*KindHeap !*{# CheckedTypeDef} -> (!Int,!*KindHeap,!*{# CheckedTypeDef}) 
+	update_type_def_info {glob_module,glob_object} td_kinds type_properties top_vars group group_nr kind_store kind_heap td_infos
+		# (td_info=:{tdi_kinds}, td_infos) = td_infos![glob_module].[glob_object]
+		# (group_vars, cons_vars, kind_store, kind_heap) = determine_type_def_info tdi_kinds td_kinds top_vars kind_store kind_heap
+		= (kind_store, kind_heap, { td_infos & [glob_module].[glob_object] =
+				{td_info & tdi_properties = type_properties, tdi_kinds = td_kinds, tdi_group = group,
+				 tdi_group_vars = group_vars, tdi_cons_vars = cons_vars, tdi_group_nr = group_nr } })
+//					---> ("update_type_def_info", glob_module, glob_object, group_nr)
+	where
+		determine_type_def_info [ KindVar kind_info_ptr : kind_vars ] [ kind : kinds ] top_vars kind_store kind_heap
+			#! kind_info = sreadPtr kind_info_ptr kind_heap
+			# (var_number, (kind_store, kind_heap)) = nomalize_var kind_info_ptr kind_info (kind_store, kind_heap)
+			  (group_vars, cons_vars, kind_store, kind_heap) = determine_type_def_info kind_vars kinds top_vars kind_store kind_heap
+			= case kind of
+				KindArrow _
+					| is_a_top_var var_number top_vars
+						-> ([ var_number : group_vars ], [ encodeTopConsVar var_number : cons_vars ], kind_store, kind_heap)
+						-> ([ var_number : group_vars ], [ var_number : cons_vars ], kind_store, kind_heap)
+				_
+					-> ([ var_number : group_vars ], cons_vars, kind_store, kind_heap)
+		determine_type_def_info [] [] top_vars kind_store kind_heap
+			= ([], [], kind_store, kind_heap)
+				
+		is_a_top_var var_number [ top_var_number : top_var_numbers]
+			= var_number == top_var_number || is_a_top_var var_number top_var_numbers
+		is_a_top_var var_number []
+			= False
+
+
+analTypeDefs :: !{#CommonDefs} !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
+analTypeDefs modules heaps error
+//	#! modules = modules ---> "analTypeDefs"
+	# sizes = [ size mod.com_type_defs - size mod.com_class_defs \\ mod <-: modules ]
+
+	  check_marks		= { createArray nr_of_types AS_NotChecked \\ nr_of_types <- sizes }
+	  type_def_infos	= { createArray nr_of_types EmptyTypeDefInfo \\ nr_of_types <- sizes }
+
+	  as = {	as_check_marks = check_marks, as_kind_heap = newHeap, as_heaps = heaps, as_td_infos = type_def_infos,
+				as_next_num = 0, as_deps = [], as_next_group_num = 0, as_error = error }
+
+	  {as_td_infos,as_heaps,as_error} = anal_type_defs modules 0 sizes as
+	= (as_td_infos, as_heaps, as_error)
+where
+	anal_type_defs modules mod_index [ size : sizes ] as
+		# as = iFoldSt (anal_type_def modules mod_index) 0 size as
+		= anal_type_defs modules (inc mod_index) sizes as
+	anal_type_defs _ _ [] as
+		= as
+
+
+	anal_type_def modules mod_index type_index as=:{as_check_marks}
+		| as_check_marks.[mod_index].[type_index] == AS_NotChecked
+			# (_, (_, as)) = analTypeDef modules mod_index type_index as
+			= as
+			= as
+
+instance == AttributeVar
+where
+	(==) av1 av2 = av1.av_info_ptr == av2.av_info_ptr
+
+instance <<< DynamicType
+where
+	(<<<) file {dt_global_vars,dt_type} = file <<< dt_global_vars <<< dt_type
diff --git a/frontend/analunitypes.dcl b/frontend/analunitypes.dcl
new file mode 100644
index 0000000..8afc662
--- /dev/null
+++ b/frontend/analunitypes.dcl
@@ -0,0 +1,14 @@
+definition module analunitypes
+
+import StdEnv
+import syntax, checksupport
+
+typeProperties :: !Index  !Index ![SignClassification] ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
+	-> (!TypeSymbProperties, !*TypeVarHeap, !*TypeDefInfos)
+
+signClassification :: !Index  !Index  ![SignClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
+	-> (!SignClassification, !*TypeVarHeap, !*TypeDefInfos)
+
+propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
+	-> (!PropClassification, !*TypeVarHeap, !*TypeDefInfos)
+
diff --git a/frontend/analunitypes.icl b/frontend/analunitypes.icl
new file mode 100644
index 0000000..08cb748
--- /dev/null
+++ b/frontend/analunitypes.icl
@@ -0,0 +1,402 @@
+implementation module analunitypes
+
+import StdEnv
+import syntax, checksupport, analtypes, check, typesupport, checktypes, utilities
+	
+instance + SignClassification
+where
+	(+) {sc_pos_vect=sc_pos_vect1,sc_neg_vect=sc_neg_vect1} {sc_pos_vect=sc_pos_vect2,sc_neg_vect=sc_neg_vect2}
+		= {	sc_pos_vect = sc_pos_vect1 bitor sc_pos_vect2, sc_neg_vect = sc_neg_vect1 bitor sc_neg_vect2 }
+
+(*+)  infixl 7 :: !Sign !SignClassification -> SignClassification
+(*+) {pos_sign,neg_sign} {sc_pos_vect,sc_neg_vect}
+	= {	sc_pos_vect = (if pos_sign sc_pos_vect 0) bitor (if neg_sign sc_neg_vect 0),
+		sc_neg_vect = (if neg_sign sc_pos_vect 0) bitor (if pos_sign sc_neg_vect 0) }
+
+sign_class_to_sign :: !SignClassification !Int -> Sign
+sign_class_to_sign {sc_pos_vect,sc_neg_vect} index
+	= { pos_sign = sc_pos_vect bitand (1 << index) <> 0, neg_sign = sc_neg_vect bitand (1 << index) <> 0}
+
+set_sign_in_sign_class :: !Sign !Int !SignClassification -> SignClassification
+set_sign_in_sign_class {pos_sign,neg_sign} index {sc_pos_vect,sc_neg_vect}
+	= { sc_pos_vect = sc_pos_vect bitor (if pos_sign (1 << index) 0), sc_neg_vect = sc_neg_vect bitor (if neg_sign (1 << index) 0) }
+
+typeProperties :: !Index  !Index ![SignClassification] ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
+	-> (!TypeSymbProperties, !*TypeVarHeap, !*TypeDefInfos)
+typeProperties type_index module_index hio_signs hio_props defs type_var_heap td_infos
+	# {td_args} = defs.[module_index].com_type_defs.[type_index]
+	  (td_info, td_infos) = td_infos![module_index].[type_index]
+	  (tsp_sign, type_var_heap, td_infos) = determineSignClassOfTypeDef type_index module_index td_args td_info hio_signs defs type_var_heap td_infos
+	  (tsp_propagation, type_var_heap, td_infos) = determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos
+	  tsp_coercible = (td_info.tdi_properties bitand cIsNonCoercible) == 0
+	= ({tsp_sign = tsp_sign, tsp_propagation = tsp_propagation, tsp_coercible = tsp_coercible }, type_var_heap, td_infos)
+
+signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
+	-> (!SignClassification, !*TypeVarHeap, !*TypeDefInfos)
+signClassification type_index module_index hio_signs defs type_var_heap td_infos
+	# {td_args} = defs.[module_index].com_type_defs.[type_index]
+	  (td_info, td_infos) = td_infos![module_index].[type_index]
+	= determineSignClassOfTypeDef type_index module_index td_args td_info hio_signs defs type_var_heap td_infos
+
+removeTopClasses [cv : cvs] [tc : tcs] 
+	| isATopConsVar cv
+		= removeTopClasses cvs tcs
+		= [tc : removeTopClasses cvs tcs] 
+removeTopClasses _ _
+	= []
+
+determineSignClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![SignClassification] {# CommonDefs} !*TypeVarHeap !*TypeDefInfos
+	-> (!SignClassification, !*TypeVarHeap, !*TypeDefInfos)
+determineSignClassOfTypeDef type_index module_index td_args {tdi_classification,tdi_cons_vars,tdi_group_vars,tdi_group,tdi_group_nr}
+			hio_signs ci type_var_heap td_infos
+	# hio_signs = removeTopClasses tdi_cons_vars hio_signs
+	  result = retrieveSignClassification hio_signs tdi_classification
+	= case result of
+		Yes {ts_type_sign}
+			-> (ts_type_sign, type_var_heap, td_infos)
+		No
+			# type_var_heap = bind_type_vars_to_signs td_args tdi_group_vars tdi_cons_vars hio_signs type_var_heap
+			  (sign_class, type_var_heap, td_infos)
+			  		= newSignClassOfTypeDefGroup tdi_group_nr { glob_module = module_index, glob_object = type_index}
+						tdi_group hio_signs ci type_var_heap td_infos
+			-> (sign_class, foldSt restore_binds_of_type_var td_args type_var_heap, td_infos)
+
+where
+	bind_type_vars_to_signs [{atv_variable={tv_info_ptr}}: tvs] [gv : gvs] cons_vars hio_signs type_var_heap
+		# sign = determine_classification gv cons_vars hio_signs BottomSignClass
+		# (var_info, type_var_heap) = readPtr tv_info_ptr type_var_heap
+		= bind_type_vars_to_signs tvs gvs cons_vars hio_signs (type_var_heap <:= (tv_info_ptr, TVI_SignClass gv sign var_info))
+	bind_type_vars_to_signs [] group_vars cons_vars hio_signs type_var_heap
+		= type_var_heap
+
+	determine_classification gv [cv : cvs] hio_signs=:[tc : tcs] cumm_sign_class
+		| isATopConsVar cv
+			| gv == decodeTopConsVar cv
+				= TopSignClass
+				= determine_classification gv cvs tcs cumm_sign_class
+		| gv == cv
+			= determine_classification gv cvs tcs (tc + cumm_sign_class)
+			= determine_classification gv cvs tcs cumm_sign_class
+	determine_classification gv cons_vars [] cumm_sign_class
+		= cumm_sign_class
+
+	restore_binds_of_type_var {atv_variable={tv_info_ptr}} type_var_heap
+		# (TVI_SignClass _ _ old_info, type_var_heap) = readPtr tv_info_ptr type_var_heap
+		= type_var_heap <:= (tv_info_ptr, old_info)
+
+newSignClassOfTypeDefGroup :: !Int !(Global Int) ![Global Int] ![SignClassification] !{#CommonDefs} !*TypeVarHeap !*TypeDefInfos
+			-> *(!SignClassification,!*TypeVarHeap,!*TypeDefInfos)
+newSignClassOfTypeDefGroup group_nr this_type group hio_signs ci type_var_heap td_infos
+	# (cumm_sign_env, type_var_heap, td_infos) = collect_sign_class_of_type_defs group_nr group ci BottomSignClass type_var_heap td_infos 
+	  (sign_class, td_infos) = update_sign_class_of_group this_type group cumm_sign_env hio_signs td_infos
+	= (sign_class, type_var_heap, td_infos)
+where
+	update_sign_class_of_group my_index [] cumm_sign_env hio_signs td_infos
+		= (BottomSignClass, td_infos)
+	update_sign_class_of_group my_index [{glob_module,glob_object} : group] cumm_sign_env hio_signs td_infos
+		# (tdi=:{tdi_classification, tdi_group_vars},td_infos) = td_infos![glob_module].[glob_object]
+		  sign_class = determine_sign_class tdi_group_vars cumm_sign_env BottomSignClass 0
+		  tdi_classification = addSignClassification hio_signs sign_class tdi_classification
+		  td_infos = { td_infos & [glob_module].[glob_object] = { tdi & tdi_classification = tdi_classification }}
+		  (my_sign_class, td_infos) = update_sign_class_of_group my_index group cumm_sign_env hio_signs td_infos
+		= (if (my_index.glob_module == glob_module &&  my_index.glob_object == glob_object) sign_class my_sign_class, td_infos)
+
+	determine_sign_class [gv : gvs] cumm_sign_env sign_class var_index
+		# sign_class = set_sign_in_sign_class (sign_class_to_sign cumm_sign_env gv) var_index sign_class
+		= determine_sign_class gvs cumm_sign_env sign_class (inc var_index)
+	determine_sign_class [] cumm_sign_env sign_class var_index
+		= sign_class
+
+	collect_sign_class_of_type_defs group_nr [] ci cumm_sign_env type_var_heap td_infos
+		= (cumm_sign_env, type_var_heap, td_infos)
+	collect_sign_class_of_type_defs group_nr [{glob_module,glob_object} : group] ci cumm_sign_env type_var_heap td_infos 
+		# {td_rhs} = ci.[glob_module].com_type_defs.[glob_object]
+		# (cumm_sign_env, type_var_heap, td_infos) = sign_class_of_type_def glob_module td_rhs group_nr ci cumm_sign_env type_var_heap td_infos
+		= collect_sign_class_of_type_defs group_nr group ci cumm_sign_env type_var_heap td_infos
+
+	sign_class_of_type_def :: !Int !TypeRhs !Int !{#CommonDefs} !SignClassification !*TypeVarHeap *TypeDefInfos
+		-> (!SignClassification,!*TypeVarHeap,!*TypeDefInfos)
+	sign_class_of_type_def module_index (AlgType conses) group_nr ci cumm_sign_env type_var_heap td_infos
+		= sign_class_of_type_conses module_index conses group_nr ci cumm_sign_env type_var_heap td_infos
+	sign_class_of_type_def _ (SynType {at_type}) group_nr ci cumm_sign_env type_var_heap td_infos
+		# (sign_class, _, type_var_heap, td_infos) = signClassOfType at_type group_nr ci type_var_heap td_infos
+		= (cumm_sign_env + sign_class, type_var_heap, td_infos)
+	sign_class_of_type_def module_index (RecordType {rt_constructor}) group_nr ci cumm_sign_env type_var_heap td_infos
+		= sign_class_of_type_conses module_index [rt_constructor] group_nr ci cumm_sign_env type_var_heap td_infos
+	sign_class_of_type_def _ (AbstractType properties) _ _ _ type_var_heap td_infos
+		| properties bitand cIsNonCoercible == 0
+			= (PosSignClass, type_var_heap, td_infos)
+			= (TopSignClass, type_var_heap, td_infos)
+
+	sign_class_of_type_conses module_index [{ds_index}:conses] group_nr ci cumm_sign_class type_var_heap td_infos
+		#! cons_def = ci.[module_index].com_cons_defs.[ds_index]
+		#  (cumm_sign_class, type_var_heap, td_infos) = sign_class_of_type_of_list cons_def.cons_type.st_args group_nr ci cumm_sign_class type_var_heap td_infos
+		= sign_class_of_type_conses module_index conses group_nr ci cumm_sign_class type_var_heap td_infos
+	sign_class_of_type_conses module_index [] _ _ cumm_sign_class type_var_heap td_infos
+		= (cumm_sign_class, type_var_heap, td_infos)
+
+	sign_class_of_type_of_list [{at_type} : types] group_nr ci cumm_sign_class type_var_heap td_infos
+		# (sign_class, _, type_var_heap, td_infos) = signClassOfType at_type group_nr ci type_var_heap td_infos
+		= sign_class_of_type_of_list types group_nr ci (cumm_sign_class + sign_class) type_var_heap td_infos
+	sign_class_of_type_of_list [] _ _ cumm_sign_class type_var_heap td_infos
+		= (cumm_sign_class, type_var_heap, td_infos)
+
+IsAHioType		:== True
+IsNotAHioType	:== False
+
+IsArrowKind (KindArrow _) = True
+IsArrowKind _ = False
+
+signClassOfTypeVariable :: !TypeVar !{#CommonDefs} !*TypeVarHeap !*TypeDefInfos
+	-> *(!SignClassification,!SignClassification,!*TypeVarHeap,!*TypeDefInfos);
+signClassOfTypeVariable {tv_info_ptr} ci type_var_heap td_infos
+	#! var_info = sreadPtr tv_info_ptr type_var_heap
+	= case var_info of
+		TVI_SignClass group_var_index var_class _ 
+			-> (var_index_to_sign_class group_var_index, var_class, type_var_heap, td_infos)
+		_
+			-> (BottomSignClass, TopSignClass, type_var_heap, td_infos)
+where
+	var_index_to_sign_class :: !Int -> SignClassification
+	var_index_to_sign_class var_index 
+		= { sc_pos_vect = 1 << var_index, sc_neg_vect = 0}
+
+
+signClassOfType :: !Type !Int !{#CommonDefs} !*TypeVarHeap !*TypeDefInfos -> *(!SignClassification,!SignClassification,!*TypeVarHeap,!*TypeDefInfos);
+signClassOfType (TV tv) _ ci type_var_heap td_infos
+	= signClassOfTypeVariable tv ci type_var_heap td_infos
+
+signClassOfType (TA {type_index = {glob_module, glob_object}} types) group_nr ci type_var_heap td_infos
+	# ({tdi_group_nr,tdi_kinds}, td_infos) = td_infos![glob_module].[glob_object]
+	| tdi_group_nr == group_nr
+		= sign_class_of_type_list_of_rec_type types BottomSignClass ci type_var_heap td_infos 
+		# {td_args,td_arity} = ci.[glob_module].com_type_defs.[glob_object]
+		  (td_info, td_infos) = td_infos![glob_module].[glob_object]
+		  (sign_classes, hio_signs, type_var_heap, td_infos) = collect_sign_classes_of_type_list types tdi_kinds ci type_var_heap td_infos 
+		  (type_class, type_var_heap, td_infos) = determineSignClassOfTypeDef glob_object glob_module td_args td_info hio_signs ci type_var_heap td_infos
+		  sign_class = determine_cummulative_sign sign_classes type_class 0 BottomSignClass
+		= (sign_class, adjust_sign_class type_class td_arity, type_var_heap, td_infos)
+where
+
+	sign_class_of_type_list_of_rec_type [t : ts] cumm_sign_class ci type_var_heap td_infos
+		# (sign_class, type_class, type_var_heap, td_infos) = signClassOfType t.at_type group_nr ci type_var_heap td_infos
+		  cumm_sign_class = { cumm_sign_class & sc_neg_vect = cumm_sign_class.sc_neg_vect bitor sign_class.sc_neg_vect }
+		= sign_class_of_type_list_of_rec_type ts cumm_sign_class ci type_var_heap td_infos
+	sign_class_of_type_list_of_rec_type [] cumm_sign_class ci type_var_heap td_infos
+		= (cumm_sign_class, TopSignClass, type_var_heap, td_infos)
+
+	collect_sign_classes_of_type_list [t : ts] [tk : tks] ci type_var_heap td_infos
+		# (sign_class, type_class, type_var_heap, td_infos) = signClassOfType t.at_type group_nr ci type_var_heap td_infos
+		  (sign_classes, hio_signs, type_var_heap, td_infos) = collect_sign_classes_of_type_list ts tks ci type_var_heap td_infos
+		  sign_classes = [sign_class : sign_classes]
+		| IsArrowKind tk
+			= (sign_classes, [type_class:hio_signs], type_var_heap, td_infos)
+			= (sign_classes, hio_signs, type_var_heap, td_infos)
+	collect_sign_classes_of_type_list [] _ ci type_var_heap td_infos
+		= ([], [], type_var_heap, td_infos)
+
+	determine_cummulative_sign [sc : scs] sign_class type_index cumm_class
+		# cumm_class = sign_class_to_sign sign_class type_index *+ sc + cumm_class
+		= determine_cummulative_sign scs sign_class (inc type_index) cumm_class
+	determine_cummulative_sign [] _ _ cumm_class
+		= cumm_class
+	
+	adjust_sign_class {sc_pos_vect,sc_neg_vect} arity
+		= { sc_pos_vect = sc_pos_vect >> arity, sc_neg_vect = sc_neg_vect >> arity }
+
+signClassOfType (CV tv :@: types) group_nr ci type_var_heap td_infos
+	# (sign_class, type_class, type_var_heap, td_infos) = signClassOfTypeVariable tv ci type_var_heap td_infos
+	  (sign_class, type_var_heap, td_infos) = sign_class_of_type_list types group_nr type_class 0 sign_class ci type_var_heap td_infos
+	= (sign_class, BottomSignClass, type_var_heap, td_infos)
+where	  	
+	sign_class_of_type_list [{at_type} : ts] group_nr cv_sign_class type_index cumm_class ci type_var_heap td_infos
+		# (sign_class, _, type_var_heap, td_infos) = signClassOfType at_type group_nr ci type_var_heap td_infos
+		  cumm_class = (sign_class_to_sign cv_sign_class type_index *+ sign_class) + cumm_class
+		= sign_class_of_type_list ts group_nr sign_class (inc type_index) cumm_class ci type_var_heap td_infos
+	sign_class_of_type_list [] _ _ _ cumm_class ci type_var_heap td_infos
+		= (cumm_class, type_var_heap, td_infos)
+
+signClassOfType (arg_type --> res_type) group_nr ci type_var_heap td_infos
+	# (arg_class, _, type_var_heap, td_infos) = signClassOfType arg_type.at_type group_nr ci type_var_heap td_infos
+	  (res_class, _, type_var_heap, td_infos) = signClassOfType res_type.at_type group_nr ci type_var_heap td_infos
+	= (NegativeSign *+ arg_class + PositiveSign *+ res_class, BottomSignClass, type_var_heap, td_infos)
+
+signClassOfType type _ _ type_var_heap td_infos
+	= (BottomSignClass, BottomSignClass, type_var_heap, td_infos)
+
+propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
+	-> (!PropClassification, !*TypeVarHeap, !*TypeDefInfos)
+propClassification type_index module_index hio_props defs type_var_heap td_infos
+	# {td_args, td_name} = defs.[module_index].com_type_defs.[type_index]
+	  (td_info, td_infos) = td_infos![module_index].[type_index]
+	= determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos
+
+determinePropClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![PropClassification] {# CommonDefs} !*TypeVarHeap !*TypeDefInfos
+	-> (!PropClassification,!*TypeVarHeap, !*TypeDefInfos)
+determinePropClassOfTypeDef type_index module_index td_args {tdi_classification, tdi_kinds, tdi_group, tdi_group_vars, tdi_cons_vars, tdi_group_nr}
+			hio_props ci type_var_heap td_infos
+	# hio_props = removeTopClasses tdi_cons_vars hio_props
+	  result = retrievePropClassification hio_props tdi_classification
+					// ---> (td_args, tdi_kinds, tdi_group_vars)
+	= case result of
+		Yes {ts_type_prop}
+			-> (ts_type_prop, type_var_heap, td_infos)
+		No
+			# type_var_heap = bind_type_vars_to_props td_args tdi_group_vars tdi_cons_vars hio_props type_var_heap
+			  (ts_type_prop, type_var_heap, td_infos) = newPropClassOfTypeDefGroup type_index module_index tdi_group hio_props
+			  		tdi_group_nr ci type_var_heap td_infos
+			-> (ts_type_prop, foldSt restore_binds_of_type_var td_args type_var_heap, td_infos)
+//					---> ("determinePropClassOfTypeDef", ci.[module_index].com_type_defs.[type_index].td_name, ts_type_prop)
+where
+	bind_type_vars_to_props [{atv_variable={tv_info_ptr}} : tvs] [gv : gvs] cons_vars hio_props type_var_heap
+		#! old_info = sreadPtr tv_info_ptr type_var_heap
+		# sign = determine_classification gv cons_vars hio_props NoPropClass
+		= bind_type_vars_to_props tvs gvs cons_vars hio_props (writePtr tv_info_ptr (TVI_PropClass gv sign old_info) type_var_heap)
+	bind_type_vars_to_props [] group_vars cons_vars hio_props type_var_heap
+		= type_var_heap
+
+	determine_classification gv [cv : cvs] hio_props=:[tc : tcs] cumm_prop_class
+		| isATopConsVar cv
+			| gv == decodeTopConsVar cv
+				= PropClass
+				= determine_classification gv cvs tcs cumm_prop_class
+		| gv == cv
+			= determine_classification gv cvs tcs (tc bitor cumm_prop_class)
+			= determine_classification gv cvs tcs cumm_prop_class
+	determine_classification gv cons_vars [] cumm_prop_class
+		= cumm_prop_class
+
+	restore_binds_of_type_var {atv_variable={tv_info_ptr}} type_var_heap
+		# (TVI_PropClass _ _ old_info, type_var_heap) = readPtr tv_info_ptr type_var_heap
+		= type_var_heap <:= (tv_info_ptr, old_info)
+
+newPropClassOfTypeDefGroup :: !Int !Int ![Global Int] ![PropClassification] !Int !{#CommonDefs} !*TypeVarHeap !*TypeDefInfos
+			-> *(!PropClassification, !*TypeVarHeap, !*TypeDefInfos)
+newPropClassOfTypeDefGroup type_index module_index group hio_props group_nr ci type_var_heap td_infos
+	# (cumm_prop_env, type_var_heap, td_infos) = collect_prop_class_of_type_defs group group_nr ci NoPropClass type_var_heap td_infos 
+	  (prop_class, td_infos) = update_prop_class_of_group type_index module_index group cumm_prop_env hio_props ci td_infos
+//			 ---> ("newPropClassOfTypeDefGroup", (type_index, module_index), cumm_prop_env)
+	= (prop_class, type_var_heap, td_infos)
+where
+	update_prop_class_of_group my_index module_index [] cumm_prop_env hio_props ci td_infos
+		= (NoPropClass, td_infos)
+	update_prop_class_of_group my_index module_index [{glob_module,glob_object} : group] cumm_prop_env hio_props ci td_infos
+		# (tdi=:{tdi_group_vars,tdi_classification},td_infos) = td_infos![glob_module].[glob_object]
+		  prop_class = determine_prop_class tdi_group_vars cumm_prop_env NoPropClass 0
+		  tdi_classification = addPropClassification hio_props prop_class tdi_classification
+		  td_infos = { td_infos & [glob_module].[glob_object] = { tdi & tdi_classification = tdi_classification }}
+		  (my_prop_class, td_infos) = update_prop_class_of_group my_index module_index group cumm_prop_env hio_props ci td_infos
+		| glob_module == module_index && my_index == glob_object
+//			 ---> ("update_prop_class_of_group", (my_index, module_index), (glob_object, glob_module), prop_class)
+			= (prop_class, td_infos)
+			= (my_prop_class, td_infos)
+
+	determine_prop_class [gv : gvs] cumm_prop_env prop_class var_index
+		| IsPropagating cumm_prop_env gv
+			= determine_prop_class gvs cumm_prop_env (prop_class bitor (IndexToPropClass var_index)) (inc var_index)
+			= determine_prop_class gvs cumm_prop_env prop_class (inc var_index)
+	determine_prop_class [] cumm_prop_env prop_class var_index
+		= prop_class
+
+	collect_prop_class_of_type_defs [] group_nr ci cumm_prop_env type_var_heap td_infos
+		= (cumm_prop_env, type_var_heap, td_infos)
+	collect_prop_class_of_type_defs [{glob_module,glob_object} : group] group_nr ci cumm_prop_env type_var_heap td_infos 
+		# {td_rhs} = ci.[glob_module].com_type_defs.[glob_object]
+		# (cumm_prop_env, type_var_heap, td_infos) = prop_class_of_type_def glob_module td_rhs group_nr ci cumm_prop_env type_var_heap td_infos
+		= collect_prop_class_of_type_defs group group_nr ci cumm_prop_env type_var_heap td_infos
+
+	prop_class_of_type_def :: !Int !TypeRhs !Int !{#CommonDefs} !PropClassification !*TypeVarHeap *TypeDefInfos
+		-> (!PropClassification, !*TypeVarHeap, !*TypeDefInfos)
+	prop_class_of_type_def module_index (AlgType conses) group_nr ci cumm_prop_env type_var_heap td_infos
+		= prop_class_of_type_conses module_index conses group_nr ci cumm_prop_env type_var_heap td_infos
+	prop_class_of_type_def module_index (SynType {at_type}) group_nr ci cumm_prop_env type_var_heap td_infos
+		# (prop_class, _, type_var_heap, td_infos) = propClassOfType at_type group_nr ci type_var_heap td_infos
+		= (cumm_prop_env bitor prop_class, type_var_heap, td_infos)
+	prop_class_of_type_def module_index (RecordType {rt_constructor}) group_nr ci cumm_prop_env type_var_heap td_infos
+		= prop_class_of_type_conses module_index [rt_constructor] group_nr ci cumm_prop_env type_var_heap td_infos
+	prop_class_of_type_def module_index (AbstractType _) _ _ _ type_var_heap td_infos
+		= (PropClass, type_var_heap, td_infos)
+
+	prop_class_of_type_conses module_index [{ds_index}:conses] group_nr ci cumm_prop_class type_var_heap td_infos
+		#! cons_def = ci.[module_index].com_cons_defs.[ds_index]
+		#  (cumm_prop_class, type_var_heap, td_infos) = prop_class_of_type_of_list cons_def.cons_type.st_args group_nr ci cumm_prop_class type_var_heap td_infos
+		= prop_class_of_type_conses module_index conses group_nr ci cumm_prop_class type_var_heap td_infos
+	prop_class_of_type_conses module_index [] _ _ cumm_prop_class type_var_heap td_infos
+		= (cumm_prop_class, type_var_heap, td_infos)
+
+	prop_class_of_type_of_list [{at_type} : types] group_nr ci cumm_prop_class type_var_heap td_infos
+		# (prop_class, _, type_var_heap, td_infos) = propClassOfType at_type group_nr ci type_var_heap td_infos
+		= prop_class_of_type_of_list types group_nr ci (cumm_prop_class bitor prop_class) type_var_heap td_infos
+	prop_class_of_type_of_list [] _ _ cumm_prop_class type_var_heap td_infos
+		= (cumm_prop_class, type_var_heap, td_infos)
+
+
+IndexToPropClass index :== 1 << index
+IsPropagating prop_class_of_type type_index :== prop_class_of_type == (prop_class_of_type bitor IndexToPropClass type_index)
+AdjustPropClass prop_class arity :== prop_class >> arity
+
+
+propClassOfTypeVariable :: !TypeVar !{#CommonDefs} !*TypeVarHeap !*TypeDefInfos
+	-> *(!PropClassification,!PropClassification, !*TypeVarHeap, !*TypeDefInfos)
+propClassOfTypeVariable {tv_info_ptr} ci type_var_heap td_infos
+	#! var_info = sreadPtr tv_info_ptr type_var_heap
+	= case var_info of
+		TVI_PropClass group_var_index var_class _
+			-> (IndexToPropClass group_var_index, var_class, type_var_heap, td_infos)
+		_
+			-> (NoPropClass, PropClass, type_var_heap, td_infos)
+
+propClassOfType :: !Type !Int !{#CommonDefs} !*TypeVarHeap !*TypeDefInfos -> *(!PropClassification,!PropClassification, !*TypeVarHeap, !*TypeDefInfos)
+propClassOfType (TV tv) _ ci type_var_heap td_infos
+	= propClassOfTypeVariable tv ci type_var_heap td_infos
+
+propClassOfType (TA {type_name,type_index = {glob_module, glob_object}} types) group_nr ci type_var_heap td_infos
+	# ({tdi_group_nr,tdi_kinds}, td_infos) = td_infos![glob_module].[glob_object]
+	| tdi_group_nr == group_nr
+		= (NoPropClass, PropClass, type_var_heap, td_infos )
+		# {td_args,td_arity} = ci.[glob_module].com_type_defs.[glob_object]
+		  (td_info, td_infos) = td_infos![glob_module].[glob_object]
+		  (prop_classes, hio_signs, type_var_heap, td_infos) = collect_prop_classes_of_hio_types types tdi_kinds group_nr ci type_var_heap td_infos 
+		  (type_class, type_var_heap, td_infos) = determinePropClassOfTypeDef glob_object glob_module td_args td_info hio_signs ci type_var_heap td_infos
+		  (prop_class, type_var_heap, td_infos) = prop_classes_of_type_list types tdi_kinds prop_classes type_class 0 group_nr ci NoPropClass type_var_heap td_infos
+		= (prop_class, AdjustPropClass type_class td_arity, type_var_heap, td_infos)
+//			---> ("propClassOfType (TA ...)", type_name, prop_class)
+
+where
+	collect_prop_classes_of_hio_types [{at_type} : types] [ KindArrow _ : tks ] group_nr ci type_var_heap td_infos
+		 # (prop_class, type_class, type_var_heap, td_infos) = propClassOfType at_type group_nr ci type_var_heap td_infos
+		   (prop_classes, hio_signs, type_var_heap, td_infos) = collect_prop_classes_of_hio_types types tks group_nr ci type_var_heap td_infos
+		 = ([prop_class : prop_classes], [type_class : hio_signs], type_var_heap, td_infos)
+	collect_prop_classes_of_hio_types [_ : types] [ _ : tks ] _ _ type_var_heap td_infos
+		= ([], [], type_var_heap, td_infos)
+	collect_prop_classes_of_hio_types [] _ _ _ type_var_heap td_infos
+		= ([], [], type_var_heap, td_infos)
+	
+	prop_classes_of_type_list [ _ : types ] [ KindArrow _ : tks] [pc : pcs] prop_class_of_type type_index group_nr ci cumm_class type_var_heap td_infos
+		| IsPropagating prop_class_of_type type_index 
+			= prop_classes_of_type_list types tks pcs prop_class_of_type (inc type_index) group_nr ci (cumm_class bitor pc) type_var_heap td_infos
+			= prop_classes_of_type_list types tks pcs prop_class_of_type (inc type_index) group_nr ci cumm_class type_var_heap td_infos
+	prop_classes_of_type_list [ {at_type} : types] [ _ : tks] pcs prop_class_of_type type_index group_nr ci cumm_class type_var_heap td_infos
+		| IsPropagating prop_class_of_type type_index 
+			# (pc, _, type_var_heap, td_infos) = propClassOfType at_type group_nr ci type_var_heap td_infos
+			= prop_classes_of_type_list types tks pcs prop_class_of_type (inc type_index) group_nr ci (cumm_class bitor pc) type_var_heap td_infos
+			= prop_classes_of_type_list types tks pcs prop_class_of_type (inc type_index) group_nr ci cumm_class type_var_heap td_infos
+	prop_classes_of_type_list [] [] _ _ _ _ _ cumm_class type_var_heap td_infos
+		= (cumm_class, type_var_heap, td_infos)
+
+propClassOfType (CV tv :@: types) group_nr ci type_var_heap td_infos
+	# (prop_class, type_class, type_var_heap, td_infos) = propClassOfTypeVariable tv ci type_var_heap td_infos
+	  (prop_class, type_var_heap, td_infos) = prop_class_of_type_list types type_class 0 group_nr ci prop_class type_var_heap td_infos
+	= (prop_class, NoPropClass, type_var_heap, td_infos)
+where	  	
+	prop_class_of_type_list [{at_type} : types] cv_prop_class type_index group_nr ci cumm_class type_var_heap td_infos
+		| IsPropagating cv_prop_class type_index 
+			# (pc, _, type_var_heap, td_infos) = propClassOfType at_type group_nr ci type_var_heap td_infos
+			= prop_class_of_type_list types cv_prop_class (inc type_index) group_nr ci (cumm_class bitor pc) type_var_heap td_infos
+			= prop_class_of_type_list types cv_prop_class (inc type_index) group_nr ci cumm_class type_var_heap td_infos
+	prop_class_of_type_list [] _ _ _ _ cumm_class type_var_heap td_infos
+		= (cumm_class, type_var_heap, td_infos)
+
+propClassOfType _ _ _ type_var_heap td_infos
+	= (NoPropClass, NoPropClass, type_var_heap, td_infos)
+
diff --git a/frontend/cheat.dcl b/frontend/cheat.dcl
new file mode 100644
index 0000000..9ec0617
--- /dev/null
+++ b/frontend/cheat.dcl
@@ -0,0 +1,3 @@
+system module cheat
+
+i :: !b -> a
diff --git a/frontend/cheat.icl b/frontend/cheat.icl
new file mode 100644
index 0000000..776f323
--- /dev/null
+++ b/frontend/cheat.icl
@@ -0,0 +1,10 @@
+implementation module cheat
+
+i :: !a -> b
+i x =
+	code
+	{	.inline i
+			no_op
+		.end
+	}
+
diff --git a/frontend/check.dcl b/frontend/check.dcl
new file mode 100644
index 0000000..c91ac95
--- /dev/null
+++ b/frontend/check.dcl
@@ -0,0 +1,20 @@
+definition module check
+
+import syntax, transform, checksupport, typesupport, predef
+
+//MOVE
+//cIclModIndex 			:== 0
+cPredefinedModuleIndex 		:== 1
+
+checkModule :: !ScannedModule !Int ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File
+	-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
+
+retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index)
+
+newFreeVariable :: !FreeVar ![FreeVar] ->(!Bool, ![FreeVar])
+
+convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index
+
+determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps -> (!SymbolType, !Specials, !*TypeHeaps)
+
+
diff --git a/frontend/check.icl b/frontend/check.icl
new file mode 100644
index 0000000..06d4f34
--- /dev/null
+++ b/frontend/check.icl
@@ -0,0 +1,3037 @@
+implementation module check
+
+import StdEnv
+
+import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, RWSDebug
+
+import explicitimports
+
+// MW moved cIclModIndex 			:== 0
+cPredefinedModuleIndex 	:== 1
+
+convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index
+convertIndex index table_index (Yes tables)
+	= tables.[table_index].[index]
+convertIndex index table_index No
+	= index
+	
+getPredefinedGlobalSymbol symb_index module_index req_ste_kind arity cs=:{cs_predef_symbols,cs_symbol_table}
+	#! pre_def_mod		= cs_predef_symbols.[module_index]
+	#  mod_id			= pre_def_mod.pds_ident
+	#! mod_entry		= sreadPtr mod_id.id_info cs_symbol_table
+	| mod_entry.ste_kind == STE_ClosedModule
+		# (glob_object, cs) = get_predefined_symbol symb_index req_ste_kind arity mod_entry.ste_index cs
+		= ({ glob_object = glob_object, glob_module = mod_entry.ste_index }, cs)
+		= ({ glob_object = { ds_ident = { id_name = "** ERRONEOUS **", id_info = nilPtr }, ds_index = NoIndex, ds_arity = arity }, glob_module = NoIndex},
+				  		{ cs & cs_error = checkError mod_id "not imported" cs.cs_error})
+where
+	get_predefined_symbol symb_index req_ste_kind arity mod_index cs=:{cs_predef_symbols,cs_symbol_table,cs_error}
+		#! pre_def_symb	= cs_predef_symbols.[symb_index]
+		# symb_id		= pre_def_symb.pds_ident
+		#! symb_entry 	= sreadPtr symb_id.id_info cs_symbol_table
+		| symb_entry.ste_kind == req_ste_kind
+			= ({ ds_ident = symb_id, ds_index = symb_entry.ste_index, ds_arity = arity }, cs)
+			= case symb_entry.ste_kind of
+				STE_Imported kind module_index
+					| mod_index == module_index && kind == req_ste_kind
+						-> ({ ds_ident = symb_id, ds_index = symb_entry.ste_index, ds_arity = arity }, cs)
+				_
+					-> ({ ds_ident = symb_id, ds_index = NoIndex, ds_arity = arity }, { cs & cs_error = checkError symb_id "undefined" cs.cs_error })
+		
+checkTypeClasses :: !Index !Index !Int !*{#ClassDef} !*{#MemberDef} !*{#CheckedTypeDef} !*{#DclModule} !*TypeHeaps !*CheckState
+	-> (!*{#ClassDef}, !*{#MemberDef}, !*{#CheckedTypeDef}, !*{#DclModule}, !*TypeHeaps, !*CheckState)
+checkTypeClasses class_index module_index upper_limit class_defs member_defs type_defs modules type_heaps=:{th_vars} cs=:{cs_symbol_table,cs_error}
+	| class_index == size class_defs
+		= (class_defs, member_defs, type_defs, modules, type_heaps, cs)
+		#! class_def = class_defs.[class_index]
+		# {class_name,class_pos,class_args,class_context,class_members} = class_def
+		  position = newPosition class_name class_pos
+		  cs_error = setErrorAdmin position cs_error
+		  (rev_class_args, cs_symbol_table, th_vars, cs_error)
+		  		= add_variables_to_symbol_table cGlobalScope class_args [] cs_symbol_table th_vars cs_error
+		  cs = {cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }
+		  (class_context, type_defs, class_defs, modules, type_heaps, cs)
+		  		= checkTypeContexts class_context module_index type_defs class_defs modules { type_heaps & th_vars = th_vars } cs
+		  (class_args, cs_symbol_table) = retrieve_variables_from_symbol_table rev_class_args [] cs.cs_symbol_table
+		  class_defs = { class_defs & [class_index] = { class_def & class_context = class_context, class_args = class_args }}
+		  member_defs = set_classes_in_member_defs 0 class_members {glob_object = class_index, glob_module = module_index} member_defs 
+// MW was			= checkTypeClasses (inc class_index) module_index class_defs member_defs type_defs modules type_heaps { cs & cs_symbol_table = cs_symbol_table }
+		= checkTypeClasses (inc class_index) module_index upper_limit class_defs member_defs type_defs modules type_heaps { cs & cs_symbol_table = cs_symbol_table }
+where
+	add_variables_to_symbol_table :: !Level ![TypeVar] ![TypeVar] !*SymbolTable !*TypeVarHeap !*ErrorAdmin
+		-> (![TypeVar],!*SymbolTable,!*TypeVarHeap,!*ErrorAdmin)
+	add_variables_to_symbol_table level [] rev_class_args symbol_table th_vars error
+		= (rev_class_args, symbol_table, th_vars, error)
+	add_variables_to_symbol_table level [var=:{tv_name={id_name,id_info}} : vars] rev_class_args symbol_table th_vars error
+	  	#! entry = sreadPtr id_info symbol_table
+		| entry.ste_kind == STE_Empty || entry.ste_def_level < level
+			# (new_var_ptr, th_vars) = newPtr TVI_Empty th_vars
+			# symbol_table = NewEntry symbol_table id_info (STE_TypeVariable new_var_ptr) NoIndex level entry
+			= add_variables_to_symbol_table level vars [{ var & tv_info_ptr = new_var_ptr} : rev_class_args] symbol_table th_vars error
+			= add_variables_to_symbol_table level  vars rev_class_args symbol_table th_vars (checkError id_name "(variable) already defined" error)
+
+	retrieve_variables_from_symbol_table [var=:{tv_name={id_name,id_info}} : vars] class_args symbol_table
+		#! entry = sreadPtr id_info symbol_table
+		= retrieve_variables_from_symbol_table vars [var : class_args] (symbol_table <:= (id_info,entry.ste_previous))
+	retrieve_variables_from_symbol_table [] class_args symbol_table
+		= (class_args, symbol_table)
+	
+	set_classes_in_member_defs mem_offset class_members glob_class_index member_defs
+		| mem_offset == size class_members
+			= member_defs
+			# {ds_index} = class_members.[mem_offset]
+			#! member_def = member_defs.[ds_index]
+			= set_classes_in_member_defs (inc mem_offset) class_members glob_class_index { member_defs & [ds_index] = { member_def & me_class = glob_class_index }}
+
+	
+checkSpecial :: !Index !FunType !Index !SpecialSubstitution (!Index, ![FunType], !*Heaps, !*ErrorAdmin)
+	-> (!Special, (!Index, ![FunType], !*Heaps, !*ErrorAdmin))
+checkSpecial mod_index fun_type=:{ft_type} fun_index subst (next_inst_index, special_types, heaps, error)
+	# (special_type, hp_type_heaps) = substitute_type ft_type subst heaps.hp_type_heaps
+	  (spec_types, error) = checkAndCollectTypesOfContexts special_type.st_context error
+	  ft_type = { special_type & st_context = [] }
+	  (new_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap
+	= ( { spec_index = { glob_module = mod_index, glob_object = next_inst_index }, spec_types = spec_types, spec_vars = subst.ss_vars, spec_attrs = subst.ss_attrs },
+			((inc next_inst_index), [{ fun_type & ft_type = ft_type, ft_specials = SP_FunIndex fun_index, ft_type_ptr = new_info_ptr} : special_types ],
+					{ heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap }, error))
+where	
+	substitute_type st=:{st_vars,st_attr_vars,st_args,st_result,st_context,st_attr_env} environment type_heaps
+		# (st_vars, st_attr_vars, [st_result : st_args], st_context, st_attr_env, _, type_heaps)
+			= instantiateTypes st_vars st_attr_vars [ st_result : st_args ] st_context st_attr_env environment [] type_heaps
+		= ({st & st_vars = st_vars, st_args = st_args, st_result = st_result, st_attr_vars = st_attr_vars,
+			st_context = st_context, st_attr_env = st_attr_env }, type_heaps)
+
+checkDclFunctions :: !Index !Index ![FunType] !v:{#CheckedTypeDef} !x:{#ClassDef} !u:{#.DclModule} !*Heaps !*CheckState
+	-> (!Index, ![FunType], ![FunType], !z:{#CheckedTypeDef}, !y:{#ClassDef}, !w:{#DclModule}, !.Heaps, !.CheckState), [u v <= w, x <= y, u v <= z]
+checkDclFunctions module_index first_inst_index fun_types type_defs class_defs modules heaps cs
+	= check_dcl_functions module_index fun_types 0 first_inst_index [] [] type_defs class_defs modules heaps cs
+where
+	check_dcl_functions module_index [] fun_index next_inst_index collected_funtypes collected_instances type_defs class_defs modules heaps cs
+		= (next_inst_index, collected_funtypes, collected_instances, type_defs, class_defs, modules, heaps, cs)
+	check_dcl_functions module_index [fun_type=:{ft_symb,ft_type,ft_pos,ft_specials} : fun_types] fun_index
+			next_inst_index collected_funtypes collected_instances type_defs class_defs modules heaps cs
+		# position = newPosition ft_symb ft_pos
+		  cs = { cs & cs_error = setErrorAdmin position cs.cs_error }
+		  (ft_type, ft_specials, type_defs,  class_defs, modules, hp_type_heaps, cs)
+		  		= checkSymbolType module_index ft_type ft_specials type_defs class_defs modules heaps.hp_type_heaps cs
+		  (spec_types, next_inst_index, collected_instances, heaps, cs_error)
+		  		= check_specials module_index { fun_type & ft_type = ft_type } fun_index ft_specials next_inst_index collected_instances
+		  				{ heaps & hp_type_heaps = hp_type_heaps } cs.cs_error
+		  (new_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap
+		= check_dcl_functions module_index fun_types (inc fun_index) next_inst_index [
+				{ fun_type & ft_type = ft_type, ft_specials = spec_types, ft_type_ptr = new_info_ptr } : collected_funtypes]
+					collected_instances type_defs class_defs modules { heaps & hp_var_heap = hp_var_heap } { cs & cs_error = cs_error }
+
+	check_specials :: !Index !FunType !Index !Specials !Index ![FunType] !*Heaps !*ErrorAdmin
+		-> (!Specials, !Index, ![FunType], !*Heaps, !*ErrorAdmin)
+	check_specials mod_index fun_type fun_index (SP_Substitutions substs) next_inst_index all_instances heaps error
+		# (list_of_specials, (next_inst_index, all_instances, heaps, cs_error))
+				= mapSt (checkSpecial mod_index fun_type fun_index) substs (next_inst_index, all_instances, heaps, error)
+		= (SP_ContextTypes list_of_specials, next_inst_index, all_instances, heaps, cs_error)
+	check_specials mod_index fun_type fun_index SP_None next_inst_index all_instances heaps error
+		= (SP_None, next_inst_index, all_instances, heaps, error)
+
+
+checkSpecialsOfInstances :: !Index !Index ![ClassInstance] !Index ![ClassInstance] ![FunType] {# FunType} *{! [Special] } !*Heaps !*ErrorAdmin
+		-> (!Index, ![ClassInstance], ![FunType], !*{! [Special]}, !*Heaps, !*ErrorAdmin)
+checkSpecialsOfInstances mod_index first_mem_index [class_inst=:{ins_members,ins_specials} : class_insts] next_inst_index all_class_instances all_specials
+		new_inst_defs all_spec_types heaps error
+	= case ins_specials of
+		SP_TypeOffset type_offset
+			# (next_inst_index, rev_mem_specials, all_specials, all_spec_types, heaps, error)
+				= check_and_build_members mod_index first_mem_index 0 ins_members type_offset next_inst_index [] all_specials new_inst_defs all_spec_types heaps error
+			  class_inst = { class_inst & ins_members = { mem \\ mem <- reverse rev_mem_specials } }
+			-> checkSpecialsOfInstances mod_index first_mem_index class_insts next_inst_index [class_inst : all_class_instances]
+					all_specials new_inst_defs all_spec_types heaps error
+		SP_None
+			-> checkSpecialsOfInstances mod_index first_mem_index class_insts next_inst_index [class_inst : all_class_instances]
+					all_specials new_inst_defs all_spec_types heaps error
+where
+	check_and_build_members mod_index first_mem_index member_offset ins_members type_offset next_inst_index rev_mem_specials all_specials inst_spec_defs
+			all_spec_types heaps error
+		| member_offset < size ins_members
+			# member = ins_members.[member_offset]
+			  member_index = member.ds_index
+			  spec_member_index = member_index - first_mem_index
+		 	#! spec_types = all_spec_types.[spec_member_index]
+		 	# mem_inst = inst_spec_defs.[spec_member_index]
+		 	  (SP_Substitutions specials) = mem_inst.ft_specials
+		 	  env = specials !! type_offset
+			  member = { member & ds_index = next_inst_index }
+			  (spec_type, (next_inst_index, all_specials, heaps, error))
+			  		= checkSpecial mod_index mem_inst member_index env (next_inst_index, all_specials, heaps, error)
+			  all_spec_types = { all_spec_types & [spec_member_index] = [ spec_type : spec_types] }
+			= check_and_build_members mod_index first_mem_index (inc member_offset) ins_members type_offset next_inst_index [ member : rev_mem_specials ]
+					all_specials inst_spec_defs all_spec_types heaps error
+			= (next_inst_index, rev_mem_specials, all_specials, all_spec_types, heaps, error)
+
+checkSpecialsOfInstances mod_index first_mem_index [] next_inst_index all_class_instances all_specials inst_spec_defs all_spec_types heaps error
+	= (next_inst_index, all_class_instances, all_specials, all_spec_types, heaps, error)	
+
+/* MW was
+checkMemberTypes :: !Index !*{#MemberDef} !*{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState
+	-> (!*{#MemberDef}, !*{#CheckedTypeDef}, !*{#ClassDef}, !*{#DclModule}, !*TypeHeaps,  !*VarHeap, !*CheckState)
+checkMemberTypes module_index member_defs type_defs class_defs modules type_heaps var_heap cs
+	#! nr_of_members = size member_defs
+	= iFoldSt (check_class_member module_index) 0 nr_of_members (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs)
+*/
+checkMemberTypes :: !Index !Int !*{#MemberDef} !*{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState
+	-> (!*{#MemberDef}, !*{#CheckedTypeDef}, !*{#ClassDef}, !*{#DclModule}, !*TypeHeaps,  !*VarHeap, !*CheckState)
+checkMemberTypes module_index nr_of_members member_defs type_defs class_defs modules type_heaps var_heap cs
+	= iFoldSt (check_class_member module_index) 0 nr_of_members (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs)
+where
+	check_class_member module_index member_index (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs)
+		# (member_def=:{me_symb,me_type,me_pos}, member_defs) = member_defs![member_index]
+		  position = newPosition me_symb me_pos
+		  cs = { cs & cs_error = setErrorAdmin position cs.cs_error }
+		  (me_type, _, type_defs, class_defs, modules, type_heaps, cs)
+		   		= checkSymbolType module_index me_type SP_None type_defs class_defs modules type_heaps cs
+		  me_class_vars = map (\(TV type_var) -> type_var) (hd me_type.st_context).tc_types
+		  (me_type_ptr, var_heap) = newPtr VI_Empty var_heap		   
+		= ({ member_defs & [member_index] = { member_def & me_type = me_type, me_class_vars = me_class_vars, me_type_ptr = me_type_ptr }},
+				type_defs, class_defs, modules, type_heaps, var_heap, cs)
+
+::	InstanceSymbols =
+	{	is_type_defs		:: !.{# CheckedTypeDef}
+	,	is_class_defs		:: !.{# ClassDef}
+	,	is_member_defs		:: !.{# MemberDef}
+	,	is_modules			:: !.{# DclModule}
+	}
+
+checkInstanceDefs :: !Index !*{#ClassInstance} !u:{#CheckedTypeDef} !u:{#ClassDef} !u:{#MemberDef} !u:{#DclModule} !*TypeHeaps !*CheckState
+	-> (!.{#ClassInstance},!u:{#CheckedTypeDef},!u:{#ClassDef},!u:{#MemberDef},!u:{#DclModule},!.TypeHeaps,!.CheckState)
+checkInstanceDefs mod_index instance_defs type_defs class_defs member_defs modules type_heaps cs
+	# is = { is_type_defs = type_defs, is_class_defs = class_defs, is_member_defs = member_defs, is_modules = modules }
+	  (instance_defs, is, type_heaps, cs) = check_instance_defs 0 mod_index instance_defs is type_heaps cs
+	= (instance_defs, is.is_type_defs, is.is_class_defs, is.is_member_defs, is.is_modules, type_heaps, cs)
+where	
+	check_instance_defs :: !Index !Index !*{# ClassInstance} !u:InstanceSymbols !*TypeHeaps !*CheckState
+		-> (!*{# ClassInstance},!u:InstanceSymbols,!*TypeHeaps,!*CheckState)
+	check_instance_defs inst_index mod_index instance_defs is type_heaps cs
+		| inst_index < size instance_defs
+			#! instance_def = instance_defs.[inst_index]
+			#  (instance_def, is, type_heaps, cs) = check_instance mod_index instance_def is type_heaps cs
+			= check_instance_defs (inc inst_index) mod_index { instance_defs & [inst_index] = instance_def } is type_heaps cs
+			= (instance_defs, is, type_heaps, cs)
+
+	check_instance :: !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
+	check_instance module_index
+			ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident}
+			is=:{is_class_defs,is_modules} type_heaps cs=:{cs_symbol_table}
+		#! entry = sreadPtr id_info cs_symbol_table
+		# (class_index, class_mod_index, class_def, is_class_defs, is_modules) = get_class_def entry module_index is_class_defs is_modules
+		  is = { is & is_class_defs = is_class_defs, is_modules = is_modules }
+		  cs = pushErrorAdmin (newPosition ins_ident ins_pos) cs
+		| class_index <> NotFound
+			| class_def.class_arity == ds_arity
+				# (ins_type, ins_specials, is_type_defs, is_class_defs, is_modules, type_heaps, cs) = checkInstanceType module_index ins_type ins_specials
+						is.is_type_defs is.is_class_defs is.is_modules type_heaps cs
+				  ins_class = { glob_object = { class_name & ds_index = class_index }, glob_module = class_mod_index}
+				  is = { is & is_type_defs = is_type_defs, is_class_defs = is_class_defs, is_modules = is_modules }
+				= ({ins & ins_class = ins_class, ins_type = ins_type, ins_specials = ins_specials}, is, type_heaps, popErrorAdmin cs)
+				= ( ins
+				  , is
+				  , type_heaps
+				  , popErrorAdmin { cs & cs_error = checkError id_name ("wrong arity: expected "+++toString class_def.class_arity+++" found "+++toString ds_arity) cs.cs_error }
+				  )
+			= (ins, is, type_heaps, popErrorAdmin { cs & cs_error = checkError id_name "class undefined" cs.cs_error })
+
+	get_class_def :: !SymbolTableEntry !Index v:{# ClassDef} u:{# DclModule} -> (!Index,!Index,ClassDef,!v:{# ClassDef},!u:{# DclModule})
+	get_class_def {ste_kind = STE_Class, ste_index} mod_index class_defs modules
+		#! class_def = class_defs.[ste_index]
+		= (ste_index, mod_index, class_def, class_defs, modules)
+	get_class_def {ste_kind = STE_Imported STE_Class dcl_index, ste_index, ste_def_level} mod_index  class_defs modules
+		#! dcl_mod = modules.[dcl_index]
+		#  class_def = dcl_mod.dcl_common.com_class_defs.[ste_index]
+		= (ste_index, dcl_index, class_def, class_defs, modules)
+	get_class_def _ mod_index class_defs modules
+		= (NotFound, cIclModIndex, abort "no class definition", class_defs, modules)
+	
+checkInstances :: !Index !*CommonDefs !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
+	-> (![(Index,SymbolType)], !*CommonDefs, !u:{# DclModule}, !*VarHeap , !*TypeHeaps, !*CheckState)
+checkInstances mod_index icl_common=:{com_instance_defs,com_class_defs,com_member_defs} modules var_heap type_heaps cs=:{cs_error}
+	| cs_error.ea_ok
+		# (instance_types, com_instance_defs, com_class_defs, com_member_defs, modules, var_heap, type_heaps, cs)
+				= check_instances 0 mod_index [] com_instance_defs com_class_defs com_member_defs modules var_heap type_heaps cs
+		= (instance_types, { icl_common & com_instance_defs = com_instance_defs,com_class_defs = com_class_defs,com_member_defs = com_member_defs },
+			 	modules, var_heap, type_heaps, cs)
+		= ([], icl_common, modules, var_heap, type_heaps, cs)
+where
+	check_instances :: !Index !Index ![(Index,SymbolType)] !x:{# ClassInstance} !w:{# ClassDef} !v:{# MemberDef} !u:{# DclModule}
+		!*VarHeap !*TypeHeaps !*CheckState
+			-> (![(Index,SymbolType)], !x:{# ClassInstance}, !w:{# ClassDef}, !v:{# MemberDef}, !u:{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
+	check_instances inst_index mod_index instance_types instance_defs class_defs member_defs modules var_heap type_heaps cs
+		| inst_index < size instance_defs
+			#! {ins_class,ins_members,ins_type} = instance_defs.[inst_index]
+			# ({class_members,class_name}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules
+			  class_size = size class_members
+			| class_size == size ins_members
+				# (instance_types, member_defs, modules, var_heap, type_heaps, cs) = check_member_instances mod_index ins_class.glob_module
+			  	         0 class_size ins_members class_members ins_type instance_types member_defs modules var_heap type_heaps cs
+				= check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs modules var_heap type_heaps cs
+				= check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs modules var_heap type_heaps
+						{ cs & cs_error = checkError class_name "different number of members specified" cs.cs_error }
+			= (instance_types, instance_defs, class_defs, member_defs, modules, var_heap, type_heaps, cs)
+/*
+	check_member_instances :: !Index !Index ![DefinedSymbol] ![DefinedSymbol] !InstanceType ![TypeVar] ![(Index,SymbolType)] !v:{# MemberDef} !u:{# DclModule} !*TypeHeaps !*CheckState
+		 -> (![(Index,SymbolType)], !v:{# MemberDef},!u:{# DclModule},!*TypeHeaps,!*CheckState)
+
+*/
+
+	check_member_instances module_index member_mod_index mem_offset class_size ins_members class_members
+				ins_type instance_types member_defs modules var_heap type_heaps cs
+		| mem_offset == class_size
+			= (instance_types, member_defs, modules, var_heap, type_heaps, cs)
+			# ins_member = ins_members.[mem_offset]
+			  class_member = class_members.[mem_offset]
+			| ins_member.ds_ident <> class_member.ds_ident
+				= check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members ins_type 
+						instance_types member_defs modules var_heap type_heaps
+							{ cs & cs_error = checkError class_member.ds_ident "instance of class member expected" cs.cs_error}
+			| ins_member.ds_arity <> class_member.ds_arity
+				= check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members ins_type
+						instance_types member_defs modules var_heap type_heaps
+							{ cs & cs_error = checkError class_member.ds_ident "used with wrong arity" cs.cs_error}
+				# ({me_type,me_class_vars}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules
+				  (instance_type, _, type_heaps) = determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None type_heaps
+				  (st_context, var_heap) = initializeContextVariables instance_type.st_context var_heap
+				= check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members ins_type
+						[ (ins_member.ds_index, { instance_type & st_context = st_context }) : instance_types ] member_defs modules var_heap type_heaps cs
+
+getClassDef :: !(Global DefinedSymbol) !Int !u:{#ClassDef} !v:{#DclModule} -> (!ClassDef,!u:{#ClassDef},!v:{#DclModule})
+getClassDef {glob_module, glob_object={ds_ident, ds_index}} mod_index class_defs modules
+	| glob_module == mod_index
+		#! class_def = class_defs.[ds_index]
+		= (class_def, class_defs, modules)
+		#! dcl_mod = modules.[glob_module]
+		= (dcl_mod.dcl_common.com_class_defs.[ds_index], class_defs, modules)
+		
+getMemberDef :: !Int Int !Int !u:{#MemberDef} !v:{#DclModule} -> (!MemberDef,!u:{#MemberDef},!v:{#DclModule})
+getMemberDef mem_mod mem_index mod_index member_defs modules
+	| mem_mod == mod_index
+		#! member_def = member_defs.[mem_index]
+		= (member_def, member_defs, modules)
+		#! dcl_mod = modules.[mem_mod]
+		= (dcl_mod.dcl_common.com_member_defs.[mem_index], member_defs, modules)
+
+instantiateTypes :: ![TypeVar] ![AttributeVar] !types ![TypeContext] ![AttrInequality] !SpecialSubstitution ![SpecialSubstitution] !*TypeHeaps
+	-> (![TypeVar], ![AttributeVar], !types , ![TypeContext], ![AttrInequality], ![SpecialSubstitution], !*TypeHeaps) | substitute types
+instantiateTypes old_type_vars old_attr_vars types type_contexts attr_env {ss_environ, ss_vars, ss_attrs, ss_context} special_subst_list type_heaps=:{th_vars, th_attrs}
+	# th_vars = clear_vars old_type_vars th_vars
+
+	  (new_type_vars, th_vars) = foldSt build_var_subst ss_vars ([], th_vars)
+	  (new_attr_vars, th_attrs) = foldSt build_attr_subst ss_attrs ([], th_attrs)
+
+	  type_heaps = foldSt build_type_subst ss_environ { type_heaps & th_vars = th_vars, th_attrs = th_attrs }
+	  (new_ss_context, type_heaps) = substitute ss_context type_heaps
+
+	  (inst_vars, th_vars) =  foldSt determine_free_var old_type_vars (new_type_vars, type_heaps.th_vars) 
+	  (inst_attr_vars, th_attrs) = foldSt build_attr_subst old_attr_vars (new_attr_vars, type_heaps.th_attrs)
+
+	  (inst_types, type_heaps)		= substitute types { type_heaps & th_vars = th_vars, th_attrs = th_attrs }
+	  (inst_contexts, type_heaps)	= substitute type_contexts type_heaps
+	  (inst_attr_env, type_heaps)	= substitute attr_env type_heaps
+	  
+	  (special_subst_list, th_vars) =  mapSt adjust_special_subst special_subst_list type_heaps.th_vars
+
+	= (inst_vars, inst_attr_vars, inst_types, inst_contexts ++ new_ss_context, inst_attr_env, special_subst_list, { type_heaps & th_vars = th_vars })
+where
+	clear_vars type_vars type_var_heap = foldSt (\tv -> writePtr tv.tv_info_ptr TVI_Empty) type_vars type_var_heap
+	
+	determine_free_var tv=:{tv_info_ptr} (free_vars, type_var_heap)
+		# (type_var_info, type_var_heap) = readPtr tv_info_ptr type_var_heap
+		= case type_var_info of
+			TVI_Empty
+				-> build_var_subst tv (free_vars, type_var_heap)
+			_
+				-> (free_vars, type_var_heap)
+
+	build_type_subst {bind_src,bind_dst} type_heaps
+		# (bind_src, type_heaps) = substitute bind_src type_heaps
+		= { type_heaps & th_vars = writePtr bind_dst.tv_info_ptr (TVI_Type bind_src) type_heaps.th_vars}
+
+	build_var_subst var (free_vars, type_var_heap)
+		# (new_info_ptr, type_var_heap) = newPtr TVI_Empty type_var_heap
+		  new_fv = { var & tv_info_ptr = new_info_ptr}
+	  	= ([ new_fv : free_vars ], writePtr var.tv_info_ptr (TVI_Type (TV new_fv)) type_var_heap)
+
+	build_attr_subst attr (free_attrs, attr_var_heap)
+		# (new_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap
+		  new_attr = { attr & av_info_ptr = new_info_ptr}
+		= ([new_attr : free_attrs], writePtr attr.av_info_ptr (AVI_Attr (TA_Var new_attr)) attr_var_heap)
+	
+	adjust_special_subst special_subst=:{ss_environ} type_var_heap
+		# (ss_environ, type_var_heap) = mapSt adjust_special_bind ss_environ type_var_heap
+		= ({ special_subst & ss_environ = ss_environ }, type_var_heap)
+		
+	adjust_special_bind bind=:{bind_dst={tv_info_ptr}} type_var_heap
+		# (TVI_Type (TV new_tv), type_var_heap) = readPtr tv_info_ptr type_var_heap
+		= ({ bind & bind_dst = new_tv }, type_var_heap)
+
+substituteInstanceType :: !InstanceType !SpecialSubstitution !*TypeHeaps -> (!InstanceType,!*TypeHeaps)
+substituteInstanceType it=:{it_vars,it_attr_vars,it_types,it_context} environment type_heaps
+	# (it_vars, it_attr_vars, it_types, it_context, _, _, type_heaps)
+		= instantiateTypes it_vars it_attr_vars it_types it_context [] environment [] type_heaps
+	= ({it & it_vars = it_vars, it_types = it_types, it_attr_vars = it_attr_vars, it_context = it_context }, type_heaps)
+
+hasTypeVariables []
+	= False
+hasTypeVariables [TV tvar : types]
+	= True
+hasTypeVariables [ _ : types]
+	= hasTypeVariables types
+
+determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps -> (!SymbolType, !Specials, !*TypeHeaps)
+determineTypeOfMemberInstance mem_st class_vars {it_types,it_vars,it_attr_vars,it_context} specials type_heaps
+	# env = { ss_environ = foldl2 (\binds var type -> [ {bind_src = type, bind_dst = var} : binds]) [] class_vars it_types,
+			  ss_context = it_context, ss_vars = it_vars, ss_attrs = it_attr_vars} 
+	= determine_type_of_member_instance mem_st env specials type_heaps
+where
+	determine_type_of_member_instance mem_st=:{st_context} env (SP_Substitutions substs) type_heaps
+		# (mem_st, substs, type_heaps) = substitute_symbol_type { mem_st &  st_context = tl st_context } env substs type_heaps
+		= (mem_st, SP_Substitutions substs, type_heaps) 
+	determine_type_of_member_instance mem_st=:{st_context} env SP_None type_heaps
+		# (mem_st, _, type_heaps) = substitute_symbol_type { mem_st &  st_context = tl st_context } env [] type_heaps 
+		= (mem_st, SP_None, type_heaps)
+
+	substitute_symbol_type st=:{st_vars,st_attr_vars,st_args,st_result,st_context,st_attr_env} environment specials type_heaps
+		# (st_vars, st_attr_vars, [st_result : st_args], st_context, st_attr_env, specials, type_heaps)
+			= instantiateTypes st_vars st_attr_vars [ st_result : st_args ] st_context st_attr_env environment specials type_heaps
+		= ({st & st_vars = st_vars, st_args = st_args, st_result = st_result, st_attr_vars = st_attr_vars,
+			st_context = st_context, st_attr_env = st_attr_env }, specials, type_heaps)
+
+determineTypesOfInstances :: !Index !Index !*CommonDefs !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState
+	-> (![FunType], !Index, ![ClassInstance], !*CommonDefs, !*{#DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState)
+determineTypesOfInstances first_memb_inst_index mod_index dcl_common=:{com_instance_defs,com_class_defs,com_member_defs}
+		modules type_heaps var_heap cs=:{cs_error}
+	| cs_error.ea_ok
+		#! nr_of_class_instances = size com_instance_defs
+		# (memb_inst_defs, next_mem_inst_index, all_class_specials, com_class_defs, com_member_defs, modules, com_instance_defs, type_heaps, var_heap, cs_error)
+				= determine_types_of_instances 0 nr_of_class_instances first_memb_inst_index mod_index [] com_class_defs com_member_defs
+						modules com_instance_defs type_heaps var_heap cs_error
+		= (memb_inst_defs, next_mem_inst_index, all_class_specials,
+				{ dcl_common & com_instance_defs = com_instance_defs,com_class_defs = com_class_defs, com_member_defs = com_member_defs },
+					 modules, type_heaps, var_heap, { cs & cs_error = cs_error })
+		= ([], first_memb_inst_index, [], dcl_common, modules, type_heaps, var_heap, cs)
+where
+
+	determine_types_of_instances :: !Index !Index !Index !Index ![ClassInstance] !v:{#ClassDef} !w:{#MemberDef}
+		!x:{#DclModule} !*{#ClassInstance} !*TypeHeaps !*VarHeap !*ErrorAdmin
+			-> (![FunType], !Index, ![ClassInstance], !v:{#ClassDef}, !w:{#MemberDef}, !x:{#DclModule}, !*{#ClassInstance}, !*TypeHeaps, !*VarHeap, !*ErrorAdmin)
+	determine_types_of_instances inst_index next_class_inst_index next_mem_inst_index mod_index all_class_specials
+			class_defs member_defs modules instance_defs type_heaps var_heap error
+		| inst_index < size instance_defs
+			#! instance_def = instance_defs.[inst_index]
+			# {ins_class,ins_pos,ins_type,ins_specials} = instance_def
+			  ({class_members}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules
+			  class_size = size class_members
+			  (ins_members, memb_inst_defs1, member_defs, modules, type_heaps, var_heap)
+			  		= determine_instance_symbols_and_types next_mem_inst_index 0 mod_index ins_class.glob_module class_size class_members
+			  				ins_type ins_specials ins_pos member_defs modules type_heaps var_heap
+			  instance_def = { instance_def & ins_members = { member \\ member <- ins_members }}
+			  (ins_specials, next_class_inst_index, all_class_specials, type_heaps, error)
+					= check_instance_specials mod_index instance_def inst_index ins_specials next_class_inst_index all_class_specials type_heaps error
+			  (memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, modules, instance_defs, type_heaps, var_heap, error)
+			  		= determine_types_of_instances (inc inst_index) next_class_inst_index (next_mem_inst_index + class_size) mod_index all_class_specials
+			  				class_defs member_defs modules { instance_defs & [inst_index] = { instance_def & ins_specials = ins_specials }} type_heaps var_heap error
+
+			= (memb_inst_defs1 ++ memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, modules, instance_defs, type_heaps, var_heap, error)
+			= ([], next_mem_inst_index, all_class_specials, class_defs, member_defs, modules, instance_defs, type_heaps, var_heap, error)
+
+	determine_instance_symbols_and_types :: !Index !Index !Index !Index !Int !{#DefinedSymbol} !InstanceType !Specials !Position
+			!w:{#MemberDef} !u:{#DclModule} !*TypeHeaps !*VarHeap
+					-> (![DefinedSymbol], ![FunType], !w:{#MemberDef}, !u:{#DclModule}, !*TypeHeaps, !*VarHeap)
+	determine_instance_symbols_and_types first_inst_index mem_offset module_index member_mod_index class_size class_members
+			ins_type ins_specials ins_pos member_defs modules type_heaps var_heap
+		| mem_offset == class_size
+			=  ([], [], member_defs, modules, type_heaps, var_heap)
+			# class_member = class_members.[mem_offset]
+			  ({me_symb,me_type,me_priority,me_class_vars}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules
+			  (instance_type, new_ins_specials, type_heaps) = determineTypeOfMemberInstance me_type me_class_vars ins_type ins_specials type_heaps
+	  		  (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+			  inst_def = MakeNewFunctionType me_symb me_type.st_arity me_priority instance_type ins_pos new_ins_specials new_info_ptr
+			  (inst_symbols, memb_inst_defs, member_defs, modules, type_heaps, var_heap)
+			  		= determine_instance_symbols_and_types first_inst_index (inc mem_offset) module_index member_mod_index
+			  				class_size class_members ins_type ins_specials ins_pos member_defs modules type_heaps var_heap
+			= ([{ class_member & ds_index = first_inst_index +  mem_offset } : inst_symbols], [inst_def : memb_inst_defs], member_defs, modules, type_heaps, var_heap)
+
+	check_instance_specials :: !Index !ClassInstance !Index !Specials !Index ![ClassInstance] !*TypeHeaps !*ErrorAdmin
+		-> (!Specials, !Index, ![ClassInstance], !*TypeHeaps, !*ErrorAdmin)
+	check_instance_specials mod_index inst_type inst_index (SP_Substitutions substs) next_inst_index all_instances type_heaps error
+		# (list_of_specials, next_inst_index, all_instances, type_heaps, error)
+			= check_specials mod_index inst_type 0 substs [] next_inst_index all_instances type_heaps error
+		= (SP_ContextTypes list_of_specials, next_inst_index, all_instances, type_heaps, error)
+	where
+		check_specials mod_index inst=:{ins_type} type_offset [ subst : substs ] list_of_specials next_inst_index all_instances type_heaps error
+			# (special_type, type_heaps) = substituteInstanceType ins_type subst type_heaps
+			  (spec_types, error) = checkAndCollectTypesOfContexts special_type.it_context error
+			  special = { spec_index = { glob_module = mod_index, glob_object = next_inst_index }, spec_types = spec_types,
+			  				spec_vars = subst.ss_vars, spec_attrs = subst.ss_attrs }
+			= check_specials mod_index inst (inc type_offset) substs [ special : list_of_specials ] (inc next_inst_index)
+					[{ inst & ins_type = { special_type & it_context = [] }, ins_specials = SP_TypeOffset type_offset} : all_instances ] type_heaps error
+		check_specials mod_index inst=:{ins_type} type_offset [] list_of_specials next_inst_index all_instances type_heaps error
+			= (list_of_specials,  next_inst_index, all_instances, type_heaps, error)
+	
+	check_instance_specials mod_index fun_type fun_index SP_None next_inst_index all_instances type_heaps error
+		= (SP_None, next_inst_index, all_instances, type_heaps, error)
+
+checkAndCollectTypesOfContexts type_contexts error
+	= mapSt check_and_collect_context_types type_contexts error
+where	
+	check_and_collect_context_types {tc_class={glob_object={ds_ident}},tc_types} error
+		| hasTypeVariables tc_types
+			= (tc_types, checkError ds_ident.id_name "illegal specialization" error)
+			= (tc_types, error)
+
+/*
+retrieveSelectorIndexes mod_index {ste_kind = STE_Selector selector_list, ste_index, ste_previous }
+	# imported_selectors = retrieveSelectorIndexes mod_index ste_previous
+	= mapAppend (\ sel -> { sel & glob_module = mod_index }) selector_list [{glob_module = mod_index, glob_object = ste_index } : imported_selectors ]
+retrieveSelectorIndexes mod_index {ste_kind = STE_Imported (STE_Selector selector_list) dcl_mod_index, ste_index }
+	= [ { glob_object = ste_index, glob_module = dcl_mod_index } : selector_list ]
+retrieveSelectorIndexes mod_index off_kind
+	= []
+*/
+
+retrieveSelectorIndexes mod_index {ste_kind = STE_Selector selector_list, ste_index, ste_previous }
+	= map (adjust_mod_index mod_index) selector_list
+where
+	adjust_mod_index mod_index selector=:{glob_module}
+		| glob_module == NoIndex
+			= { selector & glob_module = mod_index }
+			= selector
+retrieveSelectorIndexes mod_index off_kind
+	= []
+
+checkFields :: !Index ![FieldAssignment] !(Optional Ident) !u:ExpressionInfo !*CheckState
+	-> (!Optional ((Global DefinedSymbol), Index, [Bind ParsedExpr (Global FieldSymbol)]), !u:ExpressionInfo, !*CheckState)
+checkFields mod_index field_ass opt_type e_info=:{ef_selector_defs,ef_type_defs,ef_modules} cs
+	# (ok, field_ass, cs) = check_fields field_ass cs
+	| ok
+		# (opt_type_def, ef_selector_defs, ef_type_defs, ef_modules, cs)
+				= determine_record_type mod_index opt_type field_ass ef_selector_defs ef_type_defs ef_modules cs
+		  e_info = { e_info & ef_selector_defs = ef_selector_defs, ef_type_defs = ef_type_defs, ef_modules = ef_modules}
+		= case opt_type_def of
+			Yes ({td_index,td_rhs = RecordType {rt_constructor,rt_fields}}, type_mod_index)
+				# (field_exprs, cs_error) = check_and_rearrange_fields type_mod_index 0 rt_fields field_ass cs.cs_error
+				-> (Yes ({ glob_object = rt_constructor, glob_module = type_mod_index }, td_index, field_exprs), e_info, { cs & cs_error = cs_error })
+			No
+				-> (No, e_info, cs)
+		= (No, e_info, cs)
+where
+
+	check_fields [ bind=:{bind_dst} : field_ass ] cs=:{cs_symbol_table,cs_error}
+		#! entry = sreadPtr bind_dst.id_info cs_symbol_table
+		# fields = retrieveSelectorIndexes mod_index entry 
+		| isEmpty fields
+			= (False, [], { cs & cs_error = checkError bind_dst "not defined as a record field" cs_error })
+			# (ok, field_ass, cs) = check_fields field_ass cs
+			= (ok, [{bind & bind_dst = (bind_dst, fields)} : field_ass], cs)
+	check_fields [] cs
+		= (True, [], cs)
+
+	try_to_get_unique_field []
+		= No
+	try_to_get_unique_field [ {bind_dst = (field_id, [field])} : fields ]
+		= Yes field
+	try_to_get_unique_field [ _ : fields ]
+		= try_to_get_unique_field fields
+	
+	determine_record_type mod_index (Yes type_id=:{id_info}) _ selector_defs type_defs modules cs=:{cs_symbol_table, cs_error}
+		#! entry = sreadPtr id_info cs_symbol_table
+		#  (type_index, type_mod_index) = retrieveGlobalDefinition entry STE_Type mod_index
+		| type_index <> NotFound
+			| mod_index == type_mod_index
+			 	#! type_def = type_defs.[type_index]
+			 	= (Yes (type_def, type_mod_index), selector_defs, type_defs, modules, cs)
+				# (type_def, modules) = modules![type_mod_index].dcl_common.com_type_defs.[type_index]
+				= (Yes (type_def, type_mod_index), selector_defs, type_defs, modules, cs)
+			= (No, selector_defs, type_defs, modules, { cs & cs_error = checkError type_id " not defined" cs_error})
+	determine_record_type mod_index No fields selector_defs type_defs modules cs=:{cs_error}
+		# succ = try_to_get_unique_field fields
+		= case succ of
+			Yes {glob_module, glob_object}
+				| glob_module == mod_index
+					#! selector_def = selector_defs.[glob_object]
+					   type_def = type_defs.[selector_def.sd_type_index]
+					-> (Yes (type_def, glob_module), selector_defs, type_defs, modules, cs)
+					#! {dcl_common={com_selector_defs,com_type_defs}} = modules.[glob_module]
+					#! selector_def = com_selector_defs.[glob_object]
+					   type_def = com_type_defs.[selector_def.sd_type_index]
+					-> (Yes (type_def,glob_module), selector_defs, type_defs, modules, cs)
+			No
+				-> (No, selector_defs, type_defs, modules, { cs & cs_error = checkError "" " could not determine the type of this record" cs.cs_error })
+			
+
+	check_and_rearrange_fields mod_index field_index fields field_ass cs_error
+		| field_index < size fields
+			# (field_expr, field_ass) = look_up_field mod_index fields.[field_index] field_ass
+		 	  (field_exprs, cs_error) = check_and_rearrange_fields mod_index (inc field_index) fields field_ass cs_error
+			= ([field_expr : field_exprs], cs_error)
+			| isEmpty field_ass
+				= ([], cs_error)
+				= ([], foldSt field_error field_ass cs_error)
+
+	where			
+		look_up_field mod_index field []
+			= ({bind_src = PE_WildCard,  bind_dst = { glob_object = field, glob_module = mod_index }}, [])
+		look_up_field mod_index field=:{fs_index} [ass=:{bind_src, bind_dst = (_, fields)} : field_ass]
+			| field_list_contains_field mod_index fs_index fields
+				= ({bind_src = bind_src, bind_dst = { glob_module = mod_index, glob_object = field}}, field_ass)
+				# (field_expr, field_ass) = look_up_field mod_index field field_ass
+				= (field_expr, [ass : field_ass])
+
+		field_list_contains_field mod_index fs_index []
+			= False
+		field_list_contains_field mod_index fs_index [{glob_object,glob_module} : fields]
+			= mod_index == glob_module && fs_index == glob_object || field_list_contains_field mod_index fs_index fields
+
+		field_error {bind_dst=(field_id,_)} error
+			= checkError field_id " field is either multiply used or not a part of this record" error
+
+::	ExpressionInfo =
+	{	ef_type_defs		:: !.{# CheckedTypeDef}
+	,	ef_selector_defs	:: !.{# SelectorDef}
+	,	ef_cons_defs		:: !.{# ConsDef}
+	,	ef_member_defs		:: !.{# MemberDef}
+	,	ef_class_defs		:: !.{# ClassDef}
+	,	ef_modules			:: !.{# DclModule}
+	}
+
+::	ExpressionState =
+	{	es_expression_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
+	}
+
+
+cIsInExpressionList		:== True
+cIsNotInExpressionList	:== False
+
+
+::	UnfoldMacroState =
+	{	ums_var_heap	:: !.VarHeap
+	,	ums_modules		:: !.{# DclModule}
+	,	ums_cons_defs	:: !.{# ConsDef}
+	,	ums_error		:: !.ErrorAdmin
+	}
+
+unfoldPatternMacro mod_index macro_index macro_args opt_var ps=:{ps_var_heap, ps_fun_defs} modules cons_defs error
+	# (macro, ps_fun_defs) = ps_fun_defs![macro_index]
+	= case macro.fun_body of
+		TransformedBody {tb_args,tb_rhs}
+			| no_sharing tb_args
+				# ums = { ums_var_heap = fold2St bind_var tb_args macro_args ps_var_heap, ums_modules = modules, ums_cons_defs = cons_defs, ums_error = error }
+				  (pattern, {ums_var_heap,ums_modules,ums_cons_defs,ums_error}) = unfold_pattern_macro mod_index macro.fun_symb opt_var tb_rhs ums
+				-> (pattern, { ps_fun_defs = ps_fun_defs, ps_var_heap = ums_var_heap}, ums_modules, ums_cons_defs, ums_error)
+				-> (AP_Empty macro.fun_symb, { ps_fun_defs = ps_fun_defs, ps_var_heap = ps_var_heap},
+						modules, cons_defs, checkError macro.fun_symb " sharing not allowed" error)
+		_
+			-> (AP_Empty macro.fun_symb, { ps_fun_defs = ps_fun_defs, ps_var_heap = ps_var_heap},
+					modules, cons_defs, checkError macro.fun_symb " illegal macro in pattern" error)
+	
+where
+	no_sharing [{fv_count} : args]
+		= fv_count <= 1 && no_sharing args
+	no_sharing []
+		= True
+	
+	bind_var {fv_info_ptr} pattern ps_var_heap
+		= ps_var_heap <:= (fv_info_ptr, VI_Pattern pattern)
+
+	unfold_pattern_macro mod_index macro_ident _ (Var {var_name,var_info_ptr}) ums=:{ums_var_heap}
+		# (VI_Pattern pattern, ums_var_heap) = readPtr var_info_ptr ums_var_heap
+		= (pattern, { ums & ums_var_heap = ums_var_heap})
+	unfold_pattern_macro mod_index macro_ident opt_var (App {app_symb,app_args}) ums
+		= unfold_application  mod_index macro_ident opt_var app_symb app_args ums
+	where
+		unfold_application  mod_index macro_ident opt_var {symb_kind=SK_Constructor {glob_module,glob_object},symb_name,symb_arity} args 
+										ums=:{ums_cons_defs, ums_modules,ums_error}
+				# (cons_def, cons_index, ums_cons_defs, ums_modules) = get_cons_def mod_index glob_module glob_object ums_cons_defs ums_modules
+				| cons_def.cons_type.st_arity == symb_arity
+					# (patterns, ums) = mapSt (unfold_pattern_macro mod_index macro_ident No) app_args { ums & ums_cons_defs = ums_cons_defs, ums_modules = ums_modules }
+					  cons_symbol = { glob_object = MakeDefinedSymbol symb_name cons_index symb_arity, glob_module = glob_module }	
+					= (AP_Algebraic cons_symbol cons_def.cons_type_index patterns opt_var, ums)	
+					= (AP_Empty cons_def.cons_symb, { ums & ums_cons_defs = ums_cons_defs, ums_modules = ums_modules,
+							ums_error = checkError cons_def.cons_symb " missing argument(s)" ums_error })
+			
+		get_cons_def mod_index cons_mod cons_index cons_defs modules
+			| mod_index == cons_mod
+				# (cons_def, cons_defs) = cons_defs![cons_index]
+				= (cons_def, cons_index, cons_defs, modules)
+				#! {dcl_common,dcl_conversions} = modules.[cons_mod]
+				#! cons_def = dcl_common.com_cons_defs.[cons_index]
+				= (cons_def, convertIndex cons_index (toInt STE_Constructor) dcl_conversions, cons_defs, modules)
+
+	unfold_pattern_macro mod_index macro_ident opt_var (BasicExpr bv bt) ums
+		= (AP_Basic bv opt_var, ums)
+	unfold_pattern_macro mod_index macro_ident opt_var expr ums=:{ums_error}
+		= (AP_Empty macro_ident, { ums & ums_error = checkError macro_ident " illegal rhs for a pattern macro" ums_error })
+	
+	
+			
+checkPatternVariable :: !Level !SymbolTableEntry !Ident !VarInfoPtr !*CheckState -> !*CheckState
+checkPatternVariable def_level entry=:{ste_def_level,ste_kind} ident=:{id_info} var_info cs=:{cs_symbol_table,cs_error}
+	| ste_kind == STE_Empty || def_level > ste_def_level
+		# entry = {ste_kind = STE_Variable var_info, ste_index = NoIndex, ste_def_level = def_level, ste_previous = entry }
+		= { cs & cs_symbol_table = cs_symbol_table <:= (id_info,entry)}
+		= { cs & cs_error = checkError ident "(pattern variable) already defined" cs_error }
+
+checkPatternConstructor :: !Index !Bool !SymbolTableEntry !Ident !(Optional (Bind Ident VarInfoPtr)) !*PatternState !*ExpressionInfo !*CheckState
+	-> (!AuxiliaryPattern, !*PatternState, !*ExpressionInfo, !*CheckState);
+checkPatternConstructor _ _ {ste_kind = STE_Empty} ident _  ps e_info cs=:{cs_error}
+	= (AP_Empty ident, ps, e_info, { cs & cs_error = checkError ident " not defined" cs_error })
+checkPatternConstructor mod_index is_expr_list {ste_kind = STE_FunctionOrMacro _,ste_index} ident opt_var  ps=:{ps_fun_defs} e_info cs=:{cs_error}
+	# ({fun_symb,fun_arity,fun_kind,fun_priority},ps_fun_defs) = ps_fun_defs![ste_index]
+	  ps = { ps & ps_fun_defs = ps_fun_defs }
+	| fun_kind == FK_Macro
+		| is_expr_list
+			# macro_symbol = { glob_object = MakeDefinedSymbol fun_symb ste_index fun_arity, glob_module = cIclModIndex }
+	 		= (AP_Constant APK_Macro macro_symbol fun_priority, ps, e_info, cs)
+		| fun_arity == 0
+			# (pattern, ps, ef_modules, ef_cons_defs, cs_error)
+					= unfoldPatternMacro mod_index ste_index [] opt_var ps e_info.ef_modules e_info.ef_cons_defs cs_error
+			= (pattern, ps, { e_info & ef_modules = ef_modules, ef_cons_defs = ef_cons_defs }, { cs & cs_error = cs_error })
+			= (AP_Empty ident, ps, e_info, { cs & cs_error = checkError ident " not defined" cs_error })
+		= (AP_Empty ident, ps, e_info, { cs & cs_error = checkError fun_symb " not allowed in a pattern" cs_error })
+checkPatternConstructor mod_index is_expr_list {ste_index, ste_kind} cons_symb opt_var ps
+		e_info=:{ef_cons_defs,ef_modules} cs=:{cs_error}
+	# (cons_index, cons_module, cons_arity, cons_priority, cons_type_index, ef_cons_defs, ef_modules, cs_error)
+			= determine_pattern_symbol mod_index ste_index ste_kind cons_symb.id_name ef_cons_defs ef_modules cs_error
+	  e_info = { e_info & ef_cons_defs = ef_cons_defs, ef_modules = ef_modules }
+	  cons_symbol = { glob_object = MakeDefinedSymbol cons_symb cons_index cons_arity, glob_module = cons_module }
+   	| is_expr_list
+		= (AP_Constant (APK_Constructor cons_type_index) cons_symbol cons_priority, ps, e_info, { cs & cs_error = cs_error })
+	| cons_arity == 0
+		= (AP_Algebraic cons_symbol cons_type_index [] opt_var, ps, e_info, { cs & cs_error = cs_error })
+		= (AP_Algebraic cons_symbol cons_type_index [] opt_var, ps, e_info, { cs & cs_error = checkError cons_symb " constructor arguments are missing" cs_error })
+where
+	determine_pattern_symbol mod_index id_index STE_Constructor id_name cons_defs modules error
+		#! cons_def = cons_defs.[id_index]
+		# {cons_type={st_arity},cons_priority, cons_type_index} = cons_def
+		= (id_index, mod_index, st_arity, cons_priority, cons_type_index, cons_defs, modules, error)
+	determine_pattern_symbol mod_index id_index (STE_Imported STE_Constructor import_mod_index) id_name cons_defs modules error
+		#! {dcl_common,dcl_conversions} = modules.[import_mod_index]
+		#! cons_def = dcl_common.com_cons_defs.[id_index]
+		# {cons_type={st_arity},cons_priority, cons_type_index} = cons_def
+		  id_index = convertIndex id_index (toInt STE_Constructor) dcl_conversions
+		= (id_index, import_mod_index, st_arity, cons_priority, cons_type_index, cons_defs, modules, error)
+	determine_pattern_symbol mod_index id_index id_kind id_name cons_defs modules error
+		= (id_index, NoIndex, 0, NoPrio, NoIndex, cons_defs, modules, checkError id_name " constructor expected" error)
+
+
+checkIdentPattern :: !Level !Index !Bool !Ident !(Optional (Bind Ident VarInfoPtr)) ![Ident] !*PatternState !*ExpressionInfo !*CheckState
+	-> (!AuxiliaryPattern, ![Ident], !*PatternState, !*ExpressionInfo, !*CheckState)
+checkIdentPattern def_level mod_index is_expr_list id=:{id_name,id_info} opt_var var_env ps e_info cs=:{cs_symbol_table}
+	#! entry = sreadPtr id_info cs_symbol_table
+	| isLowerCaseName id_name
+		# (new_info_ptr, ps_var_heap) = newPtr VI_Empty ps.ps_var_heap
+		  cs = checkPatternVariable def_level entry id new_info_ptr cs
+		= (AP_Variable id new_info_ptr opt_var, [ id : var_env ], { ps & ps_var_heap = ps_var_heap}, e_info, cs)
+		# (pattern, ps, e_info, cs) = checkPatternConstructor mod_index is_expr_list entry id opt_var ps e_info cs
+		= (pattern, var_env, ps, e_info, cs)
+
+::	PatternState =
+	{	ps_var_heap :: !.VarHeap
+	,	ps_fun_defs :: !.{# FunDef}
+	}
+
+
+buildPattern mod_index (APK_Constructor type_index) cons_symb args opt_var ps e_info cs
+	= (AP_Algebraic cons_symb type_index args opt_var, ps, e_info, cs)
+buildPattern mod_index APK_Macro {glob_object} args opt_var ps e_info=:{ef_modules,ef_cons_defs} cs=:{cs_error}
+	# (pattern, ps, ef_modules, ef_cons_defs, cs_error)
+			= unfoldPatternMacro mod_index glob_object.ds_index args opt_var ps ef_modules ef_cons_defs cs_error
+	= (pattern, ps, { e_info & ef_modules = ef_modules, ef_cons_defs = ef_cons_defs }, { cs & cs_error = cs_error })
+
+checkPattern :: !Level !Index !ParsedExpr !(Optional (Bind Ident VarInfoPtr)) ![Ident] !*PatternState !*ExpressionInfo !*CheckState
+									-> (!AuxiliaryPattern, ![Ident], !*PatternState, !*ExpressionInfo, !*CheckState)
+checkPattern def_level mod_index (PE_List [exp]) opt_var var_env ps e_info cs=:{cs_symbol_table}
+	= case exp of
+		PE_Ident ident
+			-> checkIdentPattern def_level mod_index cIsNotInExpressionList ident opt_var var_env ps e_info cs
+		_
+			-> checkPattern def_level mod_index exp opt_var var_env ps e_info cs
+
+checkPattern def_level mod_index (PE_List [exp1, exp2 : exps]) opt_var var_env ps e_info cs
+	# (exp_pat, var_env, ps, e_info, cs) = check_pattern def_level mod_index exp1 var_env ps e_info cs
+	= check_patterns def_level mod_index [exp_pat] exp2 exps opt_var var_env ps e_info cs
+	where
+		check_patterns def_level mod_index left middle [] opt_var var_env ps e_info cs
+			# (mid_pat, var_env, ps, e_info, cs) = checkPattern def_level mod_index middle No var_env ps e_info cs
+			  (pat, ps, e_info, cs) = combine_patterns opt_var [mid_pat : left] [] 0 ps e_info cs
+			= (pat, var_env, ps, e_info, cs)
+		check_patterns def_level mod_index left middle [right:rest] opt_var var_env ps e_info cs
+			# (mid_pat, var_env, ps, e_info, cs) = check_pattern def_level mod_index middle var_env ps e_info cs
+			= case mid_pat of
+				AP_Constant kind constant=:{glob_object={ds_arity,ds_ident}} prio
+					| ds_arity == 0
+						# (pattern, ps, e_info, cs) = buildPattern mod_index kind constant [] No ps e_info cs
+						-> check_patterns def_level mod_index [pattern: left] right rest opt_var var_env ps e_info cs
+					| is_infix_constructor prio
+						# (left_arg, ps, e_info, cs) = combine_patterns No left [] 0 ps e_info cs
+						-> check_infix_pattern def_level mod_index [] left_arg kind constant prio right rest
+									opt_var var_env ps e_info cs
+						-> (AP_Empty ds_ident, var_env, ps, e_info,
+								{ cs & cs_error = checkError ds_ident "arguments of constructor are missing" cs.cs_error })
+				_
+					-> check_patterns def_level mod_index [mid_pat : left] right rest opt_var var_env ps e_info cs
+
+
+		check_pattern def_level mod_index (PE_Ident id) var_env ps e_info cs
+			= checkIdentPattern def_level mod_index cIsInExpressionList id No var_env ps e_info cs
+		check_pattern def_level mod_index expr var_env ps e_info cs
+			= checkPattern def_level mod_index expr No var_env ps e_info cs
+		
+	 	check_infix_pattern def_level mod_index left_args left kind cons prio middle [] opt_var var_env ps e_info cs
+			# (mid_pat, var_env, ps, e_info, cs) = checkPattern def_level mod_index middle No var_env ps e_info cs
+			  (pattern, ps, e_info, cs) = buildPattern mod_index kind cons [left,mid_pat] opt_var ps e_info cs
+			  (pattern, ps, e_info, cs) = build_final_pattern mod_index left_args pattern ps e_info cs
+			= (pattern, var_env, ps, e_info, cs)
+	 	check_infix_pattern def_level mod_index left_args left kind cons prio middle [right] opt_var var_env ps e_info cs
+			# (mid_pat, var_env, ps, e_info, cs) = check_pattern def_level mod_index middle var_env ps e_info cs
+			  (right_pat, var_env, ps, e_info, cs) =  checkPattern def_level mod_index middle No var_env ps e_info cs
+			  (right_arg, ps, e_info, cs) = combine_patterns No [right_pat, mid_pat] [] 0 ps e_info cs
+			  (pattern, ps, e_info, cs) = buildPattern mod_index kind cons [left,right_arg] opt_var ps e_info cs
+			  (pattern, ps, e_info, cs) = build_final_pattern mod_index left_args pattern ps e_info cs
+			= (pattern, var_env, ps, e_info, cs)
+	 	check_infix_pattern def_level mod_index left_args left kind1 cons1 prio1 middle [inf_cons, arg : rest] opt_var var_env ps e_info cs
+			# (inf_cons_pat, var_env, ps, e_info, cs) = check_pattern def_level mod_index inf_cons var_env ps e_info cs
+			= case inf_cons_pat of
+				AP_Constant kind2 cons2=:{glob_object={ds_ident,ds_arity}} prio2
+					| ds_arity == 0
+						# (mid_pat, var_env, ps, e_info, cs) = check_pattern def_level mod_index middle var_env ps e_info cs
+						  (pattern2, ps, e_info, cs) = buildPattern mod_index kind2 cons2 [] No ps e_info cs
+						  (pattern1, ps, e_info, cs) = buildPattern mod_index kind1 cons1 [left,mid_pat] No ps e_info cs
+						  (pattern1, ps, e_info, cs) = build_final_pattern mod_index left_args pattern1 ps e_info cs
+						-> check_patterns def_level mod_index [pattern2,pattern1] arg rest opt_var var_env ps e_info cs
+					| is_infix_constructor prio2
+						| prio1 > prio2
+							# (mid_pat, var_env, ps, e_info, cs) = check_pattern def_level mod_index middle var_env ps e_info cs
+						      (pattern, ps, e_info, cs) = buildPattern mod_index kind1 cons1 [left,mid_pat] No ps e_info cs
+						      (left_args, pattern, ps, e_info, cs) = build_left_pattern mod_index left_args prio2 pattern ps e_info cs
+							-> check_infix_pattern def_level mod_index left_args pattern kind2 cons2 prio2 arg rest opt_var var_env ps e_info cs 
+							# (mid_pat, var_env, ps, e_info, cs) = checkPattern def_level mod_index middle No var_env ps e_info cs
+							-> check_infix_pattern def_level mod_index [(kind1, cons1, prio1, left) : left_args]
+							  				mid_pat kind2 cons2 prio2 arg rest No var_env ps e_info cs
+						-> (AP_Empty ds_ident, var_env, ps, e_info, { cs & cs_error = checkError ds_ident "arguments of constructor are missing" cs.cs_error })
+				_
+					# (right_pat, var_env, ps, e_info, cs) = checkPattern def_level mod_index middle No var_env ps e_info cs
+					  (pattern, ps, e_info, cs) = buildPattern mod_index kind1 cons1 [left,right_pat] No ps e_info cs
+					  (pattern, ps, e_info, cs) = build_final_pattern  mod_index left_args pattern ps e_info cs
+					-> check_patterns def_level mod_index [inf_cons_pat, pattern] arg rest opt_var var_env ps e_info cs
+
+		is_infix_constructor (Prio _ _) = True
+		is_infix_constructor _ = False
+
+		build_left_pattern mod_index [] _ result_pattern ps e_info cs
+			= ([], result_pattern, ps, e_info, cs)		
+		build_left_pattern mod_index la=:[(kind, cons, priol, left) : left_args] prior result_pattern ps e_info cs
+			| priol > prior
+				# (result_pattern,  ps, e_info, cs) = buildPattern mod_index kind cons [left,result_pattern] No ps e_info cs
+				= build_left_pattern mod_index left_args prior result_pattern ps e_info cs
+				= (la, result_pattern,  ps, e_info, cs)
+		
+		build_final_pattern mod_index [] result_pattern ps e_info cs
+			= (result_pattern,  ps, e_info, cs)		
+		build_final_pattern mod_index [(kind, cons, priol, left) : left_appls] result_pattern ps e_info cs
+			# (result_pattern, ps, e_info, cs) = buildPattern mod_index kind cons [left,result_pattern] No ps e_info cs
+			= build_final_pattern mod_index left_appls result_pattern ps e_info cs
+
+		combine_patterns opt_var [first_expr] args nr_of_args ps e_info cs
+			= case first_expr of
+				AP_Constant kind constant=:{glob_object={ds_ident,ds_arity}} _
+					| ds_arity == nr_of_args
+						# (pattern, ps, e_info, cs) = buildPattern mod_index kind constant args opt_var ps e_info cs
+						-> (pattern, ps, e_info, cs)
+						-> (AP_Empty ds_ident, ps, e_info, { cs & cs_error = checkError ds_ident "used with wrong arity" cs.cs_error})
+				_
+					| nr_of_args == 0
+						-> (first_expr, ps, e_info, cs)
+						-> (first_expr, ps, e_info, { cs & cs_error = checkError "<pattern>" "(curried) application not allowed " cs.cs_error })
+		combine_patterns opt_var [rev_arg : rev_args] args arity ps e_info cs
+			= combine_patterns opt_var rev_args [rev_arg : args] (inc arity) ps e_info cs
+/*
+		combine_optional_variables (Yes var1) (Yes var2) error
+			= (Yes var1, checkError var2.bind_dst "pattern already bound" error)
+		combine_optional_variables No opt_var error
+			= (opt_var, error)
+		combine_optional_variables opt_var _ error
+			= (opt_var, error)
+*/
+
+checkPattern def_level mod_index (PE_DynamicPattern pattern type) opt_var var_env ps e_info cs
+	# (dyn_pat, var_env, ps, e_info, cs) = checkPattern def_level mod_index pattern No var_env ps e_info cs
+	= (AP_Dynamic dyn_pat type opt_var, var_env, ps, e_info, cs)
+checkPattern def_level mod_index (PE_Basic basic_value) opt_var var_env ps e_info cs
+	= (AP_Basic basic_value opt_var, var_env, ps, e_info, cs)
+
+checkPattern def_level mod_index (PE_Tuple tuple_args) opt_var var_env ps e_info cs
+	# (patterns, arity, var_env, ps, e_info, cs) = check_tuple_patterns def_level mod_index tuple_args var_env ps e_info cs
+	  (tuple_symbol, cs) = getPredefinedGlobalSymbol (GetTupleConsIndex arity) PD_PredefinedModule STE_Constructor arity cs
+	#! {cons_type_index} = e_info.ef_modules.[tuple_symbol.glob_module].dcl_common.com_cons_defs.[tuple_symbol.glob_object.ds_index]
+	= (AP_Algebraic tuple_symbol cons_type_index patterns opt_var, var_env, ps, e_info, cs)
+where
+	check_tuple_patterns def_level mod_index [] var_env ps e_info cs
+		= ([], 0, var_env, ps, e_info, cs)
+	check_tuple_patterns def_level mod_index [expr : exprs] var_env ps e_info cs
+		# (pattern, var_env, ps, e_info, cs) = checkPattern def_level mod_index expr No var_env ps e_info cs
+		  (patterns, length, var_env, ps, e_info, cs) = check_tuple_patterns def_level mod_index exprs var_env ps e_info cs
+		= ([pattern : patterns], inc length, var_env, ps, e_info, cs)
+checkPattern def_level mod_index (PE_Record record opt_type fields) opt_var var_env ps e_info cs
+	# (opt_record_and_fields, e_info, cs) = checkFields mod_index fields opt_type e_info cs
+	= case opt_record_and_fields of
+		Yes (record_symbol, type_index, new_fields)
+			# (patterns, (var_env, ps, e_info, cs)) = mapSt (check_field_pattern def_level mod_index) new_fields (var_env, ps, e_info, cs)
+			  (patterns, ps_var_heap) = bind_opt_record_variable opt_var patterns new_fields ps.ps_var_heap
+			-> (AP_Algebraic record_symbol type_index patterns opt_var, var_env, { ps & ps_var_heap = ps_var_heap }, e_info, cs)
+		No
+			-> (AP_Empty (hd fields).bind_dst, var_env, ps, e_info, cs)
+where
+
+	check_field_pattern def_level mod_index {bind_src = PE_Empty, bind_dst = {glob_object={fs_var}}} (var_env, ps, e_info, cs)
+		#! entry = sreadPtr fs_var.id_info cs.cs_symbol_table
+		# (new_info_ptr, ps_var_heap) = newPtr VI_Empty ps.ps_var_heap
+		  cs = checkPatternVariable def_level entry fs_var new_info_ptr cs
+		= (AP_Variable fs_var new_info_ptr No, ([ fs_var : var_env ], { ps & ps_var_heap = ps_var_heap }, e_info, cs))
+	check_field_pattern def_level mod_index {bind_src = PE_WildCard, bind_dst={glob_object={fs_var}}} (var_env, ps, e_info, cs)
+		# (new_info_ptr, ps_var_heap) = newPtr VI_Empty ps.ps_var_heap
+		= (AP_WildCard (Yes { bind_src = fs_var, bind_dst = new_info_ptr}), (var_env, { ps & ps_var_heap = ps_var_heap }, e_info, cs))
+	check_field_pattern def_level mod_index {bind_src,bind_dst} (var_env, ps, e_info, cs)
+		# (pattern, var_env, ps, e_info, cs) = checkPattern def_level mod_index bind_src No var_env ps e_info cs
+		= (pattern, (var_env, ps, e_info, cs))
+
+
+	add_bound_variable (AP_Algebraic symbol index patterns No) {bind_dst = {glob_object={fs_var}}} ps_var_heap
+		# (new_info_ptr, ps_var_heap) = newPtr VI_Empty ps_var_heap
+		= (AP_Algebraic symbol index patterns (Yes { bind_src = fs_var, bind_dst = new_info_ptr}), ps_var_heap)
+	add_bound_variable (AP_Basic bas_val No) {bind_dst = {glob_object={fs_var}}} ps_var_heap
+		# (new_info_ptr, ps_var_heap) = newPtr VI_Empty ps_var_heap
+		= (AP_Basic bas_val (Yes { bind_src = fs_var, bind_dst = new_info_ptr}), ps_var_heap)
+	add_bound_variable (AP_Dynamic dynamic dynamic_type No) {bind_dst = {glob_object={fs_var}}} ps_var_heap
+		# (new_info_ptr, ps_var_heap) = newPtr VI_Empty ps_var_heap
+		= (AP_Dynamic dynamic dynamic_type (Yes { bind_src = fs_var, bind_dst = new_info_ptr}), ps_var_heap)
+	add_bound_variable pattern _ ps_var_heap
+		= (pattern, ps_var_heap)
+
+	add_bound_variables [] _ var_heap
+		= ([] , var_heap)
+	add_bound_variables [ap : aps] [field : fields] var_heap
+		# (ap, var_heap) = add_bound_variable ap field var_heap
+		  (aps, var_heap) = add_bound_variables aps fields var_heap
+		= ([ap : aps], var_heap)
+
+	bind_opt_record_variable (Yes {bind_dst}) patterns fields var_heap
+		# (patterns, var_heap) = add_bound_variables patterns fields var_heap
+		= (patterns, var_heap <:= (bind_dst, VI_Record patterns))
+	bind_opt_record_variable No patterns _ var_heap
+		= (patterns, var_heap)
+
+checkPattern def_level mod_index (PE_Bound bind) opt_var var_env ps e_info cs
+	= checkBoundPattern def_level mod_index bind opt_var var_env ps e_info cs
+
+checkPattern def_level mod_index (PE_Ident id) opt_var var_env ps e_info cs
+	= checkIdentPattern def_level mod_index cIsNotInExpressionList id opt_var var_env ps e_info cs
+checkPattern def_level mod_index PE_WildCard opt_var var_env ps e_info cs
+	= (AP_WildCard No, var_env, ps, e_info, cs)
+checkPattern def_level mod_index expr opt_var var_env ps e_info cs
+	= abort "checkPattern: do not know how to handle pattern" ---> expr
+
+checkBoundPattern def_level mod_index {bind_src,bind_dst} opt_var var_env ps e_info cs=:{cs_symbol_table}
+	| isLowerCaseName bind_dst.id_name
+		#! entry = sreadPtr bind_dst.id_info cs_symbol_table
+		# (new_info_ptr, ps_var_heap) = newPtr VI_Empty ps.ps_var_heap
+		  cs = checkPatternVariable def_level entry bind_dst new_info_ptr cs
+		  ps = { ps & ps_var_heap = ps_var_heap }
+		  var_env = [ bind_dst : var_env ]
+		= case opt_var of
+			Yes bind
+				-> checkPattern def_level mod_index bind_src (Yes { bind_src = bind_dst, bind_dst = new_info_ptr }) var_env ps
+					 	e_info { cs & cs_error = checkError bind.bind_src "pattern already bound" cs.cs_error }
+			No
+				-> checkPattern def_level mod_index bind_src (Yes { bind_src = bind_dst, bind_dst = new_info_ptr }) var_env ps e_info cs
+	= checkPattern def_level mod_index bind_src opt_var var_env ps e_info { cs & cs_error = checkError bind_dst "variable expected" cs.cs_error }
+
+instance <<< AuxiliaryPattern
+where
+	(<<<) file (AP_Algebraic symbol index patterns var)
+		= file <<< symbol <<< ' ' <<< patterns
+	(<<<) file (AP_Variable ident var_ptr var)
+		= file <<< ident
+	(<<<) file (AP_Basic val var)
+		= file <<< val
+	(<<<) file (AP_Constant kind symbol prio)
+		= file <<< symbol
+	(<<<) file (AP_WildCard _)
+		= file <<< '_'
+	(<<<) file (AP_Empty ident)
+		= file <<< "<?" <<< ident <<< "?>"
+
+newFreeVariable :: !FreeVar ![FreeVar] ->(!Bool, ![FreeVar])
+newFreeVariable new_var vars=:[free_var=:{fv_def_level,fv_info_ptr}: free_vars]
+	| new_var.fv_def_level > fv_def_level
+		= (True, [new_var : vars])
+	| new_var.fv_def_level == fv_def_level
+		| new_var.fv_info_ptr == fv_info_ptr
+			= (False, vars)
+			#! (free_var_added, free_vars) = newFreeVariable new_var free_vars
+			= (free_var_added, [free_var : free_vars])
+		#! (free_var_added, free_vars) = newFreeVariable new_var free_vars
+		= (free_var_added, [free_var : free_vars])
+newFreeVariable new_var []
+	= (True, [new_var])
+
+
+buildTypeCase type_case_dynamic type_case_patterns type_case_default type_case_info_ptr :==
+	Case {	case_expr = type_case_dynamic, case_guards = DynamicPatterns type_case_patterns, case_default = type_case_default, 
+			case_info_ptr = type_case_info_ptr, case_ident = No }
+
+
+consOptional (Yes thing) things
+	= [ thing : things]
+consOptional No things
+	= things
+
+buildApplication :: !SymbIdent !Int !Int !Bool ![Expression] !*ExpressionState !*ErrorAdmin -> (!Expression,!*ExpressionState,!*ErrorAdmin)
+buildApplication symbol form_arity act_arity is_fun args e_state=:{es_expression_heap} error
+	| is_fun
+		# (new_info_ptr, es_expression_heap) = newPtr EI_Empty es_expression_heap
+		| form_arity < act_arity
+			# app = { app_symb = { symbol & symb_arity = form_arity }, app_args = take form_arity args, app_info_ptr = new_info_ptr }
+			= (App app @ drop form_arity args, { e_state & es_expression_heap = es_expression_heap }, error)
+			# app = { app_symb = { symbol & symb_arity = act_arity }, app_args = take form_arity args, app_info_ptr = new_info_ptr }
+			= (App app, { e_state & es_expression_heap = es_expression_heap }, error)
+		# app = App { app_symb = { symbol & symb_arity = act_arity }, app_args = args, app_info_ptr = nilPtr }
+		| form_arity < act_arity
+			= (app, e_state, checkError symbol.symb_name " used with too many arguments" error)
+			= (app, e_state, error)
+
+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 = sreadPtr id_info cs_symbol_table
+	= check_id_expression entry is_expr_list free_vars id e_input e_state e_info cs
+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}
+		= (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_expression_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_expression_heap) = newPtr EI_Empty es_expression_heap
+			= (Var {var_name = id, var_info_ptr = info_ptr, var_expr_ptr = var_expr_ptr}, free_vars,
+					{e_state & es_expression_heap = es_expression_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
+				e_input=:{ei_fun_index, ei_mod_index} e_state=:{es_fun_defs,es_calls} e_info cs=:{cs_symbol_table}
+		#! {fun_symb,fun_arity,fun_kind,fun_priority} = es_fun_defs.[ste_index]
+		# index = { glob_object = ste_index, glob_module = cIclModIndex }
+		| is_called_before ei_fun_index calls
+			| fun_kind == FK_Macro
+				= (SK_Macro index, fun_arity, fun_priority, cIsNotAFunction, e_state, e_info, cs)
+				= (SK_Function index, fun_arity, fun_priority, cIsAFunction, e_state, 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_calls = [{ fc_index = ste_index, fc_level = ste_def_level} : es_calls ]}
+			= (if (fun_kind == FK_Macro) (SK_Macro index) (SK_Function index), 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.[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, 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)
+		ste_kind_to_symbol_kind STE_Constructor def_index mod_index {dcl_common={com_cons_defs},dcl_conversions}
+			#! {cons_type={st_arity},cons_priority} = com_cons_defs.[def_index]
+			# def_index = convertIndex def_index (toInt STE_Constructor) dcl_conversions
+			= (SK_Constructor { glob_object = def_index, glob_module = mod_index }, st_arity, cons_priority, cIsNotAFunction)
+
+	determine_info_of_symbol {ste_kind=STE_Member, ste_index} _ e_input=:{ei_mod_index} e_state e_info=:{ef_member_defs} cs
+		#! {me_type={st_arity},me_priority} = ef_member_defs.[ste_index]
+		= (SK_OverloadedFunction { glob_object = ste_index, glob_module = ei_mod_index}, st_arity, me_priority, cIsAFunction, e_state, e_info, cs)
+	determine_info_of_symbol {ste_kind=STE_Constructor, ste_index} _ e_input=:{ei_mod_index} e_state e_info=:{ef_cons_defs} cs
+		#! {cons_type={st_arity},cons_priority} = ef_cons_defs.[ste_index]
+		= (SK_Constructor { glob_object = ste_index, glob_module =  ei_mod_index}, st_arity, cons_priority, cIsNotAFunction, e_state, e_info, cs)
+	determine_info_of_symbol {ste_kind=STE_DclFunction, ste_index} _ e_input=:{ei_mod_index} e_state e_info=:{ef_modules} cs
+		#! mod_def = ef_modules.[ei_mod_index]
+		# {ft_type={st_arity},ft_priority} = mod_def.dcl_functions.[ste_index]
+		  def_index = convertIndex ste_index (toInt STE_DclFunction) mod_def.dcl_conversions
+		= (SK_Function { glob_object = def_index, glob_module =  ei_mod_index}, st_arity, ft_priority, cIsAFunction, e_state, e_info, cs)
+
+::	RecordKind = RK_Constructor | RK_Update | RK_UpdateToConstructor ![AuxiliaryPattern]
+
+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)
+
+	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)
+				-> 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
+			# (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)
+					| prio1 > prio2
+				  		# (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
+					# (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
+			| priol > prior
+				# (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)
+		
+		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, 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
+	  (let_expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs let_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_expression_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
+	= (let_expr, free_vars, { e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap, es_expression_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 [] e_input e_state e_info cs
+	  (pattern_expr, binds, es_expression_heap) = bind_pattern_variables pattern_variables pattern_expr e_state.es_expression_heap
+	  (case_expr, es_expression_heap) = build_case guards defaul pattern_expr case_ident es_expression_heap
+	  (result_expr, es_expression_heap) = buildLetExpression binds cIsNotStrict case_expr es_expression_heap
+	= (result_expr, free_vars, { e_state & es_expression_heap = es_expression_heap }, e_info, cs)
+	
+where
+	check_guarded_expressions free_vars [g] pattern_variables 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 pattern_variables No e_input e_state e_info cs 
+	check_guarded_expressions free_vars [g : gs] pattern_variables e_input=:{ei_expr_level} e_state e_info cs
+		# e_input = { e_input & ei_expr_level = inc ei_expr_level }
+		  (gs, pattern_variables, defaul, free_vars, e_state, e_info, cs)
+		  	= check_guarded_expressions free_vars gs pattern_variables e_input e_state e_info cs
+		= check_guarded_expression free_vars g gs pattern_variables defaul e_input e_state e_info cs 
+
+	check_guarded_expression free_vars {calt_pattern,calt_rhs={rhs_alts,rhs_locals}} patterns pattern_variables defaul e_input=:{ei_expr_level,ei_mod_index}
+				e_state=:{es_fun_defs,es_var_heap} e_info cs
+		# (pattern, var_env, {ps_fun_defs,ps_var_heap}, e_info, cs)
+				= checkPattern ei_expr_level ei_mod_index calt_pattern No [] {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}
+		  (expr, free_vars, e_state=:{es_dynamics,es_expression_heap,es_var_heap}, e_info, cs) = checkRhs free_vars rhs_alts rhs_locals e_input e_state e_info cs
+		  cs_symbol_table = removeLocalIdentsFromSymbolTable ei_expr_level var_env cs.cs_symbol_table
+		  (guarded_expr, pattern_variables, defaul, es_var_heap, es_expression_heap, dynamics_in_patterns, cs)
+		  		= transform_pattern pattern patterns pattern_variables defaul expr es_var_heap es_expression_heap es_dynamics { cs & cs_symbol_table = cs_symbol_table }
+		= (guarded_expr, pattern_variables, defaul, free_vars,
+			{ e_state & es_var_heap = es_var_heap, es_expression_heap = es_expression_heap, es_dynamics = dynamics_in_patterns },
+				e_info, cs) 
+
+	transform_pattern :: !AuxiliaryPattern !CasePatterns !(Env Ident VarInfoPtr) !(Optional (Optional FreeVar, Expression)) !Expression
+			!*VarHeap !*ExpressionHeap ![DynamicPtr] !*CheckState
+				-> (!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_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 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}
+		  pattern_variables = cons_optional opt_var pattern_variables
+		= case patterns of
+			AlgebraicPatterns alg_type alg_patterns
+				| type_symbol == alg_type
+					-> (AlgebraicPatterns type_symbol [pattern : alg_patterns], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+					-> (patterns, 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], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+			_
+				-> (patterns, 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_variables defaul result_expr var_store expr_heap opt_dynamics cs
+		# pattern = { bp_value = basic_val, bp_expr = result_expr}
+		  pattern_variables = cons_optional opt_var pattern_variables
+		  (type_symbol, cs) = typeOfBasicValue basic_val cs
+		= case patterns of
+			BasicPatterns basic_type basic_patterns
+				| type_symbol == basic_type
+					-> (BasicPatterns basic_type [pattern : basic_patterns], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+					-> (patterns, 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], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+			_
+				-> (patterns, 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_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 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 }
+		  pattern_variables = cons_optional opt_var pattern_variables
+		= case patterns of
+			DynamicPatterns dyn_patterns
+				-> (DynamicPatterns [pattern : dyn_patterns], pattern_variables, defaul, var_store, expr_heap, [dynamic_info_ptr], cs)
+			NoPattern
+				-> (DynamicPatterns [pattern], pattern_variables, defaul, var_store, expr_heap, [dynamic_info_ptr], cs)
+			_
+				-> (patterns, 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_variables No result_expr var_store expr_heap opt_dynamics cs
+		= (NoPattern, 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_variables defaul result_expr var_store expr_heap opt_dynamics cs
+		= (patterns, cons_optional opt_var pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
+				{ cs & cs_error = checkError name "illegal combination of patterns" cs.cs_error })
+	transform_pattern (AP_WildCard _) NoPattern pattern_variables No result_expr var_store expr_heap opt_dynamics cs
+		= (NoPattern, pattern_variables, Yes (No, result_expr), var_store, expr_heap, opt_dynamics, cs)		
+	transform_pattern (AP_WildCard _) patterns pattern_variables defaul result_expr var_store expr_heap opt_dynamics cs
+		= (patterns, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, { cs & cs_error = checkError "_" "illegal combination of patterns" cs.cs_error })		
+	transform_pattern (AP_Empty name) patterns pattern_variables defaul result_expr var_store expr_heap opt_dynamics cs
+		= (patterns, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+
+
+	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
+				-> (abort "incorrect case expression in build_case", 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
+						# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+						  (type_case_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
+						  bound_var = { var_name = var.fv_name, var_info_ptr = var.fv_info_ptr, var_expr_ptr = var_expr_ptr }
+						  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 (defaul,result)) expr case_ident expr_heap
+		= case defaul of
+			Yes var
+				# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+				  (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+				  bound_var = { var_name = var.fv_name, var_info_ptr = var.fv_info_ptr, var_expr_ptr = var_expr_ptr }
+				  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_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 }, 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 }, expr_heap)
+
+	bind_default_variable bind_src bind_dst result_expr expr_heap
+		#  (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+		= (Let {let_strict = cIsNotStrict, let_binds = [{ bind_src = bind_src, bind_dst = bind_dst }], let_expr = result_expr, let_info_ptr = let_expr_ptr }, expr_heap)
+
+	cons_optional (Yes var) variables
+		= [ var : variables ]
+	cons_optional No variables
+		= variables
+
+	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 }
+		  (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+		  bound_var = { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }
+		  (pattern_expr, binds, expr_heap) = bind_pattern_variables variables (Var bound_var) expr_heap
+		= (pattern_expr, [{bind_src = this_pattern_expr, bind_dst = free_var} : binds], expr_heap)
+
+
+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 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 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 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 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 = EE }, 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 e_info cs
+		= ({ field & bind_src = EE }, free_vars, e_state, e_info, cs)
+	check_field_expr free_vars field=:{bind_src = PE_WildCard} field_nr (RK_UpdateToConstructor fields) e_input e_state=:{es_expression_heap} e_info cs
+		# (var_name, var_info_ptr) = get_field_var (fields !! field_nr)
+		  (var_expr_ptr, es_expression_heap) = newPtr EI_Empty es_expression_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_expression_heap = es_expression_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_expression_heap,es_dynamics} e_info cs	
+	# (dyn_info_ptr, es_expression_heap) = newPtr (EI_Dynamic opt_type) es_expression_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_expression_heap = es_expression_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) 
+
+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 = sreadPtr 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
+
+			= (	{ 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
+checkExpression free_vars expr e_input e_state e_info cs
+	= abort "checkExpression (check.icl, line 1433)" <<- expr
+
+checkSelectors free_vars [] e_input e_state e_info cs
+	= ([], free_vars, e_state, e_info, cs)
+checkSelectors free_vars [ selector : selectors ] e_input e_state e_info cs
+	# (selector, free_vars, e_state, e_info, cs) = check_selector free_vars selector e_input e_state e_info cs
+	  (selectors, free_vars, e_state, e_info, cs) = checkSelectors free_vars selectors e_input e_state e_info cs
+	= ([ selector : selectors ], free_vars, e_state, e_info, cs)
+where		
+	check_selector free_vars (PS_Record selector=:{id_info,id_name} opt_type) e_input=:{ei_mod_index} e_state
+			e_info=:{ef_selector_defs, ef_modules} cs=:{cs_symbol_table}
+		#! entry = sreadPtr id_info cs_symbol_table
+		# selectors = retrieveSelectorIndexes ei_mod_index entry 
+		  (field_module, field_index, field_nr, ef_selector_defs, ef_modules, cs)
+		  		= get_field_nr ei_mod_index selector opt_type selectors ef_selector_defs ef_modules cs
+		= (RecordSelection { glob_object = MakeDefinedSymbol selector field_index 1, glob_module = field_module } field_nr, free_vars, e_state,
+								{e_info & ef_selector_defs = ef_selector_defs, ef_modules = ef_modules }, cs)
+	where					
+		get_field_nr :: !Index !Ident !(Optional Ident) ![Global Index] !u:{#SelectorDef} !v:{# DclModule} !*CheckState
+				-> (!Index, !Index, !Index, u:{#SelectorDef}, v:{#DclModule}, !*CheckState)
+		get_field_nr mod_index sel_id _ [] selector_defs modules cs=:{cs_error}
+			= (NoIndex, NoIndex, NoIndex, selector_defs, modules, { cs & cs_error = checkError id_name " selector not defined" cs_error })
+		get_field_nr mod_index sel_id (Yes type_id=:{id_info}) selectors selector_defs modules cs=:{cs_symbol_table,cs_error}
+			#! entry = sreadPtr id_info cs_symbol_table
+			#  (type_index, type_module) = retrieveGlobalDefinition entry STE_Type mod_index
+			| type_index <> NotFound
+				#! (selector_index, selector_offset, selector_defs, modules)
+						= determine_selector mod_index type_module type_index selectors selector_defs modules
+				| selector_offset <> NoIndex
+					= (type_module, selector_index, selector_offset, selector_defs, modules, cs)
+					= (NoIndex, NoIndex, NoIndex, selector_defs, modules, { cs & cs_error = checkError id_name " selector not defined" cs_error })
+				= (NoIndex, NoIndex, NoIndex, selector_defs, modules, { cs & cs_error = checkError type_id " type not defined" cs_error })
+		get_field_nr mod_index sel_id No [{glob_object,glob_module}] selector_defs modules cs
+			| mod_index == glob_module
+				#! selector_offset = selector_defs.[glob_object].sd_field_nr
+				= (glob_module, glob_object, selector_offset, selector_defs, modules, cs)
+				#! selector_offset = modules.[glob_module].dcl_common.com_selector_defs.[glob_object].sd_field_nr
+				= (glob_module, glob_object, selector_offset, selector_defs, modules, cs)
+		get_field_nr mod_index sel_id No _  selector_defs modules cs=:{cs_error}
+			= (NoIndex, NoIndex, NoIndex, selector_defs, modules, { cs & cs_error = checkError sel_id " ambiguous selector specified" cs_error })
+
+		determine_selector :: !Index !Index !Index ![Global Index] !u:{# SelectorDef} !v:{# DclModule} -> (!Int, !Int, !u:{# SelectorDef}, !v:{# DclModule})
+		determine_selector mod_index type_mod_index type_index [] selector_defs modules
+			= (NoIndex, NoIndex, selector_defs, modules)
+		determine_selector mod_index type_mod_index type_index [{glob_module, glob_object} : selectors] selector_defs modules
+			| type_mod_index == glob_module
+				| type_mod_index == mod_index
+					#! selector_def = selector_defs.[glob_object]
+					| selector_def.sd_type_index == type_index
+						= (glob_object, selector_def.sd_field_nr, selector_defs, modules)
+						= determine_selector mod_index type_mod_index type_index selectors selector_defs modules
+					#! {dcl_common={com_selector_defs}} = modules.[glob_module]
+					#! selector_def = com_selector_defs.[glob_object]
+					| selector_def.sd_type_index == type_index
+						= (glob_object, selector_def.sd_field_nr, selector_defs, modules)
+						= determine_selector mod_index type_mod_index type_index selectors selector_defs modules
+				= determine_selector mod_index type_mod_index type_index selectors selector_defs modules
+
+	check_selector free_vars (PS_Array index_expr) e_input=:{ei_mod_index} e_state e_info cs
+		# (index_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars index_expr e_input e_state e_info cs
+		  (glob_select_symb, cs) = getPredefinedGlobalSymbol PD_ArraySelectFun PD_StdArray STE_Member 2 cs
+		  (new_info_ptr, es_expression_heap) = newPtr EI_Empty e_state.es_expression_heap
+		= (ArraySelection glob_select_symb new_info_ptr index_expr, free_vars, { e_state & es_expression_heap = es_expression_heap }, e_info, cs)
+
+
+buildLetExpression :: !(Env Expression FreeVar) !Bool !Expression !*ExpressionHeap  -> (!Expression, !*ExpressionHeap)
+buildLetExpression [] is_strict expr expr_heap
+	= (expr, expr_heap)
+buildLetExpression binds is_strict expr expr_heap
+	#  (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+	= (Let {let_strict = is_strict, let_binds = binds, let_expr = expr, let_info_ptr = let_expr_ptr }, expr_heap)
+
+checkLhssOfLocalDefs def_level mod_index (CollectedLocalDefs {loc_functions={ir_from,ir_to},loc_nodes}) e_state=:{es_var_heap,es_fun_defs} e_info cs
+	# (loc_defs, var_env, {ps_fun_defs,ps_var_heap}, e_info, cs)
+			= check_patterns def_level mod_index loc_nodes [] {ps_fun_defs = es_fun_defs, ps_var_heap = es_var_heap} e_info cs
+	  (es_fun_defs, cs_symbol_table, cs_error) = addLocalFunctionDefsToSymbolTable def_level ir_from ir_to ps_fun_defs cs.cs_symbol_table cs.cs_error
+	= (loc_defs, var_env, { e_state & es_fun_defs = es_fun_defs, es_var_heap = ps_var_heap }, e_info, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error })
+where
+	check_patterns def_level mod_index [ (_,node_def) : node_defs ] var_env var_store e_info cs
+		# (pattern, var_env, var_store, e_info, cs) = checkPattern def_level mod_index node_def.nd_dst No var_env var_store e_info cs
+		  (patterns, var_env, var_store, e_info, cs) = check_patterns def_level mod_index node_defs var_env var_store e_info cs
+		= ([{ node_def & nd_dst = pattern } : patterns], var_env, var_store, e_info, cs)
+	check_patterns def_level mod_index [] var_env var_store e_info cs
+		= ([], var_env, var_store, e_info, cs)
+
+
+checkRhssAndTransformLocalDefs free_vars [] rhs_expr e_input e_state e_info cs
+	= (rhs_expr, free_vars, e_state, e_info, cs)
+checkRhssAndTransformLocalDefs free_vars loc_defs rhs_expr e_input e_state e_info cs
+	# (binds, free_vars, e_state, e_info, cs) = checkAndTransformPatternIntoBind free_vars loc_defs e_input e_state e_info cs
+	  (rhs_expr, es_expression_heap) = buildLetExpression binds cIsNotStrict rhs_expr e_state.es_expression_heap
+	= (rhs_expr, free_vars, { e_state & es_expression_heap = es_expression_heap }, e_info, cs)
+
+checkAndTransformPatternIntoBind free_vars [{nd_dst,nd_alts,nd_locals} : local_defs] e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
+	# (bind_src, free_vars, e_state, e_info, cs) = checkRhs free_vars nd_alts nd_locals e_input e_state e_info cs	
+	  (binds_of_bind, es_var_heap, es_expression_heap, e_info, cs)
+			= transfromPatternIntoBind ei_mod_index ei_expr_level nd_dst bind_src e_state.es_var_heap e_state.es_expression_heap e_info cs
+	  e_state = { e_state & es_var_heap = es_var_heap, es_expression_heap = es_expression_heap }
+	  (binds_of_local_defs, free_vars, e_state, e_info, cs) = checkAndTransformPatternIntoBind free_vars local_defs e_input e_state e_info cs
+	= (binds_of_bind ++ binds_of_local_defs, free_vars, e_state, e_info, cs)
+checkAndTransformPatternIntoBind free_vars [] e_input e_state e_info cs
+	= ([], free_vars, e_state, e_info, cs)
+
+transfromPatternIntoBind :: !Index !Level !AuxiliaryPattern !Expression !*VarHeap !*ExpressionHeap !*ExpressionInfo !*CheckState
+	-> *(![Bind Expression FreeVar], !*VarHeap, !*ExpressionHeap,  !*ExpressionInfo, !*CheckState)
+transfromPatternIntoBind mod_index def_level (AP_Variable name var_info _) src_expr var_store expr_heap e_info cs
+	# bind = {bind_src = src_expr, bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = def_level, fv_count = 0 }}
+	= ([bind], var_store, expr_heap, e_info, cs)
+transfromPatternIntoBind mod_index def_level (AP_Algebraic cons_symbol=:{glob_module,glob_object=ds_cons=:{ds_arity, ds_index, ds_ident}} type_index args opt_var)
+		src_expr var_store expr_heap e_info=:{ef_type_defs,ef_modules} cs
+	# (src_expr, opt_var_bind, var_store, expr_heap) = bind_opt_var opt_var src_expr var_store expr_heap
+	| ds_arity == 0
+		= ([], var_store, expr_heap, e_info, { cs & cs_error = checkError ds_ident " constant not allowed in a node pattern" cs.cs_error})
+	# (is_tuple, cs) = is_tuple_symbol glob_module ds_index cs
+	| is_tuple
+		# (tuple_var, tuple_bind, var_store, expr_heap) = bind_match_expr src_expr opt_var_bind var_store expr_heap
+		= transform_sub_patterns mod_index def_level args ds_cons 0 tuple_var tuple_bind var_store expr_heap e_info cs
+		# ({td_rhs}, ef_type_defs, ef_modules) = get_type_def mod_index glob_module type_index ef_type_defs ef_modules
+		  e_info = { e_info & ef_type_defs = ef_type_defs, ef_modules = ef_modules }
+		= case td_rhs of
+			RecordType {rt_fields}
+				| size rt_fields == 1
+					-> transform_sub_patterns_of_record mod_index def_level args rt_fields glob_module 0 src_expr opt_var_bind var_store expr_heap e_info cs
+					# (record_var, record_bind, var_store, expr_heap)
+						= bind_match_expr src_expr opt_var_bind var_store expr_heap
+					-> transform_sub_patterns_of_record mod_index def_level args rt_fields glob_module 0 record_var record_bind var_store expr_heap e_info cs
+			_
+				| ds_arity == 1
+		  			# (binds, var_store, expr_heap, e_info, cs)
+						= transfromPatternIntoBind mod_index def_level (hd args) (MatchExpr No cons_symbol src_expr) var_store expr_heap e_info cs
+					-> (opt_var_bind ++ binds, var_store, expr_heap, e_info, cs)
+					# (tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex ds_arity) PD_PredefinedModule STE_Type ds_arity cs
+					  (tuple_cons, cs) = getPredefinedGlobalSymbol (GetTupleConsIndex ds_arity) PD_PredefinedModule STE_Constructor ds_arity cs
+					  (match_var, match_bind, var_store, expr_heap)
+						=  bind_match_expr (MatchExpr (Yes tuple_type) cons_symbol src_expr) opt_var_bind var_store expr_heap
+					-> transform_sub_patterns mod_index def_level args tuple_cons.glob_object 0 match_var match_bind var_store expr_heap e_info cs
+
+
+where
+	get_type_def mod_index type_mod_index type_index ef_type_defs ef_modules
+		| mod_index == type_mod_index
+			# (type_def, ef_type_defs) = ef_type_defs![type_index]
+			= (type_def, ef_type_defs, ef_modules)
+			# ({dcl_common},  ef_modules) = ef_modules![type_mod_index]
+			= (dcl_common.com_type_defs.[type_index], ef_type_defs, ef_modules)
+		
+	is_tuple_symbol cons_module cons_index cs
+		# (tuple_2_symbol, cs) = getPredefinedGlobalSymbol (GetTupleConsIndex 2) PD_PredefinedModule STE_Constructor 2 cs
+		= (tuple_2_symbol.glob_module == cons_module &&
+		   tuple_2_symbol.glob_object.ds_index <= cons_index && cons_index <= tuple_2_symbol.glob_object.ds_index + 30, cs)
+
+	transform_sub_patterns mod_index def_level [pattern : patterns] tup_id tup_index arg_var all_binds var_store expr_heap e_info cs
+		# match_expr = TupleSelect tup_id tup_index arg_var
+		  (binds, var_store, expr_heap, e_info, cs) = transfromPatternIntoBind mod_index def_level pattern match_expr var_store expr_heap e_info cs
+		= transform_sub_patterns mod_index def_level patterns tup_id (inc tup_index) arg_var (binds ++ all_binds) var_store expr_heap e_info cs
+	transform_sub_patterns mod_index _ [] _ _ _ binds var_store expr_heap e_info cs
+		= (binds, var_store, expr_heap, e_info, cs)
+
+	transform_sub_patterns_of_record mod_index def_level [pattern : patterns] fields field_module field_index record_expr
+			all_binds var_store expr_heap e_info cs
+		# {fs_name, fs_index} = fields.[field_index]
+		  selector = { glob_module = field_module, glob_object = MakeDefinedSymbol fs_name fs_index 1}
+		  (binds, var_store, expr_heap, e_info, cs)
+				= transfromPatternIntoBind mod_index def_level pattern (Selection No record_expr [ RecordSelection selector field_index ])
+						var_store expr_heap e_info cs
+		= transform_sub_patterns_of_record mod_index def_level patterns fields field_module (inc field_index) record_expr
+				(binds ++ all_binds) var_store expr_heap e_info cs
+	transform_sub_patterns_of_record mod_index _ [] _ _ _ _ binds var_store expr_heap e_info cs
+		= (binds, var_store, expr_heap, e_info, cs)
+
+	bind_opt_var (Yes {bind_src,bind_dst}) src_expr var_heap expr_heap
+		# free_var = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }
+		  (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+		  bound_var = { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }
+		= (Var bound_var, [{bind_src = src_expr, bind_dst = free_var}], var_heap, expr_heap)
+	bind_opt_var No src_expr var_heap expr_heap
+		= (src_expr, [], var_heap, expr_heap)
+		
+	bind_match_expr var_expr=:(Var var) opt_var_bind var_heap expr_heap
+		= (var_expr, opt_var_bind, var_heap, expr_heap)
+	bind_match_expr match_expr opt_var_bind var_heap expr_heap
+		# new_name = newVarId "_x"
+		  (var_info_ptr, var_heap) = newPtr VI_Empty var_heap
+		  (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+		  bound_var = { var_name = new_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr }
+		  free_var = { fv_name = new_name, fv_info_ptr = var_info_ptr, fv_def_level = def_level, fv_count = 0 }
+		= (Var bound_var, [{bind_src = match_expr, bind_dst = free_var} : opt_var_bind], var_heap, expr_heap)
+
+transfromPatternIntoBind mod_index def_level (AP_WildCard _) src_expr var_store expr_heap e_info cs
+	= ([], var_store, expr_heap, e_info, cs)
+transfromPatternIntoBind _ _ pattern src_expr var_store expr_heap e_info cs
+	= ([], var_store, expr_heap, e_info, { cs & cs_error = checkError "<pattern>" " illegal node pattern" cs.cs_error})
+
+checkLocalFunctions mod_index level (CollectedLocalDefs {loc_functions={ir_from,ir_to}}) fun_defs e_info heaps cs
+	= checkFunctions mod_index level ir_from ir_to fun_defs e_info heaps cs
+
+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, 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_expression_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_expression_heap = heaps.hp_expression_heap,
+								es_type_heaps = heaps.hp_type_heaps } e_info cs
+	  (expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs rhs_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_expression_heap) = convert_guards_to_cases rev_guarded_exprs default_expr e_state.es_expression_heap
+	  	= (result_expr, free_vars, { e_state & es_expression_heap = es_expression_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)] result_expr es_expression_heap
+		# (case_expr_ptr, es_expression_heap) = newPtr EI_Empty es_expression_heap
+		  case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [{bp_value = (BVB True), bp_expr = expr}],
+		  		case_default = result_expr, case_ident = No, case_info_ptr = case_expr_ptr }
+		= build_sequential_lets let_binds case_expr es_expression_heap
+	convert_guards_to_cases [(let_binds, guard, expr) : rev_guarded_exprs] result_expr es_expression_heap
+		# (case_expr_ptr, es_expression_heap) = newPtr EI_Empty es_expression_heap
+		  case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [{bp_value = (BVB True), bp_expr = expr}],
+		  		case_default = result_expr, case_ident = No, case_info_ptr = case_expr_ptr }
+		  (result_expr, es_expression_heap) = build_sequential_lets let_binds case_expr es_expression_heap
+		= convert_guards_to_cases rev_guarded_exprs (Yes result_expr) es_expression_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}
+			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 }
+	  	  (guard, free_vars, e_state, e_info, cs) = checkExpression free_vars alt_guard e_input e_state e_info 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) : rev_guarded_exprs], ei_expr_level, free_vars, e_state, e_info,  cs )
+
+	check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
+		# this_expr_level = inc ei_expr_level
+		  (loc_defs, var_env, 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
+	  	  (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 = { cs & cs_symbol_table = remove_seq_let_vars rhs_expr_level let_vars_list cs.cs_symbol_table }
+	  	  (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 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_expression_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
+		  (seq_let_expr, es_expression_heap) = build_sequential_lets binds expr heaps.hp_expression_heap
+	  	= (seq_let_expr, free_vars, {e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap,
+	  			es_expression_heap = es_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 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, 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_expression_heap, e_info, cs)
+				= transfromPatternIntoBind ei_mod_index ei_expr_level pattern_expr src_expr e_state.es_var_heap e_state.es_expression_heap e_info cs
+	    = ([(seq_let.ndwl_strict, let_binds) : binds], loc_envs, max_expr_level, free_vars, { e_state & es_var_heap = es_var_heap, es_expression_heap = es_expression_heap }, 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 free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
+		# (loc_defs, loc_env, 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) = 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_expression_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, let_vars, {ps_fun_defs,ps_var_heap}, e_info, cs) = checkPattern ei_expr_level ei_mod_index bind_dst No []
+		  			{ps_var_heap = hp_var_heap, ps_fun_defs = es_fun_defs } e_info { cs & cs_symbol_table = cs_symbol_table }
+		= (src_expr, pattern, let_vars, free_vars,
+			{ e_state & es_var_heap = ps_var_heap, es_expression_heap = hp_expression_heap, es_type_heaps = hp_type_heaps, es_fun_defs = ps_fun_defs },
+				e_info, cs)
+	
+	build_sequential_lets :: ![(Bool,[Bind Expression FreeVar])] !Expression !*ExpressionHeap -> (!Expression, !*ExpressionHeap)
+	build_sequential_lets [] expr expr_heap
+		= (expr, expr_heap)
+	build_sequential_lets [(nd_strict,[]) : seq_lets] expr expr_heap
+		= build_sequential_lets seq_lets expr expr_heap
+	build_sequential_lets [(nd_strict,binds) : seq_lets] expr expr_heap
+		# (let_expr, expr_heap) = build_sequential_lets seq_lets expr expr_heap
+	  	= buildLetExpression binds nd_strict let_expr expr_heap
+
+newVarId name = { id_name = name, id_info = nilPtr }
+
+determinePatternVariable (Yes bind) var_heap
+	= (bind, var_heap)
+determinePatternVariable No var_heap
+	# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+	= ({ bind_src = newVarId "_x", bind_dst = new_info_ptr }, var_heap)
+
+convertSubPatterns [] result_expr var_store expr_heap opt_dynamics cs
+	= ([], result_expr, var_store, expr_heap, opt_dynamics, cs)
+convertSubPatterns [pattern : patterns] result_expr var_store expr_heap opt_dynamics cs
+	# (var_args, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns patterns result_expr var_store expr_heap opt_dynamics cs
+	  (var_arg, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr var_store expr_heap opt_dynamics cs
+	= ([var_arg : var_args], result_expr, var_store, expr_heap, opt_dynamics, cs)
+
+convertSubPattern (AP_Variable name var_info (Yes {bind_src,bind_dst})) result_expr var_store expr_heap opt_dynamics cs
+	# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+	  bound_var = { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }
+	  free_var = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }
+	  (let_expr, expr_heap)	= buildLetExpression [{ bind_src = Var bound_var,
+	  			bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }}] cIsNotStrict result_expr expr_heap
+	= (free_var, let_expr, var_store, expr_heap, opt_dynamics, cs)
+convertSubPattern (AP_Variable name var_info No) result_expr var_store expr_heap opt_dynamics cs
+	= ({ fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr, var_store, expr_heap, opt_dynamics, cs)
+convertSubPattern (AP_Algebraic cons_symbol type_index args opt_var) result_expr var_store expr_heap opt_dynamics cs
+	# (var_args, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr var_store expr_heap opt_dynamics cs
+	  type_symbol = { glob_module = cons_symbol.glob_module, glob_object = type_index }
+	  case_guards = AlgebraicPatterns type_symbol [{ ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr }]
+	  ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
+	  (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+	  (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+	= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 },
+			Case { case_expr = Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr },
+				case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr }, var_store, expr_heap, opt_dynamics, cs)
+convertSubPattern (AP_Basic basic_val opt_var) result_expr var_store expr_heap opt_dynamics cs
+	# (basic_type, cs) = typeOfBasicValue basic_val cs
+	  case_guards = BasicPatterns basic_type [{ bp_value = basic_val, bp_expr = result_expr }]
+  	  ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
+	  (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+	  (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+	= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 },
+			Case { case_expr = Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr },
+				case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr}, var_store, expr_heap, opt_dynamics, cs)
+convertSubPattern (AP_Dynamic pattern type opt_var) result_expr var_store expr_heap opt_dynamics cs
+	# (var_arg, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr var_store expr_heap opt_dynamics cs
+ 	  ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store
+	  (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+	  (type_case_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
+	  (dynamic_info_ptr, expr_heap) = newPtr (EI_DynamicType type opt_dynamics) 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 }]
+	= ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 },
+			buildTypeCase (Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }) type_case_patterns No type_case_info_ptr,
+				var_store, expr_heap, [dynamic_info_ptr], cs)
+convertSubPattern (AP_WildCard opt_var) result_expr var_store expr_heap opt_dynamics cs
+ 	# ({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  }, result_expr, var_store, expr_heap, opt_dynamics, cs)
+convertSubPattern ap result_expr var_store expr_heap opt_dynamics cs
+	= abort ("convertSubPattern: unknown pattern " ---> ap) 
+
+
+typeOfBasicValue :: !BasicValue !*CheckState -> (!BasicType, !*CheckState)
+typeOfBasicValue (BVI _) cs = (BT_Int, cs)
+typeOfBasicValue (BVC _) cs = (BT_Char, cs)
+typeOfBasicValue (BVB _) cs = (BT_Bool, cs)
+typeOfBasicValue (BVR _) cs = (BT_Real, cs)
+typeOfBasicValue (BVS _) cs
+	# ({glob_module,glob_object={ds_ident,ds_index,ds_arity}}, cs) = getPredefinedGlobalSymbol PD_StringType PD_PredefinedModule STE_Type 0 cs
+	= (BT_String (TA (MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident ds_arity) []), cs)
+
+checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}} : bodies]) e_input=:{ei_expr_level,ei_mod_index}
+		e_state=:{es_var_heap, es_fun_defs} e_info cs
+	# (aux_patterns, var_env, {ps_var_heap, ps_fun_defs}, e_info, cs)
+			= check_patterns ei_expr_level ei_mod_index pb_args [] {ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs 
+	  (rhs_expr, free_vars, e_state=:{es_dynamics=dynamics_in_rhs}, 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
+	  cs_symbol_table = removeLocalIdentsFromSymbolTable ei_expr_level var_env cs.cs_symbol_table
+	  (cb_args, es_var_heap) = mapSt determine_function_arg aux_patterns e_state.es_var_heap
+	  (rhss, free_vars, e_state=:{es_dynamics,es_expression_heap,es_var_heap}, e_info, cs)
+	  		= check_function_bodies free_vars cb_args bodies e_input { e_state & es_var_heap = es_var_heap, es_dynamics = [] } e_info
+	  				{ cs & cs_symbol_table = cs_symbol_table }
+	  (rhs, es_var_heap, es_expression_heap, dynamics_in_patterns, cs)
+	  		= transform_patterns_into_cases aux_patterns cb_args rhs_expr es_var_heap es_expression_heap dynamics_in_rhs cs
+	= (CheckedBody { cb_args = cb_args, cb_rhs = [rhs : rhss] }, free_vars,
+		{ e_state & es_var_heap = es_var_heap, es_expression_heap = es_expression_heap, es_dynamics = dynamics_in_patterns ++ es_dynamics }, e_info, cs)
+
+where
+	check_patterns def_level mod_index [pattern : patterns] var_env var_store e_info cs
+		# (aux_pat, var_env, var_store, e_info, cs) = checkPattern def_level mod_index pattern No var_env var_store e_info cs
+		  (aux_pats, var_env, var_store, e_info, cs) = check_patterns def_level mod_index patterns var_env var_store e_info cs
+		= ([aux_pat : aux_pats], var_env, var_store, e_info, cs)
+	check_patterns def_level mod_index [] var_env var_store e_info cs
+		= ([], var_env, 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}} : bodies] e_input=:{ei_expr_level,ei_mod_index}
+			e_state=:{es_var_heap,es_fun_defs} e_info cs
+		# (aux_patterns, var_env, {ps_var_heap, ps_fun_defs}, e_info, cs)
+				= check_patterns ei_expr_level ei_mod_index pb_args [] {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=:{es_dynamics=dynamics_in_rhs}, e_info, cs) = checkRhs free_vars rhs_alts rhs_locals 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_expression_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, es_var_heap, es_expression_heap, dynamics_in_patterns, cs)
+		  		= transform_patterns_into_cases aux_patterns fun_args rhs_expr es_var_heap es_expression_heap dynamics_in_rhs cs
+		= ([rhs_expr : rhs_exprs], free_vars, { e_state & es_var_heap = es_var_heap, es_expression_heap = es_expression_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 var_store expr_heap opt_dynamics cs
+		# (patterns_expr, var_store, expr_heap, opt_dynamics, cs)
+				= transform_succeeding_patterns_into_cases patterns fun_args result_expr var_store expr_heap opt_dynamics cs
+		= transform_pattern_into_cases pattern fun_arg patterns_expr var_store expr_heap opt_dynamics cs
+	where
+		transform_succeeding_patterns_into_cases [] _ result_expr var_store expr_heap opt_dynamics cs
+			= (result_expr, var_store, expr_heap, opt_dynamics, cs)
+		transform_succeeding_patterns_into_cases [pattern : patterns] [fun_arg : fun_args] result_expr var_store expr_heap opt_dynamics cs
+			# (patterns_expr, var_store, expr_heap, opt_dynamics, cs)
+				= transform_succeeding_patterns_into_cases patterns fun_args result_expr var_store expr_heap opt_dynamics cs
+			= transform_pattern_into_cases pattern fun_arg patterns_expr var_store expr_heap opt_dynamics cs
+	transform_patterns_into_cases [] _ result_expr var_store expr_heap opt_dynamics cs
+		= (result_expr, var_store, expr_heap, opt_dynamics, cs)
+		
+	transform_pattern_into_cases :: !AuxiliaryPattern !FreeVar !Expression !*VarHeap !*ExpressionHeap ![DynamicPtr] !*CheckState
+		-> (!Expression, !*VarHeap, !*ExpressionHeap, ![DynamicPtr], !*CheckState)
+	transform_pattern_into_cases (AP_Variable name var_info opt_var) fun_arg=:{fv_info_ptr,fv_name} result_expr 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 = cIsStrict, let_binds = [
+								{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr },
+									bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }}],
+							  let_expr = result_expr, let_info_ptr = let_expr_ptr}, 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 = cIsStrict, let_binds = [
+								{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr1 },
+									bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }},
+								{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 },
+									bind_dst = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }}],
+							  let_expr = result_expr, let_info_ptr = let_expr_ptr}, var_store, expr_heap, opt_dynamics, cs)
+			No
+				| var_info == fv_info_ptr
+					-> (result_expr, 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 = cIsStrict, let_binds =
+									[{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr },
+										 bind_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }}],
+							  let_expr = result_expr, let_info_ptr = let_expr_ptr}, var_store, expr_heap, opt_dynamics, cs)
+	transform_pattern_into_cases (AP_Algebraic cons_symbol type_index args opt_var) fun_arg result_expr var_store expr_heap opt_dynamics cs
+		# (var_args, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr 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
+	  	  case_guards = AlgebraicPatterns type_symbol [{ ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr }]
+		  (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 },
+				var_store, expr_heap, opt_dynamics, cs)	
+	transform_pattern_into_cases (AP_Basic basic_val opt_var) fun_arg result_expr 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 }]
+		  (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 },
+			var_store, expr_heap, opt_dynamics, cs)	
+	transform_pattern_into_cases (AP_Dynamic pattern type opt_var) fun_arg result_expr var_store expr_heap opt_dynamics cs
+		# (var_arg, result_expr, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern pattern result_expr 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 }]
+		= (buildTypeCase act_var type_case_patterns No type_case_info_ptr, var_store, expr_heap, [dynamic_info_ptr], cs)	
+	transform_pattern_into_cases (AP_WildCard _) fun_arg result_expr var_store expr_heap opt_dynamics cs
+		= (result_expr, var_store, expr_heap, opt_dynamics, cs)	
+	transform_pattern_into_cases (AP_Empty name) fun_arg result_expr var_store expr_heap opt_dynamics cs
+		= (result_expr, 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 = cIsNotStrict, let_binds =
+						 		[{ bind_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 },
+											bind_dst = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }}],
+							  let_expr = result_expr, let_info_ptr = let_expr_ptr}, 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)
+
+initializeContextVariables :: ![TypeContext] !*VarHeap ->  (![TypeContext], !*VarHeap)
+initializeContextVariables contexts var_heap
+	= mapSt add_variable_to_context contexts var_heap
+where
+	add_variable_to_context context var_heap
+		# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+		= ({ context & tc_var = new_info_ptr}, var_heap)
+
+checkFunction :: !Index !Index !Level !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef},!*ExpressionInfo, !*Heaps, !*CheckState);
+checkFunction mod_index fun_index def_level fun_defs
+			e_info=:{ef_type_defs,ef_modules,ef_class_defs} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps} cs=:{cs_error}
+	#! fun_def = fun_defs.[fun_index]
+	# {fun_symb,fun_pos,fun_body,fun_type} = fun_def
+	  position = newPosition fun_symb fun_pos
+	  cs = { cs & cs_error = pushErrorAdmin position cs_error }
+	  (fun_type, ef_type_defs, ef_class_defs, ef_modules, hp_var_heap, hp_type_heaps, cs)
+			= check_function_type fun_type mod_index ef_type_defs ef_class_defs ef_modules hp_var_heap hp_type_heaps cs
+	  e_info  = { e_info & ef_type_defs = ef_type_defs, ef_class_defs = ef_class_defs, ef_modules = ef_modules }
+	  e_state = {   es_var_heap = hp_var_heap, es_expression_heap = hp_expression_heap, es_type_heaps = hp_type_heaps,
+	  				es_dynamics = [], es_calls = [], es_fun_defs = fun_defs }
+	  e_input = { ei_expr_level = inc def_level, ei_fun_index = fun_index, ei_fun_level = inc def_level, ei_mod_index = mod_index }
+	  (fun_body, free_vars, e_state, e_info, cs) = checkFunctionBodies fun_body e_input e_state e_info cs
+
+	# {es_fun_defs,es_calls,es_var_heap,es_expression_heap,es_type_heaps,es_dynamics} = e_state
+	  (ef_type_defs, ef_modules, es_type_heaps, es_expression_heap, cs) = 
+	  	checkDynamicTypes mod_index es_dynamics fun_type e_info.ef_type_defs e_info.ef_modules es_type_heaps es_expression_heap cs
+	  cs = { cs & cs_error = popErrorAdmin cs.cs_error }
+	  fun_info = { fun_def.fun_info & fi_calls = es_calls, fi_def_level = def_level, fi_free_vars = free_vars, fi_dynamics = es_dynamics }
+	  fun_defs = { es_fun_defs & [fun_index] = { fun_def & fun_body = fun_body, fun_index = fun_index, fun_info = fun_info, fun_type = fun_type}}
+	  (fun_defs, cs_symbol_table) = remove_calls_from_symbol_table fun_index def_level es_calls fun_defs cs.cs_symbol_table
+	= (fun_defs,
+			{ e_info & ef_type_defs = ef_type_defs, ef_modules = ef_modules },
+			{ heaps & hp_var_heap = es_var_heap, hp_expression_heap = es_expression_heap, hp_type_heaps = es_type_heaps }, 
+			{ cs & cs_symbol_table = cs_symbol_table })
+
+where
+	check_function_type (Yes ft) module_index type_defs class_defs modules var_heap type_heaps cs
+		# (ft, _, type_defs, class_defs, modules, type_heaps, cs) = checkSymbolType module_index ft SP_None type_defs class_defs modules type_heaps cs
+		  (st_context, var_heap) = initializeContextVariables ft.st_context var_heap
+		= (Yes { ft & st_context = st_context } , type_defs,  class_defs, modules, var_heap, type_heaps, cs)
+
+	check_function_type No module_index type_defs class_defs modules var_heap type_heaps cs
+		= (No, type_defs,  class_defs, modules, var_heap, type_heaps, cs)
+
+	remove_calls_from_symbol_table fun_index fun_level [{fc_index, fc_level} : fun_calls] fun_defs symbol_table
+		| fc_level <= fun_level
+			#! {fun_symb={id_info}} = fun_defs.[fc_index]
+			#! entry = sreadPtr id_info symbol_table
+			# (c,cs) = get_calls entry.ste_kind
+			| fun_index == c
+				= remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs (symbol_table <:= (id_info,{ entry & ste_kind = STE_FunctionOrMacro cs}))
+				= abort " Error in remove_calls_from_symbol_table"
+			= remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs symbol_table
+	remove_calls_from_symbol_table fun_index fun_level [] fun_defs symbol_table
+		= (fun_defs, symbol_table)
+
+	get_calls (STE_FunctionOrMacro [x:xs]) = (x,xs)
+
+			
+checkFunctions :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState)
+checkFunctions mod_index level from_index to_index fun_defs e_info heaps cs
+	| from_index == to_index
+		= (fun_defs, e_info, heaps, cs)
+		# (fun_defs, e_info, heaps, cs) = checkFunction mod_index from_index level fun_defs e_info heaps cs
+		= checkFunctions mod_index level (inc from_index) to_index fun_defs e_info heaps cs
+
+checkMacros ::  !Index !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
+	-> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState);
+checkMacros mod_index range fun_defs e_info heaps cs
+	# (fun_defs, e_info=:{ef_modules}, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table,cs_error})
+			= checkFunctions mod_index cGlobalScope range.ir_from range.ir_to fun_defs e_info heaps cs
+	  (fun_defs, ef_modules, hp_var_heap, hp_expression_heap, cs_symbol_table, cs_error)
+	  		= partitionateMacros range mod_index fun_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error
+	= (fun_defs, { e_info & ef_modules = ef_modules }, {heaps &  hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap},
+			{ cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error })
+
+checkInstanceBodies :: !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef},!*ExpressionInfo,!*Heaps, !*CheckState);
+checkInstanceBodies {ir_from, ir_to} fun_defs e_info heaps cs
+	= checkFunctions cIclModIndex cGlobalScope ir_from ir_to fun_defs e_info heaps cs
+
+instance < FunDef 
+where
+	(<) fd1 fd2 = fd1.fun_symb.id_name < fd2.fun_symb.id_name
+
+
+//createCommonDefinitions :: !(CollectedDefinitions ClassInstance) -> *CommonDefs
+createCommonDefinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances} var_heap
+	# (cons_defs, var_heap) = mapSt new_constructor def_constructors var_heap
+	  (sel_defs, var_heap) = mapSt new_selector def_selectors var_heap
+	=  ({	com_type_defs		= { type \\ type <- def_types }
+		,	com_cons_defs		= { cons \\ cons <- cons_defs }
+		,	com_selector_defs	= { sel \\ sel <- sel_defs }
+//		,	com_macro_defs		= { macro \\ macro <- def_macros }
+		,	com_class_defs		= { class_def \\ class_def <- def_classes }
+		,	com_member_defs		= { member \\ member <- def_members }
+		,	com_instance_defs	= { next_instance \\ next_instance <- def_instances }
+		}, var_heap)
+	where
+		new_constructor cons var_heap 
+			# (new_type_ptr, var_heap) = newPtr VI_Empty var_heap
+			= (ParsedConstructorToConsDef cons new_type_ptr, var_heap)
+
+		new_selector sel var_heap 
+			# (new_type_ptr, var_heap) = newPtr VI_Empty var_heap
+			= (ParsedSelectorToSelectorDef sel new_type_ptr, var_heap)
+			
+
+IsMainDclMod is_dcl module_index :== is_dcl && module_index == cIclModIndex
+
+/* MW was
+checkCommonDefinitions :: !Bool !Index !*CommonDefs !*{# DclModule} !*TypeHeaps !*VarHeap !*CheckState
+	-> (!*CommonDefs, !*{# DclModule}, !*TypeHeaps,  !*VarHeap, !*CheckState)
+checkCommonDefinitions is_dcl module_index common modules type_heaps var_heap cs
+	# (com_type_defs, com_cons_defs, com_selector_defs, modules, type_heaps, cs)
+			= checkTypeDefs (IsMainDclMod is_dcl module_index) common.com_type_defs module_index common.com_cons_defs common.com_selector_defs modules type_heaps cs
+	  (com_class_defs, com_member_defs, com_type_defs, modules, type_heaps, cs)
+	  		= checkTypeClasses 0 module_index common.com_class_defs common.com_member_defs com_type_defs modules type_heaps cs
+	  (com_member_defs, com_type_defs, com_class_defs, modules, type_heaps, var_heap, cs)
+	  		= checkMemberTypes module_index com_member_defs com_type_defs com_class_defs modules type_heaps var_heap cs
+	  (com_instance_defs, com_type_defs, com_class_defs, com_member_defs, modules, type_heaps, cs)
+	  		= checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs modules type_heaps cs
+	  (com_class_defs, modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, var_heap, cs)
+	  	= createClassDictionaries module_index com_class_defs modules (size com_type_defs) (size com_selector_defs)
+	  		(size com_cons_defs) type_heaps.th_vars var_heap cs
+	  com_type_defs = { type_def \\ type_def <- [ type_def \\ type_def <-: com_type_defs ] ++ new_type_defs }
+	  com_selector_defs = { sel_def \\ sel_def <- [ sel_def \\ sel_def <-: com_selector_defs ] ++ new_selector_defs }
+	  com_cons_defs = { cons_def \\ cons_def <- [ cons_def \\ cons_def <-: com_cons_defs ] ++ new_cons_defs }
+	= ({common & com_type_defs = com_type_defs, com_cons_defs = com_cons_defs, com_selector_defs = com_selector_defs, com_class_defs = com_class_defs,
+			com_member_defs = com_member_defs,  com_instance_defs = com_instance_defs }, modules, { type_heaps & th_vars = th_vars }, var_heap, cs)
+*/
+
+checkCommonDefinitions :: !Bool !Index !{#Int} !*CommonDefs !*{# DclModule} !*TypeHeaps !*VarHeap !*CheckState
+	-> (!*CommonDefs, !*{# DclModule}, !*TypeHeaps,  !*VarHeap, !*CheckState)
+checkCommonDefinitions is_dcl module_index upper_limits common modules type_heaps var_heap cs
+	# (com_type_defs, com_cons_defs, com_selector_defs, modules, type_heaps, cs)
+			= checkTypeDefs (IsMainDclMod is_dcl module_index) common.com_type_defs module_index upper_limits.[cTypeDefs]
+							common.com_cons_defs common.com_selector_defs modules type_heaps cs
+	  (com_class_defs, com_member_defs, com_type_defs, modules, type_heaps, cs)
+	  		= checkTypeClasses 0 module_index upper_limits.[cClassDefs] common.com_class_defs common.com_member_defs com_type_defs modules type_heaps cs
+	  (com_member_defs, com_type_defs, com_class_defs, modules, type_heaps, var_heap, cs)
+	  		= checkMemberTypes module_index upper_limits.[cMemberDefs] com_member_defs com_type_defs com_class_defs modules type_heaps var_heap cs
+	  (com_instance_defs, com_type_defs, com_class_defs, com_member_defs, modules, type_heaps, cs)
+	  		= checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs modules type_heaps cs
+	  (com_class_defs, modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, var_heap, cs)
+	  	= createClassDictionaries module_index com_class_defs modules (size com_type_defs) (size com_selector_defs)
+	  		(size com_cons_defs) upper_limits.[cClassDefs] type_heaps.th_vars var_heap cs
+	  com_type_defs = { type_def \\ type_def <- [ type_def \\ type_def <-: com_type_defs ] ++ new_type_defs }
+	  com_selector_defs = { sel_def \\ sel_def <- [ sel_def \\ sel_def <-: com_selector_defs ] ++ new_selector_defs }
+	  com_cons_defs = { cons_def \\ cons_def <- [ cons_def \\ cons_def <-: com_cons_defs ] ++ new_cons_defs }
+	= ({common & com_type_defs = com_type_defs, com_cons_defs = com_cons_defs, com_selector_defs = com_selector_defs, com_class_defs = com_class_defs,
+			com_member_defs = com_member_defs,  com_instance_defs = com_instance_defs }, modules, { type_heaps & th_vars = th_vars }, var_heap, cs)
+
+strictMapAppendi :: !(Index -> a -> b) !Index ![a] ![b] -> [b]
+strictMapAppendi f i [] t = t
+strictMapAppendi f i [x : xs] t
+	#! t = strictMapAppendi f (inc i) xs t
+	   el = f i x
+	= [el : t] 
+
+collectCommonfinitions :: !(CollectedDefinitions ClassInstance a) ![Declaration] -> [Declaration]
+collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances} defs
+	# defs = strictMapAppendi (\dcl_index {td_name} -> { dcl_ident = td_name, dcl_kind = STE_Type, dcl_index = dcl_index }) 0 def_types defs
+	  defs = strictMapAppendi (\dcl_index {pc_cons_name} -> { dcl_ident = pc_cons_name, dcl_kind = STE_Constructor, dcl_index = dcl_index }) 0 def_constructors defs
+	  defs = strictMapAppendi (\dcl_index {ps_selector_name,ps_field_name} -> { dcl_ident = ps_field_name, dcl_kind = STE_Field ps_selector_name, dcl_index = dcl_index }) 0 def_selectors defs
+	  defs = strictMapAppendi (\dcl_index {class_name} -> { dcl_ident = class_name, dcl_kind = STE_Class, dcl_index = dcl_index }) 0 def_classes defs
+	  defs = strictMapAppendi (\dcl_index {me_symb} -> { dcl_ident = me_symb, dcl_kind = STE_Member, dcl_index = dcl_index }) 0 def_members defs
+	  defs = strictMapAppendi (\dcl_index {ins_ident} -> { dcl_ident = ins_ident, dcl_kind = STE_Instance, dcl_index = dcl_index }) 0 def_instances defs
+	= defs
+
+collectMacros {ir_from,ir_to} defs macro_defs
+	= collectGlobalFunctions ir_from ir_to defs macro_defs 
+
+collectFunctionTypes fun_types defs
+	= strictMapAppendi (\dcl_index {ft_symb} -> { dcl_ident = ft_symb, dcl_kind = STE_DclFunction, dcl_index = dcl_index }) 0 fun_types defs
+
+collectGlobalFunctions from_index to_index defs fun_defs
+	| from_index == to_index
+		= (defs, fun_defs)
+		#! fun_def = fun_defs.[from_index]
+		   (defs, fun_defs) = collectGlobalFunctions (inc from_index) to_index defs fun_defs
+		= ([{ dcl_ident = fun_def.fun_symb, dcl_kind = STE_FunctionOrMacro [], dcl_index = from_index } : defs], fun_defs)
+
+combineDclAndIclModule MK_Main modules icl_defs cs
+// MW was	= (modules, cs)
+	= (modules, createArray cConversionTableSize [], cs)
+combineDclAndIclModule _ modules icl_defs cs
+/* MW was
+	#! dcl_mod = modules.[cIclModIndex]
+	# {dcl_declared={dcls_local},dcl_macros} = dcl_mod
+	  cs = addGlobalDefinitionsToSymbolTable icl_defs cs
+	  conversion_table = { createArray size NoIndex \\ size <-: count_defs (createArray cConversionTableSize 0) dcls_local }
+	  (conversion_table, cs) = build_conversion_table conversion_table dcls_local dcl_macros.ir_from cs
+	  cs_symbol_table = removeDeclarationsFromSymbolTable icl_defs cGlobalScope cs.cs_symbol_table
+	= ( { modules & [cIclModIndex] = { dcl_mod & dcl_conversions = Yes conversion_table }}, { cs & cs_symbol_table = cs_symbol_table })
+*/
+	#! dcl_mod = modules.[cIclModIndex]
+	# {dcl_declared={dcls_local},dcl_macros} = dcl_mod
+	  cs = addGlobalDefinitionsToSymbolTable icl_defs cs
+	  sizes	= count_defs (createArray cConversionTableSize 0) dcls_local
+	  conversion_table = { createArray size NoIndex \\ size <-: sizes }
+	  defs_only_in_dcl = { (size, []) \\ size <-: sizes }
+	  (conversion_table, defs_only_in_dcl_l, cs)
+	  		= build_conversion_table conversion_table dcls_local dcl_macros.ir_from defs_only_in_dcl cs
+	# cs_symbol_table = removeDeclarationsFromSymbolTable icl_defs cGlobalScope cs.cs_symbol_table
+	= ( { modules & [cIclModIndex] = { dcl_mod & dcl_conversions = Yes conversion_table }}
+	  , defs_only_in_dcl_l
+	  , { cs & cs_symbol_table = cs_symbol_table }
+	  )
+where
+// MW was	build_conversion_table conversion_table [{dcl_ident=ident=:{id_info},dcl_kind,dcl_index} : local_defs] first_macro_index cs=:{cs_symbol_table, cs_error}
+	build_conversion_table conversion_table [decl=:{dcl_ident=ident=:{id_info},dcl_kind,dcl_index} : local_defs]
+							first_macro_index defs_only_in_dcl cs=:{cs_symbol_table, cs_error}
+		#! entry = sreadPtr id_info cs_symbol_table
+		# {ste_kind,ste_index,ste_def_level} = entry
+/* MW was
+		| ste_def_level == cGlobalScope && ste_kind == dcl_kind
+			# def_index = toInt dcl_kind
+			  dcl_index = if (def_index == cMacroDefs) (dcl_index - first_macro_index) dcl_index
+			# conversion_table = { conversion_table & [def_index].[dcl_index] = ste_index }
+			= build_conversion_table conversion_table local_defs first_macro_index cs
+			= build_conversion_table conversion_table local_defs first_macro_index { cs & cs_error = checkError ident "inconsistently defined" cs_error }
+			= build_conversion_table conversion_table local_defs first_macro_index { cs & cs_error = checkError ident "inconsistently defined" cs_error }
+	build_conversion_table conversion_table [] first_macro_index cs
+		= (conversion_table, cs)
+*/
+		  def_index = toInt dcl_kind
+		  dcl_index = if (def_index == cMacroDefs) (dcl_index - first_macro_index) dcl_index
+		| ste_kind == STE_Empty && can_be_only_in_dcl dcl_kind
+			# ((top,defs), defs_only_in_dcl)	= defs_only_in_dcl![def_index]
+			  defs_only_in_dcl	= { defs_only_in_dcl & [def_index] = (inc top, [decl:defs])}
+			  conversion_table = { conversion_table & [def_index].[dcl_index] = top }
+			= build_conversion_table conversion_table local_defs first_macro_index defs_only_in_dcl cs
+		| ste_def_level == cGlobalScope && ste_kind == dcl_kind
+			# conversion_table = { conversion_table & [def_index].[dcl_index] = ste_index }
+			= build_conversion_table conversion_table local_defs first_macro_index defs_only_in_dcl cs
+		= build_conversion_table conversion_table local_defs first_macro_index defs_only_in_dcl
+								{ cs & cs_error = checkError ident "inconsistently defined" cs_error }
+	build_conversion_table conversion_table [] first_macro_index defs_only_in_dcl cs
+		= (conversion_table, {reverse decls \\ (_,decls) <-: defs_only_in_dcl}, cs)
+
+// MW..
+	can_be_only_in_dcl STE_Type					= True
+	can_be_only_in_dcl STE_Constructor			= True
+	can_be_only_in_dcl (STE_Field _)			= True
+	can_be_only_in_dcl STE_Class				= True
+	can_be_only_in_dcl STE_Member				= True
+	can_be_only_in_dcl (STE_FunctionOrMacro _)	= True
+	can_be_only_in_dcl STE_DclFunction			= False
+	can_be_only_in_dcl _						= False
+// .. MW
+
+	count_defs :: !*{# Int} ![Declaration] -> *{# Int}
+	count_defs def_counts []
+		= def_counts
+	count_defs def_counts [{dcl_kind} : local_defs]
+		#  def_index = toInt dcl_kind
+		#! count = def_counts.[def_index]
+		= count_defs { def_counts & [def_index] = inc count } local_defs
+	
+/* MW moved 
+cIsNotADclModule 	:== False
+cIsADclModule 		:== True
+*/
+
+(<=<) infixl 
+(<=<) state fun :== fun state 
+
+
+checkModule :: !ScannedModule !Int ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File
+	-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
+checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} nr_of_global_funs fun_defs dcl_mod pre_def_mod scanned_modules predef_symbols symbol_table err_file
+	# error = {ea_file = err_file, ea_loc = [], ea_ok = True }
+
+	  first_inst_index = length fun_defs
+	  
+	  (inst_fun_defs, def_instances) = convert_class_instances cdefs.def_instances first_inst_index
+	  icl_functions = { next_fun \\ next_fun <- fun_defs ++ inst_fun_defs }
+	  cdefs = { cdefs & def_instances = def_instances }
+	#! nr_of_functions = size icl_functions
+
+	# local_defs = collectCommonfinitions cdefs []
+	  (local_defs, icl_functions) = collectGlobalFunctions 0 nr_of_global_funs local_defs icl_functions
+	  (local_defs, icl_functions) = collectMacros cdefs.def_macros local_defs icl_functions
+
+	  (scanned_modules, icl_functions, cs)
+	  		= add_modules_to_symbol_table [ dcl_mod, pre_def_mod : scanned_modules ] 0 icl_functions
+	  				{ cs_symbol_table = symbol_table, cs_predef_symbols = predef_symbols, cs_error = error }
+	  
+	  (init_dcl_modules, hp_var_heap) = mapSt initialDclModule scanned_modules newHeap
+// MW was 	  (dcl_modules, cs)
+	  (dcl_modules, defs_only_in_main_dcl, cs)
+	  		= combineDclAndIclModule mod_type { dcl_module \\ dcl_module <- init_dcl_modules } local_defs cs
+
+	  heaps = { hp_var_heap = hp_var_heap, hp_expression_heap = newHeap, hp_type_heaps = { th_vars = newHeap, th_attrs = newHeap }}
+
+	  (dcl_modules, icl_functions, heaps, cs)
+	  		= check_predefined_module pre_def_mod.mod_name dcl_modules icl_functions heaps cs
+
+	  iinfo = {	ii_modules = dcl_modules, ii_funs_and_macros = icl_functions, ii_next_num = 0, ii_deps = [] }
+
+	  (iinfo, heaps, cs) = check_dcl_module iinfo heaps cs
+
+	  (_, {ii_modules,ii_funs_and_macros = icl_functions}, heaps, cs) = checkImports mod_imports iinfo heaps cs
+
+	  (nr_of_modules, (f_consequences, ii_modules, icl_functions, hp_expression_heap, cs))
+	  	= check_completeness_of_all_dcl_modules ii_modules icl_functions heaps.hp_expression_heap cs
+
+	  all_defs_only_in_main_dcl =	  defs_only_in_main_dcl.[cTypeDefs]++defs_only_in_main_dcl.[cConstructorDefs]
+	  							++defs_only_in_main_dcl.[cSelectorDefs]++defs_only_in_main_dcl.[cClassDefs]
+	  							++defs_only_in_main_dcl.[cMemberDefs]++defs_only_in_main_dcl.[cMacroDefs]
+
+	  (dcls_explicit, dcl_modules, cs) = addImportsToSymbolTable mod_imports [] ii_modules cs
+	  cs			    = addGlobalDefinitionsToSymbolTable (local_defs++all_defs_only_in_main_dcl) cs
+
+	  (_, dcl_modules, icl_functions, hp_expression_heap, cs)
+		= check_completeness_of_module nr_of_modules dcls_explicit (mod_name.id_name+++".icl")
+							 (f_consequences, dcl_modules, icl_functions, hp_expression_heap, cs)
+
+	  heaps	= { heaps & hp_expression_heap=hp_expression_heap }
+
+	  (icl_common, hp_var_heap) = createCommonDefinitions cdefs heaps.hp_var_heap
+
+	  (main_dcl_module, dcl_modules)	= dcl_modules![cIclModIndex]
+
+	  (upper_limits, icl_common)	= get_upper_limits icl_common
+
+	  icl_common	= add_defs_only_in_main_dcl defs_only_in_main_dcl main_dcl_module icl_common
+
+	  (icl_common, dcl_modules, hp_type_heaps, hp_var_heap, cs)
+	  		= checkCommonDefinitions cIsNotADclModule cIclModIndex upper_limits icl_common dcl_modules heaps.hp_type_heaps hp_var_heap cs
+	  
+	  (instance_types, icl_common, dcl_modules, hp_var_heap, hp_type_heaps, cs)
+	  		= checkInstances cIclModIndex icl_common dcl_modules hp_var_heap hp_type_heaps cs
+
+	  heaps = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap }
+
+	  e_info = { ef_type_defs = icl_common.com_type_defs, ef_selector_defs = icl_common.com_selector_defs, ef_class_defs = icl_common.com_class_defs, 
+	  			  ef_cons_defs = icl_common.com_cons_defs, ef_member_defs = icl_common.com_member_defs, ef_modules = dcl_modules }
+
+	  (icl_functions, e_info, heaps, cs) = checkMacros cIclModIndex cdefs.def_macros icl_functions e_info heaps cs
+	  (icl_functions, e_info, heaps, cs) = checkFunctions cIclModIndex cGlobalScope 0 nr_of_global_funs icl_functions e_info heaps cs
+
+	  (icl_functions, e_info, heaps, {cs_symbol_table, cs_predef_symbols, cs_error})
+	  	= checkInstanceBodies {ir_from = first_inst_index, ir_to = nr_of_functions} icl_functions e_info heaps cs
+	  (icl_imported, dcl_modules, cs_symbol_table) = retrieveImportsFromSymbolTable mod_imports [] e_info.ef_modules cs_symbol_table
+	| cs_error.ea_ok
+		# {hp_var_heap,hp_type_heaps,hp_expression_heap} = heaps
+		  (spec_functions, dcl_modules, class_instances, icl_functions, new_nr_of_functions, dcl_icl_conversions, var_heap, th_vars, expr_heap)
+				= collect_specialized_functions_in_dcl_module dcl_modules icl_common.com_instance_defs icl_functions nr_of_functions
+							hp_var_heap hp_type_heaps.th_vars hp_expression_heap
+		  icl_global_function_range = {ir_from = 0, 				ir_to = nr_of_global_funs}
+		  icl_instances				= {ir_from = first_inst_index,	ir_to = nr_of_functions}
+		  icl_specials				= {ir_from = nr_of_functions,	ir_to = new_nr_of_functions}
+		  icl_functions = copy_instance_types instance_types { icl_fun \\ icl_fun <- [ icl_fun \\ icl_fun <-: icl_functions ] ++ spec_functions }
+
+		  (dcl_modules, class_instances, icl_functions, cs_predef_symbols)
+		  		= adjust_instance_types_of_array_functions_in_std_array_icl dcl_modules class_instances icl_functions cs_predef_symbols
+
+		  (groups, icl_functions, dcl_modules, var_heap, expr_heap, cs_symbol_table, cs_error)
+		  		= partitionateAndLiftFunctions [icl_global_function_range, icl_instances] cIclModIndex icl_functions
+		  			dcl_modules var_heap expr_heap cs_symbol_table cs_error
+		  icl_common	= { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs,
+			  	 			  com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, com_instance_defs = class_instances }	  			  
+		  icl_mod		= { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common, icl_instances = icl_instances, icl_specials = icl_specials,
+// MW was	  			  			icl_declared = {dcls_local = local_defs, dcls_import = icl_imported} }
+// RWS ...
+									icl_imported_objects = mod_imported_objects,
+// ... RWS
+	  			  			icl_declared = {dcls_local = local_defs, dcls_import = icl_imported, dcls_explicit=dcls_explicit} }
+		= (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions,
+				{ heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = { hp_type_heaps & th_vars = th_vars }},
+				cs_predef_symbols, cs_symbol_table, cs_error.ea_file)
+		# icl_common	= { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs,
+			  	 			  com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs }	  			  
+		  icl_mod		= { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common,
+		  					icl_instances = {ir_from = first_inst_index, ir_to = nr_of_functions},
+		  					icl_specials = {ir_from = nr_of_functions, ir_to = nr_of_functions},
+// MW was		    		  			icl_declared = {dcls_local = local_defs, dcls_import = icl_imported} }
+// RWS ...
+									icl_imported_objects = mod_imported_objects,
+// ... RWS
+	    		  			icl_declared = {dcls_local = local_defs, dcls_import = icl_imported, dcls_explicit=dcls_explicit} }
+		= (False, icl_mod, dcl_modules, {}, No, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file)
+	where
+		convert_class_instances [pi=:{pi_members} : pins] next_fun_index
+			# ins_members = sort pi_members
+			  (member_symbols, next_fun_index) = determine_indexes_of_members ins_members next_fun_index
+			  (next_fun_defs, cins) =  convert_class_instances pins next_fun_index
+			= (ins_members ++ next_fun_defs, [ParsedInstanceToClassInstance pi { member \\ member <- member_symbols} : cins])
+		convert_class_instances [] next_fun_index
+			= ([], [])
+
+		determine_indexes_of_members [{fun_symb,fun_arity}:members] next_fun_index
+			#! (member_symbols, last_fun_index) = determine_indexes_of_members members (inc next_fun_index)
+			= ([{ds_ident = fun_symb, ds_index = next_fun_index, ds_arity = fun_arity} : member_symbols], last_fun_index)
+		determine_indexes_of_members [] next_fun_index
+			= ([], next_fun_index)
+
+		add_modules_to_symbol_table [] mod_index macro_and_fun_defs cs=:{cs_predef_symbols,cs_symbol_table}
+			# (cs_predef_symbols, cs_symbol_table) = (cs_predef_symbols, cs_symbol_table) 
+					<=< adjust_predefined_module_symbol PD_StdArray
+					<=< adjust_predefined_module_symbol PD_StdEnum
+					<=< adjust_predefined_module_symbol PD_StdBool
+					<=< adjust_predefined_module_symbol PD_StdDynamics
+					<=< adjust_predefined_module_symbol PD_PredefinedModule
+			= ([], macro_and_fun_defs, { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table})
+		where
+			adjust_predefined_module_symbol :: !Index !(!*PredefinedSymbols, !*SymbolTable) -> (!*PredefinedSymbols, !*SymbolTable)
+			adjust_predefined_module_symbol predef_index (pre_def_symbols, symbol_table)
+				# (mod_symb, pre_def_symbols) = pre_def_symbols![predef_index]
+				#! mod_entry = sreadPtr mod_symb.pds_ident.id_info symbol_table
+				= case mod_entry.ste_kind of
+					STE_Module _
+						-> ({ pre_def_symbols & [predef_index] = { mod_symb & pds_module = cIclModIndex, pds_def =  mod_entry.ste_index }}, symbol_table)
+					_
+						-> (pre_def_symbols, symbol_table)
+
+		add_modules_to_symbol_table [mod=:{mod_defs} : mods] mod_index macro_and_fun_defs cs=:{cs_predef_symbols,cs_symbol_table, cs_error}
+			# def_instances	= convert_class_instances mod_defs.def_instances
+			  mod_defs = { mod_defs & def_instances = def_instances }
+			  defs = collectFunctionTypes mod_defs.def_funtypes (collectCommonfinitions mod_defs [])
+			  (defs, macro_and_fun_defs) = collectMacros mod_defs.def_macros defs macro_and_fun_defs
+  			  mod = { mod & mod_defs = mod_defs }
+		   	  (cs_symbol_table, cs_error) = addDefToSymbolTable cGlobalScope mod_index mod.mod_name (STE_Module mod) cs_symbol_table cs_error
+			  (mods, macro_and_fun_defs, cs)
+			  		= add_modules_to_symbol_table mods (inc mod_index) macro_and_fun_defs { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }
+			= ([(mod, defs) : mods], macro_and_fun_defs, cs)
+		where
+			convert_class_instances :: ![ParsedInstance a] -> [ClassInstance]
+			convert_class_instances [pi : pins]
+				= [ParsedInstanceToClassInstance pi {} : convert_class_instances pins]
+			convert_class_instances []
+				= []
+
+		check_predefined_module {id_info} modules macro_and_fun_defs heaps cs=:{cs_symbol_table}
+			#! entry = sreadPtr id_info cs_symbol_table
+			# cs = { cs & cs_symbol_table = cs_symbol_table <:= (id_info, { entry & ste_kind = STE_ClosedModule })}
+			  {ste_kind = STE_Module mod, ste_index} = entry
+			  (modules, macro_and_fun_defs, heaps, cs)
+			  		= checkDclModule mod ste_index modules macro_and_fun_defs heaps cs
+			  ({dcl_declared={dcls_import,dcls_local}}, modules) = modules![ste_index]
+			= (modules, macro_and_fun_defs, heaps, addDeclaredSymbolsToSymbolTable cIsADclModule ste_index dcls_local dcls_import cs)
+
+		check_dcl_module iinfo=:{ii_modules} heaps cs=:{cs_symbol_table}
+			#! dcl_mod = ii_modules.[cIclModIndex]
+			#  dcl_info = dcl_mod.dcl_name.id_info			
+			#! entry = sreadPtr dcl_info cs_symbol_table
+			# (_, iinfo, heaps, cs) = checkImport dcl_info entry iinfo heaps cs
+			= (iinfo, heaps, cs)
+
+		collect_specialized_functions_in_dcl_module :: !w:{# DclModule} !v:{# ClassInstance} !u:{# FunDef} !Index !*VarHeap !*TypeVarHeap !*ExpressionHeap
+			-> (![FunDef], !w:{# DclModule}, !v:{# ClassInstance}, !u:{# FunDef}, !Index, !(Optional {# Index}), !*VarHeap,  !*TypeVarHeap, !*ExpressionHeap)
+ 		collect_specialized_functions_in_dcl_module modules icl_instances icl_functions first_free_index var_heap type_var_heap expr_heap
+			#! dcl_mod = modules.[cIclModIndex]
+			# {dcl_specials,dcl_functions,dcl_common,dcl_class_specials,dcl_conversions} = dcl_mod
+			= case dcl_conversions of
+				Yes conversion_table
+					# (new_conversion_table, icl_instances)
+					  		= build_conversion_table_for_instances_of_dcl_mod dcl_specials first_free_index
+					  				dcl_functions dcl_common.com_instance_defs conversion_table icl_instances
+					  (spec_fun_defs, (icl_functions, last_index, (var_heap, type_var_heap, expr_heap)))
+							= collect_specialized_functions dcl_specials.ir_from dcl_specials.ir_to dcl_functions new_conversion_table
+									(icl_functions, first_free_index, (var_heap, type_var_heap, expr_heap))
+					-> (spec_fun_defs, modules, icl_instances, icl_functions, last_index, Yes new_conversion_table, var_heap, type_var_heap, expr_heap)
+				No
+					-> ([], modules, icl_instances, icl_functions, first_free_index, No, var_heap, type_var_heap, expr_heap)
+		where
+			build_conversion_table_for_instances_of_dcl_mod {ir_from,ir_to} first_free_index dcl_functions dcl_instances conversion_table icl_instances
+				#! nr_of_dcl_functions = size dcl_functions
+				# dcl_instances_table = conversion_table.[toInt STE_Instance]
+				  dcl_function_table = conversion_table.[toInt STE_DclFunction]
+				  new_table = { createArray nr_of_dcl_functions NoIndex & [i] = icl_index \\ icl_index <-: dcl_function_table & i <- [0..] }
+				  index_diff = first_free_index - ir_from
+				  new_table = { new_table & [i] = i + index_diff \\ i <- [ir_from .. ir_to - 1] }
+				= build_conversion_table_for_instances 0 dcl_instances dcl_instances_table icl_instances new_table
+
+			build_conversion_table_for_instances dcl_class_inst_index dcl_instances class_instances_table icl_instances new_table 
+				| dcl_class_inst_index < size class_instances_table
+					# icl_index = class_instances_table.[dcl_class_inst_index]
+					#! icl_instance = icl_instances.[icl_index]
+					   dcl_instance = dcl_instances.[dcl_class_inst_index]
+					# new_table = build_conversion_table_for_instances_of_members 0 dcl_instance.ins_members icl_instance.ins_members new_table
+					= build_conversion_table_for_instances (inc dcl_class_inst_index) dcl_instances class_instances_table icl_instances new_table
+					= (new_table, icl_instances)
+			
+			build_conversion_table_for_instances_of_members mem_index dcl_members icl_members new_table
+				| mem_index < size dcl_members
+					# dcl_member = dcl_members.[mem_index]
+					  icl_member = icl_members.[mem_index]
+					= build_conversion_table_for_instances_of_members (inc mem_index) dcl_members icl_members
+						{ new_table & [dcl_member.ds_index] = icl_member.ds_index }
+					= new_table
+			
+			collect_specialized_functions spec_index last_index dcl_fun_types conversion_table (icl_functions, next_fun_index, heaps)
+				| spec_index < last_index
+					# {ft_type,ft_specials = SP_FunIndex dcl_index} = dcl_fun_types.[spec_index]
+					  icl_index = conversion_table.[dcl_index]
+					#! icl_fun = icl_functions.[icl_index]
+					   (new_fun_def, heaps) = build_function next_fun_index icl_fun ft_type heaps
+					   (new_fun_defs, funs_index_heaps)
+					   	= collect_specialized_functions (inc spec_index) last_index dcl_fun_types conversion_table (icl_functions, inc next_fun_index, heaps)
+					= ([new_fun_def : new_fun_defs], funs_index_heaps) 
+					= ([], (icl_functions, next_fun_index, heaps))
+		 
+			build_function new_fun_index fun_def=:{fun_symb, fun_arity, fun_index, fun_body = CheckedBody {cb_args}, fun_info} fun_type
+						(var_heap, type_var_heap, expr_heap)
+				# (tb_args, var_heap) = mapSt new_free_var cb_args var_heap
+				  (app_args, expr_heap) = mapSt new_bound_var tb_args expr_heap
+				  (app_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
+				  tb_rhs = App { app_symb = {	symb_name = fun_symb, symb_arity = fun_arity,
+												symb_kind = SK_Function { glob_module = cIclModIndex, glob_object = fun_index }},
+								 app_args = app_args,
+								 app_info_ptr = app_info_ptr }
+				= ({ fun_def & fun_index = new_fun_index, fun_body = TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}, fun_type = Yes fun_type,
+						fun_info = { EmptyFunInfo & fi_calls = [ { fc_index = fun_index, fc_level = cGlobalScope }] }},
+					(var_heap, type_var_heap, expr_heap))
+		
+		new_bound_var :: !FreeVar !*ExpressionHeap -> (!Expression, !*ExpressionHeap)
+		new_bound_var {fv_name,fv_info_ptr} 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 }, expr_heap)
+
+		new_free_var :: !FreeVar *VarHeap -> (!FreeVar, !*VarHeap)
+		new_free_var fv var_heap
+			# (fv_info_ptr, var_heap) = newPtr VI_Empty var_heap
+			= ({ fv & fv_info_ptr = fv_info_ptr, fv_def_level = NotALevel, fv_count = 0}, var_heap)
+			
+		copy_instance_types :: [(Index,SymbolType)] !*{# FunDef} -> !*{# FunDef}
+		copy_instance_types types fun_defs 
+			= foldl copy_instance_type fun_defs types
+		copy_instance_type fun_defs (index, symbol_type)
+			#! inst_def = fun_defs.[index]
+			= { fun_defs & [index] = { inst_def & fun_type = Yes symbol_type }}
+		
+		adjust_instance_types_of_array_functions_in_std_array_icl dcl_modules class_instances fun_defs predef_symbols
+			# ({pds_def}, predef_symbols) = predef_symbols![PD_StdArray]
+			| pds_def == cIclModIndex
+				#! nr_of_instances = size class_instances
+				# ({dcl_common, dcl_conversions = Yes conversion_table}, dcl_modules) = dcl_modules![cIclModIndex]
+				  ({pds_def}, predef_symbols) = predef_symbols![PD_ArrayClass]
+				  (offset_table, _, predef_symbols) = arrayFunOffsetToPD_IndexTable dcl_common.com_member_defs predef_symbols
+				  array_class_index = conversion_table.[cClassDefs].[pds_def]
+				  (class_instances, fun_defs, predef_symbols) 
+					= iFoldSt (adjust_instance_types_of_array_functions array_class_index offset_table) 0 nr_of_instances
+						(class_instances, fun_defs, predef_symbols)
+				= (dcl_modules, class_instances, fun_defs, predef_symbols)
+				= (dcl_modules, class_instances, fun_defs, predef_symbols)
+		where
+			adjust_instance_types_of_array_functions array_class_index offset_table inst_index (class_instances, fun_defs, predef_symbols)
+				# ({ins_class={glob_module,glob_object={ds_index}},ins_type,ins_members}, class_instances) = class_instances![inst_index]
+				| glob_module == cIclModIndex && ds_index == array_class_index && elemTypeIsStrict ins_type.it_types predef_symbols
+					# fun_defs = iFoldSt (make_instance_strict ins_members offset_table) 0 (size ins_members) fun_defs
+					= (class_instances, fun_defs, predef_symbols)
+					= (class_instances, fun_defs, predef_symbols)
+			
+			make_instance_strict instances offset_table ins_offset instance_defs
+				# {ds_index} = instances.[ins_offset]
+				  (inst_def, instance_defs) = instance_defs![ds_index]
+				  (Yes symbol_type) = inst_def.fun_type
+				= { instance_defs & [ds_index] = { inst_def & fun_type = Yes (makeElemTypeOfArrayFunctionStrict symbol_type ins_offset offset_table) } }
+
+// MW..
+get_upper_limits icl_common=:{com_type_defs, com_cons_defs, com_selector_defs, com_class_defs
+								,com_member_defs, com_instance_defs}
+	#	(size_type_defs, com_type_defs)	= usize com_type_defs
+		(size_cons_defs, com_cons_defs)	= usize com_cons_defs
+		(size_selector_defs, com_selector_defs)	= usize com_selector_defs
+		(size_class_defs, com_class_defs)	= usize com_class_defs
+		(size_member_defs, com_member_defs)	= usize com_member_defs
+		(size_instance_defs, com_instance_defs)	= usize com_instance_defs
+		upper_limits	= { createArray cConversionTableSize 0
+							&	[cTypeDefs]=size_type_defs
+							,	[cConstructorDefs]=size_cons_defs
+							,	[cSelectorDefs]=size_selector_defs
+							,	[cClassDefs]=size_class_defs
+							,	[cMemberDefs]=size_member_defs
+							,	[cInstanceDefs]=size_instance_defs
+						  }
+	= (upper_limits,	{ com_type_defs		=com_type_defs
+						, com_cons_defs		=com_cons_defs
+						, com_selector_defs	=com_selector_defs
+						, com_class_defs	=com_class_defs
+						, com_member_defs	=com_member_defs
+						, com_instance_defs	=com_instance_defs
+						})
+// ..MW
+
+// MW..
+add_defs_only_in_main_dcl defs_only_in_main_dcl {dcl_common} icl_common
+	= { icl_common
+		& com_type_defs	= append_array_and_list icl_common.com_type_defs
+											    [ dcl_common.com_type_defs.[dcl_index]
+								  					\\ {dcl_index} <- defs_only_in_main_dcl.[cTypeDefs]]
+		, com_cons_defs	= append_array_and_list icl_common.com_cons_defs
+											    [ dcl_common.com_cons_defs.[dcl_index]
+								  					\\ {dcl_index} <- defs_only_in_main_dcl.[cConstructorDefs]]
+		, com_selector_defs	= append_array_and_list icl_common.com_selector_defs
+											    [ dcl_common.com_selector_defs.[dcl_index]
+								  					\\ {dcl_index} <- defs_only_in_main_dcl.[cSelectorDefs]]
+		, com_class_defs	= append_array_and_list icl_common.com_class_defs
+											    [ dcl_common.com_class_defs.[dcl_index]
+								  					\\ {dcl_index} <- defs_only_in_main_dcl.[cClassDefs]]
+		, com_member_defs	= append_array_and_list icl_common.com_member_defs
+											    [ dcl_common.com_member_defs.[dcl_index]
+								  					\\ {dcl_index} <- defs_only_in_main_dcl.[cMemberDefs]]
+	  }
+  where
+	append_array_and_list a []
+		= a
+	append_array_and_list a l
+		= { el \\ el <- [el \\ el<-:a]++l}
+// ..MW
+
+arrayFunOffsetToPD_IndexTable member_defs predef_symbols
+	# nr_of_array_functions = size member_defs
+	= iFoldSt offset_to_PD_index PD_CreateArrayFun (PD_CreateArrayFun + nr_of_array_functions)
+			(createArray nr_of_array_functions NoIndex, member_defs, predef_symbols)
+where	
+	offset_to_PD_index pd_index (table, member_defs, predef_symbols)
+		# ({pds_def}, predef_symbols) = predef_symbols![pd_index]
+		#! {me_offset} = member_defs.[pds_def]
+		= ({ table & [me_offset] = pd_index }, member_defs, predef_symbols)
+
+elemTypeIsStrict [TA {type_index={glob_object,glob_module}} _ : _] predef_symbols
+	= glob_module == predef_symbols.[PD_PredefinedModule].pds_def &&
+		(glob_object == predef_symbols.[PD_StrictArrayType].pds_def || glob_object == predef_symbols.[PD_UnboxedArrayType].pds_def)
+
+makeElemTypeOfArrayFunctionStrict st=:{st_args,st_result} me_offset offset_table
+	# array_fun_kind = offset_table.[me_offset]
+	| array_fun_kind == PD_UnqArraySelectFun
+		# (TA tuple [elem : res_array]) = st_result.at_type
+		= { st & st_result = { st_result &  at_type = TA tuple [{ elem & at_annotation = AN_Strict } : res_array]}}
+	| array_fun_kind == PD_ArrayUpdateFun
+		# [array, index, elem: _] = st_args
+		= { st & st_args = [array, index, { elem & at_annotation = AN_Strict }] }
+	| array_fun_kind == PD_CreateArrayFun
+		# [array, elem: _] = st_args
+		= { st & st_args = [array, { elem & at_annotation = AN_Strict }] }
+	| array_fun_kind == PD_ArrayReplaceFun
+		# [arg_array, index, elem: _] = st_args
+		  (TA tuple [elem : res_array]) = st_result.at_type
+		= { st & st_args = [arg_array, index, { elem & at_annotation = AN_Strict }],
+					st_result = { st_result &  at_type = TA tuple [{ elem & at_annotation = AN_Strict } : res_array]}}
+		= st
+
+
+::	ImportInfo =
+	{	ii_modules			:: !.{# DclModule}
+	,	ii_funs_and_macros	:: !.{# FunDef}
+	,	ii_next_num			:: !Int
+	,	ii_deps				:: ![SymbolPtr]
+	}
+	
+checkImports :: ![ParsedImport] !*ImportInfo !*Heaps !*CheckState -> (!Int, !*ImportInfo, !*Heaps, !*CheckState)
+checkImports [] iinfo=:{ii_modules,ii_deps} heaps cs
+	#! mod_num = size ii_modules
+	= (mod_num, iinfo, heaps, cs)
+checkImports [ {import_module = {id_info}}: mods ] iinfo heaps cs=:{cs_symbol_table}
+	#! entry = sreadPtr id_info cs_symbol_table
+	# (min_mod_num1, iinfo, heaps, cs) = checkImport id_info entry iinfo heaps cs
+	  (min_mod_num2, iinfo, heaps, cs) = checkImports mods iinfo heaps cs
+	= (min min_mod_num1 min_mod_num2, iinfo, heaps, cs)
+
+	
+checkImport :: SymbolPtr SymbolTableEntry *ImportInfo *Heaps *CheckState -> *(Int,*ImportInfo,*Heaps,*CheckState); // MW++
+checkImport module_id_info entry=:{ste_kind = STE_OpenModule mod_num _} iinfo heaps cs
+	= (mod_num, iinfo, heaps, cs)
+checkImport module_id_info entry=:{ste_kind = STE_ClosedModule} iinfo=:{ii_modules} heaps cs
+	#! mod_num = size ii_modules
+	= (mod_num, iinfo, heaps, cs)
+checkImport module_id_info entry=:{ste_kind = STE_Module mod, ste_index} iinfo=:{ii_next_num,ii_deps} heaps cs=:{cs_symbol_table}
+	# entry = { entry & ste_kind = STE_OpenModule ii_next_num mod}
+	  cs = { cs & cs_symbol_table = cs_symbol_table <:= (module_id_info,entry) }
+	  iinfo = { iinfo & ii_next_num = inc ii_next_num, ii_deps = [module_id_info : ii_deps] }
+	  (min_mod_num, iinfo, heaps, cs) = checkImports mod.mod_imports iinfo heaps cs
+
+	| ii_next_num <= min_mod_num
+		# {ii_deps,ii_modules,ii_funs_and_macros} = iinfo
+		  (ii_deps, ii_modules, ii_funs_and_macros, heaps, cs)
+		  		= check_component module_id_info ii_deps ii_modules ii_funs_and_macros heaps cs
+		#! max_mod_num = size ii_modules
+		= (max_mod_num, { iinfo & ii_deps = ii_deps, ii_modules = ii_modules, ii_funs_and_macros = ii_funs_and_macros }, heaps, cs) 
+		= (min_mod_num, iinfo, heaps, cs)
+	where
+		check_component lowest_mod_info [mod_info : ds] modules macro_and_fun_defs heaps cs=:{cs_symbol_table}
+			#! entry = sreadPtr mod_info cs_symbol_table
+			# {ste_kind=STE_OpenModule _ mod,ste_index} = entry
+		  	  (modules, macro_and_fun_defs, heaps, cs) = checkDclModule mod ste_index modules macro_and_fun_defs heaps cs
+		  	  cs = { cs & cs_symbol_table = cs.cs_symbol_table <:= (mod_info, { entry & ste_kind = STE_ClosedModule })}
+			| lowest_mod_info == mod_info
+				= (ds, modules, macro_and_fun_defs, heaps, cs)
+// MW was					= check_component mod_info ds modules macro_and_fun_defs heaps cs
+				= check_component lowest_mod_info ds modules macro_and_fun_defs heaps cs
+
+initialDclModule ({mod_name, mod_defs=mod_defs=:{def_funtypes,def_macros}, mod_type},all_defs) var_heap
+	# (dcl_common, var_heap) = createCommonDefinitions mod_defs var_heap
+	= ({	dcl_name			= mod_name
+	,	dcl_functions		= { function \\ function <- mod_defs.def_funtypes }
+	,	dcl_macros			= def_macros
+	,	dcl_instances		= { ir_from = 0, ir_to = 0 }
+	,	dcl_class_specials	= { ir_from = 0, ir_to = 0 }
+	,	dcl_specials		= { ir_from = 0, ir_to = 0 }
+	,	dcl_common			= dcl_common
+	,	dcl_declared		=
+		{	dcls_import 	= []
+		,	dcls_local		= all_defs
+		,	dcls_explicit	= []	// MW++
+		}
+	,	dcl_conversions = No
+	,	dcl_is_system	= case mod_type of
+							MK_System 	-> True
+							 _			-> False
+	}, var_heap)
+	
+// MW moved retrieveAndRemoveImportsFromSymbolTable
+					
+checkDclModule {mod_name,mod_imports,mod_defs} mod_index modules icl_functions heaps=:{hp_var_heap, hp_type_heaps} cs
+	#! dcl_mod = modules.[mod_index]
+	# dcl_defined 					= dcl_mod.dcl_declared.dcls_local
+
+  // createCommonDefinitions only converts lists into arrays
+  
+	  (dcl_common, hp_var_heap)		= createCommonDefinitions mod_defs hp_var_heap
+	  dcl_macros					= mod_defs.def_macros
+	  (imports, modules, cs)		= collect_imported_symbols mod_imports [] modules cs
+
+  // imports :: [(Index,Declarations)]
+
+	# cs							= add_imported_symbols_to_symbol_table imports cs
+//	  cs							= addImportedSymbolsToSymbolTable imports cs
+	  cs							= addGlobalDefinitionsToSymbolTable dcl_defined cs
+
+	  nr_of_dcl_functions 			= size dcl_mod.dcl_functions
+	  (upper_limits, dcl_common)	= get_upper_limits dcl_common	// MW++
+	  (dcl_common, modules, hp_type_heaps, hp_var_heap, cs)
+// MW was		  		= checkCommonDefinitions cIsADclModule mod_index dcl_common modules hp_type_heaps hp_var_heap cs
+	  		= checkCommonDefinitions cIsADclModule mod_index upper_limits dcl_common modules hp_type_heaps hp_var_heap cs
+	  (memb_inst_defs, nr_of_dcl_functions_and_instances, rev_spec_class_inst, dcl_common, modules, hp_type_heaps, hp_var_heap, cs)
+	  		= determineTypesOfInstances nr_of_dcl_functions  mod_index dcl_common modules hp_type_heaps hp_var_heap cs
+	  (nr_of_dcl_funs_insts_and_specs, rev_function_list, rev_special_defs, com_type_defs, com_class_defs, modules, heaps, cs)
+	  		= checkDclFunctions mod_index nr_of_dcl_functions_and_instances mod_defs.def_funtypes
+	  			dcl_common.com_type_defs dcl_common.com_class_defs modules { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap } cs
+
+	  (nr_of_dcl_funs_insts_and_specs, new_class_instances, rev_special_defs, all_spec_types, heaps, cs_error)
+			= checkSpecialsOfInstances mod_index nr_of_dcl_functions rev_spec_class_inst nr_of_dcl_funs_insts_and_specs []
+					rev_special_defs { mem \\ mem <- memb_inst_defs } { [] \\ mem <- memb_inst_defs } heaps cs.cs_error
+
+	  dcl_functions = { function \\ function <- revAppend rev_function_list
+	  		( [ { mem_inst & ft_specials = if (isEmpty spec_types) SP_None (SP_ContextTypes spec_types) } \\
+	  					mem_inst <- memb_inst_defs & spec_types <-: all_spec_types ] ++
+	  						reverse rev_special_defs) }
+	  
+	  e_info = { ef_type_defs = com_type_defs, ef_selector_defs = dcl_common.com_selector_defs, ef_class_defs = com_class_defs,
+	  			 ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = dcl_common.com_member_defs, ef_modules = modules }
+
+	  (icl_functions, e_info, heaps, cs)
+			= checkMacros mod_index dcl_macros icl_functions e_info heaps { cs & cs_error = cs_error }
+
+	  com_instance_defs = dcl_common.com_instance_defs
+	  com_instance_defs = { inst_def \\ inst_def <- [ inst_def \\ inst_def <-: com_instance_defs ] ++ new_class_instances }
+
+	  (ef_member_defs, com_instance_defs, dcl_functions, cs)
+	  		= adjust_predefined_symbols mod_index e_info.ef_member_defs com_instance_defs dcl_functions cs
+
+ 	  first_special_class_index = size com_instance_defs
+ 	  last_special_class_index = first_special_class_index + length new_class_instances
+	  
+	  dcl_common = { dcl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs,
+			  	 		com_instance_defs = com_instance_defs, com_cons_defs = e_info.ef_cons_defs, com_member_defs = ef_member_defs }	  			  
+
+	  (dcl_imported, cs_symbol_table) = retrieveAndRemoveImportsFromSymbolTable imports [] cs.cs_symbol_table
+	  cs_symbol_table = removeDeclarationsFromSymbolTable dcl_defined cModuleScope cs_symbol_table
+
+	  dcls_explicit	= flatten [dcls_explicit \\ (_,{dcls_explicit})<-imports]	//MW++
+
+/* MW was
+	  dcl_mod = { dcl_mod &  dcl_declared = { dcl_mod.dcl_declared & dcls_import = dcl_imported },  dcl_common = dcl_common, dcl_functions = dcl_functions, 
+	  			 dcl_instances = { ir_from = nr_of_dcl_functions, ir_to = nr_of_dcl_functions_and_instances },
+	  			 dcl_specials = { ir_from = nr_of_dcl_functions_and_instances, ir_to = nr_of_dcl_funs_insts_and_specs },
+	  			 dcl_class_specials = { ir_from = first_special_class_index, ir_to = last_special_class_index }}
+*/
+	  dcl_mod = { dcl_mod &  dcl_declared = { dcl_mod.dcl_declared & dcls_import = dcl_imported, dcls_explicit = dcls_explicit },
+	  			 dcl_common = dcl_common, dcl_functions = dcl_functions, 
+	  			 dcl_instances = { ir_from = nr_of_dcl_functions, ir_to = nr_of_dcl_functions_and_instances },
+	  			 dcl_specials = { ir_from = nr_of_dcl_functions_and_instances, ir_to = nr_of_dcl_funs_insts_and_specs },
+	  			 dcl_class_specials = { ir_from = first_special_class_index, ir_to = last_special_class_index }}
+	= ({ e_info.ef_modules & [ mod_index ] = dcl_mod }, icl_functions, heaps, { cs & cs_symbol_table = cs_symbol_table })
+where
+/* MW was
+	collect_imported_symbols [{import_module={id_info}} : mods ] all_decls modules cs=:{cs_symbol_table}
+		#! entry = sreadPtr id_info cs_symbol_table
+		# (all_decls, modules, cs) = collect_declarations_of_module id_info entry all_decls modules cs
+		= collect_imported_symbols mods all_decls modules cs
+*/
+	collect_imported_symbols [{import_module={id_info},import_symbols,import_file_position} : mods ] all_decls modules cs=:{cs_symbol_table}
+		#! entry = sreadPtr id_info cs_symbol_table
+		# (decls_of_imported_module, modules, cs) = collect_declarations_of_module id_info entry [] modules cs
+		  (imported_decls, modules, cs)	= possibly_filter_decls 
+		  										import_symbols decls_of_imported_module import_file_position modules cs
+		= collect_imported_symbols mods (imported_decls++all_decls) modules cs
+	collect_imported_symbols [] all_decls modules cs
+		= (all_decls, modules, cs)
+
+	collect_declarations_of_module module_id_info entry=:{ste_index, ste_kind= old_kind=:STE_OpenModule mod_num {mod_imports} }
+			all_decls modules cs=:{cs_symbol_table}
+		# cs = { cs & cs_symbol_table = cs_symbol_table <:= (module_id_info, { entry & ste_kind = STE_LockedModule })}
+		  (imported_decls, modules, cs) = collect_imported_symbols mod_imports [] modules cs
+		#! dcl_mod = modules.[ste_index]
+		# (declared, cs) = determine_declared_symbols ste_index dcl_mod.dcl_declared.dcls_local imported_decls cs
+// MW was			= ([(ste_index, declared) : all_decls], modules, { cs & cs_symbol_table = cs.cs_symbol_table <:= (module_id_info, { entry & ste_kind = old_kind })})
+		= (	[(ste_index, declared) : all_decls]
+		  ,	modules
+		  ,	{ cs & cs_symbol_table	= cs.cs_symbol_table <:= (module_id_info, { entry & ste_kind = old_kind })}
+		  )
+	collect_declarations_of_module module_id_info entry=:{ste_index, ste_kind= STE_ClosedModule} all_decls modules cs
+		#! {dcl_declared} = modules.[ste_index]
+		= ([(ste_index, dcl_declared) : all_decls], modules, cs)
+	collect_declarations_of_module module_id_info entry=:{ste_kind= STE_LockedModule} all_decls modules cs
+		= (all_decls, modules, cs)
+
+	determine_declared_symbols mod_index definitions imported_decls cs
+		# cs = addGlobalDefinitionsToSymbolTable definitions (add_imported_symbols_to_symbol_table imported_decls cs)
+		  (dcls_import, cs_symbol_table) = retrieveAndRemoveImportsFromSymbolTable imported_decls [] cs.cs_symbol_table
+		  cs_symbol_table = removeDeclarationsFromSymbolTable definitions cModuleScope cs_symbol_table
+		= (	{dcls_import = dcls_import, dcls_local = definitions, dcls_explicit = []}, { cs & cs_symbol_table = cs_symbol_table })
+
+	add_imported_symbols_to_symbol_table [(mod_index, {dcls_import,dcls_local}) : imports] cs
+		= add_imported_symbols_to_symbol_table imports (addDeclaredSymbolsToSymbolTable cIsADclModule mod_index dcls_local dcls_import cs)
+	add_imported_symbols_to_symbol_table [] cs
+		= cs
+
+	adjust_predefined_symbols mod_index class_members class_instances fun_types cs=:{cs_predef_symbols}
+		#! pre_mod = cs_predef_symbols.[PD_StdArray]
+		| pre_mod.pds_def == mod_index
+			# cs = cs
+				<=< adjust_predef_symbols PD_CreateArrayFun PD_UnqArraySizeFun mod_index STE_Member
+				<=< adjust_predef_symbol PD_ArrayClass mod_index STE_Class
+			  (class_members, class_instances, fun_types, cs_predef_symbols)
+			  		= adjust_instance_types_of_array_functions_in_std_array_dcl mod_index class_members class_instances fun_types cs.cs_predef_symbols
+			= (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols })
+		#! pre_mod = cs_predef_symbols.[PD_PredefinedModule]
+		| pre_mod.pds_def == mod_index
+			= (class_members, class_instances, fun_types, cs
+				<=< adjust_predef_symbols PD_ListType PD_UnboxedArrayType mod_index STE_Type
+				<=< adjust_predef_symbols PD_ConsSymbol PD_Arity32TupleSymbol mod_index STE_Constructor
+				<=< adjust_predef_symbol PD_TypeCodeClass mod_index STE_Class
+				<=< adjust_predef_symbol PD_TypeCodeMember mod_index STE_Member)
+		#! pre_mod = cs_predef_symbols.[PD_StdBool]
+		| pre_mod.pds_def == mod_index
+			= (class_members, class_instances, fun_types, cs
+				<=< adjust_predef_symbol PD_AndOp mod_index STE_DclFunction
+				<=< adjust_predef_symbol PD_OrOp mod_index STE_DclFunction)
+		#! pre_mod = cs_predef_symbols.[PD_StdDynamics]	
+		| pre_mod.pds_def == mod_index
+			= (class_members, class_instances, fun_types, cs
+				<=< adjust_predef_symbol PD_TypeObjectType		mod_index STE_Type
+				<=< adjust_predef_symbol PD_TypeConsSymbol		mod_index STE_Constructor
+				<=< adjust_predef_symbol PD_variablePlaceholder mod_index STE_Constructor
+				<=< adjust_predef_symbol PD_unify				mod_index STE_DclFunction
+				<=< adjust_predef_symbol PD_undo_indirections	mod_index STE_DclFunction)
+			= (class_members, class_instances, fun_types, cs)
+	where
+		
+		adjust_predef_symbols next_symb last_symb mod_index symb_kind cs=:{cs_predef_symbols, cs_symbol_table, cs_error} 
+			| next_symb > last_symb
+				= cs
+				= cs
+					<=< adjust_predef_symbol next_symb mod_index symb_kind
+					<=< adjust_predef_symbols (inc next_symb) last_symb mod_index symb_kind
+			
+		adjust_predef_symbol predef_index mod_index symb_kind cs=:{cs_predef_symbols,cs_symbol_table,cs_error}
+			#! pre_symb = cs_predef_symbols.[predef_index]
+			#  pre_id = pre_symb.pds_ident
+			#! pre_index = determine_index_of_symbol (sreadPtr pre_id.id_info cs_symbol_table) symb_kind
+			| pre_index <> NoIndex
+				= { cs & cs_predef_symbols = {cs_predef_symbols & [predef_index] = { pre_symb & pds_def = pre_index, pds_module = mod_index }}}
+				= { cs & cs_error = checkError pre_id " function not defined" cs_error }
+		where
+			determine_index_of_symbol {ste_kind, ste_index} symb_kind
+				| ste_kind == symb_kind
+					= ste_index
+					= NoIndex
+		
+		adjust_instance_types_of_array_functions_in_std_array_dcl array_mod_index class_members class_instances fun_types predef_symbols
+			#! nr_of_instances = size class_instances
+			# ({pds_def}, predef_symbols) = predef_symbols![PD_ArrayClass]
+			  (offset_table, class_members, predef_symbols) = arrayFunOffsetToPD_IndexTable class_members predef_symbols
+			  (class_instances, fun_types, predef_symbols) 
+					= iFoldSt (adjust_instance_types_of_array_functions array_mod_index pds_def offset_table) 0 nr_of_instances
+							(class_instances, fun_types, predef_symbols)
+			= (class_members, class_instances, fun_types, predef_symbols)
+		where
+			adjust_instance_types_of_array_functions array_mod_index array_class_index offset_table inst_index (class_instances, fun_types, predef_symbols)
+				# ({ins_class={glob_module,glob_object={ds_index}},ins_type,ins_members}, class_instances) = class_instances![inst_index]
+				| glob_module == array_mod_index && ds_index == array_class_index && elemTypeIsStrict ins_type.it_types predef_symbols
+					# fun_types = iFoldSt (make_instance_strict ins_members offset_table) 0 (size ins_members) fun_types
+					= (class_instances, fun_types, predef_symbols)
+					= (class_instances, fun_types, predef_symbols)
+			
+			make_instance_strict instances offset_table ins_offset instance_defs
+				# {ds_index} = instances.[ins_offset]
+				  (inst_def, instance_defs) = instance_defs![ds_index]
+				  (Yes symbol_type) = inst_def.ft_type
+				= { instance_defs & [ds_index] = { inst_def & ft_type =  makeElemTypeOfArrayFunctionStrict inst_def.ft_type ins_offset offset_table } }
+
+// MW moved functions
+
+NewEntry symbol_table symb_ptr def_kind def_index level previous :==
+	 symbol_table <:= (symb_ptr,{  ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous })
+	
+// MW moved function
+
+addImportsToSymbolTable :: ![ParsedImport] ![(!Declaration, !LineNr)] !*{# DclModule} !*CheckState 
+						-> (![(!Declaration, !LineNr)], !*{# DclModule}, !*CheckState)
+addImportsToSymbolTable [{import_module={id_info},import_symbols, import_file_position} : mods ] 
+						explicit_akku modules cs=:{cs_symbol_table}
+	#! {ste_index} = sreadPtr id_info cs_symbol_table
+	#! {dcl_declared=decls_of_imported_module} = modules.[ste_index]
+	   (imported_decls, modules, cs)	= possibly_filter_decls import_symbols 
+	   											[(ste_index, decls_of_imported_module)] import_file_position modules cs
+	|  isEmpty imported_decls
+		= addImportsToSymbolTable mods explicit_akku modules cs
+	#! (_,{dcls_import,dcls_local,dcls_explicit}) = hd imported_decls
+	= addImportsToSymbolTable mods (dcls_explicit++explicit_akku) 
+								modules (addDeclaredSymbolsToSymbolTable cIsNotADclModule ste_index dcls_local dcls_import cs)
+addImportsToSymbolTable [] explicit_akku modules cs
+	= (explicit_akku, modules, cs)
+
+// MW moved functions
+
+file_and_status {ea_file,ea_ok}
+	= (ea_file, ea_ok)
+
+instance <<< FunCall
+where
+	(<<<) file {fc_index} = file <<< fc_index
+
+instance <<< Priority
+where
+	(<<<) file (Prio ass prio) = file <<< "##" <<< prio <<< ass <<< "##"
+	(<<<) file NoPrio = file <<< "#"
+
+instance <<< Assoc
+where
+	(<<<) file LeftAssoc = file <<< 'L'
+	(<<<) file RightAssoc = file <<< 'R'
+	(<<<) file _ = file
+
+instance <<< DefinedSymbol
+where
+	(<<<) file { ds_index, ds_ident } = file <<< ds_ident <<< '.' <<< ds_index
+	
+instance <<< FreeVar
+where
+	(<<<) file { fv_name } = file <<< fv_name
+	
+instance <<< FieldSymbol
+where
+	(<<<) file { fs_var } = file <<< fs_var
+
+
+instance <<< Declarations
+where
+	(<<<) file { dcls_import, dcls_local } = file <<< "I:" <<< dcls_import <<< "L:" <<< dcls_local
+
+instance <<< Specials
+where
+	(<<<) file (SP_ParsedSubstitutions _)	= file <<< "SP_ParsedSubstitutions"
+	(<<<) file (SP_Substitutions substs)	= file <<< "SP_Substitutions " <<< substs
+	(<<<) file (SP_ContextTypes specials)	= file <<< "SP_ContextTypes " <<< specials
+	(<<<) file (SP_FunIndex _)					= file <<< "SP_ParsedSubstitutions"
+	(<<<) file SP_None						= file <<< "SP_None"
+
+instance <<< Special
+where
+	(<<<) file {spec_types} = file <<< spec_types
+
+
+instance <<< SpecialSubstitution
+where
+	(<<<) file {ss_environ} = file <<< ss_environ
+
+instance <<< Declaration
+where
+	(<<<) file { dcl_ident } = file <<< dcl_ident
+
+instance <<< Ptr a
+where
+	(<<<) file ptr = file <<< "[[" <<< ptrToInt ptr <<< "]]"
+
+instance <<< LocalDefs
+where
+	(<<<) file (CollectedLocalDefs { loc_functions={ir_from,ir_to} }) = file <<< ir_from <<< '-' <<< ir_to
+	
+retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index)
+retrieveGlobalDefinition {ste_kind = STE_Imported kind dcl_index, ste_def_level, ste_index} requ_kind mod_index
+	| kind == requ_kind
+		= (ste_index, dcl_index)
+		= (NotFound, mod_index)
+retrieveGlobalDefinition {ste_kind,ste_def_level,ste_index} requ_kind mod_index
+	| ste_kind == requ_kind && ste_def_level == cGlobalScope
+		= (ste_index, mod_index)
+		= (NotFound, mod_index)
+
+
diff --git a/frontend/checksupport.dcl b/frontend/checksupport.dcl
new file mode 100644
index 0000000..32db0be
--- /dev/null
+++ b/frontend/checksupport.dcl
@@ -0,0 +1,136 @@
+definition module checksupport
+
+import StdEnv
+import syntax, predef
+
+cIclModIndex 			:== 0 // MW++
+
+CS_NotChecked 	:== -1
+NotFound		:== -1
+
+cModuleScope	:== 0
+cGlobalScope	:== 1
+
+cIsNotADclModule 	:== False // MW++
+cIsADclModule 		:== True  // MW++
+
+::	VarHeap :== Heap VarInfo
+
+::	Heaps =
+	{	hp_var_heap			::!.VarHeap
+	,	hp_expression_heap	::!.ExpressionHeap
+	,	hp_type_heaps		::!.TypeHeaps
+	}
+
+::	ErrorAdmin = { ea_file :: !.File, ea_loc :: ![IdentPos], ea_ok :: !Bool }
+
+::	CheckState = { cs_symbol_table :: !.SymbolTable, cs_predef_symbols :: !.PredefinedSymbols, cs_error :: !.ErrorAdmin }
+
+//	SymbolTable			:== {# SymbolTableEntry}
+
+instance == STE_Kind
+
+::	ConversionTable		:== {# .{# Int }}
+
+cTypeDefs				:== 0
+cConstructorDefs		:== 1
+cSelectorDefs			:== 2
+cClassDefs				:== 3
+cMemberDefs				:== 4
+cInstanceDefs			:== 5
+cFunctionDefs			:== 6
+cMacroDefs				:== 7
+
+cConversionTableSize	:== 8
+
+::	CommonDefs =
+	{	com_type_defs 		:: !.{# CheckedTypeDef}
+	,	com_cons_defs		:: !.{# ConsDef}
+	,	com_selector_defs	:: !.{# SelectorDef}
+	,	com_class_defs		:: !.{# ClassDef}
+	,	com_member_defs		:: !.{# MemberDef}
+	,	com_instance_defs	:: !.{# ClassInstance}
+//	,	com_instance_types	:: !.{ SymbolType}
+	}
+
+::	Declaration =
+	{	dcl_ident	:: !Ident
+	,	dcl_kind	:: !STE_Kind
+	,	dcl_index	:: !Index
+	}
+
+::	Declarations =
+	{	dcls_import		::![Declaration]
+	,	dcls_local		::![Declaration]
+	,	dcls_explicit	::![(!Declaration, !LineNr)] // MW++
+	}
+
+::	IclModule  =
+	{	icl_name			:: !Ident
+	,	icl_functions		:: !.{# FunDef }
+	,	icl_instances		:: !IndexRange
+	,	icl_specials		:: !IndexRange
+	,	icl_common			:: !.CommonDefs
+	,	icl_declared		:: !Declarations
+// RWS ...
+	,	icl_imported_objects	:: ![ImportedObject]
+// ... RWS
+	}
+
+::	DclModule =
+	{	dcl_name			:: !Ident
+	,	dcl_functions		:: !{# FunType }
+	,	dcl_instances		:: !IndexRange
+	,	dcl_macros			:: !IndexRange
+	,	dcl_class_specials	:: !IndexRange
+	,	dcl_specials		:: !IndexRange
+	,	dcl_common			:: !CommonDefs
+	,	dcl_declared		:: !Declarations
+	,	dcl_conversions		:: !Optional ConversionTable
+	,	dcl_is_system		:: !Bool
+	}
+
+class Erroradmin state
+where
+	pushErrorAdmin :: !IdentPos *state -> *state
+	setErrorAdmin :: !IdentPos *state -> *state
+	popErrorAdmin  :: *state -> *state
+
+instance Erroradmin ErrorAdmin, CheckState
+
+newPosition :: !Ident  !Position -> IdentPos 
+
+checkError :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
+checkWarning :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
+
+class envLookUp a :: !a !(Env Ident .b) -> (!Bool,.b)
+
+instance envLookUp TypeVar, AttributeVar, ATypeVar
+
+class toIdent a :: !a -> Ident
+
+instance toIdent ConsDef, TypeDef a, ClassDef, MemberDef, FunDef, SelectorDef // , ClassInstance
+instance toIdent SymbIdent, TypeSymbIdent, BoundVar, TypeVar, ATypeVar, Ident
+
+instance toInt STE_Kind
+instance <<< STE_Kind
+instance <<< IdentPos
+
+// MW..
+retrieveAndRemoveImportsFromSymbolTable :: ![(.a,.Declarations)] [Declaration] *(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry);
+retrieveAndRemoveImportsOfModuleFromSymbolTable :: ![.Declaration] ![.Declaration] ![.Declaration] !*(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry);
+addLocalFunctionDefsToSymbolTable :: Level Index .Index u:(a FunDef) *SymbolTable *ErrorAdmin -> (v:(a FunDef),.SymbolTable,.ErrorAdmin) | Array .a, [u <= v];
+addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* SymbolTable, !*ErrorAdmin)
+addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] ![.Declaration] !*CheckState -> .CheckState;
+addLocalSymbolsToSymbolTable :: ![.Declaration] Int !*CheckState -> .CheckState;
+addImportedFunctionOrMacro :: !Ident .Int !*CheckState -> .CheckState;
+addFieldToSelectorDefinition :: !Ident (Global .Int) !*CheckState -> .CheckState;
+addImportedSymbol :: !Ident STE_Kind .Int .Int !*CheckState -> .CheckState;
+addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState;
+retrieveImportsFromSymbolTable :: ![Import ImportDeclaration] ![Declaration] !*{#DclModule} !*(Heap SymbolTableEntry) -> *(![Declaration],!*{#DclModule},!*Heap SymbolTableEntry);
+removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
+removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*(Heap SymbolTableEntry) -> *Heap SymbolTableEntry;
+removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
+removeLocalsFromSymbolTable :: .Level .[Ident] LocalDefs u:(a b) *(Heap SymbolTableEntry) -> (v:(a b),.Heap SymbolTableEntry) | Array .a & select_u , toIdent b, [u <= v];
+removeIdentFromSymbolTable :: !.Int !Ident !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
+// ..MW
\ No newline at end of file
diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl
new file mode 100644
index 0000000..1bd4655
--- /dev/null
+++ b/frontend/checksupport.icl
@@ -0,0 +1,521 @@
+implementation module checksupport
+
+import StdEnv, compare_constructor
+import syntax, predef
+import utilities // MW++
+
+::	VarHeap :== Heap VarInfo
+
+cIclModIndex 			:== 0 // MW++
+
+CS_NotChecked 	:== -1
+NotFound		:== -1
+	
+cModuleScope	:== 0
+cGlobalScope	:== 1
+
+cIsNotADclModule 	:== False // MW++
+cIsADclModule 		:== True  // MW++
+
+::	Heaps =
+	{	hp_var_heap			::!.VarHeap
+	,	hp_expression_heap	::!.ExpressionHeap
+	,	hp_type_heaps		::!.TypeHeaps
+	}
+
+::	ErrorAdmin = { ea_file :: !.File, ea_loc :: ![IdentPos], ea_ok :: !Bool }
+
+::	CheckState = { cs_symbol_table :: !.SymbolTable, cs_predef_symbols :: !.PredefinedSymbols, cs_error :: !.ErrorAdmin }
+
+::	ConversionTable		:== {# .{# Int }}
+
+cTypeDefs				:== 0
+cConstructorDefs		:== 1
+cSelectorDefs			:== 2
+cClassDefs				:== 3
+cMemberDefs				:== 4
+cInstanceDefs			:== 5
+cFunctionDefs			:== 6
+cMacroDefs				:== 7
+
+cConversionTableSize	:== 8
+
+instance toInt STE_Kind
+where
+	toInt STE_Type					= cTypeDefs
+	toInt STE_Constructor			= cConstructorDefs
+	toInt (STE_Field _)				= cSelectorDefs
+	toInt STE_Class					= cClassDefs
+	toInt STE_Member				= cMemberDefs
+	toInt STE_Instance				= cInstanceDefs
+	toInt STE_DclFunction			= cFunctionDefs
+	toInt (STE_FunctionOrMacro _)	= cMacroDefs
+	toInt _							= NoIndex
+
+::	CommonDefs =
+	{	com_type_defs 		:: !.{# CheckedTypeDef}
+	,	com_cons_defs		:: !.{# ConsDef}
+	,	com_selector_defs	:: !.{# SelectorDef}
+	,	com_class_defs		:: !.{# ClassDef}
+	,	com_member_defs		:: !.{# MemberDef}
+	,	com_instance_defs	:: !.{# ClassInstance}
+//	,	com_instance_types	:: !.{ SymbolType}
+	}
+
+::	Declaration =
+	{	dcl_ident	:: !Ident
+	,	dcl_kind	:: !STE_Kind
+	,	dcl_index	:: !Index
+	}
+
+::	Declarations =
+	{	dcls_import		::![Declaration]
+	,	dcls_local		::![Declaration]
+	,	dcls_explicit	::![(!Declaration, !LineNr)]	// MW++
+	}
+	
+::	IclModule  =
+	{	icl_name			:: !Ident
+	,	icl_functions		:: !.{# FunDef }
+	,	icl_instances		:: !IndexRange
+	,	icl_specials		:: !IndexRange
+	,	icl_common			:: !.CommonDefs
+	,	icl_declared		:: !Declarations
+// RWS ...
+	,	icl_imported_objects	:: ![ImportedObject]
+// ... RWS
+	}
+
+::	DclModule =
+	{	dcl_name			:: !Ident
+	,	dcl_functions		:: !{# FunType }
+	,	dcl_instances		:: !IndexRange
+	,	dcl_macros			:: !IndexRange
+	,	dcl_class_specials	:: !IndexRange
+	,	dcl_specials		:: !IndexRange
+	,	dcl_common			:: !CommonDefs
+	,	dcl_declared		:: !Declarations
+	,	dcl_conversions		:: !Optional ConversionTable
+	,	dcl_is_system		:: !Bool
+	}
+
+class Erroradmin state // PK...
+where
+	pushErrorAdmin :: !IdentPos *state -> *state
+	setErrorAdmin :: !IdentPos *state -> *state
+	popErrorAdmin  :: *state -> *state
+
+instance Erroradmin ErrorAdmin
+where
+	pushErrorAdmin pos error=:{ea_loc}
+		= { error & ea_loc = [pos : ea_loc] } 
+	
+	setErrorAdmin pos error
+		= { error & ea_loc = [pos] } 
+	
+	popErrorAdmin error=:{ea_loc = [_:ea_locs]}
+		=  { error & ea_loc = ea_locs }
+
+instance Erroradmin CheckState
+where
+	pushErrorAdmin pos cs=:{cs_error}
+		= {cs & cs_error = pushErrorAdmin pos cs_error } 
+	
+	setErrorAdmin pos cs=:{cs_error}
+		= {cs & cs_error = setErrorAdmin pos cs_error }
+	
+	popErrorAdmin cs=:{cs_error}
+		= {cs & cs_error = popErrorAdmin cs_error } //...PK
+
+newPosition :: !Ident  !Position -> IdentPos 
+newPosition id (FunPos file_name line_nr _)
+	= { ip_ident = id, ip_line = line_nr, ip_file = file_name }
+newPosition id (LinePos file_name line_nr)
+	= { ip_ident = id, ip_line = line_nr, ip_file = file_name }
+newPosition id (PreDefPos file_name)
+	= { ip_ident = id, ip_line = cNotALineNumber, ip_file = file_name.id_name }
+newPosition id NoPos
+	= { ip_ident = id, ip_line = cNotALineNumber, ip_file = "???" }
+
+checkError :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b // PK
+checkError id mess error=:{ea_file,ea_loc=[]}
+	= { error & ea_file = ea_file <<< "Check Error " <<< "\"" <<< id <<< "\" " <<< mess <<< '\n', ea_ok = False }
+checkError id mess error=:{ea_file,ea_loc}
+	= { error & ea_file = ea_file <<< "Check Error " <<< hd ea_loc <<< ":\"" <<< id  <<< "\" " <<< mess <<< '\n', ea_ok = False }
+
+checkWarning :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b // PK
+checkWarning id mess error=:{ea_file,ea_loc=[]}
+	= { error & ea_file = ea_file <<< "Check Warning " <<< "\"" <<< id <<< "\" " <<< mess <<< '\n' }
+checkWarning id mess error=:{ea_file,ea_loc}
+	= { error & ea_file = ea_file <<< "Check Warning " <<< hd ea_loc <<< ":\"" <<< id  <<< "\" " <<< mess <<< '\n' }
+
+class envLookUp a :: !a !(Env Ident .b) -> (!Bool,.b)
+
+instance envLookUp TypeVar
+where
+	envLookUp var [bind:binds]
+		| var.tv_name == bind.bind_src
+			= (True, bind.bind_dst)
+			= envLookUp var binds
+	envLookUp var []
+		= (False, abort "illegal value")
+	
+instance envLookUp AttributeVar
+where
+	envLookUp var [bind:binds]
+		| var.av_name == bind.bind_src
+			= (True, bind.bind_dst)
+			= envLookUp var binds
+	envLookUp var []
+		= (False, abort "illegal value")
+
+
+instance envLookUp ATypeVar
+where
+	envLookUp var=:{atv_variable} [bind:binds]
+		| atv_variable.tv_name == bind.bind_src
+			= (True, bind.bind_dst)
+			= envLookUp var binds
+	envLookUp var []
+		= (False, abort "illegal value")
+
+
+// MW..
+retrieveAndRemoveImportsFromSymbolTable :: ![(.a,.Declarations)] [Declaration] *(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry);
+retrieveAndRemoveImportsFromSymbolTable [(_, {dcls_import,dcls_local}) : imports] all_decls symbol_table
+	# (all_decls, symbol_table) = retrieveAndRemoveImportsOfModuleFromSymbolTable dcls_import dcls_local all_decls symbol_table
+	= retrieveAndRemoveImportsFromSymbolTable imports all_decls symbol_table
+retrieveAndRemoveImportsFromSymbolTable []  all_decls symbol_table
+	= (all_decls, symbol_table)
+	
+retrieveAndRemoveImportsOfModuleFromSymbolTable :: ![.Declaration] ![.Declaration] ![.Declaration] !*(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry);
+retrieveAndRemoveImportsOfModuleFromSymbolTable imports locals all_decls symbol_table
+	# (all_decls, symbol_table) = retrieve_declared_symbols imports all_decls symbol_table
+	= retrieve_declared_symbols locals all_decls symbol_table
+where
+	retrieve_declared_symbols :: ![Declaration] ![Declaration] !*SymbolTable -> (![Declaration], !*SymbolTable)
+	retrieve_declared_symbols decls collected_decls symbol_table
+		= foldSt retrieve_declared_symbol decls (collected_decls, symbol_table)
+
+	retrieve_declared_symbol symbol=:{dcl_ident=ident=:{id_info},dcl_kind,dcl_index} (decls, symbol_table)
+		#! entry = sreadPtr id_info symbol_table
+		# {ste_kind,ste_def_level,ste_previous} = entry
+		| ste_kind == STE_Empty || ste_def_level > cModuleScope
+			= (decls, symbol_table)
+			= case ste_kind of
+				STE_Field selector_id
+					-> ([{ symbol & dcl_kind = ste_kind } : decls ], 
+							removeFieldFromSelectorDefinition selector_id NoIndex dcl_index (symbol_table <:= (id_info, ste_previous)))
+				STE_Imported (STE_Field selector_id) def_mod
+					-> ([{ symbol & dcl_kind = ste_kind } : decls ], 
+							removeFieldFromSelectorDefinition selector_id def_mod dcl_index (symbol_table <:= (id_info, ste_previous)))
+				_
+					-> ([{ symbol & dcl_kind = ste_kind } : decls ], symbol_table <:= (id_info, ste_previous))
+
+addLocalFunctionDefsToSymbolTable :: Level Index .Index u:(a FunDef) *SymbolTable *ErrorAdmin -> (v:(a FunDef),.SymbolTable,.ErrorAdmin) | Array .a, [u <= v];
+addLocalFunctionDefsToSymbolTable level from_index to_index fun_defs symbol_table error
+	| from_index == to_index
+		= (fun_defs, symbol_table, error)	
+		#! fun_def = fun_defs.[from_index]
+		   (symbol_table, error) = addDefToSymbolTable level from_index fun_def.fun_symb (STE_FunctionOrMacro []) symbol_table error
+		= addLocalFunctionDefsToSymbolTable level (inc from_index) to_index fun_defs symbol_table error
+
+NewEntry symbol_table symb_ptr def_kind def_index level previous :==
+	 symbol_table <:= (symb_ptr,{  ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous })
+	
+		
+addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* SymbolTable, !*ErrorAdmin)
+addDefToSymbolTable level def_index def_ident=:{id_info} def_kind symbol_table error
+	#! entry = sreadPtr id_info symbol_table
+	| entry.ste_kind == STE_Empty || entry.ste_def_level <> level
+		# entry = {ste_index = def_index, ste_kind = def_kind, ste_def_level = level, ste_previous = entry }
+		= (symbol_table <:= (id_info,entry), error)
+		= (symbol_table, checkError def_ident " already defined" error)
+
+addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] ![.Declaration] !*CheckState -> .CheckState;
+addDeclaredSymbolsToSymbolTable is_dcl_mod ste_index locals imported cs
+	= addLocalSymbolsToSymbolTable locals ste_index (add_imports_to_symbol_table is_dcl_mod imported cs)
+where
+	add_imports_to_symbol_table is_dcl_mod [{dcl_ident,dcl_kind,dcl_index} : symbols] cs
+		= case dcl_kind of
+			STE_Imported def_kind def_mod
+				| is_dcl_mod || def_mod <> cIclModIndex
+					-> add_imports_to_symbol_table is_dcl_mod symbols (addImportedSymbol dcl_ident def_kind dcl_index def_mod cs)
+					-> add_imports_to_symbol_table is_dcl_mod symbols cs
+			STE_FunctionOrMacro _
+				-> add_imports_to_symbol_table is_dcl_mod symbols (addImportedFunctionOrMacro dcl_ident dcl_index cs)
+	add_imports_to_symbol_table is_dcl_mod [] cs
+		= cs
+
+addLocalSymbolsToSymbolTable :: ![.Declaration] Int !*CheckState -> .CheckState;
+addLocalSymbolsToSymbolTable [{dcl_ident,dcl_kind,dcl_index} : symbols] mod_index cs
+	= case dcl_kind of
+		STE_FunctionOrMacro _
+			-> addLocalSymbolsToSymbolTable symbols mod_index (addImportedFunctionOrMacro dcl_ident dcl_index cs)
+		_
+				-> addLocalSymbolsToSymbolTable symbols mod_index (addImportedSymbol dcl_ident dcl_kind dcl_index mod_index cs)
+addLocalSymbolsToSymbolTable [] mod_index cs
+	= cs
+
+addImportedFunctionOrMacro :: !Ident .Int !*CheckState -> .CheckState;
+addImportedFunctionOrMacro ident=:{id_info} def_index cs=:{cs_symbol_table}
+	#! entry = sreadPtr id_info cs_symbol_table
+	= case entry.ste_kind of
+		STE_Empty
+			-> { cs & cs_symbol_table = NewEntry cs.cs_symbol_table id_info (STE_FunctionOrMacro []) def_index cModuleScope entry}
+		STE_FunctionOrMacro _
+			| entry.ste_index == def_index
+				-> cs
+		_
+			-> { cs & cs_error = checkError ident " multiply imported" cs.cs_error}
+
+addFieldToSelectorDefinition :: !Ident (Global .Int) !*CheckState -> .CheckState;
+addFieldToSelectorDefinition {id_info} glob_field_index cs=:{cs_symbol_table}
+	# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table 
+	  cs = { cs & cs_symbol_table = cs_symbol_table }
+	= case entry.ste_kind of
+		STE_Selector selector_list
+			-> { cs & cs_symbol_table = cs.cs_symbol_table <:= (id_info, { entry & ste_kind = STE_Selector [ glob_field_index : selector_list ] })}
+		_
+			-> { cs & cs_symbol_table = NewEntry cs.cs_symbol_table id_info (STE_Selector [glob_field_index]) NoIndex cModuleScope entry }
+			
+addImportedSymbol :: !Ident STE_Kind .Int .Int !*CheckState -> .CheckState;
+addImportedSymbol ident def_kind def_index def_mod cs=:{cs_symbol_table}
+	# (entry, cs_symbol_table) = readPtr ident.id_info cs_symbol_table 
+	= add_imported_symbol entry ident def_kind def_index def_mod { cs & cs_symbol_table = cs_symbol_table }
+where	
+	add_imported_symbol entry=:{ste_kind = STE_Empty} {id_info} def_kind def_index def_mod cs=:{cs_symbol_table}
+		# cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info (STE_Imported def_kind def_mod) def_index cModuleScope entry}
+		= case def_kind of
+			STE_Field selector_id
+				-> addFieldToSelectorDefinition selector_id	{ glob_module = def_mod, glob_object = def_index } cs
+			_
+				-> cs
+	add_imported_symbol	entry=:{ste_kind = STE_Imported kind mod_index, ste_index} ident=:{id_info} def_kind def_index def_mod cs
+		| kind == def_kind && mod_index == def_mod && ste_index == def_index
+			= cs
+	add_imported_symbol	entry ident def_kind def_index def_mod cs=:{cs_error}
+		= { cs & cs_error = checkError ident " multiply imported" cs_error}
+	
+addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState;
+addGlobalDefinitionsToSymbolTable decls cs
+	= foldSt add_global_definition decls cs
+where
+	add_global_definition {dcl_ident=ident=:{id_info},dcl_kind,dcl_index} cs=:{cs_symbol_table}
+		#! entry = sreadPtr id_info cs_symbol_table
+		| entry.ste_def_level < cGlobalScope
+			# cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info dcl_kind dcl_index cGlobalScope entry }
+			= case dcl_kind of
+				STE_Field selector_id
+					-> addFieldToSelectorDefinition selector_id	{ glob_module = NoIndex, glob_object = dcl_index } cs
+				_
+					-> cs
+			= { cs & cs_error = checkError ident "(global definition) already defined" cs.cs_error}
+
+retrieveImportsFromSymbolTable :: ![Import ImportDeclaration] ![Declaration] !*{#DclModule} !*(Heap SymbolTableEntry) -> *(![Declaration],!*{#DclModule},!*Heap SymbolTableEntry);
+retrieveImportsFromSymbolTable [{import_module=import_module=:{id_info},import_symbols} : mods ] decls modules symbol_table
+	#! entry = sreadPtr id_info symbol_table
+	# {ste_index} = entry
+	#! {dcl_declared={dcls_import,dcls_local}} = modules.[ste_index]	
+	   (decls, symbol_table) = retrieveAndRemoveImportsOfModuleFromSymbolTable dcls_import dcls_local decls symbol_table
+	= retrieveImportsFromSymbolTable mods decls modules symbol_table
+retrieveImportsFromSymbolTable [] decls modules symbol_table
+	= (decls, modules, symbol_table)
+
+removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
+removeFieldFromSelectorDefinition {id_info} field_mod field_index symbol_table 
+	# (entry, symbol_table) = readPtr id_info symbol_table
+	  (STE_Selector selector_list) = entry.ste_kind
+	= symbol_table <:= (id_info, { entry & ste_kind = STE_Selector (remove_field field_mod field_index selector_list) })
+where	
+	remove_field field_mod field_index [field=:{glob_module, glob_object} : fields]
+		| field_mod == glob_module && field_index == glob_object
+			= fields
+			= [field : remove_field field_mod field_index fields]
+	remove_field field_mod field_index []
+		= []
+
+
+removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*(Heap SymbolTableEntry) -> *Heap SymbolTableEntry;
+removeDeclarationsFromSymbolTable decls scope symbol_table
+	= foldSt (remove_declaration scope) decls symbol_table
+where
+	remove_declaration scope {dcl_ident={id_info}, dcl_index} symbol_table
+		#! entry = sreadPtr id_info symbol_table
+		# {ste_kind,ste_previous} = entry
+		= case ste_kind of
+			STE_Field field_id
+				# symbol_table = removeFieldFromSelectorDefinition field_id NoIndex dcl_index symbol_table
+				| ste_previous.ste_def_level == scope
+					-> symbol_table <:= (id_info, ste_previous.ste_previous)
+					-> symbol_table <:= (id_info, ste_previous)
+			_
+				| ste_previous.ste_def_level == scope
+					-> symbol_table <:= (id_info, ste_previous.ste_previous)
+					-> symbol_table <:= (id_info, ste_previous)
+
+
+removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
+removeLocalIdentsFromSymbolTable level idents symbol_table
+	= foldSt (removeIdentFromSymbolTable level) idents symbol_table
+
+
+removeLocalsFromSymbolTable :: .Level .[Ident] LocalDefs u:(a b) *(Heap SymbolTableEntry) -> (v:(a b),.Heap SymbolTableEntry) | Array .a & select_u , toIdent b, [u <= v];
+removeLocalsFromSymbolTable level loc_vars (CollectedLocalDefs {loc_functions={ir_from,ir_to}}) defs symbol_table
+	= remove_defs_from_symbol_table level ir_from ir_to defs (removeLocalIdentsFromSymbolTable level loc_vars symbol_table)
+where
+	remove_defs_from_symbol_table level from_index to_index defs symbol_table
+		| from_index == to_index
+			= (defs, symbol_table)	
+			#! def = defs.[from_index]
+			   id_info = (toIdent def).id_info
+			   entry = sreadPtr id_info symbol_table
+			| level == entry.ste_def_level
+				= remove_defs_from_symbol_table level (inc from_index) to_index defs (symbol_table <:= (id_info, entry.ste_previous))
+				= remove_defs_from_symbol_table level (inc from_index) to_index defs symbol_table
+
+
+removeIdentFromSymbolTable :: !.Int !Ident !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
+removeIdentFromSymbolTable level {id_name,id_info} symbol_table
+	#! {ste_previous,ste_def_level} = sreadPtr id_info symbol_table
+	| level <= ste_def_level 
+		= symbol_table <:= (id_info,ste_previous) // ---> ("removeIdentFromSymbolTable", id_name)
+		= symbol_table // ---> ("NO removeIdentFromSymbolTable", id_name)
+// ..MW
+
+class toIdent a :: !a -> Ident
+
+instance toIdent SymbIdent
+where
+	toIdent symb = symb.symb_name
+
+instance toIdent TypeSymbIdent
+where
+	toIdent type_symb = type_symb.type_name
+
+instance toIdent BoundVar
+where
+	toIdent var = var.var_name
+
+instance toIdent TypeVar
+where
+	toIdent tvar = tvar.tv_name
+
+instance toIdent ATypeVar
+where
+	toIdent {atv_variable} = atv_variable.tv_name
+
+
+instance toIdent Ident
+where
+	toIdent id = id
+
+instance toIdent ConsDef
+where
+	toIdent cons = cons.cons_symb
+
+instance toIdent TypeDef a
+where
+	toIdent td = td.td_name
+
+instance toIdent ClassDef
+where
+	toIdent cl = cl.class_name
+
+instance toIdent MemberDef
+where
+	toIdent me = me.me_symb
+
+instance toIdent FunDef
+where
+	toIdent fun = fun.fun_symb
+
+instance toIdent SelectorDef
+where
+	toIdent sd = sd.sd_symb
+
+/*
+instance toIdent DeltaRule
+where
+	toIdent delta = delta.delta_name
+*/
+
+instance toIdent (a,b) | toIdent a
+where
+	toIdent (x,y) = toIdent x
+
+instance == STE_Kind
+where
+	(==) (STE_FunctionOrMacro _) STE_DclFunction	= True
+	(==) STE_DclFunction (STE_FunctionOrMacro _)	= True
+	(==) sk1 sk2 									= equal_constructor sk1 sk2
+
+instance <<< IdentPos
+where
+	(<<<) file {ip_file,ip_line,ip_ident}
+	| ip_line == cNotALineNumber
+		= file <<< '[' <<< ip_file <<< ',' <<< ip_ident <<< ']'
+		= file <<< '[' <<< ip_file <<< ',' <<< ip_line <<< ',' <<< ip_ident <<< ']'
+	
+
+instance <<< STE_Kind
+where
+	(<<<) file
+		(STE_FunctionOrMacro _)
+			= file <<< "STE_FunctionOrMacro"
+	(<<<) file
+		STE_Type
+			= file <<< "STE_Type"
+	(<<<) file
+		STE_Constructor
+			= file <<< "STE_Constructor"
+	(<<<) file
+		(STE_Selector _)
+			= file <<< "STE_Selector"
+	(<<<) file
+		STE_Class
+			= file <<< "STE_Class"
+	(<<<) file
+		STE_Member
+			= file <<< "STE_Member"
+	(<<<) file
+		STE_Instance
+			= file <<< "STE_Instance"
+	(<<<) file
+		(STE_Variable _) 
+			= file <<< "STE_Variable"
+	(<<<) file
+		(STE_TypeVariable _) 
+			= file <<< "STE_TypeVariable"
+	(<<<) file
+		(STE_TypeAttribute _)
+			= file <<< "STE_TypeAttribute"
+	(<<<) file
+		(STE_BoundTypeVariable _)
+			= file <<< "STE_BoundTypeVariable"
+	(<<<) file
+		(STE_BoundType _)
+			= file <<< "STE_BoundType"
+	(<<<) file
+		(STE_Imported _ _)
+			= file <<< "STE_Imported"
+	(<<<) file
+		STE_DclFunction
+			= file <<< "STE_DclFunction"
+	(<<<) file
+		(STE_Module _)
+			= file <<< "STE_Module"
+	(<<<) file
+		(STE_OpenModule _ _)
+			= file <<< "STE_OpenModule"
+	(<<<) file
+		STE_ClosedModule
+			= file <<< "STE_ClosedModule"
+	(<<<) file
+		STE_LockedModule
+			= file <<< "STE_LockedModule"
+	(<<<) file
+		STE_Empty 
+			= file <<< "STE_Empty"
+
+
diff --git a/frontend/checktypes.dcl b/frontend/checktypes.dcl
new file mode 100644
index 0000000..efb8526
--- /dev/null
+++ b/frontend/checktypes.dcl
@@ -0,0 +1,25 @@
+definition module checktypes
+
+import checksupport, typesupport
+
+checkTypeDefs :: !Bool !*{# CheckedTypeDef} !Index !Int !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*TypeHeaps !*CheckState
+	-> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*TypeHeaps, !*CheckState)
+
+checkSymbolType :: !Index !SymbolType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
+	-> (!SymbolType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
+
+checkTypeContexts :: ![TypeContext] !Index !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
+	-> (![TypeContext], !u:{#CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
+
+checkInstanceType :: !Index !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
+	-> (!InstanceType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
+
+checkDynamicTypes :: !Index ![ExprInfoPtr] !(Optional SymbolType) !u:{# CheckedTypeDef} !u:{# DclModule} !*TypeHeaps !*ExpressionHeap !*CheckState
+	-> (!u:{# CheckedTypeDef}, !u:{# DclModule}, !*TypeHeaps, !*ExpressionHeap, !*CheckState)
+
+createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !Int !*TypeVarHeap !*VarHeap !*CheckState
+	-> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*CheckState)
+
+isATopConsVar cv		:== cv < 0
+encodeTopConsVar cv		:== dec (~cv)
+decodeTopConsVar cv		:== ~(inc cv)
diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl
new file mode 100644
index 0000000..b649de0
--- /dev/null
+++ b/frontend/checktypes.icl
@@ -0,0 +1,1225 @@
+implementation module checktypes
+
+import StdEnv
+import syntax, checksupport, check, typesupport, utilities, RWSDebug
+
+
+::	TypeSymbols = 
+	{	ts_type_defs		:: !.{# CheckedTypeDef}
+	,	ts_cons_defs 		:: !.{# ConsDef}
+	,	ts_selector_defs	:: !.{# SelectorDef}
+	,	ts_modules			:: !.{# DclModule}
+	}
+	
+::	TypeInfo =
+	{	ti_heaps		:: !.TypeHeaps
+	}
+
+::	CurrentTypeInfo =
+	{	cti_module_index	:: !Index
+	,	cti_type_index		:: !Index
+	,	cti_lhs_attribute	:: !TypeAttribute
+	}
+
+class bindTypes type :: !CurrentTypeInfo !type !(!*TypeSymbols, !*TypeInfo, !*CheckState)
+	-> (!type, !TypeAttribute, !(!*TypeSymbols, !*TypeInfo, !*CheckState))
+
+instance bindTypes AType
+where
+	bindTypes cti atype=:{at_attribute,at_type} ts_ti_cs
+		# (at_type, type_attr, (ts, ti, cs)) = bindTypes cti at_type ts_ti_cs
+		  (combined_attribute, cs_error) = check_type_attribute at_attribute type_attr cti.cti_lhs_attribute cs.cs_error
+		= ({ atype & at_attribute = combined_attribute, at_type = at_type }, combined_attribute, (ts, ti, { cs & cs_error = cs_error }))
+	where
+		check_type_attribute :: !TypeAttribute !TypeAttribute !TypeAttribute !*ErrorAdmin -> (!TypeAttribute,!*ErrorAdmin)
+		check_type_attribute TA_Anonymous type_attr root_attr error
+			| try_to_combine_attributes type_attr root_attr
+				= (root_attr, error)
+				= (TA_Multi, checkError "" "conflicting attribution of type definition" error)
+		check_type_attribute TA_Unique type_attr root_attr error
+			| try_to_combine_attributes TA_Unique type_attr || try_to_combine_attributes TA_Unique root_attr
+				= (TA_Unique, error)
+				= (TA_Multi, checkError "" "conflicting attribution of type definition" error)
+		check_type_attribute (TA_Var var) _ _ error
+			= (TA_Multi, checkError var "attribute variable not allowed" error)
+		check_type_attribute (TA_RootVar var) _ _ error
+			= (TA_Multi, checkError var "attribute variable not allowed" error)
+		check_type_attribute _ type_attr root_attr error
+			= (type_attr, error)
+
+		try_to_combine_attributes :: !TypeAttribute !TypeAttribute -> Bool
+		try_to_combine_attributes TA_Multi _
+			= True
+		try_to_combine_attributes (TA_Var attr_var1) (TA_Var attr_var2)
+			= attr_var1.av_name == attr_var2.av_name
+		try_to_combine_attributes TA_Unique TA_Unique
+			= True
+		try_to_combine_attributes TA_Unique TA_Multi
+			= True
+		try_to_combine_attributes _ _
+			= False
+				
+instance bindTypes TypeVar
+where
+	bindTypes cti tv=:{tv_name=var_id=:{id_info}} (ts, ti, cs=:{cs_symbol_table})
+		#! var_def = sreadPtr id_info cs_symbol_table
+		= case var_def.ste_kind of
+			STE_BoundTypeVariable bv=:{stv_attribute, stv_info_ptr, stv_count}
+				# cs = { cs & cs_symbol_table = cs.cs_symbol_table <:= (id_info, { var_def & ste_kind = STE_BoundTypeVariable { bv & stv_count = inc stv_count }})}
+				-> ({ tv & tv_info_ptr = stv_info_ptr }, stv_attribute, (ts, ti, cs))
+			_
+				-> (tv, TA_Multi, (ts, ti, { cs & cs_error = checkError var_id "undefined" cs.cs_error }))
+
+
+instance bindTypes [a] | bindTypes a
+where
+	bindTypes cti [] ts_ti_cs
+		= ([], TA_Multi, ts_ti_cs)
+	bindTypes cti [x : xs] ts_ti_cs
+		# (x, _, ts_ti_cs) = bindTypes cti x ts_ti_cs
+		  (xs, attr, ts_ti_cs) = bindTypes cti xs ts_ti_cs
+		= ([x : xs], attr, ts_ti_cs)
+	
+
+instance bindTypes Type
+where
+	bindTypes cti (TV tv) ts_ti_cs
+		# (tv, attr, ts_ti_cs) = bindTypes cti tv ts_ti_cs
+		= (TV tv, attr, ts_ti_cs)
+	bindTypes cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} type=:(TA type_cons=:{type_name=type_name=:{id_info}} types)
+					(ts=:{ts_type_defs,ts_modules}, ti, cs=:{cs_symbol_table})
+		#! entry					= sreadPtr id_info cs_symbol_table
+		# (type_index, type_module)	= retrieveGlobalDefinition entry STE_Type cti_module_index
+		| type_index <> NotFound
+			# ({td_arity,td_attribute},type_index,ts_type_defs,ts_modules) = getTypeDef type_index type_module cti_module_index ts_type_defs ts_modules
+			  ts = { ts & ts_type_defs = ts_type_defs, ts_modules = ts_modules }
+			| td_arity >= type_cons.type_arity
+				# (types, _, ts_ti_cs) = bindTypes cti types (ts, ti, cs)
+				| type_module == cti_module_index && cti_type_index == type_index
+					= (TA { type_cons & type_index = { glob_object = type_index, glob_module = type_module}} types, cti_lhs_attribute, ts_ti_cs)
+					= (TA { type_cons & type_index = { glob_object = type_index, glob_module = type_module}} types,
+								determine_type_attribute td_attribute, ts_ti_cs)
+				= (type, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_name " used with wrong arity" cs.cs_error }))
+			= (type, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_name " undefined" cs.cs_error}))
+	where
+		determine_type_attribute TA_Unique		= TA_Unique
+		determine_type_attribute _				= TA_Multi
+	
+	bindTypes cti (arg_type --> res_type) ts_ti_cs
+		# (arg_type, _, ts_ti_cs) = bindTypes cti arg_type ts_ti_cs
+		  (res_type, _, ts_ti_cs) = bindTypes cti res_type ts_ti_cs
+		= (arg_type --> res_type, TA_Multi, ts_ti_cs)
+	bindTypes cti (CV tv :@: types) ts_ti_cs
+		# (tv, type_attr, ts_ti_cs) = bindTypes cti tv ts_ti_cs
+		  (types, _, ts_ti_cs) = bindTypes cti types ts_ti_cs
+		= (CV tv :@: types, type_attr, ts_ti_cs)
+	bindTypes cti type ts_ti_cs
+		= (type, TA_Multi, ts_ti_cs)
+	
+
+addToAttributeEnviron :: !TypeAttribute !TypeAttribute ![AttrInequality] !*ErrorAdmin -> (![AttrInequality],!*ErrorAdmin)
+addToAttributeEnviron TA_Multi _ attr_env error
+	= (attr_env, error)
+addToAttributeEnviron _ TA_Unique attr_env error
+	= (attr_env, error)
+addToAttributeEnviron (TA_Var attr_var) (TA_Var root_var) attr_env error
+	| attr_var.av_info_ptr == root_var.av_info_ptr
+		= (attr_env, error)
+		= ([ { ai_demanded = attr_var, ai_offered = root_var } :  attr_env], error)
+addToAttributeEnviron (TA_RootVar attr_var) root_attr attr_env error
+	= (attr_env, error)
+addToAttributeEnviron _ _ attr_env error
+	= (attr_env, checkError "" "inconsistent attribution of type definition" error)
+
+/*
+bindTypesOfCons :: !Index !Index ![TypeVar] ![AttributeVar] !AType ![DefinedSymbol] !Bool !Index !Level !TypeAttribute !Conditions !*TypeSymbols !*TypeInfo !*CheckState
+	-> *(!TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState)
+*/
+
+bindTypesOfConstructors _ _ _ _ _ [] ts_ti_cs
+	= ts_ti_cs
+bindTypesOfConstructors cti=:{cti_lhs_attribute} cons_index free_vars free_attrs type_lhs [{ds_index}:conses] (ts=:{ts_cons_defs}, ti=:{ti_heaps}, cs)
+	#! cons_def = ts_cons_defs.[ds_index]
+	# (exi_vars, (ti_heaps, cs))
+	  		= addExistentionalTypeVariablesToSymbolTable cti_lhs_attribute cons_def.cons_exi_vars ti_heaps cs
+	  (st_args, cons_arg_vars, st_attr_env, (ts, ti, cs))
+	  		= bind_types_of_cons cons_def.cons_type.st_args cti free_vars [] (ts, { ti  & ti_heaps = ti_heaps }, cs)
+	  cs_symbol_table = removeAttributedTypeVarsFromSymbolTable cOuterMostLevel exi_vars cs.cs_symbol_table
+	  (ts, ti, cs) = bindTypesOfConstructors cti (inc cons_index) free_vars free_attrs type_lhs conses
+							(ts, ti, { cs & cs_symbol_table = cs_symbol_table }) 
+	  cons_type = { cons_def.cons_type & st_vars = free_vars, st_args = st_args, st_result = type_lhs, st_attr_vars = free_attrs, st_attr_env = st_attr_env }
+	= ({ ts & ts_cons_defs = { ts.ts_cons_defs & [ds_index] =
+			{ cons_def & cons_type = cons_type, cons_index = cons_index, cons_type_index = cti.cti_type_index, cons_exi_vars = exi_vars,
+						 cons_arg_vars = cons_arg_vars }}}, ti, cs)
+where
+/*
+	check_types_of_cons :: ![AType] !Bool !Index  !Level ![TypeVar] !TypeAttribute ![AttrInequality] !Conditions !*TypeSymbols !*TypeInfo !*CheckState
+		-> *(![AType], ![[ATypeVar]], ![AttrInequality], !TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState)
+*/
+
+	bind_types_of_cons [] cti free_vars attr_env ts_ti_cs
+		= ([], [], attr_env, ts_ti_cs)
+	bind_types_of_cons [type : types] cti free_vars attr_env ts_ti_cs
+		# (types, local_vars_list, attr_env, ts_ti_cs)
+				= bind_types_of_cons types cti free_vars attr_env ts_ti_cs
+		  (type, type_attr, (ts, ti, cs)) = bindTypes cti type ts_ti_cs
+		  (local_vars, cs_symbol_table) = foldSt retrieve_local_vars free_vars ([], cs.cs_symbol_table)
+		  (attr_env, cs_error) = addToAttributeEnviron type_attr cti.cti_lhs_attribute attr_env cs.cs_error
+		= ([type : types], [local_vars : local_vars_list], attr_env, (ts, ti , { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }))
+	where 
+		retrieve_local_vars tv=:{tv_name={id_info}} (local_vars, symbol_table)
+			# (ste=:{ste_kind = STE_BoundTypeVariable bv=:{stv_attribute, stv_info_ptr, stv_count}}, symbol_table) = readPtr id_info symbol_table
+			| stv_count == 0
+				= (local_vars, symbol_table)
+				= ([{ atv_variable = { tv & tv_info_ptr = stv_info_ptr }, atv_attribute = stv_attribute, atv_annotation = AN_None } : local_vars],
+						symbol_table <:= (id_info, { ste & ste_kind = STE_BoundTypeVariable { bv & stv_count = 0}}))
+
+
+/*
+checkRhsOfTypeDef :: !CheckedTypeDef ![AttributeVar] !Bool !Index !Level !TypeAttribute !Index !Conditions !*TypeSymbols !*TypeInfo !*CheckState
+	-> (!TypeRhs, !TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState)
+*/
+checkRhsOfTypeDef {td_name,td_arity,td_args,td_rhs = td_rhs=:AlgType conses} attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} ts_ti_cs
+	# type_lhs = { at_annotation = AN_None, at_attribute = cti_lhs_attribute,
+			  	   at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_name td_arity)
+								[{at_annotation = AN_None, at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]}
+	  ts_ti_cs = bindTypesOfConstructors cti 0 [ atv_variable \\ {atv_variable} <- td_args] attr_vars type_lhs conses ts_ti_cs
+	= (td_rhs, ts_ti_cs)
+
+checkRhsOfTypeDef {td_name,td_arity,td_args,td_rhs = td_rhs=:RecordType {rt_constructor=rec_cons=:{ds_index}, rt_fields}}
+		attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} ts_ti_cs
+	# type_lhs = {	at_annotation = AN_None, at_attribute = cti_lhs_attribute,
+					at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_name td_arity)
+			[{at_annotation = AN_None, at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]}
+	  (ts, ti, cs) = bindTypesOfConstructors cti 0  [ atv_variable \\ {atv_variable} <- td_args]
+	  						attr_vars type_lhs [rec_cons] ts_ti_cs
+	#! rec_cons_def = ts.ts_cons_defs.[ds_index]
+	# {cons_type = { st_vars,st_args,st_result,st_attr_vars }, cons_exi_vars} = rec_cons_def
+	  (ts_selector_defs, cs_error) = check_selectors 0 rt_fields cti_type_index st_args st_result st_vars st_attr_vars cons_exi_vars ts.ts_selector_defs cs.cs_error
+	= (td_rhs, ({ ts & ts_selector_defs = ts_selector_defs }, ti, { cs & cs_error = cs_error}))
+where
+	check_selectors :: !Index !{# FieldSymbol} !Index ![AType] !AType ![TypeVar] ![AttributeVar] ![ATypeVar] !*{#SelectorDef} !*ErrorAdmin
+		-> (!*{#SelectorDef},!*ErrorAdmin)
+	check_selectors field_nr fields rec_type_index sel_types rec_type st_vars st_attr_vars exi_vars selector_defs error
+		| field_nr < size fields
+			# {fs_index} = fields.[field_nr]
+			#! sel_def = selector_defs.[fs_index]
+			# [sel_type:sel_types] = sel_types
+			# (st_attr_env, error) = addToAttributeEnviron sel_type.at_attribute rec_type.at_attribute [] error
+			  sd_type = { sel_def.sd_type &  st_arity = 1, st_args = [rec_type], st_result = sel_type, st_vars = st_vars,
+			  				st_attr_vars = st_attr_vars, st_attr_env = st_attr_env }
+			  selector_defs = { selector_defs & [fs_index] = { sel_def & sd_type = sd_type, sd_field_nr = field_nr, sd_type_index = rec_type_index,
+			  									sd_exi_vars = exi_vars  } }
+			= check_selectors (inc field_nr) fields rec_type_index sel_types  rec_type st_vars st_attr_vars exi_vars selector_defs error
+			= (selector_defs, error)
+checkRhsOfTypeDef {td_rhs = SynType type} _ cti ts_ti_cs
+	# (type, type_attr, ts_ti_cs) = bindTypes cti type ts_ti_cs
+	= (SynType type, ts_ti_cs)
+checkRhsOfTypeDef {td_rhs} _ _ ts_ti_cs
+	= (td_rhs, ts_ti_cs)
+
+emptyIdent name :== { id_name = name, id_info = nilPtr }
+
+isATopConsVar cv		:== cv < 0
+encodeTopConsVar cv		:== dec (~cv)
+decodeTopConsVar cv		:== ~(inc cv)
+
+// checkTypeDef :: !Bool !Index !Index  !*TypeSymbols !*TypeInfo !*CheckState -> (!Int, !Conditions, !*TypeSymbols, !*TypeInfo, !*CheckState);
+checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_heaps} cs=:{cs_error}
+	#! type_def = ts_type_defs.[type_index]
+	# {td_name,td_pos,td_args,td_attribute,td_properties} = type_def
+	  position = newPosition td_name td_pos
+	  cs_error = pushErrorAdmin position cs_error
+	  (td_attribute, attr_vars, th_attrs) = determine_root_attribute td_attribute td_name.id_name ti_heaps.th_attrs
+	  (type_vars, (attr_vars, ti_heaps, cs))
+	  		= addTypeVariablesToSymbolTable td_args attr_vars { ti_heaps & th_attrs = th_attrs } { cs & cs_error = cs_error }
+	  type_def = {	type_def & td_args = type_vars, td_index = type_index, td_attrs = attr_vars, td_attribute = td_attribute }
+	  (td_rhs, (ts, ti, cs)) = checkRhsOfTypeDef type_def attr_vars
+			{ cti_module_index = module_index, cti_type_index = type_index, cti_lhs_attribute = td_attribute } (ts,{ ti & ti_heaps = ti_heaps}, cs)
+	= ({ ts & ts_type_defs = { ts.ts_type_defs & [type_index] = { type_def & td_rhs = td_rhs }}}, ti,
+				{ cs &	cs_error = popErrorAdmin cs.cs_error,
+						cs_symbol_table = removeAttributedTypeVarsFromSymbolTable cOuterMostLevel type_vars cs.cs_symbol_table })
+where
+	determine_root_attribute TA_None name attr_var_heap
+		# (attr_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap
+		  new_var = { av_name = emptyIdent name, av_info_ptr = attr_info_ptr}
+		= (TA_Var new_var, [new_var], attr_var_heap)
+	determine_root_attribute TA_Unique name attr_var_heap
+		= (TA_Unique, [], attr_var_heap)
+
+CS_Checked	:== 1
+CS_Checking	:== 0
+
+::	SynTypeInfo =
+	{	sti_type_defs	::!.{# CheckedTypeDef}
+	,	sti_modules		::!.{# DclModule}
+	,	sti_marks		::!.{# Int}
+	}
+
+
+class expand a :: !Index !a !*SynTypeInfo !*CheckState -> (!a, !TypeAttribute, !*SynTypeInfo, !*CheckState)
+
+expandTypeVariable :: TypeVar !*SynTypeInfo !*CheckState -> (!Type, !TypeAttribute, !*SynTypeInfo, !*CheckState)
+expandTypeVariable {tv_name={id_info}} sti cs=:{cs_symbol_table}
+	#! {ste_kind = STE_BoundType {at_attribute,at_type}} = sreadPtr id_info cs_symbol_table
+	= (at_type, at_attribute, sti, cs)
+	
+
+instance expand Type
+where
+	expand module_index (TV tv) sti cs
+		= expandTypeVariable tv sti cs
+	expand module_index type=:(TA type_cons=:{type_name,type_index={glob_object,glob_module}} types) sti=:{sti_marks}  cs=:{cs_error,cs_symbol_table}
+		| module_index == glob_module
+			#! mark = sti_marks.[glob_object]
+			| mark == CS_NotChecked
+				# (sti, cs) = expandSynType module_index glob_object sti cs
+				  (types, attr, sti, cs) = expand module_index types sti cs
+				= (TA type_cons types, attr, sti, cs)
+			| mark == CS_Checked
+				# (types, attr, sti, cs) = expand module_index types sti cs
+				= (TA type_cons types, attr, sti, cs)
+//			| mark == CS_Checking
+				= (type, TA_None, sti, { cs & cs_error = checkError type_name "cyclic dependency between type synonyms" cs_error })
+			# (types, attr, sti, cs) = expand module_index types sti cs
+			= (TA type_cons types, attr, sti, cs)
+	expand module_index (arg_type --> res_type) sti cs
+		# (arg_type, _, sti, cs) = expand module_index arg_type sti cs
+		  (res_type, _, sti, cs) = expand module_index res_type sti cs
+		= (arg_type --> res_type, TA_None, sti, cs)
+	expand module_index (CV tv :@: types) sti cs
+		# (type, type_attr, sti, cs) = expandTypeVariable tv sti cs
+		  (types, _, sti, cs) = expand module_index types sti cs
+		= (simplify_type_appl type types, type_attr, sti, cs) 
+		where
+			simplify_type_appl :: !Type ![AType] -> Type
+			simplify_type_appl (TA type_cons=:{type_arity} cons_args) type_args
+				= TA { type_cons & type_arity = type_arity + length type_args } (cons_args ++ type_args)
+			simplify_type_appl (TV tv) type_args
+				= CV tv :@: type_args
+	expand module_index type sti cs
+		= (type, TA_None, sti, cs)
+
+instance expand [a] | expand a
+where
+	expand module_index [x:xs] sti cs
+		# (x, _, sti, cs) = expand module_index x sti cs
+		  (xs, _, sti, cs) = expand module_index xs sti cs
+		= ([x:xs], TA_None, sti, cs)
+	expand module_index [] sti cs
+		= ([], TA_None, sti, cs)
+
+instance expand AType
+where
+	expand module_index atype=:{at_type} sti cs
+		# (at_type, attr, sti, cs) = expand module_index at_type sti cs
+		= ({ atype & at_type = at_type, at_attribute = attr }, attr, sti, cs)
+
+class look_for_cycles a :: !Index !a !(!*SynTypeInfo, !*CheckState) -> (!*SynTypeInfo, !*CheckState)
+
+instance look_for_cycles Type
+where
+	look_for_cycles module_index type=:(TA type_cons=:{type_name,type_index={glob_object,glob_module}} types) (sti=:{sti_marks}, cs=:{cs_error})
+		| module_index == glob_module
+			#! mark = sti_marks.[glob_object]
+			| mark == CS_NotChecked
+				# (sti, cs) = expandSynType module_index glob_object sti cs
+				= look_for_cycles module_index types (sti, cs)
+			| mark == CS_Checked
+				= look_for_cycles module_index types (sti, cs)
+				= (sti, { cs & cs_error = checkError type_name "cyclic dependency between type synonyms" cs_error })
+		= look_for_cycles module_index types (sti, cs)
+	look_for_cycles module_index (arg_type --> res_type) state
+		= look_for_cycles module_index res_type (look_for_cycles module_index arg_type state)
+	look_for_cycles module_index (type :@: types) state
+		= look_for_cycles module_index types state
+	look_for_cycles module_index type state
+		= state
+	
+instance look_for_cycles [a] | look_for_cycles a
+where
+	look_for_cycles mod_index l state
+		= foldr (look_for_cycles mod_index) state l
+
+instance look_for_cycles AType
+where
+	look_for_cycles mod_index {at_type} state
+		= look_for_cycles mod_index at_type state
+
+expandSynType ::  !Index !Index !*SynTypeInfo !*CheckState -> (!*SynTypeInfo, !*CheckState)
+expandSynType mod_index type_index sti=:{sti_type_defs,sti_marks,sti_modules} cs
+	#! type_def = sti_type_defs.[type_index]
+	= case type_def.td_rhs of
+		SynType type=:{at_type = TA {type_name,type_index={glob_object,glob_module}} types}
+	   		# (type_def2,_,sti_type_defs,sti_modules) = getTypeDef glob_object glob_module mod_index sti_type_defs sti_modules
+			-> case type_def2.td_rhs of
+				SynType rhs_type
+					# cs_symbol_table = bind_args type_def2.td_args types cs.cs_symbol_table
+					  position = newPosition type_def.td_name type_def.td_pos
+					  cs_error = pushErrorAdmin position cs.cs_error
+	  		  		  sti_marks = { sti_marks & [type_index] = CS_Checking }			  
+					  (exp_type, _, sti, cs) = expand mod_index  rhs_type.at_type
+									{ sti_type_defs = sti_type_defs, sti_modules = sti_modules, sti_marks = sti_marks }
+									{ cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }
+					-> ({sti & sti_type_defs = { sti.sti_type_defs & [type_index] = { type_def & td_rhs = SynType { type & at_type = exp_type }}},
+						 sti_marks = { sti.sti_marks & [type_index] = CS_Checked }},
+							{ cs & cs_symbol_table = free_args type_def2.td_args cs.cs_symbol_table, cs_error = popErrorAdmin cs.cs_error })
+				_
+					# sti_marks = { sti_marks & [type_index] = CS_Checking }
+					  position = newPosition type_def.td_name type_def.td_pos
+	  		  		  (sti, cs) = look_for_cycles mod_index types
+	  		  		   			({ sti_type_defs = sti_type_defs, sti_modules = sti_modules, sti_marks = sti_marks },
+	  		  		   			{ cs & cs_error = pushErrorAdmin position cs.cs_error })
+					-> ({ sti & sti_marks = { sti.sti_marks & [type_index] = CS_Checked }}, { cs & cs_error = popErrorAdmin cs.cs_error })
+
+		_
+			-> ({ sti_type_defs = sti_type_defs, sti_modules = sti_modules, sti_marks = { sti_marks & [type_index] = CS_Checked }}, cs)
+where
+	bind_args [{atv_variable = {tv_name = {id_info}}} : type_vars] [type : types] symbol_table
+		#! entry = sreadPtr id_info symbol_table
+		= bind_args type_vars types symbol_table  <:= (id_info,
+					{ ste_index = NoIndex, ste_kind = STE_BoundType type, ste_def_level = cGlobalScope, ste_previous = entry })
+	bind_args [] [] symbol_table
+		= symbol_table
+		
+	free_args [{atv_variable = {tv_name = {id_info}}} : type_vars] symbol_table
+		#! {ste_previous} = sreadPtr id_info symbol_table
+		= free_args type_vars (symbol_table <:= (id_info, ste_previous))
+	free_args [] symbol_table
+		= symbol_table
+
+instance toString KindInfo
+where
+	toString (KI_Var ptr) 		= "*" +++ toString (ptrToInt ptr)
+	toString (KI_Const) 		= "*"
+	toString (KI_Arrow kinds)	= kind_list_to_string kinds
+	where
+		kind_list_to_string [k] = "* -> *"
+		kind_list_to_string [k:ks] = "* -> " +++ kind_list_to_string ks
+/*
+instance toString TypeKind
+where
+	toString (KindVar var_num) = "*" +++ toString var_num
+	toString (KindConst) = "*"
+	toString (KindArrow [k:ks]) = toString k +++ kind_list_to_string ks +++ " -> *"
+	where
+		kind_list_to_string [] = ""
+		kind_list_to_string [k:ks] = " -> " +++ toString k +++ kind_list_to_string ks
+*/
+checkTypeDefs :: !Bool !*{# CheckedTypeDef} !Index !Int !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*TypeHeaps !*CheckState
+	-> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*TypeHeaps, !*CheckState)
+checkTypeDefs is_main_dcl type_defs module_index nr_of_types cons_defs selector_defs modules heaps cs
+	#  ts = { ts_type_defs = type_defs, ts_cons_defs = cons_defs, ts_selector_defs = selector_defs, ts_modules = modules }
+	   ti = { ti_heaps = heaps  }
+	= check_type_defs is_main_dcl 0 nr_of_types module_index ts ti cs
+where
+	check_type_defs is_main_dcl type_index nr_of_types module_index ts ti=:{ti_heaps} cs
+		| type_index == nr_of_types
+			| cs.cs_error.ea_ok && not is_main_dcl
+				# marks = createArray nr_of_types CS_NotChecked
+				  (type_defs, modules, cs) = expand_syn_types module_index 0 nr_of_types
+				  		{ sti_type_defs = ts.ts_type_defs, sti_modules = ts.ts_modules, sti_marks = marks } cs
+				= (type_defs, ts.ts_cons_defs, ts.ts_selector_defs, modules, ti_heaps, cs)
+			= (ts.ts_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, ts.ts_modules, ti_heaps, cs)
+			# (ts, ti, cs) = checkTypeDef type_index module_index ts ti cs
+			= check_type_defs is_main_dcl (inc type_index) nr_of_types module_index ts ti cs
+
+	expand_syn_types module_index type_index nr_of_types sti cs
+		| type_index == nr_of_types
+			= (sti.sti_type_defs, sti.sti_modules, cs)
+		| sti.sti_marks.[type_index] == CS_NotChecked
+			# (sti, cs) = expandSynType module_index type_index sti cs
+			= expand_syn_types module_index (inc type_index) nr_of_types sti cs
+			= expand_syn_types module_index (inc type_index) nr_of_types sti cs
+
+::	OpenTypeInfo =
+	{	oti_heaps		:: !.TypeHeaps
+	,	oti_all_vars	:: ![TypeVar]
+	,	oti_all_attrs	:: ![AttributeVar]
+	,	oti_global_vars	:: ![TypeVar]
+	}
+
+::	OpenTypeSymbols =
+	{	ots_type_defs	:: .{# CheckedTypeDef}
+	,	ots_modules		:: .{# DclModule}
+	}
+
+determineAttributeVariable attr_var=:{av_name=attr_name=:{id_info}} oti=:{oti_heaps,oti_all_attrs} symbol_table
+	#! entry = sreadPtr id_info symbol_table
+	# {ste_kind,ste_def_level} = entry
+	| ste_kind == STE_Empty || ste_def_level == cModuleScope
+		#! (new_attr_ptr, th_attrs) = newPtr AVI_Empty oti_heaps.th_attrs
+		# symbol_table = symbol_table <:= (id_info,{	ste_index = NoIndex, ste_kind = STE_TypeAttribute new_attr_ptr,
+														ste_def_level = cGlobalScope, ste_previous = entry })
+		  new_attr = { attr_var & av_info_ptr = new_attr_ptr}
+		= (new_attr, { oti & oti_heaps = { oti_heaps & th_attrs = th_attrs }, oti_all_attrs = [new_attr : oti_all_attrs] }, symbol_table)
+		# (STE_TypeAttribute attr_ptr) = ste_kind
+		= ({ attr_var & av_info_ptr = attr_ptr}, oti, symbol_table)
+
+::	DemandedAttributeKind = DAK_Ignore | DAK_Unique | DAK_None
+
+newAttribute DAK_Ignore var_name _ oti cs
+	= (TA_Multi, oti, cs)
+newAttribute DAK_Unique var_name new_attr  oti cs
+	= case new_attr of
+		TA_Unique
+			-> (TA_Unique, oti, cs)
+		TA_Multi
+			-> (TA_Unique, oti, cs)
+		TA_None
+			-> (TA_Unique, oti, cs)
+		_
+			-> (TA_Unique, oti, { cs & cs_error = checkError var_name "inconsistently attributed (1)" cs.cs_error })
+newAttribute DAK_None var_name (TA_Var attr_var) oti cs=:{cs_symbol_table}
+	# (attr_var, oti, cs_symbol_table) = determineAttributeVariable attr_var oti cs_symbol_table
+	= (TA_Var attr_var, oti, { cs & cs_symbol_table = cs_symbol_table })
+newAttribute DAK_None var_name TA_Anonymous oti=:{oti_heaps, oti_all_attrs} cs
+	# (new_attr_ptr, th_attrs) = newPtr AVI_Empty oti_heaps.th_attrs
+	  new_attr = { av_info_ptr = new_attr_ptr, av_name = emptyIdent var_name }
+	= (TA_Var new_attr, { oti & oti_heaps = { oti_heaps & th_attrs = th_attrs }, oti_all_attrs = [new_attr : oti_all_attrs] }, cs)
+newAttribute DAK_None var_name TA_Unique oti cs
+	= (TA_Unique, oti, cs)
+newAttribute DAK_None var_name attr oti cs
+	= (TA_Multi, oti, cs)
+			
+
+getTypeDef :: !Index !Index !Index !u:{# CheckedTypeDef} !v:{# DclModule} -> (!CheckedTypeDef, !Index , !u:{# CheckedTypeDef}, !v:{# DclModule})
+getTypeDef type_index type_module module_index type_defs modules
+	| type_module == module_index
+		#! type_def = type_defs.[type_index]
+		= (type_def, type_index, type_defs, modules)
+		#! {dcl_common={com_type_defs},dcl_conversions} = modules.[type_module]
+		#! type_def = com_type_defs.[type_index]
+		#  type_index = convertIndex type_index (toInt STE_Type) dcl_conversions
+		= (type_def, type_index, type_defs, modules)
+
+getClassDef :: !Index !Index !Index !u:{# ClassDef} !v:{# DclModule} -> (!ClassDef, !Index , !u:{# ClassDef}, !v:{# DclModule})
+getClassDef class_index type_module module_index class_defs modules
+	| type_module == module_index
+		#! si = size class_defs
+		#! class_def = class_defs.[class_index]
+		= (class_def, class_index, class_defs, modules)
+		#! {dcl_common={com_class_defs},dcl_conversions} = modules.[type_module]
+		#! class_def = com_class_defs.[class_index]
+		#  class_index = convertIndex class_index (toInt STE_Class) dcl_conversions
+		= (class_def, class_index, class_defs, modules)
+
+
+checkTypeVar mod_index scope dem_attr tv=:{tv_name=var_name=:{id_name,id_info}} tv_attr (ots, oti, cs=:{cs_symbol_table})
+	#! entry = sreadPtr id_info cs_symbol_table
+	# {ste_kind,ste_def_level} = entry
+	| ste_kind == STE_Empty || ste_def_level == cModuleScope
+		# (new_attr, oti=:{oti_heaps,oti_all_vars}, cs) = newAttribute dem_attr id_name tv_attr oti cs
+		  (new_var_ptr, th_vars) = newPtr (TVI_Attribute new_attr) oti_heaps.th_vars
+		  new_var = { tv & tv_info_ptr = new_var_ptr }
+		= (new_var, new_attr, (ots, { oti & oti_heaps = { oti_heaps & th_vars = th_vars }, oti_all_vars = [new_var : oti_all_vars]},
+				{ cs & cs_symbol_table = cs.cs_symbol_table <:= (id_info, {ste_index = NoIndex, ste_kind = STE_TypeVariable new_var_ptr,
+								ste_def_level = scope, ste_previous = entry })}))
+		# (STE_TypeVariable tv_info_ptr) = ste_kind
+		  {oti_heaps} = oti
+		  (var_info, th_vars) = readPtr tv_info_ptr oti_heaps.th_vars
+		  (var_attr, oti, cs) = check_attribute id_name dem_attr var_info tv_attr { oti & oti_heaps = { oti_heaps & th_vars = th_vars }} cs
+		= ({ tv & tv_info_ptr = tv_info_ptr }, var_attr, (ots, oti, cs))
+where
+	check_attribute var_name DAK_Ignore (TVI_Attribute prev_attr) this_attr oti cs=:{cs_error}
+		= (TA_Multi, oti, cs)
+	check_attribute var_name dem_attr (TVI_Attribute prev_attr) this_attr oti cs=:{cs_error}
+		# (new_attr, cs_error) = determine_attribute var_name dem_attr this_attr cs_error
+		= check_var_attribute prev_attr new_attr oti { cs & cs_error = cs_error }
+	where					
+		check_var_attribute (TA_Var old_var) (TA_Var new_var) oti cs=:{cs_symbol_table,cs_error}
+			# (new_var, oti, cs_symbol_table) = determineAttributeVariable new_var oti cs_symbol_table
+			| old_var.av_info_ptr == new_var.av_info_ptr
+				= (TA_Var old_var, oti, { cs &  cs_symbol_table = cs_symbol_table })
+				= (TA_Var old_var, oti, { cs &  cs_symbol_table = cs_symbol_table,
+						cs_error = checkError new_var.av_name "inconsistently attributed (4)" cs_error })
+		check_var_attribute var_attr=:(TA_Var old_var) TA_Anonymous oti cs
+			= (var_attr, oti, cs)
+		check_var_attribute TA_Unique new_attr oti cs
+			= case new_attr of
+				TA_Unique
+					-> (TA_Unique, oti, cs)
+				_
+					-> (TA_Unique, oti, { cs & cs_error = checkError var_name "inconsistently attributed (5)" cs.cs_error })
+		check_var_attribute TA_Multi new_attr oti cs
+			= case new_attr of
+				TA_Multi
+					-> (TA_Multi, oti, cs)
+				TA_None
+					-> (TA_Multi, oti, cs)
+				_
+					-> (TA_Multi, oti, { cs & cs_error = checkError var_name "inconsistently attributed (6)" cs.cs_error })
+		check_var_attribute var_attr new_attr oti cs
+			= (var_attr, oti, { cs & cs_error = checkError var_name "inconsistently attributed (7)" cs.cs_error })// ---> (var_attr, new_attr)
+		
+		
+		determine_attribute var_name DAK_Unique new_attr error
+			= case new_attr of
+				 TA_Multi
+				 	-> (TA_Unique, error)
+				 TA_None
+				 	-> (TA_Unique, error)
+				 TA_Unique
+				 	-> (TA_Unique, error)
+				 _
+				 	-> (TA_Unique, checkError var_name "inconsistently attributed (3)" error)
+		determine_attribute var_name dem_attr TA_None error
+			= (TA_Multi, error)
+		determine_attribute var_name dem_attr new_attr error
+			= (new_attr, error)
+
+	check_attribute var_name dem_attr _ this_attr oti cs
+		= (TA_Multi, oti, cs)
+
+
+checkOpenAType mod_index scope dem_attr type=:{at_type = TV tv, at_attribute} ots_oti_cs
+	# (tv, at_attribute, ots_oti_cs) = checkTypeVar mod_index scope dem_attr tv at_attribute ots_oti_cs
+	= ({ type & at_type = TV tv, at_attribute = at_attribute }, ots_oti_cs)
+checkOpenAType mod_index scope dem_attr type=:{at_type = GTV var_id=:{tv_name={id_info}}} (ots, oti=:{oti_heaps,oti_global_vars}, cs=:{cs_symbol_table})
+	# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
+	  (type_var, oti_global_vars, th_vars, entry)
+			= retrieve_global_variable var_id entry oti_global_vars oti_heaps.th_vars
+	= ({type & at_type = TV type_var, at_attribute = TA_Multi }, (ots, { oti & oti_heaps = { oti_heaps & th_vars = th_vars }, oti_global_vars = oti_global_vars },
+								{ cs & cs_symbol_table = cs_symbol_table <:= (id_info, entry) }))
+where
+	retrieve_global_variable var entry=:{ste_kind = STE_Empty} global_vars var_heap
+		# (new_var_ptr, var_heap) = newPtr TVI_Used var_heap
+		  var = { var & tv_info_ptr = new_var_ptr }
+		= (var, [var : global_vars], var_heap, 
+				{ entry  & ste_kind = STE_TypeVariable new_var_ptr, ste_def_level = cModuleScope, ste_previous = entry }) 
+	retrieve_global_variable var entry=:{ste_kind,ste_def_level, ste_previous} global_vars var_heap
+		| ste_def_level == cModuleScope
+			= case ste_kind of
+				STE_TypeVariable glob_info_ptr
+					# var = { var & tv_info_ptr = glob_info_ptr }
+					  (var_info, var_heap) = readPtr glob_info_ptr var_heap
+					-> case var_info of
+						TVI_Empty
+							-> (var, [var : global_vars], var_heap <:= (glob_info_ptr, TVI_Used), entry)
+						TVI_Used
+							-> (var, global_vars, var_heap, entry)
+			# (var, global_vars, var_heap, ste_previous) = retrieve_global_variable var ste_previous global_vars var_heap
+			= (var, global_vars, var_heap, { entry & ste_previous = ste_previous })
+
+checkOpenAType mod_index scope dem_attr type=:{ at_type=TA type_cons=:{type_name=type_name=:{id_name,id_info}} types, at_attribute}
+		(ots=:{ots_type_defs,ots_modules}, oti, cs=:{cs_symbol_table,cs_error})
+	#! entry = sreadPtr id_info cs_symbol_table
+	# (type_index, type_module) = retrieveGlobalDefinition entry STE_Type mod_index
+	| type_index <> NotFound
+		# ({td_arity,td_args,td_attribute},type_index,ots_type_defs,ots_modules) = getTypeDef type_index type_module mod_index ots_type_defs ots_modules
+		  ots = { ots & ots_type_defs = ots_type_defs, ots_modules = ots_modules }
+		| type_cons.type_arity <= td_arity
+			# type_cons = { type_cons & type_index = { glob_object = type_index, glob_module = type_module }}
+			  (types, (ots, oti, cs)) = check_args_of_type_cons mod_index scope dem_attr types td_args (ots, oti, cs)
+			  (new_attr, oti, cs) = newAttribute (new_demanded_attribute dem_attr td_attribute) id_name at_attribute oti cs
+			= ({ type & at_type = TA type_cons types, at_attribute = new_attr } , (ots, oti, cs)) 
+			= (type, (ots, oti, {cs & cs_error = checkError type_name "used with wrong arity" cs_error}))
+		= (type, (ots, oti, {cs & cs_error = checkError type_name "undefined" cs_error}))
+where
+	check_args_of_type_cons mod_index scope dem_attr [] _ cot_state
+		= ([], cot_state)
+	check_args_of_type_cons mod_index scope dem_attr [arg_type : arg_types] [ {atv_attribute} : td_args ] cot_state
+		# (arg_type, cot_state) = checkOpenAType mod_index scope (new_demanded_attribute dem_attr atv_attribute) arg_type cot_state
+		  (arg_types, cot_state) = check_args_of_type_cons mod_index scope dem_attr arg_types td_args cot_state
+		= ([arg_type : arg_types], cot_state)
+
+	new_demanded_attribute DAK_Ignore _
+		= DAK_Ignore
+	new_demanded_attribute _ TA_Unique
+		= DAK_Unique
+	new_demanded_attribute dem_attr _
+		= dem_attr
+
+checkOpenAType mod_index scope dem_attr type=:{at_type = arg_type --> result_type, at_attribute} cot_state
+	# (arg_type, cot_state) = checkOpenAType mod_index scope DAK_None arg_type cot_state
+	  (result_type, (ots, oti, cs)) = checkOpenAType mod_index scope DAK_None result_type cot_state
+	  (new_attr, oti, cs) = newAttribute dem_attr "-->" at_attribute oti cs
+	= ({ type & at_type = arg_type --> result_type, at_attribute = new_attr }, (ots, oti, cs))
+checkOpenAType mod_index scope dem_attr type=:{at_type = CV tv :@: types, at_attribute} cot_state
+	# (cons_var, _, cot_state) =  checkTypeVar mod_index scope DAK_None tv TA_Multi cot_state
+	  (types, (ots, oti, cs)) = mapSt (checkOpenAType mod_index scope DAK_None) types cot_state
+	  (new_attr, oti, cs) = newAttribute dem_attr ":@:" at_attribute oti cs
+	= ({ type & at_type = CV cons_var :@: types, at_attribute = new_attr }, (ots, oti, cs))
+checkOpenAType mod_index scope dem_attr type=:{at_attribute} (ots, oti, cs)
+	# (new_attr, oti, cs) = newAttribute dem_attr "." at_attribute oti cs
+	= ({ type & at_attribute = new_attr}, (ots, oti, cs))
+
+checkOpenTypes mod_index scope dem_attr types cot_state
+	= mapSt (checkOpenType mod_index scope dem_attr) types cot_state
+
+checkOpenType mod_index scope dem_attr type cot_state
+	# ({at_type}, cot_state) = checkOpenAType mod_index scope dem_attr { at_type = type, at_attribute = TA_Multi, at_annotation = AN_None } cot_state
+	= (at_type, cot_state)
+	
+checkOpenATypes mod_index scope types cot_state
+	= mapSt (checkOpenAType mod_index scope DAK_None) types cot_state
+
+checkInstanceType :: !Index !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
+	-> (!InstanceType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
+checkInstanceType mod_index it=:{it_types,it_context} specials type_defs class_defs modules heaps cs
+	# ots = { ots_type_defs = type_defs, ots_modules = modules }
+	  oti = { oti_heaps = heaps, oti_all_vars = [], oti_all_attrs = [], oti_global_vars= [] }
+	  (it_types, (ots, {oti_heaps,oti_all_vars,oti_all_attrs}, cs)) = checkOpenTypes mod_index cGlobalScope DAK_None it_types (ots, oti, cs)
+	  (it_context, type_defs, class_defs, modules, heaps, cs) = checkTypeContexts it_context mod_index ots.ots_type_defs class_defs ots.ots_modules oti_heaps cs
+	  (specials, cs) = checkSpecialTypeVars specials cs 
+	  cs_symbol_table = removeVariablesFromSymbolTable cGlobalScope oti_all_vars cs.cs_symbol_table
+	  cs_symbol_table = removeAttributesFromSymbolTable oti_all_attrs cs_symbol_table
+	  (specials, type_defs, modules, heaps, cs) = checkSpecialTypes mod_index specials type_defs modules heaps { cs & cs_symbol_table = cs_symbol_table }
+	= ({it & it_vars = oti_all_vars, it_types = it_types, it_attr_vars = oti_all_attrs, it_context = it_context },
+	    	specials, type_defs, class_defs, modules, heaps, cs)
+	
+checkSymbolType :: !Index !SymbolType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
+	-> (!SymbolType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
+checkSymbolType  mod_index st=:{st_args,st_result,st_context,st_attr_env} specials type_defs class_defs modules heaps cs
+	# ots = { ots_type_defs = type_defs, ots_modules = modules }
+	  oti = { oti_heaps = heaps, oti_all_vars = [], oti_all_attrs = [], oti_global_vars= [] }
+	  (st_args, cot_state) = checkOpenATypes mod_index cGlobalScope st_args (ots, oti, cs)
+	  (st_result, (ots, {oti_heaps,oti_all_vars,oti_all_attrs}, cs)) = checkOpenAType mod_index cGlobalScope DAK_None st_result cot_state
+	  (st_context, type_defs, class_defs, modules, heaps, cs) = checkTypeContexts st_context mod_index ots.ots_type_defs class_defs ots.ots_modules oti_heaps cs
+	  (st_attr_env, cs) = check_attr_inequalities st_attr_env cs
+	  (specials, cs) = checkSpecialTypeVars specials cs 
+	  cs_symbol_table = removeVariablesFromSymbolTable cGlobalScope oti_all_vars cs.cs_symbol_table
+	  cs_symbol_table = removeAttributesFromSymbolTable oti_all_attrs cs_symbol_table
+	  (specials, type_defs, modules, heaps, cs) = checkSpecialTypes mod_index specials type_defs modules heaps { cs & cs_symbol_table = cs_symbol_table }
+	= ({st & st_vars = oti_all_vars, st_args = st_args, st_result = st_result, st_context = st_context,
+	    st_attr_vars = oti_all_attrs, st_attr_env = st_attr_env }, specials, type_defs, class_defs, modules, heaps, cs)// ---> (st, "--->", st_args, st_result)
+where
+	check_attr_inequalities [ineq : ineqs] cs
+		# (ineq, cs) = check_attr_inequality ineq cs
+		  (ineqs, cs) = check_attr_inequalities ineqs cs
+		= ([ineq : ineqs], cs)
+	check_attr_inequalities [] cs
+		= ([], cs)
+
+	check_attr_inequality ineq=:{ai_demanded=ai_demanded=:{av_name=dem_name},ai_offered=ai_offered=:{av_name=off_name}} cs=:{cs_symbol_table,cs_error}
+		#! dem_entry = sreadPtr dem_name.id_info cs_symbol_table
+		# (found_dem_attr, dem_attr_ptr) = retrieve_attribute dem_entry
+		| found_dem_attr
+		   	#! off_entry = sreadPtr off_name.id_info cs_symbol_table
+			# (found_off_attr, off_attr_ptr) = retrieve_attribute off_entry
+			| found_off_attr
+				= ({ai_demanded = { ai_demanded & av_info_ptr = dem_attr_ptr }, ai_offered = { ai_offered & av_info_ptr = off_attr_ptr }}, cs)
+				= (ineq, { cs & cs_error = checkError off_name "attribute variable undefined" cs_error })
+			= (ineq, { cs & cs_error = checkError dem_name "attribute variable undefined" cs_error })
+
+	retrieve_attribute {ste_kind = STE_TypeAttribute attr_ptr, ste_def_level, ste_index}
+		| ste_def_level == cGlobalScope
+			= (True, attr_ptr)
+	retrieve_attribute entry
+		= (False, abort "no attribute")
+
+checkTypeContexts :: ![TypeContext] !Index !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
+	-> (![TypeContext], !u:{#CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
+checkTypeContexts [tc : tcs] mod_index type_defs class_defs modules heaps cs
+	# (tc, type_defs, class_defs, modules, heaps, cs) = check_type_context tc mod_index type_defs class_defs modules heaps cs
+	  (tcs, type_defs, class_defs, modules, heaps, cs) =  checkTypeContexts tcs mod_index type_defs class_defs modules heaps cs
+	= ([tc : tcs], type_defs, class_defs, modules, heaps, cs)
+where
+
+	check_type_context :: !TypeContext !Index v:{#CheckedTypeDef} !x:{#ClassDef} !u:{#.DclModule} !*TypeHeaps !*CheckState
+		-> (!TypeContext,!z:{#CheckedTypeDef},!x:{#ClassDef},!w:{#DclModule},!*TypeHeaps,!*CheckState), [u v <= w, v u <= z]
+	check_type_context tc=:{tc_class=tc_class=:{glob_object=class_name=:{ds_ident={id_name,id_info},ds_arity}},tc_types}
+		mod_index type_defs class_defs modules heaps cs=:{cs_symbol_table}
+		#! entry = sreadPtr id_info cs_symbol_table
+		# (class_index, class_module) = retrieveGlobalDefinition entry STE_Class mod_index
+		| class_index <> NotFound
+			# (class_def, class_index, class_defs, modules) = getClassDef class_index class_module mod_index class_defs modules
+			  ots = { ots_modules = modules, ots_type_defs = type_defs }
+			  oti = { oti_heaps = heaps, oti_all_vars = [], oti_all_attrs = [], oti_global_vars = [] }
+			  (tc_types, (ots, {oti_all_vars,oti_all_attrs,oti_heaps}, cs)) = checkOpenTypes mod_index cGlobalScope DAK_Ignore tc_types (ots, oti, cs)		
+			  cs = foldr (\ {tv_name} cs=:{cs_symbol_table,cs_error} -> 
+						 { cs & cs_symbol_table =  removeDefinitionFromSymbolTable cGlobalScope tv_name cs_symbol_table,
+						   cs_error = checkError tv_name " undefined" cs_error}) cs oti_all_vars 
+			  cs = foldr (\ {av_name} cs=:{cs_symbol_table,cs_error} -> 
+						 { cs & cs_symbol_table =  removeDefinitionFromSymbolTable cGlobalScope av_name cs_symbol_table,
+						   cs_error = checkError av_name " undefined" cs_error}) cs oti_all_attrs 
+			  tc = { tc & tc_class = { tc_class & glob_object = { class_name & ds_index = class_index }, glob_module = class_module }, tc_types = tc_types}
+			| class_def.class_arity == ds_arity
+				= (tc, ots.ots_type_defs, class_defs, ots.ots_modules, oti_heaps, cs)
+				= (tc, ots.ots_type_defs, class_defs, ots.ots_modules, oti_heaps, {  cs & cs_error = checkError id_name "used with wrong arity" cs.cs_error })
+			= (tc, type_defs, class_defs, modules, heaps, { cs & cs_error = checkError id_name "undefined" cs.cs_error })
+checkTypeContexts [] _ type_defs class_defs modules heaps cs
+	= ([], type_defs, class_defs, modules, heaps, cs)
+
+checkDynamicTypes :: !Index ![ExprInfoPtr] !(Optional SymbolType) !u:{# CheckedTypeDef} !u:{# DclModule} !*TypeHeaps !*ExpressionHeap !*CheckState
+	-> (!u:{# CheckedTypeDef}, !u:{# DclModule}, !*TypeHeaps, !*ExpressionHeap, !*CheckState)
+checkDynamicTypes mod_index dyn_type_ptrs No type_defs modules type_heaps expr_heap cs
+	# (type_defs, modules, heaps, expr_heap, cs) = checkDynamics mod_index (inc cModuleScope) dyn_type_ptrs type_defs modules type_heaps expr_heap cs
+	  (expr_heap, cs_symbol_table) = remove_global_type_variables_in_dynamics dyn_type_ptrs (expr_heap, cs.cs_symbol_table)
+	= (type_defs, modules, heaps, expr_heap, { cs & cs_symbol_table = cs_symbol_table })
+where
+	remove_global_type_variables_in_dynamics dyn_info_ptrs expr_heap_and_symbol_table
+		= foldSt remove_global_type_variables_in_dynamic dyn_info_ptrs expr_heap_and_symbol_table
+	where
+		remove_global_type_variables_in_dynamic dyn_info_ptr (expr_heap, symbol_table)
+			# (dyn_info, expr_heap) = readPtr dyn_info_ptr expr_heap
+			= case dyn_info of
+				EI_Dynamic (Yes {dt_global_vars})
+					-> (expr_heap, remove_global_type_variables dt_global_vars symbol_table)
+				EI_Dynamic No
+					-> (expr_heap, symbol_table)
+				EI_DynamicTypeWithVars loc_type_vars {dt_global_vars} loc_dynamics
+					-> remove_global_type_variables_in_dynamics loc_dynamics (expr_heap, remove_global_type_variables dt_global_vars symbol_table)
+						
+	
+		remove_global_type_variables global_vars symbol_table
+			= foldSt remove_global_type_variable global_vars symbol_table
+		where		
+			remove_global_type_variable {tv_name=tv_name=:{id_info}} symbol_table
+				# (entry, symbol_table) = readPtr id_info symbol_table
+				| entry.ste_kind == STE_Empty
+					= symbol_table
+					= symbol_table <:= (id_info, entry.ste_previous)
+							 
+checkDynamicTypes mod_index dyn_type_ptrs (Yes {st_vars}) type_defs modules type_heaps expr_heap cs=:{cs_symbol_table}
+	# (th_vars, cs_symbol_table) = foldSt add_type_variable_to_symbol_table st_vars (type_heaps.th_vars, cs_symbol_table)
+	  (type_defs, modules, heaps, expr_heap, cs) = checkDynamics mod_index (inc cModuleScope) dyn_type_ptrs type_defs modules
+	  		{ type_heaps & th_vars = th_vars } expr_heap { cs & cs_symbol_table = cs_symbol_table }
+	  cs_symbol_table =	removeVariablesFromSymbolTable cModuleScope st_vars cs.cs_symbol_table
+	  (expr_heap, cs) = check_global_type_variables_in_dynamics dyn_type_ptrs (expr_heap, { cs & cs_symbol_table = cs_symbol_table })
+	= (type_defs, modules, heaps, expr_heap, cs) 
+where
+	add_type_variable_to_symbol_table {tv_name={id_info},tv_info_ptr} (var_heap,symbol_table)
+		# (entry, symbol_table) = readPtr id_info symbol_table
+		= (	var_heap <:= (tv_info_ptr, TVI_Empty),
+			symbol_table <:= (id_info, {ste_index = NoIndex, ste_kind = STE_TypeVariable tv_info_ptr,
+									ste_def_level = cModuleScope, ste_previous = entry }))
+
+	check_global_type_variables_in_dynamics dyn_info_ptrs expr_heap_and_cs
+		= foldSt check_global_type_variables_in_dynamic dyn_info_ptrs expr_heap_and_cs
+	where
+		check_global_type_variables_in_dynamic dyn_info_ptr (expr_heap, cs)
+			# (dyn_info, expr_heap) = readPtr dyn_info_ptr expr_heap
+			= case dyn_info of
+				EI_Dynamic (Yes {dt_global_vars})
+					-> (expr_heap, check_global_type_variables dt_global_vars cs)
+				EI_Dynamic No
+					-> (expr_heap, cs)
+				EI_DynamicTypeWithVars loc_type_vars {dt_global_vars} loc_dynamics
+					-> check_global_type_variables_in_dynamics loc_dynamics (expr_heap, check_global_type_variables dt_global_vars cs)
+						
+	
+		check_global_type_variables global_vars cs
+			= foldSt check_global_type_variable global_vars cs
+		where		
+			check_global_type_variable {tv_name=tv_name=:{id_info}} cs=:{cs_symbol_table, cs_error}
+				# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
+				| entry.ste_kind == STE_Empty
+					= { cs & cs_symbol_table = cs_symbol_table }
+					= { cs & cs_symbol_table = cs_symbol_table <:= (id_info, entry.ste_previous),
+							 cs_error = checkError tv_name.id_name " global type variable not used in type of the function" cs_error }
+
+checkDynamics mod_index scope dyn_type_ptrs type_defs modules type_heaps expr_heap cs
+	= foldSt (check_dynamic mod_index scope) dyn_type_ptrs (type_defs, modules, type_heaps, expr_heap, cs)
+where	
+	check_dynamic mod_index scope dyn_info_ptr (type_defs, modules, type_heaps, expr_heap, cs)
+		# (dyn_info, expr_heap) = readPtr dyn_info_ptr expr_heap
+		= case dyn_info of
+			EI_Dynamic opt_type
+				-> case opt_type of
+					Yes dyn_type
+						# (dyn_type, loc_type_vars, type_defs, modules, type_heaps, cs) = check_dynamic_type mod_index scope dyn_type type_defs modules type_heaps cs
+						| isEmpty loc_type_vars
+							-> (type_defs, modules, type_heaps, expr_heap <:= (dyn_info_ptr, EI_Dynamic (Yes dyn_type)), cs)
+				  			# cs_symbol_table = removeVariablesFromSymbolTable scope loc_type_vars cs.cs_symbol_table
+							  cs_error = checkError loc_type_vars " type variable(s) not defined" cs.cs_error
+							-> (type_defs, modules, type_heaps, expr_heap <:= (dyn_info_ptr, EI_Dynamic (Yes dyn_type)),
+									{ cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table })
+					No
+						-> (type_defs, modules, type_heaps, expr_heap, cs)
+			EI_DynamicType dyn_type loc_dynamics
+				# (dyn_type, loc_type_vars, type_defs, modules, type_heaps, cs) = check_dynamic_type mod_index scope dyn_type type_defs modules type_heaps cs
+				  (type_defs, modules, type_heaps, expr_heap, cs) = check_local_dynamics mod_index scope loc_dynamics type_defs modules type_heaps expr_heap cs
+				  cs_symbol_table = removeVariablesFromSymbolTable scope loc_type_vars cs.cs_symbol_table
+				-> (type_defs, modules, type_heaps, expr_heap <:= (dyn_info_ptr, EI_DynamicTypeWithVars loc_type_vars dyn_type loc_dynamics),
+							{ cs & cs_symbol_table = cs_symbol_table }) 
+						// ---> ("check_dynamic ", scope, dyn_type, loc_type_vars)
+
+	check_local_dynamics mod_index scope local_dynamics type_defs modules type_heaps expr_heap cs
+		= foldSt (check_dynamic mod_index (inc scope)) local_dynamics (type_defs, modules, type_heaps, expr_heap, cs)
+
+	check_dynamic_type mod_index scope dt=:{dt_uni_vars,dt_type} type_defs modules type_heaps=:{th_vars} cs
+		# (dt_uni_vars, (th_vars, cs)) = mapSt (add_type_variable_to_symbol_table scope) dt_uni_vars (th_vars, cs)
+		  ots = { ots_type_defs = type_defs, ots_modules = modules }
+		  oti = { oti_heaps = { type_heaps & th_vars = th_vars }, oti_all_vars = [], oti_all_attrs = [], oti_global_vars = [] }
+		  (dt_type, ( {ots_type_defs, ots_modules}, {oti_heaps,oti_all_vars,oti_all_attrs, oti_global_vars}, cs))
+		  		= checkOpenAType mod_index scope DAK_Ignore dt_type (ots, oti, cs)
+		  th_vars = foldSt (\{tv_info_ptr} -> writePtr tv_info_ptr TVI_Empty) oti_global_vars oti_heaps.th_vars
+	  	  cs_symbol_table = removeAttributedTypeVarsFromSymbolTable scope dt_uni_vars cs.cs_symbol_table
+		| isEmpty oti_all_attrs
+			= ({ dt & dt_uni_vars = dt_uni_vars, dt_global_vars = oti_global_vars, dt_type = dt_type },
+					oti_all_vars, ots_type_defs, ots_modules, { oti_heaps & th_vars = th_vars }, { cs & cs_symbol_table = cs_symbol_table })
+			# cs_symbol_table = removeAttributesFromSymbolTable oti_all_attrs cs_symbol_table
+			= ({ dt & dt_uni_vars = dt_uni_vars, dt_global_vars = oti_global_vars, dt_type = dt_type },
+					oti_all_vars, ots_type_defs, ots_modules, { oti_heaps & th_vars = th_vars },
+					{ cs & cs_symbol_table = cs_symbol_table, cs_error = checkError (hd oti_all_attrs).av_name " type attribute variable not allowed" cs.cs_error})
+		
+	add_type_variable_to_symbol_table :: !Level !ATypeVar !*(!*TypeVarHeap,!*CheckState) -> (!ATypeVar,!(!*TypeVarHeap, !*CheckState))
+	add_type_variable_to_symbol_table scope atv=:{atv_variable=atv_variable=:{tv_name}, atv_attribute} (type_var_heap, cs=:{cs_symbol_table,cs_error})
+		#! var_info = tv_name.id_info
+		   var_entry = sreadPtr var_info cs_symbol_table
+		| var_entry.ste_kind == STE_Empty || scope < var_entry.ste_def_level
+			#! (new_var_ptr, type_var_heap) = newPtr TVI_Empty type_var_heap
+			# cs_symbol_table = cs_symbol_table <:=
+				(var_info, {ste_index = NoIndex, ste_kind = STE_TypeVariable new_var_ptr, ste_def_level = scope, ste_previous = var_entry })
+			= ({atv & atv_attribute = TA_Multi, atv_variable = { atv_variable & tv_info_ptr = new_var_ptr }}, (type_var_heap,
+					{ cs & cs_symbol_table = cs_symbol_table, cs_error = check_attribute atv_attribute cs_error}))
+			= (atv, (type_var_heap, { cs & cs_error = checkError tv_name.id_name " type variable already defined" cs_error }))
+
+	check_attribute TA_Unique error
+		= error
+	check_attribute TA_Multi error
+		= error
+	check_attribute TA_None error
+		= error
+	check_attribute attr error
+		= checkError attr " attribute not allowed in type of dynamic" error
+	
+	
+checkSpecialTypeVars :: !Specials !*CheckState -> (!Specials, !*CheckState)
+checkSpecialTypeVars (SP_ParsedSubstitutions env) cs
+	# (env, cs) = mapSt (mapSt check_type_var) env cs
+	= (SP_ParsedSubstitutions env, cs)
+where		
+	check_type_var bind=:{bind_dst=type_var=:{tv_name={id_name,id_info}}} cs=:{cs_symbol_table,cs_error}
+		#! entry = sreadPtr id_info cs_symbol_table
+		# {ste_kind,ste_def_level} = entry
+		| ste_kind <> STE_Empty && ste_def_level == cGlobalScope
+			# (STE_TypeVariable tv_info_ptr) = ste_kind
+			= ({ bind & bind_dst = { type_var & tv_info_ptr = tv_info_ptr}}, cs)
+			= (bind, { cs & cs_error = checkError id_name " type variable not defined" cs_error })
+checkSpecialTypeVars SP_None cs
+	= (SP_None, cs)
+/*	
+checkSpecialTypes :: !Index !Specials !u:{#.CheckedTypeDef} !u:{#.DclModule} !*TypeHeaps !*CheckState
+	-> (!Specials, !u:{#CheckedTypeDef},!u:{#DclModule},!*TypeHeaps,!*CheckState)
+*/
+checkSpecialTypes mod_index (SP_ParsedSubstitutions envs) type_defs modules heaps cs
+	# ots = { ots_type_defs = type_defs, ots_modules = modules }
+	  (specials, (heaps, ots, cs)) = mapSt (check_environment mod_index) envs (heaps, ots, cs)
+	= (SP_Substitutions specials, ots.ots_type_defs, ots.ots_modules, heaps, cs)
+where
+	check_environment mod_index env (heaps, ots, cs)
+	 	# oti = { oti_heaps = heaps, oti_all_vars = [], oti_all_attrs = [], oti_global_vars = [] }
+	 	  (env, (ots, {oti_heaps,oti_all_vars,oti_all_attrs}, cs)) = mapSt (check_substituted_type mod_index) env (ots, oti, cs)
+	  	  cs_symbol_table = removeVariablesFromSymbolTable cGlobalScope oti_all_vars cs.cs_symbol_table
+		  cs_symbol_table = removeAttributesFromSymbolTable oti_all_attrs cs_symbol_table
+		= ({ ss_environ = env, ss_context = [], ss_vars = oti_all_vars, ss_attrs = oti_all_attrs}, (oti_heaps, ots, { cs & cs_symbol_table = cs_symbol_table }))
+
+	check_substituted_type mod_index bind=:{bind_src} cot_state
+		 # (bind_src, cot_state) = checkOpenType mod_index cGlobalScope DAK_Ignore bind_src cot_state
+		 = ({ bind & bind_src = bind_src }, cot_state)
+checkSpecialTypes mod_index SP_None type_defs modules heaps cs
+	= (SP_None, type_defs, modules, heaps, cs)
+
+
+instance <<< SelectorDef
+where
+	(<<<) file {sd_symb} = file <<< sd_symb
+
+instance <<< AttrInequality
+where
+	(<<<) file {ai_demanded,ai_offered}
+		= file <<< ai_offered <<< " <= " <<< ai_demanded
+/*
+instance <<< VarBind
+where
+	(<<<) file vb = file <<< (vb.vb_var,vb.vb_vars)
+*/
+
+cOuterMostLevel :== 0
+
+addTypeVariablesToSymbolTable :: ![ATypeVar] ![AttributeVar] !*TypeHeaps !*CheckState
+	-> (![ATypeVar], !(![AttributeVar], !*TypeHeaps, !*CheckState))
+addTypeVariablesToSymbolTable type_vars attr_vars heaps cs
+	= mapSt (add_type_variable_to_symbol_table) type_vars (attr_vars, heaps, cs)
+where
+	add_type_variable_to_symbol_table :: !ATypeVar !(![AttributeVar], !*TypeHeaps, !*CheckState)
+		-> (!ATypeVar, !(![AttributeVar], !*TypeHeaps, !*CheckState))
+	add_type_variable_to_symbol_table atv=:{atv_variable=atv_variable=:{tv_name}, atv_attribute}
+		(attr_vars, heaps=:{th_vars,th_attrs}, cs=:{ cs_symbol_table, cs_error })
+		#! tv_info = tv_name.id_info
+		   entry = sreadPtr tv_info cs_symbol_table
+		| entry.ste_def_level < cOuterMostLevel
+			# (tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars
+		      atv_variable = { atv_variable & tv_info_ptr = tv_info_ptr }
+		      (atv_attribute, attr_vars, th_attrs, cs_error) = check_attribute atv_attribute tv_name.id_name attr_vars th_attrs cs_error
+			  cs_symbol_table = cs_symbol_table <:= (tv_info, {ste_index = NoIndex, ste_kind = STE_BoundTypeVariable {stv_attribute = atv_attribute,
+			  						stv_info_ptr = tv_info_ptr, stv_count = 0 }, ste_def_level = cOuterMostLevel, ste_previous = entry })
+			  heaps = { heaps & th_vars = th_vars, th_attrs = th_attrs }
+			= ({atv & atv_variable = atv_variable, atv_attribute = atv_attribute},
+					(attr_vars, heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }))
+			= (atv, (attr_vars, { heaps & th_vars = th_vars },
+					 { cs & cs_error = checkError tv_name.id_name " type variable already defined" cs_error}))
+
+	check_attribute :: !TypeAttribute !String ![AttributeVar] !*AttrVarHeap !*ErrorAdmin
+		-> (!TypeAttribute, ![AttributeVar], !*AttrVarHeap, !*ErrorAdmin)
+	check_attribute TA_Multi name attr_vars attr_var_heap cs
+			# (attr_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap
+			  new_var = { av_name = emptyIdent name, av_info_ptr = attr_info_ptr}
+			= (TA_Var new_var, [new_var : attr_vars], attr_var_heap, cs)
+	check_attribute TA_None name attr_vars attr_var_heap cs
+			# (attr_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap
+			  new_var = { av_name = emptyIdent name, av_info_ptr = attr_info_ptr}
+			= (TA_Var new_var, [new_var : attr_vars], attr_var_heap, cs)
+	check_attribute TA_Unique name attr_vars attr_var_heap cs
+		= (TA_Unique, attr_vars, attr_var_heap, cs)
+	check_attribute _ name attr_vars attr_var_heap cs
+		= (TA_Multi, attr_vars, attr_var_heap, checkError name "specified attribute variable not allowed" cs)
+
+
+addExistentionalTypeVariablesToSymbolTable :: !TypeAttribute ![ATypeVar] !*TypeHeaps !*CheckState
+	-> (![ATypeVar], !(!*TypeHeaps, !*CheckState))
+addExistentionalTypeVariablesToSymbolTable root_attr type_vars heaps cs
+	= mapSt (add_type_variable_to_symbol_table root_attr) type_vars (heaps, cs)
+where
+	add_type_variable_to_symbol_table :: !TypeAttribute !ATypeVar !(!*TypeHeaps, !*CheckState)
+		-> (!ATypeVar, !(!*TypeHeaps, !*CheckState))
+	add_type_variable_to_symbol_table root_attr atv=:{atv_variable=atv_variable=:{tv_name}, atv_attribute}
+		(heaps=:{th_vars,th_attrs}, cs=:{ cs_symbol_table, cs_error })
+		#! tv_info = tv_name.id_info
+		   entry = sreadPtr tv_info cs_symbol_table
+		| entry.ste_def_level < cOuterMostLevel
+			# (tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars
+		      atv_variable = { atv_variable & tv_info_ptr = tv_info_ptr }
+		      (atv_attribute, cs_error) = check_attribute atv_attribute root_attr tv_name.id_name cs_error
+			  cs_symbol_table = cs_symbol_table <:= (tv_info, {ste_index = NoIndex, ste_kind = STE_BoundTypeVariable {stv_attribute = atv_attribute,
+			  						stv_info_ptr = tv_info_ptr, stv_count = 0 }, ste_def_level = cOuterMostLevel, ste_previous = entry })
+			  heaps = { heaps & th_vars = th_vars }
+			= ({atv & atv_variable = atv_variable, atv_attribute = atv_attribute},
+					(heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }))
+			= (atv, ({ heaps & th_vars = th_vars },
+					 { cs & cs_error = checkError tv_name.id_name " type variable already defined" cs_error}))
+
+	check_attribute :: !TypeAttribute !TypeAttribute !String !*ErrorAdmin
+		-> (!TypeAttribute, !*ErrorAdmin)
+	check_attribute TA_Multi root_attr name error
+		= (TA_Multi, error)
+	check_attribute TA_None root_attr name error
+		= (TA_Multi, error)
+	check_attribute TA_Unique root_attr name error
+		= (TA_Unique, error)
+	check_attribute TA_Anonymous root_attr name error
+		= case root_attr of
+			TA_Var var
+				-> (TA_RootVar var, error)
+			_
+				-> (root_attr, error)
+	check_attribute attr root_attr name error
+		= (TA_Multi, checkError name "specified attribute not allowed" error)
+	
+retrieveKinds :: ![ATypeVar] *TypeVarHeap -> (![TypeKind], !*TypeVarHeap)
+retrieveKinds type_vars var_heap = mapSt retrieve_kind type_vars var_heap
+where
+	retrieve_kind {atv_variable = {tv_info_ptr}} var_heap
+		# (TVI_TypeKind kind_info_ptr, var_heap) = readPtr tv_info_ptr var_heap
+		= (KindVar kind_info_ptr, var_heap)
+
+removeAttributedTypeVarsFromSymbolTable :: !Level ![ATypeVar] !*SymbolTable -> *SymbolTable
+removeAttributedTypeVarsFromSymbolTable level vars symbol_table
+	= foldr (\{atv_variable={tv_name}} -> removeDefinitionFromSymbolTable level tv_name) symbol_table vars
+
+
+cExistentialVariable	:== True
+cUniversalVariable 		:== False
+
+removeDefinitionFromSymbolTable level {id_info} symbol_table
+	| isNilPtr id_info
+		= symbol_table
+		#! entry = sreadPtr id_info symbol_table
+		| entry.ste_def_level == level
+			= symbol_table <:= (id_info, entry.ste_previous)
+			= symbol_table
+
+removeAttributesFromSymbolTable :: ![AttributeVar] !*SymbolTable -> *SymbolTable
+removeAttributesFromSymbolTable attrs symbol_table
+	= foldr (\{av_name} -> removeDefinitionFromSymbolTable cGlobalScope av_name) symbol_table attrs
+
+removeVariablesFromSymbolTable :: !Int ![TypeVar] !*SymbolTable -> *SymbolTable
+removeVariablesFromSymbolTable scope vars symbol_table
+	= foldr (\{tv_name} -> removeDefinitionFromSymbolTable scope tv_name) symbol_table vars
+
+::	Indexes =
+	{	index_type		:: !Index
+	,	index_cons		:: !Index
+	,	index_selector	:: !Index
+	}
+
+makeAttributedType attr annot type :== { at_attribute = attr, at_annotation = annot, at_type = type }
+
+createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !Int  !*TypeVarHeap !*VarHeap !*CheckState
+	-> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*CheckState)
+createClassDictionaries mod_index class_defs modules first_type_index first_selector_index first_cons_index upper_limit type_var_heap var_heap cs
+	# (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs) = create_class_dictionaries mod_index 0  class_defs modules []
+			{ index_type = first_type_index, index_cons= first_cons_index, index_selector = first_selector_index } type_var_heap var_heap cs
+	  (type_defs, sel_defs, cons_defs, cs_symbol_table) = foldSt collect_type_def rev_dictionary_list  ([], [], [], cs.cs_symbol_table)
+	= (class_defs, modules, type_defs, sel_defs, cons_defs, type_var_heap, var_heap, {cs & cs_symbol_table = cs_symbol_table })
+where
+	collect_type_def type_ptr (type_defs, sel_defs, cons_defs, symbol_table)
+		# ({ ste_kind = STE_DictType type_def }, symbol_table) = readPtr type_ptr symbol_table
+		  (RecordType {rt_constructor, rt_fields}) = type_def.td_rhs
+		  ({ ste_kind = STE_DictCons cons_def }, symbol_table) = readPtr rt_constructor.ds_ident.id_info symbol_table
+	 	  (sel_defs, symbol_table) = collect_fields 0 rt_fields (sel_defs, symbol_table)
+	 	= ( [type_def : type_defs ] , sel_defs, [cons_def : cons_defs], symbol_table)
+	 where
+		collect_fields field_nr fields (sel_defs, symbol_table)
+			| field_nr < size fields
+				# (sel_defs, symbol_table) = collect_fields (inc field_nr) fields (sel_defs, symbol_table)
+				  ({ ste_kind = STE_DictField sel_def }, symbol_table) = readPtr fields.[field_nr].fs_name.id_info symbol_table
+				= ( [ sel_def : sel_defs ], symbol_table)
+				= ( sel_defs, symbol_table)
+	
+	create_class_dictionaries mod_index class_index class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
+// MW was			| class_index < size class_defs
+		| class_index < upper_limit
+			# (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs) = 
+					create_class_dictionary mod_index class_index class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
+			= create_class_dictionaries mod_index (inc class_index) class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
+			= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs)			
+
+	create_class_dictionary mod_index class_index  class_defs =:{[class_index] = class_def } modules rev_dictionary_list
+			indexes type_var_heap var_heap cs=:{cs_symbol_table,cs_error}
+		# {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_info}}} = class_def
+		| isNilPtr id_info
+			# (type_id_info, cs_symbol_table) = newPtr EmptySymbolTableEntry cs_symbol_table
+			  nr_of_members = size class_members
+			  nr_of_fields = nr_of_members + length class_context
+			  rec_type_id = { class_name &  id_info = type_id_info}
+			  class_dictionary = { ds & ds_ident = rec_type_id }
+			  class_defs = { class_defs & [class_index] = { class_def & class_dictionary = class_dictionary}}
+			  (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs)
+			  		= create_class_dictionaries_of_contexts mod_index class_context class_defs modules
+			  				rev_dictionary_list indexes type_var_heap var_heap { cs & cs_symbol_table = cs_symbol_table }
+			
+			  { index_type, index_cons, index_selector } = indexes
+
+			  type_symb = MakeTypeSymbIdent { glob_object = index_type, glob_module = mod_index } rec_type_id class_arity
+
+			  rec_type		= makeAttributedType TA_Multi AN_Strict (TA type_symb [makeAttributedType TA_Multi AN_None TE \\ i <- [1..class_arity]])
+			  field_type	= makeAttributedType TA_Multi AN_None TE
+
+			  (rev_fields, var_heap, cs_symbol_table)
+		  			= build_fields 0 nr_of_members class_members rec_type field_type index_type index_selector [] var_heap cs.cs_symbol_table
+			  (index_selector, rev_fields, rev_field_types, class_defs, modules, var_heap, cs_symbol_table)
+		  			= build_context_fields mod_index nr_of_members class_context rec_type index_type (index_selector + nr_of_members) rev_fields
+		  					[ { field_type & at_annotation = AN_Strict } \\ i <- [1..nr_of_members] ] class_defs modules var_heap cs_symbol_table
+
+			  (cons_id_info, cs_symbol_table) = newPtr EmptySymbolTableEntry cs_symbol_table
+			  rec_cons_id = { class_name & id_info = cons_id_info}
+			  cons_symbol = { ds_ident = rec_cons_id, ds_arity = nr_of_fields, ds_index = index_cons }
+			  (cons_type_ptr, var_heap) = newPtr VI_Empty var_heap
+
+			  (td_args, type_var_heap) = mapSt new_attributed_type_variable class_args type_var_heap
+			  
+
+	  		  type_def =
+			 	{	td_name			= rec_type_id
+				,	td_index		= index_type
+				,	td_arity		= 0
+				,	td_args			= td_args
+				,	td_attrs		= []
+				,	td_context		= []
+				,	td_rhs			= RecordType {rt_constructor = cons_symbol, rt_fields = { field \\ field <- reverse rev_fields }}
+				,	td_attribute	= TA_None
+				,	td_pos			= NoPos
+//				,	td_kinds		= []
+//				,	td_properties	= cAllBitsClear
+//				,	td_info			= EmptyTypeDefInfo
+				}
+			
+			  cons_def = 	
+				{	cons_symb		= rec_cons_id
+				,	cons_type		= { st_vars	= [], st_args = reverse rev_field_types, st_result = rec_type,
+									    st_arity = nr_of_fields, st_context = [], st_attr_vars = [], st_attr_env = [] }
+				,	cons_priority	= NoPrio
+				,	cons_index		= 0
+				,	cons_type_index	= index_type
+				,	cons_exi_vars	= []
+//				,	cons_exi_attrs	= []
+				,	cons_arg_vars	= []
+				,	cons_type_ptr	= cons_type_ptr
+				,	cons_pos		= NoPos
+				}
+			= ({ class_defs & [class_index] = { class_def & class_dictionary = { class_dictionary & ds_index = index_type }}}, modules,
+					 [ type_id_info : rev_dictionary_list ], { index_type = inc index_type, index_cons = inc index_cons, index_selector = index_selector },
+						type_var_heap, var_heap, { cs & cs_symbol_table = cs_symbol_table
+							<:= (type_id_info, { ste_kind = STE_DictType type_def, ste_index = index_type,
+											ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })
+							<:= (cons_id_info, { ste_kind = STE_DictCons cons_def, ste_index = index_cons,
+											ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })})
+		# ({ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
+		| ste_kind == STE_Empty
+			= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap,
+				{ cs & cs_symbol_table = cs_symbol_table, cs_error = checkError class_name "cyclic dependencies between type classes" cs_error})
+			= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, { cs & cs_symbol_table = cs_symbol_table })
+
+	create_class_dictionaries_of_contexts mod_index [{tc_class = {glob_module, glob_object={ds_index}}}:tcs] class_defs modules
+			rev_dictionary_list indexes type_var_heap var_heap cs
+		| mod_index == glob_module
+			# (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs)
+					= create_class_dictionary mod_index ds_index class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
+			= create_class_dictionaries_of_contexts mod_index tcs class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
+			= create_class_dictionaries_of_contexts mod_index tcs class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
+	create_class_dictionaries_of_contexts mod_index [] class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
+		= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs)
+	
+	new_attributed_type_variable tv type_var_heap
+		# (new_tv_ptr, type_var_heap) = newPtr TVI_Empty type_var_heap
+		= ({atv_attribute = TA_Multi, atv_annotation = AN_None , atv_variable = { tv & tv_info_ptr = new_tv_ptr }}, type_var_heap)
+		
+	build_fields field_nr nr_of_fields class_members rec_type field_type rec_type_index next_selector_index rev_fields var_heap symbol_table
+		| field_nr < nr_of_fields
+			# (field, var_heap, symbol_table) = build_field field_nr class_members.[field_nr].ds_ident.id_name rec_type_index
+											rec_type field_type next_selector_index var_heap symbol_table
+			= build_fields (inc field_nr) nr_of_fields class_members rec_type field_type rec_type_index (inc next_selector_index)
+				 [ field : rev_fields ] var_heap symbol_table
+			= (rev_fields, var_heap, symbol_table)			
+
+	build_context_fields mod_index field_nr [{tc_class = {glob_module, glob_object={ds_index}}}:tcs] rec_type rec_type_index
+			next_selector_index rev_fields rev_field_types class_defs modules var_heap symbol_table
+		# ({class_name, class_arity, class_dictionary = {ds_ident, ds_index}}, _, class_defs, modules) = getClassDef ds_index glob_module mod_index class_defs modules
+		  type_symb = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident class_arity
+		  field_type = makeAttributedType TA_Multi AN_Strict (TA type_symb [makeAttributedType TA_Multi AN_None TE \\ i <- [1..class_arity]])
+		  (field, var_heap, symbol_table) = build_field field_nr class_name.id_name rec_type_index rec_type field_type next_selector_index var_heap symbol_table
+		= build_context_fields mod_index (inc field_nr) tcs rec_type rec_type_index (inc next_selector_index) [ field : rev_fields ]
+				 [field_type : rev_field_types] class_defs modules var_heap symbol_table
+	build_context_fields mod_index field_nr [] rec_type rec_type_index next_selector_index rev_fields rev_field_types class_defs modules var_heap symbol_table
+		= (next_selector_index, rev_fields, rev_field_types , class_defs, modules, var_heap, symbol_table)			
+
+	build_field field_nr field_name rec_type_index rec_type field_type selector_index var_heap symbol_table
+		# (id_info, symbol_table) = newPtr EmptySymbolTableEntry symbol_table
+		  (sd_type_ptr, var_heap) = newPtr VI_Empty var_heap
+  		  field_id = { id_name = field_name, id_info = id_info }
+  		  sel_def =
+  		  	{	sd_symb			= field_id
+  		  	,	sd_field		= field_id
+  		  	,	sd_type			= { st_vars	= [], st_args = [ rec_type ], st_result = field_type, st_arity = 1,
+  		  	                        st_context = [], st_attr_vars = [], st_attr_env = [] }
+			,	sd_exi_vars		= []
+//			,	sd_exi_attrs	= []
+			,	sd_field_nr		= field_nr
+			,	sd_type_index	= rec_type_index
+			,	sd_type_ptr		= sd_type_ptr
+			,	sd_pos			= NoPos
+			}
+		  field = { fs_name = field_id, fs_var = field_id, fs_index = selector_index }
+		= (field, var_heap, symbol_table <:= (id_info, { ste_kind = STE_DictField sel_def, ste_index = selector_index,
+				ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" }))
+
+class toVariable var :: !STE_Kind !Ident -> var
+
+instance toVariable TypeVar
+where
+	toVariable (STE_TypeVariable info_ptr) ident = { tv_name = ident, tv_info_ptr = info_ptr }
+
+instance toVariable AttributeVar
+where
+	toVariable (STE_TypeAttribute info_ptr) ident = { av_name = ident, av_info_ptr = info_ptr }
+
+instance == AttributeVar
+where
+	(==) av1 av2 = av1.av_info_ptr == av2.av_info_ptr
+
+instance <<< DynamicType
+where
+	(<<<) file {dt_global_vars,dt_type} = file <<< dt_global_vars <<< dt_type
diff --git a/frontend/compare_constructor.dcl b/frontend/compare_constructor.dcl
new file mode 100644
index 0000000..3261007
--- /dev/null
+++ b/frontend/compare_constructor.dcl
@@ -0,0 +1,5 @@
+system module compare_constructor;
+
+equal_constructor :: !a !a ->Bool;
+less_constructor :: !a !a ->Bool;
+greater_constructor :: !a !a ->Bool;
diff --git a/frontend/compare_constructor.icl b/frontend/compare_constructor.icl
new file mode 100644
index 0000000..d92f9a9
--- /dev/null
+++ b/frontend/compare_constructor.icl
@@ -0,0 +1,36 @@
+implementation module compare_constructor;
+
+equal_constructor :: !a !a ->Bool;
+equal_constructor _ _ = code {
+	.inline equal_constructor
+		pushD_a 1
+		pushD_a 0
+		pop_a 2
+		eqI
+	.end
+};
+
+less_constructor :: !a !a ->Bool;
+less_constructor _ _ = code {
+	.inline less_constructor
+		pushD_a 1
+		pushD_a 0
+		pop_a 2
+		ltI
+	.end
+};
+
+greater_constructor :: !a !a ->Bool;
+greater_constructor _ _ = code {
+	.inline greater_constructor
+		pushD_a 1
+		pushD_a 0
+		pop_a 2
+		gtI
+	.end
+};
+
+
+
+
+
diff --git a/frontend/convertDynamics.dcl b/frontend/convertDynamics.dcl
new file mode 100644
index 0000000..45c8d35
--- /dev/null
+++ b/frontend/convertDynamics.dcl
@@ -0,0 +1,7 @@
+definition module convertDynamics
+
+import syntax, transform, convertcases
+
+convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols
+		!*{#{# CheckedTypeDef}} !ImportedFunctions !*VarHeap !*TypeHeaps !*ExpressionHeap
+			-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl
new file mode 100644
index 0000000..d046d72
--- /dev/null
+++ b/frontend/convertDynamics.icl
@@ -0,0 +1,528 @@
+implementation module convertDynamics
+
+import syntax, transform, utilities, convertcases
+
+::	*ConversionInfo =
+	{	ci_predef_symb		:: !*PredefinedSymbols
+	,	ci_var_heap			:: !*VarHeap
+	,	ci_expr_heap		:: !*ExpressionHeap
+	,	ci_new_functions 	:: ![FunctionInfoPtr]
+	,	ci_fun_heap			:: !*FunctionHeap
+	,	ci_next_fun_nr		:: !Index
+	}
+
+::	ConversionInput =
+	{	cinp_glob_type_inst	:: !{! GlobalTCType} 
+	,	cinp_group_index	:: !Int
+	}
+
+:: OpenedDynamic =
+	{	opened_dynamic_expr :: Expression
+	, 	opened_dynamic_type :: Expression
+	}
+
+:: DefaultExpression :== Optional (BoundVar, [IndirectionVar])   //DefaultRecord
+:: DefaultRecord =
+	{	c_i				:: BoundVar
+	,	indirections	:: [IndirectionVar]
+	}
+:: BoundVariables 	 :== [(FreeVar, AType)]
+:: IndirectionVar    :== BoundVar
+
+convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols
+		!*{#{# CheckedTypeDef}} !ImportedFunctions !*VarHeap !*TypeHeaps !*ExpressionHeap
+			-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
+convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs groups fun_defs predefined_symbols
+		imported_types imported_conses var_heap type_heaps expr_heap
+	#! nr_of_funs = size fun_defs
+	# (groups, (fun_defs, {ci_predef_symb, ci_var_heap, ci_expr_heap, ci_fun_heap, ci_new_functions}))
+			= convert_groups 0 groups global_type_instances (fun_defs, {	
+							ci_predef_symb = predefined_symbols, ci_var_heap = var_heap, ci_expr_heap = expr_heap,
+							ci_new_functions = [], ci_fun_heap = newHeap, ci_next_fun_nr = nr_of_funs })
+	  (groups, new_fun_defs, imported_types, imported_conses, type_heaps, ci_var_heap)
+			= addNewFunctionsToGroups common_defs ci_fun_heap ci_new_functions groups imported_types imported_conses type_heaps ci_var_heap
+	= (groups, { fundef \\ fundef <- [ fundef \\ fundef <-: fun_defs ] ++ new_fun_defs }, ci_predef_symb, imported_types, imported_conses, ci_var_heap, type_heaps, ci_expr_heap)
+where
+	convert_groups group_nr groups global_type_instances fun_defs_and_ci
+		| group_nr == size groups
+			= (groups, fun_defs_and_ci)
+			#! group = groups.[group_nr]
+			= convert_groups (inc group_nr) groups global_type_instances (foldSt (convert_function group_nr global_type_instances) group.group_members fun_defs_and_ci)
+
+	convert_function group_nr global_type_instances fun (fun_defs, ci)
+		#! fun_def = fun_defs.[fun]
+		# {fun_body,fun_type} = fun_def
+		  (fun_body, ci) = convert_dynamics_in_body {cinp_glob_type_inst = global_type_instances, cinp_group_index = group_nr} fun_body fun_type ci
+		= ({fun_defs & [fun] = { fun_def & fun_body = fun_body }}, ci)
+
+	convert_dynamics_in_body global_type_instances (TransformedBody {tb_args,tb_rhs}) (Yes {st_args}) ci
+		# vars_with_types = zip2 tb_args st_args
+		  (tb_rhs, ci) = convertDynamics global_type_instances vars_with_types No tb_rhs ci
+		= (TransformedBody {tb_args = tb_args,tb_rhs = tb_rhs}, ci)
+	convert_dynamics_in_body global_type_instances other fun_type ci
+		= abort "unexpected value in 'convert dynamics.convert_dynamics_in_body'"
+
+
+
+class convertDynamics a :: !ConversionInput !BoundVariables !DefaultExpression !a !*ConversionInfo -> (!a, !*ConversionInfo)
+
+instance convertDynamics [a]  |  convertDynamics a
+where
+	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression ![a] !*ConversionInfo -> (![a], !*ConversionInfo)  |  convertDynamics a
+	convertDynamics cinp bound_vars default_expr xs ci = mapSt (convertDynamics cinp bound_vars default_expr) xs ci
+
+instance convertDynamics (Optional a)  |  convertDynamics a
+where
+	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression !(Optional a) !*ConversionInfo -> (!Optional a, !*ConversionInfo)  |  convertDynamics a
+	convertDynamics cinp bound_vars default_expr (Yes x)	ci
+		# (x, ci) = convertDynamics cinp bound_vars default_expr x ci
+		= (Yes x, ci)
+	convertDynamics _ _ _ No ci
+		= (No, ci)
+
+instance convertDynamics (Bind a b)  |  convertDynamics a
+where
+	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression !(Bind a b) !*ConversionInfo -> (!Bind a b, !*ConversionInfo)  |  convertDynamics a
+	convertDynamics cinp bound_vars default_expr binding=:{bind_src} ci
+		# (bind_src, ci) = convertDynamics cinp bound_vars default_expr bind_src ci
+		= ({binding &  bind_src = bind_src}, ci)
+
+convertDynamicsOfAlgebraicPattern :: !ConversionInput !BoundVariables !DefaultExpression !(!AlgebraicPattern,[AType]) !*ConversionInfo -> (!AlgebraicPattern,!*ConversionInfo)
+convertDynamicsOfAlgebraicPattern cinp bound_vars default_expr (algebraic_pattern=:{ap_vars, ap_expr}, arg_types_of_conses) ci
+	# (ap_expr, ci) = convertDynamics cinp (zipAppend2 ap_vars arg_types_of_conses bound_vars) default_expr ap_expr ci
+	= ({algebraic_pattern &  ap_expr = ap_expr}, ci)
+
+instance convertDynamics BasicPattern
+where
+	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression !BasicPattern !*ConversionInfo -> (!BasicPattern, !*ConversionInfo)
+	convertDynamics cinp bound_vars default_expr basic_pattern=:{bp_expr} ci
+		# (bp_expr, ci) = convertDynamics cinp bound_vars default_expr bp_expr ci
+		= ({basic_pattern &  bp_expr = bp_expr}, ci)
+
+
+instance convertDynamics Expression
+where
+	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression !Expression !*ConversionInfo -> (!Expression, !*ConversionInfo)
+	convertDynamics cinp bound_vars default_expr (Var var) ci
+		= (Var var, ci)
+	convertDynamics cinp bound_vars default_expr (App appje=:{app_args}) ci
+		# (app_args,ci) = convertDynamics cinp bound_vars default_expr app_args ci
+		= (App {appje &  app_args = app_args}, ci)
+	convertDynamics cinp bound_vars default_expr (expr @ exprs) ci
+		# (expr,  ci) = convertDynamics cinp bound_vars default_expr expr  ci
+		  (exprs, ci) = convertDynamics cinp bound_vars default_expr exprs ci
+		= (expr @ exprs, ci)
+	convertDynamics cinp bound_vars default_expr (Let letje=:{let_binds, let_expr,let_info_ptr}) ci
+		# (let_types, ci) = determine_let_types let_info_ptr ci
+		  bound_vars = zipAppend2 [ bind.bind_dst \\ bind <- let_binds ] let_types bound_vars
+		  (let_binds, ci) = convertDynamics cinp bound_vars default_expr let_binds ci
+		  (let_expr,  ci) = convertDynamics cinp bound_vars default_expr let_expr  ci
+		= (Let { letje &  let_binds = let_binds, let_expr = let_expr}, ci)
+	where
+		determine_let_types let_info_ptr ci=:{ci_expr_heap}
+			# (EI_LetType let_types, ci_expr_heap) = readPtr let_info_ptr ci_expr_heap
+			= (let_types, { ci & ci_expr_heap = ci_expr_heap })
+
+	convertDynamics cinp bound_vars default_expr (Case keesje=:{case_expr, case_guards, case_default, case_info_ptr}) ci
+		# (case_expr,    ci) = convertDynamics cinp bound_vars default_expr case_expr ci
+		  (case_default, ci) = convertDynamics cinp bound_vars default_expr case_default ci
+		  (this_case_default, nested_case_default, ci) = determine_defaults case_default default_expr ci
+		  (EI_CaseType {ct_cons_types, ct_result_type}, ci_expr_heap) = readPtr case_info_ptr ci.ci_expr_heap
+		  ci = { ci & ci_expr_heap = ci_expr_heap }
+		= case case_guards of
+			(AlgebraicPatterns type algebraic_patterns)
+				#  (algebraic_patterns, ci) = mapSt (convertDynamicsOfAlgebraicPattern cinp bound_vars nested_case_default)
+													(zip2 algebraic_patterns ct_cons_types) ci
+				-> (Case {keesje &  case_expr = case_expr, case_guards = AlgebraicPatterns type algebraic_patterns, case_default = this_case_default}, ci)
+			(BasicPatterns type basic_patterns)
+				#  (basic_patterns, ci) = convertDynamics  cinp bound_vars nested_case_default basic_patterns ci
+				-> (Case {keesje &  case_expr = case_expr, case_guards = BasicPatterns type basic_patterns, case_default = this_case_default}, ci)
+			(DynamicPatterns dynamic_patterns)
+				#  keesje = {keesje &  case_expr = case_expr, case_default = this_case_default}
+				-> convertDynamicPatterns cinp bound_vars keesje ci
+			NoPattern
+				-> (Case {keesje &  case_expr = case_expr, case_guards = NoPattern, case_default = this_case_default}, ci)
+			_
+				-> abort "unexpected value in convertDynamics: 'convertDynamics.CasePatterns'"
+	convertDynamics cinp bound_vars default_expr (Selection opt_symb expression selections) ci
+		# (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci
+		= (Selection opt_symb expression selections, ci)
+	convertDynamics cinp bound_vars default_expr (Update expression1 selections expression2) ci
+		# (expression1,ci) = convertDynamics cinp bound_vars default_expr expression1 ci
+		# (expression2,ci) = convertDynamics cinp bound_vars default_expr expression2 ci
+		= (Update expression1 selections expression2, ci)
+	convertDynamics cinp bound_vars default_expr (RecordUpdate cons_symbol expression expressions) ci
+		# (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci
+		# (expressions,ci) = convertDynamics cinp bound_vars default_expr expressions ci
+		= (RecordUpdate cons_symbol expression expressions, ci)
+	convertDynamics cinp bound_vars default_expr (TupleSelect definedSymbol int expression) ci
+		# (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci
+		= (TupleSelect definedSymbol int expression, ci)
+	convertDynamics _ _ _ (BasicExpr basicValue basicType) ci
+		= (BasicExpr basicValue basicType, ci)
+	convertDynamics _ _ _ (AnyCodeExpr codeBinding1 codeBinding2 strings) ci
+		= (AnyCodeExpr codeBinding1 codeBinding2 strings, ci)
+	convertDynamics _ _ _ (ABCCodeExpr strings bool) ci
+		= (ABCCodeExpr strings bool, ci)
+	convertDynamics cinp bound_vars default_expr (MatchExpr opt_symb symb expression) ci
+		# (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci
+		= (MatchExpr opt_symb symb expression, ci)
+	convertDynamics cinp bound_vars default_expr  (DynamicExpr {dyn_expr, dyn_info_ptr, dyn_uni_vars, dyn_type_code}) ci
+		# (twoTuple_symb, ci) = getSymbol (GetTupleConsIndex 2) SK_Constructor 2 ci
+		  (let_binds,     ci) = createVariables dyn_uni_vars [] ci
+		  (dyn_expr,      ci) = convertDynamics cinp bound_vars default_expr dyn_expr ci
+		  (dyn_type_code, ci) = convertTypecode cinp dyn_type_code ci
+		= case let_binds of
+			[]	-> (App {	app_symb		= twoTuple_symb,
+							app_args 		= [dyn_expr, dyn_type_code],
+							app_info_ptr	= nilPtr }, ci)
+			_ 	#  (let_info_ptr,  ci) = let_ptr ci
+				-> ( Let {	let_strict		= False,
+							let_binds		= let_binds,
+							let_expr		= App {	app_symb		= twoTuple_symb,
+													app_args 		= [dyn_expr, dyn_type_code],
+													app_info_ptr	= nilPtr },
+							let_info_ptr	= let_info_ptr}, ci)
+	convertDynamics cinp bound_vars default_expr (TypeCodeExpression type_code) ci
+		= convertTypecode cinp type_code ci
+	convertDynamics cinp bound_vars default_expr EE ci
+		= (EE, ci)
+	convertDynamics cinp bound_vars default_expr expression ci
+		= abort "unexpected value in convertDynamics: 'convertDynamics.Expression'"
+
+convertTypecode ::  !ConversionInput TypeCodeExpression !*ConversionInfo  -> (Expression,!*ConversionInfo)
+convertTypecode cinp TCE_Empty ci
+	= (EE, ci)
+convertTypecode cinp (TCE_Var var_info_ptr) ci
+	= (Var {var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}, ci)
+convertTypecode cinp (TCE_Constructor index typecode_exprs) ci
+	# (typecons_symb,  ci) 	= getSymbol PD_TypeConsSymbol SK_Constructor 2 ci
+	  constructor			= get_constructor cinp.cinp_glob_type_inst index
+	  (typecode_exprs, ci)	= convertTypecodes cinp typecode_exprs ci
+	= (App {app_symb		= typecons_symb,
+			app_args 		= [constructor , typecode_exprs],
+			app_info_ptr	= nilPtr}, ci)
+convertTypecode cinp (TCE_Selector selections var_info_ptr) ci
+	= (Selection No (Var { var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selections, ci)
+
+convertTypecodes :: !ConversionInput [TypeCodeExpression] !*ConversionInfo  -> (Expression,!*ConversionInfo)
+convertTypecodes _ [] ci
+	# (nil_symb, ci) = getSymbol PD_NilSymbol SK_Constructor 0 ci
+	= (App {	app_symb		= nil_symb,
+				app_args 		= [],
+				app_info_ptr	= nilPtr}, ci)
+convertTypecodes cinp [typecode_expr : typecode_exprs] ci
+	# (cons_symb, ci) = getSymbol PD_ConsSymbol SK_Constructor 2 ci
+	  (expr,      ci) = convertTypecode  cinp typecode_expr  ci
+	  (exprs,     ci) = convertTypecodes cinp typecode_exprs ci
+	= (App {	app_symb		= cons_symb,
+				app_args 		= [expr , exprs],
+				app_info_ptr	= nilPtr}, ci)
+
+
+determine_defaults :: (Optional Expression) DefaultExpression !*ConversionInfo -> (Optional Expression, DefaultExpression, !*ConversionInfo)
+/***
+determine_defaults :: case_default default_expr varheap -> (this_case_default, nested_case_default, var_heap)
+	this_case_default =	IF this case has no default, but there is a surrounding default
+						THEN that is now the default and its reference count must be increased.
+						ELSE it keeps this default
+	nested_case_default  = 	IF this case has no default
+		 					THEN the deault_expr remains default in the nested cases.
+							ELSE nested cases get this default. This is semantically already the case, so nothing has to be changed.
+***/
+determine_defaults No default_expr=:(Yes (var=:{var_info_ptr}, indirection_var_list)) ci=:{ci_var_heap}
+	#! var_info = sreadPtr var_info_ptr ci_var_heap
+	# (expression, ci) = toExpression default_expr {ci & ci_var_heap = ci_var_heap}
+	= case var_info of
+		VI_Default ref_count
+			-> (expression, default_expr, {ci & ci_var_heap = ci.ci_var_heap <:= (var_info_ptr, VI_Default (inc ref_count))} )
+		_
+			-> (expression, default_expr, ci )
+determine_defaults case_default _ ci
+	= (case_default, No, ci)
+
+
+add_dynamic_bound_vars :: ![DynamicPattern] BoundVariables -> BoundVariables
+add_dynamic_bound_vars [] bound_vars = bound_vars
+add_dynamic_bound_vars [{dp_var, dp_type_patterns_vars} : patterns] bound_vars
+	= add_dynamic_bound_vars patterns [(dp_var, empty_attributed_type) : mapAppend bind_info_ptr dp_type_patterns_vars bound_vars]
+where
+	bind_info_ptr var_info_ptr
+		= ({fv_def_level = NotALevel, fv_name = a_ij_var_name, fv_info_ptr = var_info_ptr, fv_count = 0}, empty_attributed_type)
+
+
+open_dynamic :: Expression !*ConversionInfo -> (OpenedDynamic, Bind Expression FreeVar, !*ConversionInfo)
+open_dynamic dynamic_expr ci
+	# (twotuple, ci) = getTupleSymbol 2 ci
+	  (dynamicType_var, ci) = newVariable "dt" VI_Empty ci
+	= (	{ opened_dynamic_expr = TupleSelect twotuple 0 dynamic_expr,   opened_dynamic_type = Var dynamicType_var },
+	  	{ bind_src = TupleSelect twotuple 1 dynamic_expr,   bind_dst = varToFreeVar dynamicType_var 0 },
+	  	ci)
+
+/**************************************************************************************************/
+
+convertDynamicPatterns :: !ConversionInput !BoundVariables !Case *ConversionInfo -> (Expression, *ConversionInfo)
+convertDynamicPatterns cinp bound_vars {case_guards = DynamicPatterns [], case_default} ci
+	= case case_default of
+		(Yes expr)	-> (expr, ci)
+		No			-> abort "unexpected value in convertDynamics: 'convertDynamicPatterns'"
+convertDynamicPatterns cinp bound_vars {case_expr, case_guards = DynamicPatterns patterns, case_default, case_info_ptr} ci
+	# (opened_dynamic, dt_bind, ci) = open_dynamic case_expr ci
+	  (ind_0, ci) = newVariable "ind_0" VI_Empty ci
+	  (c_1,   ci) = newVariable "c_1" (VI_Default 0) ci
+      new_default = newDefault c_1 ind_0
+      (result_type, ci) = getResultType case_info_ptr ci
+      bound_vars = addToBoundVars (freeVarToVar dt_bind.bind_dst) empty_attributed_type (addToBoundVars ind_0 empty_attributed_type
+      							  (addToBoundVars c_1 result_type (add_dynamic_bound_vars patterns bound_vars)))
+	  (binds, expr, ci) = convertDynamicPattern cinp bound_vars new_default 1 opened_dynamic result_type case_default patterns ci
+	  (let_info_ptr, ci) = let_ptr ci
+	= (Let {let_strict = False, let_binds = [ dt_bind : binds ], let_expr = expr, let_info_ptr = let_info_ptr}, ci)
+
+convertDynamicPattern :: !ConversionInput !BoundVariables DefaultExpression Int OpenedDynamic AType (Optional Expression) ![DynamicPattern] *ConversionInfo -> (Env Expression FreeVar, Expression, *ConversionInfo)
+convertDynamicPattern cinp bound_vars this_default pattern_number opened_dynamic result_type last_default
+																		[{ dp_var, dp_type_patterns_vars, dp_type_code, dp_rhs } : patterns] ci
+	# /***  The last case may noy have a default  ***/
+	  ind_var = getIndirectionVar this_default
+      this_default = if (isEmpty patterns && (isNo last_default))  No  this_default
+
+	  /***  convert the elements of this pattern  ***/
+	  x_i_bind = { bind_src = opened_dynamic.opened_dynamic_expr,  bind_dst = dp_var }
+	  (a_ij_binds, ci) = createVariables dp_type_patterns_vars [] ci
+ 	  (type_code, ci) = convertTypecode cinp dp_type_code ci
+ 	  (dp_rhs,    ci) = convertDynamics cinp bound_vars this_default dp_rhs ci
+
+	  /***  recursively convert the other patterns  ***/
+	  (binds, ci) = convertOtherPatterns cinp bound_vars this_default pattern_number opened_dynamic result_type last_default patterns ci
+
+	  /***  generate the expression  ***/
+ 	  (unify_symb, ci) = getSymbol PD_unify SK_Function 2 ci
+	  (twotuple,   ci) = getTupleSymbol 2 ci
+	  (let_info_ptr,  ci) = let_ptr ci
+	  (case_info_ptr, ci) = case_ptr ci
+	  (default_expr, ci) = toExpression this_default ci
+	  (unify_result, ci) = newVariable "result" VI_Empty ci
+	  (unify_bool,   ci) = newVariable "unify_bool" VI_Empty ci
+	  let_expr = Let {	let_strict = False,
+	  					let_binds = [{ bind_src = App { app_symb = unify_symb,  app_args = [opened_dynamic.opened_dynamic_type, type_code],  app_info_ptr = nilPtr },
+	  								   bind_dst = varToFreeVar unify_result 0 },
+	  								 { bind_src = TupleSelect twotuple 0 (Var unify_result),
+	  								   bind_dst = varToFreeVar unify_bool 0 },
+	  								 { bind_src = TupleSelect twotuple 1 (Var unify_result),
+	  								   bind_dst = varToFreeVar ind_var 0 }
+	  								],
+	  					let_expr = Case {	case_expr 		= Var unify_bool,
+											case_guards		= BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs}],
+											case_default	= default_expr,
+											case_ident		= No,
+											case_info_ptr	= case_info_ptr	},
+	  					let_info_ptr = let_info_ptr	}
+	= ([x_i_bind : a_ij_binds ++ binds],  let_expr,  ci)
+
+convertOtherPatterns :: ConversionInput BoundVariables DefaultExpression Int OpenedDynamic AType !(Optional Expression) ![DynamicPattern] !*ConversionInfo -> (Env Expression FreeVar, *ConversionInfo)
+convertOtherPatterns _ _ _ _ _ _  No  []  ci
+	= ([], ci)
+convertOtherPatterns cinp bound_vars this_default _ _ result_type (Yes last_default_expr) [] ci
+	# c_i = getVariable this_default
+	  (c_bind, ci) = generateBinding cinp bound_vars c_i last_default_expr result_type ci
+	= ([c_bind], ci)
+convertOtherPatterns cinp bound_vars this_default pattern_number opened_dynamic result_type last_default patterns ci
+	# (ind_i,   ci) = newVariable ("ind_"+++toString (pattern_number)) VI_Empty ci
+	  (c_inc_i, ci) = newVariable ("c_"+++toString (inc pattern_number)) (VI_Default 0) ci
+      new_default = newDefault c_inc_i ind_i
+      bound_vars = addToBoundVars ind_i empty_attributed_type (addToBoundVars c_inc_i result_type bound_vars)
+ 	  (binds, expr, ci) = convertDynamicPattern cinp bound_vars new_default (inc pattern_number) opened_dynamic result_type last_default patterns ci
+	  c_i = getVariable this_default
+	  (c_bind, ci) = generateBinding cinp bound_vars c_i expr result_type ci
+   = ([c_bind : binds], ci)
+
+generateBinding :: !ConversionInput BoundVariables BoundVar Expression AType !*ConversionInfo -> *(Bind Expression FreeVar, *ConversionInfo)
+generateBinding cinp bound_vars var bind_expr result_type ci
+	# (ref_count, ci) = get_reference_count var ci
+	| ref_count == 0
+		= ({ bind_src = bind_expr, bind_dst = varToFreeVar var 1}, ci)
+		# (saved_defaults, ci_var_heap) = foldSt save_default bound_vars ([], ci.ci_var_heap)
+		  (act_args, free_typed_vars, tb_rhs, ci_var_heap) = copyExpression bound_vars bind_expr ci_var_heap
+		  ci_var_heap = foldSt restore_default saved_defaults ci_var_heap
+		  tb_args = [ arg \\ (arg, _) <- free_typed_vars ]
+		  arg_types = [ type \\ (_, type) <- free_typed_vars ]
+		  (fun_symb,  (ci_next_fun_nr, ci_new_functions, ci_fun_heap))
+				= newFunction No (TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}) arg_types result_type cinp.cinp_group_index
+						(ci.ci_next_fun_nr, ci.ci_new_functions, ci.ci_fun_heap)
+		= ({	bind_src = App {	app_symb 		= fun_symb,
+									app_args 		= act_args,
+									app_info_ptr	= nilPtr },
+				bind_dst = varToFreeVar var (inc ref_count) },
+		   { ci & ci_var_heap = ci_var_heap, ci_next_fun_nr = ci_next_fun_nr, ci_new_functions = ci_new_functions, ci_fun_heap = ci_fun_heap })
+	where
+		get_reference_count {var_name,var_info_ptr} ci=:{ci_var_heap}
+			# (info, ci_var_heap) = readPtr var_info_ptr ci_var_heap
+			  ci = { ci & ci_var_heap = ci_var_heap }
+			= case info of
+				VI_Default ref_count	-> (ref_count, ci)
+//				_						-> (0, ci) ---> ("get_reference_count", var_name)  /* A predicted variable always has a ref_count */ 
+		
+		save_default ({fv_info_ptr},_) (saved_defaults, ci_var_heap)
+			# (info, ci_var_heap) = readPtr fv_info_ptr ci_var_heap
+			= case info of
+				VI_Default ref_count	-> ([(fv_info_ptr, ref_count) : saved_defaults] , ci_var_heap)
+				_						-> (saved_defaults, ci_var_heap)
+				
+		restore_default (var_info_ptr,ref_count) ci_var_heap
+			= ci_var_heap <:= (var_info_ptr, VI_Default ref_count)
+
+
+/**************************************************************************************************/
+
+createVariables :: [VarInfoPtr] !(Env Expression FreeVar) !*ConversionInfo -> (!Env Expression FreeVar, !*ConversionInfo)
+createVariables var_info_ptrs binds ci
+	= mapAppendSt create_variable var_info_ptrs binds ci
+where
+	create_variable :: VarInfoPtr !*ConversionInfo -> (Bind Expression FreeVar, !*ConversionInfo)
+	create_variable var_info_ptr ci
+		# (placeholder_symb, ci) = getSymbol PD_variablePlaceholder SK_Constructor 3 ci
+		  cyclic_var = {var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}	
+		= ({ bind_src = App {	app_symb = placeholder_symb,
+								app_args = [Var cyclic_var, Var cyclic_var],
+								app_info_ptr = nilPtr },
+			 bind_dst = varToFreeVar cyclic_var 1
+		   },
+		   ci)
+
+/**************************************************************************************************/
+
+newVariable :: String !VarInfo !*ConversionInfo -> *(!BoundVar,!*ConversionInfo)
+newVariable var_name var_info ci=:{ci_var_heap}
+	# (var_info_ptr, ci_var_heap) = newPtr var_info ci_var_heap
+	= ( { var_name = {id_name = var_name, id_info = nilPtr},  var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr},
+	    { ci & ci_var_heap = ci_var_heap })	
+
+
+newDefault :: BoundVar IndirectionVar -> DefaultExpression
+newDefault variable indirection_var = Yes (variable, [indirection_var])
+
+getVariable :: DefaultExpression -> BoundVar
+getVariable (Yes (variable, _)) = variable
+getVariable No = abort "unexpected value in convertDynamics: 'getVariable'"
+
+getIndirectionVar (Yes (_, [ind_var:_])) = ind_var
+getIndirectionVar No = abort "unexpected value in convertDynamics: 'getIndirectionVar'"
+
+toExpression :: DefaultExpression !*ConversionInfo -> (Optional Expression, !*ConversionInfo)
+toExpression No ci = (No, ci)
+toExpression (Yes (variable, indirection_var_list)) ci
+	# (expression, ci) = toExpression2 variable indirection_var_list ci
+	= (Yes expression, ci)
+where
+	toExpression2 variable [] ci = (Var variable, ci)
+	toExpression2 variable [indirection_var : indirection_vars] ci
+		# (expression, ci) = toExpression2 variable indirection_vars ci
+		  (undo_symb, ci) = getSymbol PD_undo_indirections SK_Function 2 ci
+		= (App {	app_symb = undo_symb,
+					app_args = [expression, Var indirection_var],
+					app_info_ptr = nilPtr }, ci)
+
+varToFreeVar :: BoundVar Int -> FreeVar
+varToFreeVar {var_name, var_info_ptr} count
+	= {fv_def_level = NotALevel, fv_name = var_name, fv_info_ptr = var_info_ptr, fv_count = count}
+
+freeVarToVar ::  FreeVar -> BoundVar
+freeVarToVar {fv_name, fv_info_ptr}
+	= { var_name = fv_name,  var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr}
+
+
+addToBoundVars :: BoundVar AType BoundVariables -> BoundVariables
+addToBoundVars var type bound_vars
+	= [ (varToFreeVar var 0, type) : bound_vars ]
+
+
+get_constructor :: !{!GlobalTCType} Index -> Expression
+get_constructor glob_type_inst index
+	= BasicExpr (BVS ("\"" +++ toString  glob_type_inst.[index] +++ "\"")) (BT_String TE)
+
+
+instance toString GlobalTCType
+where
+	toString (GTT_Basic basic_type)				= toString basic_type
+	toString GTT_Function						= " -> "
+	toString (GTT_Constructor type_symb_indent)	= type_symb_indent.type_name.id_name
+
+instance toString BasicType
+where
+	toString BT_Int 		= "Int"
+	toString BT_Char		= "Char"
+	toString BT_Real		= "Real"
+	toString BT_Bool		= "Bool"
+	toString BT_Dynamic		= "Dynamic"
+	toString BT_File		= "File"
+	toString BT_World		= "World"
+	toString (BT_String _)	= "String"
+
+
+getResultType :: ExprInfoPtr !*ConversionInfo -> (!AType, !*ConversionInfo)
+getResultType case_info_ptr ci=:{ci_expr_heap}
+	# (EI_CaseType {ct_result_type}, ci_expr_heap) = readPtr case_info_ptr ci_expr_heap
+	= (ct_result_type, {ci & ci_expr_heap = ci_expr_heap})
+
+getSymbol :: Index ((Global Index) -> SymbKind) Int !*ConversionInfo -> (SymbIdent, !*ConversionInfo)
+getSymbol index symb_kind arity ci=:{ci_predef_symb}
+	# ({pds_module, pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![index]
+	  ci = {ci & ci_predef_symb = ci_predef_symb}
+	  symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity }
+	= (symbol, ci)
+
+getTupleSymbol arity ci=:{ci_predef_symb}
+	# ({pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![GetTupleConsIndex arity]
+    = ( {ds_ident = pds_ident, ds_arity = arity, ds_index = pds_def}, {ci & ci_predef_symb = ci_predef_symb })
+
+getGlobalIndex :: Index !*ConversionInfo -> (Global Index, !*ConversionInfo)
+getGlobalIndex index ci=:{ci_predef_symb}
+	# ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![index]
+	= ( { glob_module = pds_module, glob_object = pds_def} , {ci & ci_predef_symb = ci_predef_symb} )
+
+getConstructor :: Index Int !*ConversionInfo -> (Global DefinedSymbol, !*ConversionInfo)
+getConstructor index arity ci=:{ci_predef_symb}
+	# ({pds_module, pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![index]
+	  defined_symbol = { ds_ident = pds_ident, ds_arity = arity, ds_index = pds_def}
+	= (	{glob_object = defined_symbol, glob_module = pds_module} , {ci & ci_predef_symb = ci_predef_symb} )
+
+
+a_ij_var_name :== { id_name = "a_ij", id_info = nilPtr }
+
+case_ptr :: !*ConversionInfo -> (ExprInfoPtr, !*ConversionInfo)
+case_ptr ci=:{ci_expr_heap}
+	# (expr_info_ptr, ci_expr_heap) = newPtr (EI_CaseType {	ct_pattern_type = empty_attributed_type,
+															ct_result_type = empty_attributed_type,
+															ct_cons_types = repeat (repeat empty_attributed_type)}) ci_expr_heap
+	= (expr_info_ptr, {ci &  ci_expr_heap = ci_expr_heap})
+
+let_ptr :: !*ConversionInfo -> (ExprInfoPtr, !*ConversionInfo)
+let_ptr ci=:{ci_expr_heap}
+	# (expr_info_ptr, ci_expr_heap) = newPtr (EI_LetType (repeat empty_attributed_type)) ci_expr_heap
+	= (expr_info_ptr, {ci &  ci_expr_heap = ci_expr_heap})
+
+
+empty_attributed_type :: AType
+empty_attributed_type = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TE }
+
+
+
+isNo :: (Optional a) -> Bool
+isNo (Yes _) = False
+isNo No = True
+
+zipAppend2 :: [.a] [.b] u:[w:(.a,.b)] -> v:[x:(.a,.b)], [w <= x, u <= v]
+zipAppend2   []       ys     zs = zs
+zipAppend2   xs       []     zs = zs
+zipAppend2 [x : xs] [y : ys] zs = [ (x,y)  :  zipAppend2 xs ys zs ]
+
+
+instance <<< FreeVar
+where
+	(<<<) file {fv_name,fv_info_ptr} = file <<< fv_name <<< '[' <<< fv_info_ptr <<< ']'
+
+instance <<< Ptr a
+where
+	(<<<) file ptr = file <<< ptrToInt ptr  
+
+
+
diff --git a/frontend/convertcases.dcl b/frontend/convertcases.dcl
new file mode 100644
index 0000000..d7b2cf2
--- /dev/null
+++ b/frontend/convertcases.dcl
@@ -0,0 +1,28 @@
+definition module convertcases
+
+import syntax, transform, trans
+
+::	ImportedFunctions 	:== [Global Index]
+
+convertCasesOfFunctionsIntoPatterns :: !*{! Group} !{# {# FunType} } !{# CommonDefs} !*{#FunDef} !*{#{# CheckedTypeDef}}
+		!ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap
+			-> (!ImportedFunctions, !*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
+
+convertImportedTypeSpecifications :: !{# DclModule}  !{# {# FunType} } !{# CommonDefs} !ImportedConstructors !ImportedFunctions
+	!*{# {#CheckedTypeDef}} !*TypeHeaps !*VarHeap -> (!*{#{#CheckedTypeDef}}, !*TypeHeaps, !*VarHeap)
+
+convertDclModule :: !{# DclModule} !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
+	-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
+
+convertIclModule :: !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
+	-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
+
+
+newFunction :: !(Optional Ident) !FunctionBody ![AType] !AType !Int !(!Int, ![FunctionInfoPtr],!*FunctionHeap)
+	-> (! SymbIdent, !(!Int, ![FunctionInfoPtr],!*FunctionHeap))
+
+copyExpression :: ![(FreeVar,AType)] !Expression !*VarHeap -> (![Expression], ![.(FreeVar,AType)], !Expression, !*VarHeap)
+
+addNewFunctionsToGroups :: !{#.CommonDefs} FunctionHeap ![FunctionInfoPtr] !*{! Group} !*{#{# CheckedTypeDef}} !ImportedFunctions !*TypeHeaps !*VarHeap
+	-> (!*{! Group}, ![FunDef],  !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
+
diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl
new file mode 100644
index 0000000..b4be642
--- /dev/null
+++ b/frontend/convertcases.icl
@@ -0,0 +1,1456 @@
+implementation module convertcases
+
+import syntax, transform, checksupport, StdCompare, check, utilities, trans, general, RWSDebug
+
+
+::	*ConversionInfo =
+	{	ci_new_functions 	:: ![FunctionInfoPtr]
+	,	ci_fun_heap			:: !*FunctionHeap
+	,	ci_var_heap			:: !*VarHeap
+	,	ci_expr_heap		:: !*ExpressionHeap
+	,	ci_next_fun_nr		:: !Index
+	}
+	 
+getIdent (Yes ident) fun_nr
+	= ident
+getIdent No fun_nr
+	= { id_name = "_f" +++ toString fun_nr, id_info = nilPtr }
+
+
+class convertCases a :: ![(FreeVar, AType)] !Index !{# CommonDefs } !a  !*ConversionInfo -> (!a, !*ConversionInfo)
+
+instance convertCases [a] | convertCases a
+where
+	convertCases bound_vars group_index common_defs l ci = mapSt (convertCases bound_vars group_index common_defs) l ci 
+		
+instance convertCases (a,b) | convertCases a & convertCases b
+where
+	convertCases bound_vars group_index common_defs t ci
+		= app2St (convertCases bound_vars group_index common_defs, convertCases bound_vars group_index common_defs) t ci
+
+instance convertCases Bind a b | convertCases a
+where
+	convertCases bound_vars group_index common_defs bind=:{bind_src} ci
+		# (bind_src, ci) = convertCases bound_vars group_index common_defs bind_src ci
+		= ({ bind & bind_src = bind_src }, ci)
+
+instance convertCases DynamicExpr
+where
+	convertCases bound_vars group_index common_defs dynamik=:{dyn_expr} ci
+		# (dyn_expr, ci) = convertCases bound_vars group_index common_defs dyn_expr ci
+		= ({ dynamik & dyn_expr = dyn_expr }, ci)
+	
+instance convertCases Let
+where
+	convertCases bound_vars group_index common_defs lad=:{let_binds,let_expr,let_info_ptr} ci=:{ci_expr_heap}
+		# (let_info, ci_expr_heap) =  readPtr let_info_ptr ci_expr_heap
+		  ci = { ci & ci_expr_heap = ci_expr_heap }
+		= case let_info of
+			EI_LetType let_type
+				# ((let_binds,let_expr), ci) = convertCases (addLetVars let_binds let_type bound_vars) group_index common_defs (let_binds,let_expr) ci
+				-> ({ lad & let_binds = let_binds, let_expr = let_expr }, ci)
+			_
+				-> abort "convertCases [Let] (convertcases 53)" <<- let_info 
+
+addLetVars [{bind_dst} : binds] [bind_type : bind_types] bound_vars
+	= addLetVars binds bind_types [ (bind_dst, bind_type) : bound_vars ]
+addLetVars [] _ bound_vars
+	= bound_vars
+
+instance convertCases Expression  
+where
+	convertCases bound_vars group_index common_defs (App app=:{app_args}) ci
+		# (app_args, ci) = convertCases bound_vars group_index common_defs app_args ci
+		= (App {app & app_args = app_args}, ci)
+	convertCases bound_vars group_index common_defs (fun_expr @ exprs) ci
+		# ((fun_expr, exprs), ci) = convertCases bound_vars group_index common_defs (fun_expr, exprs) ci
+		= (fun_expr @ exprs, ci)
+	convertCases bound_vars group_index common_defs (Let lad) ci
+		# (lad, ci) = convertCases bound_vars group_index common_defs lad ci
+		= (Let lad, ci)
+	convertCases bound_vars group_index common_defs (MatchExpr opt_tuple constructor expr) ci
+		# (expr, ci) = convertCases bound_vars group_index common_defs expr ci
+		= (MatchExpr opt_tuple constructor expr, ci)
+	convertCases bound_vars group_index common_defs (Selection is_unique expr selectors) ci
+		# (expr, ci) = convertCases bound_vars group_index common_defs expr ci
+		  (selectors, ci) = convertCases bound_vars group_index common_defs selectors ci
+		= (Selection is_unique expr selectors, ci)		
+	convertCases bound_vars group_index common_defs (Update expr1 selectors expr2) ci
+		# (expr1, ci) = convertCases bound_vars group_index common_defs expr1 ci
+		  (selectors, ci) = convertCases bound_vars group_index common_defs selectors ci
+		  (expr2, ci) = convertCases bound_vars group_index common_defs expr2 ci
+		= (Update expr1 selectors expr2, ci)		
+	convertCases bound_vars group_index common_defs (RecordUpdate cons_symbol expression expressions) ci
+		# (expression, ci) = convertCases bound_vars group_index common_defs expression ci
+		  (expressions, ci) = convertCases bound_vars group_index common_defs expressions ci
+		= (RecordUpdate cons_symbol expression expressions, ci)		
+	convertCases bound_vars group_index common_defs (TupleSelect tuple_symbol arg_nr expr) ci
+		# (expr, ci) = convertCases bound_vars group_index common_defs expr ci
+		= (TupleSelect tuple_symbol arg_nr expr, ci)
+	convertCases bound_vars group_index common_defs (Case case_expr) ci
+		= convertCasesInCaseExpression bound_vars group_index common_defs cHasNoDefault case_expr ci
+	convertCases bound_vars group_index common_defs (DynamicExpr dynamik) ci
+		# (dynamik, ci) = convertCases bound_vars group_index common_defs dynamik ci
+		= (DynamicExpr dynamik, ci)
+	convertCases bound_vars group_index common_defs expr ci
+		= (expr, ci)
+
+instance convertCases Selection  
+where
+	convertCases bound_vars group_index common_defs (DictionarySelection record selectors expr_ptr index_expr) ci
+		# (index_expr, ci) = convertCases bound_vars group_index common_defs index_expr ci
+		  (selectors, ci) = convertCases bound_vars group_index common_defs selectors ci
+		= (DictionarySelection record selectors expr_ptr index_expr, ci)
+	convertCases bound_vars group_index common_defs (ArraySelection selector expr_ptr index_expr) ci
+		# (index_expr, ci) = convertCases bound_vars group_index common_defs index_expr ci
+		= (ArraySelection selector expr_ptr index_expr, ci)
+	convertCases bound_vars group_index common_defs selector ci
+		= (selector, ci)
+
+cHasNoDefault :== nilPtr
+
+convertDefaultToExpression default_ptr (EI_Default expr type prev_default) bound_vars group_index common_defs ci=:{ci_var_heap}
+	# (act_args, free_typed_vars, expression, ci_var_heap) = copyExpression bound_vars expr ci_var_heap
+	  (fun_symb, ci) = newDefaultFunction free_typed_vars expression type prev_default group_index common_defs { ci & ci_var_heap = ci_var_heap }
+	= (App { app_symb = fun_symb, app_args = act_args, app_info_ptr = nilPtr }, 
+		{ ci & ci_expr_heap = ci.ci_expr_heap <:= (default_ptr, EI_DefaultFunction fun_symb act_args)})
+convertDefaultToExpression default_ptr (EI_DefaultFunction fun_symb act_args) bound_vars group_index common_defs ci
+	= (App { app_symb = fun_symb, app_args = act_args, app_info_ptr = nilPtr }, ci)
+
+combineDefaults default_ptr No bound_vars guards group_index common_defs ci=:{ci_expr_heap}
+	| isNilPtr default_ptr
+		= (No, ci)
+	| case_is_partial guards common_defs
+		# (default_info, ci_expr_heap) = readPtr default_ptr ci_expr_heap
+		  (default_expr, ci) = convertDefaultToExpression default_ptr default_info bound_vars group_index common_defs { ci & ci_expr_heap = ci_expr_heap }
+		= (Yes default_expr, ci)
+		= (No, ci)
+where
+	case_is_partial (AlgebraicPatterns {glob_module, glob_object} patterns) common_defs
+		# {td_rhs} = common_defs.[glob_module].com_type_defs.[glob_object]
+		= length patterns < nr_of_alternatives td_rhs
+	where
+		nr_of_alternatives (AlgType conses)
+			= length conses
+		nr_of_alternatives _
+			= 1
+
+	case_is_partial (BasicPatterns BT_Bool bool_patterns) common_defs
+		= length bool_patterns < 2
+	case_is_partial patterns common_defs
+		= True
+
+combineDefaults default_ptr this_default bound_vars guards group_index common_defs ci
+	= (this_default, ci)
+	
+
+retrieveVariable (var_info_ptr, type) (bound_vars, free_typed_vars, var_heap)
+	# (VI_FreeVar name new_ptr count type, var_heap) = readPtr var_info_ptr var_heap
+	= ( [Var { var_name = name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} : bound_vars],
+		[({ fv_def_level = NotALevel, fv_name = name, fv_info_ptr = new_ptr, fv_count = count }, type) :  free_typed_vars], var_heap)
+
+copyCaseExpression bound_vars opt_variable guards_and_default var_heap
+    # var_heap = foldSt (\({fv_name,fv_info_ptr},type) -> writePtr fv_info_ptr (VI_BoundVar type)) bound_vars var_heap
+	  (opt_copied_var, var_heap) = copy_variable opt_variable var_heap
+	  (expression, {cp_free_vars, cp_var_heap}) = copy guards_and_default ({ cp_free_vars = [], cp_var_heap = var_heap }
+				==> ("copyCaseExpression", bound_vars, guards_and_default))
+	  (bound_vars, free_typed_vars, var_heap) = foldSt retrieveVariable cp_free_vars ([], [], cp_var_heap)
+	  (opt_free_var, var_heap) = toOptionalFreeVar opt_copied_var var_heap
+	= (bound_vars, free_typed_vars, opt_free_var, expression, var_heap)
+where
+	copy_variable (Yes (var=:{var_name,var_info_ptr}, var_type)) var_heap
+		# (new_info, var_heap) = newPtr VI_Empty var_heap
+		= (Yes (var_info_ptr, var_type), var_heap <:= (var_info_ptr, VI_FreeVar var_name new_info 0 var_type))
+	copy_variable No var_heap
+		= (No, var_heap)
+
+copyExpression :: ![(FreeVar,AType)] !Expression !*VarHeap -> (![Expression], ![.(FreeVar,AType)], !Expression, !*VarHeap)
+copyExpression bound_vars expression var_heap
+    # var_heap = foldSt (\({fv_name,fv_info_ptr},type) -> writePtr fv_info_ptr (VI_BoundVar type)) bound_vars var_heap
+	  (expression, {cp_free_vars, cp_var_heap}) = copy expression { cp_free_vars = [], cp_var_heap = var_heap }
+	  (bound_vars, free_typed_vars, var_heap) = foldSt retrieveVariable cp_free_vars ([], [], cp_var_heap)
+	= (bound_vars, free_typed_vars, expression, var_heap)
+
+convertCasesInCaseExpression bound_vars group_index common_defs default_ptr { case_expr, case_guards, case_default, case_ident, case_info_ptr} ci
+	# (case_default, ci) = combineDefaults default_ptr case_default bound_vars case_guards group_index common_defs ci
+	  (case_expr, ci) = convertCases bound_vars group_index common_defs case_expr ci
+	  (EI_CaseTypeAndRefCounts case_type ref_counts, ci_expr_heap) = readPtr case_info_ptr ci.ci_expr_heap
+	  (act_vars, form_vars, opt_free_var, (case_guards, case_default), ci_var_heap)
+			= copyCaseExpression bound_vars (get_variable case_expr case_type.ct_pattern_type) (case_guards,case_default) ci.ci_var_heap
+	  (fun_symb, ci) = newCaseFunction case_ident case_guards case_default case_type opt_free_var form_vars
+	  							group_index common_defs default_ptr { ci & ci_var_heap = ci_var_heap, ci_expr_heap = ci_expr_heap }
+	= (App { app_symb = fun_symb, app_args = [ case_expr : act_vars ], app_info_ptr = nilPtr }, ci)
+where
+	get_variable (Var var) pattern_type
+		= Yes (var, pattern_type)
+	get_variable _ _
+		= No
+
+
+makePtrToDefault (Yes default_expr) type prev_default_ptr expr_heap
+	= newPtr (EI_Default default_expr type prev_default_ptr) expr_heap
+makePtrToDefault No type prev_default_ptr expr_heap
+	= (cHasNoDefault, expr_heap)
+
+
+convertDefault default_ptr opt_var left_vars right_vars group_index common_defs (fun_bodies, ci)
+	| isNilPtr default_ptr
+		= (fun_bodies, ci)
+		# (default_info, ci_expr_heap) = readPtr default_ptr ci.ci_expr_heap
+		= convert_default default_info opt_var left_vars right_vars group_index common_defs (fun_bodies, { ci & ci_expr_heap = ci_expr_heap})
+where
+	convert_default (EI_Default default_expr type prev_default) opt_var left_vars right_vars group_index common_defs (fun_bodies, ci)
+		# (bb_rhs, ci) = convertRootExpression (left_vars ++ consOptional opt_var right_vars) group_index common_defs prev_default default_expr ci
+		  bb_args = build_args opt_var left_vars right_vars
+		= (fun_bodies ++ [{ bb_args = bb_args, bb_rhs = bb_rhs }], ci)	
+	convert_default (EI_DefaultFunction fun_symb act_args) opt_var left_vars right_vars group_index common_defs (fun_bodies, ci)
+		# bb_args = build_args opt_var left_vars right_vars
+		  bb_rhs = App { app_symb = fun_symb, app_args = act_args, app_info_ptr = nilPtr }
+		= (fun_bodies ++ [{ bb_args = bb_args, bb_rhs = bb_rhs }], ci)	
+
+	build_args (Yes (var,type)) left_vars right_vars
+		= mapAppend typed_free_var_to_pattern left_vars [FP_Variable var : map typed_free_var_to_pattern right_vars]
+	build_args No left_vars right_vars
+		= mapAppend typed_free_var_to_pattern left_vars [FP_Empty : map typed_free_var_to_pattern right_vars]
+
+	typed_free_var_to_pattern (free_var, type) = FP_Variable free_var
+
+newDefaultFunction free_vars rhs_expr result_type prev_default group_index common_defs ci
+	# (guarded_exprs, ci) = convertPatternExpression [] [free_vars] group_index common_defs prev_default rhs_expr ci
+	  fun_bodies  = map build_pattern guarded_exprs
+	  arg_types = map (\(_,type) -> type) free_vars
+	  (fun_symb,  (ci_next_fun_nr, ci_new_functions, ci_fun_heap))
+			= newFunction No (BackendBody fun_bodies) arg_types result_type group_index
+					(ci.ci_next_fun_nr, ci.ci_new_functions, ci.ci_fun_heap)
+	= (fun_symb, { ci & ci_fun_heap = ci_fun_heap, ci_next_fun_nr = ci_next_fun_nr, ci_new_functions = ci_new_functions })
+where
+	build_pattern ([ right_patterns : _ ], bb_rhs)
+		= { bb_args = right_patterns, bb_rhs = bb_rhs }
+
+newCaseFunction opt_id patterns case_default {ct_result_type,ct_pattern_type,ct_cons_types} opt_var free_vars
+		group_index common_defs prev_default ci=:{ci_expr_heap}
+	# (default_ptr, ci_expr_heap) = makePtrToDefault case_default ct_result_type prev_default ci_expr_heap
+	  (fun_bodies, ci) = convertPatterns patterns ct_cons_types opt_var [] free_vars default_ptr group_index common_defs { ci & ci_expr_heap = ci_expr_heap }
+	  (fun_bodies, ci) = convertDefault default_ptr opt_var [] free_vars group_index common_defs (fun_bodies, ci)
+	  (fun_symb,  (ci_next_fun_nr, ci_new_functions, ci_fun_heap))
+			= newFunction opt_id (BackendBody fun_bodies) [ct_pattern_type : map (\(_,type) -> type) free_vars] ct_result_type group_index
+					(ci.ci_next_fun_nr, ci.ci_new_functions, ci.ci_fun_heap)
+	= (fun_symb, { ci & ci_fun_heap = ci_fun_heap, ci_next_fun_nr = ci_next_fun_nr, ci_new_functions = ci_new_functions })
+
+newFunction :: !(Optional Ident) !FunctionBody ![AType] !AType !Int !(!Int, ![FunctionInfoPtr],!*FunctionHeap)
+	-> (! SymbIdent, !(!Int, ![FunctionInfoPtr],!*FunctionHeap))
+newFunction opt_id fun_bodies arg_types result_type group_index (ci_next_fun_nr, ci_new_functions, ci_fun_heap)
+	# (fun_def_ptr, ci_fun_heap) = newPtr FI_Empty ci_fun_heap
+	  fun_id = getIdent opt_id ci_next_fun_nr
+	  arity = length arg_types
+	  fun_type =
+	  	{	st_vars			= []
+		,	st_args			= arg_types
+		,	st_arity		= arity
+		,	st_result		= result_type
+		,	st_context		= []
+		,	st_attr_vars	= []
+		,	st_attr_env		= []
+		}
+
+	  fun_def = 
+			{	fun_symb		= fun_id
+			,	fun_arity		= arity
+			,	fun_priority	= NoPrio
+			,	fun_body		= fun_bodies
+			,	fun_type		= Yes fun_type
+			,	fun_pos			= NoPos
+			,	fun_index		= NoIndex
+			,	fun_kind		= FK_Function
+			,	fun_lifted		= 0
+			,	fun_info		= { EmptyFunInfo & fi_group_index = group_index }
+			}
+	= ({ symb_name = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr ci_next_fun_nr, symb_arity = arity },
+			(inc ci_next_fun_nr, [fun_def_ptr : ci_new_functions],
+				ci_fun_heap <:= (fun_def_ptr,  FI_Function { gf_fun_def = fun_def, gf_instance_info = II_Empty,
+	  				  gf_fun_index = ci_next_fun_nr, gf_cons_args = {cc_args = [], cc_size=0} })))
+
+
+consOptional (Yes x) xs = [x : xs]
+consOptional No xs = xs
+
+getOptionalFreeVar (Yes (free_var,_)) = Yes free_var
+getOptionalFreeVar No = No
+
+optionalToListofLists (Yes x)
+	= [[x]]
+optionalToListofLists No
+	= []
+
+hasOption (Yes _)	= True
+hasOption No		= False
+
+convertPatterns (AlgebraicPatterns algtype patterns) cons_types opt_var left_vars right_vars default_ptr group_index common_defs ci
+	# (guarded_exprs_list, ci) = mapSt (convert_algebraic_guard_into_function_pattern opt_var left_vars right_vars
+			group_index common_defs default_ptr) (zip2 patterns cons_types) ci
+	= (flatten guarded_exprs_list, ci)
+where
+	convert_algebraic_guard_into_function_pattern opt_var left_vars right_vars group_index common_defs default_ptr ({ap_symbol, ap_vars, ap_expr}, cons_arg_types) ci
+		# pattern_vars = zip2 ap_vars cons_arg_types
+		  (guarded_exprs, ci)
+				= convertPatternExpression (consOptional opt_var left_vars) [pattern_vars, right_vars] group_index common_defs default_ptr ap_expr ci
+		= (map (complete_pattern left_vars ap_symbol (getOptionalFreeVar opt_var)) guarded_exprs, ci)
+	where
+		complete_pattern left_vars cons_symbol optional_var ([ pattern_args, right_patterns : _ ], bb_rhs)
+			# bb_args = mapAppend selectFreeVar left_vars [FP_Algebraic cons_symbol pattern_args optional_var : right_patterns ]
+			= { bb_args = bb_args, bb_rhs = bb_rhs }			
+convertPatterns (BasicPatterns bastype patterns) cons_types opt_var left_vars right_vars default_ptr group_index common_defs ci
+	# (guarded_exprs_list, ci) = mapSt (convert_basic_guard_into_function_pattern opt_var left_vars right_vars
+			group_index common_defs default_ptr) patterns ci
+	= (flatten guarded_exprs_list, ci)
+where
+	convert_basic_guard_into_function_pattern opt_var left_vars right_vars group_index common_defs default_ptr {bp_value, bp_expr} ci
+		# (guarded_exprs, ci)
+				= convertPatternExpression (consOptional opt_var left_vars) [right_vars] group_index common_defs default_ptr bp_expr ci
+		= (map (complete_pattern left_vars bp_value (getOptionalFreeVar opt_var)) guarded_exprs, ci)
+	where
+		complete_pattern left_vars value optional_var ([ right_patterns : _ ], bb_rhs)
+			# bb_args = mapAppend selectFreeVar left_vars [FP_Basic value optional_var : right_patterns ]
+			= { bb_args = bb_args, bb_rhs = bb_rhs }
+
+convertPatternExpression :: ![(FreeVar,AType)] ![[(FreeVar,AType)]] !Index !{#CommonDefs} !ExprInfoPtr !Expression !*ConversionInfo
+	-> *(![([[FunctionPattern]], !Expression)], !*ConversionInfo)
+convertPatternExpression left_vars right_vars group_index common_defs default_ptr
+		case_expr=:(Case {case_expr = Var var=:{var_info_ptr}, case_guards, case_default, case_info_ptr}) ci
+	| list_contains_variable var_info_ptr right_vars
+		= case case_guards of
+			BasicPatterns type basic_patterns
+				# split_result = split_list_of_vars var_info_ptr [] right_vars
+				  (default_patterns, ci) = convert_default left_vars split_result group_index common_defs case_default ci
+				  (guarded_exprs, ci) = mapSt (convert_basic_guard_into_function_pattern left_vars split_result group_index common_defs) basic_patterns ci
+				-> (flatten guarded_exprs ++ default_patterns, ci)
+			AlgebraicPatterns type algebraic_patterns
+				# (EI_CaseTypeAndRefCounts {ct_cons_types} _, ci_expr_heap) = readPtr case_info_ptr ci.ci_expr_heap
+		  		  split_result = split_list_of_vars var_info_ptr [] right_vars
+				  (default_patterns, ci) = convert_default left_vars split_result group_index common_defs case_default { ci & ci_expr_heap = ci_expr_heap }
+				  (guarded_exprs, ci) = mapSt (convert_algebraic_guard_into_function_pattern left_vars split_result group_index common_defs case_info_ptr)
+											(zip2 algebraic_patterns ct_cons_types) ci
+				-> (flatten guarded_exprs ++ default_patterns, ci)
+			_
+				-> convertToRhsExpression left_vars right_vars group_index common_defs default_ptr case_expr ci
+		= convertToRhsExpression left_vars right_vars group_index common_defs default_ptr case_expr ci
+where
+	list_contains_variable var_info_ptr []
+		= False
+	list_contains_variable var_info_ptr [ right_vars : list_of_right_vars ]
+		= contains_variable var_info_ptr right_vars || list_contains_variable var_info_ptr list_of_right_vars
+	where
+		contains_variable var_info_ptr []
+			= False
+		contains_variable var_info_ptr [ ({fv_info_ptr},_) : right_vars ]
+			= var_info_ptr == fv_info_ptr || contains_variable var_info_ptr right_vars
+	
+	convert_default left_vars ((fv,fv_type), list_of_left, list_of_right) group_index common_defs (Yes default_expr) ci
+		# (guarded_exprs, ci)
+				= convertPatternExpression (left_vars ++ [ (fv,fv_type) : flatten list_of_left ]) list_of_right group_index common_defs default_ptr default_expr ci
+		= (map (complete_pattern list_of_left fv) guarded_exprs, ci) 
+	where
+		complete_pattern list_of_left this_var (list_of_patterns, expr)
+			= (complete_patterns list_of_left (FP_Variable this_var) list_of_patterns, expr)
+	convert_default left_vars ((fv,fv_type), list_of_left, list_of_right) group_index common_defs No ci
+		= ([], ci)
+	
+	convert_basic_guard_into_function_pattern left_vars ((fv,fv_type), list_of_left, list_of_right) group_index common_defs {bp_value, bp_expr} ci
+		# (guarded_exprs, ci)
+				= convertPatternExpression (left_vars ++ [ (fv,fv_type) : flatten list_of_left ]) list_of_right group_index common_defs default_ptr bp_expr ci
+		= (map (complete_pattern list_of_left bp_value (Yes fv)) guarded_exprs, ci) 
+	where
+		complete_pattern list_of_left value opt_var (list_of_patterns, expr)
+			= (complete_patterns list_of_left (FP_Basic value opt_var) list_of_patterns, expr)
+	
+	convert_algebraic_guard_into_function_pattern left_vars ((fv,fv_type), list_of_left, list_of_right) group_index common_defs case_info_ptr
+				({ap_symbol, ap_vars, ap_expr}, arg_types) ci=:{ci_expr_heap}
+		# (guarded_exprs, ci)
+				= convertPatternExpression (left_vars ++ [ (fv,fv_type) : flatten list_of_left ]) [ zip2 ap_vars arg_types : list_of_right ]
+						 group_index common_defs default_ptr ap_expr { ci & ci_expr_heap = ci_expr_heap }
+		= (map (complete_pattern list_of_left ap_symbol (Yes fv)) guarded_exprs, ci) 
+	where
+		complete_pattern :: ![[(FreeVar,a)]] !(Global DefinedSymbol) !(Optional !FreeVar) !([[FunctionPattern]], !b) -> (![[FunctionPattern]], !b)
+		complete_pattern list_of_left cons_symbol opt_var ([ patterns : list_of_patterns], expr)
+			= (complete_patterns list_of_left (FP_Algebraic cons_symbol patterns opt_var) list_of_patterns, expr)
+
+	split_list_of_vars var_info_ptr list_of_left [ vars : list_of_vars ]
+		# (fv, left, list_of_left, list_of_right) = split_vars var_info_ptr [] list_of_left vars list_of_vars
+		= (fv, [left : list_of_left], list_of_right)
+	where
+		split_vars var_info_ptr left list_of_left []  list_of_vars 
+			# (fv, list_of_left, list_of_right) =  split_list_of_vars var_info_ptr list_of_left list_of_vars 
+			= (fv, left, list_of_left, list_of_right)
+	
+		split_vars var_info_ptr left list_of_left [ this_var=:(fv,_) : vars ] list_of_vars
+			| var_info_ptr == fv.fv_info_ptr
+				= (this_var, left, list_of_left, [ vars : list_of_vars ])
+				= split_vars var_info_ptr [this_var : left] list_of_left vars list_of_vars
+
+	complete_patterns [ left_args ] current_pattern [ right_args : list_of_right_args ]
+		= [ add_free_vars left_args [current_pattern : right_args] : list_of_right_args ]
+	complete_patterns [ left_args : list_of_left_args ] current_pattern list_of_right_args
+		= [ add_free_vars left_args [] : complete_patterns list_of_left_args current_pattern list_of_right_args ]
+
+	add_free_vars [(fv, _) : left_vars] right_vars
+		= add_free_vars left_vars [ FP_Variable fv : right_vars ]
+	add_free_vars [] right_vars
+		= right_vars
+
+convertPatternExpression left_vars right_vars group_index common_defs default_ptr expr ci
+	= convertToRhsExpression left_vars right_vars group_index common_defs default_ptr expr ci
+
+convertToRhsExpression left_vars right_vars group_index common_defs default_ptr expr ci
+	# (bb_rhs, ci) = convertRootExpression (left_vars ++ flatten right_vars) group_index common_defs default_ptr expr ci
+	= ([(map (map selectFreeVar) right_vars, bb_rhs)], ci)
+	
+selectFreeVar (fv,_) = FP_Variable fv
+
+toFreeVar (var_info_ptr, _) var_heap
+	#! var_info = sreadPtr var_info_ptr var_heap
+	# (VI_FreeVar name new_ptr count type) = var_info
+	= (FP_Variable { fv_def_level = NotALevel, fv_name = name, fv_info_ptr = new_ptr, fv_count = count}, var_heap)
+		 	
+toOptionalFreeVar (Yes (var_info_ptr, type)) var_heap
+	#! var_info = sreadPtr var_info_ptr var_heap
+	= case var_info of
+		VI_FreeVar name new_ptr count type
+			-> (Yes ({ fv_def_level = NotALevel, fv_name = name, fv_info_ptr = new_ptr, fv_count = count}, type), var_heap)
+		_
+			-> (No, var_heap)
+toOptionalFreeVar No var_heap
+	= (No, var_heap)
+
+::	ImportedFunctions 	:== [Global Index]
+
+addNewFunctionsToGroups :: !{#.CommonDefs} FunctionHeap ![FunctionInfoPtr] !*{! Group} !*{#{# CheckedTypeDef}} !ImportedFunctions !*TypeHeaps !*VarHeap
+	-> (!*{! Group}, ![FunDef],  !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
+addNewFunctionsToGroups common_defs fun_heap new_functions groups imported_types imported_conses type_heaps var_heap
+	= foldSt (add_new_function_to_group fun_heap common_defs) new_functions (groups, [], imported_types, imported_conses, type_heaps, var_heap)
+where
+
+	add_new_function_to_group :: !FunctionHeap  !{# CommonDefs} !FunctionInfoPtr
+				!(!*{! Group}, ![FunDef], !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
+					-> (!*{! Group}, ![FunDef],  !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
+	add_new_function_to_group fun_heap common_defs fun_ptr (groups, fun_defs, imported_types, imported_conses, type_heaps, var_heap)
+		# (FI_Function {gf_fun_def,gf_fun_index}) = sreadPtr fun_ptr fun_heap
+		  group_index = gf_fun_def.fun_info.fi_group_index
+		  (Yes ft) = gf_fun_def.fun_type
+		  (ft, imported_types, imported_conses, type_heaps, var_heap) = convertSymbolType common_defs ft imported_types imported_conses type_heaps var_heap
+		#! group = groups.[group_index]
+		= ({ groups & [group_index] = { group & group_members = [gf_fun_index : group.group_members]} },
+				[ { gf_fun_def & fun_type = Yes ft }: fun_defs], imported_types, imported_conses, type_heaps, var_heap)
+
+convertCasesOfFunctionsIntoPatterns :: !*{! Group} !{# {# FunType} } !{# CommonDefs} !*{#FunDef} !*{#{# CheckedTypeDef}}
+		!ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap
+			-> (!ImportedFunctions, !*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
+convertCasesOfFunctionsIntoPatterns groups dcl_functions common_defs fun_defs imported_types imported_conses var_heap type_heaps expr_heap
+	#! nr_of_funs = size fun_defs
+	# (groups, (fun_defs, collected_imports, {ci_new_functions, ci_var_heap, ci_expr_heap, ci_fun_heap}))
+			= convert_groups 0 groups dcl_functions common_defs
+				(fun_defs, [], { ci_new_functions = [], ci_fun_heap = newHeap, ci_var_heap = var_heap, ci_expr_heap = expr_heap, ci_next_fun_nr = nr_of_funs })
+	  (groups, new_fun_defs, imported_types, imported_conses, type_heaps, ci_var_heap)
+			= addNewFunctionsToGroups common_defs ci_fun_heap ci_new_functions groups imported_types imported_conses type_heaps ci_var_heap
+//	  		= foldSt (add_new_function_to_group ci_fun_heap common_defs) ci_new_functions (groups, [], imported_types, imported_conses, type_heaps, ci_var_heap)
+	  (imported_functions, imported_conses) = foldSt split collected_imports ([], imported_conses)
+	= (imported_functions, groups, { fundef \\ fundef <- [ fundef \\ fundef <-: fun_defs ] ++ new_fun_defs },
+			imported_types, imported_conses, ci_var_heap, type_heaps, ci_expr_heap)
+where
+	convert_groups group_nr groups dcl_functions common_defs fun_defs_and_ci
+		| group_nr == size groups
+			= (groups, fun_defs_and_ci)
+			#! group = groups.[group_nr]
+			= convert_groups (inc group_nr) groups dcl_functions common_defs
+				(foldSt (convert_function group_nr dcl_functions common_defs) group.group_members fun_defs_and_ci)
+
+
+	convert_function group_index dcl_functions common_defs fun (fun_defs, collected_imports, ci)
+		#! fun_def = fun_defs.[fun]
+		# {fun_body,fun_type} = fun_def
+		  (fun_body, (collected_imports, ci)) = eliminate_code_sharing_in_function dcl_functions common_defs (fun_body ==> ("convert_function", fun_def.fun_symb)) (collected_imports, ci)		  		
+		  (fun_body, ci) = convert_cases_into_function_patterns fun_body fun_type group_index common_defs ci
+		= ({fun_defs & [fun] = { fun_def & fun_body = fun_body }}, collected_imports, ci)
+
+	convert_cases_into_function_patterns (TransformedBody {tb_args,tb_rhs=Case {case_expr = Var var=:{var_info_ptr}, case_guards, case_default, case_info_ptr}})
+			(Yes {st_result,st_args}) group_index common_defs ci=:{ci_expr_heap}
+		# (EI_CaseTypeAndRefCounts case_type _, ci_expr_heap) = readPtr case_info_ptr ci_expr_heap
+		  (default_ptr, ci_expr_heap) = makePtrToDefault case_default st_result cHasNoDefault ci_expr_heap
+		  vars_with_types = zip2 tb_args st_args
+		  (form_var_with_type, left_vars, right_vars) = split_vars var_info_ptr vars_with_types
+		  (fun_bodies, ci) = convertPatterns case_guards case_type.ct_cons_types (Yes form_var_with_type) left_vars right_vars default_ptr group_index common_defs
+					{ ci & ci_expr_heap = ci_expr_heap }
+		  (fun_bodies, ci) = convertDefault default_ptr (Yes form_var_with_type) left_vars right_vars group_index common_defs (fun_bodies, ci) 
+		= (BackendBody fun_bodies, ci)
+	where
+		split_vars var_info_ptr [ form_var_with_type=:({fv_info_ptr},_) : free_vars]
+			| var_info_ptr == fv_info_ptr
+				= (form_var_with_type, [], free_vars)
+				# (form_var, left, right) = split_vars var_info_ptr free_vars
+				= (form_var, [form_var_with_type : left], right)			
+	convert_cases_into_function_patterns (TransformedBody {tb_args,tb_rhs}) (Yes {st_result,st_args}) group_index common_defs ci
+		# (tb_rhs, ci) = convertRootExpression (zip2 tb_args st_args) group_index common_defs cHasNoDefault tb_rhs ci
+		= (BackendBody [ { bb_args = map FP_Variable tb_args, bb_rhs = tb_rhs }], ci)
+
+	eliminate_code_sharing_in_function dcl_functions common_defs (TransformedBody body=:{tb_rhs}) (collected_imports, ci=:{ci_expr_heap,ci_var_heap})
+		# {rc_var_heap, rc_expr_heap, rc_imports} = weightedRefCount dcl_functions common_defs 1 tb_rhs
+				{ rc_var_heap = ci_var_heap, rc_expr_heap = ci_expr_heap, rc_free_vars = [], rc_imports = collected_imports} 
+		  	==> ("eliminate_code_sharing_in_function (weightedRefCount)", tb_rhs)
+		  (tb_rhs, {di_lets,di_var_heap,di_expr_heap}) = distributeLets 1 tb_rhs { di_lets = [], di_var_heap = rc_var_heap, di_expr_heap = rc_expr_heap}
+		  (tb_rhs, (var_heap, expr_heap)) = buildLetExpr di_lets tb_rhs (di_var_heap,di_expr_heap)
+		= (TransformedBody { body & tb_rhs = tb_rhs }, (rc_imports, { ci & ci_var_heap = var_heap, ci_expr_heap = expr_heap }))
+		  	==> ("eliminate_code_sharing_in_function (distributeLets)", tb_rhs)
+
+	split (SK_Function fun_symb) (collected_functions, collected_conses)
+		= ([fun_symb : collected_functions], collected_conses)
+	split (SK_Constructor cons_symb) (collected_functions, collected_conses)
+		= (collected_functions, [ cons_symb : collected_conses])
+
+convertDclModule :: !{# DclModule} !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
+	-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
+convertDclModule dcl_mods common_defs imported_types imported_conses var_heap type_heaps
+	# {dcl_functions,dcl_common={com_type_defs,com_cons_defs,com_selector_defs},dcl_conversions} = dcl_mods.[cIclModIndex]
+	= case dcl_conversions of
+		Yes conversion_table
+			# (icl_type_defs, imported_types) = imported_types![cIclModIndex]
+			  types_and_heaps = convert_dcl_functions dcl_functions common_defs ( { imported_types & [cIclModIndex] = com_type_defs }, imported_conses, var_heap, type_heaps)
+			  types_and_heaps = convertConstructorTypes com_cons_defs common_defs types_and_heaps
+			  (imported_types, imported_conses, var_heap, type_heaps) = convertSelectorTypes com_selector_defs common_defs types_and_heaps
+			-> ({ imported_types & [cIclModIndex] = icl_type_defs}, imported_conses, var_heap, type_heaps)
+		No
+			-> (imported_types, imported_conses, var_heap, type_heaps)
+where
+	convert_dcl_functions dcl_functions common_defs types_and_heaps
+		= iFoldSt (convert_dcl_function dcl_functions common_defs) 0 (size dcl_functions) types_and_heaps
+
+	convert_dcl_function dcl_functions common_defs dcl_index (imported_types, imported_conses, var_heap, type_heaps)
+		# {ft_type, ft_type_ptr} = dcl_functions.[dcl_index]
+		  (ft_type, imported_types, imported_conses, type_heaps, var_heap) = convertSymbolType common_defs ft_type imported_types imported_conses type_heaps var_heap
+		= (imported_types, imported_conses, var_heap <:= (ft_type_ptr, VI_ExpandedType ft_type), type_heaps)
+	
+convertConstructorTypes cons_defs common_defs types_and_heaps
+	= iFoldSt (convert_constructor_type common_defs cons_defs) 0 (size cons_defs) types_and_heaps
+where
+	convert_constructor_type common_defs cons_defs cons_index (imported_types, imported_conses, var_heap, type_heaps)  
+		# {cons_type_ptr, cons_type} = cons_defs.[cons_index]
+		  (cons_type, imported_types, imported_conses, type_heaps, var_heap)
+				= convertSymbolType common_defs cons_type imported_types imported_conses type_heaps var_heap
+		= (imported_types, imported_conses, var_heap <:= (cons_type_ptr, VI_ExpandedType cons_type), type_heaps)
+		
+
+convertSelectorTypes selector_defs common_defs types_and_heaps
+	= iFoldSt (convert_selector_type common_defs selector_defs) 0 (size selector_defs) types_and_heaps
+where
+	convert_selector_type common_defs selector_defs sel_index (imported_types, imported_conses, var_heap, type_heaps)  
+		# {sd_type_ptr, sd_type} = selector_defs.[sel_index]
+		  (sd_type, imported_types, imported_conses, type_heaps, var_heap)
+				= convertSymbolType common_defs sd_type imported_types imported_conses type_heaps var_heap
+		= (imported_types, imported_conses, var_heap <:= (sd_type_ptr, VI_ExpandedType sd_type), type_heaps)
+
+convertIclModule :: !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
+	-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
+convertIclModule common_defs imported_types imported_conses var_heap type_heaps
+	# types_and_heaps = convertConstructorTypes common_defs.[cIclModIndex].com_cons_defs common_defs (imported_types, imported_conses, var_heap, type_heaps)
+	= convertSelectorTypes common_defs.[cIclModIndex].com_selector_defs common_defs types_and_heaps
+
+convertImportedTypeSpecifications :: !{# DclModule}  !{# {# FunType} } !{# CommonDefs} !ImportedConstructors !ImportedFunctions
+	!*{# {#CheckedTypeDef}} !*TypeHeaps !*VarHeap -> (!*{#{#CheckedTypeDef}}, !*TypeHeaps, !*VarHeap)
+convertImportedTypeSpecifications dcl_mods dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap
+	# {dcl_common={com_type_defs},dcl_conversions} = dcl_mods.[cIclModIndex]
+	= case dcl_conversions of
+		Yes conversion_table
+			# abstract_type_indexes = iFoldSt (determine_abstract_type com_type_defs) 0 (size com_type_defs) []
+			| isEmpty abstract_type_indexes
+				-> convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap
+				# (icl_type_defs, imported_types) = imported_types![cIclModIndex]
+				  type_defs = foldSt (insert_abstract_type conversion_table.[cTypeDefs]) abstract_type_indexes { icl_type_def \\ icl_type_def <-: icl_type_defs }
+				  (imported_types, type_heaps, var_heap)
+				  		= convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions
+							{ imported_types & [cIclModIndex] = type_defs } type_heaps var_heap
+				-> ({ imported_types & [cIclModIndex] = icl_type_defs }, type_heaps, var_heap)
+		No
+			-> convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap
+			  
+
+where
+	determine_abstract_type dcl_type_defs type_index abstract_type_indexes
+		# {td_rhs} = dcl_type_defs.[type_index]
+		= case td_rhs of
+			AbstractType _
+				-> [type_index : abstract_type_indexes]
+			_
+				-> abstract_type_indexes
+					
+	insert_abstract_type conversion_table type_index type_defs
+		# icl_index = conversion_table.[type_index]
+		  (type_def, type_defs) = type_defs![icl_index]
+		= { type_defs & [icl_index] = { type_def & td_rhs = AbstractType cAllBitsClear }}
+
+	convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap
+		# (imported_types, imported_conses, type_heaps, var_heap)
+				= foldSt (convert_imported_function dcl_functions common_defs) imported_functions (imported_types, imported_conses, type_heaps, var_heap)
+		= convert_imported_constructors common_defs imported_conses imported_types type_heaps var_heap
+
+	convert_imported_function dcl_functions common_defs {glob_object,glob_module} (imported_types, imported_conses, type_heaps, var_heap)
+		# {ft_type_ptr,ft_type} = dcl_functions.[glob_module].[glob_object]
+		  (ft_type, imported_types, imported_conses, type_heaps, var_heap)
+				= convertSymbolType common_defs ft_type imported_types imported_conses type_heaps var_heap
+		= (imported_types, imported_conses, type_heaps, var_heap <:= (ft_type_ptr, VI_ExpandedType ft_type))
+
+	convert_imported_constructors common_defs [] imported_types type_heaps var_heap
+		= (imported_types, type_heaps, var_heap)
+	convert_imported_constructors common_defs [ {glob_module, glob_object} : conses ] imported_types type_heaps var_heap 
+		# {com_cons_defs,com_selector_defs} = common_defs.[glob_module]
+		  {cons_type_ptr,cons_type,cons_type_index} = common_defs.[glob_module].com_cons_defs.[glob_object]
+		  (cons_type, imported_types, conses, type_heaps, var_heap) = convertSymbolType common_defs cons_type imported_types conses type_heaps var_heap
+		  var_heap = var_heap <:= (cons_type_ptr, VI_ExpandedType cons_type)
+		  ({td_rhs}, imported_types) = imported_types![glob_module].[cons_type_index]
+		= case td_rhs of
+			RecordType {rt_fields}
+				# (imported_types, conses, type_heaps, var_heap)
+						= iFoldSt (convert_type_of_imported_field glob_module com_selector_defs rt_fields) 0 (size rt_fields)
+							(imported_types, conses, type_heaps, var_heap)
+				-> convert_imported_constructors common_defs conses imported_types type_heaps var_heap
+			_
+				-> convert_imported_constructors common_defs conses imported_types type_heaps var_heap
+		where
+			convert_type_of_imported_field module_index selector_defs fields field_index (imported_types, conses, type_heaps, var_heap)
+				# field_index = fields.[field_index].fs_index
+				  {sd_type_ptr,sd_type} = selector_defs.[field_index]
+				  (sd_type, imported_types, conses, type_heaps, var_heap) = convertSymbolType common_defs sd_type imported_types conses type_heaps var_heap
+				= (imported_types, conses, type_heaps, var_heap <:= (sd_type_ptr, VI_ExpandedType sd_type))
+
+convertRootExpression bound_vars group_index common_defs default_ptr (Let lad=:{let_binds,let_expr,let_info_ptr}) ci=:{ci_expr_heap}
+	# (EI_LetType let_type, ci_expr_heap) = readPtr let_info_ptr ci_expr_heap
+	  bound_vars = addLetVars let_binds let_type bound_vars
+	  (let_binds, ci) = convertCases bound_vars group_index common_defs let_binds { ci & ci_expr_heap = ci_expr_heap }
+	  (let_expr, ci) = convertRootExpression bound_vars group_index common_defs default_ptr let_expr ci
+	= (Let { lad & let_binds = let_binds, let_expr = let_expr }, ci)
+convertRootExpression bound_vars group_index common_defs default_ptr (Case kees=:{case_expr, case_guards, case_default, case_info_ptr}) ci
+	= case case_guards of
+		BasicPatterns BT_Bool patterns
+			-> convert_boolean_case_into_guard bound_vars group_index common_defs default_ptr case_expr patterns case_default case_info_ptr ci
+		_
+			-> convertCasesInCaseExpression bound_vars group_index common_defs default_ptr kees ci
+
+where
+/*
+	convert_boolean_case_into_guard bound_vars  group_index common_defs default_ptr guard [ alt : alts ] case_default case_info_ptr ci
+		# (guard, ci) = convertRootExpression bound_vars group_index common_defs cHasNoDefault guard ci
+		  (then_bool, then_expr, opt_else_expr) = check_reachability alt alts
+		= case opt_else_expr of
+			Yes else_expr
+				# (then_expr, ci) = convertRootExpression bound_vars group_index common_defs cHasNoDefault then_expr ci
+				  (else_expr, ci) = convertRootExpression bound_vars group_index common_defs cHasNoDefault else_expr ci
+				-> (build_conditional then_bool guard then_expr else_expr, ci)
+			No
+				-> case case_default of
+					Yes default_expr
+						# (EI_CaseTypeAndRefCounts case_type ref_counts, ci_expr_heap) = readPtr case_info_ptr ci.ci_expr_heap
+						  (default_ptr, ci_expr_heap) = makePtrToDefault case_default case_type.ct_result_type default_ptr ci_expr_heap
+						  (then_expr, ci) = convertRootExpression bound_vars group_index common_defs default_ptr then_expr { ci & ci_expr_heap = ci_expr_heap }
+						  (default_info, ci_expr_heap) = readPtr default_ptr ci.ci_expr_heap
+						  (else_expr, ci) = convertDefaultToExpression default_ptr default_info bound_vars group_index common_defs
+													{ ci & ci_expr_heap = ci_expr_heap }
+						-> (build_conditional then_bool guard then_expr else_expr, ci)
+					No
+						# (then_expr, ci) = convertRootExpression bound_vars group_index common_defs default_ptr then_expr ci
+						| isNilPtr default_ptr
+							-> (Conditional { if_cond = convert_guard then_bool guard, if_then = then_expr, if_else = No }, ci)
+							# (default_info, ci_expr_heap) = readPtr default_ptr ci.ci_expr_heap
+							  (else_expr, ci) = convertDefaultToExpression default_ptr default_info bound_vars group_index common_defs
+														{ ci & ci_expr_heap = ci_expr_heap }
+							-> (build_conditional then_bool guard then_expr else_expr, ci)
+
+	convert_guard guard_bool guard
+		| guard_bool
+			= guard
+			= Conditional { if_cond = guard, if_then = BasicExpr (BVB False) BT_Bool, if_else = Yes (BasicExpr (BVB True) BT_Bool) }
+
+	build_conditional then_bool guard then_expr else_expr
+		| then_bool
+			= Conditional { if_cond = guard, if_then = then_expr, if_else =  Yes else_expr }
+			= Conditional { if_cond = guard, if_then = else_expr, if_else =  Yes then_expr }
+		
+
+	check_reachability {bp_value=BVB bool,bp_expr} alts
+		= (bool, bp_expr, check_other_alternatives bool alts)
+	where
+		check_other_alternatives then_bool []
+			= No
+		check_other_alternatives then_bool [{bp_value=BVB else_bool,bp_expr} : alts ]
+			| then_bool == else_bool
+				= check_other_alternatives then_bool alts
+				= Yes bp_expr
+*/
+
+//	convert_boolean_case_into_guard bound_vars  group_index common_defs default_ptr guard [ alt : alts ] case_default case_info_ptr ci
+	convert_boolean_case_into_guard bound_vars  group_index common_defs has_default guard [ alt : alts ] case_default case_info_ptr ci
+		# (guard, ci) = convertRootExpression bound_vars group_index common_defs cHasNoDefault guard ci
+		# (sign_of_then_part, then_part, ci) = convert_boolean_guard bound_vars group_index common_defs alt ci
+		  (opt_else_part, ci) = convert_to_else_part bound_vars group_index common_defs has_default sign_of_then_part alts case_default ci
+//		= (Conditional { if_cond = { con_positive = sign_of_then_part, con_expression = guard }, if_then = then_part, if_else = opt_else_part }, ci)
+		= (build_conditional sign_of_then_part guard then_part opt_else_part, ci)
+	where
+		build_conditional True guard then_expr opt_else_expr
+			= Conditional { if_cond = guard, if_then = then_expr, if_else = opt_else_expr }
+		build_conditional false guard then_expr (Yes else_expr)
+			= Conditional { if_cond = guard, if_then = else_expr, if_else = Yes then_expr }
+		build_conditional false guard then_expr No
+			= Conditional { if_cond = Conditional { if_cond = guard, if_then = BasicExpr (BVB False) BT_Bool, if_else = Yes (BasicExpr (BVB True) BT_Bool) },
+							if_then = then_expr, if_else = No }
+
+	convert_to_else_part bound_vars group_index common_defs has_default sign_of_then_part [ alt : alts ] case_default ci
+		# (sign_of_else_part, else_part, ci) = convert_boolean_guard bound_vars group_index common_defs alt ci
+		| sign_of_then_part == sign_of_else_part
+			= convert_to_else_part bound_vars group_index common_defs has_default sign_of_then_part alts case_default ci
+			= (Yes else_part, ci)
+	convert_to_else_part bound_vars group_index common_defs has_default sign_of_then_part [ ] (Yes else_part) ci
+		# (else_part, ci) = convertRootExpression bound_vars group_index common_defs has_default else_part ci
+		= (Yes else_part, ci)
+	convert_to_else_part bound_vars group_index common_defs has_default sign_of_then_part [ ] No ci
+		= (No, ci)
+
+	convert_boolean_guard bound_vars group_index common_defs {bp_value=BVB bool,bp_expr} ci
+		# (bp_expr, ci) = convertRootExpression bound_vars group_index common_defs cHasNoDefault bp_expr ci
+		= (bool, bp_expr, ci)
+
+
+convertRootExpression bound_vars group_index common_defs _ expr ci
+	= convertCases bound_vars group_index common_defs expr ci
+
+
+::	CopyInfo =
+	{	cp_free_vars	:: ![(VarInfoPtr,AType)]
+	,	cp_var_heap		:: !.VarHeap
+	}
+	
+
+class copy e :: !e !*CopyInfo -> (!e, !*CopyInfo)
+
+instance copy BoundVar
+where
+	copy var=:{var_name,var_info_ptr} cp_info=:{cp_free_vars, cp_var_heap}
+		#! var_info = sreadPtr var_info_ptr cp_var_heap
+		= case var_info of
+			VI_FreeVar name new_info_ptr count type
+				-> ({ var & var_info_ptr = new_info_ptr }, { cp_free_vars = cp_free_vars,
+							cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar name new_info_ptr (inc count) type)})
+			VI_LocalVar
+				-> (var, {cp_free_vars = cp_free_vars, cp_var_heap = cp_var_heap})
+			VI_BoundVar type
+				# (new_info_ptr, cp_var_heap) = newPtr VI_Empty cp_var_heap
+				-> ({ var & var_info_ptr = new_info_ptr }, { cp_free_vars = [ (var_info_ptr, type) : cp_free_vars ],
+							cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar var_name new_info_ptr 1 type) })
+			_
+				-> abort "copy [BoundVar] (convertcases, 612)" <<- (var_info ---> (var_name, ptrToInt var_info_ptr))
+
+instance copy Expression
+where
+	copy (Var var) cp_info
+		# (var, cp_info) = copy var cp_info
+		= (Var var, cp_info)
+	copy (App app=:{app_args}) cp_info
+		# (app_args, cp_info) = copy app_args cp_info
+		= (App {app & app_args = app_args}, cp_info)
+	copy (fun_expr @ exprs) cp_info
+		# ((fun_expr, exprs), cp_info) = copy (fun_expr, exprs) cp_info
+		= (fun_expr @ exprs, cp_info)
+	copy (Let lad=:{let_binds,let_expr}) cp_info=:{cp_var_heap}
+		# ((let_binds,let_expr), cp_info) = copy (let_binds,let_expr)
+			{ cp_info & cp_var_heap = foldSt (\{bind_dst={fv_info_ptr}} -> writePtr fv_info_ptr VI_LocalVar) let_binds cp_var_heap }
+		= (Let {lad & let_expr = let_expr, let_binds = let_binds }, cp_info)
+	copy (Case case_expr) cp_info
+		# (case_expr, cp_info) = copy case_expr cp_info
+		= (Case case_expr, cp_info)
+	copy expr=:(BasicExpr _ _) cp_info
+		= (expr, cp_info)
+	copy (MatchExpr opt_tuple constructor expr) cp_info
+		# (expr, cp_info) = copy expr cp_info
+		= (MatchExpr opt_tuple constructor expr, cp_info)
+	copy (Selection is_unique expr selectors) cp_info
+		# (expr, cp_info) = copy expr cp_info
+		  (selectors, cp_info) = copy selectors cp_info
+		= (Selection is_unique expr selectors, cp_info)
+	copy (Update expr1 selectors expr2) cp_info
+		# (expr1, cp_info) = copy expr1 cp_info
+		  (selectors, cp_info) = copy selectors cp_info
+		  (expr2, cp_info) = copy expr2 cp_info
+		= (Update expr1 selectors expr2, cp_info)
+	copy (RecordUpdate cons_symbol expression expressions) cp_info
+		# (expression, cp_info) = copy expression cp_info
+		  (expressions, cp_info) = copy expressions cp_info
+		= (RecordUpdate cons_symbol expression expressions, cp_info)
+	copy (TupleSelect tuple_symbol arg_nr expr) cp_info
+		# (expr, cp_info) = copy expr cp_info
+		= (TupleSelect tuple_symbol arg_nr expr, cp_info)
+	copy (DynamicExpr dynamik) cp_info
+		# (dynamik, cp_info) = copy dynamik cp_info
+		= (DynamicExpr dynamik, cp_info)
+	copy EE cp_info
+		= (EE, cp_info)
+	copy expr cp_info
+		= abort ("copy (Expression) does not match" ---> expr)
+
+instance copy Optional a | copy a
+where
+	copy (Yes expr) cp_info
+		# (expr, cp_info) = copy expr cp_info
+		= (Yes expr, cp_info)
+	copy No cp_info
+		= (No, cp_info)
+
+instance copy Selection  
+where
+	copy (DictionarySelection record selectors expr_ptr index_expr) cp_info
+		# (index_expr, cp_info) = copy index_expr cp_info
+		  (selectors, cp_info) = copy selectors cp_info
+		= (DictionarySelection record selectors expr_ptr index_expr, cp_info)
+	copy (ArraySelection selector expr_ptr index_expr) cp_info
+		# (index_expr, cp_info) = copy index_expr cp_info
+		= (ArraySelection selector expr_ptr index_expr, cp_info)
+	copy selector cp_info
+		= (selector, cp_info)
+
+
+instance copy DynamicExpr
+where
+	copy dynamik=:{dyn_expr,dyn_uni_vars,dyn_type_code} cp_info=:{cp_var_heap}
+		# ((dyn_expr, dyn_type_code), cp_info) = copy (dyn_expr,dyn_type_code)
+				{ cp_info & cp_var_heap = foldSt (\info_ptr -> writePtr info_ptr VI_LocalVar) dyn_uni_vars cp_var_heap }
+		= ({ dynamik & dyn_expr = dyn_expr, dyn_type_code = dyn_type_code }, cp_info)
+
+instance copy TypeCodeExpression
+where
+	copy (TCE_Var var_info_ptr) cp_info=:{cp_free_vars, cp_var_heap}
+		# (new_info_ptr, cp_info) = copyVarInfo var_info_ptr cp_info
+		= (TCE_Var new_info_ptr, cp_info)
+	copy (TCE_Constructor index type_codes) cp_info
+		# (type_codes, cp_info) = copy type_codes cp_info
+		= (TCE_Constructor index type_codes, cp_info)
+	copy (TCE_Selector selections var_info_ptr) cp_info
+		# (new_info_ptr, cp_info) = copyVarInfo var_info_ptr cp_info
+		= (TCE_Selector selections new_info_ptr, cp_info)
+
+copyVarInfo var_info_ptr cp_info=:{cp_free_vars, cp_var_heap}
+	#! var_info = sreadPtr var_info_ptr cp_var_heap
+	= case var_info of
+		VI_FreeVar name new_info_ptr count type
+			-> (new_info_ptr, { cp_free_vars = cp_free_vars, cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar name new_info_ptr (inc count) type)})
+		VI_LocalVar
+			-> (var_info_ptr, {cp_free_vars = cp_free_vars, cp_var_heap = cp_var_heap})
+		VI_BoundVar type
+			# (new_info_ptr, cp_var_heap) = newPtr VI_Empty cp_var_heap
+			-> (new_info_ptr, { cp_free_vars = [ (var_info_ptr, type) : cp_free_vars ],
+						cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar { id_name = "_t", id_info = nilPtr } new_info_ptr 1 type) })
+instance copy Case
+where
+	copy this_case=:{case_expr, case_guards, case_default} cp_info
+		# ((case_expr,(case_guards,case_default)), cp_info) = copy (case_expr,(case_guards,case_default)) cp_info
+		= ({ this_case & case_expr = case_expr, case_guards = case_guards, case_default = case_default}, cp_info) 
+
+instance copy CasePatterns
+where
+	copy (AlgebraicPatterns type patterns) cp_info
+		# (patterns, cp_info) = copy patterns cp_info
+		= (AlgebraicPatterns type patterns, cp_info) 
+	copy (BasicPatterns type patterns) cp_info
+		# (patterns, cp_info) = copy patterns cp_info
+		= (BasicPatterns type patterns, cp_info) 
+	copy (DynamicPatterns patterns) cp_info
+		# (patterns, cp_info) = copy patterns cp_info
+		= (DynamicPatterns patterns, cp_info) 
+
+instance copy AlgebraicPattern
+where
+	copy pattern=:{ap_vars,ap_expr} cp_info=:{cp_var_heap}
+		# (ap_expr, cp_info) = copy ap_expr { cp_info & cp_var_heap = foldSt (\{fv_info_ptr} -> writePtr fv_info_ptr VI_LocalVar) ap_vars cp_var_heap}
+		= ({ pattern & ap_expr = ap_expr }, cp_info) 
+
+instance copy BasicPattern
+where
+	copy pattern=:{bp_expr} cp_info
+		# (bp_expr, cp_info) = copy bp_expr cp_info
+		= ({ pattern & bp_expr = bp_expr }, cp_info) 
+
+instance copy DynamicPattern
+where
+	copy pattern=:{dp_var={fv_info_ptr},dp_rhs,dp_type_patterns_vars, dp_type_code} cp_info=:{cp_var_heap}
+		# (dp_rhs, cp_info) = copy dp_rhs
+				{ cp_info & cp_var_heap = foldSt (\info_ptr -> writePtr info_ptr VI_LocalVar) dp_type_patterns_vars cp_var_heap
+				 			<:= (fv_info_ptr, VI_LocalVar) }
+		  (dp_type_code, cp_info) = copy dp_type_code cp_info
+		= ({ pattern & dp_rhs = dp_rhs, dp_type_code = dp_type_code }, cp_info) 
+
+instance copy [a] | copy a
+where
+	copy l cp_info = mapSt copy l cp_info 
+		
+instance copy (a,b) | copy a & copy b
+where
+	copy t cp_info = app2St (copy, copy) t cp_info 
+
+instance copy (Bind a b) | copy a
+where
+	copy bind=:{bind_src} cp_info
+		# (bind_src, cp_info) = copy bind_src cp_info
+		= ({ bind & bind_src = bind_src }, cp_info) 
+
+/*
+
+	weightedRefCount determines the references counts of variables in an expression. Runtime behaviour of constructs into account: 
+	multiple occurrences of variables in different alternatives of the same case clause are counted only once. The outcome
+	is used to distribute shared expressions (via let declarations) over cases. In this way code sharing is eliminated.
+	As a side effect, weightedRefCount returns a list of all imported function that have been used iinside the expression.
+	
+*/
+
+::	RCInfo =
+	{	rc_free_vars	:: ![VarInfoPtr]
+	,	rc_imports		:: ![SymbKind]
+	,	rc_var_heap		:: !.VarHeap
+	,	rc_expr_heap	:: !.ExpressionHeap
+	}
+	
+
+weightedRefCountOfVariable depth var_info_ptr lvi=:{lvi_count,lvi_var,lvi_depth,lvi_previous,lvi_new} ref_count new_vars
+	| lvi_depth < depth 
+		= (True, {lvi & lvi_count = ref_count, lvi_depth = depth, lvi_new = True, lvi_previous =
+				[{plvi_count = lvi_count, plvi_depth = lvi_depth, plvi_new = lvi_new } : lvi_previous]}, [var_info_ptr : new_vars])
+//					==> (lvi_var, " PUSHED ",lvi_depth)
+	| lvi_count == 0
+		= (True, { lvi & lvi_count = ref_count }, [var_info_ptr : new_vars])
+		= (lvi_new, { lvi & lvi_count = lvi_count + ref_count }, new_vars)
+
+class weightedRefCount e :: !{# {# FunType} } !{# CommonDefs} !Int !e !*RCInfo -> *RCInfo
+
+instance weightedRefCount BoundVar
+where
+	weightedRefCount dcl_functions common_defs depth {var_name,var_info_ptr} rc_info=:{rc_var_heap,rc_free_vars}
+		#! var_info = sreadPtr var_info_ptr rc_var_heap
+		= case var_info of
+			VI_LetVar lvi
+				# (is_new, lvi=:{lvi_expression}, rc_free_vars) = weightedRefCountOfVariable depth var_info_ptr lvi 1 rc_free_vars
+				| is_new
+					# rc_info = weightedRefCount dcl_functions common_defs depth lvi_expression
+							{ rc_info & rc_free_vars = rc_free_vars,
+							  rc_var_heap = rc_info.rc_var_heap  <:= (var_info_ptr, VI_LetVar {lvi & lvi_expression = EE, lvi_new = False})}
+					  (VI_LetVar lvi, rc_var_heap) = readPtr var_info_ptr rc_info.rc_var_heap
+					-> { rc_info & rc_var_heap = rc_var_heap <:= (var_info_ptr, VI_LetVar { lvi & lvi_expression = lvi_expression }) }
+//							 ==> (var_name, var_info_ptr, depth, lvi.lvi_count)
+					-> { rc_info & rc_var_heap = rc_info.rc_var_heap <:= (var_info_ptr, VI_LetVar lvi) }
+			_
+				-> rc_info
+				
+instance weightedRefCount Expression
+where
+	weightedRefCount dcl_functions common_defs depth (Var var) rc_info
+		= weightedRefCount dcl_functions common_defs depth var rc_info
+	weightedRefCount dcl_functions common_defs depth (App app) rc_info
+		= weightedRefCount dcl_functions common_defs depth app rc_info
+	weightedRefCount dcl_functions common_defs depth (fun_expr @ exprs) rc_info
+		= weightedRefCount dcl_functions common_defs depth (fun_expr, exprs) rc_info
+	weightedRefCount dcl_functions common_defs depth (Let {let_binds,let_expr, let_info_ptr}) rc_info=:{rc_var_heap}
+		# rc_info = weightedRefCount dcl_functions common_defs depth let_expr { rc_info & rc_var_heap = foldSt store_binding let_binds rc_var_heap }
+		  (let_info, rc_expr_heap) = readPtr let_info_ptr rc_info.rc_expr_heap
+		  rc_info = { rc_info & rc_expr_heap = rc_expr_heap }
+		= case let_info of
+			EI_LetType let_type
+		  		# (ref_counts, rc_var_heap) = mapSt get_ref_count let_binds rc_info.rc_var_heap
+				  (rc_free_vars, rc_var_heap) = foldl remove_variable (rc_info.rc_free_vars, rc_var_heap) let_binds
+				-> { rc_info & rc_free_vars = rc_free_vars, rc_var_heap = rc_var_heap,
+						rc_expr_heap = rc_info.rc_expr_heap <:= (let_info_ptr, EI_LetTypeAndRefCounts let_type ref_counts)}
+							 ==> ("weightedRefCount (EI_LetType)", ref_counts, rc_info.rc_free_vars, rc_free_vars, depth)
+			_
+				# (rc_free_vars, rc_var_heap) = foldl remove_variable (rc_info.rc_free_vars, rc_info.rc_var_heap) let_binds
+				-> { rc_info & rc_free_vars = rc_free_vars, rc_var_heap = rc_var_heap }
+//						==> ("weightedRefCount (Let)" <<- let_info)
+	where
+		remove_variable ([], var_heap) let_bind
+			= ([], var_heap)
+		remove_variable ([var_ptr : var_ptrs], var_heap) bind=:{bind_dst={fv_name,fv_info_ptr}}
+			| fv_info_ptr == var_ptr
+				# (VI_LetVar {lvi_count,lvi_depth}, var_heap) = readPtr fv_info_ptr var_heap
+				= (var_ptrs, var_heap) 
+//						==> ("remove_variable (lvi_count,lvi_dpeth) ", fv_name, lvi_count, lvi_depth)
+				# (var_ptrs, var_heap) = remove_variable (var_ptrs, var_heap) bind
+				= ([var_ptr : var_ptrs], var_heap)
+
+		store_binding {bind_dst={fv_name,fv_info_ptr},bind_src} var_heap
+			= var_heap <:= (fv_info_ptr, VI_LetVar {lvi_count = 0, lvi_depth = depth, lvi_previous = [],
+													lvi_new = True, lvi_expression = bind_src, lvi_var = fv_name})
+
+		get_ref_count {bind_dst={fv_name,fv_info_ptr}} var_heap 
+			# (VI_LetVar {lvi_count}, var_heap) = readPtr fv_info_ptr var_heap
+		  	= (lvi_count, var_heap)
+//				==> (fv_name,fv_info_ptr,lvi_count)
+	weightedRefCount dcl_functions common_defs depth (Case case_expr) rc_info=:{rc_expr_heap}
+		# (case_info, rc_expr_heap) = readPtr case_expr.case_info_ptr rc_expr_heap
+		= weightedRefCountOfCase dcl_functions common_defs depth case_expr case_info { rc_info & rc_expr_heap = rc_expr_heap }
+	weightedRefCount dcl_functions common_defs depth expr=:(BasicExpr _ _) rc_info
+		= rc_info
+	weightedRefCount dcl_functions common_defs depth (MatchExpr _ constructor expr) rc_info
+		= weightedRefCount dcl_functions common_defs depth expr rc_info
+	weightedRefCount dcl_functions common_defs depth (Selection opt_tuple expr selections) rc_info
+		= weightedRefCount dcl_functions common_defs depth (expr, selections) rc_info
+	weightedRefCount dcl_functions common_defs depth (Update expr1 selections expr2) rc_info
+		= weightedRefCount dcl_functions common_defs depth (expr1, (selections, expr2)) rc_info
+	weightedRefCount dcl_functions common_defs depth (RecordUpdate cons_symbol expression expressions) rc_info
+		= weightedRefCount dcl_functions common_defs depth (expression, expressions) rc_info
+	weightedRefCount dcl_functions common_defs depth (TupleSelect tuple_symbol arg_nr expr) rc_info
+		= weightedRefCount dcl_functions common_defs depth expr rc_info
+	weightedRefCount dcl_functions common_defs depth (DynamicExpr {dyn_expr}) rc_info
+		= weightedRefCount dcl_functions common_defs depth dyn_expr rc_info
+	weightedRefCount dcl_functions common_defs depth (AnyCodeExpr _ _ _) rc_info
+		= rc_info
+	weightedRefCount dcl_functions common_defs depth (ABCCodeExpr _ _) rc_info
+		= rc_info
+	weightedRefCount dcl_functions common_defs depth (TypeCodeExpression type_code_expr) rc_info
+		= weightedRefCount dcl_functions common_defs depth type_code_expr rc_info
+	weightedRefCount dcl_functions common_defs depth EE rc_info
+		= rc_info
+	weightedRefCount dcl_functions common_defs depth expr rc_info
+		= abort ("weightedRefCount [Expression] (convertcases, 864))" ---> expr)
+
+addPatternVariable depth {cv_variable = var_info_ptr, cv_count = ref_count} (free_vars, var_heap)
+ 	#! var_info = sreadPtr var_info_ptr var_heap
+	= case var_info of
+		VI_LetVar lvi
+			# (_, lvi, free_vars) = weightedRefCountOfVariable depth var_info_ptr lvi ref_count free_vars
+			-> (free_vars, var_heap <:= (var_info_ptr, VI_LetVar lvi))
+		_
+			-> (free_vars, var_heap)
+
+weightedRefCountOfCase dcl_functions common_defs depth this_case=:{case_expr, case_guards, case_default, case_info_ptr} (EI_CaseType case_type)
+			rc_info=:{ rc_var_heap, rc_expr_heap, rc_imports }
+	# (local_vars, vars_and_heaps) = weighted_ref_count_in_case_patterns dcl_functions common_defs (inc depth) case_guards rc_imports rc_var_heap rc_expr_heap
+	  (default_vars, (all_vars, rc_imports, var_heap, expr_heap)) = weighted_ref_count_in_default dcl_functions common_defs (inc depth) case_default vars_and_heaps
+	  rc_info = weightedRefCount dcl_functions common_defs depth case_expr { rc_info & rc_var_heap = var_heap, rc_expr_heap = expr_heap, rc_imports = rc_imports }
+	  (rc_free_vars, rc_var_heap) = foldSt (addPatternVariable depth) all_vars (rc_info.rc_free_vars, rc_info.rc_var_heap)
+//	  (EI_CaseType case_type, rc_expr_heap) = readPtr case_info_ptr rc_info.rc_expr_heap
+	  rc_expr_heap = rc_info.rc_expr_heap <:= (case_info_ptr, EI_CaseTypeAndRefCounts case_type 
+	  		{ rcc_all_variables = all_vars, rcc_default_variables = default_vars, rcc_pattern_variables = local_vars })
+	= { rc_info & rc_var_heap = rc_var_heap, rc_expr_heap = rc_expr_heap, rc_free_vars = rc_free_vars   }
+//			==> (rc_free_vars, all_vars, default_vars, local_vars)
+	where
+		weighted_ref_count_in_default dcl_functions common_defs depth (Yes expr) info
+			= weightedRefCountInPatternExpr dcl_functions common_defs depth expr info
+		weighted_ref_count_in_default dcl_functions common_defs depth No info
+			= ([], info)
+						
+		weighted_ref_count_in_case_patterns dcl_functions common_defs depth (AlgebraicPatterns type patterns) collected_imports var_heap expr_heap
+			= mapSt (weighted_ref_count_in_algebraic_pattern dcl_functions common_defs depth) patterns ([], collected_imports, var_heap, expr_heap)
+		where
+			weighted_ref_count_in_algebraic_pattern dcl_functions common_defs depth {ap_expr,ap_symbol={glob_module, glob_object={ds_index}}} wrc_state
+				# (free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
+						= weightedRefCountInPatternExpr dcl_functions common_defs depth ap_expr wrc_state
+				| glob_module <> cIclModIndex
+					# {cons_type_ptr} = common_defs.[glob_module].com_cons_defs.[ds_index]
+					  (collected_imports, var_heap) = checkImportedSymbol (SK_Constructor {glob_module = glob_module, glob_object = ds_index})
+							cons_type_ptr (collected_imports, var_heap)
+					= (free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
+					= (free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
+
+		weighted_ref_count_in_case_patterns dcl_functions common_defs depth (BasicPatterns type patterns) collected_imports var_heap expr_heap
+			= mapSt (\{bp_expr} -> weightedRefCountInPatternExpr dcl_functions common_defs depth bp_expr) patterns ([], collected_imports, var_heap, expr_heap)
+		weighted_ref_count_in_case_patterns dcl_functions common_defs depth (DynamicPatterns patterns) collected_imports var_heap expr_heap
+			= mapSt (\{dp_rhs} -> weightedRefCountInPatternExpr dcl_functions common_defs depth dp_rhs) patterns ([], collected_imports, var_heap, expr_heap)
+
+weightedRefCountOfCase dcl_functions common_defs depth this_case=:{case_expr, case_guards, case_default, case_info_ptr} (EI_CaseTypeAndRefCounts case_type {rcc_all_variables})
+			rc_info=:{ rc_var_heap, rc_expr_heap, rc_imports }
+	# rc_info = weightedRefCount dcl_functions common_defs depth case_expr rc_info
+	  (rc_free_vars, rc_var_heap) = foldSt (addPatternVariable depth) rcc_all_variables (rc_info.rc_free_vars, rc_info.rc_var_heap)
+	= { rc_info & rc_var_heap = rc_var_heap, rc_free_vars = rc_free_vars }	
+
+checkRecordSelector common_defs {glob_module, glob_object={ds_index}} rc_info=:{rc_imports,rc_var_heap}
+	| glob_module <> cIclModIndex
+		# {com_selector_defs,com_cons_defs,com_type_defs} = common_defs.[glob_module]
+		  {sd_type_index} = com_selector_defs.[ds_index]
+		  {td_rhs = RecordType {rt_constructor={ds_index=cons_index}, rt_fields}} = com_type_defs.[sd_type_index]
+		  {cons_type_ptr} = com_cons_defs.[cons_index]
+		  (rc_imports, rc_var_heap) = checkImportedSymbol (SK_Constructor {glob_module = glob_module, glob_object = cons_index})
+											cons_type_ptr (rc_imports, rc_var_heap)
+		= { rc_info & rc_imports = rc_imports, rc_var_heap = rc_var_heap }
+		= rc_info
+	
+instance weightedRefCount Selection
+where
+	weightedRefCount dcl_functions common_defs depth (ArraySelection {glob_module,glob_object={ds_index}} _ index_expr) rc_info
+		# rc_info = weightedRefCount dcl_functions common_defs depth index_expr rc_info
+		= checkImportOfDclFunction dcl_functions common_defs glob_module ds_index rc_info
+	weightedRefCount dcl_functions common_defs depth (DictionarySelection _ selectors _ index_expr) rc_info
+		# rc_info = weightedRefCount dcl_functions common_defs depth index_expr rc_info
+		= weightedRefCount dcl_functions common_defs depth selectors rc_info
+	weightedRefCount dcl_functions common_defs depth (RecordSelection selector _) rc_info
+		= checkRecordSelector common_defs selector rc_info
+
+weightedRefCountInPatternExpr dcl_functions common_defs depth pattern_expr (previous_free_vars, collected_imports, var_heap, expr_heap)
+	# {rc_free_vars,rc_var_heap,rc_imports,rc_expr_heap} = weightedRefCount dcl_functions common_defs depth pattern_expr
+				{ rc_var_heap = var_heap, rc_expr_heap = expr_heap, rc_free_vars = [], rc_imports = collected_imports}
+	  (free_vars_with_rc, rc_var_heap) = mapSt get_ref_count rc_free_vars rc_var_heap
+	  (previous_free_vars, rc_var_heap) = foldSt (select_unused_free_variable depth) previous_free_vars ([], rc_var_heap)
+	  (all_free_vars, rc_var_heap) = foldSt (collect_free_variable depth) rc_free_vars (previous_free_vars, rc_var_heap)
+//			==> ("remove_vars ", depth, free_vars_with_rc)
+	= (free_vars_with_rc, (all_free_vars, rc_imports, rc_var_heap, rc_expr_heap))
+where
+	select_unused_free_variable depth var=:{cv_variable = var_ptr, cv_count = var_count} (collected_vars, var_heap)
+		# (VI_LetVar info=:{lvi_count,lvi_depth}, var_heap) = readPtr var_ptr var_heap
+		| lvi_depth == depth && lvi_count > 0
+			= (collected_vars, var_heap <:= (var_ptr, VI_LetVar {info & lvi_count = max lvi_count var_count}))
+			= ([ var : collected_vars], var_heap) 
+	
+	get_ref_count var_ptr var_heap
+		# (VI_LetVar {lvi_count}, var_heap) = readPtr var_ptr var_heap
+		= ({cv_variable = var_ptr, cv_count = lvi_count}, var_heap)
+
+	collect_free_variable depth var_ptr (collected_vars, var_heap)
+		# (VI_LetVar lvi=:{lvi_count,lvi_depth,lvi_previous}, var_heap) = readPtr var_ptr var_heap
+		| depth == lvi_depth
+			= case lvi_previous of
+				[{plvi_depth, plvi_count, plvi_new} : lvi_previous ]
+					-> ([ {cv_variable = var_ptr, cv_count = lvi_count} : collected_vars ],
+						(var_heap <:= (var_ptr, VI_LetVar {lvi & lvi_count = plvi_count, lvi_depth = plvi_depth,
+																 lvi_new = plvi_new, lvi_previous = lvi_previous})))
+				[]
+					-> (collected_vars, var_heap)
+			= ([ {cv_variable = var_ptr, cv_count = lvi_count} : collected_vars ], var_heap)
+		
+
+/*
+	Here we examine the appplication to see whether an imported function has been used. If so, the 'ft_type_ptr' is examined. Initially
+	this pointer contains VI_Empty. After the first occurrence the pointer will be set to 'VI_Used'.
+
+*/
+
+checkImportOfDclFunction dcl_functions common_defs mod_index fun_index rc_info=:{rc_imports, rc_var_heap}
+	| mod_index <> cIclModIndex
+		# {ft_type_ptr} = dcl_functions.[mod_index].[fun_index]
+		  (rc_imports, rc_var_heap) = checkImportedSymbol (SK_Function {glob_module=mod_index,glob_object=fun_index}) ft_type_ptr (rc_imports, rc_var_heap)
+		= { rc_info & rc_imports = rc_imports, rc_var_heap = rc_var_heap }
+		= rc_info
+
+instance weightedRefCount App
+where
+	weightedRefCount dcl_functions common_defs depth {app_symb,app_args} rc_info
+		# rc_info = weightedRefCount dcl_functions common_defs depth app_args rc_info
+		= check_import dcl_functions common_defs app_symb.symb_kind rc_info
+	where
+		check_import dcl_functions common_defs symb_kind=:(SK_Function {glob_module,glob_object}) rc_info=:{rc_imports, rc_var_heap}
+			= checkImportOfDclFunction dcl_functions common_defs glob_module glob_object rc_info
+		check_import dcl_functions common_defs symb_kind=:(SK_Constructor {glob_module,glob_object}) rc_info=:{rc_imports, rc_var_heap}
+			| glob_module <> cIclModIndex
+				# {cons_type_ptr} = common_defs.[glob_module].com_cons_defs.[glob_object]
+				  (rc_imports, rc_var_heap) = checkImportedSymbol symb_kind cons_type_ptr (rc_imports, rc_var_heap)
+				= { rc_info & rc_imports = rc_imports, rc_var_heap = rc_var_heap }
+				= rc_info
+		check_import dcl_functions common_defs symb_kind rc_info
+			= rc_info
+
+
+instance weightedRefCount TypeCodeExpression
+where
+	weightedRefCount dcl_functions common_defs depth type_code_expr rc_info
+		= rc_info
+
+instance weightedRefCount [a] | weightedRefCount a
+where
+	weightedRefCount dcl_functions common_defs depth l rc_info = foldr (weightedRefCount dcl_functions common_defs depth) rc_info l 
+		
+instance weightedRefCount (a,b) | weightedRefCount a & weightedRefCount b
+where
+	weightedRefCount dcl_functions common_defs depth (x,y) rc_info = weightedRefCount dcl_functions common_defs depth y (weightedRefCount dcl_functions common_defs depth x rc_info) 
+
+instance weightedRefCount (Bind a b) | weightedRefCount a
+where
+	weightedRefCount dcl_functions common_defs depth bind=:{bind_src} rc_info
+		= weightedRefCount dcl_functions common_defs depth bind_src rc_info
+
+checkImportedSymbol symb_kind symb_type_ptr (collected_imports, var_heap)
+	#! type_info = sreadPtr symb_type_ptr var_heap
+	= case type_info of
+		VI_Used
+			-> (collected_imports, var_heap)
+		_
+			-> ([symb_kind : collected_imports ], var_heap <:= (symb_type_ptr, VI_Used))
+
+::	DistributeInfo =
+	{	di_lets			:: ![VarInfoPtr]
+	,	di_var_heap		:: !.VarHeap
+	,	di_expr_heap	:: !.ExpressionHeap
+	}
+/*
+	distributeLets tries to move shared expressions as close as possible to the location at ewhich they are used.
+	Case-expression may require unsharing if the shared expression is used in different alternatives. Of course
+	only if the expreesion is not used in the pattern nor in a surrounding expression.
+*/
+
+class distributeLets e :: !Int !e !*DistributeInfo -> (!e, !*DistributeInfo)
+
+
+instance distributeLets Expression
+where
+	distributeLets depth (Var var=:{var_name,var_info_ptr}) dl_info=:{di_var_heap}
+		#! var_info = sreadPtr var_info_ptr di_var_heap
+		= case var_info of
+			VI_LetExpression lei
+				| lei.lei_count == 1
+//						 ==> (var_name, var_info_ptr, lei.lei_count, (lei.lei_expression, lei.lei_depth, depth))
+					# (lei_updated_expr, dl_info) = distributeLets depth lei.lei_expression dl_info
+					| lei.lei_strict
+						-> (Var { var & var_info_ptr = lei.lei_var.fv_info_ptr }, { dl_info & di_lets = [ var_info_ptr : dl_info.di_lets ],
+									di_var_heap = dl_info.di_var_heap <:= (var_info_ptr, VI_LetExpression
+										{ lei & lei_status = LES_Updated lei_updated_expr }) })
+						-> (lei_updated_expr, { dl_info &  di_var_heap = dl_info.di_var_heap <:=
+								(var_info_ptr, VI_LetExpression { lei & lei_status = LES_Updated lei_updated_expr }) })
+				| lei.lei_depth == depth
+					# dl_info = distributeLetsInLetExpression depth var_info_ptr lei dl_info
+					-> (Var { var & var_info_ptr = lei.lei_var.fv_info_ptr }, dl_info)
+					-> (Var { var & var_info_ptr = lei.lei_var.fv_info_ptr }, dl_info)
+			VI_CaseVar var_info_ptr
+				-> (Var { var & var_info_ptr = var_info_ptr }, dl_info)
+			_
+				-> (Var var, dl_info)
+	distributeLets depth (Case kees) dl_info
+		# (kees, dl_info) = distributeLets depth kees dl_info
+		= (Case kees, dl_info)
+	distributeLets depth (App app=:{app_args}) dl_info
+		# (app_args, dl_info) = distributeLets depth app_args dl_info
+		= (App {app & app_args = app_args}, dl_info)
+	distributeLets depth (fun_expr @ exprs) dl_info
+		# (fun_expr, dl_info) = distributeLets depth fun_expr dl_info
+		  (exprs, dl_info) = distributeLets depth exprs dl_info
+		= (fun_expr @ exprs, dl_info)
+	distributeLets depth expr=:(BasicExpr _ _) dl_info
+		= (expr, dl_info)
+	distributeLets depth (MatchExpr opt_tuple constructor expr) dl_info
+		# (expr, dl_info) = distributeLets depth expr dl_info
+		= (MatchExpr opt_tuple constructor expr, dl_info)
+	distributeLets depth (Selection opt_tuple expr selectors) dl_info
+		# (expr, dl_info) = distributeLets depth expr dl_info
+		# (selectors, dl_info) = distributeLets depth selectors dl_info
+		= (Selection opt_tuple expr selectors, dl_info)
+	distributeLets depth (Update expr1 selectors expr2) dl_info
+		# (expr1, dl_info) = distributeLets depth expr1 dl_info
+		# (selectors, dl_info) = distributeLets depth selectors dl_info
+		# (expr2, dl_info) = distributeLets depth expr2 dl_info
+		= (Update expr1 selectors expr2, dl_info)
+	distributeLets depth (RecordUpdate cons_symbol expression expressions) dl_info
+		# (expression, dl_info) = distributeLets depth expression dl_info
+		# (expressions, dl_info) = distributeLets depth expressions dl_info
+		= (RecordUpdate cons_symbol expression expressions, dl_info)
+	distributeLets depth (TupleSelect tuple_symbol arg_nr expr) dl_info
+		# (expr, dl_info) = distributeLets depth expr dl_info
+		= (TupleSelect tuple_symbol arg_nr expr, dl_info)
+	distributeLets depth (Let lad=:{let_binds,let_expr,let_strict,let_info_ptr}) dl_info=:{di_expr_heap,di_var_heap}
+		# (EI_LetTypeAndRefCounts let_type ref_counts, di_expr_heap) = readPtr let_info_ptr di_expr_heap
+		  di_var_heap = set_let_expression_info depth let_strict let_binds ref_counts let_type di_var_heap
+		  (let_expr, dl_info) = distributeLets depth let_expr { dl_info & di_var_heap = di_var_heap, di_expr_heap = di_expr_heap }
+        = (let_expr, foldSt (distribute_lets_in_non_distributed_let depth) let_binds dl_info)
+	where
+		set_let_expression_info depth let_strict [{bind_src,bind_dst}:binds][ref_count:ref_counts][type:types] var_heap
+			# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+			  lei = { lei_count = ref_count, lei_depth = depth, lei_strict = let_strict, /* lei_moved = False, */
+					  lei_var = { bind_dst & fv_info_ptr = new_info_ptr }, lei_expression = bind_src, lei_type = type, lei_status = LES_Untouched }
+			= set_let_expression_info depth let_strict binds ref_counts types (var_heap <:= (bind_dst.fv_info_ptr, VI_LetExpression lei))
+		set_let_expression_info depth let_strict [] _ _ var_heap
+			= var_heap
+		
+		distribute_lets_in_non_distributed_let depth {bind_dst={fv_name,fv_info_ptr}} dl_info=:{di_var_heap}
+			# (VI_LetExpression lei=:{lei_depth,lei_count,lei_status}, di_var_heap) = readPtr fv_info_ptr di_var_heap
+			| lei_count > 0
+//			| not lei_moved && lei_count > 0
+				= distributeLetsInLetExpression depth fv_info_ptr lei { dl_info & di_var_heap = di_var_heap }
+				= { dl_info & di_var_heap = di_var_heap }
+					==> ("distribute_lets_in_non_distributed_let (moved or not used)", lei_count, fv_name)
+
+		is_moved LES_Moved	= True
+		is_moved _ 			= False
+
+	distributeLets depth (DynamicExpr dynamik=:{dyn_expr}) dl_info
+		# (dyn_expr, dl_info) = distributeLets depth dyn_expr dl_info
+		= (DynamicExpr { dynamik & dyn_expr = dyn_expr }, dl_info)
+	distributeLets depth expr=:(TypeCodeExpression _) dl_info
+		= (expr, dl_info)
+	distributeLets depth (AnyCodeExpr in_params out_params code_expr) dl_info=:{di_var_heap}
+		# (in_params, di_var_heap) = mapSt determineInputParameter in_params di_var_heap
+		= (AnyCodeExpr in_params out_params code_expr, { dl_info & di_var_heap = di_var_heap })
+		where
+			determineInputParameter bind=:{bind_dst} var_heap
+				# (var_info, var_heap) = readPtr bind_dst.var_info_ptr var_heap
+				= case var_info of
+					VI_CaseVar new_info_ptr
+						-> ({ bind & bind_dst = { bind_dst & var_info_ptr = new_info_ptr }}, var_heap)
+					_
+						-> (bind, var_heap)
+
+	distributeLets depth expr=:(ABCCodeExpr _ _) dl_info
+		= (expr, dl_info)
+	distributeLets depth EE dl_info
+		= (EE, dl_info)
+
+instance distributeLets Case
+where 
+	distributeLets depth kees=:{case_info_ptr,case_guards,case_default,case_expr} dl_info=:{di_var_heap, di_expr_heap}
+		# (EI_CaseTypeAndRefCounts case_type { rcc_all_variables = tot_ref_counts , rcc_default_variables = ref_counts_in_default, rcc_pattern_variables = ref_counts_in_patterns }, di_expr_heap) = readPtr case_info_ptr di_expr_heap
+//		  di_expr_heap = di_expr_heap <:= (case_info_ptr, EI_CaseType case_type)
+		  new_depth = inc depth
+		  (local_lets, di_var_heap) = foldSt (mark_local_let_var new_depth) tot_ref_counts ([], di_var_heap)
+		  (case_guards, heaps) = distribute_lets_in_patterns new_depth ref_counts_in_patterns case_guards (di_var_heap, di_expr_heap)
+		  (case_default, (di_var_heap, di_expr_heap)) = distribute_lets_in_default new_depth ref_counts_in_default case_default heaps
+		  di_var_heap = foldSt reset_local_let_var local_lets di_var_heap
+		  (case_expr, dl_info) = distributeLets depth case_expr { dl_info & di_var_heap = di_var_heap, di_expr_heap = di_expr_heap }
+		= ({ kees & case_guards = case_guards, case_expr = case_expr, case_default = case_default }, dl_info)
+	where
+		distribute_lets_in_patterns depth ref_counts (AlgebraicPatterns conses patterns) heaps
+			# (patterns, heaps) = mapSt (distribute_lets_in_alg_pattern depth) (zip2 ref_counts patterns) heaps
+			= (AlgebraicPatterns conses patterns, heaps)
+		where
+			distribute_lets_in_alg_pattern depth (ref_counts,pattern) (di_var_heap, di_expr_heap)
+				# (ap_vars, di_var_heap) = mapSt refresh_variable pattern.ap_vars di_var_heap
+				  (ap_expr, heaps) = distribute_lets_in_pattern_expr depth ref_counts pattern.ap_expr (di_var_heap, di_expr_heap)
+				= ({ pattern & ap_vars = ap_vars, ap_expr = ap_expr }, heaps) 
+		distribute_lets_in_patterns depth ref_counts (BasicPatterns type patterns) heaps
+			# (patterns, heaps) = mapSt (distribute_lets_in_basic_pattern depth) (zip2 ref_counts patterns) heaps
+			= (BasicPatterns type patterns, heaps)
+		where
+			distribute_lets_in_basic_pattern depth (ref_counts,pattern) heaps
+				# (bp_expr, heaps) = distribute_lets_in_pattern_expr depth ref_counts pattern.bp_expr heaps
+				= ({ pattern & bp_expr = bp_expr }, heaps) 
+		distribute_lets_in_patterns depth ref_counts (DynamicPatterns patterns) heaps
+			# (patterns, heaps) = mapSt (distribute_lets_in_dynamic_pattern depth) (zip2 ref_counts patterns) heaps
+			= (DynamicPatterns patterns, heaps)
+		where
+			distribute_lets_in_dynamic_pattern depth (ref_counts,pattern) (di_var_heap, di_expr_heap)
+				# (dp_var, di_var_heap) = refresh_variable pattern.dp_var di_var_heap
+				  (dp_rhs, heaps) = distribute_lets_in_pattern_expr depth ref_counts pattern.dp_rhs (di_var_heap, di_expr_heap)
+				= ({ pattern & dp_rhs = dp_rhs, dp_var = dp_var }, heaps) 
+				
+		distribute_lets_in_default depth ref_counts_in_default (Yes expr) heaps
+			# (expr, heaps) = distribute_lets_in_pattern_expr depth ref_counts_in_default expr heaps
+			= (Yes expr, heaps)
+		distribute_lets_in_default depth ref_counts_in_default No heaps
+			= (No, heaps)
+
+		refresh_variable fv=:{fv_info_ptr} var_heap
+			# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+			= ({ fv & fv_info_ptr = new_info_ptr }, var_heap <:= (fv_info_ptr, VI_CaseVar new_info_ptr))
+
+		mark_local_let_var depth {cv_variable, cv_count} (local_vars, var_heap)
+			# (VI_LetExpression lei=:{lei_count,lei_depth}, var_heap) = readPtr cv_variable var_heap
+			| lei_count == cv_count
+				= ([(cv_variable, lei_count, lei_depth) : local_vars ], var_heap <:= (cv_variable, VI_LetExpression { lei & lei_depth = depth}))
+						==> ("mark_local_let_var ", lei.lei_var.fv_name, cv_variable, (lei.lei_var.fv_info_ptr, cv_count, depth))
+				= (local_vars, var_heap)
+
+		reset_local_let_var (var_info_ptr, lei_count, lei_depth)  var_heap
+			# (VI_LetExpression lei, var_heap) = readPtr var_info_ptr var_heap
+			= var_heap <:= (var_info_ptr, VI_LetExpression { lei & lei_depth = lei_depth, lei_count = lei_count, lei_status = LES_Moved })
+
+		distribute_lets_in_pattern_expr depth local_vars pattern_expr (var_heap, expr_heap)
+			# var_heap = foldSt (mark_local_let_var_of_pattern_expr depth) local_vars var_heap
+			  (pattern_expr, dl_info) = distributeLets depth pattern_expr { di_lets = [], di_var_heap = var_heap, di_expr_heap = expr_heap}
+			  dl_info = foldSt (reexamine_local_let_expressions depth) local_vars dl_info
+			= buildLetExpr dl_info.di_lets pattern_expr (dl_info.di_var_heap, dl_info.di_expr_heap)
+				==> ("distribute_lets_in_pattern_expr", dl_info.di_lets)
+	
+		mark_local_let_var_of_pattern_expr depth {cv_variable, cv_count} var_heap
+			# (VI_LetExpression lei, var_heap) = readPtr cv_variable var_heap
+			| depth == lei.lei_depth
+				= var_heap <:= (cv_variable, VI_LetExpression { lei & lei_count = cv_count, lei_status = LES_Untouched })
+						==> ("mark_local_let_var_of_pattern_expr ", lei.lei_var.fv_name, cv_variable, (lei.lei_var.fv_info_ptr, cv_count, depth))
+				= var_heap
+
+		reexamine_local_let_expressions depth {cv_variable, cv_count} dl_info=:{di_var_heap}
+			| cv_count > 1
+				# (VI_LetExpression lei, di_var_heap) = readPtr cv_variable di_var_heap
+				| depth == lei.lei_depth
+					= distributeLetsInLetExpression depth cv_variable lei { dl_info & di_var_heap = di_var_heap }
+					= { dl_info & di_var_heap = di_var_heap }
+				= dl_info
+
+
+distributeLetsInLetExpression depth let_var_info_ptr lei=:{lei_expression, lei_status = LES_Moved} dl_info
+	= dl_info
+distributeLetsInLetExpression depth let_var_info_ptr lei=:{lei_expression, lei_status = LES_Updated _} dl_info
+	= dl_info
+distributeLetsInLetExpression depth let_var_info_ptr lei=:{lei_expression, lei_status = LES_Untouched} dl_info=:{di_var_heap}
+	# di_var_heap = di_var_heap <:= (let_var_info_ptr, VI_LetExpression { lei & lei_status = LES_Updated EE}) /* to prevent doing this expression twice */
+      (lei_expression, dl_info) = distributeLets depth lei_expression { dl_info & di_var_heap = di_var_heap }
+	= { dl_info & di_lets = [ let_var_info_ptr : dl_info.di_lets ],
+		 di_var_heap = dl_info.di_var_heap <:= (let_var_info_ptr, VI_LetExpression { lei & lei_status = LES_Updated lei_expression })}
+
+	
+buildLetExpr :: ![VarInfoPtr] !Expression !*(!*VarHeap, !*ExpressionHeap) -> (!Expression, !(!*VarHeap, !*ExpressionHeap))
+buildLetExpr let_vars let_expr (var_heap, expr_heap)
+	# (strict_binds, strict_bind_types, lazy_binds, lazy_binds_types, var_heap) = foldr build_bind ([], [], [], [], var_heap) let_vars
+	| isEmpty strict_binds
+		| isEmpty lazy_binds
+			= (let_expr, (var_heap, expr_heap))
+			# (let_info_ptr, expr_heap) = newPtr (EI_LetType lazy_binds_types) expr_heap
+			= (Let { let_binds = lazy_binds, let_strict = cIsNotStrict, let_expr = let_expr, let_info_ptr = let_info_ptr }, (var_heap, expr_heap))
+		| isEmpty lazy_binds
+			# (let_info_ptr, expr_heap) = newPtr (EI_LetType strict_bind_types) expr_heap
+			= (Let { let_binds = strict_binds, let_strict = cIsStrict, let_expr = let_expr, let_info_ptr = let_info_ptr }, (var_heap, expr_heap))
+			# (strict_let_info_ptr, expr_heap) = newPtr (EI_LetType strict_bind_types) expr_heap
+			  (lazy_let_info_ptr, expr_heap) = newPtr (EI_LetType lazy_binds_types) expr_heap
+			= (Let { let_binds = strict_binds, let_strict = cIsStrict, let_info_ptr = strict_let_info_ptr, let_expr =
+				Let { let_binds = lazy_binds, let_strict = cIsNotStrict, let_info_ptr = lazy_let_info_ptr, let_expr = let_expr }}, (var_heap, expr_heap))
+
+where
+	build_bind :: !VarInfoPtr !(!Env Expression FreeVar, ![AType], !Env Expression FreeVar, ![AType], !*VarHeap)
+		-> (!Env Expression FreeVar, ![AType], !Env Expression FreeVar, ![AType], !*VarHeap)
+	build_bind info_ptr (strict_binds, strict_bind_types, lazy_binds, lazy_binds_types, var_heap)
+		# (let_info, var_heap) = readPtr info_ptr var_heap
+		# (VI_LetExpression lei=:{lei_strict,lei_var,lei_expression,lei_status,lei_type}) = let_info
+		  (LES_Updated updated_expr) = lei_status
+		  (new_info_ptr, var_heap) = newPtr VI_Empty var_heap 
+		  var_heap = var_heap <:= (info_ptr, VI_LetExpression { lei & lei_status = LES_Untouched, lei_var = { lei_var & fv_info_ptr = new_info_ptr }})
+//			==> (lei_var.fv_name, info_ptr, new_info_ptr)
+		| lei_strict
+			= ([{ bind_src = updated_expr, bind_dst = lei_var } : strict_binds], [lei_type : strict_bind_types ], lazy_binds, lazy_binds_types, var_heap)
+			= (strict_binds, strict_bind_types, [{ bind_src = updated_expr, bind_dst = lei_var } : lazy_binds], [lei_type : lazy_binds_types ], var_heap)
+
+instance distributeLets Selection
+where
+	distributeLets depth (ArraySelection selector expr_ptr expr) cp_info
+		# (expr, cp_info) = distributeLets depth expr cp_info
+		= (ArraySelection selector expr_ptr expr, cp_info)
+	distributeLets depth selection cp_info
+		= (selection, cp_info)
+
+instance distributeLets [a] | distributeLets a
+where
+	distributeLets depth l cp_info = mapSt (distributeLets depth) l cp_info 
+
+instance distributeLets (Bind a b) | distributeLets a
+where
+	distributeLets depth bind=:{bind_src} cp_info
+		# (bind_src, cp_info) = distributeLets depth bind_src cp_info
+		= ({ bind & bind_src = bind_src }, cp_info)
+	
+instance <<< ExprInfo
+where
+	(<<<) file EI_Empty			= file <<< "*Empty*"
+	(<<<) file (EI_CaseType _)	= file <<< "CaseType"
+
+instance <<< Ptr a
+where
+	(<<<) file ptr = file <<< ptrToInt ptr  
+
+instance <<< FreeVar
+where
+	(<<<) file {fv_name,fv_info_ptr} = file <<< fv_name <<< '[' <<< fv_info_ptr <<< ']'
+
+instance <<< BoundVar
+where
+	(<<<) file {var_name,var_info_ptr} = file <<< var_name <<< '[' <<< var_info_ptr <<< ']'
+
+instance  <<<  FunctionBody
+where
+	(<<<) file (TransformedBody {tb_rhs}) = file <<<  tb_rhs
+
+instance  <<<  CountedVariable
+where
+	(<<<) file {cv_variable,cv_count} = file <<< '<' <<< cv_variable <<< ',' <<< cv_count <<< '>'
+
+(==>) a b :== a
+//(==>) a b :== a ---> b
diff --git a/frontend/explicitimports.dcl b/frontend/explicitimports.dcl
new file mode 100644
index 0000000..45562f6
--- /dev/null
+++ b/frontend/explicitimports.dcl
@@ -0,0 +1,17 @@
+definition module explicitimports
+
+import syntax, checksupport
+
+temporary_import_solution_XXX yes no :== yes
+// to switch between importing modes.
+// iff this is yes, then explicit imports happen in the old Clean 1.3 fashion.
+// This feature will be removed, when all programs are ported to Clean 2.0. The last Constructors of AtomType
+// and StructureType should then be removed also
+
+// MW2 everything changed in this dcl
+::	FunctionConsequence
+
+possibly_filter_decls :: .[ImportDeclaration] u:[w:(.Index,y:Declarations)] (.FileName,.LineNr) *{#.DclModule} *CheckState -> (v:[x:(Index,z:Declarations)],.{#DclModule},.CheckState), [y <= z, w <= x, u <= v];
+check_completeness_of_module :: .Index [(.Declaration,.Int)] .String *(*{!.FunctionConsequence},*{#.DclModule},*{#FunDef},*ExpressionHeap,*CheckState) -> (.{!FunctionConsequence},.{#DclModule},.{#FunDef},.ExpressionHeap,.CheckState);
+check_completeness_of_all_dcl_modules	:: !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState
+									-> (!Int, !(!*{!FunctionConsequence}, !*{#DclModule}, !*{#FunDef}, !*ExpressionHeap, !*CheckState))
diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl
new file mode 100644
index 0000000..e683a83
--- /dev/null
+++ b/frontend/explicitimports.icl
@@ -0,0 +1,865 @@
+implementation module explicitimports
+
+import StdEnv
+
+import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, RWSDebug
+
+
+temporary_import_solution_XXX yes no :== yes
+// to switch between importing modes.
+// iff this is yes, then explicit imports happen in the old Clean 1.3 fashion.
+// This feature will be removed, when all programs are ported to Clean 2.0. The last Constructors of AtomType
+// and StructureType should then be removed also
+do_temporary_import_solution_XXX :== temporary_import_solution_XXX True False
+
+// MW was cIclModIndex 			:== 0
+
+// MW DclModule
+::	ExplicitImports	:==	(![AtomicImport], ![StructureImport])
+::	AtomicImport	:==	(!Ident, !AtomType)
+::	StructureImport	:==	(!Ident, !StructureInfo, !StructureType, !OptimizeInfo)
+
+::	AtomType		=	AT_Function | AT_Class | AT_Instance | AT_RecordType | AT_AlgType | AT_Type
+						| AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen Bool // XXX
+::	StructureInfo	= SI_DotDot
+					// The .. notation was used for the structure
+					// (currently nothing is known about the elements)
+					| SI_Elements ![Ident] !Bool
+					// list of elements, that were not imported yet.
+					// Bool: the elements were listed explicitly in the structure
+::	StructureType	= ST_AlgType | ST_RecordType | ST_Class
+					| ST_stomm_stomm_stomm String
+::	IdentWithKind	:==	(!Ident, !STE_Kind)
+::	IdentWithCKind	:==	(!Ident, !ConsequenceKind)
+
+::	OptimizeInfo	:==	(Optional !Index)
+
+::	ConsequenceKind	= CK_Function !(Global Index)
+					| CK_DynamicPatternType ExprInfoPtr
+					| CK_Macro
+					| CK_Constructor
+					| CK_Selector !(Global DefinedSymbol)
+					| CK_Type
+					| CK_Class
+
+::	FunctionConsequence	:==	Optional !(!Int, !Optional ![IdentWithCKind])
+	// Int i: The consequences of this function/macro have already been considered for all dcl modules with indices <= i
+
+check_completeness_of_all_dcl_modules	:: !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState
+									-> (!Int, !(!*{!FunctionConsequence}, !*{#DclModule}, !*{#FunDef}, !*ExpressionHeap, !*CheckState))
+check_completeness_of_all_dcl_modules modules icl_functions expr_heap cs
+	#	(nr_modules, modules)	= usize modules
+		(nr_functions, icl_functions)	= usize icl_functions
+		f_consequences	= f_consequences nr_functions
+		result
+			= iFoldSt check_completeness_of_dcl_module 0 (nr_modules) (f_consequences, modules, icl_functions, expr_heap, cs)
+	= (nr_modules, result)
+  where
+	f_consequences :: !Int -> *{!FunctionConsequence}
+	f_consequences i = createArray i No
+
+check_completeness_of_dcl_module mod_index (f_consequences, modules, icl_functions, expr_heap, cs=:{cs_predef_symbols})
+	#	pre_mod = cs_predef_symbols.[PD_PredefinedModule]
+	|	pre_mod.pds_def == mod_index
+		= (f_consequences, modules, icl_functions, expr_heap, cs)	// predefined module should not be checked for completeness of explicit imports
+	#	(modul=:{ dcl_name, dcl_declared=dcl_declared=:{dcls_import,dcls_local, dcls_explicit}}, modules)
+			= modules![mod_index]
+		cs	= addDeclaredSymbolsToSymbolTable cIsADclModule mod_index dcls_local dcls_import cs
+		(f_consequences, modules, icl_functions, expr_heap, cs)
+			= check_completeness_of_module mod_index dcls_explicit (dcl_name.id_name+++".dcl") (f_consequences, modules, icl_functions, expr_heap, cs)
+		(_, cs_symbol_table) = retrieveAndRemoveImportsFromSymbolTable [(mod_index, dcl_declared)] [] cs.cs_symbol_table
+		cs	= { cs & cs_symbol_table=cs_symbol_table }
+	= (f_consequences, modules, icl_functions, expr_heap, cs)
+
+possibly_filter_decls :: .[ImportDeclaration] u:[w:(.Index,y:Declarations)] (.FileName,.LineNr) *{#.DclModule} *CheckState -> (v:[x:(Index,z:Declarations)],.{#DclModule},.CheckState), [y <= z, w <= x, u <= v];
+possibly_filter_decls [] decls_of_imported_module	_ modules cs // implicit import can't go wrong
+	= (decls_of_imported_module, modules, cs)
+possibly_filter_decls listed_symbols decls_of_imported_module (file_name, line_nr) modules cs
+	// explicit import
+	#!	
+		ident_pos	=	{	ip_ident= { id_name="", id_info=nilPtr }
+						,	ip_line	= line_nr
+						,	ip_file	= file_name
+						}
+		cs	= { cs & cs_error	= pushErrorAdmin ident_pos cs.cs_error }
+		(result, modules, cs)	= filter_explicitly_imported_decl listed_symbols decls_of_imported_module [] line_nr modules cs
+		cs	= { cs & cs_error	= popErrorAdmin cs.cs_error }
+	= (result, modules, cs)
+
+filter_explicitly_imported_decl _ [] akku _ modules cs
+	= (akku, modules, cs)
+filter_explicitly_imported_decl import_symbols [(index,{dcls_import,dcls_local,dcls_explicit}):new_decls] akku
+								line_nr modules cs
+	#	undefined	= -1
+		atoms	= flatten (map toAtom import_symbols)
+		structures = flatten (map toStructure import_symbols)
+		(checked_atoms, cs)	= checkAtoms atoms cs
+		unimported	= (checked_atoms, structures)
+		((dcls_import,unimported), modules, cs)	
+			= filter_decl dcls_import [] unimported undefined modules cs
+		((dcls_local,unimported), modules, cs)	
+			= filter_decl dcls_local [] unimported index modules cs
+		cs_error	= foldSt checkAtomError (fst unimported) cs.cs_error
+		cs_error	= foldSt checkStructureError (snd unimported) cs_error
+		cs	= { cs & cs_error=cs_error }
+	|	(isEmpty dcls_import && isEmpty dcls_local && isEmpty dcls_explicit)
+		= filter_explicitly_imported_decl import_symbols new_decls akku line_nr modules cs
+	#	local_imports	= [ { declaration & dcl_kind = STE_Imported declaration.dcl_kind index }
+							 \\ declaration <- dcls_local]
+		new_dcls_explicit	= [ (dcls, line_nr) \\ dcls<-dcls_import++local_imports ]
+		newAkku	= [(index, { dcls_import=dcls_import, dcls_local=dcls_local , dcls_explicit=new_dcls_explicit}) : akku]
+	= filter_explicitly_imported_decl import_symbols new_decls newAkku line_nr modules cs
+  where
+	toAtom (ID_Function {ii_ident})				
+		= [(ii_ident, temporary_import_solution_XXX 
+							(AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen False)
+							AT_Function)]
+	toAtom (ID_Class {ii_ident} _)
+		= [(ii_ident, AT_Class)]
+	toAtom (ID_Type {ii_ident} (Yes _))
+		= [(ii_ident, AT_AlgType)]
+	toAtom (ID_Type {ii_ident} No)
+		= [(ii_ident, AT_Type)]
+	toAtom (ID_Record {ii_ident} yesOrNo)
+		= [(ii_ident, AT_RecordType)]
+	toAtom (ID_Instance _ ident _)
+		= [(ident, AT_Instance)]
+	toAtom _
+		= []
+
+	atomTypeString	AT_Function		= "function"
+	atomTypeString	AT_Class		= "class"
+	atomTypeString	AT_Instance		= "instance"
+	atomTypeString	_				= "type"
+
+	toStructure (ID_Class {ii_ident} yesOrNo)
+		= to_structure ii_ident yesOrNo ST_Class
+	toStructure (ID_Type {ii_ident} yesOrNo)
+		= to_structure ii_ident yesOrNo ST_AlgType
+	toStructure (ID_Record {ii_ident} yesOrNo)
+		= to_structure ii_ident yesOrNo ST_RecordType
+// MW added
+	toStructure (ID_Function {ii_ident})
+		| do_temporary_import_solution_XXX
+			= [(ii_ident, SI_DotDot, ST_stomm_stomm_stomm ii_ident.id_name, No)]
+// ..MW
+	toStructure _
+		= []
+		
+	to_structure _ No _
+		= []
+	to_structure ident (Yes []) structureType
+		=	[(ident, SI_DotDot, structureType, No)]
+	to_structure ident (Yes elements) structureType
+		#	element_idents	= removeDup [ ii_ident \\ {ii_ident}<-elements]
+		=	[(ident, (SI_Elements element_idents True),structureType, No)]
+
+	checkAtoms l cs
+		#	groups	= grouped l
+		#	wrong	= filter isErrornous groups
+			unique	= map hd groups
+		|	isEmpty wrong
+			= (unique, cs)
+		= (unique, foldSt error wrong cs)
+	  where
+		isErrornous l=:[(_,AT_Type),_:_]		= True
+		isErrornous l=:[(_,AT_AlgType),_:_]		= True
+		isErrornous l=:[(_,AT_RecordType),_:_]	= True
+		isErrornous _							= False
+		
+		error [(ident, atomType):_] cs
+			= { cs & cs_error = checkError ("type "+++ident.id_name) "imported more than once in one from statement"
+										cs.cs_error }
+
+	checkAtomError (id, AT_Instance) cs_error
+		= checkError ("specified instance of class "+++id.id_name) "not exported by the specified module" cs_error
+	checkAtomError (id, AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen was_imported_at_least_once) cs_error
+		| do_temporary_import_solution_XXX
+			= case was_imported_at_least_once of
+				True -> cs_error
+				_    -> checkError id ("not exported by the specified module") cs_error
+	checkAtomError (id, atomType) cs_error
+		= checkError id ("not exported as a "+++atomTypeString atomType+++" by the specified module") cs_error
+
+// MW remove this later..
+	checkStructureError (_,_, ST_stomm_stomm_stomm _, _) cs_error
+		| do_temporary_import_solution_XXX
+			= cs_error
+		// further with next alternative
+// ..MW
+	checkStructureError (struct_id, (SI_Elements wrong_elements _), st, _) cs_error
+		= foldSt err wrong_elements cs_error
+	  where
+		err element_id cs_error
+			#	(element_type, structure_type)	= case st of
+													ST_AlgType		->	("constructor",	"algebraic type")
+													ST_RecordType	->	("field",		"record type")
+													ST_Class		->	("member",		"class")
+			= checkError element_id (	"not a "+++element_type+++" of "+++structure_type
+									 +++" "+++struct_id.id_name) cs_error
+	checkStructureError _ cs_error
+		= cs_error
+	
+	// collect groups, e.g. grouped [3,5,1,3,1] = [[1,1],[3,3],[5]]
+	grouped []
+		= []
+	grouped l
+		#	sorted	= qsort l
+		= grouped_ [hd sorted] (tl sorted) []
+	  where
+		grouped_ group [] akku
+			= [group:akku]
+		grouped_ group=:[x:_] [h:t] akku
+			|	x==h	= grouped_ [h:group] t akku
+						= grouped_ [h] t [group:akku]
+	
+	qsort []	= []
+	qsort [h:t] = qsort left++[h: qsort right]
+	  where
+		left	= [x \\ x<-t | greater x h]
+		right	= [x \\ x<-t | not (greater x h) || x==h]
+		greater ({id_name=id_name_l}, atomType_l) ({id_name=id_name_r}, atomType_r)
+			|	id_name_l >id_name_r 	= True
+			|	id_name_l==id_name_r 	= toInt atomType_l > toInt atomType_r
+										= False
+
+instance == AtomType
+  where
+	(==) l r = toInt l==toInt r
+	
+instance toInt AtomType
+  where
+	toInt AT_Function	= 0
+	toInt AT_Class		= 1
+	toInt AT_Instance	= 2
+	toInt AT_RecordType	= 3
+	toInt AT_AlgType	= 3
+	toInt AT_Type		= 3	// AT_RecordType, AT_AlgType & AT_Type are in one class !!!
+	toInt (AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen _)
+						= 0
+
+instance == ConsequenceKind
+  where
+	(==) CK_Type		c = case c of	CK_Type	-> True
+										_		-> False
+	(==) CK_Constructor	c = case c of	CK_Constructor	-> True
+										_		-> False
+	(==) (CK_Selector globDefinedSymb1)
+						c = case c of	CK_Selector globDefinedSymb2 -> globDefinedSymb1==globDefinedSymb2
+										_		-> False
+	(==) CK_Class		c = case c of	CK_Class-> True
+										_		-> False
+	(==) (CK_Function globIndex1)
+						c = case c of	(CK_Function	globIndex2) -> globIndex1==globIndex2
+										_		-> False
+	(==) CK_Macro		c = case c of	CK_Macro-> True
+										_		-> False
+
+filter_decl [] akku unimported _ modules cs
+	= ((akku, unimported), modules, cs)
+filter_decl [decl:decls] akku unimported index modules cs
+	#	((appears,unimported), modules, cs)	= decl_appears decl unimported index modules cs
+	= filter_decl decls (if appears [decl:akku] akku) unimported index modules cs
+
+decl_appears :: !Declaration !ExplicitImports !Index !*{#DclModule} !*CheckState
+			 -> (!(!Bool, !ExplicitImports), !*{#DclModule}, !*CheckState)
+decl_appears dec=:{dcl_kind=STE_Imported ste_Kind def_index} unimported _ modules cs
+	= decl_appears {dec & dcl_kind=ste_Kind} unimported def_index modules cs
+/* MW2 was:
+decl_appears {dcl_ident,dcl_kind=STE_Constructor,dcl_index} unimported index modules cs
+	= elementAppears ST_AlgType dcl_ident dcl_index unimported index modules cs
+*/
+decl_appears {dcl_ident,dcl_kind=STE_Constructor,dcl_index} unimported index modules cs
+	# (result=:((appears, unimported), modules, cs))
+		 = elementAppears ST_AlgType dcl_ident dcl_index unimported index modules cs
+	| appears || not do_temporary_import_solution_XXX
+		= result
+	= atomAppears dcl_ident dcl_index unimported index modules cs
+/* MW2 was
+decl_appears { dcl_ident,dcl_kind=(STE_Field _),dcl_index} unimported index modules cs 
+	= elementAppears ST_RecordType dcl_ident dcl_index unimported index modules cs
+*/
+decl_appears { dcl_ident,dcl_kind=(STE_Field _),dcl_index} unimported index modules cs 
+	# (result=:((appears, unimported), modules, cs))
+		= elementAppears ST_RecordType dcl_ident dcl_index unimported index modules cs
+	| appears || not do_temporary_import_solution_XXX
+		= result
+	= atomAppears dcl_ident dcl_index unimported index modules cs
+/* MW2 was
+decl_appears { dcl_ident,dcl_kind=STE_Member,dcl_index} unimported index modules cs 
+	= elementAppears ST_Class dcl_ident dcl_index unimported index modules cs
+*/
+decl_appears { dcl_ident,dcl_kind=STE_Member,dcl_index} unimported index modules cs 
+	# (result=:((appears, unimported), modules, cs))
+		= elementAppears ST_Class dcl_ident dcl_index unimported index modules cs
+	| appears || not do_temporary_import_solution_XXX
+		= result
+	= atomAppears dcl_ident dcl_index unimported index modules cs
+decl_appears {dcl_ident, dcl_kind, dcl_index} unimported index modules cs 
+	| isAtom dcl_kind
+		=  atomAppears dcl_ident dcl_index unimported index modules cs
+  where
+	isAtom STE_DclFunction			= True
+	isAtom (STE_FunctionOrMacro	_)	= True
+	isAtom STE_Class				= True
+	isAtom STE_Type					= True
+	isAtom STE_Instance				= True
+
+
+// CommonDefs CollectedDefinitions
+
+elementAppears imported_st dcl_ident dcl_index (atomicImports, structureImports) index modules cs
+	#	((result, structureImports), modules, cs)
+			=  element_appears imported_st dcl_ident dcl_index structureImports [] index modules cs
+	= ((result, (atomicImports, structureImports)), modules, cs)
+
+atomAppears dcl_ident dcl_index (atomicImports, structureImports) index modules cs
+	#	((result, atomicImports), modules, cs)
+			= atom_appears dcl_ident dcl_index atomicImports [] index modules cs
+	= ((result, (atomicImports, structureImports)), modules, cs)
+
+
+atom_appears _ _ [] akku _ modules cs
+  	= ((False, akku), modules, cs)
+atom_appears ident dcl_index [h=:(import_ident, atomType):t] akku index modules cs
+// MW2..
+	|		do_temporary_import_solution_XXX
+		&&	ident.id_name==import_ident.id_name 
+		&&	atomType==(AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen True) // True or False doesn't matter in this line
+		#	new_h = (import_ident, AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen True)
+		=  ((True, [new_h:t]++akku), modules, cs)
+// ..MW2
+	|	ident==import_ident
+		#	(modules, cs)	=  checkRecordError atomType import_ident dcl_index index modules cs
+		= ((True, t++akku), modules, cs)
+	// goes further with next alternative
+  where
+	checkRecordError atomType import_ident dcl_index index modules cs
+		#	(td_rhs, modules, cs) = lookup_type dcl_index index modules cs
+			cs_error	= cs.cs_error
+			cs_error	= case atomType of
+							AT_RecordType
+								-> case td_rhs of
+									RecordType _	-> cs_error
+									_				-> checkError import_ident "imported as a record type" cs_error
+							AT_AlgType
+								-> case td_rhs of
+									AlgType _		-> cs_error
+									_				-> checkError import_ident "imported as an algebraic type" cs_error
+							_	-> cs_error
+		= (modules, { cs & cs_error=cs_error })
+atom_appears ident dcl_index [h:t] akku index modules cs
+	= atom_appears ident dcl_index t [h:akku] index modules cs
+
+instance == StructureType
+  where
+	(==) ST_AlgType		ST_AlgType		= True
+	(==) ST_RecordType	ST_RecordType	= True
+	(==) ST_Class		ST_Class		= True
+	(==) _ _							= False
+
+element_appears _ _ _ [] akku _ modules cs
+	= ((False, akku), modules, cs)
+// MW remove this later ..
+element_appears imported_st element_ident dcl_index
+				[h=:(_, SI_DotDot, ST_stomm_stomm_stomm type_name_string, optInfo):t] akku
+				index modules cs
+	| do_temporary_import_solution_XXX
+		#	(appears, modules, cs)
+			= element_appears_in_stomm_struct imported_st element_ident dcl_index index type_name_string modules cs
+		| appears
+			= ((appears,[h:t]++akku), modules, cs)
+		= element_appears imported_st element_ident dcl_index t [h:akku] index modules cs
+	// otherwise go further with next alternative
+// ..MW
+element_appears imported_st element_ident dcl_index
+				[h=:(_, _, st, _):t] akku
+				index modules cs
+	|	imported_st<>st
+		= element_appears imported_st element_ident dcl_index t [h:akku] index modules cs
+	// goes further with next alternative
+element_appears imported_st element_ident dcl_index
+				[h=:(_, _, _, (Yes notDefinedHere)):t] akku
+				index modules cs
+	|	notDefinedHere==dcl_index 
+		= element_appears imported_st element_ident dcl_index t [h:akku] index modules cs
+	// goes further with next alternative
+element_appears	imported_st element_ident dcl_index
+				[h=:(struct_id, (SI_Elements elements explicit), st, optInfo):t] akku
+				index modules cs
+	#	(l,r)	= span ((<>) element_ident) elements
+	|	isEmpty r
+		= element_appears imported_st element_ident dcl_index t [h:akku] index modules cs
+	#	oneLess	= l++(tl r)
+		newStructure	= (struct_id, (SI_Elements oneLess explicit), st, optInfo)
+	|	not explicit
+		= ((True, [newStructure: t]++akku), modules, cs)
+	// the found element was explicitly specified by the programmer: check it
+	#	(appears, _, _, modules, cs)
+			= element_appears_in_struct imported_st element_ident dcl_index struct_id index modules cs
+	|	appears
+		= ((True, [newStructure: t]++akku), modules, cs)
+	#	message	= "does not belong to specified "+++(case st of
+														ST_Class	-> "class."
+														_			-> "type.")
+		cs	= { cs & cs_error= checkError element_ident message  cs.cs_error}
+	= ((False, t++akku), modules, cs)
+element_appears imported_st element_ident dcl_index
+				[h=:(struct_id, SI_DotDot, st, optInfo):t] akku
+				index modules cs
+	#	(appears, defined, opt_element_idents, modules, cs)
+			= element_appears_in_struct imported_st element_ident dcl_index struct_id index modules cs
+	|	not appears
+		#	structureInfo	= case opt_element_idents of
+								No					-> SI_DotDot
+								Yes element_idents	-> (SI_Elements element_idents False)
+			newStructure	= (struct_id, SI_DotDot, st, (if defined No (Yes dcl_index)))
+		= element_appears imported_st element_ident dcl_index t [newStructure:akku] index modules cs
+	#	(Yes element_idents)	= opt_element_idents
+		oneLess	= filter ((<>) element_ident) element_idents
+		newStructure	= (struct_id, (SI_Elements oneLess False), st, No)
+	= ((True,[newStructure:t]++akku), modules, cs)
+element_appears imported_st element_ident dcl_index [h:t] akku index modules cs
+	= element_appears imported_st element_ident dcl_index t [h:akku] index modules cs
+
+lookup_type dcl_index index modules cs
+	#	(dcl_module=:{dcl_name=dcl_name=:{id_info}}, modules)		= modules ! [index]
+		(module_entry, cs_symbol_table)				= readPtr id_info cs.cs_symbol_table
+		cs	= { cs & cs_symbol_table=cs_symbol_table }
+	= continuation module_entry.ste_kind dcl_module modules cs
+  where
+	continuation (STE_OpenModule _ modul) _ modules cs
+		#	allTypes	= modul.mod_defs.def_types
+		= ((allTypes !! dcl_index).td_rhs, modules, cs)
+	continuation STE_ClosedModule dcl_module modules cs
+		#	com_type_def	= dcl_module.dcl_common.com_type_defs.[dcl_index]
+		= (com_type_def.td_rhs, modules, cs)
+
+// MW remove this later CCC
+element_appears_in_stomm_struct imported_st element_ident dcl_index index type_name_string modules cs
+	| not do_temporary_import_solution_XXX
+		= abort "element_appears_in_stomm_struct will be never called, when the above guard holds. This statement is only to remind people to remove this function."
+	#	(dcl_module=:{dcl_name=dcl_name=:{id_info}}, modules)		= modules ! [index]
+		(module_entry, cs_symbol_table)				= readPtr id_info cs.cs_symbol_table
+		cs	= { cs & cs_symbol_table=cs_symbol_table }
+	= continuation imported_st module_entry.ste_kind dcl_module modules cs
+  where
+	continuation ST_RecordType (STE_OpenModule _ modul) _ modules cs
+		//	lookup the constructors/fields for the algebraic type/record
+		#	allTypes	= modul.mod_defs.def_types
+			search		= dropWhile (\{td_name} -> td_name.id_name<>type_name_string) allTypes
+		|	isEmpty search
+			= (False, modules, cs)
+		#	{td_rhs}	= hd search
+		|	not (isRecordType td_rhs)
+			= (False, modules, cs)
+		#	element_idents	= getElements td_rhs
+		= (isMember element_ident element_idents, modules, cs)
+	continuation ST_RecordType STE_ClosedModule dcl_module modules cs
+		// lookup the type of the constructor and compare
+		#	type_index		= dcl_module.dcl_common.com_selector_defs.[dcl_index].sd_type_index
+			com_type_def	= dcl_module.dcl_common.com_type_defs.[type_index]
+			appears	= com_type_def.td_name.id_name==type_name_string
+		= (appears, modules, cs)
+	continuation ST_Class (STE_OpenModule _ modul) _ modules cs
+		//	lookup the members for the class
+		#	allClasses	= modul.mod_defs.def_classes
+			search		= dropWhile (\{class_name} -> class_name.id_name<>type_name_string) allClasses
+		|	isEmpty search
+			= (False, modules, cs)
+		#	{class_members}	= hd search
+			element_idents	= [ ds_ident \\ {ds_ident} <-:class_members ]
+		= (isMember element_ident element_idents, modules, cs)
+	continuation ST_Class STE_ClosedModule dcl_module modules cs
+		// lookup the class and compare
+		#	com_member_def	= dcl_module.dcl_common.com_member_defs.[dcl_index]
+			{glob_object}	= com_member_def.me_class
+			com_class_def	= dcl_module.dcl_common.com_class_defs.[glob_object]
+			allMembers		= com_class_def.class_members
+			member_idents	= [ ds_ident \\ {ds_ident} <-: allMembers]
+			appears	= com_class_def.class_name.id_name==type_name_string
+		= (appears, modules, cs)
+	continuation _ _ _ modules cs
+		= (False, modules, cs)
+	getElements (RecordType {rt_fields})
+		= [ fs_name \\ {fs_name}<-:rt_fields ]
+	getElements _
+		= []
+	isRecordType (RecordType _)	= True
+	isRecordType _				= False
+// ..MW
+
+/*	1st result: whether the element appears in the structure
+	2nd result: whether the structure is defined at all in the module
+	3rd result: Yes: a list of all idents of the elements of the structure
+the first bool implies the second
+*/
+element_appears_in_struct imported_st element_ident dcl_index struct_ident index modules cs
+	#	(dcl_module=:{dcl_name=dcl_name=:{id_info}}, modules)		= modules ! [index]
+		(module_entry, cs_symbol_table)				= readPtr id_info cs.cs_symbol_table
+		cs	= { cs & cs_symbol_table=cs_symbol_table }
+	= continuation imported_st module_entry.ste_kind dcl_module modules cs
+  where
+	continuation ST_Class (STE_OpenModule _ modul) _ modules cs
+		//	lookup the members for the class
+		#	allClasses	= modul.mod_defs.def_classes
+			search		= dropWhile (\{class_name} -> class_name<>struct_ident) allClasses
+		|	isEmpty search
+			= (False, False, No, modules, cs)
+		#	{class_members}	= hd search
+			element_idents	= [ ds_ident \\ {ds_ident} <-:class_members ]
+		= (isMember element_ident element_idents, True, Yes element_idents, modules, cs)
+	continuation imported_st (STE_OpenModule _ modul) _ modules cs
+		//	lookup the constructors/fields for the algebraic type/record
+		#	allTypes	= modul.mod_defs.def_types
+			search		= dropWhile (\{td_name} -> td_name<>struct_ident) allTypes
+		|	isEmpty search
+			= (False, False, No, modules, cs)
+		#	{td_rhs}	= hd search
+		|	not (isAlgOrRecordType td_rhs)
+			= (False, True, No, modules, cs)
+		#	element_idents	= getElements td_rhs
+		= (isMember element_ident element_idents, True, Yes element_idents, modules, cs)
+	continuation ST_Class STE_ClosedModule dcl_module modules cs
+		// lookup the class and compare
+		#	com_member_def	= dcl_module.dcl_common.com_member_defs.[dcl_index]
+			{glob_object}	= com_member_def.me_class
+			com_class_def	= dcl_module.dcl_common.com_class_defs.[glob_object]
+			allMembers		= com_class_def.class_members
+			member_idents	= [ ds_ident \\ {ds_ident} <-: allMembers]
+			appears	= com_class_def.class_name==struct_ident
+		= (appears, True, if appears (Yes member_idents) No, modules, cs)
+	continuation imported_st STE_ClosedModule dcl_module modules cs
+		// lookup the type of the constructor and compare
+		#	type_index	= if (imported_st==ST_AlgType)
+								 dcl_module.dcl_common.com_cons_defs.[dcl_index].cons_type_index 
+								 dcl_module.dcl_common.com_selector_defs.[dcl_index].sd_type_index
+			com_type_def	= dcl_module.dcl_common.com_type_defs.[type_index]
+			element_idents	= getElements com_type_def.td_rhs
+			appears	= com_type_def.td_name==struct_ident
+		= (appears, True, if appears (Yes element_idents) No, modules, cs)
+	isAlgOrRecordType (AlgType _)		= True
+	isAlgOrRecordType (RecordType _)	= True
+	isAlgOrRecordType _					= False
+	getElements (AlgType constructor_symbols)
+		= [ds_ident \\ {ds_ident} <- constructor_symbols]
+	getElements (RecordType {rt_fields})
+		= [ fs_name \\ {fs_name}<-:rt_fields ]
+	getElements _
+		= []
+
+check_completeness_of_module :: .Index [(.Declaration,.Int)] .String *(*{!.FunctionConsequence},*{#.DclModule},*{#FunDef},*ExpressionHeap,*CheckState) -> (.{!FunctionConsequence},.{#DclModule},.{#FunDef},.ExpressionHeap,.CheckState);
+check_completeness_of_module mod_index dcls_explicit file_name (f_consequences, modules, icl_functions, expr_heap, cs)
+	#	dcls_imp	= [((dcl_ident, kind), (dcl_index, mod_index), (file_name, line_nr))
+						\\ ({dcl_ident, dcl_index, dcl_kind=STE_Imported kind mod_index}, line_nr) <- dcls_explicit]
+		(conseqs, (f_consequences, modules, icl_functions, expr_heap))
+				= seqList (map (consequences_of mod_index) dcls_imp) (f_consequences, modules, icl_functions, expr_heap)
+		conseqs	= flatten conseqs
+	#!	(modules, cs)	= seq (map checkConsequenceError conseqs) (modules, cs)
+	= (f_consequences, modules, icl_functions, expr_heap, cs)
+
+consequences_of ::	!Index
+					(!IdentWithKind, !(!Index,!Index), !(!String, !Int)) !(!*{!FunctionConsequence}, !*{#DclModule}, !*{#FunDef}, !*ExpressionHeap)
+ 				->	(![(!IdentWithKind, !IdentWithCKind, !(!String, !Int))], !(*{!FunctionConsequence}, !*{#DclModule}, !*{#FunDef}, !*ExpressionHeap))
+consequences_of count (expl_imp_ident_kind=:(_,expl_imp_kind), (dcl_index, mod_index), errMsgInfo) 
+				(f_consequences, modules, icl_functions, expr_heap)
+	#	(modul, modules)	= modules![mod_index]
+		(consequences, (f_consequences, icl_functions, expr_heap))
+			= case expl_imp_kind of
+					STE_FunctionOrMacro _
+						-> consequences_of_macro count dcl_index f_consequences icl_functions expr_heap
+					_
+						-> (consequences_of_simple_symbol expl_imp_kind modul dcl_index, (f_consequences, icl_functions,expr_heap))
+		conseqs	= removeDup consequences
+	= ([(expl_imp_ident_kind, conseq, errMsgInfo) \\ conseq<-conseqs], (f_consequences, modules, icl_functions, expr_heap))
+	
+consequences_of_macro count dcl_index f_consequences icl_functions expr_heap
+	#	(icl_function, icl_functions)	= icl_functions![dcl_index]
+		{fun_symb, fun_type, fun_body}	= icl_function
+		result = consequences fun_body
+	= expand_functions_and_dynamics result [] (f_consequences, icl_functions, expr_heap)
+  where
+	expand_functions_and_dynamics [] akku unique_stuff
+		= (akku, unique_stuff)
+	expand_functions_and_dynamics [(_,CK_DynamicPatternType exprInfoPtr):t] akku (f_consequences, icl_functions, expr_heap)
+		#	(conseqs, expr_heap)	= expand_dynamic exprInfoPtr expr_heap
+		= expand_functions_and_dynamics t (conseqs++akku) (f_consequences, icl_functions, expr_heap)
+	expand_functions_and_dynamics [(ident,(CK_Function globIndex)):t] akku unique_stuff
+		#	(conseqs, unique_stuff) = expand_function ident globIndex unique_stuff
+		= expand_functions_and_dynamics t (conseqs++akku) unique_stuff
+	expand_functions_and_dynamics [h:t] akku unique_stuff
+		= expand_functions_and_dynamics t [h:akku] unique_stuff
+
+	expand_dynamic :: ExprInfoPtr *ExpressionHeap -> ([IdentWithCKind], *ExpressionHeap)
+	expand_dynamic exprInfoPtr expr_heap
+	// it is assumed, that the pointer structure from the fi_dynamics field (of record FunInfo)
+	// is a tree
+		#	(exprInfo, expr_heap)	= readPtr exprInfoPtr expr_heap
+			(conseqs, expr_heap)
+			 	= case exprInfo of
+							(EI_Dynamic No)	
+								-> ([], expr_heap)
+							(EI_Dynamic (Yes dynamicType))
+								-> (consequences dynamicType, expr_heap)
+							(EI_Dynamic (Yes dynamicType))
+								-> (consequences dynamicType, expr_heap)
+							(EI_DynamicType dynamicType further_dynamic_ptrs)
+								#	(further_conseqs, expr_heap)	= expand_dynamics further_dynamic_ptrs [] expr_heap
+								-> (further_conseqs++consequences dynamicType, expr_heap)
+							(EI_DynamicTypeWithVars _ dynamicType further_dynamic_ptrs)
+								#	(further_conseqs, expr_heap)	= expand_dynamics further_dynamic_ptrs [] expr_heap
+								-> (further_conseqs++consequences dynamicType, expr_heap)
+		= (conseqs, expr_heap)
+	
+	expand_dynamics [] akku expr_heap
+		= (akku, expr_heap)
+	expand_dynamics [h:t] akku expr_heap
+		#	(dyn, expr_heap)	= expand_dynamic h expr_heap
+		= expand_dynamics t (dyn++akku) expr_heap
+
+
+	expand_function ident globIndex=:{glob_object,glob_module} (f_consequences, icl_functions, expr_heap)
+		|	glob_module<>cIclModIndex	// the function that is referred from within a macro is a DclFunction
+										// -> must be global -> is a consequence
+			= ([(ident, CK_Function globIndex)], (f_consequences, icl_functions, expr_heap))
+		#	(fun_def, icl_functions)	= icl_functions![glob_object]
+		|	fun_def.fun_info.fi_def_level==cGlobalScope	// the function is defined in the icl module in the global scope
+														// -> it's not a consequence
+			= ([], (f_consequences, icl_functions, expr_heap))
+		// otherwise the function was defined locally in a macro and stored in the IclModule object.
+		// it is not a consequence, but it's type and body are consequences !
+		#	(opt_f_consequences, f_consequences)	= f_consequences![glob_object]
+		= case opt_f_consequences of
+			No 	#	type_consequences	= consequences fun_def.fun_type
+					body_consequences	= consequences fun_def.fun_body
+					dynamic_pointers	= fun_def.fun_info.fi_dynamics
+				#	(dynamic_consequences, expr_heap)
+										= expand_dynamics dynamic_pointers [] expr_heap
+					f_consequences		= { f_consequences & [glob_object]=Yes (count, No) }
+					(cons, (f_consequences, icl_functions, expr_heap))
+										= expand_functions_and_dynamics body_consequences [] (f_consequences, icl_functions,expr_heap)
+					cons_of_function	= type_consequences++cons++dynamic_consequences
+					f_consequences		= { f_consequences & [glob_object]=Yes (count, Yes cons_of_function) }
+				-> (cons_of_function, (f_consequences, icl_functions, expr_heap))
+			Yes (j, opt_consequences)
+				|	j==count	// the consequences of the function are already considered
+				-> ([], (f_consequences, icl_functions, expr_heap))
+			Yes (j, Yes cons)
+				|	j<count	// always True
+				-> (cons, (f_consequences, icl_functions, expr_heap))
+
+consequences_of_simple_symbol STE_Type {dcl_common} dcl_index
+	= consequences dcl_common.com_type_defs.[dcl_index]
+consequences_of_simple_symbol STE_Constructor {dcl_common} dcl_index
+	= consequences dcl_common.com_cons_defs.[dcl_index]
+consequences_of_simple_symbol STE_DclFunction {dcl_functions} dcl_index
+	= consequences dcl_functions.[dcl_index]
+consequences_of_simple_symbol (STE_Field _) {dcl_common} dcl_index
+	= consequences dcl_common.com_selector_defs.[dcl_index]
+consequences_of_simple_symbol STE_Class {dcl_common} dcl_index
+	= consequences dcl_common.com_class_defs.[dcl_index]
+consequences_of_simple_symbol STE_Member {dcl_common} dcl_index
+	= consequences dcl_common.com_member_defs.[dcl_index]
+consequences_of_simple_symbol STE_Instance {dcl_common} dcl_index
+	= consequences dcl_common.com_instance_defs.[dcl_index]
+
+checkConsequenceError (expl_imp_ident_kind, conseq_ident_kind=:(conseq_ident, conseq_kind), (file_name, line_nr))
+					 (modules, cs=:{cs_symbol_table, cs_error})
+	#	(c_ident, modules)
+			= case conseq_kind of
+				CK_Selector {glob_object,glob_module}				// if a selector is a consequence of an imported macro the
+					#	(modul, modules)	= modules![glob_module]	// it's FIELD has to be looked up
+						com_selector_def	= modul.dcl_common.com_selector_defs.[glob_object.ds_index]
+					-> (com_selector_def.sd_field, modules)
+				_	-> (conseq_ident, modules)
+		({ste_kind}, cs_symbol_table)				= readPtr c_ident.id_info cs_symbol_table
+		cs_error
+			= case ste_kind of
+				STE_Empty
+							-> cError expl_imp_ident_kind
+									  (   "explicitly imported without importing "
+									   +++cIdent_kind_to_string conseq_ident_kind)
+									  cs_error
+				_			-> cs_error
+	= (modules, { cs & cs_symbol_table=cs_symbol_table, cs_error=cs_error })
+  where
+	ident_kind_to_string ({id_name}, kind)
+		= kind_to_string kind+++" "+++id_name
+	cIdent_kind_to_string ({id_name}, cKind)
+		= cKind_to_string cKind+++" "+++id_name
+	cError expl_imp_ident_kind=:(expl_ident,_) s2 cs_error
+		#	identPos	= {	ip_ident = expl_ident, ip_line = line_nr, ip_file = file_name } 
+			cs_error	= pushErrorAdmin identPos cs_error
+			cs_error	= checkError (ident_kind_to_string expl_imp_ident_kind) s2 cs_error
+			cs_error	= popErrorAdmin cs_error
+		= cs_error
+
+kind_to_string (STE_FunctionOrMacro _)	= "function"
+kind_to_string STE_Type					= "type"
+kind_to_string STE_Constructor			= "constructor"
+kind_to_string (STE_Field _)			= "field"
+kind_to_string STE_Class				= "class"
+kind_to_string STE_Member				= "member"
+kind_to_string STE_Instance				= "instance"
+kind_to_string STE_DclFunction			= "function"
+
+cKind_to_string (CK_Function _)			= "function"
+cKind_to_string CK_Macro				= "macro"
+cKind_to_string CK_Type					= "type"
+cKind_to_string CK_Constructor			= "constructor"
+cKind_to_string (CK_Selector _)			= "appropriate record field"
+cKind_to_string CK_Class				= "class"
+
+class consequences x :: x -> [IdentWithCKind]
+
+instance consequences App
+  where consequences {app_symb, app_args}	= consequences app_symb++consequences app_args
+	
+instance consequences AlgebraicPattern
+  where consequences {ap_symbol, ap_expr} = [ (ap_symbol.glob_object.ds_ident, CK_Constructor) : consequences ap_expr]
+
+instance consequences AType
+  where
+	consequences {at_type}	= consequences at_type
+
+instance consequences BasicPattern
+  where consequences {bp_expr} = consequences bp_expr
+
+instance consequences Case
+  where	consequences { case_expr, case_guards, case_default, case_ident }
+		= consequences case_expr++consequences case_guards++consequences case_default
+
+instance consequences CasePatterns
+  where
+	consequences (AlgebraicPatterns _ algebraicPatterns)	= consequences algebraicPatterns
+	consequences (BasicPatterns _ basicPatterns)	= consequences basicPatterns
+	consequences (DynamicPatterns dynamicPatterns)	= consequences dynamicPatterns
+	consequences NoPattern	= []
+
+instance consequences CheckedBody
+  where consequences {cb_rhs} = consequences cb_rhs
+
+instance consequences ClassDef
+  where
+	consequences {class_context}	= consequences class_context	
+
+instance consequences ClassInstance
+  where
+	consequences {ins_type}	= consequences ins_type	
+
+instance consequences ConsDef
+  where
+	consequences {cons_type}	= consequences cons_type	
+
+instance consequences DynamicPattern // the types, that are found via dp_type are checked later
+  where	consequences { dp_rhs, dp_type } = [({ id_name="", id_info=nilPtr}, CK_DynamicPatternType dp_type): consequences dp_rhs]
+
+instance consequences DynamicExpr
+  where	consequences { dyn_expr, dyn_opt_type } = consequences dyn_expr++consequences dyn_opt_type
+
+instance consequences DynamicType
+  where	consequences { dt_type } = consequences dt_type
+
+instance consequences Expression
+  where
+	consequences (Var _)	= []
+	consequences (App app)	= consequences app
+	consequences (expression @ expressions)	= consequences expression++consequences expressions
+	consequences (Let let_)	= consequences let_
+	consequences (Case case_)	= consequences case_
+	consequences (Selection _ expression selections)	= consequences expression++consequences selections
+	consequences (TupleSelect _ _ expression)	= consequences expression
+	consequences (BasicExpr _ _)		= []
+	consequences (AnyCodeExpr _ _ _)	= []
+	consequences (ABCCodeExpr _ _)	= []
+	consequences (MatchExpr _ constructor expression)
+		= [(constructor.glob_object.ds_ident,CK_Constructor):consequences expression]
+	consequences (FreeVar _) 	= []
+	consequences (DynamicExpr dynamicExpr)	= consequences dynamicExpr
+	consequences EE	= []
+
+instance consequences FunctionBody
+  where	consequences (CheckedBody body) = consequences body
+		consequences (TransformedBody body) = consequences body
+		// other alternatives should not occur
+
+instance consequences FunType
+  where
+	consequences {ft_type}	= consequences ft_type	
+
+instance consequences (Global x) | consequences x
+  where	consequences { glob_object } = consequences glob_object
+
+instance consequences InstanceType
+  where
+	consequences {it_types, it_context}	= consequences it_types++consequences it_context	
+
+instance consequences Let
+  where	consequences { let_binds, let_expr }
+  			= consequences let_expr++(flatten [consequences bind_src \\ {bind_src}<-let_binds] )
+
+instance consequences MemberDef
+  where
+	consequences {me_type}	= consequences me_type	
+
+instance consequences (Optional x) | consequences x
+  where	consequences (Yes x) = consequences x
+  		consequences No = []
+
+instance consequences Selection
+  where consequences (RecordSelection globDefinedSymbol=:{glob_object={ds_ident}} _)
+  			= [(ds_ident, CK_Selector globDefinedSymbol)]
+		consequences (ArraySelection {glob_object={ds_ident={id_name}}} _ _)
+  			= []
+
+instance consequences SelectorDef
+  where consequences {sd_type}	= consequences sd_type	
+
+instance consequences SymbIdent
+  where consequences {symb_name, symb_kind}
+  			= case symb_kind of
+  					SK_Constructor _		-> [(symb_name, CK_Constructor)]
+  			  		SK_Function	globalIndex	-> [(symb_name, CK_Function globalIndex)]
+  			  		SK_OverloadedFunction globalIndex
+  			  								-> [(symb_name, CK_Function globalIndex)]
+  			  		SK_Macro globalIndex	-> [(symb_name, CK_Macro)]
+  			  		_						-> []
+
+instance consequences SymbolType
+  where
+	consequences {st_args, st_result, st_context}
+		= consequences st_args++consequences st_result++consequences st_context
+
+instance consequences TransformedBody
+  where consequences {tb_rhs} = consequences tb_rhs
+
+instance consequences Type
+  where
+	consequences (TA {type_name} arguments)
+		= [(type_name, CK_Type):consequences arguments]
+	consequences (l --> r)
+		= consequences l++consequences r
+	consequences (_ :@: arguments)
+		= consequences arguments
+	consequences _
+		= []
+
+
+instance consequences TypeContext
+  where
+	consequences {tc_class= {glob_object={ds_ident}}, tc_types}
+		= [(ds_ident,CK_Class):consequences tc_types]
+
+instance consequences (TypeDef TypeRhs)  // ==CheckedTypeDef
+  where
+	consequences {td_rhs, td_context}	= consequences td_rhs++consequences td_context
+
+instance consequences TypeRhs
+  where
+	consequences (SynType aType)	= consequences aType
+	consequences _					= []
+
+instance consequences [a]	| consequences a
+  where
+	consequences l	= flatten (map consequences l)
+  
diff --git a/frontend/general.dcl b/frontend/general.dcl
new file mode 100644
index 0000000..e2215df
--- /dev/null
+++ b/frontend/general.dcl
@@ -0,0 +1,31 @@
+definition module general
+
+from StdEnv import <<<, +, ~
+
+instance ~ Bool
+
+instance <<< Bool
+instance <<< (a,b) | <<< a & <<< b
+instance <<< (a,b,c) | <<< a & <<< b & <<< c
+instance <<< (a,b,c,d) | <<< a & <<< b & <<< c & <<< d
+instance <<< (a,b,c,d,e) | <<< a & <<< b & <<< c & <<< d & <<< e
+instance <<< [a] | <<< a
+
+::	Bind a b =
+	{	bind_src :: !a
+	,	bind_dst :: !b
+	}	
+
+::	Env a b :== [Bind a b]
+
+::	Optional x = Yes !x | No
+
+(--->) infix :: .a !b -> .a | <<< b
+(-?->) infix :: .a !(!Bool, !b) -> .a | <<< b
+
+instance + {#Char}
+
+cMAXINT :== 2147483647
+
+::	BITVECT :== Int
+
diff --git a/frontend/general.icl b/frontend/general.icl
new file mode 100644
index 0000000..83f854e
--- /dev/null
+++ b/frontend/general.icl
@@ -0,0 +1,72 @@
+implementation module general
+
+import StdEnv
+
+::	Bind a b =
+	{	bind_src :: !a
+	,	bind_dst :: !b
+	}	
+
+::	Env a b :== [Bind a b]
+
+::	Optional x = Yes !x | No
+
+cMAXINT :== 2147483647
+
+::	BITVECT :== Int
+
+instance ~ Bool
+where ~ b = not b
+
+instance <<< Bool
+where
+	(<<<) file bool = file <<< (toString bool)
+
+instance <<< (a,b) | <<< a & <<< b
+where
+	(<<<) file (x,y) = file <<< '(' <<< x <<< ", " <<< y <<< ") "
+
+instance <<< (a,b,c) | <<< a & <<< b & <<< c
+where
+	(<<<) file (x,y,z) = file <<< '(' <<< x <<< ", " <<< y <<< ", " <<< z <<< ") "
+
+instance <<< (a,b,c,d) | <<< a & <<< b & <<< c & <<< d
+where
+	(<<<) file (w,x,y,z) = file <<< '(' <<< w <<< ", " <<< x <<< ", " <<< y <<< ", " <<< z <<< ") "
+
+instance <<< (a,b,c,d,e) | <<< a & <<< b & <<< c & <<< d & <<< e
+where
+	(<<<) file (v,w,x,y,z) = file <<< '(' <<< v <<< ", " <<< w <<< ", " <<< x <<< ", " <<< y <<< ", " <<< z <<< ") "
+
+instance <<< [a] | <<< a
+where
+	(<<<) file [] = file <<< "[]"
+	(<<<) file l  = showTail (file <<< "[") l
+	where
+		showTail f [x]   = f <<< x <<< "] "
+		showTail f [a:x] = showTail (f <<< a <<< ", ") x
+		showTail f []    = f <<< "] "
+
+(--->) infix :: .a !b -> .a | <<< b
+(--->) val message
+  | file_to_true (stderr <<< message <<< '\n')
+      = val
+      = abort "Internal error in --->"
+
+(-?->) infix :: .a !(!Bool, !b) -> .a | <<< b
+(-?->) val (cond, message)  
+  | cond && file_to_true (stderr <<< message <<< '\n')
+      = val
+      = abort "Internal error in --->"
+
+file_to_true :: !File -> Bool
+file_to_true file = code {
+  .inline file_to_true
+          pop_b 2
+          pushB TRUE
+  .end
+  }
+
+instance + {#Char}
+where
+	(+) s t = s +++ t
diff --git a/frontend/hashtable.dcl b/frontend/hashtable.dcl
new file mode 100644
index 0000000..2d1621f
--- /dev/null
+++ b/frontend/hashtable.dcl
@@ -0,0 +1,26 @@
+definition module hashtable
+
+import syntax
+
+::	HashTableEntry 
+
+::	HashTable =
+	{	hte_symbol_heap	:: !.SymbolTable
+	,	hte_entries		:: !.{! .HashTableEntry}
+	}
+
+newHashTable :: *HashTable
+
+::	IdentClass	= IC_Expression
+				| IC_Type
+				| IC_TypeAttr
+				| IC_Class
+				| IC_Module
+				| IC_Field !Ident
+				| IC_Selector
+				| IC_Instance ![Type]
+				| IC_Unknown
+
+
+putIdentInHashTable :: !String !IdentClass !*HashTable -> (!Ident, !*HashTable)
+
diff --git a/frontend/hashtable.icl b/frontend/hashtable.icl
new file mode 100644
index 0000000..ed90380
--- /dev/null
+++ b/frontend/hashtable.icl
@@ -0,0 +1,99 @@
+implementation module hashtable
+
+import predef, syntax, StdCompare, compare_constructor
+
+
+::	HashTableEntry	= HTE_Ident !String !SymbolPtr !IdentClass !HashTableEntry !HashTableEntry
+					| HTE_Empty 
+
+::	HashTable =
+	{	hte_symbol_heap	:: !.SymbolTable
+	,	hte_entries		:: !.{! .HashTableEntry}
+	}
+
+::	IdentClass	= IC_Expression
+				| IC_Type
+				| IC_TypeAttr
+				| IC_Class
+				| IC_Module
+				| IC_Field !Ident
+				| IC_Selector
+				| IC_Instance ![Type]
+				| IC_Unknown
+
+newHashTable :: *HashTable
+newHashTable = { hte_symbol_heap = newHeap, hte_entries = {  HTE_Empty \\ i <- [0 .. dec cHashTableSize] }}
+
+instance =< IdentClass
+where
+	(=<) (IC_Instance types1) (IC_Instance types2)
+		= compare_types types1 types2
+	where
+		compare_types [t1 : t1s] [t2 : t2s]
+			# cmp = t1 =< t2
+			| cmp == Equal
+				= t1s =< t2s
+				= cmp
+		compare_types [] []
+			= Equal
+		compare_types [] _
+			= Smaller
+		compare_types _ []
+			= Greater
+	(=<) (IC_Field typ_id1) (IC_Field typ_id2)
+		= typ_id1 =< typ_id2
+	(=<) ic1 ic2
+		| equal_constructor ic1 ic2
+			= Equal
+		| less_constructor ic1 ic2
+			= Smaller
+			= Greater
+
+instance =< (!a,!b) |  =< a &  =< b
+where
+	(=<) (x1,y1) (x2,y2)
+		# cmp = x1 =< x2
+		| cmp == Equal
+			= y1 =< y2
+			= cmp
+
+cHashTableSize	:==	1023
+
+hashValue :: !String -> Int
+hashValue name
+	# hash_val = hash_value name (size name) 0 mod cHashTableSize
+	| hash_val < 0
+		= hash_val + cHashTableSize
+		= hash_val
+where
+	hash_value :: !String !Int !Int -> Int
+	hash_value name index val
+		| index == 0
+			= val
+		# index = dec index
+		  char = name.[index]
+		= hash_value name index (val << 2 + toInt char)
+
+putIdentInHashTable :: !String !IdentClass !*HashTable -> (!Ident, !*HashTable)
+putIdentInHashTable name indent_class {hte_symbol_heap,hte_entries}
+	# hash_val = hashValue name
+	  (entries,hte_entries) = replace hte_entries hash_val HTE_Empty
+	  (ident, hte_symbol_heap, entries) = insert name indent_class hte_symbol_heap entries
+	  (_,hte_entries) = replace hte_entries hash_val entries
+	= (ident, { hte_symbol_heap = hte_symbol_heap, hte_entries = hte_entries })
+
+where
+	insert ::  !String !IdentClass !*SymbolTable *HashTableEntry -> (!Ident, !*SymbolTable, !*HashTableEntry)
+	insert name indent_class hte_symbol_heap HTE_Empty
+		# (hte_symbol_ptr, hte_symbol_heap) = newPtr EmptySymbolTableEntry hte_symbol_heap
+		= ({ id_name = name, id_info = hte_symbol_ptr}, hte_symbol_heap, HTE_Ident name hte_symbol_ptr indent_class HTE_Empty HTE_Empty)
+	insert name indent_class hte_symbol_heap (HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right)
+		# cmp = (name,indent_class) =< (hte_name,hte_class)
+		| cmp == Equal
+			= ({ id_name = hte_name, id_info = hte_symbol_ptr}, hte_symbol_heap, HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right)
+		| cmp == Smaller
+			#! (ident, hte_symbol_heap, hte_left) = insert name indent_class hte_symbol_heap hte_left
+			= (ident, hte_symbol_heap, HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right)
+			#! (ident, hte_symbol_heap, hte_right) = insert name indent_class hte_symbol_heap hte_right
+			= (ident, hte_symbol_heap, HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right)
+
diff --git a/frontend/main.icl b/frontend/main.icl
new file mode 100644
index 0000000..c4532a3
--- /dev/null
+++ b/frontend/main.icl
@@ -0,0 +1,323 @@
+module main
+
+import scanner, parse, postparse, check, type, trans, convertcases, utilities, convertDynamics
+
+import StdEnv
+
+Start world
+	# (std_io, world) = stdio world
+	  (_, ms_out, world) = fopen "out" FWriteText world
+	  (ms_out,world) = accFiles (
+	  		\files -> 
+				(let
+				    (ms_paths, ms_files, ms_error) = converFileToListOfStrings "mainPrefs" files stderr
+					ms = CommandLoop No { ms_io = std_io, ms_out = ms_out, ms_error = ms_error, ms_files = ms_files, ms_paths = ms_paths }
+				in
+					(ms.ms_out, ms.ms_files))) world
+	= fclose ms_out world
+
+CommandLoop proj ms=:{ms_io}
+	# (answer, ms_io)		= freadline (ms_io <<< "> ")
+	  (command, argument)	= SplitAtLayoutChar (dropWhile isSpace (fromString answer))
+	| command == []
+		= CommandLoop proj { ms & ms_io = ms_io}
+		# (ready, proj, ms) = DoCommand command argument proj { ms & ms_io = ms_io}
+		| ready
+			= ms
+			= CommandLoop proj ms
+
+::	MainStateDefs funs funtypes types conses classes instances members selectors =
+	{	msd_funs		:: !funs
+	,	msd_funtypes	:: !funtypes
+	,	msd_types		:: !types
+	,	msd_conses		:: !conses
+	,	msd_classes		:: !classes
+	,	msd_instances	:: !instances
+	,	msd_members		:: !members
+	,	msd_selectors	:: !selectors
+	,	msd_genfuns		:: ![FunDef]
+	}
+	
+
+::	*MainState funs funtypes types conses classes instances members selectors =
+	{	ms_io			:: !*File
+	,	ms_error		:: !*File
+	,	ms_out			:: !*File
+	,	ms_paths		:: !SearchPaths
+	,	ms_files		:: !*Files
+	}	
+
+::	ModuleTree = ModuleNode !InterMod !ModuleTree !ModuleTree | NoModules
+
+containsModule name (ModuleNode {inter_name = {id_name}} left right)
+	# cmp = id_name =< name
+	| cmp == Equal
+		= True
+	| cmp == Smaller
+		= containsModule name right
+		= containsModule name left
+containsModule name NoModules
+	= False
+
+addModule name mod tree=:(ModuleNode this_mod=:{inter_name = {id_name}} left right)
+	# cmp = id_name =< name
+	| cmp == Equal
+		= tree
+	| cmp == Smaller
+		= ModuleNode this_mod left (addModule name mod right)
+		= ModuleNode this_mod (addModule name mod left) right
+addModule _ mod NoModules
+	= ModuleNode mod NoModules NoModules
+
+::	Project =
+	{	proj_main_module	:: !Ident
+	,	proj_hash_table		:: !.HashTable
+	,	proj_predef_symbols	:: !.PredefinedSymbols
+	,	proj_modules		:: !ModuleTree
+	}
+
+::	InterMod =
+	{	inter_name					:: Ident
+	,	inter_modules				:: !{# Ident}
+	,	inter_fun_defs				:: !{# FunDef}
+	,	inter_icl_dcl_conversions	:: !Optional {# Index}
+	,	inter_dcl_icl_conversions	:: !Optional {# Index}
+	}
+
+
+DoCommand ['c':_] argument proj ms 
+	# (file_name, rest_input) = SplitAtLayoutChar (dropWhile isSpace argument)
+	  (opt_mod, ms) = compileModule (toString file_name) ms
+	= (False, proj, ms)
+DoCommand ['s':_] argument proj ms=:{ms_io, ms_files} 
+	# (file_name, rest_input)	= SplitAtLayoutChar (dropWhile isSpace argument)
+	  file_name 				= toString (file_name++['.icl'])
+	  (ok,file,files)			= fopen file_name FReadText ms_files
+	  (lines,file)				= freadlines file
+	  (ok,files)				= fclose file files
+	= (False, proj, {ms & ms_io = ms_io <<< ("file "+++file_name+++" "+++toString (length lines)+++" lines\n") <<< lines <<< "\n", ms_files = files})
+DoCommand ['t':_] argument proj ms=:{ms_files, ms_io}
+	# (file_names, ms_files, ms_io) = converFileToListOfStrings "testfiles" ms_files ms_io
+	= (False, proj, foldSt check_module file_names { ms & ms_files = ms_files, ms_io = ms_io })
+where
+	check_module file_name ms
+  		# (opt_mod, ms) = compileModule file_name (ms ---> file_name)
+		= case opt_mod of
+			No
+				-> { ms & ms_io = ms.ms_io <<< file_name <<< " is not OK\n" }
+			_
+				-> ms
+DoCommand ['p':_] argument proj ms=:{ms_io, ms_files}
+	# (file_name, rest_input)		= SplitAtLayoutChar (dropWhile isSpace argument)
+	  (predef_symbols, hash_table) 	= buildPredefinedSymbols newHashTable
+	  (mod_ident, hash_table) 		= putIdentInHashTable (toString file_name) IC_Module hash_table
+	= (False, Yes { proj_main_module = mod_ident, proj_hash_table = hash_table, proj_predef_symbols = predef_symbols, proj_modules = NoModules }, ms)
+DoCommand ['q':_] argument proj ms
+	= (True, proj, ms)
+DoCommand ['h':_] argument proj  ms=:{ms_io}
+	= (False, proj, {ms & ms_io = ms_io <<< "No help available. Sorry.\n"})
+DoCommand command argument proj  ms=:{ms_io}
+	= (False, proj, {ms & ms_io = ms_io <<< toString command <<< "?\n"})
+
+freadlines file
+    |   sfend file
+        =   ([],file)
+	    #   (line, file)    = freadline file
+   		#   (lines,file)    = freadlines file
+        =   ([line:lines],file)
+
+SplitAtLayoutChar [] = ([], [])
+SplitAtLayoutChar [x:xs]
+	| x == ' ' || x == '\t' || x == '\n'
+		= ([], xs)
+	| otherwise
+		= ([x:word], rest_input)
+where
+	(word, rest_input) = SplitAtLayoutChar xs
+
+compileModule mod_name ms
+	# (predef_symbols, hash_table) = buildPredefinedSymbols newHashTable
+	  (mod_ident, hash_table) = putIdentInHashTable mod_name IC_Module hash_table
+	  (opt_module, predef_symbols, hash_table, ms) = loadModule mod_ident predef_symbols hash_table ms
+	= (opt_module, ms)
+
+loadModule mod_ident predef_symbols hash_table ms=:{ms_files,ms_error,ms_io,ms_out,ms_paths}
+	# (ok, mod, hash_table, ms_error, predef_symbols, ms_files)
+		= wantModule cWantIclFile mod_ident (hash_table ---> "Parsing") ms_error ms_paths predef_symbols ms_files
+	| not ok
+		= (No,  predef_symbols, hash_table, { ms & ms_files = ms_files, ms_io = ms_io, ms_error = ms_error })
+	# (ok, mod, nr_of_global_funs, mod_functions, dcl_mod, predef_mod, modules, hash_table, ms_error, predef_symbols, ms_files)
+		= scanModule (mod ---> "Scanning") hash_table ms_error ms_paths predef_symbols ms_files
+	| not ok
+		= (No,  predef_symbols, hash_table, { ms & ms_files = ms_files, ms_io = ms_io, ms_error = ms_error })
+  	# symbol_table = hash_table.hte_symbol_heap
+  	  (ok, icl_mod, dcl_mods, components, dcl_icl_conversions, heaps, predef_symbols, symbol_table, ms_error)
+  	  	= checkModule mod nr_of_global_funs mod_functions dcl_mod predef_mod modules predef_symbols (symbol_table ---> "Checking") ms_error
+	| not ok
+		= (No,  predef_symbols, { hash_table & hte_symbol_heap = symbol_table}, { ms & ms_files = ms_files, ms_error = ms_error, ms_io = ms_io })
+	# {icl_functions,icl_instances,icl_specials,icl_common,icl_declared={dcls_import}} = icl_mod
+//	  (components, icl_functions, ms_error) = showComponents components 0 True icl_functions ms_error
+	  (ok, fun_defs, array_instances, type_code_instances, common_defs, imported_funs, heaps, predef_symbols, ms_error)
+		= typeProgram (components ---> "Typing") icl_functions icl_specials icl_common dcls_import dcl_mods heaps predef_symbols ms_error
+	| not ok
+		= (No,  predef_symbols, { hash_table & hte_symbol_heap = symbol_table}, { ms & ms_files = ms_files, ms_error = ms_error, ms_io = ms_io, ms_out = ms_out })
+
+	# (components, fun_defs) = partitionateFunctions (fun_defs ---> "partitionateFunctions") [ { ir_from = 0, ir_to = nr_of_global_funs }, icl_instances, icl_specials]
+	  (components, fun_defs, ms_io) = showTypes components 0 fun_defs ms_io
+//	  (components, fun_defs, ms_out) = showComponents components 0 True fun_defs ms_out
+	  (acc_args, components, fun_defs, var_heap) = analyseGroups (components ---> "Transform") fun_defs heaps.hp_var_heap
+	  (components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
+	  		= transformGroups components fun_defs acc_args common_defs imported_funs var_heap heaps.hp_type_heaps heaps.hp_expression_heap
+//	  (components, fun_defs, ms_error) = showComponents components 0 True fun_defs ms_error
+	  (dcl_types, used_conses, var_heap, type_heaps) = convertIclModule common_defs dcl_types used_conses var_heap type_heaps
+	  (dcl_types, used_conses, var_heap, type_heaps) = convertDclModule dcl_mods common_defs dcl_types used_conses var_heap type_heaps
+	  (components, fun_defs, predef_symbols, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
+	  		= convertDynamicPatternsIntoUnifyAppls type_code_instances common_defs (components ---> "convertDynamics") fun_defs predef_symbols
+					dcl_types used_conses var_heap type_heaps expression_heap
+	  (components, fun_defs, ms_out) = showComponents components 0 True fun_defs ms_out
+	  (used_funs, components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
+	  		= convertCasesOfFunctionsIntoPatterns components imported_funs common_defs fun_defs dcl_types used_conses var_heap type_heaps expression_heap
+	  (dcl_types, var_heap, type_heaps)
+			= convertImportedTypeSpecifications dcl_mods imported_funs common_defs used_conses used_funs dcl_types type_heaps var_heap		
+//	  (components, fun_defs, ms_out) = showComponents components 0 False fun_defs ms_out
+	= (Yes (buildInterMod mod_ident dcl_mods fun_defs dcl_icl_conversions),  predef_symbols,
+		{ hash_table & hte_symbol_heap = symbol_table}, { ms & ms_files = ms_files, ms_error = ms_error, ms_io = ms_io, ms_out = ms_out })
+
+
+makeProject (Yes proj=:{proj_main_module,proj_hash_table,proj_predef_symbols}) ms
+	# (main_mod, proj_predef_symbols, proj_hash_table, ms) = loadModule proj_main_module proj_predef_symbols proj_hash_table ms
+	  proj = { proj & proj_hash_table = proj_hash_table, proj_predef_symbols = proj_predef_symbols }
+	= case main_mod of
+		Yes main_mod=:{inter_modules}
+			# (proj_modules, ms) = collect_modules [ mod \\ mod <-: inter_modules ] (ModuleNode main_mod NoModules NoModules) ms
+			-> (Yes { proj & proj_modules = proj_modules }, ms)
+		_
+			-> (Yes proj, ms)
+where
+	collect_modules [{id_name} : modules] collected_modules ms
+		| containsModule id_name collected_modules
+			= collect_modules modules collected_modules ms
+			# (this_mod, ms) = compileModule id_name ms
+			= case this_mod of
+				Yes new_mod
+					-> collect_modules (modules ++ [ mod \\ mod <-: new_mod.inter_modules ]) (addModule id_name new_mod collected_modules) ms
+				_
+					-> (NoModules, ms)
+	collect_modules [{id_name} : modules] collected_modules ms
+		= (collected_modules, ms)
+
+buildInterMod name dcl_modules fun_defs dcl_icl_conversions
+	=	{	inter_name					= name
+		,	inter_modules				= { dcl_name \\ {dcl_name} <-: dcl_modules }
+		,	inter_fun_defs				= fun_defs
+		,	inter_icl_dcl_conversions	= build_icl_dcl_conversions (size fun_defs) dcl_icl_conversions
+		,	inter_dcl_icl_conversions	= dcl_icl_conversions
+		}
+where
+	build_icl_dcl_conversions table_size (Yes conversion_table)
+		# dcl_table_size = size conversion_table
+		  icl_dcl_conversions = update_conversion_array 0 dcl_table_size conversion_table (createArray table_size NoIndex)
+		= Yes (fill_empty_positions 0 table_size dcl_table_size icl_dcl_conversions)
+	build_icl_dcl_conversions table_size No
+		= No
+		
+	update_conversion_array	dcl_index dcl_table_size conversion_table icl_conversions
+		| dcl_index < dcl_table_size
+			#  icl_index = conversion_table.[dcl_index]
+			= update_conversion_array (inc dcl_index) dcl_table_size conversion_table
+					{ icl_conversions & [icl_index] = dcl_index }
+			= icl_conversions
+
+	fill_empty_positions next_index table_size next_new_index icl_conversions
+		| next_index < table_size
+			| icl_conversions.[next_index] == NoIndex
+				= fill_empty_positions (inc next_index) table_size (inc next_new_index) { icl_conversions & [next_index] = next_new_index }
+				= fill_empty_positions (inc next_index) table_size next_new_index icl_conversions
+			= icl_conversions
+			
+showComponents :: !*{! Group} !Int !Bool !*{# FunDef} !*File  -> (!*{! Group}, !*{# FunDef},!*File)
+showComponents comps comp_index show_types fun_defs file
+	| comp_index >= size comps
+		= (comps, fun_defs, file)
+		# (comp, comps) = comps![comp_index]
+		# (fun_defs, file) = show_component comp.group_members show_types fun_defs (file <<< "component " <<< comp_index <<< '\n')
+		= showComponents comps (inc comp_index) show_types fun_defs file
+where
+	show_component [] show_types fun_defs file
+		= (fun_defs, file <<< '\n')
+	show_component [fun:funs] show_types fun_defs file
+		#! fun_def = fun_defs.[fun]
+		| show_types
+			= show_component funs show_types fun_defs (file <<< '\n' <<< fun_def)
+			= show_component funs show_types fun_defs (file <<< fun_def)
+//		= show_component funs show_types fun_defs (file <<< fun_def.fun_symb)
+
+instance <<< Optional a | <<< a
+where
+	(<<<) file (Yes x)	= file <<< x
+	(<<<) file No		= file
+	
+showComponents2 :: !{! Group} !Int !*{# FunDef} !{! ConsClasses} !*File  -> (!*{# FunDef},!*File)
+showComponents2 comps comp_index fun_defs acc_args file
+	| comp_index >= (size comps)
+		= (fun_defs, file)
+	# (fun_defs, file) = show_component comps.[comp_index].group_members fun_defs acc_args file
+	= showComponents2 comps (inc comp_index) fun_defs acc_args file
+where
+	show_component [] fun_defs _ file
+		= (fun_defs, file <<< '\n')
+	show_component [fun:funs] fun_defs acc_args file
+		#! fd = fun_defs.[fun]
+		# file = show_accumulating_arguments acc_args.[fun].cc_args (file <<< fd.fun_symb <<< '.' <<< fun <<< " (")
+		= show_component funs fun_defs acc_args (file <<< ") ")
+	
+	show_accumulating_arguments [ cc : ccs] file
+		| cc == cPassive
+			= show_accumulating_arguments ccs (file <<< 'p')
+		| cc == cActive
+			= show_accumulating_arguments ccs (file <<< 'c')
+		| cc == cAccumulating
+			= show_accumulating_arguments ccs (file <<< 'a')
+			= show_accumulating_arguments ccs (file <<< '?')
+	show_accumulating_arguments [] file
+		= file
+
+
+show_components comps fun_defs = map (show_component fun_defs) comps
+
+show_component fun_defs [] = []
+show_component fun_defs [fun:funs] = [fun_defs.[fun ---> fun] : show_component fun_defs funs]
+
+showTypes :: !*{! Group} !Int !*{# FunDef} !*File  -> (!*{! Group}, !*{# FunDef},!*File)
+showTypes comps comp_index fun_defs file
+	| comp_index >= size comps
+		= (comps, fun_defs, file)
+		# (comp, comps) = comps![comp_index]
+		# (fun_defs, file) = show_types comp.group_members fun_defs (file <<< "component " <<< comp_index <<< '\n')
+		= showTypes comps (inc comp_index) fun_defs file
+where
+	show_types [] fun_defs file
+		= (fun_defs, file <<< '\n')
+	show_types [fun:funs] fun_defs file
+		#! fun_def = fun_defs.[fun]
+		= show_types funs fun_defs (file <<< '\n' <<< fun_def.fun_type)
+
+converFileToListOfStrings file_name files error
+	# (ok, file, files) = fopen file_name FReadText files
+	| ok
+		# (lines, file) = read_lines file
+		= (lines, snd (fclose file files), error)
+		= ([], files, error <<< "Could not open \"" <<< file_name <<< "\"\n")
+where
+	read_lines file
+		# (line, file) = freadline file
+		  last_char_index = size line - 1
+		| last_char_index < 0
+			= ([], file)
+		| line.[last_char_index] == '\n'
+			| last_char_index == 0 || line.[0] == '|'
+				= read_lines file
+				# (lines, file) = read_lines file
+				= ([line % (0, last_char_index - 1) : lines ], file)
+		// otherwise
+			= ([line], file)
diff --git a/frontend/overloading.dcl b/frontend/overloading.dcl
new file mode 100644
index 0000000..2b1accb
--- /dev/null
+++ b/frontend/overloading.dcl
@@ -0,0 +1,52 @@
+definition module overloading
+
+import StdEnv
+import syntax, check
+
+::	InstanceTree = IT_Node !(Global Index) !InstanceTree !InstanceTree | IT_Empty 
+
+::	ClassInstanceInfo :== {# {! .InstanceTree}}
+
+::	ArrayInstance =
+	{	ai_record		:: !TypeSymbIdent
+	,	ai_members		:: !{# DefinedSymbol}
+	}
+
+::	GlobalTCInstance =
+	{	gtci_type		:: !GlobalTCType
+	,	gtci_index		:: !Index
+	}
+
+::	SpecialInstances =
+	{	si_next_array_member_index			:: !Index
+	,	si_array_instances					:: ![ArrayInstance]
+	,	si_next_TC_member_index				:: !Index
+	,	si_TC_instances						:: ![GlobalTCInstance]
+	}
+	
+::	OverloadingState =
+	{	os_type_heaps			:: !.TypeHeaps
+	,	os_var_heap				:: !.VarHeap
+	,	os_symbol_heap			:: !.ExpressionHeap
+	,	os_predef_symbols		:: !.PredefinedSymbols
+	,	os_special_instances	:: !.SpecialInstances
+	,	os_error				:: !.ErrorAdmin				
+	}
+
+::	LocalTypePatternVariable
+
+tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos)] !{# CommonDefs } !ClassInstanceInfo !*Coercions !*OverloadingState
+	-> (![TypeContext], !*Coercions, ![LocalTypePatternVariable], !*OverloadingState)
+
+::	TypeCodeInfo =
+	{	tci_next_index			:: !Index
+	,	tci_instances			:: ![GlobalTCInstance]
+	,	tci_type_var_heap		:: !.TypeVarHeap
+	}
+
+removeOverloadedFunctions :: ![Int] ![(Optional [TypeContext], IdentPos)] ![TypeContext] ![LocalTypePatternVariable] !*{#FunDef} !*ExpressionHeap
+	!*TypeCodeInfo !*VarHeap !*ErrorAdmin
+		-> (!*{#FunDef}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin)
+
+updateDynamics :: ![Int] ![TypeContext] ![LocalTypePatternVariable] !*{#FunDef} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin
+	-> (!*{#FunDef}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin)
diff --git a/frontend/overloading.icl b/frontend/overloading.icl
new file mode 100644
index 0000000..ec2973a
--- /dev/null
+++ b/frontend/overloading.icl
@@ -0,0 +1,1201 @@
+implementation module overloading
+
+import StdEnv
+
+import syntax, check, type, typesupport, utilities, unitype, predef, RWSDebug
+
+
+::	InstanceTree = IT_Node !(Global Index) !InstanceTree !InstanceTree | IT_Empty 
+
+::	ClassInstanceInfo :== {# {! .InstanceTree}}
+
+::	ReducedContext = 
+	{	rc_class			:: !Global DefinedSymbol
+	,	rc_types			:: ![Type]
+	,	rc_inst_module		:: !Index
+	,	rc_inst_members		:: !{# DefinedSymbol}
+	,	rc_red_contexts		:: ![ClassApplication]
+	}
+
+::	ReducedContexts = 
+	{	rcs_class_context			:: !ReducedContext
+	,	rcs_constraints_contexts	:: ![ReducedContexts]
+	}
+
+::	TypeCodeInstance =
+	{	tci_index			:: !Index
+	,	tci_contexts		:: ![ClassApplication]
+	}
+
+
+::	ClassApplication	= CA_Instance !ReducedContexts
+						| CA_Context !TypeContext
+						| CA_LocalTypeCode !VarInfoPtr			/* for (local) type pattern variables */
+						| CA_GlobalTypeCode !TypeCodeInstance	/* for (global) type constructors */
+
+
+::	ArrayInstance =
+	{	ai_record		:: !TypeSymbIdent
+	,	ai_members		:: !{# DefinedSymbol}
+	}
+
+::	GlobalTCInstance =
+	{	gtci_type		:: !GlobalTCType
+	,	gtci_index		:: !Index
+	}
+
+::	SpecialInstances =
+	{	si_next_array_member_index			:: !Index
+	,	si_array_instances					:: ![ArrayInstance]
+	,	si_next_TC_member_index				:: !Index
+	,	si_TC_instances						:: ![GlobalTCInstance]
+	}
+	
+::	LocalTypePatternVariable =
+	{	ltpv_var			:: !Int
+	,	ltpv_new_var		:: !VarInfoPtr
+	}
+
+::	LocalTypePatternVariables =
+	{	ltp_var_heap			:: !.VarHeap
+	,	ltp_variables			:: ![LocalTypePatternVariable]
+	}
+
+::	OverloadingState =
+	{	os_type_heaps			:: !.TypeHeaps
+	,	os_var_heap				:: !.VarHeap
+	,	os_symbol_heap			:: !.ExpressionHeap
+	,	os_predef_symbols		:: !.PredefinedSymbols
+	,	os_special_instances	:: !.SpecialInstances
+	,	os_error				:: !.ErrorAdmin				
+	}
+
+instance =< TypeSymbIdent
+where	
+	(=<) {type_index={glob_module=mod1,glob_object=index1}} {type_index={glob_module=mod2,glob_object=index2}}
+		# cmp = mod1 =< mod2
+		| cmp == Equal
+			= index1 =< index2
+			= cmp
+
+instance =< GlobalTCType
+where	
+	(=<) globtype1 globtype2
+		| equal_constructor globtype1 globtype2
+			= compare_types  globtype1 globtype2
+		| less_constructor globtype1 globtype2
+			= Smaller
+			= Greater
+	where
+		compare_types (GTT_Basic bt1) (GTT_Basic bt2)
+			= bt1 =< bt2
+		compare_types (GTT_Constructor cons1) (GTT_Constructor cons2) 
+			= cons1 =< cons2
+		compare_types _ _
+			= Equal
+		
+		
+instanceError symbol types err=:{ea_file,ea_loc}
+	# ea_file = ea_file <<< "Overloading error " <<< hd ea_loc <<< ": \"" <<< symbol <<< "\" no instance available of type " <<< types <<< '\n'
+	= { err & ea_file = ea_file, ea_ok = False}
+
+contextError err=:{ea_file,ea_loc}
+	# ea_file = ea_file <<< "Overloading Error " <<< hd ea_loc <<< ": specified context is too general\n"
+	= { err & ea_file = ea_file, ea_ok = False}
+
+uniqueError symbol types err=:{ea_file, ea_loc}
+	# ea_file = ea_file <<< "Overloading/Uniqueness Error " <<< hd ea_loc <<< ": \"" <<< symbol <<< "\" uniqueness specification of instance conflicts with current application " <<< types <<< '\n'
+	= { err & ea_file = ea_file, ea_ok = False}
+
+unboxError type err=:{ea_file,ea_loc}
+	# ea_file = ea_file <<< "Overloading error "  <<< hd ea_loc <<< ": instance cannot be unboxed" <<< type <<< '\n'
+	= { err & ea_file = ea_file, ea_ok = False}
+
+get :: !a !(Env a b) -> b | == a 
+get elem_id [] 
+		= abort "illegal access"
+get elem_id [b : bs]
+	| elem_id == b.bind_src
+		= b.bind_dst
+		= get elem_id bs
+
+/*
+	As soon as all overloaded variables in an type context are instantiated, context reduction is carried out.
+	This reduction yields a type class instance (here represented by a an index) and a list of
+	ClassApplications.
+*/
+
+simpleSubstitution type type_heaps
+	= substitute type type_heaps
+
+FoundObject object :== object.glob_module <> NotFound
+ObjectNotFound 	:== { glob_module = NotFound, glob_object = NotFound }
+
+
+reduceContexts :: ![TypeContext] !{# CommonDefs} !ClassInstanceInfo !*SpecialInstances !*LocalTypePatternVariables
+	!*TypeHeaps !*Coercions !*PredefinedSymbols !*ErrorAdmin
+		-> *(![ClassApplication], !*SpecialInstances, !*LocalTypePatternVariables, !*TypeHeaps, !*Coercions, !*PredefinedSymbols, !*ErrorAdmin)
+reduceContexts [] defs instance_info special_instances type_pattern_vars type_heaps coercion_env predef_symbols error
+	= ([], special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+reduceContexts [tc : tcs] defs instance_info special_instances type_pattern_vars type_heaps coercion_env predef_symbols error
+	# (appl, special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+			= try_to_reduce_context tc defs instance_info special_instances type_pattern_vars type_heaps coercion_env predef_symbols error
+	  (appls, special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+	  		= reduceContexts tcs defs instance_info special_instances type_pattern_vars type_heaps coercion_env predef_symbols error
+	= ([appl : appls], special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+
+where		
+	try_to_reduce_context :: !TypeContext !{# CommonDefs} !ClassInstanceInfo  !*SpecialInstances !*LocalTypePatternVariables
+		!*TypeHeaps !*Coercions !*PredefinedSymbols !*ErrorAdmin
+			-> *(!ClassApplication, !*SpecialInstances, !*LocalTypePatternVariables, !*TypeHeaps, !*Coercions, !*PredefinedSymbols, !*ErrorAdmin)
+	try_to_reduce_context tc=:{tc_class=class_symb=:{glob_object={ds_index},glob_module},tc_types} defs instance_info
+			special_instances type_pattern_vars type_heaps coercion_env predef_symbols error
+		| is_reducible tc_types
+			| is_predefined_symbol glob_module ds_index PD_TypeCodeClass predef_symbols
+				# (red_context, (special_instances, type_pattern_vars)) = reduce_TC_context class_symb (hd tc_types) special_instances type_pattern_vars
+				= (red_context, special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+				# (class_appls, special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+						= reduceContext tc defs instance_info special_instances type_pattern_vars
+								type_heaps coercion_env predef_symbols error
+				= (CA_Instance class_appls, special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+			= (CA_Context tc, special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+
+/*	reduceContext :: !ClassDef !InstanceTree ![Type] !{# CommonDefs} !ClassInstanceInfo !*SpecialInstances !*LocalTypePatternVariables
+			!*TypeHeaps !*Coercions !*PredefinedSymbols !*ErrorAdmin
+				-> *(![ReducedContext], !*SpecialInstances, !*LocalTypePatternVariables, !*TypeHeaps, !*Coercions, !*PredefinedSymbols, !*ErrorAdmin)
+*/
+	reduceContext {tc_class=class_symb=:{glob_object={ds_index},glob_module},tc_types} defs
+						instance_info special_instances type_pattern_vars type_heaps coercion_env predef_symbols error
+		# {class_members,class_context,class_args,class_name} = defs.[glob_module].com_class_defs.[ds_index]
+		| size class_members > 0
+			# class_instances = instance_info.[glob_module].[ds_index]
+			# ({glob_module,glob_object}, contexts, uni_ok, type_heaps, coercion_env) = find_instance tc_types class_instances defs type_heaps coercion_env
+			| (glob_module <> NotFound) && uni_ok
+				# {ins_members, ins_class} = defs.[glob_module].com_instance_defs.[glob_object]
+				| is_predefined_symbol ins_class.glob_module ins_class.glob_object.ds_index PD_ArrayClass predef_symbols &&
+				  is_unboxed_array tc_types predef_symbols
+					# (rcs_class_context, special_instances, predef_symbols, error)
+							= check_unboxed_type glob_module ins_class ins_members tc_types class_members defs special_instances predef_symbols error
+					= ({ rcs_class_context = rcs_class_context, rcs_constraints_contexts = []},
+									special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+					# (appls, special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+							= reduceContexts contexts defs instance_info special_instances type_pattern_vars type_heaps coercion_env predef_symbols error
+					  (constraints, special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+					  		= reduceContextsInConstraints tc_types class_args class_context defs instance_info special_instances type_pattern_vars
+					  				type_heaps coercion_env predef_symbols error
+
+					= ({ rcs_class_context = { rc_class = ins_class, rc_inst_module = glob_module, rc_inst_members = ins_members,
+								rc_types = tc_types, rc_red_contexts = appls }, rcs_constraints_contexts = constraints },
+							special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+				# rcs_class_context = { rc_class = class_symb, rc_inst_module = NoIndex, rc_inst_members = {}, rc_types = tc_types, rc_red_contexts = [] }
+				| glob_module <> NotFound
+					= ({ rcs_class_context = rcs_class_context, rcs_constraints_contexts = []},
+							special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, uniqueError class_name tc_types error)
+					= ({ rcs_class_context = rcs_class_context, rcs_constraints_contexts = []},
+							special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, instanceError class_name tc_types error)
+			# (constraints, special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+				= reduceContextsInConstraints tc_types class_args class_context defs instance_info special_instances type_pattern_vars
+					type_heaps coercion_env predef_symbols error
+			= ({ rcs_class_context = { rc_class = class_symb, rc_inst_module = NoIndex, rc_inst_members = {}, rc_types = tc_types, rc_red_contexts = [] },
+				rcs_constraints_contexts = constraints },  special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+
+	reduceContextsInConstraints types class_args [] defs instance_info special_instances type_pattern_vars type_heaps coercion_env predef_symbols error
+		= ([], special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+	reduceContextsInConstraints types class_args class_context defs instance_info special_instances type_pattern_vars
+			type_heaps=:{th_vars} coercion_env predef_symbols error
+		# th_vars = fold2St (\ type {tv_info_ptr} -> writePtr tv_info_ptr (TVI_Type type)) types class_args th_vars
+		  (instantiated_context, type_heaps) = substitute class_context { type_heaps & th_vars = th_vars }
+		# (cappls, (special_instances, type_pattern_vars, type_var_heap, coercion_env, predef_symbols, error))
+		  		= mapSt (reduce_context_in_constraint defs instance_info) instantiated_context
+		  				(special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+		= (cappls, special_instances, type_pattern_vars, type_var_heap, coercion_env, predef_symbols, error)
+
+	where
+		reduce_context_in_constraint defs instance_info tc (special_instances, type_pattern_vars, type_heaps, coercion_env, predef_symbols, error)
+		  	# (cappls, special_instances, type_pattern_vars, type_var_heap, coercion_env, predef_symbols, error)
+				= reduceContext tc defs instance_info special_instances
+			  			type_pattern_vars type_heaps coercion_env predef_symbols error
+			= (cappls, (special_instances, type_pattern_vars, type_var_heap, coercion_env, predef_symbols, error))
+
+	find_instance co_types (IT_Node this_inst_index=:{glob_object,glob_module} left right) defs type_heaps coercion_env
+		# (left_index, types, uni_ok, type_heaps, coercion_env) = find_instance co_types left defs type_heaps coercion_env
+		| FoundObject left_index
+			= (left_index, types, uni_ok, type_heaps, coercion_env)
+			# {ins_type={it_types,it_context}, ins_specials} = defs.[glob_module].com_instance_defs.[glob_object]
+			  (matched, type_heaps) = match defs it_types co_types type_heaps
+			| matched
+				# (subst_context, type_heaps) = simpleSubstitution it_context type_heaps
+				  (uni_ok, coercion_env, type_heaps) = adjust_type_attributes defs co_types it_types coercion_env type_heaps
+				  (spec_inst, type_heaps) = trySpecializedInstances subst_context (get_specials ins_specials) type_heaps
+				| FoundObject spec_inst
+					= (spec_inst, [], uni_ok, type_heaps, coercion_env)
+					= (this_inst_index, subst_context, uni_ok, type_heaps, coercion_env)
+				= find_instance co_types right defs type_heaps coercion_env
+	find_instance co_types IT_Empty defs type_heaps coercion_env
+		= (ObjectNotFound, [], True, type_heaps, coercion_env)
+	
+	get_specials (SP_ContextTypes specials) = specials
+	get_specials SP_None 					= []
+
+	adjust_type_attributes defs act_types form_types coercion_env type_heaps
+		= fold2St (adjust_type_attribute defs) act_types form_types (True, coercion_env, type_heaps)
+
+	adjust_type_attribute defs (TA type_cons1 cons_args1) (TA type_cons2 cons_args2) (ok, coercion_env, type_heaps)
+		| type_cons1 == type_cons2
+			# (ok, coercion_env) = fold2St adjust_attribute cons_args1 cons_args2 (ok, coercion_env)
+			= (ok, coercion_env, type_heaps)
+			# (_, type1, type_heaps) = tryToExpandTypeSyn defs type_cons1 cons_args1 type_heaps
+			  (_, type2, type_heaps) = tryToExpandTypeSyn defs type_cons2 cons_args2 type_heaps
+			= adjust_type_attribute defs type1 type2 (ok, coercion_env, type_heaps)
+	adjust_type_attribute _ _ _  state
+		= state
+	
+	adjust_attribute {at_attribute} {at_attribute = TA_Var _} state
+		= state
+	adjust_attribute {at_attribute} {at_attribute = TA_Unique} (ok, coercion_env)
+		= case at_attribute of
+			TA_Unique
+				-> (ok, coercion_env)
+			TA_TempVar av_number
+				# (succ, coercion_env) = tryToMakeUnique av_number coercion_env
+				-> (ok && succ, coercion_env)
+			_
+				-> (False, coercion_env)
+	adjust_attribute {at_attribute} attr (ok, coercion_env)
+		= case at_attribute of
+			TA_Multi
+				-> (ok, coercion_env)
+			TA_TempVar av_number
+				# (succ, coercion_env) = tryToMakeNonUnique av_number coercion_env
+				-> (ok && succ, coercion_env)
+			_
+				-> (False, coercion_env)
+	
+	is_reducible []
+		= True
+	is_reducible [TempV _ : types]
+		= False
+	is_reducible [ _ :@: _ : types]
+		= False
+	is_reducible [ _ : types]
+		= is_reducible types
+
+	is_predefined_symbol mod_index symb_index predef_index predef_symbols
+		# {pds_def,pds_module,pds_ident} = predef_symbols.[predef_index]
+		= (mod_index == pds_module && symb_index == pds_def)
+		
+	is_unboxed_array [TA {type_index={glob_module,glob_object},type_arity} _ : _] predef_symbols
+		= is_predefined_symbol glob_module glob_object PD_UnboxedArrayType predef_symbols
+	is_unboxed_array _ predef_symbols
+		= False
+
+
+	check_unboxed_type ins_module ins_class ins_members types=:[ _, elem_type :_] class_members defs special_instances predef_symbols error
+		# (unboxable, opt_record, predef_symbols) = try_to_unbox elem_type defs predef_symbols
+		| unboxable
+			= case opt_record of
+				Yes record
+					# (ins_members, special_instances) = add_record_to_array_instances record class_members special_instances
+					-> ({ rc_class = ins_class, rc_inst_module = cIclModIndex, rc_inst_members = ins_members, rc_red_contexts = [], rc_types = types },
+							special_instances, predef_symbols, error)
+				No
+					-> ({ rc_class = ins_class, rc_inst_module = ins_module, rc_inst_members = ins_members, rc_red_contexts = [], rc_types = types },
+							special_instances, predef_symbols, error)
+			= ({ rc_class = ins_class, rc_inst_module = ins_module, rc_inst_members = ins_members, rc_red_contexts = [], rc_types = types },
+					special_instances, predef_symbols, unboxError elem_type error)
+	where
+		try_to_unbox (TB _) _ predef_symbols
+			= (True, No, predef_symbols)
+		try_to_unbox (TA type_symb=:{type_index={glob_module,glob_object},type_arity} _) defs predef_symbols
+			# {td_arity,td_rhs} = defs.[glob_module].com_type_defs.[glob_object]
+			= case td_rhs of
+				RecordType _
+					-> (True, (Yes type_symb), predef_symbols)
+				AbstractType _
+					#! unboxable =
+						   is_predefined_symbol glob_module glob_object PD_LazyArrayType predef_symbols ||
+						   is_predefined_symbol glob_module glob_object PD_StrictArrayType predef_symbols ||
+						   is_predefined_symbol glob_module glob_object PD_UnboxedArrayType predef_symbols
+					-> (unboxable, No, predef_symbols)
+				_
+					-> (False, No, predef_symbols)
+				
+		try_to_unbox type _ predef_symbols
+			= (True, No, predef_symbols)
+
+		add_record_to_array_instances :: !TypeSymbIdent !{# DefinedSymbol} !*SpecialInstances -> (!{#DefinedSymbol},!*SpecialInstances)
+		add_record_to_array_instances record members special_instances=:{si_next_array_member_index,si_array_instances}
+			# (inst_members, si_array_instances, si_next_array_member_index) = add_array_instance record members si_next_array_member_index si_array_instances
+			= (inst_members, { special_instances & si_array_instances = si_array_instances, si_next_array_member_index = si_next_array_member_index })
+		where
+			add_array_instance :: !TypeSymbIdent !{# DefinedSymbol} !Index !u:[ArrayInstance]
+				-> (!{#DefinedSymbol}, !u:[ArrayInstance], !Index)
+			add_array_instance record members next_member_index instances=:[inst : insts]
+				# cmp = record =< inst.ai_record
+				| cmp == Equal
+					= (inst.ai_members, instances, next_member_index)
+				| cmp == Smaller
+					# ai_members = { { class_member & ds_index = next_inst_index } \\
+								class_member <-: members & next_inst_index <- [next_member_index .. ]}
+					= (ai_members, [{ ai_members = ai_members, ai_record = record } : instances ], next_member_index + size members)
+					# (found_inst, insts, next_member_index) = add_array_instance record members next_member_index insts
+					= (found_inst, [inst : insts], next_member_index)
+			add_array_instance record members next_member_index []
+				# ai_members = { { class_member & ds_index = next_inst_index } \\
+							class_member <-: members & next_inst_index <- [next_member_index .. ]}
+				= (ai_members, [{ ai_members = ai_members, ai_record = record }], next_member_index + size members)
+
+
+	reduce_TC_context type_code_class tc_type special_instances type_pattern_vars
+		= reduce_tc_context type_code_class tc_type (special_instances, type_pattern_vars)
+	where							
+		reduce_tc_context type_code_class (TA cons_id cons_args) (special_instances=:{si_next_TC_member_index, si_TC_instances}, type_pattern_vars)
+			# (inst_index, (si_next_TC_member_index, si_TC_instances))
+			  		= addGlobalTCInstance (GTT_Constructor cons_id) (si_next_TC_member_index, si_TC_instances)
+			  (rc_red_contexts, instances) = reduce_TC_contexts type_code_class cons_args
+			  		 ({ special_instances & si_next_TC_member_index = si_next_TC_member_index, si_TC_instances = si_TC_instances }, type_pattern_vars)
+			= (CA_GlobalTypeCode { tci_index = inst_index, tci_contexts = rc_red_contexts }, instances)
+
+		reduce_tc_context type_code_class (TB basic_type) (special_instances=:{si_next_TC_member_index, si_TC_instances}, type_pattern_vars)
+			# (inst_index, (si_next_TC_member_index, si_TC_instances))
+			  		= addGlobalTCInstance (GTT_Basic basic_type) (si_next_TC_member_index, si_TC_instances)
+			= (CA_GlobalTypeCode { tci_index = inst_index, tci_contexts = [] },
+					({ special_instances & si_next_TC_member_index = si_next_TC_member_index, si_TC_instances = si_TC_instances }, type_pattern_vars))
+
+		reduce_tc_context type_code_class (arg_type --> result_type) (special_instances=:{si_next_TC_member_index, si_TC_instances}, type_pattern_vars)
+			# (inst_index, (si_next_TC_member_index, si_TC_instances))
+			  		= addGlobalTCInstance GTT_Function (si_next_TC_member_index, si_TC_instances)
+			  (rc_red_contexts, instances) = reduce_TC_contexts type_code_class [arg_type, result_type]
+			  		 ({ special_instances & si_next_TC_member_index = si_next_TC_member_index, si_TC_instances = si_TC_instances }, type_pattern_vars)
+			= (CA_GlobalTypeCode { tci_index = inst_index, tci_contexts = rc_red_contexts }, instances)
+
+
+		reduce_tc_context type_code_class (TempQV var_number) (special_instances, type_pattern_vars)
+			# (inst_var, type_pattern_vars) = addLocalTCInstance var_number type_pattern_vars
+			= (CA_LocalTypeCode inst_var, (special_instances, type_pattern_vars))
+
+		reduce_tc_context type_code_class (TempV var_number) instances
+			= (CA_Context { tc_class = type_code_class, tc_types = [TempV var_number], tc_var = nilPtr }, instances)
+		
+
+		reduce_TC_contexts type_code_class cons_args instances
+			= mapSt (\{at_type} -> reduce_tc_context type_code_class at_type) cons_args instances
+		
+addLocalTCInstance var_number ltp=:{ltp_variables=instances=:[inst : insts], ltp_var_heap}
+	# cmp = var_number =< inst.ltpv_var
+	| cmp == Equal
+		= (inst.ltpv_new_var, ltp)
+	| cmp == Smaller
+		# (ltpv_new_var, ltp_var_heap) = newPtr VI_Empty ltp_var_heap
+		= (ltpv_new_var, { ltp_variables = [{ ltpv_new_var = ltpv_new_var, ltpv_var = var_number } : instances ], ltp_var_heap = ltp_var_heap })
+		# (found_var, ltp) = addLocalTCInstance var_number { ltp & ltp_variables = insts }
+		= (found_var, { ltp & ltp_variables = [inst :ltp.ltp_variables ] })
+addLocalTCInstance var_number {ltp_variables = [], ltp_var_heap}
+	# (ltpv_new_var, ltp_var_heap) = newPtr VI_Empty ltp_var_heap
+	= (ltpv_new_var, { ltp_variables = [{ ltpv_new_var = ltpv_new_var, ltpv_var = var_number }], ltp_var_heap = ltp_var_heap })
+
+addGlobalTCInstance type_of_TC (next_member_index, instances=:[inst : insts])
+	# cmp = type_of_TC =< inst.gtci_type
+	| cmp == Equal
+		= (inst.gtci_index, (next_member_index, instances))
+	| cmp == Smaller
+		= (next_member_index, (inc next_member_index, [{ gtci_index = next_member_index, gtci_type = type_of_TC } : instances ]))
+		# (found_inst, (next_member_index, insts)) = addGlobalTCInstance type_of_TC (next_member_index, insts)
+		= (found_inst, (next_member_index, [inst : insts]))
+addGlobalTCInstance type_of_TC (next_member_index, [])
+	= (next_member_index, (inc next_member_index, [{ gtci_index = next_member_index, gtci_type = type_of_TC }]))
+
+tryToExpandTypeSyn defs cons_id=:{type_name,type_index={glob_object,glob_module}} type_args type_heaps
+	# {td_name,td_rhs,td_args} = defs.[glob_module].com_type_defs.[glob_object]
+	| is_synonym_type td_rhs
+		# (SynType {at_type}) = td_rhs
+		  type_heaps = fold2St bind_var td_args type_args type_heaps
+		  (expanded_type, type_heaps) = substitute at_type type_heaps
+		= (True, expanded_type, type_heaps)
+		= (False, TA cons_id type_args, type_heaps)
+where
+	is_synonym_type (SynType _)
+		= True
+	is_synonym_type type_rhs
+		= False
+
+	bind_var {atv_attribute = TA_Var {av_info_ptr}, atv_variable={tv_info_ptr}} {at_attribute, at_type} type_heaps=:{th_vars,th_attrs}
+		= { type_heaps & th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type), th_attrs = th_attrs <:= (av_info_ptr, AVI_Attr at_attribute) }
+	bind_var {atv_variable={tv_info_ptr}} {at_type} type_heaps=:{th_vars}
+		= { type_heaps & th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type) }
+		
+class match type ::  !{# CommonDefs} !type !type !*TypeHeaps -> (!Bool, !*TypeHeaps)
+
+instance match AType
+where
+	match defs atype1 atype2 type_heaps = match defs atype1.at_type atype2.at_type type_heaps
+
+instance match Type
+where 
+	match defs (TV {tv_info_ptr}) type type_heaps=:{th_vars}
+		= (True, { type_heaps & th_vars = th_vars <:= (tv_info_ptr,TVI_Type type)})
+	match defs (TA cons_id1 cons_args1) (TA cons_id2 cons_args2) type_heaps
+		| cons_id1 == cons_id2
+			= match defs cons_args1 cons_args2 type_heaps
+//			# (succ1, type1, type_heaps) = tryToExpandTypeSyn defs cons_id1 cons_args1 type_heaps
+			# (succ2, type2, type_heaps) = tryToExpandTypeSyn defs cons_id2 cons_args2 type_heaps
+			| succ2
+				= case type2 of
+					TA cons_id2 cons_args2
+						| cons_id1 == cons_id2
+							-> match defs cons_args1 cons_args2 type_heaps
+							-> (False, type_heaps)
+					_
+							-> (False, type_heaps)
+				= (False, type_heaps)
+	match defs (arg_type1 --> res_type1) (arg_type2 --> res_type2) type_heaps
+		= match defs (arg_type1,res_type1) (arg_type2,res_type2) type_heaps
+	match defs (type1 :@: types1) (type2 :@: types2) type_heaps
+		= match defs (type1,types1) (type2,types2) type_heaps
+	match defs (CV tv :@: types) (TA type_cons cons_args) type_heaps
+		# diff = type_cons.type_arity - length types
+		| diff >= 0
+			= match defs (TV tv, types) (TA { type_cons & type_arity = diff } (take diff cons_args), drop diff cons_args) type_heaps
+			= (False, type_heaps)
+	match defs (TB tb1) (TB tb2) type_heaps
+		= (tb1 == tb2, type_heaps)
+/*	match defs type (TB (BT_String array_type)) type_heaps
+		= match defs type array_type type_heaps
+*/	match defs (TA cons_id cons_args) type2 type_heaps
+		# (succ, type1, type_heaps) = tryToExpandTypeSyn defs cons_id cons_args type_heaps
+		| succ
+			= match defs type1 type2 type_heaps
+			= (False, type_heaps)
+	match defs type1 (TA cons_id cons_args) type_heaps
+		# (succ, type2, type_heaps) = tryToExpandTypeSyn defs cons_id cons_args type_heaps
+		| succ
+			= match defs type1 type2 type_heaps
+			= (False, type_heaps)
+	match defs type1 type2 type_heaps
+		= (False, type_heaps)
+
+instance match (!a,!b) | match a & match b
+where
+	match defs (x1,y1) (x2,y2) type_heaps
+		# (matched, type_heaps) = match defs x1 x2 type_heaps
+		| matched
+			= match defs y1 y2 type_heaps
+			= (False, type_heaps)
+			
+instance match [a] | match a
+where
+	match defs [t1 : ts1] [t2 : ts2] type_heaps
+		= match defs (t1,ts1) (t2,ts2) type_heaps
+	match defs [] [] type_heaps
+		= (True, type_heaps)
+
+instance match ConsVariable
+where
+	match defs (CV {tv_info_ptr}) cons_var type_heaps=:{th_vars}
+		= (True, { type_heaps & th_vars = th_vars <:= (tv_info_ptr,TVI_Type (consVariableToType cons_var))})
+
+consVariableToType (TempCV temp_var_id)
+	= TempV temp_var_id
+consVariableToType (TempQCV temp_var_id)
+	= TempQV temp_var_id
+
+trySpecializedInstances type_contexts [] type_heaps
+	= (ObjectNotFound, type_heaps)
+trySpecializedInstances type_contexts specials type_heaps=:{th_vars}
+	# (spec_index, th_vars) = try_specialized_instances (map (\{tc_types} -> tc_types) type_contexts) specials th_vars
+	= (spec_index, { type_heaps & th_vars = th_vars })
+where
+
+	try_specialized_instances type_contexts_types [{spec_index,spec_vars,spec_types} : specials] type_var_heap
+		# type_var_heap = foldSt (\tv -> writePtr tv.tv_info_ptr TVI_Empty) spec_vars type_var_heap
+		  (equ, type_var_heap) = equalTypes spec_types type_contexts_types type_var_heap
+		| equ
+			= (spec_index, type_var_heap)
+			= try_specialized_instances type_contexts_types specials type_var_heap
+	try_specialized_instances type_contexts_types [] type_var_heap
+		= (ObjectNotFound, type_var_heap)
+
+tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos)] !{# CommonDefs } !ClassInstanceInfo !*Coercions !*OverloadingState
+	-> (![TypeContext], !*Coercions, ![LocalTypePatternVariable], !*OverloadingState)
+tryToSolveOverloading ocs defs instance_info coercion_env os
+	= foldSt (try_to_solve_overloading defs instance_info) ocs ([], coercion_env, [], os)
+where
+
+	try_to_solve_overloading  defs instance_info (fun_context, call_ptrs, location) (contexts, coercion_env, type_pattern_vars, os=:{os_error})
+		| isEmpty call_ptrs
+			= (contexts, coercion_env, type_pattern_vars, os)
+			# os = { os & os_error = setErrorAdmin location os_error }
+			= case fun_context of
+				Yes specified_context
+					# (_, coercion_env, type_pattern_vars, os)
+						= reduce_and_simplify_contexts call_ptrs defs instance_info True specified_context coercion_env type_pattern_vars os
+					-> (contexts, coercion_env, type_pattern_vars, os)
+//							---> ("try_to_solve_overloading (Yes ...)", specified_context)
+				No
+					-> reduce_and_simplify_contexts call_ptrs defs instance_info False contexts coercion_env type_pattern_vars os
+//							---> ("try_to_solve_overloading (No)", contexts)
+		
+	reduce_and_simplify_contexts :: ![ExprInfoPtr] !{# CommonDefs } !ClassInstanceInfo !Bool ![TypeContext] !*Coercions ![LocalTypePatternVariable]
+			!*OverloadingState -> (![TypeContext], !*Coercions, ![LocalTypePatternVariable], !*OverloadingState)
+	reduce_and_simplify_contexts [over_info_ptr : ocs] defs instance_info has_context contexts coercion_env type_pattern_vars os=:{os_symbol_heap, os_type_heaps}
+		# (EI_Overloaded {oc_symbol, oc_context, oc_specials}, os_symbol_heap) = readPtr over_info_ptr os_symbol_heap
+		  (glob_fun, os_type_heaps) = trySpecializedInstances oc_context oc_specials os_type_heaps
+		| FoundObject glob_fun
+			# os_symbol_heap = os_symbol_heap <:= (over_info_ptr, EI_Instance {glob_module = glob_fun.glob_module, glob_object =
+									{ ds_ident =  oc_symbol.symb_name, ds_arity = 0, ds_index = glob_fun.glob_object }} [])
+			= reduce_and_simplify_contexts ocs defs instance_info has_context contexts coercion_env type_pattern_vars
+					{ os & os_type_heaps = os_type_heaps, os_symbol_heap = os_symbol_heap }
+			# (appls, os_special_instances, {ltp_var_heap, ltp_variables}, os_type_heaps, coercion_env, os_predef_symbols, os_error)
+					= reduceContexts oc_context defs instance_info os.os_special_instances {ltp_var_heap = os.os_var_heap, ltp_variables = type_pattern_vars}
+							os_type_heaps coercion_env os.os_predef_symbols os.os_error
+			| os_error.ea_ok
+				# (contexts, os_type_heaps, os_var_heap, os_symbol_heap, os_error)
+					= simplifyOverloadedCall oc_symbol over_info_ptr appls defs has_context contexts os_type_heaps ltp_var_heap os_symbol_heap os_error
+				= reduce_and_simplify_contexts ocs defs instance_info has_context contexts coercion_env ltp_variables { os &
+						os_type_heaps = os_type_heaps, os_var_heap = os_var_heap, os_symbol_heap = os_symbol_heap,
+						os_predef_symbols = os_predef_symbols, os_special_instances = os_special_instances, os_error = os_error }
+
+				= reduce_and_simplify_contexts ocs defs instance_info has_context contexts coercion_env ltp_variables
+						{ os & os_type_heaps = os_type_heaps, os_predef_symbols = os_predef_symbols, os_symbol_heap = os_symbol_heap,
+							os_special_instances = os_special_instances, os_error = os_error, os_var_heap = ltp_var_heap}
+	reduce_and_simplify_contexts [] defs instance_info has_context contexts coercion_env type_pattern_vars os
+		= (contexts, coercion_env, type_pattern_vars, os)
+
+/*	
+RecordName = { id_name = "_Record", id_info = nilPtr }
+
+InternalSelectSymbol = { symb_name = {id_name = "_Select", id_info = nilPtr },
+						 symb_kind = SK_InternalFunction (-1), symb_arity = 2 }
+*/
+
+selectFromDictionary  dict_mod dict_index member_index defs
+	# (RecordType {rt_fields}) = defs.[dict_mod].com_type_defs.[dict_index].td_rhs
+	  { fs_name, fs_index } = rt_fields.[member_index]
+	= { glob_module = dict_mod, glob_object = { ds_ident = fs_name, ds_index = fs_index, ds_arity = 1 }}
+
+getDictionaryConstructor {glob_module, glob_object = {ds_ident,ds_index}} defs	  
+	# {class_dictionary} = defs.[glob_module].com_class_defs.[ds_index]
+	  (RecordType {rt_constructor}) = defs.[glob_module].com_type_defs.[class_dictionary.ds_index].td_rhs
+	= rt_constructor
+
+simplifyOverloadedCall {symb_kind = SK_OverloadedFunction {glob_module,glob_object}, symb_arity} expr_info_ptr [class_appl:class_appls]
+		defs has_context contexts type_heaps var_heap symbol_heap error
+	# mem_def = defs.[glob_module].com_member_defs.[glob_object]
+	# (class_exprs, (contexts, heaps, error)) = convertClassApplsToExpressions defs has_context class_appls (contexts, (type_heaps, var_heap, symbol_heap), error)
+	  (inst_expr, contexts, (type_heaps, var_heap, symbol_heap), error)
+	  		= adjust_member_application mem_def symb_arity class_appl class_exprs defs has_context contexts heaps error
+	= (contexts, type_heaps, var_heap, symbol_heap <:= (expr_info_ptr, inst_expr), error)
+
+where
+	adjust_member_application {me_symb,me_offset,me_class} symb_arity (CA_Instance red_contexts) class_exprs defs has_context contexts heaps error
+		# ({glob_module,glob_object}, red_contexts) = find_instance_of_member me_class me_offset red_contexts
+		  (exprs, (contexts, heaps, error)) = convertClassApplsToExpressions defs has_context red_contexts (contexts, heaps, error)
+		  class_exprs = exprs ++ class_exprs
+		= (EI_Instance { glob_module = glob_module, glob_object = { ds_ident = me_symb, ds_arity = length class_exprs, ds_index = glob_object }}
+				 class_exprs, contexts, heaps, error)
+	adjust_member_application {me_symb,me_offset,me_class={glob_module,glob_object}} symb_arity (CA_Context tc)
+			class_exprs defs has_context contexts (type_heaps, var_heap, symbol_heap) error
+		# (class_context, address, contexts, type_heaps, var_heap, error)
+				= determineContextAddress tc has_context contexts defs type_heaps var_heap error
+		  {class_dictionary={ds_index}} = defs.[glob_module].com_class_defs.[glob_object]
+		  selector = selectFromDictionary glob_module ds_index me_offset defs
+		= (EI_Selection (generateClassSelection address [RecordSelection selector me_offset]) (createBoundVar class_context) class_exprs,
+				contexts, (type_heaps, var_heap, symbol_heap), error)
+
+	adjust_member_application _ _ (CA_GlobalTypeCode {tci_index,tci_contexts}) _ defs has_context contexts heaps error
+		# (exprs, (contexts, heaps, error)) = convertClassApplsToExpressions defs has_context tci_contexts (contexts, heaps, error)
+		= (EI_TypeCode (TCE_Constructor tci_index (map expressionToTypeCodeExpression exprs)), contexts, heaps, error)
+	adjust_member_application _ _ (CA_LocalTypeCode new_var_ptr) _ defs has_context contexts heaps error
+		= (EI_TypeCode (TCE_Var new_var_ptr), contexts, heaps, error)
+	
+	find_instance_of_member me_class me_offset { rcs_class_context = {rc_class, rc_inst_module, rc_inst_members, rc_red_contexts}, rcs_constraints_contexts}
+		| rc_class.glob_module == me_class.glob_module && rc_class.glob_object.ds_index == me_class.glob_object
+			= ({ glob_module = rc_inst_module, glob_object = rc_inst_members.[me_offset].ds_index }, rc_red_contexts)
+			= find_instance_of_member_in_constraints me_class me_offset rcs_constraints_contexts
+	where
+		find_instance_of_member_in_constraints me_class me_offset [ rcs=:{rcs_constraints_contexts} : rcss ]
+			= find_instance_of_member me_class me_offset {rcs & rcs_constraints_contexts = rcs_constraints_contexts ++ rcss}
+		find_instance_of_member_in_constraints me_class me_offset []
+			= abort "Error in module overloading: find_instance_of_member_in_constraints\n"
+
+simplifyOverloadedCall {symb_kind = SK_TypeCode} expr_info_ptr class_appls defs has_context contexts type_heaps var_heap symbol_heap error
+	# (class_expressions, (contexts, (type_heaps, var_heap, symbol_heap), error))
+			= convertClassApplsToExpressions defs has_context class_appls (contexts, (type_heaps, var_heap, symbol_heap), error)
+	= (contexts, type_heaps, var_heap, symbol_heap <:= (expr_info_ptr, EI_TypeCodes (map expressionToTypeCodeExpression class_expressions)), error)	
+simplifyOverloadedCall _ expr_info_ptr appls defs has_context contexts type_heaps var_heap symbol_heap error
+	# (class_expressions, (contexts, (type_heaps, var_heap, symbol_heap), error))
+			= convertClassApplsToExpressions defs has_context appls (contexts, (type_heaps, var_heap, symbol_heap), error)
+	= (contexts, type_heaps, var_heap, symbol_heap <:= (expr_info_ptr, EI_Context class_expressions), error)
+
+
+expressionToTypeCodeExpression (TypeCodeExpression texpr) 			= texpr
+expressionToTypeCodeExpression (Var {var_info_ptr})					= TCE_Var var_info_ptr
+
+generateClassSelection address last_selectors
+	= mapAppend (\(off_set,selector) -> RecordSelection selector off_set) address last_selectors
+	
+convertClassApplsToExpressions defs has_context cl_appls contexts_heaps_error
+	= mapSt (convert_class_appl_to_expression defs has_context) cl_appls contexts_heaps_error
+where
+	convert_class_appl_to_expression defs has_context (CA_Instance {rcs_class_context,rcs_constraints_contexts}) contexts_heaps_error
+		# (class_symb, class_members, instance_types, contexts_heaps_error)
+				= convert_reduced_context_to_expression defs has_context rcs_class_context contexts_heaps_error
+		  (members_of_constraints, (contexts, (type_heaps, var_heap, expr_heap), error))
+		  		= convert_list_of_reduced_contexts_to_expressions defs has_context rcs_constraints_contexts contexts_heaps_error
+		  {ds_ident,ds_index,ds_arity} = getDictionaryConstructor class_symb defs
+		  record_symbol = { symb_name = ds_ident, symb_kind = SK_Constructor {glob_module = class_symb.glob_module, glob_object = ds_index}, symb_arity = ds_arity }
+		  (app_info_ptr, expr_heap) = newPtr (EI_ClassTypes instance_types) expr_heap
+		= (App { app_symb = record_symbol, app_args = class_members ++ members_of_constraints, app_info_ptr = app_info_ptr },
+				(contexts, (type_heaps, var_heap, expr_heap), error))
+	convert_class_appl_to_expression defs has_context (CA_Context tc) (contexts, (type_heaps, var_heap, expr_heap), error)
+		# (class_context, context_address, contexts, type_heaps, var_heap, error)
+				= determineContextAddress tc has_context contexts defs type_heaps var_heap error
+		| isEmpty context_address
+			= (Var (createBoundVar class_context), (contexts, (type_heaps, var_heap, expr_heap), error))
+			= (Selection No (Var (createBoundVar class_context)) (generateClassSelection context_address []), (contexts, (type_heaps, var_heap, expr_heap), error))
+	convert_class_appl_to_expression defs has_context (CA_LocalTypeCode new_var_ptr) contexts_heaps_error
+		= (TypeCodeExpression (TCE_Var new_var_ptr), contexts_heaps_error)
+	convert_class_appl_to_expression defs has_context (CA_GlobalTypeCode {tci_index,tci_contexts}) contexts_heaps_error
+		# (exprs, contexts_heaps_error) = convertClassApplsToExpressions defs has_context tci_contexts contexts_heaps_error
+		= (TypeCodeExpression (TCE_Constructor tci_index (map expressionToTypeCodeExpression exprs)), contexts_heaps_error)
+
+	convert_reduced_context_to_expression defs has_context {rc_class, rc_inst_module, rc_inst_members, rc_red_contexts, rc_types} contexts_heaps_error
+		# (expressions, contexts_heaps_error) = convertClassApplsToExpressions defs has_context rc_red_contexts contexts_heaps_error
+		  members = build_class_members 0 rc_inst_members rc_inst_module expressions (length expressions)
+		= (rc_class, members, rc_types, contexts_heaps_error)
+	where
+		build_class_members mem_offset ins_members mod_index class_arguments arity
+			| mem_offset == size ins_members
+				= []
+				# expressions = build_class_members (inc mem_offset) ins_members mod_index class_arguments arity
+				  {ds_ident,ds_index} = ins_members.[mem_offset]
+				= [ App { app_symb = { symb_name = ds_ident, symb_kind = SK_Function { glob_object = ds_index, glob_module = mod_index },
+						symb_arity = arity }, app_args = class_arguments, app_info_ptr = nilPtr } : expressions ]
+
+	convert_list_of_reduced_contexts_to_expressions defs has_context list_of_rcs contexts_heaps_error
+		= mapSt (convert_reduced_contexts_to_expressions defs has_context) list_of_rcs contexts_heaps_error
+
+	convert_reduced_contexts_to_expressions defs has_context {rcs_class_context,rcs_constraints_contexts} contexts_heaps_error
+		# (class_symb, rc_exprs, instance_types, contexts_heaps_error)
+				= convert_reduced_context_to_expression defs has_context rcs_class_context contexts_heaps_error
+		  (rcs_exprs, (contexts, (type_heaps, var_heap, expr_heap), error))
+				= convert_list_of_reduced_contexts_to_expressions defs has_context rcs_constraints_contexts contexts_heaps_error
+		  {ds_ident,ds_index,ds_arity} = getDictionaryConstructor class_symb defs
+		  record_symbol = { symb_name = ds_ident, symb_kind = SK_Constructor {glob_module = class_symb.glob_module, glob_object = ds_index}, symb_arity = ds_arity }
+		  (app_info_ptr, expr_heap) = newPtr (EI_ClassTypes instance_types) expr_heap
+		  rc_record = App { app_symb = record_symbol, app_args = rc_exprs ++ rcs_exprs, app_info_ptr = app_info_ptr }
+		= (rc_record, (contexts, (type_heaps, var_heap, expr_heap), error))
+	
+createBoundVar :: !TypeContext -> BoundVar
+createBoundVar {tc_class={glob_object={ds_ident}}, tc_var}
+	| isNilPtr tc_var
+		= abort ("createBoundVar : NIL ptr" ---> ds_ident)
+		= { var_name = { id_name = "_v" +++ ds_ident.id_name, id_info = nilPtr }, var_info_ptr = tc_var, var_expr_ptr = nilPtr }
+
+createFreeVar :: !TypeContext -> FreeVar
+createFreeVar {tc_class={glob_object={ds_ident}}, tc_var}
+	| isNilPtr tc_var
+		= abort ("createFreeVar : NIL ptr" ---> ds_ident)
+		= { fv_name = { id_name = "_v" +++ ds_ident.id_name, id_info = nilPtr }, fv_info_ptr = tc_var, fv_def_level = NotALevel, fv_count = -1 }
+
+
+determineContextAddress :: !TypeContext !Bool ![TypeContext] !{#CommonDefs} !*TypeHeaps !*VarHeap !*ErrorAdmin
+	-> (!TypeContext, ![(Int, Global DefinedSymbol)], ![TypeContext], !*TypeHeaps, !*VarHeap, !*ErrorAdmin)
+determineContextAddress tc has_context contexts defs type_heaps var_heap error
+	= determine_context_and_address tc contexts has_context contexts defs type_heaps var_heap error
+where
+	determine_context_and_address :: !TypeContext ![TypeContext] !Bool ![TypeContext] !{#CommonDefs} !*TypeHeaps !*VarHeap !*ErrorAdmin
+			-> (!TypeContext, ![(Int, Global DefinedSymbol)], ![TypeContext], !*TypeHeaps, !*VarHeap, !*ErrorAdmin)
+	determine_context_and_address context [] has_context contexts defs type_heaps var_heap error
+		| has_context
+			= (context, [], contexts, type_heaps, var_heap, contextError error)
+			#! (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+			# new_context = { context & tc_var = new_info_ptr}
+			= (new_context, [], [new_context : contexts], type_heaps, var_heap, error)
+	determine_context_and_address context [tc : tcs] has_context contexts defs type_heaps var_heap error
+		#! (may_be_addres, type_heaps) = determine_address context tc [] defs type_heaps
+		= case may_be_addres of
+			Yes address
+				| isNilPtr tc.tc_var
+					-> abort ("determine_context_and_address" ---> tc.tc_class.glob_object.ds_ident)
+					-> (tc, address, contexts, type_heaps, var_heap, error)
+			No
+				-> determine_context_and_address context tcs has_context contexts defs type_heaps var_heap error
+
+	determine_address :: !TypeContext !TypeContext ![(Int, Global DefinedSymbol)] !{#CommonDefs} !*TypeHeaps
+		-> (!Optional [(Int, Global DefinedSymbol)],!*TypeHeaps)
+	determine_address tc1 tc2 address defs type_heaps=:{th_vars}
+		| tc1 == tc2
+			= (Yes address, type_heaps)
+			# {tc_class={glob_object={ds_index},glob_module}} = tc2
+			  {class_args,class_members,class_context,class_dictionary} = defs.[glob_module].com_class_defs.[ds_index]
+			  th_vars = foldr2 (\{tv_info_ptr} type -> writePtr tv_info_ptr (TVI_Type type)) th_vars class_args tc2.tc_types
+			  (super_instances, type_heaps) = substitute class_context { type_heaps & th_vars = th_vars } 
+			= find_super_instance tc1 super_instances (size class_members) address glob_module class_dictionary.ds_index defs type_heaps
+
+	find_super_instance :: !TypeContext ![TypeContext] !Index ![(Int, Global DefinedSymbol)] !Index !Index !{#CommonDefs} !*TypeHeaps
+		-> (!Optional [(Int, Global DefinedSymbol)],!*TypeHeaps)
+	find_super_instance context [] tc_index address dict_mod dict_index defs type_heaps
+		= (No, type_heaps)
+	find_super_instance context [tc : tcs] tc_index address dict_mod dict_index defs type_heaps
+		#! (may_be_addres, type_heaps) = determine_address context tc address defs type_heaps
+		= case may_be_addres of
+			Yes address
+				# selector = selectFromDictionary dict_mod dict_index tc_index defs
+				-> (Yes [ (tc_index, selector) : address ], type_heaps)
+			No
+				-> find_super_instance context tcs (inc tc_index) address  dict_mod dict_index defs type_heaps
+
+updateDynamics :: ![Int] ![TypeContext] ![LocalTypePatternVariable] !*{#FunDef} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin
+	-> (!*{#FunDef}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin)
+updateDynamics funs type_contexts type_pattern_vars fun_defs symbol_heap type_code_info var_heap error
+	| error.ea_ok
+		= update_dynamics funs type_contexts fun_defs symbol_heap type_code_info { ltp_var_heap = var_heap, ltp_variables = type_pattern_vars} error
+		= (fun_defs, symbol_heap, type_code_info, var_heap, error)	
+where
+	update_dynamics [] type_contexts fun_defs symbol_heap type_code_info ltp error
+		= (fun_defs, symbol_heap, type_code_info, ltp.ltp_var_heap,  error)
+	update_dynamics [fun:funs] type_contexts fun_defs symbol_heap type_code_info ltp error
+		#! fun_def = fun_defs.[fun]
+		# {fun_body,fun_info={fi_group_index, fi_dynamics}} = fun_def
+		| isEmpty fi_dynamics
+			= update_dynamics funs type_contexts fun_defs symbol_heap type_code_info ltp error
+		  	# (type_code_info, symbol_heap, ltp) = convertDynamicTypes fi_dynamics (type_code_info, symbol_heap, ltp)
+		  	  (TransformedBody tb) = fun_body
+		  	  (tb_rhs, {ui_instance_calls, ui_symbol_heap, ui_fun_defs})
+		  	  		= updateExpression fi_group_index [] tb.tb_rhs {  ui_instance_calls = [], ui_symbol_heap = symbol_heap, ui_fun_defs = fun_defs }
+		 	  fun_def = { fun_def & fun_body = TransformedBody {tb & tb_rhs = tb_rhs}}
+			= update_dynamics funs type_contexts { ui_fun_defs & [fun] = fun_def } ui_symbol_heap type_code_info ltp error
+
+removeOverloadedFunctions :: ![Int] ![(Optional [TypeContext], IdentPos)] ![TypeContext] ![LocalTypePatternVariable] !*{#FunDef} !*ExpressionHeap
+	!*TypeCodeInfo !*VarHeap !*ErrorAdmin
+		-> (!*{#FunDef}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin)
+removeOverloadedFunctions funs opt_spec_contexts type_contexts type_pattern_vars fun_defs symbol_heap type_code_info var_heap error
+	| error.ea_ok
+		= remove_overloaded_functions funs opt_spec_contexts type_contexts fun_defs symbol_heap type_code_info
+				{ ltp_var_heap = var_heap, ltp_variables = type_pattern_vars} error
+		= (fun_defs, symbol_heap, type_code_info, var_heap, error)	
+where	
+	remove_overloaded_functions :: ![Int] ![(Optional [TypeContext], IdentPos)] ![TypeContext] !*{#FunDef} !*ExpressionHeap !*TypeCodeInfo
+		!*LocalTypePatternVariables !*ErrorAdmin
+			-> (!*{#FunDef}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin)
+	remove_overloaded_functions [] opt_contexts type_contexts fun_defs symbol_heap type_code_info ltp error
+		= (fun_defs, symbol_heap, type_code_info, ltp.ltp_var_heap,  error)
+	remove_overloaded_functions [fun:funs] [(opt_context, location):opt_contexts] type_contexts fun_defs symbol_heap type_code_info ltp error
+		#! fun_def = fun_defs.[fun]
+		# {fun_body = TransformedBody {tb_args,tb_rhs},fun_info,fun_arity,fun_symb} = fun_def
+		  error = setErrorAdmin location error
+		  (type_code_info, symbol_heap, ltp) = convertDynamicTypes fun_info.fi_dynamics (type_code_info, symbol_heap, ltp)
+		  tb_args = determine_class_arguments opt_context type_contexts tb_args
+		  (tb_rhs, {ui_instance_calls, ui_symbol_heap, ui_fun_defs}) = updateExpression fun_info.fi_group_index type_contexts tb_rhs
+		  							{  ui_instance_calls = [], ui_symbol_heap = symbol_heap, ui_fun_defs = fun_defs }
+		  fun_def = { fun_def & fun_body = TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs},
+		  								  fun_arity = length tb_args, fun_info = { fun_info & fi_calls = fun_info.fi_calls ++ ui_instance_calls } }
+		= remove_overloaded_functions funs opt_contexts type_contexts { ui_fun_defs & [fun] = fun_def } ui_symbol_heap type_code_info ltp error
+
+	determine_class_arguments (Yes spec_context) _ tb_args
+		= mapAppend (\tc -> createFreeVar tc) spec_context tb_args
+	determine_class_arguments No type_contexts tb_args
+		= mapAppend (\tc -> createFreeVar tc) type_contexts tb_args
+
+/*	
+	type_contexts fun_symb fun_info_ptr tb_args symbol_heap error
+		#! fun_info = sreadPtr fun_info_ptr symbol_heap
+		= case fun_info of
+			EI_Empty
+				-> (mapAppend (\tc -> createFreeVar tc) type_contexts tb_args, symbol_heap, error)
+			EI_Context class_expressions
+				# (tb_args, error) = convert_class_expressions fun_symb class_expressions tb_args error
+				-> (tb_args, symbol_heap, error)
+			_
+//				-> (tb_args, symbol_heap, contextError fun_symb error)
+				-> (tb_args, symbol_heap, contextError error)
+				
+	convert_class_expressions fun_symb [] tb_args error
+		= (tb_args, error)
+	convert_class_expressions fun_symb [Var {var_name,var_info_ptr} : class_exprs] tb_args error
+		# (tb_args, error) = convert_class_expressions fun_symb class_exprs tb_args error
+		= ([ { fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = -1 } : tb_args], error)
+	convert_class_expressions fun_symb [class_expr : class_exprs] tb_args error
+//		= (tb_args, contextError fun_symb error)
+		= (tb_args, contextError error)
+*/
+convertDynamicTypes dyn_ptrs update_info
+	= foldSt update_dynamic dyn_ptrs update_info
+where		
+	update_dynamic dyn_ptr (type_code_info, expr_heap, local_type_pattern_vars)
+		# (dyn_info, expr_heap) = readPtr dyn_ptr expr_heap
+		= case dyn_info of
+			EI_TempDynamicType (Yes {dt_global_vars, dt_uni_vars, dt_type}) _ _ expr_ptr _
+				# (expr_info, expr_heap) = readPtr expr_ptr expr_heap
+				-> case expr_info of
+					EI_TypeCodes type_codes
+						# type_var_heap = fold2St (\{tv_info_ptr} type_code -> writePtr tv_info_ptr (TVI_TypeCode type_code))
+														dt_global_vars type_codes type_code_info.tci_type_var_heap
+						  (uni_vars, (type_var_heap, ltp_var_heap)) = new_type_variables dt_uni_vars (type_var_heap, local_type_pattern_vars.ltp_var_heap)
+						  (type_code_expr, type_code_info) = toTypeCodeExpression dt_type { type_code_info & tci_type_var_heap = type_var_heap }
+						-> (type_code_info, expr_heap <:= (dyn_ptr, EI_TypeOfDynamic uni_vars type_code_expr), {local_type_pattern_vars & ltp_var_heap = ltp_var_heap})
+					EI_Empty
+						# (uni_vars, (type_var_heap, ltp_var_heap)) = new_type_variables dt_uni_vars (type_code_info.tci_type_var_heap, local_type_pattern_vars.ltp_var_heap)
+						  (type_code_expr, type_code_info) = toTypeCodeExpression dt_type { type_code_info & tci_type_var_heap = type_var_heap }
+						-> (type_code_info, expr_heap <:= (dyn_ptr, EI_TypeOfDynamic uni_vars type_code_expr), {local_type_pattern_vars & ltp_var_heap = ltp_var_heap})
+			EI_TempDynamicType No _ _ expr_ptr _
+				# (expr_info, expr_heap) = readPtr expr_ptr expr_heap
+				-> case expr_info of
+					EI_TypeCode type_expr
+						-> (type_code_info, expr_heap <:= (dyn_ptr, EI_TypeOfDynamic [] type_expr), local_type_pattern_vars)
+					EI_Selection selectors record_var _
+						-> (type_code_info, expr_heap <:= (dyn_ptr, EI_TypeOfDynamic [] (convert_selectors selectors record_var)), local_type_pattern_vars)
+			EI_TempDynamicPattern type_vars {dt_global_vars, dt_type} loc_dynamics temp_local_vars _ _ expr_ptr _
+				# (expr_info, expr_heap) = readPtr expr_ptr expr_heap
+				-> case expr_info of
+					EI_TypeCodes type_codes
+						# type_var_heap = fold2St (\{tv_info_ptr} type_code -> writePtr tv_info_ptr (TVI_TypeCode type_code)) dt_global_vars type_codes type_code_info.tci_type_var_heap
+						  (var_ptrs, local_type_pattern_vars) = mapSt addLocalTCInstance temp_local_vars local_type_pattern_vars
+						  type_var_heap = fold2St (\{tv_info_ptr} var_ptr -> writePtr tv_info_ptr (TVI_TypeCode (TCE_Var var_ptr))) type_vars var_ptrs type_var_heap
+						  (type_code_expr, type_code_info) = toTypeCodeExpression dt_type { type_code_info & tci_type_var_heap = type_var_heap }
+						-> convert_local_dynamics loc_dynamics (type_code_info, expr_heap <:= (dyn_ptr, EI_TypeOfDynamicPattern var_ptrs type_code_expr), local_type_pattern_vars)
+					EI_Empty
+						# (var_ptrs, local_type_pattern_vars) = mapSt addLocalTCInstance temp_local_vars local_type_pattern_vars
+						  type_var_heap = fold2St (\{tv_info_ptr} var_ptr -> writePtr tv_info_ptr (TVI_TypeCode (TCE_Var var_ptr))) type_vars var_ptrs type_code_info.tci_type_var_heap
+						  (type_code_expr, type_code_info) = toTypeCodeExpression dt_type { type_code_info & tci_type_var_heap = type_var_heap }
+						-> convert_local_dynamics loc_dynamics (type_code_info, expr_heap <:= (dyn_ptr, EI_TypeOfDynamicPattern var_ptrs type_code_expr), local_type_pattern_vars)
+					
+	where
+		convert_local_dynamics loc_dynamics state
+			= foldSt update_dynamic loc_dynamics state
+/*
+		convert_local_dynamics (Yes loc_dynamics) state
+			= update_dynamic loc_dynamics state
+		convert_local_dynamics No state
+			= state
+*/
+		convert_selectors [type_code_selector] {var_info_ptr}
+			= TCE_Var var_info_ptr
+		convert_selectors selectors {var_info_ptr}
+			= TCE_Selector (init selectors) var_info_ptr
+		
+		new_type_variables uni_vars heaps
+			= mapSt new_type_variable uni_vars heaps
+			
+		new_type_variable {atv_variable = {tv_info_ptr}} (type_var_heap, var_heap)
+			# (new_var_ptr, var_heap) = newPtr VI_Empty var_heap
+			= (new_var_ptr, (type_var_heap <:= (tv_info_ptr, TVI_TypeCode (TCE_Var new_var_ptr)), var_heap))
+		
+::	TypeCodeInfo =
+	{	tci_next_index			:: !Index
+	,	tci_instances			:: ![GlobalTCInstance]
+	,	tci_type_var_heap		:: !.TypeVarHeap
+	}
+		
+class toTypeCodeExpression type :: type !*TypeCodeInfo -> (!TypeCodeExpression, !*TypeCodeInfo)
+
+instance toTypeCodeExpression Type
+where
+	toTypeCodeExpression (TA cons_id type_args) tci=:{tci_next_index,tci_instances}
+		# (inst_index, (tci_next_index, tci_instances))
+		  		= addGlobalTCInstance (GTT_Constructor cons_id) (tci_next_index, tci_instances)
+		  (type_code_args, tci) = mapSt toTypeCodeExpression type_args { tci & tci_next_index = tci_next_index, tci_instances = tci_instances }
+		= (TCE_Constructor inst_index type_code_args, tci)
+	toTypeCodeExpression (TB basic_type) tci=:{tci_next_index,tci_instances}
+		# (inst_index, (tci_next_index, tci_instances))
+		  		= addGlobalTCInstance (GTT_Basic basic_type) (tci_next_index, tci_instances)
+		= (TCE_Constructor inst_index [], { tci & tci_next_index = tci_next_index, tci_instances = tci_instances })
+	toTypeCodeExpression  (arg_type --> result_type) tci=:{tci_next_index,tci_instances}
+		# (inst_index, (tci_next_index, tci_instances))
+				= addGlobalTCInstance GTT_Function (tci_next_index, tci_instances)
+		  (type_code_args, tci) = mapSt toTypeCodeExpression [arg_type, result_type] { tci & tci_next_index = tci_next_index, tci_instances = tci_instances }
+		= (TCE_Constructor inst_index type_code_args, tci)
+	toTypeCodeExpression  (TV {tv_info_ptr}) tci=:{tci_type_var_heap}
+		# (TVI_TypeCode type_code, tci_type_var_heap) = readPtr tv_info_ptr tci_type_var_heap
+		= (type_code, { tci & tci_type_var_heap = tci_type_var_heap })
+
+instance toTypeCodeExpression AType
+where
+	toTypeCodeExpression {at_type} tci = toTypeCodeExpression at_type tci
+	
+
+::	UpdateInfo =
+	{	ui_instance_calls	:: ![FunCall]
+	,	ui_symbol_heap		:: !.ExpressionHeap
+	,	ui_fun_defs			:: !.{# FunDef}
+	}
+
+class updateExpression e :: !Index ![TypeContext] !e !*UpdateInfo -> (!e, !*UpdateInfo)
+
+instance updateExpression Expression
+where
+	updateExpression group_index type_contexts (App app=:{app_symb=symb=:{symb_kind,symb_arity,symb_name},app_args,app_info_ptr}) ui
+		# (app_args, ui) = updateExpression group_index type_contexts app_args ui
+		| isNilPtr app_info_ptr
+			= (App { app & app_args = app_args }, ui)
+			#! symb_info = sreadPtr app_info_ptr ui.ui_symbol_heap
+			= case symb_info of
+				EI_Empty
+					| is_recursive_call group_index symb_kind ui.ui_fun_defs
+						# app_args = strictMapAppend (\tc -> Var (createBoundVar tc)) type_contexts app_args
+						-> (App { app & app_symb = { symb & symb_arity = length type_contexts + symb_arity }, app_args = app_args }, ui)
+						-> (App { app & app_args = app_args }, ui)
+				EI_Instance inst_symbol context_args
+					-> (build_application inst_symbol context_args app_args symb_arity app_info_ptr,
+							examine_calls context_args (new_call inst_symbol.glob_module inst_symbol.glob_object.ds_index ui))
+				EI_Selection selectors record_var context_args
+					# all_args = context_args ++ app_args
+					  select_expr = Selection No (Var record_var) selectors
+					| isEmpty all_args
+						-> (select_expr, ui)
+						-> (select_expr @ all_args, examine_calls context_args ui)
+				EI_Context context_args
+					# app = { app & app_symb = { symb & symb_arity = length context_args + symb_arity }, app_args = context_args ++  app_args}
+					-> (App app, examine_calls context_args ui)
+
+
+	where
+		is_recursive_call group_index (SK_Function {glob_module,glob_object}) fun_defs
+			| glob_module == cIclModIndex
+				#! fun_def = fun_defs.[glob_object]
+				= fun_def.fun_info.fi_group_index == group_index
+				= False
+		is_recursive_call group_index _ fun_defs
+			= False
+
+		build_application def_symbol=:{glob_object} context_args orig_args nr_of_orig_args app_info_ptr
+			= App {app_symb = { symb_name = glob_object.ds_ident,
+									symb_kind = SK_Function { def_symbol & glob_object = glob_object.ds_index },
+										symb_arity = glob_object.ds_arity + nr_of_orig_args },
+				   app_args = context_args ++ orig_args, app_info_ptr = app_info_ptr }
+
+		examine_application (SK_Function {glob_module,glob_object}) ui
+			= new_call glob_module glob_object ui
+		examine_application symb_kind ui
+			= ui
+			
+		new_call mod_index symb_index ui=:{ui_instance_calls,ui_fun_defs}
+			| mod_index == cIclModIndex && symb_index < size ui_fun_defs
+				# ui_instance_calls = add_call symb_index ui_instance_calls
+				= { ui & ui_instance_calls = ui_instance_calls }
+				= ui
+		where
+			add_call fun_num []
+				= [{ fc_level = 0, fc_index = fun_num }]
+			add_call fun_num funs=:[call=:{fc_index} : ui]
+				| fun_num == fc_index
+					= funs
+				| fun_num < fc_index
+					= [{ fc_level = 0, fc_index = fun_num } : funs]
+					= [call : add_call fun_num ui]
+	
+		examine_calls [expr : exprs] ui
+			= examine_calls exprs (examine_calls_in_expr expr ui)
+		where
+			examine_calls_in_expr (App {app_symb = {symb_name,symb_kind}, app_args}) ui
+				= examine_calls app_args (examine_application symb_kind ui)
+			examine_calls_in_expr _ ui
+				= ui
+		examine_calls [] ui
+			= ui
+		
+			
+	updateExpression group_index type_contexts (expr @ exprs) ui
+		# ((expr, exprs), ui) = updateExpression group_index type_contexts (expr, exprs) ui
+		= (expr @ exprs, ui)
+	updateExpression group_index type_contexts (Let lad=:{let_binds, let_expr}) ui
+		# ((let_binds, let_expr), ui) = updateExpression group_index type_contexts (let_binds, let_expr) ui
+		= (Let {lad & let_binds = let_binds, let_expr = let_expr}, ui)
+	updateExpression group_index type_contexts (Case kees=:{case_expr,case_guards,case_default}) ui
+		# ((case_expr,(case_guards,case_default)), ui) = updateExpression group_index type_contexts (case_expr,(case_guards,case_default)) ui
+		= (Case { kees & case_expr = case_expr, case_guards = case_guards, case_default = case_default }, ui)
+	updateExpression group_index type_contexts (Selection is_unique expr selectors) ui
+		# (expr, ui) = updateExpression group_index type_contexts expr ui
+		  (selectors, ui) = updateExpression group_index type_contexts selectors ui
+		= (Selection is_unique expr selectors, ui)
+/*
+		where
+			update_selections group_index type_contexts is_unique selectors ui
+				= foldl (update_selection group_index type_contexts is_unique) state selectors
+		  
+		  	update_selection group_index type_contexts is_unique (expr, ui) (ArraySelection selector expr_ptr index_expr)
+				# (index_expr, ui) = updateExpression group_index type_contexts index_expr ui
+				#! symb_info = sreadPtr expr_ptr ui.ui_symbol_heap
+				= case symb_info of
+					EI_Instance array_select []
+						-> (App {app_symb = { symb_name = glob_object.ds_ident,
+									symb_kind = SK_Function { glob_module = glob_module, glob_object = glob_object.ds_index },
+										symb_arity = glob_object.ds_arity + 2 },
+								 app_args = context_args ++ [expr,index_expr], app_info_ptr = expr_ptr }, ui)
+					EI_Selection selectors record context_args
+						-> (Selection is_unique record selectors @ [expr,index_expr], ui)
+		  	update_selection group_index type_contexts is_unique (expr, ui) (RecordSelection selector field_nr)
+		  		= (Selection is_unique expr [RecordSelection selector field_nr], ui)
+*/
+	updateExpression group_index type_contexts (Update expr1 selectors expr2) ui
+		# (expr1, ui) = updateExpression group_index type_contexts expr1 ui
+		  (selectors, ui) = updateExpression group_index type_contexts selectors ui
+		  (expr2, ui) = updateExpression group_index type_contexts expr2 ui
+		= (Update expr1 selectors expr2, ui)
+	updateExpression group_index type_contexts (RecordUpdate cons_symbol expression expressions) ui
+		# (expression, ui) = updateExpression group_index type_contexts expression ui
+		  (expressions, ui) = updateExpression group_index type_contexts expressions ui
+		= (RecordUpdate cons_symbol expression expressions, ui)
+	updateExpression group_index type_contexts (DynamicExpr dyn=:{dyn_expr,dyn_info_ptr}) ui
+		# (dyn_expr, ui) = updateExpression group_index type_contexts dyn_expr ui
+		  (EI_TypeOfDynamic uni_vars type_code, ui_symbol_heap) = readPtr dyn_info_ptr ui.ui_symbol_heap
+		= (DynamicExpr { dyn & dyn_expr = dyn_expr, dyn_type_code = type_code, dyn_uni_vars = uni_vars }, { ui & ui_symbol_heap = ui_symbol_heap })
+	updateExpression group_index type_contexts (MatchExpr opt_tuple cons_symbol expr) ui
+		# (expr, ui) = updateExpression group_index type_contexts expr ui
+		= (MatchExpr opt_tuple cons_symbol expr, ui)
+	updateExpression group_index type_contexts (TupleSelect symbol argn_nr expr) ui
+		# (expr, ui) = updateExpression group_index type_contexts expr ui
+		= (TupleSelect symbol argn_nr expr, ui)
+	updateExpression group_index type_contexts expr ui
+		= (expr, ui)
+
+instance updateExpression Bind a b | updateExpression a
+where
+	updateExpression group_index type_contexts bind=:{bind_src} ui
+		# (bind_src, ui) = updateExpression group_index type_contexts bind_src ui
+		= ({bind & bind_src = bind_src }, ui)
+
+instance updateExpression Optional a | updateExpression a
+where
+	updateExpression group_index type_contexts (Yes x) ui
+		# (x, ui) = updateExpression group_index type_contexts x ui
+		= (Yes x, ui)
+	updateExpression group_index type_contexts No ui
+		= (No, ui)
+
+instance updateExpression CasePatterns
+where
+	updateExpression group_index type_contexts (AlgebraicPatterns type patterns) ui
+		# (patterns, ui) =  updateExpression group_index type_contexts patterns ui
+		= (AlgebraicPatterns type patterns, ui)
+	updateExpression group_index type_contexts (BasicPatterns type patterns) ui
+		# (patterns, ui) =  updateExpression group_index type_contexts patterns ui
+		= (BasicPatterns type patterns, ui)
+	updateExpression group_index type_contexts (DynamicPatterns patterns) ui
+		# (patterns, ui) =  updateExpression group_index type_contexts patterns ui
+		= (DynamicPatterns patterns, ui)
+	
+instance updateExpression AlgebraicPattern
+where
+	updateExpression group_index type_contexts pattern=:{ap_vars,ap_expr} ui
+		# (ap_expr, ui) =  updateExpression group_index type_contexts ap_expr ui
+		= ({ pattern & ap_expr = ap_expr }, ui)
+
+instance updateExpression BasicPattern
+where
+	updateExpression group_index type_contexts pattern=:{bp_expr} ui
+		# (bp_expr, ui) = updateExpression group_index type_contexts bp_expr ui
+		= ({ pattern & bp_expr = bp_expr }, ui)
+
+instance updateExpression Selection
+where
+  	updateExpression group_index type_contexts (ArraySelection selector expr_ptr index_expr) ui
+		# (index_expr, ui) = updateExpression group_index type_contexts index_expr ui
+		#! symb_info = sreadPtr expr_ptr ui.ui_symbol_heap
+		= case symb_info of
+			EI_Instance array_select []
+				-> (ArraySelection array_select expr_ptr index_expr, ui)
+			EI_Selection selectors record context_args
+				-> (DictionarySelection record selectors expr_ptr index_expr, ui)
+  	updateExpression group_index type_contexts selection ui
+		= (selection, ui)
+
+instance updateExpression TypeCase
+where
+	updateExpression group_index type_contexts type_case=:{type_case_dynamic,type_case_patterns,type_case_default} ui
+		# ((type_case_dynamic,(type_case_patterns,type_case_default)), ui) = updateExpression group_index type_contexts
+				(type_case_dynamic,(type_case_patterns,type_case_default)) ui
+		= ({ type_case & type_case_dynamic = type_case_dynamic, type_case_patterns = type_case_patterns, type_case_default = type_case_default }, ui)
+	
+instance updateExpression DynamicPattern
+where
+	updateExpression group_index type_contexts dp=:{dp_type,dp_rhs} ui
+		# (dp_rhs, ui) =  updateExpression group_index type_contexts dp_rhs ui
+		  (EI_TypeOfDynamicPattern type_pattern_vars type_code, ui_symbol_heap) = readPtr dp_type ui.ui_symbol_heap
+		= ({ dp & dp_rhs = dp_rhs, dp_type_patterns_vars = type_pattern_vars, dp_type_code = type_code }, { ui & ui_symbol_heap = ui_symbol_heap })
+
+instance updateExpression (a,b) | updateExpression a & updateExpression b
+where
+	updateExpression group_index type_contexts t ui
+		= app2St (updateExpression group_index type_contexts,updateExpression group_index type_contexts) t ui
+
+instance updateExpression [e] | updateExpression e
+where
+	updateExpression group_index type_contexts l ui
+		= mapSt (updateExpression group_index type_contexts) l ui
+		
+
+class equalTypes a :: !a !a !*TypeVarHeap -> (!Bool, !*TypeVarHeap)
+
+instance equalTypes AType
+where
+	equalTypes atype1 atype2 type_var_heap
+		= equalTypes atype1.at_type atype2.at_type type_var_heap
+
+equalTypeVars {tv_info_ptr}	temp_var_id type_var_heap
+	#! tv_info = sreadPtr tv_info_ptr type_var_heap
+	= case tv_info of
+		TVI_Forward forw_var_number
+			-> (forw_var_number == temp_var_id, type_var_heap)
+		_
+			-> (True, type_var_heap <:= (tv_info_ptr, TVI_Forward temp_var_id))
+
+instance equalTypes Type
+where
+	equalTypes (TV tv) (TempV var_number) type_var_heap
+		= equalTypeVars tv var_number type_var_heap
+	equalTypes (arg_type1 --> restype1) (arg_type2 --> restype2) type_var_heap
+		= equalTypes (arg_type1,restype1) (arg_type2,restype2) type_var_heap
+	equalTypes (TA tc1 types1) (TA tc2 types2) type_var_heap
+		| tc1 == tc2
+			= equalTypes types1 types2 type_var_heap
+			= (False, type_var_heap)
+	equalTypes (TB basic1) (TB basic2) type_var_heap
+		= (basic1 == basic2, type_var_heap)
+	equalTypes (CV tv :@: types1) (TempCV var_number :@: types2) type_var_heap
+		# (eq, type_var_heap) = equalTypeVars tv var_number type_var_heap
+		| eq
+			= equalTypes types1 types2 type_var_heap
+			= (False, type_var_heap)
+	equalTypes type1 type2 type_var_heap
+		= (False, type_var_heap)
+
+instance equalTypes (a,b) | equalTypes a & equalTypes b
+where
+	equalTypes (x1,y1) (x2,y2) type_var_heap
+		# (eq, type_var_heap) = equalTypes x1 x2 type_var_heap
+		| eq
+			= equalTypes y1 y2 type_var_heap
+			= (False, type_var_heap)
+
+instance equalTypes [a] | equalTypes a
+where
+	equalTypes [x:xs] [y:ys] type_var_heap
+		= equalTypes (x,xs) (y,ys) type_var_heap
+	equalTypes [] [] type_var_heap
+		= (True, type_var_heap)
+	equalTypes _ _ type_var_heap
+		= (False, type_var_heap)
+
+instance <<< TypeContext
+where
+	(<<<) file tc = file <<< tc.tc_class.glob_object.ds_ident <<< ' ' <<< tc.tc_types
+
+instance <<< FunCall
+where
+	(<<<) file {fc_index} = file <<< fc_index
+	
+
+instance <<< Special
+where
+	(<<<) file {spec_types} = file <<< spec_types
+
+instance <<< (Ptr x)
+where
+	(<<<) file _ = file
+	
+instance <<< TypeCodeExpression
+where
+	(<<<) file _ = file
+
diff --git a/frontend/parse.dcl b/frontend/parse.dcl
new file mode 100644
index 0000000..6790bab
--- /dev/null
+++ b/frontend/parse.dcl
@@ -0,0 +1,14 @@
+definition module parse
+
+import syntax, hashtable, scanner, predef
+
+::	*ParseErrorAdmin = 
+	{	pea_file	:: !*File
+	,	pea_ok		:: !Bool
+	}
+
+cWantIclFile :== True	
+cWantDclFile :== False	
+
+wantModule :: !Bool !Ident !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files
+	-> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files)
diff --git a/frontend/parse.icl b/frontend/parse.icl
new file mode 100644
index 0000000..78c3780
--- /dev/null
+++ b/frontend/parse.icl
@@ -0,0 +1,2811 @@
+implementation module parse
+
+import StdEnv
+import scanner, syntax, hashtable, utilities, predef
+
+// RWS ...
+ParseOnly :== False
+import RWSDebug
+
+// +++ move to utilities?
+
+groupBy :: (a a -> Bool) [a] -> [[a]]
+groupBy eq []
+    =   []
+groupBy eq [h : t]
+    =   [[h : this] : groupBy eq other]
+    where
+        (this, other)
+            =   span (eq h) t
+/*
+ident = { id_name = "id name", id_info = nilPtr }
+Start
+	=	is_record_update [{nu_selectors=[PS_Record ident No],nu_update_expr=PE_Empty}]
+
+is_record_update :: [NestedUpdate] -> Bool
+is_record_update [{nu_selectors=[(PS_Record _ _) : _]}]
+	=	True ->> "is_record_update"
+is_record_update updates
+	=	False ->> ("not is_record_update", updates)
+*/
+
+// ... RWS
+
+/*
+
+Parser for Clean 2.0
+
+Conventions:
+
+- Parsing funtions with a name of the form try.. can fail without generating an error.
+  The parser will try an other alternative.
+- Parsing functions with a name of the form want.. should succeed. If these functions
+  fail an error message is generated.
+- Functions with names containing the character '_' are local functions.
+- All functions should consume the tokens taken form the state or given as argument,
+  or put these tokens back themselves.
+
+*/
+
+::	*ParseErrorAdmin = 
+	{	pea_file	:: !*File
+	,	pea_ok		:: !Bool
+	}
+
+:: *ParseState =
+	{	ps_scanState		:: !ScanState
+	,	ps_error			:: !*ParseErrorAdmin
+	,	ps_skipping			:: !Bool
+	,	ps_hash_table		:: !*HashTable
+	,	ps_pre_def_symbols	:: !*PredefinedSymbols
+	}
+
+appScanState :: (ScanState -> ScanState) !ParseState -> ParseState
+appScanState f pState=:{ps_scanState}
+	#	ps_scanState = f ps_scanState
+	=	{	pState & ps_scanState = ps_scanState }
+
+accScanState :: (ScanState -> (.t,ScanState)) !ParseState -> (.t,ParseState)
+accScanState f pState=:{ps_scanState}
+	#	( x, ps_scanState) = f ps_scanState
+	=	( x, {pState & ps_scanState = ps_scanState })
+
+makeStringTypeSymbol pState=:{ps_pre_def_symbols}
+	#! string_id = ps_pre_def_symbols.[PD_StringType]
+	= (MakeNewTypeSymbIdent string_id.pds_ident 0, pState)
+
+makeListTypeSymbol arity pState=:{ps_pre_def_symbols}
+	#! list_id = ps_pre_def_symbols.[PD_ListType]
+	= (MakeNewTypeSymbIdent list_id.pds_ident arity, pState)
+
+makeLazyArraySymbol arity pState=:{ps_pre_def_symbols}
+	#! lazy_array_id = ps_pre_def_symbols.[PD_LazyArrayType]
+	= (MakeNewTypeSymbIdent lazy_array_id.pds_ident arity, pState)
+
+makeStrictArraySymbol arity	pState=:{ps_pre_def_symbols}
+	#! strict_array_id = ps_pre_def_symbols.[PD_StrictArrayType]
+	= (MakeNewTypeSymbIdent strict_array_id.pds_ident arity, pState)
+
+makeUnboxedArraySymbol arity pState=:{ps_pre_def_symbols}
+	#! unboxed_array_id = ps_pre_def_symbols.[PD_UnboxedArrayType]
+	= (MakeNewTypeSymbIdent unboxed_array_id.pds_ident arity, pState)
+
+makeTupleTypeSymbol form_arity act_arity  pState=:{ps_pre_def_symbols}
+	#! tuple_id = ps_pre_def_symbols.[GetTupleTypeIndex form_arity]
+	= (MakeNewTypeSymbIdent tuple_id.pds_ident act_arity, pState)
+
+makeNilExpression pState=:{ps_pre_def_symbols}
+	#! nil_id = ps_pre_def_symbols.[PD_NilSymbol]
+	= (PE_List [PE_Ident nil_id.pds_ident], pState)
+
+makeConsExpression a1 a2 pState=:{ps_pre_def_symbols}
+	#! cons_id = ps_pre_def_symbols.[PD_ConsSymbol]
+	= (PE_List [PE_Ident cons_id.pds_ident, a1, a2], pState)
+	
+class try a	 :: !Token !*ParseState -> (!Optional a, !*ParseState)
+class want a :: !*ParseState -> (!a, !*ParseState)
+
+stringToIdent :: !String !IdentClass !*ParseState -> (!Ident, !*ParseState)
+stringToIdent ident ident_class pState=:{ps_hash_table}
+	# (ident, ps_hash_table) = putIdentInHashTable ident ident_class ps_hash_table
+	= (ident, { pState & ps_hash_table = ps_hash_table } )
+
+internalIdent :: !String !*ParseState -> (!Ident, !*ParseState)
+internalIdent prefix pState
+	# ({fp_line,fp_col},pState=:{ps_hash_table})	= getPosition pState
+	  case_string									= prefix +++ toString fp_line +++ "_" +++ toString fp_col
+	  (case_ident, ps_hash_table)					= putIdentInHashTable case_string IC_Expression ps_hash_table
+	= (case_ident, { pState & ps_hash_table = ps_hash_table } )
+
+erroneousIdent = { id_name = "", id_info = nilPtr }
+
+/*
+	Some general overloaded parsing routines
+*/
+
+wantSequence :: !Token !Context !*ParseState -> (!.[a],!*ParseState) | want a
+wantSequence separator context pState
+	# (first, pState) = want pState
+	  (token, pState) = nextToken context pState
+	| separator == token
+		# (rest, pState) = wantSequence separator context pState
+		= ([first : rest], pState)
+	// otherwise // separator <> token
+	= ([first], tokenBack pState)
+/*
+optionalSequence start_token separator context pState
+	# (token, pState) = nextToken context pState
+	| token == start_token
+		= wantSequence separator context pState
+		= ([], tokenBack pState)
+*/
+parseList try_fun pState :== parse_list pState // try_fun *
+//parseList try_fun pState = parse_list pState
+	where
+	//	parse_list :: !*ParseState -> (tree, *ParseState)
+		parse_list pState
+			# (succ, tree, pState) = try_fun pState
+			| succ
+				# (trees, pState) = parse_list pState
+				= ([tree : trees], pState)
+			= ([], pState)
+
+//wantSepList msg sep_token context try_fun pState = want_list msg pState
+wantSepList msg sep_token context try_fun pState :== want_list msg pState // try_fun (sep_token tryfun)*
+	where
+		want_list msg pState
+			# (succ, tree, pState) = try_fun pState
+			| succ
+			 	# (token, pState) = nextToken context pState
+			 	| token == sep_token
+					# (trees, pState) = optSepList sep_token context try_fun pState
+					= ([tree : trees], pState)
+				// otherwise // token <> sep_token
+					= ([tree], tokenBack pState)
+				# (token, pState) = nextToken GeneralContext pState
+				= ([tree], parseError "wantList" (Yes token) msg pState)
+
+//optSepList sep_token context try_fun pState = want_list msg pState
+optSepList sep_token context try_fun pState :== want_list pState // [ try_fun (sep_token tryfun)* ]
+	where
+		want_list pState
+			# (succ, tree, pState) = try_fun pState
+			| succ
+			 	# (token, pState) = nextToken context pState
+			 	| token == sep_token
+					# (trees, pState) = want_list pState
+					= ([tree : trees], pState)
+				// otherwise // token <> sep_token
+					= ([tree], tokenBack pState)
+			= ([], pState)
+
+//wantList msg try_fun pState = want_list msg pState
+wantList msg try_fun pState :== want_list msg pState // try_fun +
+	where
+		want_list msg pState
+			# (succ, tree, pState) = try_fun pState
+			| succ
+				# (trees, pState) = parseList try_fun pState
+				= ([tree : trees], pState)
+				# (token, pState) = nextToken GeneralContext pState
+				= ([tree], parseError "wantList" (Yes token) msg pState)
+/*
+instance want (a,b) | want a & want b
+where
+	want pState
+		# (x, pState) = want pState
+		  (y, pState) = want pState
+		= ((x,y), pState)
+*/
+wantIdents :: !Context !IdentClass !ParseState -> (![Ident], !ParseState)
+wantIdents context ident_class pState
+	# (first_name, pState) = want pState
+	  (first_ident, pState) = stringToIdent first_name ident_class pState
+	  (token, pState) = nextToken context pState
+	| token == CommaToken
+		# (rest, pState) = wantIdents context ident_class pState
+		= ([first_ident : rest], pState)
+	= ([first_ident], tokenBack pState)
+
+optionalPriority :: !Bool !Token !ParseState -> (Priority, !ParseState)
+optionalPriority isinfix (PriorityToken prio) pState
+	= (prio, pState)
+optionalPriority isinfix token pState
+	| isinfix
+		= (DummyPriority, tokenBack pState)
+		= (NoPrio, tokenBack pState)
+
+/*
+	Modules
+*/
+
+::	ParseContext	:== Int
+
+cICLContext			:== 1
+cGlobalContext		:== 2
+cDCLContext			:== 0
+cLocalContext		:== 1
+
+SetGlobalContext iclmodule
+	| iclmodule
+		= cICLContext bitor cGlobalContext
+		= cDCLContext bitor cGlobalContext
+		
+SetLocalContext context 	:== context bitand (bitnot cGlobalContext)
+
+isLocalContext context	:== context bitand cGlobalContext == 0
+isGlobalContext context	:== not (isLocalContext context)
+
+isDclContext context	:== context bitand cICLContext == 0
+isIclContext context	:== not (isDclContext context)
+
+cWantIclFile :== True	
+cWantDclFile :== False	
+
+wantModule :: !Bool !Ident !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files
+	-> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files)
+wantModule iclmodule file_id=:{id_name} hash_table error searchPaths pre_def_symbols files
+	# file_name = if iclmodule (id_name +++ ".icl") (id_name +++ ".dcl")
+	= case openScanner file_name searchPaths files of
+		(Yes scanState, files) -> initModule file_name scanState pre_def_symbols files
+		(No       , files) -> let mod = { mod_name = file_id, mod_type = MK_None, mod_imports = [], mod_imported_objects = [], mod_defs = [] } in
+							  (False, mod, hash_table, error <<< "Could not open: " <<< file_name, pre_def_symbols, files)
+where
+	initModule :: String ScanState !*PredefinedSymbols *Files -> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files)
+	initModule file_name scanState pre_def_symbols files
+		# (succ, mod_type, mod_name, scanState) = try_module_header iclmodule scanState
+		| succ
+			# pState				=	{ ps_scanState = scanState
+										, ps_error = { pea_file = error, pea_ok = True }
+										, ps_skipping = False
+										, ps_hash_table = hash_table
+										, ps_pre_def_symbols = pre_def_symbols
+										}
+			  pState				= verify_name mod_name id_name file_name pState
+		  	  (mod_ident, pState)	= stringToIdent mod_name IC_Module pState
+		  	  pState				= check_layout_rule pState
+		  	  (defs, pState)		= want_definitions (SetGlobalContext iclmodule) pState
+			  {ps_scanState,ps_hash_table,ps_error,ps_pre_def_symbols}
+			  						= pState
+// RWS ...
+			  defs = if (ParseOnly && id_name <> "StdOverloaded" && id_name <> "StdArray" && id_name <> "StdEnum" && id_name <> "StdBool" && id_name <> "StdDynamics")
+						[PD_Import imports \\ PD_Import imports <- defs]
+						defs
+// ... RWS
+			  mod					= { mod_name = mod_ident, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = defs }
+			= ( ps_error.pea_ok
+			  , mod, ps_hash_table
+			  , ps_error.pea_file
+			  , ps_pre_def_symbols
+			  , closeScanner ps_scanState files
+			  )
+		// otherwise // ~ succ
+		# mod = { mod_name = file_id, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = [] }
+		= (False, mod, hash_table, error <<< '[' <<< file_id <<< "]: " <<< "incorrect module header", pre_def_symbols, files)
+
+	try_module_header :: !Bool !ScanState -> (!Bool,!ModuleKind,!String,!ScanState)
+	try_module_header is_icl_mod scanState
+		# (token, scanState) = nextToken GeneralContext scanState
+		| is_icl_mod
+			| token == ModuleToken
+				# (token, scanState) = nextToken GeneralContext scanState
+				= try_module_name token MK_Main scanState
+			| token == ImpModuleToken 
+				= try_module_token MK_Module scanState
+			| token == SysModuleToken
+				= try_module_token MK_System scanState
+				= (False, MK_None, "", tokenBack scanState)
+		| token == DefModuleToken
+		  	= try_module_token MK_Module scanState
+		| token == SysModuleToken
+		  	= try_module_token MK_System scanState
+			= (False, MK_None, "", tokenBack scanState)
+
+	try_module_token :: !ModuleKind !ScanState -> (!Bool,!ModuleKind!,!String,!ScanState)
+	try_module_token mod_type scanState
+		# (token, scanState) = nextToken GeneralContext scanState
+		| token == ModuleToken
+			# (token, scanState) = nextToken GeneralContext scanState
+ 			= try_module_name token mod_type scanState
+			= (False, mod_type, "", tokenBack scanState)
+
+	try_module_name (IdentToken name) mod_type scanState
+		= (True, mod_type, name, scanState) //-->> ("module",name)
+	try_module_name token mod_type scanState
+		= (False, mod_type, "", tokenBack scanState)
+	
+	verify_name name id_name file_name pState=:{ps_error={pea_file}}
+		| name == id_name
+	  		= pState
+	  		# pea_file = pea_file <<< "Module name \"" <<< name <<< "\" does not match file name \"" <<< file_name <<< "\"\n"
+			= { pState & ps_error = { pea_file = pea_file, pea_ok = False }}
+
+	check_layout_rule pState
+		# (token, pState)	= nextToken GeneralContext pState
+		  use_layout		= token <> SemicolonToken && token <> EndOfFileToken // '&& token <> EndOfFileToken' to handle end groups of empty modules
+		| use_layout		= appScanState (setUseLayout use_layout) (tokenBack pState)
+							= appScanState (setUseLayout use_layout) pState
+
+	want_definitions :: !ParseContext !ParseState -> (![ParsedDefinition], !ParseState)
+	want_definitions context pState
+		= want_acc_definitions [] pState
+	where
+		want_acc_definitions :: ![ParsedDefinition] !ParseState -> (![ParsedDefinition], !ParseState)
+		want_acc_definitions acc pState
+			# (defs, pState)	= wantDefinitions context pState
+			  acc				= acc ++ defs
+			  pState			= wantEndModule pState
+			  (token, pState)	= nextToken FunctionContext pState
+			| token == EndOfFileToken
+				= (acc,  pState)
+				# pState		= parseError "want definitions" (Yes token) "End of file" pState
+				  pState		= wantEndOfDefinition "definitions" pState
+				= want_acc_definitions acc pState
+/*
+	[Definition] on local and global level
+*/
+
+wantDefinitions :: !ParseContext !ParseState -> (![ParsedDefinition], !ParseState)
+wantDefinitions context pState
+	= parseList (tryDefinition context) pState
+
+DummyPriority	:== Prio LeftAssoc 9
+
+cHasPriority 	:== True
+cHasNoPriority	:== False
+
+tryDefinition :: !ParseContext !ParseState -> (!Bool, ParsedDefinition, !ParseState)
+tryDefinition context pState
+	# (token, pState)			= nextToken GeneralContext pState
+	  (fname, linenr, pState)	= getFileAndLineNr pState
+	= try_definition context token (LinePos fname linenr) pState
+where
+	try_definition :: !ParseContext !Token !Position !ParseState -> (!Bool, ParsedDefinition, !ParseState)
+	try_definition context DoubleColonToken pos pState
+		# (def, pState) = wantTypeDef context pos pState
+		= (True, def, pState)
+	try_definition _ ImportToken pos pState
+// RWS ...
+		# (token, pState) = nextToken FunctionContext pState
+		| token == CodeToken && isIclContext context
+		# (importedObjects, pState) = wantCodeImports pState
+		= (True, PD_ImportedObjects importedObjects, pState)
+		# pState = tokenBack pState
+// ... RWS
+		# (imports, pState) = wantImports pState
+   		= (True, PD_Import imports, pState)
+	try_definition _ FromToken pos pState
+		# (imp, pState) = wantFromImports pState
+   		= (True, PD_Import [imp], pState) -->> imp
+/*	try_definition _ ExportToken pos pState
+		# (exports, pState) = wantExportDef pState
+   		= (True, PD_Export exports, pState)
+	try_definition _ ExportAllToken pos pState
+   		= (True, PD_Export ExportAll, pState)
+*/	try_definition context ClassToken pos pState
+   		# (classdef, pState) = wantClassDefinition context pos pState
+   		= (True, classdef, pState)
+	try_definition context InstanceToken pos pState
+   		# (instdef, pState) = wantInstanceDeclaration context pos pState
+   		= (True, instdef, pState)
+	try_definition context token pos pState
+		| isLhsStartToken token
+			# (lhs, pState) = want_lhs_of_def token pState
+		      (token, pState) = nextToken FunctionContext pState
+		      (def, pState) = want_rhs_of_def context lhs token (determine_position lhs pos) pState //-->> token
+			= (True, def, pState) -->>  def
+			with
+				determine_position (Yes (name, _), _)	(LinePos f l) = FunPos f l name.id_name
+		 		determine_position lhs           		pos           = pos
+		= (False, abort "no def(1)", tokenBack pState)
+
+	want_lhs_of_def :: !Token !ParseState -> (!(Optional (Ident, Bool), ![ParsedExpr]), !ParseState)
+	want_lhs_of_def token pState
+		# (succ, fname, is_infix, pState) = try_function_symbol token pState
+		| succ
+			# (args, pState) = parseList trySimpleLhsExpression pState
+			= ((Yes (fname, is_infix), args), pState)
+			# (_, exp, pState) = trySimpleLhsExpression pState
+			= ((No, [exp]), pState)
+	where
+		try_function_symbol :: !Token !ParseState -> (!Bool, Ident, !Bool, !ParseState) // (Success, Ident, Infix, ParseState)
+		try_function_symbol (IdentToken name) pState
+			# (id, pState) = stringToIdent name IC_Expression pState
+			= (True, id, False, pState)
+		try_function_symbol OpenToken pState
+			# (token, pState) = nextToken FunctionContext pState
+			= case token of
+				(IdentToken name)
+					# (token, pState) = nextToken FunctionContext pState
+					| CloseToken == token
+						# (id, pState) = stringToIdent name IC_Expression pState
+						-> (True, id, True, pState)
+						-> (False, abort "no name", False, tokenBack (tokenBack (tokenBack pState)))
+				_
+					-> (False,  abort "no name", False, tokenBack (tokenBack pState))
+		try_function_symbol token pState
+			= (False, abort "name", False, tokenBack pState)
+
+	want_rhs_of_def :: !ParseContext !(Optional (Ident, Bool), [ParsedExpr]) !Token !Position !ParseState -> (ParsedDefinition, !ParseState)
+	want_rhs_of_def context (opt_name, args) DoubleColonToken pos pState
+		# (name, is_infix, pState) = check_name_and_fixity opt_name cHasNoPriority pState
+		  (tspec, pState) = want pState		//	SymbolType
+		| isDclContext context
+			# (specials, pState) = optionalSpecials pState
+			= (PD_TypeSpec pos name (if is_infix DummyPriority NoPrio) (Yes tspec) specials, wantEndOfDefinition "type definition (1)" pState)
+			= (PD_TypeSpec pos name (if is_infix DummyPriority NoPrio) (Yes tspec) SP_None, wantEndOfDefinition "type definition (2)" pState)
+	want_rhs_of_def context (opt_name, args) (PriorityToken prio) pos pState
+		# (name, _, pState) = check_name_and_fixity opt_name cHasPriority pState
+		  (token, pState) = nextToken TypeContext pState
+		| token == DoubleColonToken
+		  	# (tspec, pState) = want pState
+			| isDclContext context
+				# (specials, pState) = optionalSpecials pState
+				= (PD_TypeSpec pos name prio (Yes tspec) specials, wantEndOfDefinition "type definition (3)" pState)
+				= (PD_TypeSpec pos name prio (Yes tspec) SP_None, wantEndOfDefinition "type definition (4)" pState)
+			= (PD_TypeSpec pos name prio No SP_None, wantEndOfDefinition "type defenition (5)" (tokenBack pState))
+	want_rhs_of_def context (No, args) token pos pState
+		# pState = want_node_def_token pState token
+  		  (rhs, pState) = wantRhs isEqualToken (tokenBack pState)
+		| isGlobalContext context
+ 			= (PD_NodeDef pos (combine_args args) rhs, parseError "RHS" No "<global definition>" pState)
+ 			= (PD_NodeDef pos (combine_args args) rhs, pState)
+	where		
+		want_node_def_token s EqualToken		= s
+		want_node_def_token s DefinesColonToken = replaceToken EqualToken s
+		want_node_def_token s token				= parseError "RHS" (Yes token) "defines token (= or =:)" s
+
+		combine_args [arg]	= arg
+		combine_args args	= PE_List args
+	want_rhs_of_def context (Yes (name, False), []) token pos pState
+		| isIclContext context && isLocalContext context && (token == DefinesColonToken || token == EqualToken)
+			# (rhs, pState) = wantRhs (\_ -> True) (tokenBack pState)
+			= (PD_NodeDef pos (PE_Ident name) rhs, pState)
+	want_rhs_of_def context (Yes (name, is_infix), args) token pos pState
+		# (fun_kind, code_allowed, pState)  = token_to_fun_kind pState token
+		  (token, pState) = nextToken FunctionContext pState
+		| isIclContext context && token == CodeToken
+			# (rhs, pState) = wantCodeRhs pState
+			| code_allowed
+  				= (PD_Function pos name is_infix args rhs fun_kind, pState)
+  			// otherwise // ~ code_allowed
+  				= (PD_Function pos name is_infix args rhs fun_kind, parseError "rhs of def" No "no code" pState)
+		# pState = tokenBack (tokenBack pState)
+		  (rhs, pState) = wantRhs isRhsStartToken pState
+		= case fun_kind of
+			FK_Function  | isDclContext context
+				->	(PD_Function pos name is_infix args rhs fun_kind, parseError "RHS" No "<type specification>" pState)
+			FK_Caf | ~(isEmpty args)
+				->	(PD_Function pos name is_infix []   rhs fun_kind, parseError "CAF" No "No arguments for a CAF" pState)
+  			_	->	(PD_Function pos name is_infix args rhs fun_kind, pState)
+	where
+		token_to_fun_kind s BarToken			= (FK_Function, False,  s)
+		token_to_fun_kind s (SeqLetToken _)		= (FK_Function, False,  s)
+		token_to_fun_kind s EqualToken			= (FK_Function, True,  s)
+		token_to_fun_kind s ColonDefinesToken	= (FK_Macro, False, s)
+		token_to_fun_kind s DoubleArrowToken	= (FK_Function, True, s)
+		token_to_fun_kind s DefinesColonToken	= (FK_Caf, False, s)
+		token_to_fun_kind s token 				= (FK_Unknown, False, parseError "RHS" (Yes token) "defines token (=, => or =:) or argument" s)
+
+	check_name_and_fixity No hasprio pState
+		= (erroneousIdent, False, parseError "Definition" No "identifier" pState)
+	check_name_and_fixity (Yes (name,is_infix)) hasprio pState
+		| not is_infix	&& hasprio	//	XXXXXXX
+			= (name, False, parseError "Definition" No "Infix operator should be inside parentheses; no infix" pState)
+			= (name, is_infix, pState)
+
+isEqualToken :: !Token -> Bool
+isEqualToken EqualToken			= True
+isEqualToken _					= False
+
+isRhsStartToken :: !Token -> Bool
+isRhsStartToken EqualToken			= True
+isRhsStartToken ColonDefinesToken	= True
+isRhsStartToken DefinesColonToken	= True
+isRhsStartToken _					= False
+
+optionalSpecials :: !ParseState -> (!Specials, !ParseState)
+optionalSpecials pState
+	# (token, pState) = nextToken TypeContext pState
+	| token == SpecialToken
+		# (specials, pState) = wantList "<special statement>" try_substitutions pState
+		= (SP_ParsedSubstitutions specials, wantEndGroup "specials" pState)
+	// otherwise // token <> SpecialToken
+		= (SP_None, tokenBack pState)
+where
+	try_substitutions pState
+		# (succ, type_var, pState) = tryTypeVar pState
+		| succ
+			# (subst, pState) = want_rest_substitutions type_var pState
+			= (True, subst, wantEndOfDefinition "substitution" pState)
+			= (False, [], pState)
+	
+	want_rest_substitutions type_var pState
+		# pState = wantToken GeneralContext "specials" EqualToken pState
+		  (type, pState) = want pState
+		  (token, pState) = nextToken GeneralContext pState
+		| token == CommaToken
+			# (next_type_var, pState) = want pState
+			  (substs, pState) = want_rest_substitutions next_type_var pState
+			= ([{ bind_src = type, bind_dst = type_var } : substs], pState)
+			= ([{ bind_src = type, bind_dst = type_var }], tokenBack pState)
+/*
+	For parsing right-hand sides of functions only
+*/
+
+wantCodeRhs :: !ParseState -> (Rhs, !ParseState)
+wantCodeRhs pState
+	# (expr, pState)	= want_code_expr pState
+	= (	{ rhs_alts		= UnGuardedExpr
+							{ ewl_nodes		= []
+							, ewl_locals	= LocalParsedDefs []
+							, ewl_expr		= expr
+							}
+		, rhs_locals	= LocalParsedDefs []
+		}
+	  , wantEndOfDefinition "code rhs" pState
+	  )
+where
+	want_code_expr :: !ParseState -> (!ParsedExpr, !ParseState)
+	want_code_expr pState
+		# (token, pState) = nextToken CodeContext pState
+		= case token of
+			OpenToken
+				#	(input, pState)	= want_bindings [] True pState
+					pState			= wantToken CodeContext "input bindings of code block" CloseToken pState
+					pState			= wantToken CodeContext "output bindings of code block" OpenToken pState
+					(out, pState)	= want_bindings [] False pState
+					pState			= wantToken CodeContext "output bindings of code block" CloseToken pState
+					(token, pState)	= nextToken CodeContext pState
+				->	case token of
+						CodeBlockToken the_code
+							-> (PE_Any_Code input out the_code, pState)
+						_	-> (PE_Any_Code input out []  , parseError "code rhs (any code)" (Yes token) "code block" pState)
+			InlineToken
+			 	#	(token, pState) = nextToken CodeContext pState
+			 	->	case token of
+			 			CodeBlockToken the_code
+			 				-> (PE_ABC_Code the_code True, pState)
+			 			token
+			 				-> (PE_ABC_Code [] True,  parseError "inline code" (Yes token) "code block" pState)
+			CodeBlockToken the_code
+				-> (PE_ABC_Code the_code False, pState)
+			token
+				-> (PE_Empty, parseError "code rhs" (Yes token) "<code rhs>" pState)
+
+	want_bindings :: !(CodeBinding Ident) !Bool !ParseState -> (!CodeBinding Ident, !ParseState)
+	want_bindings acc mayBeEmpty pState
+		# (token, pState)	= nextToken CodeContext pState
+		= case token of
+			IdentToken name
+				#	(token, pState)	= nextToken CodeContext pState
+				|	token == EqualToken || token == DefinesColonToken
+					#	(token, pState)	= nextToken CodeContext pState
+					->	case token of
+							IdentToken value
+								#	(ident, pState)	= stringToIdent name IC_Expression pState
+									acc				= [{ bind_dst = ident, bind_src = value }: acc]
+									(token, pState)	= nextToken CodeContext pState
+								|	token == CommaToken
+									->	want_bindings acc mayBeEmpty pState
+								//	token <> CommaToken
+									->	(reverse acc, tokenBack pState)
+							token
+								-> (acc, parseError "bindings in code block" (Yes token) "value" pState)
+				//	token <> EqualToken && token <> DefinesColonToken
+					->	(acc, parseError "bindings in code block" (Yes token) "= or =:" pState)
+			CloseToken
+				| mayBeEmpty
+					-> (acc, tokenBack pState) // to handle empty input bindings
+					-> (acc, parseError "code bindings" (Yes token) "output bindings" pState)
+			token
+				-> (acc, parseError "bindings in code block" (Yes token) "identifier" pState)
+/*
+	For parsing right-hand sides of functions and case expressions
+*/
+
+
+/* Syntax:
+	FunctionAltDefRhs	=	FunctionBody						// Rhs
+							[ LocalFunctionAltDefs ]
+	FunctionBody		=	exprWithLocals						// OptGuardedAlts	: GuardedAlts
+						|	GuardedAlts 						//					: UnGuardedExpr
+	GuardedAlts			=	{ [ LetBefore ] '|' [ StrictLet ] Guard FunctionBody }+ [ ExprWithLocals ]
+	ExprWithLocals		=	[ LetBefore ] sep RootExpression endOfDefinition [ LocalFunctionDefs ]
+*/
+
+wantRhs :: !(!Token -> Bool) !ParseState -> (Rhs, !ParseState) // FunctionAltDefRhs
+wantRhs separator pState
+	# (alts, pState)	= want_LetsFunctionBody separator pState
+	  (locals, pState)	= optionalLocals WhereToken pState
+	= ({ rhs_alts = alts, rhs_locals = locals}, pState)
+where
+	want_LetsFunctionBody :: !(!Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState) 
+	want_LetsFunctionBody sep pState
+		# (token, pState)			= nextToken FunctionContext pState
+		  (nodeDefs, token, pState)	= want_LetBefores token pState
+		= want_FunctionBody token nodeDefs [] sep pState
+
+	want_FunctionBody :: !Token ![NodeDefWithLocals] ![GuardedExpr] !(Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState)
+	want_FunctionBody BarToken nodeDefs alts sep pState
+//		#	(lets, pState)				= want_StrictLet pState // removed from 2.0
+		#	(token, pState)				= nextToken FunctionContext pState
+		|	token == OtherwiseToken
+			#	(token, pState)				= nextToken FunctionContext pState
+				(nodeDefs2, token, pState)	= want_LetBefores token pState
+			=	case token of
+				BarToken
+					#	pState = parseError "RHS: default alternative" No "root expression instead of guarded expression" pState
+					->	root_expression token (nodeDefs ++ nodeDefs2) (reverse alts) sep pState
+				_	->	root_expression token (nodeDefs ++ nodeDefs2) (reverse alts) sep pState
+		|	token == LetToken True
+			#	pState	= parseError "RHS" No "No 'let!' in this version of Clean" pState
+			=	root_expression token nodeDefs (reverse alts) sep pState
+		#	(guard, pState)				= wantRhsExpressionT token pState
+			(token, pState)				= nextToken FunctionContext pState
+			(nodeDefs2, token, pState)	= want_LetBefores token pState
+		|	token == BarToken // nested guard
+			#	(position, pState)			= getPosition pState
+				offside						= position.fp_col
+				(expr, pState)				= want_FunctionBody token nodeDefs2 [] sep pState
+				pState						= wantEndNestedGuard (default_found expr) offside pState
+				alt							= { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr }
+				(token, pState)				= nextToken FunctionContext pState
+				(nodeDefs, token, pState)	= want_LetBefores token pState
+			=	want_FunctionBody token nodeDefs [alt:alts] sep pState
+		// otherwise
+			#	(expr, pState)				= root_expression token nodeDefs2 [] sep pState
+				alt							= { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr }
+				(token, pState)				= nextToken FunctionContext pState
+				(nodeDefs, token, pState)	= want_LetBefores token pState
+			=	want_FunctionBody token nodeDefs [alt:alts] sep pState
+	want_FunctionBody token nodeDefs alts sep pState
+		=	root_expression token nodeDefs (reverse alts) sep pState
+	
+	root_expression :: !Token ![NodeDefWithLocals] ![GuardedExpr] !(Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState)
+	root_expression token nodeDefs [] sep pState
+		#	(expr,pState) = want_OptExprWithLocals token nodeDefs sep pState
+		=	case expr of
+				Yes expr -> ( UnGuardedExpr expr, pState)
+				No		 -> ( UnGuardedExpr {ewl_nodes = [], ewl_expr = PE_Empty, ewl_locals = LocalParsedDefs []}
+							, parseError "RHS: root expression" (Yes token) "= <ExprWithLocals>" pState
+							)
+	root_expression token nodeDefs alts sep pState
+		# (expr,pState) = want_OptExprWithLocals token nodeDefs sep pState
+		= (GuardedAlts alts expr, pState)
+	
+	default_found (GuardedAlts _ No)	= False
+	default_found _						= True
+
+	want_OptExprWithLocals :: !Token ![NodeDefWithLocals] !(Token -> Bool) !ParseState -> (!Optional !ExprWithLocalDefs, !ParseState)
+	want_OptExprWithLocals DoubleArrowToken nodeDefs sep pState
+		= want_OptExprWithLocals EqualToken nodeDefs sep (replaceToken EqualToken pState)
+	want_OptExprWithLocals token nodeDefs sep pState
+		| sep token
+		# (expr, pState)	= wantExpression cIsNotAPattern pState
+		  pState			= wantEndRootExpression pState
+		  (locals,pState)	= optionalLocals WithToken pState
+		= ( Yes	{ ewl_nodes		= nodeDefs
+				, ewl_expr		= expr
+				, ewl_locals	= locals
+				}
+		  , pState
+		  )
+		= (No, tokenBack pState)
+	
+/*	want_StrictLet :: !ParseState -> ([NodeDefWithLocals] , !ParseState) // Removed from the language !?
+	want_StrictLet pState
+		# (token, pState)	= nextToken FunctionContext pState
+		| token == LetToken True
+			# (let_defs, pState)	= wantList "<sequential node defs>" (try_LetDef True) pState
+			  pState				= wantToken FunctionContext "strict let" InToken pState
+			= (let_defs, pState)
+		= ([], tokenBack pState)
+*/ 
+	want_LetBefores :: !Token !ParseState -> (![NodeDefWithLocals], !Token, !ParseState)
+	want_LetBefores (SeqLetToken strict) pState
+		# (let_defs, pState)				= wantList "<sequential node defs>" (try_LetDef strict) pState
+		  (token, pState)					= nextToken FunctionContext pState
+		  (token, pState)					= opt_End_Group token pState
+		  (more_let_defs, token, pState)	= want_LetBefores token pState
+		= (let_defs ++ more_let_defs, token, pState)
+		where
+			opt_End_Group token pState
+			 #	(ss_useLayout, pState) = accScanState UseLayout pState
+			 |	ss_useLayout
+			 	| token == EndGroupToken
+			 		= nextToken FunctionContext pState
+			 	// otherwise // token <> EndGroupToken
+			 		= (ErrorToken "End group missing in let befores", parseError "RHS: Let befores" (Yes token) "Generated End Group (due to layout)" pState)
+			 |	otherwise // not ss_useLayout
+			 =	(token, pState)
+	want_LetBefores token pState
+		= ([], token, pState)
+	
+	try_LetDef :: !Bool !ParseState -> (!Bool, NodeDefWithLocals, !ParseState)
+	try_LetDef strict pState
+		# (succ, lhs_exp, pState)	= trySimpleLhsExpression pState
+		| succ
+			# pState			= wantToken FunctionContext "let definition" EqualToken pState
+			  (rhs_exp, pState) = wantExpression cIsNotAPattern pState
+			  pState			= wantEndRootExpression pState -->> ("#",lhs_exp,"=",rhs_exp)
+	  	  	  (locals , pState) = optionalLocals WithToken pState
+			=	( True
+				, {	ndwl_strict	= strict
+				  ,	ndwl_def	= { bind_dst = lhs_exp
+				  				  , bind_src = rhs_exp
+				  				  }
+				  , ndwl_locals	= locals
+				  }
+				, pState
+				)
+		// otherwise // ~ succ
+			= (False, abort "no definition", pState)
+
+optionalLocals :: !Token !ParseState -> (!LocalDefs, !ParseState)
+optionalLocals dem_token pState
+    # (off_token, pState) = nextToken FunctionContext pState
+	| dem_token == off_token
+		= wantLocals pState
+	# (ss_useLayout, pState) = accScanState UseLayout pState
+	| off_token == CurlyOpenToken && ~ ss_useLayout 
+		= wantLocals (tokenBack pState)
+	// otherwise
+		= (LocalParsedDefs [], tokenBack pState)
+
+wantLocals :: !ParseState -> (LocalDefs, !ParseState)
+wantLocals pState
+	# pState			= wantBeginGroup "local definitions" pState
+	  (defs, pState)	= wantDefinitions cLocalContext pState
+	= (LocalParsedDefs defs, wantEndLocals pState)
+
+/*
+	imports and exports
+*/
+
+wantImports :: !ParseState -> (![ParsedImport], !ParseState)
+wantImports pState
+	# (names, pState) = wantIdents FunctionContext IC_Module pState
+	  (file_name, line_nr, pState)	= getFileAndLineNr pState
+	  pState = wantEndOfDefinition "imports" pState
+	= (map (\name -> { import_module = name, import_symbols = [], import_file_position = (file_name, line_nr)}) names, pState)
+
+wantFromImports :: !ParseState -> (!ParsedImport, !ParseState)
+wantFromImports pState
+	# (mod_name, pState) = want pState
+	  (mod_ident, pState) = stringToIdent mod_name IC_Module pState
+	  pState = wantToken GeneralContext "from imports" ImportToken pState
+	  (file_name, line_nr, pState)	= getFileAndLineNr pState
+	  (import_symbols, pState) = wantSequence CommaToken GeneralContext pState
+	  pState = wantEndOfDefinition "from imports" pState
+	= ( { import_module = mod_ident, import_symbols = import_symbols, import_file_position = (file_name, line_nr) }, pState)
+
+// RWS ...
+instance want ImportedObject where
+	want pState
+		# (token, pState) = nextToken GeneralContext pState
+		| token == IdentToken "library"
+	  		# (token, pState) = nextToken GeneralContext pState
+			= want_import_string token cIsImportedLibrary pState
+			= want_import_string token cIsImportedObject pState
+		where		
+			want_import_string :: Token Bool ParseState -> (ImportedObject, ParseState)
+			want_import_string (StringToken string) isLibrary pState
+				=	({io_is_library = isLibrary, io_name = string}, pState)
+			want_import_string token isLibrary pState
+				=	({io_is_library = isLibrary, io_name = ""}, parseError "import code declaration" (Yes token) "imported item" pState)
+
+wantCodeImports :: !ParseState -> (![ImportedObject], !ParseState)
+wantCodeImports pState
+	# pState = wantToken GeneralContext "import code declaration" FromToken pState
+	  (importObjects, pState) = wantSequence CommaToken GeneralContext pState
+	= (importObjects, wantEndOfDefinition "import code declaration" pState)
+// ... RWS
+
+instance want ImportDeclaration
+where
+	want pState
+		# (token, pState) = nextToken GeneralContext pState
+		= case token of
+			DoubleColonToken
+				# (name, pState)				= wantUpperCaseName "import type" pState
+				  (type_id, pState)				= stringToIdent name IC_Type pState
+				  (ii_extended, token, pState)	= optional_extension_with_next_token pState
+				| token == OpenToken
+				  	#	(conses, pState)			= want_names (wantUpperCaseName "import type (..)") IC_Expression CloseToken pState
+				  	->	(ID_Type { ii_ident = type_id, ii_extended = ii_extended } (Yes conses), pState)
+				| token == CurlyOpenToken
+				  	#	(fields, pState) = want_names (wantLowerCaseName "import record fields") (IC_Field type_id) CurlyCloseToken pState
+				  	->	(ID_Record { ii_ident = type_id, ii_extended = ii_extended } (Yes fields), pState)
+				  	->	(ID_Type { ii_ident = type_id, ii_extended = ii_extended } No, tokenBack pState)
+			ClassToken
+				# (name, pState)				= want pState
+				  (class_id, pState)			= stringToIdent name IC_Class pState
+				  (ii_extended, token, pState)	= optional_extension_with_next_token pState
+				| token == OpenToken
+				  	#	(members, pState)			= want_names want IC_Expression CloseToken pState
+				  	->	(ID_Class { ii_ident = class_id, ii_extended = ii_extended } (Yes members), pState)
+				  	->	(ID_Class { ii_ident = class_id, ii_extended = ii_extended } No, pState)
+			InstanceToken
+				#	(class_name, pState)	= want pState
+					(ii_extended, pState)	= optional_extension pState
+					(types, pState)			= wantList "instance types" tryBrackType pState
+					(class_id, pState)		= stringToIdent class_name IC_Class pState
+					(inst_id, pState)		= stringToIdent class_name (IC_Instance types) pState
+					(context, pState)		= optionalContext pState
+				->	(ID_Instance { ii_ident = class_id, ii_extended = ii_extended } inst_id (types,context), pState)
+			IdentToken fun_name
+				#	(fun_id, pState)		= stringToIdent fun_name IC_Expression pState
+					(ii_extended, pState)	= optional_extension pState
+				->	(ID_Function { ii_ident = fun_id, ii_extended = ii_extended }, pState)
+			token
+				#	(fun_id, pState)		= stringToIdent "dummy" IC_Expression pState
+				->	( ID_Function { ii_ident = fun_id, ii_extended = False }
+					, parseError "from import" (Yes token) "imported item" pState
+					)
+	where				
+		want_names want_fun ident_kind close_token pState
+			# (token, pState) = nextToken FunctionContext pState
+			| token == DotDotToken
+				= ([], wantToken FunctionContext "import declaration" close_token pState)
+				= want_list_of_names want_fun ident_kind close_token (tokenBack pState)
+
+		want_list_of_names want_fun ident_kind close_token pState
+			# (name, pState) = want_fun pState
+			  (name_id, pState)	= stringToIdent name ident_kind pState
+			  (ii_extended, token, pState) = optional_extension_with_next_token pState
+			| token == CommaToken
+				# (names, pState) = want_list_of_names want_fun ident_kind close_token pState
+				= ([{ ii_ident = name_id, ii_extended = ii_extended } : names], pState)
+			| token == close_token
+				= ([{ ii_ident = name_id, ii_extended = ii_extended }], pState)
+				= ([{ ii_ident = name_id, ii_extended = ii_extended }], parseError "ImportDeclaration" (Yes token) ")" pState)
+			
+		optional_extension pState
+			# (token, pState) = nextToken FunctionContext pState
+			| token == DotDotToken
+				= (True, pState)
+				= (False, tokenBack pState)			
+			
+		optional_extension_with_next_token pState
+			# (token, pState) = nextToken FunctionContext pState
+			| token == DotDotToken
+				# (token, pState) = nextToken FunctionContext pState
+				= (True, token, pState)
+				= (False, token, pState)
+
+/*						
+wantExportDef :: !ParseState -> (!Export, !ParseState)
+wantExportDef pState
+	# (name, pState) = want pState
+	  (ident, pState) = stringToIdent name IC_Class pState
+	  (types, pState) = wantList "instance types" trySimpleType pState
+	  pState = wantEndOfDefinition "exports" pState
+	= ({ export_class = ident, export_types = types}, pState)
+*/
+/*
+	Classes and instances
+*/
+
+cIsAGlobalContext		:== True
+cIsNotAGlobalContext	:== False
+
+cMightBeAClass			:== True
+cIsNotAClass			:== False
+
+		
+wantClassDefinition :: !ParseContext !Position !ParseState -> (!ParsedDefinition, !ParseState)
+wantClassDefinition context pos pState
+	# (might_be_a_class, class_or_member_name, prio, pState) = want_class_or_member_name pState
+	  (class_variables, pState) = wantList "class variable(s)" try_class_variable pState
+	  (class_arity, class_args, class_cons_vars) = convert_class_variables class_variables 0 0
+	  (contexts, pState) = optionalContext pState
+  	  (token, pState) = nextToken TypeContext pState
+  	| token == DoubleColonToken
+		= want_overloaded_function pos class_or_member_name prio class_arity class_args class_cons_vars contexts pState
+	| might_be_a_class
+		| token == WhereToken
+			# (class_id, pState) = stringToIdent class_or_member_name IC_Class pState
+		 	  (members, pState) = wantDefinitions context pState
+  		  	  class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args,
+	    					class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars,
+	    					class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }}
+			= (PD_Class class_def members, wantEndGroup "class" pState)
+		| isEmpty contexts
+			= (PD_Erroneous, parseError "Class Definition" (Yes token) "<class definition>: contexts" pState)
+		// otherwise
+			# pState = tokenBack pState
+			  (class_id, pState) = stringToIdent class_or_member_name IC_Class pState
+  			  class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args,
+							class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars, 
+							class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }}
+	  		  pState = wantEndOfDefinition "class definition" pState
+			= (PD_Class class_def [], pState)
+		= (PD_Erroneous, parseError "Class Definition" (Yes token) "<class definition>" pState)
+	where
+		want_class_or_member_name pState 
+			# (token, pState) = nextToken TypeContext pState
+			| token == OpenToken
+				# (member_name, pState) = want pState
+				  pState = wantToken GeneralContext "class definition" CloseToken pState
+				  (token, pState) = nextToken FunctionContext pState
+				  (prio, pState) = optionalPriority cIsInfix token pState  
+				= (cIsNotAClass, member_name, prio, pState)
+ 				# (class_name, pState) = want_name token pState
+				= (cMightBeAClass, class_name, NoPrio, pState)
+		where
+			want_name (IdentToken name) pState
+				= (name, pState)
+			want_name token pState
+				= ("", parseError "Class Definition" (Yes token) "<identifier>" pState)
+
+		want_overloaded_function pos member_name prio class_arity class_args class_cons_vars contexts pState
+			# (tspec, pState) = want pState
+			  (member_id, pState) = stringToIdent member_name IC_Expression pState
+			  (class_id, pState) = stringToIdent member_name IC_Class pState
+			  member = PD_TypeSpec pos member_id prio (Yes tspec) SP_None
+			  class_def = {	class_name = class_id, class_arity = class_arity, class_args = class_args,
+		    				class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars,
+   							class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }}
+	 		  pState = wantEndOfDefinition "overloaded function" pState
+			= (PD_Class class_def [member], pState)
+
+		try_class_variable pState
+			# (token, pState) = nextToken TypeContext pState
+			| token == DotToken
+				# (type_var, pState) = wantTypeVar pState
+				= (True, (True, type_var), pState)
+			# (succ, type_var, pState) = tryTypeVarT token pState
+			= (succ, (False, type_var), pState)
+		
+		convert_class_variables [] arg_nr cons_vars
+			= (arg_nr, [], cons_vars)
+		convert_class_variables [(annot, var) : class_vars] arg_nr cons_vars
+			# (arity, class_vars, cons_vars) = convert_class_variables class_vars (inc arg_nr) cons_vars
+			| annot
+				= (arity, [var : class_vars], cons_vars bitor (1 << arg_nr))
+				= (arity, [var : class_vars], cons_vars)
+
+// Sjaak ...
+wantInstanceDeclaration :: !ParseContext !Position !ParseState -> (!ParsedDefinition, !ParseState)
+wantInstanceDeclaration context pi_pos pState
+	# (class_name, pState) = want pState
+	  (pi_class, pState) = stringToIdent class_name IC_Class pState
+	  ((pi_types, pi_context), pState) = want_instance_type pState
+	  (pi_ident, pState) = stringToIdent class_name (IC_Instance pi_types) pState
+	| isIclContext context
+		# pState = wantToken FunctionContext "instance declaration" WhereToken pState
+		  pState = wantBeginGroup "instance" pState
+		  (pi_members, pState) = wantDefinitions context pState
+		  pState = wantEndLocals pState
+
+		= (PD_Instance {pi_class = pi_class, pi_ident = pi_ident, pi_types = pi_types, pi_context = pi_context,
+						pi_members = pi_members, pi_specials = SP_None, pi_pos = pi_pos }, pState)
+	// otherwise // ~ (isIclContext context)
+		# (token, pState) = nextToken TypeContext pState
+		| token == CommaToken
+			# (pi_types_and_contexts, pState)	= want_instance_types pState
+			  (idents, pState)		= seqList [stringToIdent class_name (IC_Instance type) \\ (type,context) <- pi_types_and_contexts] pState
+			= (PD_Instances
+//				[	{ pi_class = pi_class, pi_ident = pi_ident, pi_types = type, pi_context = context // voor martin
+				[	{ pi_class = pi_class, pi_ident = ident, pi_types = type, pi_context = context
+					, pi_members = [], pi_specials = SP_None, pi_pos = pi_pos}
+				\\	(type,context)	<- [ (pi_types, pi_context) : pi_types_and_contexts ]
+				&	ident			<- [ pi_ident : idents ]
+				]
+			  , pState
+			  )
+		// otherwise // token <> CommaToken
+			# (specials, pState) = optionalSpecials (tokenBack pState)
+			  pState = wantEndOfDefinition "instance declaration" pState
+			= (PD_Instance {pi_class = pi_class, pi_ident = pi_ident, pi_types = pi_types, pi_context = pi_context,
+							pi_members = [], pi_specials = specials, pi_pos = pi_pos}, pState)
+// ... Sjaak
+where
+	want_instance_type pState
+		# (pi_types, pState)	= wantList "instance types" tryBrackType pState
+//		# (pi_types, pState)	= wantList "instance types" tryType pState	// This accepts 1.3 syntax, but is wrong for multiparameter classes
+		  (pi_context, pState)	= optionalContext pState
+		= ((pi_types, pi_context), pState)
+	want_instance_types pState
+		# (type_and_context, pState) = want_instance_type pState
+		  (token, pState) = nextToken TypeContext pState
+		| token == CommaToken
+			# (types, pState) = want_instance_types pState
+			= ([type_and_context:types], pState)
+		// otherwise // token <> CommaToken
+			= ([type_and_context], pState)
+
+optionalContext :: !ParseState -> ([TypeContext],ParseState)
+optionalContext pState
+	# (token, pState) = nextToken TypeContext pState
+	| token == BarToken
+		= want_contexts pState
+		= ([], tokenBack pState)
+where
+	want_contexts pState
+		# (contexts, pState) = want_context pState
+		  (token, pState) = nextToken TypeContext pState
+		| token == AndToken
+			# (more_contexts, pState) = want_contexts pState
+			= (contexts ++ more_contexts, pState)
+			= (contexts, tokenBack pState)
+			
+	want_context pState
+		# (class_names, pState) = wantSequence CommaToken TypeContext pState
+		  (types, pState)	= wantList "type arguments" tryBrackType pState
+		= build_contexts class_names types (length types) pState
+	where
+		build_contexts [] types arity pState
+			= ([], pState)
+		build_contexts [class_name : class_names] types arity pState
+			# (contexts, pState) = build_contexts class_names types arity pState
+			  (class_ident, pState) = stringToIdent class_name IC_Class pState
+			  tc_class = { glob_object = MakeDefinedSymbol class_ident NoIndex (length types), glob_module = NoIndex }
+			= ([{ tc_class = tc_class, tc_types = types, tc_var = nilPtr } : contexts], pState)
+
+optionalCoercions :: !ParseState -> ([AttrInequality], ParseState)
+optionalCoercions pState 
+	# (token, pState) = nextToken TypeContext pState
+	| token == CommaToken
+		# (token, pState) = nextToken TypeContext pState
+		| token == SquareOpenToken
+			# (inequals, pState) = want_inequalities pState
+			= (inequals, wantToken FunctionContext "coercions" SquareCloseToken pState)
+			= ([], parseError "Function type: coersions" (Yes token) "[" pState)
+		= ([], tokenBack pState)
+	where
+		want_inequalities pState
+			# (token, pState) = nextToken TypeContext pState
+ 			  (_, inequals, pState) = want_attr_inequality token pState
+			  (token, pState) = nextToken TypeContext pState
+			| token == CommaToken
+				# (more_inequals, pState) = want_inequalities pState
+				= (inequals ++ more_inequals, pState)
+				= (inequals, tokenBack pState)
+		want_attr_inequality (IdentToken var_name) pState
+			| isLowerCaseName var_name
+				# (off_ident, pState) = stringToIdent var_name IC_TypeAttr pState
+				  (token, pState) = nextToken  TypeContext pState
+				| token == LessThanOrEqualToken
+					# (var_name, pState) = wantLowerCaseName "attribute inequality" pState
+					  (dem_ident, pState) = stringToIdent var_name IC_TypeAttr pState
+					  ai_demanded = makeAttributeVar dem_ident
+					= (ai_demanded, [{ ai_demanded = ai_demanded, ai_offered = makeAttributeVar off_ident }], pState)				
+					# (ai_demanded, inequals, pState) = want_attr_inequality token pState
+					= (ai_demanded, [{ ai_demanded = ai_demanded, ai_offered = makeAttributeVar off_ident } : inequals], pState)
+		want_attr_inequality token pState
+			# erroneous_attr_var = makeAttributeVar erroneousIdent
+			= (	erroneous_attr_var
+			  , [{ ai_demanded = erroneous_attr_var, ai_offered = erroneous_attr_var }]
+			  , parseError "Function type: optional coercions" (Yes token) "<attribute variable>" pState
+			  )
+
+/*
+	Type definitions
+*/
+
+wantTypeVar :: ! ParseState -> (!TypeVar, !ParseState)
+wantTypeVar pState
+	# (succ, type_var, pState) = tryTypeVar pState
+	| succ
+		= (type_var, pState)
+		# (token, pState) = nextToken TypeContext pState
+		= (MakeTypeVar erroneousIdent, parseError "Type Variable" (Yes token) "type variable" pState)
+
+tryAttributedTypeVar :: !ParseState -> (!Bool, ATypeVar, !ParseState)
+tryAttributedTypeVar pState
+	# (token, pState) = nextToken TypeContext pState
+	| is_type_arg_token token
+		# (aOrA, annot, attr, pState)	= optionalAnnotAndAttr (tokenBack pState)
+	      (succ, type_var, pState)		= tryTypeVar pState
+	    | succ
+			= (True, { atv_attribute = attr, atv_annotation = annot, atv_variable = type_var }, pState)
+		| aOrA // annot <> AN_None || attr <> TA_None
+			# (token, pState) = nextToken TypeContext pState
+			= (False, no_type_var, parseError "Attributed type var" (Yes token) "type variabele after annotation or attribute" pState)
+		// otherwise
+	    	= (False, no_type_var, tokenBack pState)
+	// otherwise
+		= (False, no_type_var, tokenBack pState)
+where	
+	is_type_arg_token (IdentToken t)	= isLowerCaseName t
+	is_type_arg_token DotToken       	= True
+	is_type_arg_token AsteriskToken  	= True
+	is_type_arg_token t              	= False
+	
+	no_type_var = abort "tryAttributedTypeVar: No type var"
+
+wantTypeDef ::  !ParseContext !Position !ParseState -> (ParsedDefinition, !ParseState)
+wantTypeDef context pos pState
+	# (type_lhs, annot, pState)	= want_type_lhs pos pState
+	  (token, pState)			= nextToken TypeContext pState
+	  (def, pState)				= want_type_rhs context type_lhs token annot pState
+  	  pState					= wantEndOfDefinition "type definition (6)" pState
+  	= (def, pState)
+where
+	want_type_lhs :: !Position !ParseState -> (!ParsedTypeDef, !Annotation, !ParseState)
+	want_type_lhs pos pState
+		# (_, annot, attr, pState)	= optionalAnnotAndAttr pState
+		  (name,    pState)			= wantConstructorName "Type name" pState
+		  (ident,   pState)			= stringToIdent name IC_Type pState // -->> ("Type name",name)
+		  (args,    pState)			= parseList tryAttributedTypeVar pState
+		  (contexts, pState)		= optionalContext pState
+		= (MakeTypeDef ident args (ConsList []) attr contexts pos, annot, pState)
+
+	want_type_rhs :: !ParseContext !ParsedTypeDef !Token !Annotation !ParseState -> (ParsedDefinition, !ParseState)
+	want_type_rhs context td=:{td_name,td_attribute} EqualToken annot pState
+		# name					= td_name.id_name
+		  pState				= verify_annot_attr annot td_attribute name pState
+		  (exi_vars, pState)	= optionalQuantifiedVariables ExistentialQuantifier pState
+ 		  (token, pState)		= nextToken TypeContext pState
+ 		  (token, pState)		= case token of	// Make the ':' optional for now to handle 1.3 files
+ 		  							ColonToken	-> nextToken TypeContext (parseWarning "type RHS" ":-symbol after extential quantified variable should be removed" pState)
+ 		  							_			-> (token, pState)
+ 		= case token of
+  			CurlyOpenToken
+				#	(fields, pState)			= wantFields td_name pState
+					pState						= wantToken TypeContext "record type def" CurlyCloseToken pState
+				  	(rec_cons_ident, pState)	= stringToIdent ("_" + name) IC_Expression pState
+   				->	(PD_Type { td & td_rhs = SelectorList rec_cons_ident exi_vars fields }, pState)
+   			ColonToken
+   				| isEmpty exi_vars
+				->	(PD_Erroneous, parseError "Algebraic type" No "no colon, :," pState)
+				->	(PD_Erroneous, parseError "Algebraic type" No "in this version of Clean no colon, :, after quantified variables" pState)
+  			_
+				#	(condefs, pState)	= want_constructor_list exi_vars token pState
+					td					= { td & td_rhs = ConsList condefs }
+				|	annot == AN_None
+	 		  		->	(PD_Type td, pState)
+	 		  		->	(PD_Type td, parseError "Algebraic type" No ("No lhs strictness annotation for the algebraic type "+name) pState)
+	want_type_rhs context td=:{td_attribute} ColonDefinesToken annot pState // type Macro
+		# name				= td.td_name.id_name
+		  pState			= verify_annot_attr annot td_attribute name pState
+		  (atype, pState)	= want pState // Atype
+		  td				= {td & td_rhs = TypeSpec atype}
+		|	annot == AN_None
+			= (PD_Type td, pState)
+			= (PD_Type td, parseError "Type synonym" No ("No lhs strictness annotation for the type synonym "+name) pState)
+	want_type_rhs context td=:{td_attribute} token annot pState
+		| isIclContext context
+			= (PD_Erroneous, parseError "type RHS" (Yes token) "type definition" pState)
+			| td_attribute == TA_Anonymous || td_attribute == TA_Unique || td_attribute == TA_None
+				# (td_attribute, properties) = determine_properties annot td_attribute
+				# td = { td & td_attribute = td_attribute, td_rhs = EmptyRhs properties}
+				= (PD_Type td, tokenBack pState)
+				# name = td.td_name.id_name
+				= (PD_Type  { td & td_rhs = EmptyRhs cAllBitsClear}, parseError "abstract type" No ("type attribute "+toString td_attribute+" for abstract type "+name+" is not") (tokenBack pState))
+	
+	verify_annot_attr :: !Annotation !TypeAttribute !String !ParseState -> ParseState
+	verify_annot_attr annot attr name pState
+		| annot <> AN_None
+			= parseError "type definition" No ("No annotation, "+toString annot+", in the lhs of type "+name) pState
+		| attr == TA_None || attr == TA_Unique
+			= pState
+			= parseError "ty[e definition" No ("No attribute, "+toString attr+", in the lhs of type "+name) pState
+
+	determine_properties :: !Annotation !TypeAttribute -> (!TypeAttribute, !BITVECT)
+	determine_properties annot attr
+		| annot == AN_Strict
+			| attr == TA_Anonymous
+				= (TA_None, cIsHyperStrict)
+				= (attr, cIsHyperStrict bitor cIsNonCoercible)
+		| attr == TA_Anonymous
+			= (TA_None, cAllBitsClear)
+			= (attr, cIsNonCoercible)
+
+	want_constructor_list :: ![ATypeVar] !Token !ParseState -> (.[ParsedConstructor],ParseState)
+	want_constructor_list exi_vars token pState
+		# (pc_cons_name,  pc_cons_prio, pc_cons_pos, pState) = want_cons_name_and_prio token pState
+		  (pc_arg_types, pState) = parseList tryBrackAType pState
+		  cons = { pc_cons_name = pc_cons_name, pc_arg_types = pc_arg_types, pc_cons_arity = length pc_arg_types,
+		  			pc_cons_prio = pc_cons_prio, pc_exi_vars = exi_vars, pc_cons_pos = pc_cons_pos}
+		  (token, pState) = nextToken TypeContext pState
+		| token == BarToken
+			# (exi_vars, pState) = optionalQuantifiedVariables ExistentialQuantifier pState
+			  (token, pState) = nextToken TypeContext pState
+			  (cons_list, pState) = want_constructor_list exi_vars token pState
+			= ([cons : cons_list], pState)
+		// otherwise
+			= ([cons], tokenBack pState)
+	where
+		want_cons_name_and_prio :: !Token !ParseState -> (Ident, !Priority, !Position, !ParseState)
+		want_cons_name_and_prio tok=:(IdentToken name) pState
+			# (ident, pState) = stringToIdent name IC_Expression pState
+		 	  (fname, linenr, pState) = getFileAndLineNr pState
+		  	  (token, pState) = nextToken TypeContext pState
+		  	  (prio,  pState) = optionalPriority cIsNotInfix token pState
+		  	| isLowerCaseName name
+				= (ident, prio, LinePos fname linenr, parseError "Algebraic type: constructor definitions" (Yes tok) "constructor name" pState)
+				= (ident, prio, LinePos fname linenr, pState)
+		want_cons_name_and_prio OpenToken pState
+			# (name, pState) = wantConstructorName "infix constructor" pState
+		 	  (fname, linenr, pState) = getFileAndLineNr pState
+			  (ident, pState) = stringToIdent name IC_Expression pState
+		      (token, pState) = nextToken TypeContext (wantToken TypeContext "type: constructor and prio" CloseToken pState)
+			  (prio, pState) = optionalPriority cIsInfix token pState
+			= (ident, prio, LinePos fname linenr, pState)
+		want_cons_name_and_prio token pState
+			= (erroneousIdent, NoPrio, NoPos, parseError "Algebraic type: constructor list" (Yes token) "constructor name" pState)
+
+makeAttributeVar name :== { av_name = name, av_info_ptr = nilPtr }
+
+optionalAnnotAndAttr :: !ParseState -> (!Bool, !Annotation, !TypeAttribute, !ParseState)
+optionalAnnotAndAttr pState
+   	# (token, pState) = nextToken TypeContext pState
+   	| token == ExclamationToken
+	  	# (token, pState) = nextToken TypeContext pState
+		  (_   , attr, pState)  = optional_attribute token pState
+		= (True, AN_Strict, attr, pState)
+	| otherwise // token <> ExclamationToken
+		# (succ, attr, pState)  = optional_attribute token pState
+		= (succ, AN_None, attr, pState)
+where		  
+	optional_attribute :: !Token !ParseState -> (!Bool, !TypeAttribute, !ParseState)
+	optional_attribute DotToken           pState = (True, TA_Anonymous,    pState)
+	optional_attribute AsteriskToken      pState = (True, TA_Unique, pState)
+	optional_attribute (IdentToken id) pState
+		| isLowerCaseName id
+	  	# (token, pState) = nextToken TypeContext pState
+		| ColonToken == token
+			# (ident, pState) = stringToIdent id IC_TypeAttr pState
+			= (True, TA_Var (makeAttributeVar ident), pState)
+			= (False, TA_None, tokenBack (tokenBack pState))
+	optional_attribute _	              pState = (False, TA_None, tokenBack pState)
+   
+
+cIsInfix	:== True
+cIsNotInfix	:== False
+
+wantFields :: !Ident !*ParseState -> (![ParsedSelector], !*ParseState)
+wantFields record_type pState
+	# (field, pState) = want_field record_type pState
+	  (token, pState) = nextToken TypeContext pState
+	| token == CommaToken
+		# (fields, pState) = wantFields record_type pState
+		= ([field : fields], pState)
+		= ([field], tokenBack pState)
+	where
+		want_field :: !Ident !*ParseState -> *(!ParsedSelector, !*ParseState)
+		want_field record_type pState
+			# (field_name, pState) 			= wantLowerCaseName "record field" pState
+			  (fname, linenr, pState)		= getFileAndLineNr pState
+			  (ps_field_name, pState) 		= stringToIdent field_name (IC_Field record_type) pState
+			  (ps_selector_name, pState) 	= stringToIdent field_name IC_Selector pState
+			  (ps_field_var, pState) 		= stringToIdent field_name IC_Expression pState
+			  pState          				= wantToken TypeContext "record field" DoubleColonToken pState
+			  (ps_field_type, pState)  		= want pState
+			= ({ ps_field_name = ps_field_name, ps_selector_name = ps_selector_name, ps_field_type = ps_field_type, ps_field_var = ps_field_var,
+					ps_field_pos = LinePos fname linenr}, pState)
+
+makeSymbolType args result context attr_env :==
+	{ st_vars = [], st_args = args, st_arity = length args, st_result = result,
+	  st_context = context, st_attr_env = attr_env, st_attr_vars = [] }
+
+instance want SymbolType
+where
+	want pState
+   		# (types, pState) = parseList tryBrackAType pState
+		  (token, pState) = nextToken TypeContext pState //-->> ("arg types:",types)
+   		  (tspec, pState) = want_rest_of_symbol_type token types pState
+   		= (tspec, pState)
+	where
+		want_rest_of_symbol_type :: !Token ![AType] !ParseState -> (SymbolType, !ParseState)
+		want_rest_of_symbol_type ArrowToken types pState
+			# (type, pState) = want pState
+			  (context, pState) = optionalContext pState
+			  (attr_env, pState) = optionalCoercions pState
+			= (makeSymbolType types type context attr_env, pState)
+		want_rest_of_symbol_type token [] pState
+			= (makeSymbolType [] (MakeAttributedType TE) [] [], parseError "symbol type" (Yes token) "type" pState)
+		want_rest_of_symbol_type token [type] pState
+			# (context, pState) = optionalContext (tokenBack pState)
+			  (attr_env, pState) = optionalCoercions pState
+			= (makeSymbolType [] type context attr_env, pState)
+		want_rest_of_symbol_type token [type=:{at_type = TA type_symb []} : types] pState
+		 	# type = { type & at_type = TA { type_symb & type_arity = length types } types }
+			  (context, pState) = optionalContext (tokenBack pState)
+			  (attr_env, pState) = optionalCoercions pState
+			= (makeSymbolType [] type context attr_env, pState)
+		want_rest_of_symbol_type token [type=:{at_type = TV tv} : types] pState
+		 	# type = { type & at_type = CV tv :@: types }
+			  (context, pState) = optionalContext (tokenBack pState)
+			  (attr_env, pState) = optionalCoercions pState
+			= (makeSymbolType [] type context attr_env, pState)
+		want_rest_of_symbol_type token types pState
+			= (makeSymbolType [] (MakeAttributedType TE) [] [], parseError "symbol type" (Yes token) "->" pState) -->> types
+
+/*
+	Types
+*/
+
+nameToTypeVar name pState
+	# last_char_index = size name - 1
+	| name.[last_char_index] == '^'
+		# new_name = name % (0, last_char_index - 1)
+		# (ident, pState) = stringToIdent new_name IC_Type pState
+		= (GTV (MakeTypeVar ident), pState)
+		# (ident, pState) = stringToIdent name IC_Type pState
+		= (TV (MakeTypeVar ident), pState)
+
+instance want TypeVar
+where
+	want pState
+		# (token, pState) = nextToken TypeContext pState
+		= case token of
+			IdentToken name
+				| isLowerCaseName name
+					# (ident, pState) = stringToIdent name IC_Type pState
+					-> (MakeTypeVar ident, pState)
+					-> (MakeTypeVar erroneousIdent, parseError "Type variable" (Yes token) "<type variable>" pState)
+			_
+				-> (MakeTypeVar erroneousIdent, parseError "Type variable" (Yes token) "<type variable>" pState)
+
+adjustAttribute :: !TypeAttribute Type *ParseState -> (TypeAttribute,*ParseState)
+adjustAttribute TA_Anonymous (TV {tv_name={id_name}}) pState
+	# (ident, pState) = stringToIdent id_name IC_TypeAttr pState
+	= (TA_Var (makeAttributeVar ident), pState)
+adjustAttribute TA_Anonymous (GTV {tv_name={id_name}}) pState
+	# (ident, pState) = stringToIdent id_name IC_TypeAttr pState
+	= (TA_Var (makeAttributeVar ident), pState)
+adjustAttribute attr type pState
+	= (attr, pState)
+
+stringToType :: !String !ParseState -> (!Type, !ParseState)
+stringToType name pState
+	# (id, pState) = stringToIdent name IC_Type pState
+	| isLowerCaseName name
+		= nameToTypeVar name pState
+		= (TA (MakeNewTypeSymbIdent id 0) [], pState)
+/*	| isUpperCaseName name
+		= (TA (MakeNewTypeSymbIdent id 0) [], pState)
+		= nameToTypeVar name pState
+*/
+/*
+stringToAType :: !String !Annotation !TypeAttribute !ParseState -> (!AType, !ParseState)
+stringToAType name annot attr pState
+	# (id, pState) = stringToIdent name IC_Type pState
+	| isUpperCaseName name
+		= ({ at_annotation = annot, at_attribute = attr, at_type = TA (MakeNewTypeSymbIdent id 0) []}, pState)
+		# (type_var, pState) = nameToTypeVar name pState
+		= build_attributed_type_var attr annot type_var name pState
+where
+	build_attributed_type_var TA_Anonymous annot type_var type_var_name pState
+		# (attr_id, pState) = stringToIdent type_var_name IC_TypeAttr pState
+		= ({ at_annotation = annot, at_attribute = TA_Var (makeAttributeVar attr_id), at_type = type_var }, pState)
+	build_attributed_type_var attr annot type_var _ pState
+		= ({ at_annotation = annot, at_attribute = attr, at_type = type_var }, pState)
+*/
+
+instance want AType
+where
+	want pState = wantAType pState
+
+instance want Type
+where
+	want pState = wantType pState
+
+wantType :: !ParseState -> (!Type,!ParseState)
+wantType pState
+	# (succ, atype, pState)	= tryAType False AN_None TA_None pState
+	  (succ2, type, pState)	= tryATypeToType atype pState
+	| succ&&succ2
+		= (type, pState)
+	// otherwise //~ succ
+		# (token, pState) = nextToken TypeContext pState
+		= (type, parseError "type" (Yes token) "type" pState)
+
+wantAType :: !ParseState -> (!AType,!ParseState)
+wantAType pState
+	# (succ, atype, pState)	= tryAType True AN_None TA_None pState
+	| succ
+		= (atype, pState)
+	// otherwise //~ succ
+		# (token, pState) = nextToken TypeContext pState
+		= (atype, parseError "atype" (Yes token) "attributed and annotated type" pState)
+
+tryType :: !ParseState -> (!Bool,!Type,!ParseState)
+tryType pState
+	# (succ, atype, pState)	= tryAType False AN_None TA_None pState
+	  (succ2, type, pState)	= tryATypeToType atype pState
+	= (succ&&succ2, type, pState)
+
+tryAType :: !Bool !Annotation !TypeAttribute !ParseState -> (!Bool,!AType,!ParseState)
+tryAType tryAA annot attr pState
+	# (types, pState)		= parseList tryBrackAType pState
+	| isEmpty types
+		= (False, {at_annotation = annot, at_attribute = attr, at_type = TE}, pState)
+	# (token, pState)		= nextToken TypeContext pState
+	| token == ArrowToken
+		= tryFunctionType types annot attr pState
+	// otherwise
+		# pState	= tokenBack pState
+		= tryApplicationType types annot attr pState
+
+tryFunctionType :: ![AType] !Annotation !TypeAttribute !ParseState -> (!Bool,!AType,!ParseState)
+tryFunctionType types annot attr pState
+	# (rtype, pState)		= wantAType pState
+	= ( True
+	  , make_curry_type annot attr types rtype
+	  , pState
+	  )
+where
+	make_curry_type annot attr [t1] res_type
+		= {at_annotation = annot, at_attribute = attr, at_type = t1 --> res_type}
+	make_curry_type annot attr [t1:tr] res_type
+		= {at_annotation = annot, at_attribute = attr, at_type = t1 --> make_curry_type AN_None TA_None tr res_type}
+	make_curry_type _ _ _ _ = abort "make_curry_type: wrong assumption"
+
+tryApplicationType :: ![AType] !Annotation !TypeAttribute !ParseState -> (!Bool,!AType,!ParseState)
+tryApplicationType [type1:types_rest] annot attr pState
+	#	(annot, pState)	= determAnnot annot type1.at_annotation pState
+		type			= type1.at_type
+		(attr, pState)	= determAttr attr type1.at_attribute type pState
+	| isEmpty types_rest
+		= ( True
+		  , {at_annotation = annot, at_attribute = attr, at_type = type}
+		  , pState
+		  )
+	// otherwise // type application
+		# (type, pState)	= convert_list_of_types type1.at_type types_rest pState
+		= ( True
+		  , {at_annotation = annot, at_attribute = attr, at_type = type}
+		  , pState
+		  )
+where
+	convert_list_of_types (TA sym []) types pState
+		= (TA { sym & type_arity = length types } types, pState)
+	convert_list_of_types (TV tv) types pState
+		= (CV tv :@: types, pState)
+	convert_list_of_types _ types pState
+		= (TE, parseError "Type" No "ordinary type variable" pState)
+tryApplicationType _ annot attr pState
+	= (False, {at_annotation = annot, at_attribute = attr, at_type = TE}, pState)
+
+tryBrackType :: !ParseState -> (!Bool, Type, !ParseState)
+tryBrackType pState
+	# (succ, atype, pState) 	= trySimpleType AN_None TA_None pState
+	  (succ2, type, pState)		= tryATypeToType atype pState
+	= (succ&&succ2, type, pState)
+
+tryBrackAType :: !ParseState -> (!Bool, AType, !ParseState)
+tryBrackAType pState
+	# (_, annot, attr, pState)	= optionalAnnotAndAttr pState
+	= trySimpleType annot attr pState
+
+trySimpleType :: !Annotation !TypeAttribute !ParseState -> (!Bool, !AType, !ParseState)
+trySimpleType annot attr pState
+	# (token, pState)		= nextToken TypeContext pState
+	= trySimpleTypeT token annot attr pState
+
+trySimpleTypeT :: !Token !Annotation !TypeAttribute !ParseState -> (!Bool, !AType, !ParseState)
+trySimpleTypeT (IdentToken id) annot attr pState
+	| isLowerCaseName id
+		# (typevar, pState)	= nameToTypeVar id pState
+		  (attr, pState)	= adjustAttribute attr typevar pState
+		= (True, {at_annotation = annot, at_attribute = attr, at_type = typevar}, pState)
+	| otherwise // | isUpperCaseName id || isFunnyIdName id
+	# (type, pState) = stringToType id pState
+	= (True, {at_annotation = annot, at_attribute = attr, at_type = type}, pState)
+trySimpleTypeT SquareOpenToken annot attr pState
+	# (token, pState) = nextToken TypeContext pState
+	| token == SquareCloseToken
+		# (list_symbol, pState) = makeListTypeSymbol 0 pState
+  		= (True, {at_annotation = annot, at_attribute = attr, at_type = TA list_symbol []}, pState)
+	# (type, pState)	= wantAType (tokenBack pState)
+	  (token, pState)	= nextToken TypeContext pState
+	| token == SquareCloseToken
+		# (list_symbol, pState) = makeListTypeSymbol 1 pState
+		= (True, {at_annotation = annot, at_attribute = attr, at_type = TA list_symbol [type]}, pState)
+	// otherwise // token <> SquareCloseToken
+		= (False, {at_annotation = annot, at_attribute = attr, at_type = TE}, parseError "List type" (Yes token) "]" pState)
+trySimpleTypeT OpenToken annot attr pState
+	# (token, pState) = nextToken TypeContext pState
+	| token == CommaToken
+		# (tup_arity, pState)		= determine_arity_of_tuple 2 pState
+		  (tuple_symbol, pState)	= makeTupleTypeSymbol tup_arity 0 pState
+		= (True, {at_annotation = annot, at_attribute = attr, at_type = TA tuple_symbol []}, pState)
+	// otherwise // token <> CommaToken
+	# (atype, pState)	= wantAType (tokenBack pState)
+	  (token, pState)	= nextToken TypeContext pState
+	| token == CloseToken
+		# (annot, pState)	= determAnnot annot atype.at_annotation pState
+		  type				= atype.at_type
+		  (attr, pState)	= determAttr  attr  atype.at_attribute type pState
+		= (True, {at_annotation = annot, at_attribute = attr, at_type = type}, pState)
+	| token == CommaToken // TupleType
+		# (atypes, pState)	= wantSequence CommaToken TypeContext pState
+		  pState			= wantToken TypeContext "tuple type" CloseToken pState
+		  atypes			= [atype:atypes]
+		  arity				= length atypes
+	 	  (tuple_symbol, pState)	= makeTupleTypeSymbol arity arity pState
+		= (True, {at_annotation = annot, at_attribute = attr, at_type = TA tuple_symbol atypes}, pState)
+	// otherwise // token <> CloseToken && token <> CommaToken
+		= (False, atype, parseError "Simple type" (Yes token) "')' or ','" pState)
+where
+	determine_arity_of_tuple :: !Int !ParseState -> (!Int, !ParseState)
+	determine_arity_of_tuple arity pState
+		# (token, pState) = nextToken TypeContext pState
+		| CommaToken == token
+  			= determine_arity_of_tuple (inc arity) pState
+		| CloseToken == token
+			= (arity, pState)
+			= (arity, parseError "tuple type" (Yes token) ")" pState)
+trySimpleTypeT CurlyOpenToken annot attr pState
+	# (token, pState) = nextToken TypeContext pState
+	| token == CurlyCloseToken
+		# (array_symbol, pState) = makeLazyArraySymbol 0 pState
+		= (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol []}, pState)
+	| token == HashToken
+		# (token, pState) = nextToken TypeContext pState
+		| token == CurlyCloseToken
+			# (array_symbol, pState) = makeUnboxedArraySymbol 0 pState
+			= (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol []}, pState)
+		// otherwise // token <> CurlyCloseToken
+	  		# (atype, pState)			= wantAType (tokenBack pState)
+  			  pState					= wantToken TypeContext "unboxed array type" CurlyCloseToken pState
+  			  (array_symbol, pState)	= makeUnboxedArraySymbol 1 pState
+  			= (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol [atype]}, pState)
+	| token == ExclamationToken
+		# (token, pState) = nextToken TypeContext pState
+		| token == CurlyCloseToken
+			# (array_symbol, pState) = makeStrictArraySymbol 0 pState
+			= (True,  {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol []}, pState)
+		// otherwise // token <> CurlyCloseToken
+	  		# (atype,pState)			= wantAType (tokenBack pState)
+  			  pState					= wantToken TypeContext "strict array type" CurlyCloseToken pState
+  			  (array_symbol, pState)	= makeStrictArraySymbol 1 pState
+  			= (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol [atype]}, pState)
+  	// otherwise
+  		# (atype,pState)			= wantAType (tokenBack pState)
+  		  pState					= wantToken TypeContext "lazy array type" CurlyCloseToken pState
+		  (array_symbol, pState)	= makeLazyArraySymbol 1 pState
+		= (True, {at_annotation = annot, at_attribute = attr, at_type = TA array_symbol [atype]}, pState)
+trySimpleTypeT StringTypeToken annot attr pState
+	# (type, pState) = makeStringTypeSymbol pState
+	= (True, {at_annotation = annot, at_attribute = attr, at_type = TA type []}, pState)
+trySimpleTypeT token annot attr pState
+	# (bt, pState) = try token pState
+	= case bt of
+		Yes bt	-> (True , {at_annotation = annot, at_attribute = attr, at_type = TB bt}, pState)
+		no		-> (False, {at_annotation = annot, at_attribute = attr, at_type = TE}   , pState)
+
+instance try BasicType
+where
+	try IntTypeToken	 pState = (Yes BT_Int			, pState)
+	try CharTypeToken	 pState	= (Yes BT_Char			, pState)
+	try BoolTypeToken	 pState	= (Yes BT_Bool			, pState)
+	try RealTypeToken	 pState	= (Yes BT_Real			, pState)
+	try DynamicTypeToken pState	= (Yes BT_Dynamic		, pState)
+	try FileTypeToken	 pState = (Yes BT_File			, pState)
+	try WorldTypeToken	 pState = (Yes BT_World			, pState)
+	try _				 pState = (No					, tokenBack pState)
+
+determAnnot :: !Annotation !Annotation !ParseState -> (!Annotation, !ParseState)
+determAnnot AN_None annot2  pState = (annot2, pState)
+determAnnot annot1  AN_None pState = (annot1, pState)
+determAnnot annot1  annot2  pState
+	= (annot1, parseError "simple type" No ("More type annotations, "+toString annot1+" and "+toString annot2+", than") pState)
+
+determAttr :: !TypeAttribute !TypeAttribute !Type !ParseState -> (!TypeAttribute, !ParseState)
+determAttr TA_None  attr2   type pState = adjustAttribute attr2 type pState
+determAttr attr1    TA_None type pState = adjustAttribute attr1 type pState
+determAttr attr1    attr2   type pState
+	= (attr1, parseError "simple type" No ("More type attributes, "+toString attr1+" and "+toString attr2+", than") pState)
+
+wantDynamicType :: !*ParseState -> *(!DynamicType,!*ParseState)
+wantDynamicType pState 
+	# (type_vars, pState) = optionalQuantifiedVariables UniversalQuantifier pState
+	  (type, pState) = want pState
+	= ({ dt_uni_vars = type_vars, dt_type = type, dt_global_vars = [] }, pState)
+
+::	QuantifierKind = UniversalQuantifier | ExistentialQuantifier
+
+instance == QuantifierKind
+where
+	(==) UniversalQuantifier UniversalQuantifier
+		= True 
+	(==) ExistentialQuantifier ExistentialQuantifier
+		= True 
+	(==) _  _
+		= False 
+
+instance try QuantifierKind
+where
+	try (IdentToken name) pState
+		| name == "A"
+			# (token, pState) = nextToken TypeContext pState
+			| token == DotToken
+				= (Yes UniversalQuantifier, pState)
+				= (No, tokenBack (tokenBack pState))
+		| name == "E"
+			# (token, pState) = nextToken TypeContext pState
+			| token == DotToken
+				= (Yes ExistentialQuantifier, pState)
+				= (No, tokenBack (tokenBack pState))
+	try token pState
+			= (No, tokenBack pState)
+
+optionalQuantifiedVariables :: !QuantifierKind !*ParseState -> *(![ATypeVar],!*ParseState)
+optionalQuantifiedVariables req_quant pState
+	# (token, pState) = nextToken TypeContext pState
+	  (optional_quantifier, pState) = try token pState
+	= case optional_quantifier of
+		Yes off_quant
+			# (vars, pState) = wantList "quantified variable(s)" try_Attributed_TypeVar pState
+			| req_quant == off_quant
+				-> (vars, pState)
+				-> (vars, parseError "optional quantified variables" No "illegal quantifier" pState)
+		No
+			-> ([], pState)
+where
+	try_Attributed_TypeVar :: !ParseState -> (Bool,ATypeVar,ParseState)
+	try_Attributed_TypeVar pState
+		# (token, pState)	= nextToken TypeContext pState
+		= case token of
+			DotToken
+				# (succ,typevar, pState)	= tryTypeVar pState
+				| succ
+					#	atypevar = {atv_attribute = TA_Anonymous, atv_annotation = AN_None, atv_variable = typevar}
+					->	(True,atypevar,pState)
+					->	(False,abort "no ATypeVar",pState)
+			_
+				# (succ,typevar, pState)	= tryTypeVar (tokenBack pState)
+				| succ
+					#	atypevar = {atv_attribute = TA_None, atv_annotation = AN_None, atv_variable = typevar}
+					->	(True,atypevar,pState)
+					->	(False,abort "no ATypeVar",pState)
+
+tryATypeToType :: !AType !ParseState -> (!Bool, !Type, !ParseState)
+tryATypeToType atype pState
+	| atype.at_annotation <> AN_None
+		= ( False
+		  , atype.at_type
+		  , parseError "simple type" No ("type instead of type annotation "+toString atype.at_annotation) pState
+		  )
+	| atype.at_attribute <> TA_None
+		= ( False
+		  , atype.at_type
+		  , parseError "simple type" No ("type instead of type attribute "+toString atype.at_attribute) pState
+		  )
+	// otherwise
+		= (True, atype.at_type, pState)
+
+/*
+	Expressions
+*/
+/*
+wantMainExp :: !ParseState -> (ParsedExpr, !ParseState)
+wantMainExp pState
+	# (exp, pState) = wantExpression cIsNotAPattern pState
+	= (exp, wantEndOfFileToken pState)
+*/
+cIsAPattern		:== True
+cIsNotAPattern	:== False
+
+wantExpression :: !Bool !ParseState -> (!ParsedExpr, !ParseState)
+wantExpression is_pattern pState
+	# (token, pState) = nextToken FunctionContext pState
+	| is_pattern
+		= wantLhsExpressionT token pState
+		= wantRhsExpressionT token pState
+
+wantRhsExpressionT  :: !Token !ParseState -> (!ParsedExpr, !ParseState)
+wantRhsExpressionT  token pState
+	# (succ, expr, pState) = trySimpleRhsExpressionT token pState
+	| succ
+		# (exprs, pState) = parseList trySimpleRhsExpression pState
+		= (combineExpressions expr exprs, pState)
+		= (PE_Empty,  parseError "RHS expression" (Yes token) "<expression>" pState)
+
+wantLhsExpressionT  :: !Token !ParseState -> (!ParsedExpr, !ParseState)
+wantLhsExpressionT  token pState
+	# (succ, expr, pState) = trySimpleLhsExpressionT token pState
+	| succ
+		# (exprs, pState) = parseList trySimpleLhsExpression pState
+		= (combineExpressions expr exprs, pState)
+		= (PE_Empty,  parseError "LHS expression" (Yes token) "<expression>" pState)
+
+combineExpressions expr []
+	= expr
+combineExpressions expr exprs
+	= make_app_exp expr exprs
+where
+	make_app_exp exp []
+		= exp
+	make_app_exp (PE_Bound be=:{ bind_src}) exps
+		= PE_Bound { be & bind_src = make_app_exp bind_src exps }
+	make_app_exp exp exprs
+		= PE_List [exp : exprs]
+
+trySimpleLhsExpression :: !ParseState -> (!Bool, !ParsedExpr, !ParseState)
+trySimpleLhsExpression pState
+	# (token, pState) = nextToken FunctionContext pState
+	= trySimpleLhsExpressionT token pState
+
+trySimpleLhsExpressionT ::  !Token !ParseState -> (!Bool, !ParsedExpr, !ParseState)
+trySimpleLhsExpressionT token pState
+	# (succ, expr, pState) = trySimpleExpressionT token cIsAPattern pState
+	| succ
+		# (token, pState) = nextToken FunctionContext pState
+		| token == DoubleColonToken
+			# (dyn_type, pState) = wantDynamicType pState
+			= (True, PE_DynamicPattern expr dyn_type, pState)
+			= (True, expr, tokenBack pState)
+		= (False, PE_Empty, pState)
+
+trySimpleRhsExpression :: !ParseState -> (!Bool, !ParsedExpr, !ParseState)
+trySimpleRhsExpression pState
+	# (token, pState) = nextToken FunctionContext pState
+	= trySimpleRhsExpressionT token pState
+	
+trySimpleRhsExpressionT :: !Token !ParseState -> (!Bool, !ParsedExpr, !ParseState)
+trySimpleRhsExpressionT token pState
+	# (succ, expr, pState) = trySimpleExpressionT token cIsNotAPattern pState
+	| succ
+		# (expr, pState) = extend_expr_with_selectors expr pState
+		= (True, expr, pState)
+		= (False, PE_Empty, pState)
+where
+	extend_expr_with_selectors :: !ParsedExpr !ParseState -> (!ParsedExpr, !ParseState)
+	extend_expr_with_selectors exp pState 
+   		# (token, pState) = nextToken FunctionContext pState
+		| token == DotToken
+			# (token, pState) = nextToken FunctionContext pState
+			  (selectors, pState) = wantSelectors token pState
+			= (PE_Selection cNonUniqueSelection exp selectors, pState)
+		| token == ExclamationToken
+			# (token, pState) = nextToken FunctionContext pState
+			  (selectors, pState) = wantSelectors token pState
+			= (PE_Selection cUniqueSelection exp selectors, pState)
+		| otherwise
+			= (exp, tokenBack pState)
+
+wantSelectors :: Token *ParseState -> *(![ParsedSelection], !*ParseState)
+wantSelectors token pState
+			# (selector, pState) = want_selector token pState
+			  (token, pState) = nextToken  FunctionContext pState
+			| token == DotToken
+				# (token, pState) = nextToken FunctionContext pState
+				  (selectors, pState) = wantSelectors token pState
+				= (selector ++ selectors, pState)
+				= (selector, tokenBack pState)
+where
+	want_selector :: !Token !*ParseState -> *(![ParsedSelection], !*ParseState)
+	want_selector SquareOpenToken pState
+			# (array_selectors, pState) = want_array_selectors pState
+		= (array_selectors, wantToken FunctionContext "array selector" SquareCloseToken pState)
+		where
+			want_array_selectors :: !*ParseState -> *(![ParsedSelection], !*ParseState)
+			want_array_selectors pState
+	  			# (index_expr, pState) = wantExpression cIsNotAPattern pState
+				  selector = PS_Array index_expr
+	  			  (token, pState) = nextToken  FunctionContext pState
+				| token == CommaToken
+					# (selectors, pState) = want_array_selectors pState
+					= ([selector : selectors], pState)
+					= ([selector], tokenBack pState)
+
+	want_selector (IdentToken name) pState
+		| isUpperCaseName name
+	  		# (field, pState) = want (wantToken FunctionContext "array selector" DotToken pState)
+	  		  (field_id, pState) = stringToIdent field IC_Selector pState
+	  		  (type_id, pState) = stringToIdent name IC_Type pState
+			= ([PS_Record field_id (Yes type_id)], pState)
+	  		# (field_id, pState) = stringToIdent name IC_Selector pState
+			= ([PS_Record field_id No], pState)
+	want_selector token pState
+		= ([PS_Erroneous], parseError "simple RHS expression" (Yes token) "<selector>" pState)
+
+trySimpleExpression :: !Bool !ParseState -> (!Bool, !ParsedExpr, !ParseState)
+trySimpleExpression is_pattern pState
+	| is_pattern
+		= trySimpleLhsExpression pState
+		= trySimpleRhsExpression pState
+
+trySimpleExpressionT :: !Token !Bool !ParseState -> (!Bool, !ParsedExpr, !ParseState)
+trySimpleExpressionT (IdentToken name) is_pattern pState
+	| isLowerCaseName name
+	# (id, pState) = stringToIdent name IC_Expression pState
+	  (token, pState) = nextToken FunctionContext pState
+	| token == DefinesColonToken
+		# (succ, expr, pState) = trySimpleExpression is_pattern pState
+		| succ
+			= (True, PE_Bound { bind_dst = id, bind_src = expr }, pState)
+			= (True, PE_Empty, parseError "simple expression" No "expression" pState)
+		= (True, PE_Ident id, tokenBack pState)
+trySimpleExpressionT (IdentToken name) is_pattern pState
+//	| isUpperCaseName name || ~ is_pattern
+	# (id, pState) = stringToIdent name IC_Expression pState
+	= (True, PE_Ident id, pState)
+trySimpleExpressionT SquareOpenToken is_pattern pState
+	# (list_expr, pState) = wantListExp is_pattern pState
+	= (True, list_expr, pState)
+trySimpleExpressionT OpenToken is_pattern pState
+	# (args=:[exp:exps], pState) = want_expression_list is_pattern pState
+	  pState = wantToken FunctionContext "expression list" CloseToken pState
+	| isEmpty exps
+		= case exp of
+			PE_Ident id
+				-> (True, PE_List [exp], pState)
+			_
+				-> (True, exp, pState)
+	//	# (token,pState) = nextToken FunctionContext pState		// for debugging
+	//	  pState = tokenBack pState  -->> ("PE_tuple",args,token)
+   		= (True, PE_Tuple args, pState)
+where
+	want_expression_list is_pattern pState
+		# (expr, pState) = wantExpression is_pattern pState
+		  (token, pState) = nextToken FunctionContext pState
+		| token == CommaToken
+			# (exprs, pState) = want_expression_list is_pattern pState
+	  		= ([expr : exprs], pState)
+	  		= ([expr], tokenBack pState)
+trySimpleExpressionT CurlyOpenToken is_pattern pState
+	# (rec_or_aray_exp, pState) = wantRecordOrArrayExp is_pattern pState 
+	= (True, rec_or_aray_exp, pState)
+trySimpleExpressionT (IntToken int) is_pattern pState
+	= (True, PE_Basic (BVI int), pState)
+trySimpleExpressionT (StringToken string) is_pattern pState
+	= (True, PE_Basic (BVS string), pState)
+trySimpleExpressionT (BoolToken bool) is_pattern pState
+	= (True, PE_Basic (BVB bool), pState)
+trySimpleExpressionT (CharToken char) is_pattern pState
+	= (True, PE_Basic (BVC char), pState)
+trySimpleExpressionT (RealToken real) is_pattern pState
+	= (True, PE_Basic (BVR real), pState)
+trySimpleExpressionT token is_pattern pState
+	| is_pattern
+		| token == WildCardToken
+			= (True, PE_WildCard, pState)
+			= (False, PE_Empty, tokenBack pState)
+		= trySimpleNonLhsExpressionT token pState
+
+trySimpleNonLhsExpressionT BackSlashToken pState
+	# (lam_ident, pState)	= internalIdent "\\" pState
+	  (lam_args, pState) 	= wantList "arguments" trySimpleLhsExpression pState
+	//  pState				= wantToken FunctionContext "lambda expression" ArrowToken pState
+	  pState				= want_lambda_sep pState
+	  (exp, pState)			= wantExpression cIsNotAPattern pState
+	= (True, PE_Lambda lam_ident lam_args exp, pState)
+	where
+		want_lambda_sep pState
+			# (token, pState) = nextToken FunctionContext pState
+			= case token of
+				ArrowToken	-> pState
+				EqualToken	-> pState
+				DotToken	-> pState
+	  			_			-> parseError "lambda expression" (Yes token) "-> or =" (tokenBack pState)
+//trySimpleNonLhsExpressionT (LetToken strict) pState
+trySimpleNonLhsExpressionT (LetToken strict=:False) pState // let! is not supported in Clean 2.0
+	# (let_binds, pState)	= wantLocals pState
+	  pState				= wantToken FunctionContext "let expression" InToken pState
+	  (let_expr, pState)	= wantExpression cIsNotAPattern pState
+	= (True, PE_Let strict let_binds let_expr, pState)
+trySimpleNonLhsExpressionT WildCardToken pState
+	= (True, PE_WildCard, pState)
+trySimpleNonLhsExpressionT CaseToken pState
+   	# (case_exp, pState)		= wantCaseExp pState
+	= (True, case_exp, pState)
+trySimpleNonLhsExpressionT IfToken pState
+	# (if_ident, pState) 		= internalIdent "_if" pState
+   	  (cond_exp, pState)		= want_simple_expression "condition of if" pState
+   	  (then_exp, pState)		= want_simple_expression "then-part of if" pState
+   	  (else_exp, pState)		= want_simple_expression "else-part of if" pState
+	= (True, PE_If if_ident cond_exp then_exp else_exp, pState)
+where
+	want_simple_expression error pState
+		# (succ, expr, pState) = trySimpleRhsExpression pState
+		| succ
+			= (expr, pState)
+			= (PE_Empty,  parseError error No "<expression>" pState)
+trySimpleNonLhsExpressionT DynamicToken pState
+	# (dyn_expr, pState) = wantExpression cIsNotAPattern pState
+	  (token, pState) = nextToken FunctionContext pState
+	| token == DoubleColonToken
+		# (dyn_type, pState) = wantDynamicType pState
+		= (True, PE_Dynamic dyn_expr (Yes dyn_type), pState)
+		= (True, PE_Dynamic dyn_expr No, tokenBack pState)
+trySimpleNonLhsExpressionT token pState
+	= (False, PE_Empty, tokenBack pState)
+
+wantListExp :: !Bool !ParseState -> (ParsedExpr, !ParseState)
+wantListExp is_pattern pState
+	# (token, pState) = nextToken FunctionContext pState
+	= case token of
+		SquareCloseToken
+			-> makeNilExpression pState
+		_	-> want_LGraphExpr token [] pState
+where
+	want_list acc pState
+		# (token, pState) = nextToken FunctionContext pState
+		= case token of
+			SquareCloseToken
+				#	(nil_expr, pState) = makeNilExpression pState
+				->	gen_cons_nodes acc nil_expr pState
+			CommaToken
+				#	(token, pState)	= nextToken FunctionContext pState
+				->	want_LGraphExpr token acc pState
+			ColonToken
+				#	(token, pState)		= nextToken FunctionContext pState
+					(exp, pState)		= wantRhsExpressionT token pState
+					pState				= wantToken FunctionContext "list" SquareCloseToken pState
+				->	gen_cons_nodes acc exp pState
+			DotDotToken
+				| length acc > 2 || isEmpty acc
+				#	(nil_expr, pState)	= makeNilExpression pState
+					pState				= parseError "list expression" No "one or two expressions before .." pState
+				->	gen_cons_nodes acc nil_expr pState
+				#	(token, pState)		= nextToken FunctionContext pState
+				->	case token of
+					 SquareCloseToken
+						->	case acc of
+								[e]	-> (PE_Sequ (SQ_From e), pState)
+								[e2,e1]
+									-> (PE_Sequ (SQ_FromThen e1 e2), pState)
+								_	-> abort "Error 1 in WantListExp"
+					 _	#	(exp, pState)	= wantRhsExpressionT token pState
+							pState			= wantToken FunctionContext "dot dot expression" SquareCloseToken pState
+						->	case acc of
+								[e]	-> (PE_Sequ (SQ_FromTo e exp), pState)
+								[e2,e1]
+									-> (PE_Sequ (SQ_FromThenTo e1 e2 exp), pState)
+								_	-> abort "Error 2 in WantListExp"
+			DoubleBackSlashToken
+				| length acc == 1
+				->	wantComprehension cIsListGenerator (acc!!0)  pState
+				// otherwise // length acc <> 1
+				#	(nil_expr, pState)	= makeNilExpression pState
+					pState				= parseError "list comprehension" No "one expressions before \\\\" pState
+				->	gen_cons_nodes acc nil_expr pState
+			_	#	(nil_expr, pState)	= makeNilExpression pState
+					pState	= parseError "list" (Yes token) "list element separator" pState
+				->	gen_cons_nodes acc nil_expr pState
+
+	want_LGraphExpr token acc pState
+		= case token of
+			CharListToken chars
+				->	want_list (add_chars (fromString chars) acc) pState
+				with
+					add_chars [] acc	= acc
+					add_chars [c:r] acc	= add_chars r [PE_Basic (BVC (toString ['\'',c,'\''])): acc]
+			_	#	(exp, pState) = (if is_pattern (wantLhsExpressionT token) (wantRhsExpressionT token)) pState
+				->	want_list [exp: acc] pState
+	
+	gen_cons_nodes [] exp pState
+		= (exp, pState)
+	gen_cons_nodes [e:r] exp pState
+		# (exp, pState) = makeConsExpression e exp pState
+		= gen_cons_nodes r exp pState
+
+/**
+	(List and Array) Comprehensions
+**/
+
+wantComprehension :: !GeneratorKind !ParsedExpr !ParseState -> (!ParsedExpr, !ParseState)
+wantComprehension gen_kind exp pState
+	# (qualifiers, pState) = wantQualifiers 0 0 pState
+	| gen_kind == cIsListGenerator
+		= (PE_Compr cIsListGenerator exp qualifiers, wantToken FunctionContext "list comprehension" SquareCloseToken pState)
+		= (PE_Compr cIsArrayGenerator exp qualifiers, wantToken FunctionContext "array comprehension" CurlyCloseToken pState)
+
+wantQualifiers :: !Int !Int !ParseState -> (![Qualifier], !ParseState)
+wantQualifiers nr_of_quals nr_of_gens pState
+	# (qual, nr_of_gens, pState) = want_qualifier nr_of_quals nr_of_gens pState
+	  (token, pState) = nextToken FunctionContext pState
+	| token == CommaToken
+		# (quals, pState) = wantQualifiers (inc nr_of_quals) nr_of_gens pState
+		= ([qual : quals], pState)
+		= ([qual], tokenBack pState)
+where
+
+	want_qualifier :: !Int !Int !ParseState -> (!Qualifier, !Int, !ParseState)
+	want_qualifier qual_nr gen_nr pState
+		# (lhs_expr, pState) = wantExpression cIsAPattern pState
+		  (token, pState) = nextToken FunctionContext pState
+		| token == LeftArrowToken
+			= want_generators cIsListGenerator qual_nr gen_nr lhs_expr pState
+		| token == LeftArrowColonToken
+			= want_generators cIsArrayGenerator qual_nr gen_nr lhs_expr pState
+			= ({qual_generators = [], qual_filter = No, qual_fun_id = { id_name = "", id_info = nilPtr}}, gen_nr,
+					parseError "comprehension: qualifier" (Yes token) "qualifier(s)" pState)
+
+	want_generators :: !GeneratorKind !Int !Int !ParsedExpr !ParseState -> (!Qualifier, !Int, !ParseState)
+	want_generators gen_kind qual_nr gen_nr pattern_exp pState
+		# (gen_expr, pState) = wantExpression cIsNotAPattern pState
+		  (token, pState) = nextToken FunctionContext pState
+		  (gen_var, pState) = stringToIdent ("tl" +++ toString gen_nr) IC_Expression pState
+		  generator = { gen_kind = gen_kind, gen_expr = gen_expr, gen_pattern = pattern_exp, gen_var = gen_var }
+		| token == BarToken
+			# (filter_expr, pState) = wantExpression cIsNotAPattern pState
+			  (qual_fun_id, pState) = stringToIdent ("_compr" +++ toString qual_nr) IC_Expression pState
+			= ({qual_generators = [generator], qual_filter = Yes filter_expr, qual_fun_id = qual_fun_id }, inc gen_nr, pState)
+		| token == AndToken
+			# (qualifier, gen_nr, pState) = want_qualifier qual_nr (inc gen_nr) pState
+			= ({qualifier & qual_generators = [ generator : qualifier.qual_generators] }, gen_nr, pState)
+		# (qual_fun_id, pState) = stringToIdent ("_compr" +++ toString qual_nr) IC_Expression pState
+		= ({qual_generators = [generator], qual_filter = No, qual_fun_id = qual_fun_id}, inc gen_nr, tokenBack pState)
+
+/**
+	Case Expressions
+**/
+
+wantCaseExp :: !ParseState -> (ParsedExpr, !ParseState)
+wantCaseExp pState
+	# (case_ident, pState) = internalIdent "_c" pState
+	  (case_exp, pState)	= wantExpression cIsNotAPattern pState
+	  pState				= wantToken FunctionContext "case expression" OfToken pState
+	  pState				= wantBeginGroup "case" pState
+	  (case_alts, pState)	= parseList tryCaseAlt pState
+	  (found, alt, pState)	= tryLastCaseAlt pState
+	| found
+		= (PE_Case case_ident case_exp (case_alts++[alt]), wantEndCase pState)
+		= (PE_Case case_ident case_exp case_alts, wantEndCase pState)
+where
+	tryCaseAlt :: !ParseState -> (!Bool, CaseAlt, !ParseState)
+	tryCaseAlt pState
+		# (succ, pattern, pState) = try_pattern pState
+		| succ
+			# (rhs, pState) = wantRhs caseSeperator pState
+			= (True, { calt_pattern = pattern, calt_rhs = rhs }, pState) // -->> ("case alt", pattern)
+		// otherwise // ~ succ
+			= (False, abort "no case alt", pState)
+	
+	tryLastCaseAlt ::  !ParseState -> (!Bool, CaseAlt, !ParseState)
+	tryLastCaseAlt pState
+		# (token, pState)	= nextToken FunctionContext pState
+		| caseSeperator token
+			#	pState			= tokenBack pState
+				(rhs, pState)	= wantRhs caseSeperator pState
+			= (True, { calt_pattern = PE_WildCard, calt_rhs = rhs }, pState) // -->> ("default case alt")
+		| token == OtherwiseToken
+			# (token, pState)	= nextToken FunctionContext pState
+			  pState			= tokenBack pState
+			| caseSeperator token
+				# (rhs, pState) = wantRhs caseSeperator pState
+				= (True, { calt_pattern = PE_WildCard, calt_rhs = rhs }, pState) // -->> ("default case alt")
+				= (False, abort "no case alt", pState)
+			= (False, abort "no case alt", tokenBack pState)
+
+	caseSeperator t = t == EqualToken || t == ArrowToken // to enable Clean 1.x case expressions
+
+	try_pattern :: !ParseState -> (!Bool, ParsedExpr, !ParseState)
+	try_pattern pState
+		# (succ, expr, pState) = trySimpleLhsExpression pState
+		| succ
+			# (succ, expr2, pState) = trySimpleLhsExpression pState
+			| succ
+				# (exprs, pState) = parseList trySimpleLhsExpression pState
+				= (True, PE_List [expr,expr2 : exprs], pState)
+				= (True, expr, pState)
+			= (False, abort "no expression", pState)
+
+:: NestedUpdate =
+	{	nu_selectors :: ![ParsedSelection]
+	,	nu_update_expr :: !ParsedExpr
+	}
+errorIdent :: Ident
+errorIdent
+	=	{id_name = "<<error>>", id_info = nilPtr}
+
+buildNodeDef :: ParsedExpr ParsedExpr -> ParsedDefinition
+buildNodeDef lhsExpr rhsExpr
+	=	PD_NodeDef NoPos lhsExpr rhs
+	where
+		rhs	=
+			{ rhs_alts
+				= UnGuardedExpr
+					{ ewl_nodes		= []
+					, ewl_locals	= LocalParsedDefs []
+					, ewl_expr		= rhsExpr
+					}
+			, rhs_locals
+				= LocalParsedDefs []
+			}
+
+/**
+	Record expressions
+**/
+
+wantRecordOrArrayExp :: !Bool !ParseState -> (ParsedExpr, !ParseState)
+wantRecordOrArrayExp is_pattern pState
+	# (token, pState) = nextToken FunctionContext pState
+	| token == CurlyCloseToken
+		= (PE_ArrayDenot [], pState)
+	| is_pattern
+		| token == SquareOpenToken
+		//	# (elems, pState) =  want_array_assignments cIsAPattern pState // currently no array selections in pattern PK
+		//	= (PE_Array PE_Empty elems [], wantToken FunctionContext "array selections in pattern" CurlyCloseToken pState)
+			= (PE_Empty, parseError "array selection" No "No array selection in pattern" pState)
+		// otherwise // is_pattern && token <> SquareOpenToken
+			= want_record_pattern token pState
+	// otherwise // ~ is_pattern
+		# (opt_type, pState) = try_type_specification token pState
+		= case opt_type of
+			Yes _
+				-> want_record opt_type pState
+			_
+				# (succ, field, pState) = try_field_assignment token pState
+				| succ
+					# (token, pState) = nextToken FunctionContext pState
+					| token == CommaToken
+						# (token, pState) = nextToken FunctionContext pState
+						  (fields, pState) = want_field_assignments cIsNotAPattern token pState
+						-> (PE_Record PE_Empty No [ field : fields ], wantToken FunctionContext "record or array" CurlyCloseToken pState)
+					| token == CurlyCloseToken
+						-> (PE_Record PE_Empty No [ field ], pState)
+						-> (PE_Record PE_Empty No [ field ], parseError "record or array" (Yes token) "}" pState)
+				# (expr, pState) = wantRhsExpressionT token pState
+				  (token, pState) = nextToken FunctionContext pState
+				| token == AndToken
+					# (token, pState) = nextToken FunctionContext pState
+					-> want_record_or_array_update token expr pState
+				| token == DoubleBackSlashToken
+					-> wantComprehension cIsArrayGenerator expr pState
+				# (elems, pState) = want_array_elems token pState
+				-> (PE_ArrayDenot [expr : elems], pState)
+where
+	want_array_elems CurlyCloseToken pState
+		= ([], pState)
+	want_array_elems CommaToken pState
+		# (elem, pState) = wantExpression cIsNotAPattern pState
+		  (token, pState) = nextToken FunctionContext pState
+		  (elems, pState) = want_array_elems token pState
+		= ([elem : elems], pState)
+	want_array_elems token pState
+		= ([], parseError "array elements" (Yes token) "<array denotation>" pState)
+	
+	want_record_pattern (IdentToken ident) pState
+		| isUpperCaseName ident
+			# pState = wantToken FunctionContext "record pattern" BarToken pState
+			  (type_id, pState) = stringToIdent ident IC_Type pState
+			  (token, pState) = nextToken FunctionContext pState
+			  (fields, pState) = want_field_assignments cIsAPattern token pState
+			= (PE_Record PE_Empty (Yes type_id) fields, wantToken FunctionContext "record pattern" CurlyCloseToken pState) 
+	want_record_pattern token pState
+		# (fields, pState) =  want_field_assignments cIsAPattern token pState
+		= (PE_Record PE_Empty No fields, wantToken FunctionContext "record pattern" CurlyCloseToken pState) 
+
+	try_type_specification (IdentToken ident) pState
+		| isUpperCaseName ident || isFunnyIdName ident
+			# (token, pState) = nextToken FunctionContext pState
+			| token == BarToken
+				# (type_id, pState) = stringToIdent ident IC_Type pState
+				= (Yes type_id, pState)
+				= (No, tokenBack pState)
+			= (No, pState)
+	try_type_specification _ pState
+		= (No, pState)
+
+	want_updates :: Token ParsedExpr ParseState -> (ParsedExpr, ParseState)
+	want_updates token update_expr pState
+		# (updates, pState)
+			= parse_updates token update_expr pState
+		=	transform_record_or_array_update update_expr updates pState
+	where
+		parse_updates :: Token ParsedExpr ParseState -> ([NestedUpdate], ParseState)
+		parse_updates token update_expr pState
+				# (update, pState) = want_update token pState
+				  (token, pState) = nextToken FunctionContext pState
+				| token == CommaToken
+					# (token, pState) = nextToken FunctionContext pState
+					  (updates, pState) = parse_updates token update_expr pState 
+					= ([update : updates], pState)
+				// otherwise
+					= ([update], tokenBack pState)
+
+		want_update :: Token ParseState -> (NestedUpdate, ParseState)
+		want_update token pState
+			# (selectors, pState) = wantSelectors token pState
+			  (token, pState) = nextToken FunctionContext pState
+			| token == EqualToken
+				# (expr, pState) = wantExpression cIsNotAPattern pState
+				= ({nu_selectors = selectors, nu_update_expr = expr}, pState)
+				= ({nu_selectors = selectors, nu_update_expr = PE_Empty}, parseError "field assignment" (Yes token) "=" pState)
+
+	transform_record_or_array_update :: ParsedExpr [NestedUpdate] ParseState -> (ParsedExpr, ParseState)
+	transform_record_or_array_update expr updates pState
+		| is_record_update sortedUpdates
+			=	transform_record_update expr groupedUpdates pState
+		// otherwise
+			=	transform_array_update expr updates pState
+		where
+			sortedUpdates
+				// sort updates by first field name, array updates last
+				=	sortBy smaller_update updates
+				where
+					smaller_update :: NestedUpdate NestedUpdate -> Bool
+					smaller_update a b
+				 		=	smaller_selector (hd a.nu_selectors) (hd b.nu_selectors)
+			 			where
+							smaller_selector :: ParsedSelection ParsedSelection -> Bool
+							smaller_selector (PS_Record ident1 _) (PS_Record ident2 _)
+								=	ident1.id_name < ident2.id_name
+							smaller_selector (PS_Record _ _) _
+								=	True
+							smaller_selector _ _
+								=	False
+
+			groupedUpdates
+				// group nested updates by first field name
+				=	groupBy equal_update sortedUpdates
+				where
+					equal_update :: NestedUpdate NestedUpdate -> Bool
+					equal_update a b
+						=	equal_selectors a.nu_selectors b.nu_selectors
+			 			where
+							equal_selectors :: [ParsedSelection] [ParsedSelection] -> Bool
+							equal_selectors [PS_Record ident1 _ : [_]] [PS_Record ident2 _ : [_]]
+								=	ident1.id_name == ident2.id_name
+							equal_selectors _ _
+								=	False
+		
+			is_record_update [{nu_selectors=[select : _]} : _]
+				=	is_record_select select
+			is_record_update updates
+				=	False
+
+			is_record_select (PS_Record _ _)
+				=	True
+			is_record_select _
+				=	False
+
+			transform_record_update :: ParsedExpr ![[NestedUpdate]] ParseState -> (ParsedExpr, ParseState)
+			transform_record_update expr groupedUpdates pState
+				# (assignments, (optionalIdent, pState))
+					=	mapSt transform_update groupedUpdates (No, pState)
+				  updateExpr
+				  	=	build_update optionalIdent expr assignments
+				=	(updateExpr, pState)
+				where
+					// transform one group of nested updates with the same first field
+					//  for example: f.g1 = e1, f.g2 = e2 -> f = {id.f & g1 = e1, g2 = e2},
+					//  (id is ident to shared expression that's being updated)
+					transform_update :: [NestedUpdate] (Optional Ident, ParseState) -> (FieldAssignment, (Optional Ident, ParseState))
+					transform_update [{nu_selectors=[PS_Record fieldIdent _], nu_update_expr}] state
+						=	({bind_dst = fieldIdent, bind_src = nu_update_expr}, state)
+					transform_update updates=:[{nu_selectors=[PS_Record fieldIdent _ : _]} : _] (optionalIdent, pState)
+						# (shareIdent, pState)
+							=	make_ident optionalIdent pState
+						  select
+						  	=	PE_Selection cNonUniqueSelection (PE_Ident shareIdent) [PS_Record fieldIdent No]
+						  (update_expr, pState)
+						  	=	transform_record_or_array_update select (map sub_update updates) pState
+						=	({bind_dst = fieldIdent, bind_src = update_expr}, (Yes shareIdent, pState))
+						where
+							make_ident :: (Optional Ident) ParseState -> (Ident, ParseState)
+							make_ident (Yes ident) pState
+								=	(ident, pState)
+							make_ident No pState
+								=	internalIdent "s;" pState
+
+							sub_update :: NestedUpdate -> NestedUpdate
+							sub_update update=:{nu_selectors}
+								=	{update & nu_selectors = tl nu_selectors}
+					transform_update _ (_, pState)
+						# pState
+							=	parseError "record or array" No "field assignments mixed with array assignments not" /* expected */ pState
+						=	({bind_dst = errorIdent, bind_src = PE_Empty}, (No, pState))
+
+					build_update :: (Optional Ident) ParsedExpr [FieldAssignment] -> ParsedExpr
+					build_update No expr assignments
+						=	PE_Record expr No assignments
+					build_update (Yes ident) expr assignments
+						=	PE_Let False (LocalParsedDefs [buildNodeDef (PE_Ident ident) expr])
+									(PE_Record (PE_Ident ident) No assignments)
+
+			transform_array_update :: ParsedExpr [NestedUpdate] ParseState -> (ParsedExpr, ParseState)
+			transform_array_update expr updates pState
+				// transform {<e> & [i].<...> = e1, ... } to  {{<e> & [i1].<...> = e1} & ...}
+				=	foldSt transform_update updates (expr, pState)
+				where
+					transform_update :: NestedUpdate (ParsedExpr, ParseState) -> (ParsedExpr, ParseState)
+					transform_update {nu_selectors, nu_update_expr} (expr1, pState)
+						=	build_update expr1 (split_selectors nu_selectors) nu_update_expr pState
+						where
+							// split selectors into final record selectors and initial selectors
+							//  (resulting selectors are reversed)
+							//		for example: [i1].[i2].f.[i3].g.h -> (h.g, [i3].f.[i2].[i1])
+							split_selectors selectors
+								=	span is_record_select (reverse selectors)
+
+							build_update :: ParsedExpr ([ParsedSelection], [ParsedSelection]) ParsedExpr ParseState -> (ParsedExpr, ParseState)
+							build_update expr ([], initial_selectors) update_expr pState
+								=	(PE_Update expr (reverse initial_selectors) update_expr, pState)
+							// transform {<e> & <...>.[i].f.g. = e1} to
+							//     let
+							//		index_id = i
+							//		(element_id, array_id) = <e>!<...>.[index_id]
+							//	   in {array_id & [index_id] = {element_id & f.g = e1}}
+							build_update expr (record_selectors, [PS_Array index : initial_selectors]) update_expr pState
+								# (index_id, pState)
+									=	internalIdent "i;" pState
+								# (element_id, pState)
+									=	internalIdent "e;" pState
+								# (array_id, pState)
+									=	internalIdent "a;" pState
+								  index_def
+								  	=	buildNodeDef (PE_Ident index_id) index
+								  select_def
+								  	=	buildNodeDef
+								  			(PE_Tuple [PE_Ident element_id, PE_Ident array_id])
+								  			(PE_Selection cUniqueSelection expr (reverse [PS_Array (PE_Ident index_id) : initial_selectors]))
+								  (updated_element, pState)
+									= transform_record_update
+										(PE_Ident element_id)
+										[[{nu_selectors=(reverse record_selectors), nu_update_expr=update_expr}]] pState
+								=	(PE_Let False
+										(LocalParsedDefs [index_def, select_def])
+										(PE_Update (PE_Ident array_id) (reverse [PS_Array (PE_Ident index_id) : initial_selectors]) updated_element), pState)
+
+	want_field_assignments is_pattern token=:(IdentToken ident) pState
+		| isLowerCaseName ident
+			# (field, pState) = want_field_expression is_pattern ident pState
+			  (token, pState) = nextToken FunctionContext pState
+			| token == CommaToken
+				# (token, pState) = nextToken FunctionContext pState
+				  (fields, pState) = want_field_assignments is_pattern token pState 
+				= ([ field : fields ], pState)
+				= ([ field ], tokenBack pState)
+	where
+		want_field_expression is_pattern ident pState
+			# (field_id, pState) = stringToIdent ident IC_Selector pState
+			  (token, pState) = nextToken FunctionContext pState
+			| token == EqualToken
+				# (field_expr, pState) = wantExpression is_pattern pState
+				= ({ bind_src = field_expr, bind_dst = field_id}, pState)
+				= ({ bind_src = PE_Empty, bind_dst = field_id}, tokenBack pState)
+	want_field_assignments is_pattern token pState
+		= ([], parseError "record or array field assignments" (Yes token) "field name" pState)
+
+	try_field_assignment (IdentToken ident) pState
+		| isLowerCaseName ident
+			# (token, pState) = nextToken FunctionContext pState
+			| token == EqualToken
+				# (field_expr, pState) = wantExpression cIsNotAPattern pState
+				  (field_id, pState) = stringToIdent ident IC_Selector pState
+				= (True, { bind_src = field_expr, bind_dst = field_id}, pState) 
+				= (False, abort "no field", tokenBack pState)
+			= (False, abort "no field", pState)
+	try_field_assignment _ pState
+		= (False, abort "no field", pState)
+			
+	want_record type pState
+		# (token1, pState) = nextToken FunctionContext pState
+  		  (token2, pState) = nextToken FunctionContext pState
+		| isDefinesFieldToken token2
+			# (fields, pState) = want_field_assignments cIsNotAPattern token1 (tokenBack pState)
+			= (PE_Record PE_Empty type fields, wantToken FunctionContext "record" CurlyCloseToken pState)
+			= want_record_update type token1 (tokenBack pState)
+	where
+		want_record_update :: !(Optional Ident) !Token !ParseState -> (!ParsedExpr, !ParseState)
+		want_record_update type token pState
+			# (expr,  pState)	= wantRhsExpressionT token pState
+			  pState			= wantToken FunctionContext "record update" AndToken pState
+			  (token, pState)	= nextToken FunctionContext pState
+			= want_update expr token pState
+
+	want_update :: !ParsedExpr !Token !ParseState -> (!ParsedExpr, !ParseState)
+	want_update exp token pState
+		# (update_expr, pState)	= want_updates token exp pState
+	//	  (qualifiers, pState) = try_qualifiers pState // Bug: for RWS
+		= (update_expr, wantToken FunctionContext "record update" CurlyCloseToken pState)
+		where
+			try_qualifiers pState
+				# (token, pState) = nextToken FunctionContext pState
+				| token == DoubleBackSlashToken
+					= wantQualifiers 0 0 pState
+					= ([], tokenBack pState)
+
+	want_record_or_array_update token expr pState
+		= want_update expr token pState
+
+	want_array_assignments is_pattern pState
+		# (assign, pState) = want_array_assignment is_pattern pState
+		  (token, pState) = nextToken FunctionContext pState
+		| token == CommaToken
+			# pState = wantToken FunctionContext "array assignments" SquareOpenToken pState
+			  (assigns, pState) = want_array_assignments is_pattern pState 
+			= ([ assign : assigns ], pState)
+			= ([ assign ], tokenBack pState)
+	where
+		want_array_assignment is_pattern pState
+			# (index_exp,  pState) = wantExpression cIsNotAPattern pState
+			  pState = wantToken FunctionContext "array assignment" SquareCloseToken pState
+			  pState = wantToken FunctionContext "array assignment" EqualToken pState
+			  (pattern_exp, pState) = wantExpression is_pattern pState
+			= ({bind_dst = index_exp, bind_src = pattern_exp}, pState)
+
+/**
+	End of definitions
+**/
+
+skipToEndOfDefinition :: !ParseState -> (!Token, !ParseState)
+skipToEndOfDefinition pState
+	# (token, pState)		= nextToken FunctionContext pState
+	= case token of
+		NewDefinitionToken	-> (token, pState)
+		EndGroupToken		-> (token, pState)
+		EndOfFileToken		-> (token, pState)
+//		SemicolonToken		-> (token, pState) // might be useful in non layout mode.
+		_					-> skipToEndOfDefinition pState -->> (token,"skipped")
+
+wantEndOfDefinition :: String !ParseState -> ParseState
+wantEndOfDefinition msg pState=:{ps_skipping}
+	| ps_skipping
+		#	(token, pState) = skipToEndOfDefinition {pState & ps_skipping = False}
+		//	(pos,pState) 	= getPosition pState	// for debugging
+		= want_end_of_definition token msg pState	//-->> ("restart parsing at ",token, pos)
+	# (token, pState) = nextToken FunctionContext pState
+	= want_end_of_definition token msg pState
+where
+	want_end_of_definition :: !Token String !ParseState -> ParseState
+	want_end_of_definition token msg pState
+		# (ss_useLayout, pState) = accScanState UseLayout pState
+		| ss_useLayout
+			= case token of
+				NewDefinitionToken	->	pState 				// -->> "end of definition found due to NewDefinitionToken"
+				EndOfFileToken		->	tokenBack pState 	// -->> "end of definition found due to EndOfFileToken"
+				EndGroupToken 		->	tokenBack pState	// -->> "end of definition found due to EndGroupToken"
+				InToken		 		->	tokenBack pState	// -->> "end of definition found due to InToken"
+				WhereToken			->	tokenBack pState	// -->> "end of definition found due to WhereToken"
+				BarToken			->	tokenBack pState	// -->> "end of definition found due to BarToken"
+				EqualToken			->	tokenBack pState	// -->> "end of definition found due to EqualToken"
+				ArrowToken			->	tokenBack pState	// -->> "end of definition found due to ArrowToken"
+				SeqLetToken _		->	tokenBack pState	// -->> "end of definition found due to SeqLetToken"
+				SemicolonToken		#	(token, pState) = nextToken FunctionContext pState
+									->	case token of
+											NewDefinitionToken	->	pState			// -->> "end of definition found due to SemicolonToken and NewDefinitionToken"
+											_					->	tokenBack pState// -->> "end of definition found due to SemicolonToken"
+				token				->	wantEndOfDefinition "" (parseError msg (Yes token) "end of definition" pState)
+		// otherwise // ~ ss_useLayout
+			= case token of
+				CurlyCloseToken		->	tokenBack pState
+				SemicolonToken		->	pState
+	 			EndOfFileToken		->	tokenBack pState	// -->> "end of definition found due to EndOfFileToken"
+				token				->	wantEndOfDefinition "" (parseError msg (Yes token) "end of definition" pState)
+
+wantEndRootExpression :: !ParseState -> ParseState
+wantEndRootExpression pState=:{ps_skipping}
+	| ps_skipping
+		=	wantEndOfDefinition "root expression" pState
+		#	(token, pState)			= nextToken FunctionContext pState
+			(ss_useLayout, pState)	= accScanState UseLayout pState
+		| ss_useLayout
+			= case token of
+				NewDefinitionToken	->	pState
+				EndOfFileToken		->	tokenBack pState
+				EndGroupToken 		->	tokenBack pState
+				EqualToken 			->	tokenBack pState
+				ArrowToken 			->	tokenBack pState
+				WhereToken			->	tokenBack pState
+				WithToken			->	tokenBack pState
+				BarToken			->	tokenBack pState
+				InToken		 		->	tokenBack pState
+				CloseToken	 		->	tokenBack pState
+				(SeqLetToken _)		->	tokenBack pState
+				SemicolonToken		#	(token, pState) = nextToken FunctionContext pState
+									->	case token of
+											NewDefinitionToken	->	pState
+											_					->	tokenBack pState
+				token				->	wantEndOfDefinition "root expression" (parseError "root expression" (Yes token) "end of root expression" pState)
+		// otherwise // ~ ss_useLayout
+			= case token of
+				SemicolonToken		->	pState
+				CurlyCloseToken		->	tokenBack pState
+				EqualToken 			->	tokenBack pState	// Do we really want to allow all of these tokens
+				ArrowToken 			->	tokenBack pState
+				(SeqLetToken _)		->	tokenBack pState
+				WhereToken			->	tokenBack pState
+				WithToken			->	tokenBack pState
+				BarToken			->	tokenBack pState
+	 			EndOfFileToken		->	tokenBack pState
+				token				->	wantEndOfDefinition "root expression" (parseError "root expression" (Yes token) "end of root expression" pState)
+
+wantEndGroup :: String !ParseState -> ParseState
+wantEndGroup msg pState
+	# (token, pState) = nextToken FunctionContext pState
+	| token == EndOfFileToken
+		= tokenBack pState
+	# (ss_useLayout, pState) = accScanState UseLayout pState
+	| ss_useLayout
+		= case token of
+			EndGroupToken	->	pState
+			_				->	parseError msg (Yes token) "end of group with layout" pState
+	// ~ ss_useLayout
+	| token == CurlyCloseToken
+		= pState
+	// otherwise // token <> CurlyCloseToken
+		= parseError msg (Yes token) "end of group without layout, }," pState
+
+wantEndModule :: !ParseState -> ParseState
+wantEndModule pState
+	# (token, pState) = nextToken FunctionContext pState
+	| token == EndOfFileToken
+		= tokenBack pState
+	# (ss_useLayout, pState) = accScanState UseLayout pState
+	| ss_useLayout && token == EndGroupToken
+		= pState
+		= parseError "Definition" (Yes token) "Unexpected token in input: definition" pState
+
+wantEndNestedGuard :: !Bool !Int !ParseState -> ParseState
+wantEndNestedGuard defaultFound offside pState
+	| ~ defaultFound
+		= parseError "nested guards" No "sorry, but for the time being there is a default alternative for nested guards" pState
+	# (token, pState)			= nextToken FunctionContext pState
+	| token == EndOfFileToken
+		= tokenBack pState
+	# (ss_useLayout, pState)	= accScanState UseLayout pState
+	| ss_useLayout
+		# ({fp_col}, pState)	= getPosition pState
+		|  fp_col < offside || (end_Nested_Guard token && fp_col == offside)
+			= tokenBack pState
+		// otherwise
+			= parseError "nested guards" (Yes token) "=, ->, | or # at offside position, or end of function definition" pState
+	// ~ ss_useLayout
+	| token == SemicolonToken
+		= pState
+	| defaultFound
+		= tokenBack pState
+	// otherwise
+		= parseError "nested guards" (Yes token) "End of nested guards, ;," pState
+where
+	end_Nested_Guard EqualToken			= True
+	end_Nested_Guard BarToken			= True
+	end_Nested_Guard ArrowToken			= True
+	end_Nested_Guard (SeqLetToken _)	= True
+	end_Nested_Guard _					= False
+
+wantEndLocals :: !ParseState -> ParseState
+wantEndLocals pState
+	# (ss_useLayout, pState) = accScanState UseLayout pState
+	  (token, pState) = nextToken FunctionContext pState
+	| token == EndOfFileToken
+		= tokenBack pState
+	| ss_useLayout
+		= case token of
+			EndGroupToken	->	pState
+			_				->	parseError "local definitions" (Yes token) "end of locals with layout" pState
+	// ~ ss_useLayout
+	| token == CurlyCloseToken
+		# (token, pState) = nextToken FunctionContext pState
+		| token == SemicolonToken
+			= pState
+			= tokenBack pState
+	// otherwise // token <> CurlyCloseToken
+		= parseError "local definitions" (Yes token) "end of locals without layout, }," pState
+
+wantEndCase :: !ParseState -> ParseState
+wantEndCase pState
+	# (ss_useLayout, pState) = accScanState UseLayout pState
+	  (token, pState) = nextToken FunctionContext pState
+	| token == EndOfFileToken
+		= tokenBack pState
+	| ss_useLayout
+		= case token of
+			EndGroupToken		->	pState
+			CloseToken			->	tokenBack (appScanState dropOffsidePosition pState)
+			SquareCloseToken	->	tokenBack (appScanState dropOffsidePosition pState)
+			SemicolonToken		->	tokenBack (appScanState dropOffsidePosition pState)
+			_					->	parseError "case expression" (Yes token) "end of case with layout" pState
+	// ~ ss_useLayout
+	| token == CurlyCloseToken
+		= pState
+	// otherwise // token <> CurlyCloseToken
+		= parseError "case expression" (Yes token) "end of group without layout, }," pState
+
+wantBeginGroup :: String !ParseState -> ParseState
+wantBeginGroup msg pState
+	# (ss_useLayout, pState) = accScanState UseLayout pState
+	| ss_useLayout
+		= pState
+	// otherwise // ~ ss_uselayout
+		# (token, pState)	= nextToken FunctionContext pState
+		= case token of
+			CurlyOpenToken
+				->	pState
+			_	->	parseError msg (Yes token) "begin group without layout, {," pState
+
+/*
+	Functions on the parse pState
+*/
+/*
+instance insertToken ParseState
+where
+	insertToken t c pState = appScanState (insertToken t c) pState
+
+instance currentToken ParseState
+where
+	currentToken pState = accScanState currentToken pState
+*/	
+instance replaceToken ParseState
+where
+	replaceToken t pState = appScanState (replaceToken t) pState
+
+instance tokenBack ParseState
+where
+	tokenBack pState=:{ps_skipping}
+		| ps_skipping
+			= pState
+			= appScanState tokenBack pState
+
+instance nextToken ParseState
+where
+	nextToken :: !Context !ParseState -> (!Token, !ParseState)
+	nextToken context pState
+		| pState.ps_skipping // in error recovery from parse error
+			= (ErrorToken "Skipping", pState)
+			= accScanState (nextToken context) pState
+
+instance getPosition ParseState
+where
+	getPosition pState = accScanState getPosition pState
+
+parseWarning :: !{# Char} !{# Char} !ParseState -> ParseState
+parseWarning act msg pState
+	| pState.ps_skipping
+		= pState
+	| otherwise // not pState.ps_skipping
+		# (pos,pState) 	= getPosition pState
+		  (filename,pState=:{ps_error={pea_file,pea_ok}})	= accScanState getFilename pState
+		  pea_file 	= 	pea_file
+		  				<<< "Parse warning ["
+		  				<<< filename <<< ","
+		  				<<< pos 
+		  				<<< (if (size act > 0) ("," + act) "") <<< "]: "
+		  				<<< msg
+		  				<<< "\n"
+		=	{ pState
+			& ps_error		= { pea_file = pea_file, pea_ok = pea_ok }
+			}
+
+parseError :: !{# Char} !(Optional Token) !{# Char} !ParseState -> ParseState
+parseError act opt_token msg pState
+	| pState.ps_skipping
+		= pState
+	| otherwise // not pState.ps_skipping
+		# (pos,pState) 	= getPosition pState
+		  (filename,pState=:{ps_error={pea_file}})	= accScanState getFilename pState
+		  pea_file 	= 	pea_file
+		  				<<< "Parse error ["
+		  				<<< filename <<< ","
+		  				<<< pos 
+		  				<<< (if (size act > 0) ("," + act) "") <<< "]: "
+		  				<<< msg
+		  pea_file	= case opt_token of
+		  				Yes token	-> pea_file <<< " expected instead of " <<< token <<< "\n"
+		  				No			-> pea_file <<< " expected\n"
+		  pState 	=	{ pState
+						& ps_skipping	= True
+						, ps_error		= { pea_file = pea_file, pea_ok = False }
+						}
+		= case opt_token of
+			Yes _	-> tokenBack pState
+			No		-> pState
+
+getFileAndLineNr :: !ParseState -> (!String, !Int, !ParseState)
+getFileAndLineNr pState =: {ps_scanState}
+	# (filename,scanState)	= getFilename ps_scanState
+	  ({fp_line},scanState)	= getPosition scanState
+	= (filename, fp_line, {pState & ps_scanState = scanState} )
+
+/*
+	Simple parse functions
+*/
+
+wantToken :: !Context !{#Char} !Token !ParseState ->  ParseState
+wantToken context act dem_token pState
+	# (token, pState) = nextToken context pState
+	| dem_token == token
+		= pState // -->> (token,"wanted and consumed")
+		= parseError act (Yes token) (toString dem_token) pState
+
+instance want Priority
+where
+	want pState
+		# (token, pState) = nextToken FunctionContext pState
+		= case token of
+			PriorityToken prio
+				-> (prio, pState)
+			_
+				-> (NoPrio, parseError "Priority" (Yes token) "with" pState)
+
+instance want {# Char}
+where
+	want pState
+		# (token, pState) = nextToken GeneralContext pState
+		= case token of
+			IdentToken name -> (name, pState)
+			_				-> ("", parseError "String" (Yes token) "identifier" pState)
+
+tryTypeVar :: !ParseState -> (!Bool, TypeVar, !ParseState)
+tryTypeVar pState
+	# (token, pState) = nextToken TypeContext pState
+	= tryTypeVarT token pState
+
+tryTypeVarT :: !Token !ParseState -> (!Bool, TypeVar, !ParseState)
+tryTypeVarT (IdentToken name) pState
+	| isUpperCaseName name
+		= (False, abort "no UC ident", pState)
+		# (id, pState) = stringToIdent name IC_Type pState
+		= (True, MakeTypeVar id, pState)
+tryTypeVarT token pState
+		= (False, abort "no type variable", tokenBack pState)
+
+wantUpperCaseName :: !String !ParseState -> (!String, !ParseState)
+wantUpperCaseName string pState
+	# (token, pState) = nextToken GeneralContext pState
+	= case token of
+		IdentToken name 
+			| isUpperCaseName name
+				-> (name, pState)
+		_
+			-> ("dummy uppercase name", parseError string (Yes token) "upper case ident" pState)
+
+wantLowerCaseName :: !String !ParseState -> (!String, !ParseState)
+wantLowerCaseName string pState
+	# (token, pState) = nextToken GeneralContext pState
+	= case token of
+		IdentToken name 
+			| isLowerCaseName name
+				-> (name, pState)
+		_
+			-> ("dummy lowercase name", parseError string (Yes token) "lower case ident" pState)
+
+wantConstructorName :: !String !ParseState -> (!String, !ParseState)
+wantConstructorName string pState
+	# (token, pState) = nextToken GeneralContext pState
+	= case token of
+		IdentToken name 
+			| isUpperCaseName name || isFunnyIdName name
+				-> (name, pState)
+		_
+			-> ("", parseError string (Yes token) "upper case ident" pState)
+
+/*
+isTypeStartToken :: ! Token -> Bool
+isTypeStartToken (IdentToken id)	= True
+isTypeStartToken SquareOpenToken	= True
+isTypeStartToken CurlyOpenToken		= True
+isTypeStartToken OpenToken			= True
+isTypeStartToken IntTypeToken		= True
+isTypeStartToken CharTypeToken		= True
+isTypeStartToken BoolTypeToken		= True
+isTypeStartToken VoidTypeToken		= True
+isTypeStartToken StringTypeToken	= True
+isTypeStartToken RealTypeToken		= True
+isTypeStartToken DynamicTypeToken	= True
+isTypeStartToken ExclamationToken	= True
+isTypeStartToken DotToken			= True
+isTypeStartToken AsteriskToken		= True
+isTypeStartToken token				= False
+
+isIdentToken :: ! Token -> Bool
+isIdentToken (IdentToken id) = True
+isIdentToken t               = False
+
+isTypeDefToken :: ! Token -> Bool
+isTypeDefToken DoubleColonToken	= True
+isTypeDefToken token			= False
+
+isDefinesTypeToken :: !Token -> Bool
+isDefinesTypeToken EqualToken      = True
+isDefinesTypeToken ColonDefinesToken = True
+isDefinesTypeToken token             = False
+
+isUpperCaseIdent :: ! Token -> Bool
+isUpperCaseIdent (IdentToken name) = isUpperCaseName name
+isUpperCaseIdent token             = False
+*/
+isDefinesFieldToken :: ! Token -> Bool
+isDefinesFieldToken EqualToken    = True
+isDefinesFieldToken CurlyCloseToken = True
+isDefinesFieldToken CommaToken      = True
+isDefinesFieldToken token           = False
+
+  //---------------//
+ //--- Tracing ---//
+//---------------//
+
+(-->>) val _ :== val
+//(-->>) val message :== val ---> ("Parser",message)
diff --git a/frontend/part.icl b/frontend/part.icl
new file mode 100644
index 0000000..8a080e2
--- /dev/null
+++ b/frontend/part.icl
@@ -0,0 +1,92 @@
+module part
+
+import StdEnv
+
+import syntax, transform, checksupport, StdCompare, check, utilities
+
+::	PartitioningInfo = 
+	{	pi_marks :: 		!.{# Int}
+	,	pi_next_num ::		!Int
+	,	pi_next_group ::	!Int
+	,	pi_groups ::		![[Int]]
+	,	pi_deps ::			![Int]
+	}
+
+NotChecked :== -1	
+
+Start = 3
+
+partitionateFunctions :: !*{# FunDef} !*{# FunDef} -> (!{! Group}, !*{# FunDef}, !*{# FunDef})
+partitionateFunctions fun_defs inst_defs
+	#! nr_of_functions = size fun_defs
+	   nr_of_instances = size inst_defs
+	#! max_fun_nr = nr_of_functions + nr_of_instances
+	# partitioning_info = { pi_marks = createArray max_fun_nr NotChecked, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] }
+	  (fun_defs, inst_defs, {pi_groups,pi_next_group}) = partitionate_functions 0 max_fun_nr nr_of_functions fun_defs inst_defs partitioning_info
+	  groups = { {group_members = group} \\ group <- reverse pi_groups }
+	= (groups, fun_defs, inst_defs)
+where
+	partitionate_functions :: !Int !Int !Int !*{# FunDef} !*{# FunDef} !*PartitioningInfo -> (!*{# FunDef}, !*{# FunDef}, !*PartitioningInfo)
+	partitionate_functions from_index max_fun_nr nr_of_functions fun_defs inst_defs pi=:{pi_marks}
+		| from_index == max_fun_nr
+			= (fun_defs, inst_defs, pi)
+		| pi_marks.[from_index] == NotChecked
+			# (_, fun_defs, inst_defs, pi) = partitionate_function from_index max_fun_nr nr_of_functions fun_defs inst_defs pi
+			= partitionate_functions (inc from_index) max_fun_nr nr_of_functions fun_defs inst_defs pi
+			= partitionate_functions (inc from_index) max_fun_nr nr_of_functions fun_defs inst_defs pi
+
+	partitionate_function :: !Int !Int !Int !*{# FunDef} !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*{# FunDef}, !*PartitioningInfo)
+	partitionate_function fun_index max_fun_nr nr_of_functions fun_defs inst_defs pi=:{pi_next_num}
+		| fun_index < nr_of_functions
+			#! fd = fun_defs.[fun_index]
+			| fd.fun_kind
+				# {fi_calls,fi_instance_calls} = fd.fun_info
+				  (min_dep, fun_defs, inst_defs, pi) = visit_functions fi_calls max_fun_nr max_fun_nr nr_of_functions fun_defs inst_defs (push_on_dep_stack fun_index pi)
+				  (min_dep, fun_defs, inst_defs, pi) = visit_functions fi_calls min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
+				= try_to_close_group fun_index pi_next_num min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
+			#! fd = inst_defs.[fun_index-nr_of_functions]
+			# {fi_calls,fi_instance_calls} = fd.fun_info
+			  (min_dep, fun_defs, inst_defs, pi) = visit_functions fi_calls max_fun_nr max_fun_nr nr_of_functions fun_defs inst_defs (push_on_dep_stack fun_index pi)
+			  (min_dep, fun_defs, inst_defs, pi) = visit_functions fi_calls min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
+			= try_to_close_group fun_index pi_next_num min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
+				  
+	push_on_dep_stack :: !Int !*PartitioningInfo -> *PartitioningInfo;
+	push_on_dep_stack fun_index pi=:{pi_deps,pi_marks,pi_next_num}
+		= { pi & pi_deps = [fun_index : pi_deps], pi_marks = { pi_marks & [fun_index] = pi_next_num}, pi_next_num = inc pi_next_num}
+
+	visit_functions :: ![FunCall] !Int !Int !Int !*{# FunDef} !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*{# FunDef}, !*PartitioningInfo)
+	visit_functions [{fc_index}:funs] min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi=:{pi_marks} 
+		#! mark = pi_marks.[fc_index]
+		| mark == NotChecked
+			# (mark, fun_defs, inst_defs, pi) = partitionate_function fc_index max_fun_nr nr_of_functions fun_defs inst_defs  pi
+			= visit_functions funs (min min_dep mark) max_fun_nr nr_of_functions fun_defs inst_defs pi
+			= visit_functions funs (min min_dep mark) max_fun_nr nr_of_functions fun_defs inst_defs pi
+	visit_functions [] min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
+		= (min_dep, fun_defs, inst_defs, pi)
+		
+
+	try_to_close_group :: !Int !Int !Int !Int !Int !*{# FunDef} !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*{# FunDef}, !*PartitioningInfo)
+	try_to_close_group fun_index fun_nr min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi=:{pi_marks, pi_deps, pi_groups, pi_next_group}
+		| fun_nr <= min_dep
+			# (pi_deps, pi_marks, group, fun_defs, inst_defs)
+				= close_group fun_index pi_deps pi_marks [] max_fun_nr nr_of_functions pi_next_group fun_defs inst_defs
+				
+			  pi = { pi & pi_deps = pi_deps, pi_marks = pi_marks, pi_next_group = inc pi_next_group,  pi_groups = [group : pi_groups] }
+			= (max_fun_nr, fun_defs, inst_defs, pi)
+			= (min_dep, fun_defs, inst_defs, pi)
+	where
+		close_group :: !Int ![Int] !*{# Int} ![Int] !Int !Int !Index !*{# FunDef} !*{# FunDef} -> (![Int], !*{# Int}, ![Int], !*{# FunDef}, !*{# FunDef})
+		close_group fun_index [d:ds] marks group max_fun_nr nr_of_functions group_number fun_defs inst_defs
+			#! fd = fun_defs.[d]
+			# marks = { marks & [d] = max_fun_nr }
+			| d < nr_of_functions
+				#! fd = fun_defs.[d]
+				# fun_defs = { fun_defs & [d] = { fd & fun_info.fi_group_index = group_number }}
+				| d == fun_index
+					= (ds, marks, [d : group], fun_defs, inst_defs)
+					= close_group fun_index ds marks group max_fun_nr nr_of_functions group_number fun_defs inst_defs
+				#! fd = inst_defs.[d-nr_of_functions]
+				# inst_defs = { inst_defs & [d] = { fd & fun_info.fi_group_index = group_number }}
+				| d == fun_index
+					= (ds, marks, [d : group], fun_defs, inst_defs)
+					= close_group fun_index ds marks group max_fun_nr nr_of_functions group_number fun_defs inst_defs
diff --git a/frontend/postparse.dcl b/frontend/postparse.dcl
new file mode 100644
index 0000000..b8778aa
--- /dev/null
+++ b/frontend/postparse.dcl
@@ -0,0 +1,8 @@
+definition module postparse
+
+import StdEnv
+
+import syntax, parse, predef
+
+scanModule :: !ParsedModule !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files
+	-> (!Bool, !ScannedModule, !Int, ![FunDef], !ScannedModule, !ScannedModule, ![ScannedModule], !*HashTable, !*File, !*PredefinedSymbols, !*Files)
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
new file mode 100644
index 0000000..31d295f
--- /dev/null
+++ b/frontend/postparse.icl
@@ -0,0 +1,813 @@
+implementation module postparse
+
+import StdEnv
+import syntax, parse, predef, utilities, StdCompare
+import RWSDebug
+
+/**
+	 
+**/
+
+cIsAGlobalDef		:== True
+cIsNotAGlobalDef	:== False
+
+::	PredefinedIdents :== {!Ident}
+
+SelectPredefinedIdents :: *PredefinedSymbols -> (!PredefinedIdents, !*PredefinedSymbols)
+SelectPredefinedIdents predefs
+	=	selectIdents 0 (createArray PD_NrOfPredefSymbols {id_name="", id_info = nilPtr}) predefs
+	where
+		selectIdents i idents symbols
+			| i == PD_NrOfPredefSymbols
+				=	(idents, symbols)
+			// otherwise
+				#!	symbol = symbols.[i]
+				=	selectIdents (i+1) {idents & [i] = symbol.pds_ident} symbols
+
+predef :: Int PredefinedIdents -> ParsedExpr
+predef index ids
+	=	PE_Ident ids.[index]
+
+(##) infixl 9
+(##) f a
+	:== \idents -> apply (f idents) (toParsedExpr a idents)
+
+(#<) a b
+	:==	predef PD_SmallerFun ## a ## b
+
+// apply :: ParsedExpr ParsedExpr -> ParsedExpr
+
+apply :: ParsedExpr ParsedExpr -> ParsedExpr
+apply (PE_List application) a
+	=	PE_List (application ++ [a])
+apply f a
+	=	PE_List [f, a]
+
+class toParsedExpr a :: !a !PredefinedIdents -> ParsedExpr
+
+instance toParsedExpr [a] | toParsedExpr a where
+	toParsedExpr [] ids
+		=	predef PD_NilSymbol ids
+	toParsedExpr [hd:tl] ids
+		=	(predef PD_ConsSymbol ## hd ## tl) ids
+
+//instance toParsedExpr a where
+//	toParsedExpr _ _
+//		=	abort "toParsedExpr (a) shouldn't be called"
+
+instance toParsedExpr ParsedExpr where
+	toParsedExpr x _
+		=	x
+
+instance toParsedExpr Int where
+	toParsedExpr x _
+		=	PE_Basic (BVI (toString x))
+
+instance toParsedExpr Char where
+	toParsedExpr x _
+		=	PE_Basic (BVC (toString x))
+
+instance toParsedExpr Ident where
+	toParsedExpr x _
+		=	PE_Ident x
+
+postParseError pos msg ps=:{ca_error={pea_file}}
+	# (filename, line, funname) = get_file_and_line_nr pos
+	  pea_file	= pea_file <<< "Post Parse Error [" <<< filename <<< "," <<< line // PK
+	  pea_file	= case funname of
+	  				Yes name	-> pea_file <<< "," <<< name
+	  				No			-> pea_file
+	  pea_file	= pea_file <<< "]: " <<< msg <<< ".\n"
+	= {ps & ca_error = { pea_file = pea_file, pea_ok = False }}
+where
+	get_file_and_line_nr (FunPos filename linenr funname)
+		= (filename, linenr, Yes funname)
+	get_file_and_line_nr (LinePos filename linenr)
+		= (filename, linenr, No)
+
+:: *CollectAdmin =
+	{	ca_error		:: !ParseErrorAdmin
+	,	ca_fun_count	:: !Int
+	,	ca_predefs		:: !PredefinedIdents
+	}
+
+class collectFunctions a :: a !CollectAdmin -> (a, ![FunDef], !CollectAdmin)
+
+instance collectFunctions ParsedExpr
+where
+	collectFunctions (PE_List exprs) ca
+		# (exprs, fun_defs, ca) = collectFunctions exprs ca
+		= (PE_List exprs, fun_defs, ca)
+	collectFunctions (PE_Bound bound_expr) ca
+		# (bound_expr, fun_defs, ca) = collectFunctions bound_expr ca
+		= (PE_Bound bound_expr, fun_defs, ca)
+	collectFunctions (PE_Lambda lam_ident args res) ca
+		# fun_count = ca.ca_fun_count
+		  next_fun_count = inc fun_count
+		  ((args,res), fun_defs, ca) = collectFunctions (args,res) {ca & ca_fun_count = next_fun_count}
+		  fun_def = transformLambda lam_ident args res
+		= (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = { ir_from = fun_count, ir_to = next_fun_count }, loc_nodes = [] })
+				(PE_Ident lam_ident), [fun_def : fun_defs], ca)
+	collectFunctions (PE_Record rec_expr type_name fields) ca
+		# ((rec_expr,fields), fun_defs, ca) = collectFunctions (rec_expr,fields) ca
+		= (PE_Record rec_expr type_name fields, fun_defs, ca)
+	collectFunctions (PE_Tuple exprs) ca
+		# (exprs, fun_defs, ca) = collectFunctions exprs ca
+		= (PE_Tuple exprs, fun_defs, ca)
+	collectFunctions (PE_Selection is_unique expr selectors) ca
+		# ((expr, selectors), fun_defs, ca) = collectFunctions (expr, selectors) ca
+		= (PE_Selection is_unique  expr selectors, fun_defs, ca)
+	collectFunctions (PE_Update expr1 updates expr2) ca
+		# ((expr1, (updates, expr2)), fun_defs, ca) = collectFunctions (expr1, (updates, expr2)) ca
+		= (PE_Update expr1 updates expr2, fun_defs, ca)
+	collectFunctions (PE_Case case_ident pattern_expr case_alts) ca
+		# ((pattern_expr,case_alts), fun_defs, ca) = collectFunctions (pattern_expr,case_alts) ca
+		= (PE_Case case_ident pattern_expr case_alts, fun_defs, ca)
+	collectFunctions (PE_If if_ident c t e) ca
+		# true_pattern		= PE_Basic (BVB True)
+		  false_pattern		= PE_WildCard // PE_Basic (BVB False)
+		= collectFunctions (PE_Case if_ident c
+							[ {calt_pattern = true_pattern , calt_rhs = exprToRhs t}
+							, {calt_pattern = false_pattern, calt_rhs = exprToRhs e}
+							]) ca
+	where
+		exprToRhs expr 
+		 =	{	rhs_alts	= UnGuardedExpr
+		 						{	ewl_nodes	= []
+								,	ewl_expr	= expr
+								,	ewl_locals	= LocalParsedDefs []
+								}
+			,	rhs_locals	= LocalParsedDefs []
+			}
+	collectFunctions (PE_Let strict locals in_expr) ca
+		# ((node_defs,in_expr), fun_defs, ca) = collectFunctions (locals,in_expr) ca
+		= (PE_Let strict node_defs in_expr, fun_defs, ca)
+	collectFunctions (PE_Compr gen_kind expr qualifiers) ca=:{ca_predefs}
+		= transformComprehension gen_kind expr qualifiers ca
+	collectFunctions (PE_Array expr assignments _) ca=:{ca_predefs}
+		= collectFunctions (transformArrayUpdate expr assignments ca_predefs) ca
+	collectFunctions (PE_Sequ sequence) ca=:{ca_predefs}
+		= collectFunctions (transformSequence sequence ca_predefs) ca
+	collectFunctions (PE_ArrayDenot exprs) ca=:{ca_predefs}
+		= collectFunctions (transformArrayDenot exprs ca_predefs) ca
+	collectFunctions expr ca
+		= (expr, [], ca)
+
+instance collectFunctions [a] | collectFunctions a
+where
+	collectFunctions [x:xs] ca
+		# (x, fun_defs_in_x, ca) = collectFunctions x ca
+		  (xs, fun_defs_in_xs, ca) = collectFunctions xs ca
+		= ([x:xs], fun_defs_in_x ++ fun_defs_in_xs, ca)
+	collectFunctions [] ca
+		= ([], [], ca)
+		
+instance collectFunctions (a,b) | collectFunctions a & collectFunctions b
+where
+	collectFunctions (x,y) ca
+		# (x, fun_defs_in_x, ca) = collectFunctions x ca
+		  (y, fun_defs_in_y, ca) = collectFunctions y ca
+		= ((x,y), fun_defs_in_x ++ fun_defs_in_y, ca)
+
+instance collectFunctions Qualifier
+where
+	collectFunctions qual=:{qual_generators, qual_filter} ca
+		# ((qual_generators, qual_filter), fun_defs, ca) = collectFunctions (qual_generators, qual_filter) ca
+		= ({ qual & qual_generators = qual_generators, qual_filter = qual_filter }, fun_defs, ca) 
+		
+instance collectFunctions Generator
+where
+	collectFunctions gen=:{gen_pattern,gen_expr} ca
+		# ((gen_pattern,gen_expr), fun_defs, ca) = collectFunctions (gen_pattern,gen_expr) ca
+		= ({gen & gen_pattern = gen_pattern, gen_expr = gen_expr}, fun_defs, ca) 
+
+
+instance collectFunctions (Optional a) | collectFunctions a
+where
+	collectFunctions (Yes expr) ca
+		# (expr, fun_defs, ca) = collectFunctions expr ca
+		= (Yes expr, fun_defs, ca) 
+	collectFunctions No ca
+		= (No, [], ca) 
+
+instance collectFunctions ParsedSelection
+where
+	collectFunctions (PS_Array index_expr) ca
+		# (index_expr, fun_defs, ca) = collectFunctions index_expr ca
+		= (PS_Array index_expr, fun_defs, ca)
+	collectFunctions expr ca
+		= (expr, [], ca)
+
+instance collectFunctions CaseAlt
+where
+	collectFunctions calt=:{calt_pattern,calt_rhs} ca
+		# ((calt_pattern,calt_rhs), fun_defs, ca) = collectFunctions (calt_pattern,calt_rhs) ca
+		= ({calt & calt_pattern = calt_pattern, calt_rhs = calt_rhs}, fun_defs, ca) 
+
+
+instance collectFunctions Sequence
+where
+	collectFunctions (SQ_FromThen from_expr then_expr) ca
+		# ((from_expr,then_expr), fun_defs, ca) = collectFunctions (from_expr,then_expr) ca
+		= (SQ_FromThen from_expr then_expr, fun_defs, ca) 
+	collectFunctions (SQ_FromThenTo from_expr then_expr to_expr) ca
+		# ((from_expr,(then_expr,to_expr)), fun_defs, ca) = collectFunctions (from_expr,(then_expr,to_expr)) ca
+		= (SQ_FromThenTo from_expr then_expr to_expr, fun_defs, ca) 
+	collectFunctions (SQ_FromTo from_expr to_expr) ca
+		# ((from_expr,to_expr), fun_defs, ca) = collectFunctions (from_expr,to_expr) ca
+		= (SQ_FromTo from_expr to_expr, fun_defs, ca) 
+	collectFunctions (SQ_From from_expr) ca
+		# (from_expr, fun_defs, ca) = collectFunctions from_expr ca
+		= (SQ_From from_expr, fun_defs, ca) 
+
+instance collectFunctions Bind a b | collectFunctions a & collectFunctions b
+where
+	collectFunctions bind=:{bind_src,bind_dst} ca
+		# ((bind_src,bind_dst), fun_defs, ca) = collectFunctions (bind_src,bind_dst) ca
+		= ({ bind_src = bind_src, bind_dst = bind_dst }, fun_defs, ca)
+
+instance collectFunctions OptGuardedAlts
+where
+	collectFunctions (GuardedAlts guarded_exprs (Yes def_expr)) ca
+		# ((guarded_exprs, def_expr), fun_defs, ca) = collectFunctions (guarded_exprs, def_expr) ca
+		= (GuardedAlts guarded_exprs (Yes def_expr), fun_defs, ca)
+	collectFunctions (GuardedAlts guarded_exprs No) ca
+		# (guarded_exprs, fun_defs, ca) = collectFunctions guarded_exprs ca
+		= (GuardedAlts guarded_exprs No, fun_defs, ca)
+	collectFunctions (UnGuardedExpr unguarded_expr) ca
+		# (unguarded_expr, fun_defs, ca) = collectFunctions unguarded_expr ca
+		= (UnGuardedExpr unguarded_expr, fun_defs, ca)
+
+instance collectFunctions GuardedExpr
+where
+	collectFunctions alt=:{alt_nodes,alt_guard,alt_expr} ca
+		# ((alt_nodes, (alt_guard, alt_expr)), fun_defs, ca) =
+				collectFunctions (alt_nodes, (alt_guard, alt_expr)) ca
+		= ({alt & alt_nodes = alt_nodes, alt_guard = alt_guard, alt_expr = alt_expr}, fun_defs, ca)
+
+instance collectFunctions ExprWithLocalDefs
+where
+	collectFunctions expr=:{ewl_nodes, ewl_expr,ewl_locals} ca
+		# ((ewl_nodes, (ewl_expr, ewl_locals)), fun_defs, ca) = collectFunctions (ewl_nodes, (ewl_expr, ewl_locals)) ca
+		= ({expr & ewl_nodes = ewl_nodes, ewl_expr = ewl_expr, ewl_locals = ewl_locals}, fun_defs, ca)
+
+instance collectFunctions NodeDefWithLocals
+where
+	collectFunctions node_def=:{ndwl_def, ndwl_locals} ca
+		# (( ndwl_def, ndwl_locals), fun_defs, ca) = collectFunctions (ndwl_def, ndwl_locals) ca
+		= ({node_def & ndwl_def = ndwl_def, ndwl_locals = ndwl_locals}, fun_defs, ca)
+
+instance collectFunctions Rhs
+where
+	collectFunctions {rhs_alts, rhs_locals} ca
+		# ((rhs_alts, rhs_locals), fun_defs, ca) = collectFunctions (rhs_alts, rhs_locals) ca
+		= ({rhs_alts = rhs_alts, rhs_locals = rhs_locals}, fun_defs, ca)
+
+instance collectFunctions LocalDefs
+where
+	collectFunctions (LocalParsedDefs locals) ca
+		# (fun_defs, node_defs, ca) = reorganizeLocalDefinitions locals ca
+		  ir_from = ca.ca_fun_count
+		  ir_to = ca.ca_fun_count + length fun_defs
+		  (node_defs, fun_defs_in_node_defs, ca) = collect_functions_in_node_defs node_defs {ca & ca_fun_count = ir_to}
+		  (fun_defs, collected_fun_defs, ca) = reorganizeLocalDefinitionsOfFunctions fun_defs ca
+		= (CollectedLocalDefs { loc_functions = { ir_from = ir_from, ir_to = ir_to }, loc_nodes = node_defs },
+			fun_defs ++ fun_defs_in_node_defs ++ collected_fun_defs, ca)
+
+	where
+		collect_functions_in_node_defs [ (node_def_type, bind) : node_defs ] ca
+			# (bind, fun_defs_in_bind, ca) = collectFunctions bind ca
+			  (node_defs, fun_defs_in_node_defs, ca) = collect_functions_in_node_defs node_defs ca
+			= ([(node_def_type, bind):node_defs], fun_defs_in_bind ++ fun_defs_in_node_defs, ca)
+		collect_functions_in_node_defs [] ca
+			= ([], [], ca)
+
+instance collectFunctions NodeDef a | collectFunctions a
+where
+	collectFunctions node_def=:{nd_dst,nd_alts,nd_locals} ca
+		# ((nd_dst,(nd_alts,nd_locals)), fun_defs, ca) = collectFunctions (nd_dst,(nd_alts,nd_locals)) ca
+		= ({ node_def & nd_dst = nd_dst, nd_alts = nd_alts, nd_locals = nd_locals }, fun_defs, ca)
+	
+/*
+instance collectFunctions a
+where
+	collectFunctions e ca
+		= (e, [], ca)
+*/
+
+instance collectFunctions Ident
+where
+	collectFunctions e ca
+		= (e, [], ca)
+
+NoCollectedLocalDefs :== CollectedLocalDefs { loc_functions = { ir_from = 0, ir_to = 0 }, loc_nodes = [] }
+
+transformLambda lam_ident args result
+	# lam_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = result, ewl_locals = NoCollectedLocalDefs },
+	  			  rhs_locals = NoCollectedLocalDefs }
+	  lam_body = [{pb_args = args, pb_rhs = lam_rhs }]
+	  fun_def = MakeNewFunction lam_ident (length args) lam_body FK_Function NoPrio No NoPos
+	= fun_def
+
+makeNilExpression ca=:{ca_predefs}
+	#! nil_id = ca_predefs.[PD_NilSymbol]
+	= (PE_List [PE_Ident nil_id], ca)
+makeConsExpression a1 a2 ca=:{ca_predefs}
+	#! cons_id = ca_predefs.[PD_ConsSymbol]
+	= (PE_List [PE_Ident cons_id, a1, a2], ca)
+
+transformComprehension gen_kind expr qualifiers ca
+	| gen_kind == cIsListGenerator
+		# (nil_expr, ca) = makeNilExpression ca
+		= build_list_comprehension expr nil_expr qualifiers ca
+	// gen_kind == cIsArrayGenerator
+		= abort "transformComprehension: cIsArrayGenerator NYI" ---> "transformComprehension: cIsArrayGenerator NYI" // PK
+where		
+		
+	build_list_comprehension expr nil_case [] ca
+		# (expr, fun_defs, ca) = collectFunctions expr ca
+		  (cons_expr, ca) = makeConsExpression expr nil_case ca
+		= (cons_expr, fun_defs, ca)
+	build_list_comprehension expr nil_case [qual: quals] ca
+		# fun_count = ca.ca_fun_count
+		  next_fun_count = inc fun_count
+		  ({qual_generators,qual_fun_id,qual_filter}, fun_defs, ca) = collectFunctions qual {ca & ca_fun_count = next_fun_count}
+		  (cons_patterns, nil_patterns, tail_args, args, arity, opt_index, sizes, selections, ca)
+		  		= build_patterns qual_generators ca 
+		  (selectId,ca) = get_predef_id PD_AndOp ca /* ????????? */
+		  (incId,ca) = get_predef_id PD_IncFun ca
+		  (smallerId,ca) = get_predef_id PD_SmallerFun ca
+		  (cons_patterns, nil_patterns, tail_args, args, arity)
+				= add_index cons_patterns nil_patterns tail_args args arity incId opt_index
+  		  tail_call = PE_List [PE_Ident qual_fun_id : tail_args]
+		  (compr, tail_fun_defs, ca) = build_list_comprehension expr tail_call quals ca
+		  (andId,ca) = get_predef_id PD_AndOp ca
+		  bound_checks = make_bounds_check opt_index smallerId andId sizes
+		  guard = combine_guards qual_filter bound_checks andId
+		  fun_def = build_generator_function guard qual_fun_id compr nil_case arity cons_patterns nil_patterns
+		  gen_appl =  PE_List [PE_Ident fun_def.fun_symb : args]
+		= (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = { ir_from = fun_count, ir_to = next_fun_count }, loc_nodes = [] }) gen_appl,
+				[fun_def : fun_defs ++ tail_fun_defs], ca)
+	where  
+		// +++ combine
+		build_generator_function No qual_fun_id expr nil_case arity cons_patterns nil_patterns
+			# cons_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = expr, ewl_locals = NoCollectedLocalDefs }, rhs_locals = NoCollectedLocalDefs }
+			  nil_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = nil_case, ewl_locals = NoCollectedLocalDefs }, rhs_locals = NoCollectedLocalDefs }
+			  body = [{pb_args = cons_patterns, pb_rhs = cons_rhs },{pb_args = nil_patterns, pb_rhs = nil_rhs }]
+			  fun_def = MakeNewFunction qual_fun_id arity body FK_Function NoPrio No NoPos
+			= fun_def
+		build_generator_function (Yes guard) qual_fun_id expr nil_case arity cons_patterns nil_patterns
+			# cons_rhs = { rhs_alts = GuardedAlts [{alt_nodes = [], alt_guard = guard, alt_expr = UnGuardedExpr { ewl_nodes = [], ewl_expr = expr, ewl_locals = NoCollectedLocalDefs}}] No, rhs_locals = NoCollectedLocalDefs }
+			  nil_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = nil_case, ewl_locals = NoCollectedLocalDefs }, rhs_locals = NoCollectedLocalDefs }
+			  body = [{pb_args = cons_patterns, pb_rhs = cons_rhs },{pb_args = nil_patterns, pb_rhs = nil_rhs }]
+			  fun_def = MakeNewFunction qual_fun_id arity body FK_Function NoPrio No NoPos
+			= fun_def
+
+	build_patterns [{gen_pattern,gen_expr,gen_var} : gens] ca
+		| gen_kind == cIsListGenerator
+			# tail_arg = PE_Ident gen_var
+			  (cons_pattern, ca) = makeConsExpression gen_pattern tail_arg ca
+			  nil_pattern = PE_WildCard
+			  (cons_patterns, nil_patterns, tail_args, gen_exprs, nr_of_args, opt_index, sizes, selections, ca)
+			  		= build_patterns gens ca
+			= ([cons_pattern : cons_patterns], [nil_pattern : nil_patterns], [tail_arg : tail_args], [gen_expr : gen_exprs],
+					inc nr_of_args, opt_index, sizes, selections, ca)
+		// gen_kind == cIsArrayGenerator
+			# array_arg = PE_Ident gen_var
+			  (cons_patterns, nil_patterns, tail_args, gen_exprs, nr_of_args, opt_index, sizes, selections, ca)
+			  		= build_patterns gens ca
+			  index_ident = get_index_ident opt_index gen_var
+			  selection = make_selection gen_pattern array index
+			= ([array_arg : cons_patterns], [array_arg : nil_patterns], [array_arg : tail_args], [gen_expr : gen_exprs],
+					inc nr_of_args, Yes index_ident, sizes, selections, ca)
+		where
+			get_index_ident No var
+				=	PE_Ident var
+			get_index_ident (Yes var) _
+				=	var
+	build_patterns [] ca
+		= ([], [], [], [], 0, No, [], [], ca)
+
+	add_index cons_patterns nil_patterns tail_args gen_exprs arity _ _
+		= (cons_patterns, nil_patterns, tail_args, gen_exprs, arity)
+	add_index cons_patterns nil_patterns tail_args gen_exprs arity incId (Yes index)
+		= ([index : cons_patterns], [PE_WildCard : nil_patterns], [next_index : tail_args], [PE_Basic (BVI "0") : gen_exprs], arity+1)
+		where
+			next_index
+				=	PE_List [PE_Ident incId, index]
+
+	make_selection pattern array index
+		=	PD_NodeDef (PE_List [Arity2TupleConsIndex, array, pattern]) (PE_List [selectId, array, index])
+
+	combine_guards No No _
+		=	No
+	combine_guards a No _
+		=	a
+	combine_guards No b _
+		=	b
+	combine_guards (Yes a) (Yes b) andId
+		=	Yes (PE_List [PE_Ident andId, a, b])
+
+	get_predef_id predef_index ca=:{ca_predefs}
+		#! symb = ca_predefs.[predef_index]
+		= (symb, ca)
+
+	make_bounds_check _ _ _ []
+		=	No
+	make_bounds_check (Yes index) andId smallerId [size : sizes]
+		= combine_guards (Yes check) (make_bounds_check (Yes index) andId smallerId sizes) andId
+		where
+			check
+				=	PE_List [PE_Ident smallerId, index, size]
+
+
+transformSequence :: Sequence -> PredefinedIdents -> ParsedExpr
+transformSequence (SQ_FromThen frm then)
+	=	predef PD_FromThen ## frm ## then
+transformSequence (SQ_FromThenTo frm then to)
+	=	predef PD_FromThenTo ## frm ## then ## to
+transformSequence (SQ_From frm)
+	=	predef PD_From ## frm
+transformSequence (SQ_FromTo frm to)
+	=	predef PD_FromTo ## frm ## to
+
+transformArrayUpdate :: ParsedExpr [ElemAssignment] PredefinedIdents -> ParsedExpr
+transformArrayUpdate expr updates pi
+	=	foldr (update (predef PD_ArrayUpdateFun)) expr updates
+	where
+		update updateIdent {bind_src=value, bind_dst=index} expr
+			=	(updateIdent ## expr ## index ## value) pi
+
+transformArrayDenot :: [ParsedExpr] PredefinedIdents -> ParsedExpr
+transformArrayDenot exprs pi
+	=	PE_Array
+			((predef PD__CreateArrayFun ## length exprs) pi)
+			[{bind_dst=toParsedExpr i pi, bind_src=expr} \\ expr <- exprs & i <- [0..]]
+			[]
+
+scanModules [] parsed_modules fun_count hash_table err_file searchPaths predefs files 
+	= (True, parsed_modules, [], fun_count, hash_table, err_file, predefs, files)
+scanModules [{import_module,import_symbols} : mods] parsed_modules fun_count hash_table err_file searchPaths predefs files 
+	# (found, mod) = try_to_find import_module parsed_modules
+	| found
+		= scanModules mods parsed_modules fun_count hash_table err_file searchPaths predefs files
+		# (succ, parsed_modules, local_fun_defs, fun_count, hash_table, err_file, predefs, files)
+				= parseAndScanDclModule import_module parsed_modules fun_count hash_table err_file searchPaths predefs files
+		  (mods_succ, parsed_modules, local_fun_defs_in_imports, fun_count, hash_table, err_file, predefs, files)
+		  		= scanModules mods parsed_modules fun_count hash_table err_file searchPaths predefs files
+		= (succ && mods_succ, parsed_modules, local_fun_defs ++ local_fun_defs_in_imports, fun_count, hash_table, err_file, predefs, files)
+where
+	try_to_find mod_id []
+		= (False, abort "module not found")
+	try_to_find mod_id [pmod : pmods]
+		| mod_id == pmod.mod_name
+			= (True, pmod)
+			= try_to_find mod_id pmods
+
+MakeEmptyModule name :==  { mod_name = name, mod_type = MK_None, mod_imports = [], mod_imported_objects = [],
+	mod_defs = {	def_types = [], def_constructors = [], def_selectors = [], def_classes = [], def_macros = { ir_from = 0, ir_to = 0 },
+					def_members = [], def_funtypes = [], def_instances = [] } }
+
+parseAndScanDclModule :: !Ident ![ScannedModule] !Int !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files
+	-> *(!Bool, ![ScannedModule], ![FunDef], !Int, !*HashTable, !*File, !*PredefinedSymbols, !*Files);
+parseAndScanDclModule dcl_module parsed_modules fun_count hash_table err_file searchPaths predefs files 
+	# (parse_ok, mod, hash_table, err_file, predefs, files) = wantModule cWantDclFile dcl_module hash_table err_file searchPaths predefs files
+	| parse_ok
+		= scan_dcl_module mod parsed_modules fun_count hash_table err_file searchPaths predefs files
+		= (False, [ MakeEmptyModule mod.mod_name : parsed_modules ], [], fun_count, hash_table, err_file, predefs, files)
+where
+	scan_dcl_module mod=:{mod_defs = pdefs} parsed_modules fun_count hash_table err_file searchPaths predefs files
+		# (predefIdents, predefs) = SelectPredefinedIdents predefs
+		# state = {ca_error = { pea_file = err_file, pea_ok = True }, ca_fun_count = 0, ca_predefs = predefIdents}
+		  (_, defs, imports, imported_objects, state) = reorganizeDefinitions False pdefs 0 0 0 state
+		  macro_count = length defs.def_macros + fun_count
+	  	  (macro_defs, local_fun_defs, {ca_fun_count=new_fun_count, ca_error={pea_file,pea_ok}, ca_predefs})
+	  	  	= reorganizeLocalDefinitionsOfFunctions defs.def_macros {state & ca_fun_count = macro_count}
+		  mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = { defs & def_macros = { ir_from = fun_count, ir_to = macro_count } }}
+		  (import_ok, parsed_modules, imported_local_fun_defs, fun_count, hash_table, err_file, predefs, files)
+		  		= scanModules imports [mod : parsed_modules] new_fun_count hash_table pea_file searchPaths predefs files
+		= (pea_ok && import_ok, parsed_modules, macro_defs ++ local_fun_defs ++ imported_local_fun_defs, fun_count, hash_table, err_file, predefs, files)
+
+scanModule :: !ParsedModule !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files
+	-> (!Bool, !ScannedModule, !Int, ![FunDef], !ScannedModule, !ScannedModule, ![ScannedModule], !*HashTable, !*File, !*PredefinedSymbols, !*Files)
+scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} hash_table err_file searchPaths predefs files
+	# (predefIdents, predefs) = SelectPredefinedIdents predefs
+	# state = {ca_fun_count = 0, ca_error = { pea_file = err_file, pea_ok = True }, ca_predefs = predefIdents}
+	  (fun_defs, defs, imports, imported_objects, ca) = reorganizeDefinitions True pdefs 0 0 0 state
+	  fun_count = length fun_defs
+	  macro_count = length defs.def_macros
+	  (fun_defs, local_defs, ca) = reorganizeLocalDefinitionsOfFunctions (fun_defs ++ defs.def_macros) {ca & ca_fun_count = fun_count + macro_count}
+	  (def_instances, local_defs_in_insts, {ca_fun_count=tot_fun_count, ca_error = {pea_file,pea_ok}, ca_predefs})
+	  		= reorganizeLocalDefinitionsOfInstances defs.def_instances ca
+	  (import_ok, parsed_modules, local_defs_in_dcl, tot_fun_count, hash_table, err_file, ca_predefs, files)
+	  		= scan_dcl_module mod_name mod_type tot_fun_count hash_table pea_file predefs files
+	  (import_ok, parsed_modules, local_defs_in_imports, tot_fun_count, hash_table, err_file, ca_predefs, files)
+	  		= scanModules imports parsed_modules tot_fun_count hash_table err_file searchPaths ca_predefs files
+	  mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = { defs & def_instances = def_instances,
+	  				def_macros = { ir_from = fun_count, ir_to = fun_count + macro_count } }}
+	  [dcl_mod : modules] = reverse parsed_modules
+	  all_local_defs = fun_defs ++ local_defs ++ local_defs_in_insts ++ local_defs_in_dcl ++ local_defs_in_imports
+	  (pre_def_mod, ca_predefs) = buildPredefinedModule ca_predefs
+	= (pea_ok && import_ok, mod, fun_count, all_local_defs, dcl_mod, pre_def_mod, modules, hash_table, err_file, ca_predefs, files)
+where
+	scan_dcl_module mod_name MK_Main fun_count hash_table err_file predefs files
+		= (True, [MakeEmptyModule mod_name ], [], fun_count, hash_table, err_file, predefs, files)
+	scan_dcl_module mod_name MK_None fun_count hash_table err_file predefs files
+		= (True, [MakeEmptyModule mod_name ], [], fun_count, hash_table, err_file, predefs , files)
+	scan_dcl_module mod_name kind fun_count hash_table err_file predefs files
+		= parseAndScanDclModule mod_name [] fun_count hash_table err_file searchPaths predefs files 
+		
+reorganizeLocalDefinitionsOfInstances [] ca
+	= ([], [], ca)
+reorganizeLocalDefinitionsOfInstances [inst=:{pi_members} : insts] ca
+	# (pi_members, local_defs, ca) = reorganizeLocalDefinitionsOfFunctions pi_members ca
+	  (insts, local_defs_in_insts, ca) = reorganizeLocalDefinitionsOfInstances insts ca
+	= ([{inst & pi_members = pi_members } : insts], local_defs ++ local_defs_in_insts, ca)
+
+reorganizeLocalDefinitionsOfFunction fun_def=:{fun_body = ParsedBody bodies} ca
+	# (bodies, rhs_fun_defs, ca) = collect_local_definitions_in_bodies bodies ca
+	= ({fun_def & fun_body = ParsedBody bodies}, rhs_fun_defs, ca)
+where	
+	collect_local_definitions_in_bodies [pb=:{pb_rhs} : bodies] ca
+		# (pb_rhs, rhs_fun_defs, ca) = collectFunctions pb_rhs ca
+		  (bodies, body_fun_defs, ca) = collect_local_definitions_in_bodies bodies ca
+		= ([ { pb & pb_rhs = pb_rhs } : bodies], rhs_fun_defs ++ body_fun_defs, ca)
+	collect_local_definitions_in_bodies [] ca
+		= ([], [], ca)
+
+reorganizeLocalDefinitionsOfFunctions [] ca
+	= ([], [], ca)
+reorganizeLocalDefinitionsOfFunctions [fun_def : fun_defs] ca
+	# (fun_def, rhs_fun_defs, ca) = reorganizeLocalDefinitionsOfFunction fun_def ca
+	  (fun_defs, rhss_fun_defs, ca) = reorganizeLocalDefinitionsOfFunctions fun_defs ca
+	= ([fun_def : fun_defs], rhs_fun_defs ++ rhss_fun_defs, ca) 
+
+
+MakeNewFunction name arity body kind prio opt_type pos
+	:== { fun_symb = name, fun_arity = arity, fun_priority = prio, fun_type = opt_type, fun_kind = kind,
+		  fun_body = ParsedBody body, fun_pos = pos, fun_lifted = 0, fun_index = NoIndex, fun_info = EmptyFunInfo }
+
+collectFunctionBodies :: !Ident !Int !Priority !FunKind ![ParsedDefinition] !*CollectAdmin
+	-> (![ParsedBody], !FunKind, ![ParsedDefinition], !*CollectAdmin)
+collectFunctionBodies fun_name fun_arity fun_prio fun_kind all_defs=:[PD_Function pos name is_infix args rhs new_fun_kind : defs] ca
+	| belongsToTypeSpec fun_name fun_prio name is_infix
+		# (new_fun_kind, ca) = combine_fun_kinds pos fun_kind new_fun_kind ca
+		  (bodies, new_fun_kind, rest_defs, ca) = collectFunctionBodies fun_name fun_arity fun_prio new_fun_kind defs ca
+		  act_arity	= length args
+		| fun_arity == act_arity
+			= ([{ pb_args = args, pb_rhs = rhs } : bodies ], new_fun_kind, rest_defs, ca)
+			= ([{ pb_args = args, pb_rhs = rhs } : bodies ], new_fun_kind, rest_defs, 
+			    postParseError pos	("This alternative has " + toString act_arity +
+			  						 (if (act_arity == 1)" argument instead of " " arguments instead of ") + toString fun_arity
+			  						) ca
+			  )
+		= ([], fun_kind, all_defs, ca)
+	where
+		combine_fun_kinds pos FK_Unknown fun_kind ca
+			= (fun_kind, ca)
+		combine_fun_kinds pos fun_kind new_fun_kind ca
+			| fun_kind == new_fun_kind
+				= (fun_kind, ca)
+				= (fun_kind, postParseError pos "illegal combination of function alternatives" ca)
+collectFunctionBodies fun_name fun_arity fun_prio fun_kind defs ca
+	= ([], fun_kind, defs, ca)
+
+reorganizeDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kind : defs] cons_count sel_count mem_count ca
+	# prio = if is_infix (Prio NoAssoc 9) NoPrio
+	  fun_arity = length args
+	  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
+	  (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca
+	  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies] fun_kind prio No pos
+	| fun_kind == FK_Macro
+		= (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros ]}, imports, imported_objects, ca)
+		= ([ fun : fun_defs ], c_defs, imports, imported_objects, ca)
+reorganizeDefinitions icl_module [PD_TypeSpec fun_pos fun_name prio No specials : defs] cons_count sel_count mem_count ca
+	= case defs of
+		[PD_Function pos name is_infix args rhs fun_kind : defs]
+			| fun_name <> name
+				-> reorganizeDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos ("function alternative for "+++fun_name.id_name+++" expected") ca)
+			| not (sameFixity prio is_infix)
+				-> reorganizeDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "infix of type specification and alternative should match" ca)
+			//	| belongsToTypeSpec fun_name prio name is_infix
+  				# fun_arity = length args
+				  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
+	  			  (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca
+				  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
+				| fun_kind == FK_Macro
+					-> (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros]}, imports, imported_objects, ca)
+					-> ([ fun : fun_defs ], c_defs, imports, imported_objects, ca)
+			//	-> reorganizeDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "function body expected (1)" ca)
+		_
+			-> reorganizeDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "function alternative expected (2)" ca)
+// ... PK
+reorganizeDefinitions icl_module [PD_TypeSpec pos name prio (Yes fun_type=:{st_arity}) specials : defs] cons_count sel_count mem_count ca
+	# (bodies, fun_kind, defs, ca) = collectFunctionBodies name st_arity prio FK_Unknown defs ca
+	  (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca
+	| isEmpty bodies
+		# fun_type = MakeNewFunctionType name st_arity prio fun_type pos specials nilPtr
+		  c_defs = { c_defs & def_funtypes = [ fun_type : c_defs.def_funtypes ]}
+		| icl_module
+			= (fun_defs, c_defs, imports, imported_objects, postParseError pos "function body expected" ca)
+			= (fun_defs, c_defs, imports, imported_objects, ca)
+		# fun = MakeNewFunction name fun_type.st_arity bodies fun_kind prio (Yes fun_type) pos
+		| icl_module
+			= ([fun : fun_defs], c_defs, imports, imported_objects, ca)		  
+			= ([fun : fun_defs], c_defs, imports, imported_objects, postParseError pos "function body not allowed in definition module" ca)		  
+reorganizeDefinitions icl_module [PD_Type type_def=:{td_rhs = ConsList cons_defs} : defs] cons_count sel_count mem_count ca
+	# (cons_symbs, cons_count) = determine_symbols_of_conses cons_defs cons_count
+	  (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca
+	  type_def = { type_def & td_rhs = AlgType 	cons_symbs }
+	  c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = cons_defs ++ c_defs.def_constructors }
+	= (fun_defs, c_defs, imports, imported_objects, ca)  
+where
+	determine_symbols_of_conses [{pc_cons_name,pc_cons_arity} : conses] next_cons_index
+		# cons = { ds_ident = pc_cons_name, ds_arity = pc_cons_arity, ds_index = next_cons_index }
+		  (conses, next_cons_index) = determine_symbols_of_conses conses (inc next_cons_index)
+		= ([cons : conses], next_cons_index)
+	determine_symbols_of_conses [] next_cons_index
+		= ([], next_cons_index)
+reorganizeDefinitions icl_module [PD_Type type_def=:{td_name, td_rhs = SelectorList rec_cons_id exivars sel_defs, td_pos } : defs] cons_count sel_count mem_count ca
+	# (sel_syms, new_count) = determine_symbols_of_selectors sel_defs sel_count
+	  (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs (inc cons_count) new_count mem_count ca
+	  cons_arity = new_count - sel_count
+	  cons_def = {	pc_cons_name = rec_cons_id, pc_cons_prio = NoPrio, pc_cons_arity = cons_arity, pc_cons_pos = td_pos,
+	  				pc_arg_types = [ ps_field_type \\ {ps_field_type} <- sel_defs ], pc_exi_vars = exivars }
+	  type_def = { type_def & td_rhs = RecordType {rt_constructor = { ds_ident = td_name, ds_arity = cons_arity, ds_index = cons_count },
+	  							rt_fields =  { sel \\ sel <- sel_syms }}}
+	  c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = [cons_def : c_defs.def_constructors],
+	  				def_selectors = sel_defs ++ c_defs.def_selectors }
+	= (fun_defs, c_defs, imports, imported_objects, ca)  
+where
+	determine_symbols_of_selectors [{ps_field_name,ps_field_var} : sels] next_selector_index
+		# field = { fs_name = ps_field_name, fs_var = ps_field_var, fs_index = next_selector_index }
+		  (fields, next_selector_index) = determine_symbols_of_selectors sels (inc next_selector_index)
+		= ([field : fields], next_selector_index)
+	determine_symbols_of_selectors [] next_selector_index
+		= ([], next_selector_index)
+
+reorganizeDefinitions icl_module [PD_Type type_def=:{td_rhs = TypeSpec type} : defs] cons_count sel_count mem_count ca
+	# (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca
+	  type_def = { type_def & td_rhs = SynType type }
+	  c_defs = { c_defs & def_types = [type_def : c_defs.def_types] }
+	= (fun_defs, c_defs, imports, imported_objects, ca)  
+reorganizeDefinitions icl_module [PD_Type type_def=:{td_rhs = EmptyRhs properties} : defs] cons_count sel_count mem_count ca
+	# (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca
+	  type_def = { type_def & td_rhs = AbstractType properties }
+	  c_defs = { c_defs & def_types = [type_def : c_defs.def_types] }
+	= (fun_defs, c_defs, imports, imported_objects, ca)  
+reorganizeDefinitions icl_module [PD_Class class_def=:{class_name,class_arity,class_args} members : defs] cons_count sel_count mem_count ca
+	# type_context = { tc_class = {glob_module = NoIndex, glob_object = {ds_ident = class_name, ds_arity = class_arity, ds_index = NoIndex }},
+					   tc_types = [ TV tv \\ tv <- class_args ], tc_var = nilPtr }
+	  (mem_defs, mem_macros, ca) = check_symbols_of_class_members members type_context ca
+	  (mem_symbs, mem_defs, class_size) = reorganize_member_defs mem_defs mem_count
+	  (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs  cons_count sel_count (mem_count + class_size) ca
+	  class_def = { class_def & class_members = { member \\ member <- mem_symbs }}
+	  c_defs = { c_defs & def_classes = [class_def : c_defs.def_classes], def_macros = mem_macros ++ c_defs.def_macros,
+	  			 def_members = mem_defs ++ c_defs.def_members }
+	= (fun_defs, c_defs, imports, imported_objects, ca)  
+where
+	
+	check_symbols_of_class_members :: ![ParsedDefinition] !TypeContext !*CollectAdmin -> (![MemberDef], ![FunDef], !*CollectAdmin)
+	check_symbols_of_class_members [PD_TypeSpec pos name prio opt_type=:(Yes type=:{st_context,st_arity}) specials : defs] type_context ca
+		# (bodies, fun_kind, defs, ca) = collectFunctionBodies name st_arity prio FK_Unknown defs ca
+		| isEmpty bodies
+			# mem_def = { me_symb = name, me_type = { type & st_context = [type_context : st_context ]}, me_pos = pos, me_priority = prio,
+							me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr }
+			  ( mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca
+			= ([mem_def : mem_defs], mem_macros, ca)
+			# macro = MakeNewFunction name st_arity bodies FK_Macro prio opt_type pos
+			  (mem_defs, mem_macros,ca) = check_symbols_of_class_members defs type_context ca
+			= (mem_defs, [macro : mem_macros], ca)
+	check_symbols_of_class_members [PD_TypeSpec fun_pos fun_name prio No specials : defs] type_context ca
+		= case defs of
+			[PD_Function pos name is_infix args rhs fun_kind : defs]
+				| belongsToTypeSpec fun_name prio name is_infix
+  					# fun_arity = length args
+  					  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
+		  			  (mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca
+					  macro = MakeNewFunction name fun_arity bodies FK_Macro prio No pos
+					-> (mem_defs, [macro : mem_macros], ca)
+					-> check_symbols_of_class_members defs type_context (postParseError fun_pos "macro body expected" ca)
+			_
+				-> check_symbols_of_class_members defs type_context (postParseError fun_pos "macro body expected" ca)
+	check_symbols_of_class_members [PD_Function fun_pos name is_infix args rhs fun_kind : defs] type_context ca
+		# prio = if is_infix (Prio NoAssoc 9) NoPrio
+		  fun_arity = length args
+		  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
+		  (mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca
+		  macro = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies] FK_Macro prio No fun_pos
+		= (mem_defs, [macro : mem_macros], ca)
+	check_symbols_of_class_members [] type_context ca
+		= ([], [], ca)
+	
+	reorganize_member_defs mem_defs first_mem_index
+		# mem_defs = sort mem_defs
+		= determine_indexes_of_class_members mem_defs first_mem_index 0
+		
+	determine_indexes_of_class_members [member=:{me_symb,me_type}:members] first_mem_index mem_offset
+		#! (member_symbols, member_defs, last_mem_offset) = determine_indexes_of_class_members members first_mem_index (inc mem_offset)
+		= ([{ds_ident = me_symb, ds_index = first_mem_index + mem_offset, ds_arity = me_type.st_arity } : member_symbols],
+			[ { member & me_offset = mem_offset } : member_defs], last_mem_offset)
+	determine_indexes_of_class_members [] first_mem_index last_mem_offset
+		= ([], [], last_mem_offset)
+
+	
+reorganizeDefinitions icl_module [PD_Instance class_instance=:{pi_members,pi_pos} : defs] cons_count sel_count mem_count ca
+	# (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca
+	  (mem_defs, ca) = collect_member_instances pi_members ca
+	| icl_module || isEmpty mem_defs
+		= (fun_defs, { c_defs & def_instances = [{class_instance & pi_members = mem_defs} : c_defs.def_instances] }, imports, imported_objects, ca)
+		= (fun_defs, { c_defs & def_instances = [{class_instance & pi_members = []} : c_defs.def_instances] }, imports, imported_objects,
+			postParseError pi_pos "instance specifications of members not allowed" ca)
+where	  
+	collect_member_instances [PD_Function pos name is_infix args rhs fun_kind : defs] ca
+		# fun_arity = length args
+		  prio = if is_infix (Prio NoAssoc 9) NoPrio
+		  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
+		  (fun_defs, ca) = collect_member_instances defs ca
+		  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
+		= ([ fun : fun_defs ], ca)
+	collect_member_instances [PD_TypeSpec fun_pos fun_name prio type specials : defs] ca
+		= case defs of
+			[PD_Function pos name is_infix args rhs fun_kind : defs]
+				| belongsToTypeSpec fun_name prio name is_infix
+  					# (fun_arity, ca) = determineArity args type pos ca
+  					  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
+		  			  (fun_defs, ca) = collect_member_instances defs ca
+					  fun = MakeNewFunction name fun_arity [ { pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio type pos
+					-> ([ fun : fun_defs ], ca)
+			_
+				-> collect_member_instances defs (postParseError fun_pos "function body expected" ca)
+	collect_member_instances [] ca
+	    = ([], ca)	
+reorganizeDefinitions icl_module [PD_Instances class_instances : defs] cons_count sel_count mem_count ca
+	= reorganizeDefinitions icl_module ([PD_Instance class_instance \\ class_instance <- class_instances] ++ defs) cons_count sel_count mem_count ca
+reorganizeDefinitions icl_module [PD_Import new_imports : defs] cons_count sel_count mem_count ca
+	# (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca
+	= (fun_defs, c_defs, new_imports ++ imports, imported_objects, ca)
+// RWS ...
+reorganizeDefinitions icl_module [PD_ImportedObjects new_imported_objects : defs] cons_count sel_count mem_count ca
+	# (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca
+	= (fun_defs, c_defs, imports, new_imported_objects ++ imported_objects, ca)
+// ... RWS
+reorganizeDefinitions icl_module [def:defs] _ _ _ ca
+	= abort ("reorganizeDefinitions does not match" ---> def)
+
+reorganizeDefinitions icl_module [] _ _ _ ca
+	= ([], { def_types = [], def_constructors = [], def_selectors = [], def_macros = [], def_classes = [], def_members = [],
+			def_instances = [], def_funtypes = [] }, [], [], ca)
+
+checkRhsOfNodeDef pos { rhs_alts = UnGuardedExpr {ewl_expr,ewl_nodes = [],ewl_locals = LocalParsedDefs []}, rhs_locals = LocalParsedDefs []} ca
+	= (ewl_expr, ca)
+checkRhsOfNodeDef pos rhs ca
+	= (PE_Empty, postParseError pos "illegal node definition" ca)
+
+reorganizeLocalDefinitions [PD_NodeDef pos pattern {rhs_alts,rhs_locals} : defs] ca
+	# (fun_defs, node_defs, ca) = reorganizeLocalDefinitions defs ca
+	= (fun_defs, [(No, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals }) : node_defs], ca)
+//	= (fun_defs, [(No, { bind_dst = pattern, bind_src = rhs_expr }) : node_defs], ca)
+reorganizeLocalDefinitions [PD_Function pos name is_infix args rhs fun_kind : defs] ca
+	# prio = if is_infix (Prio NoAssoc 9) NoPrio
+	  fun_arity = length args
+	  (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
+	  (fun_defs, node_defs, ca) = reorganizeLocalDefinitions defs ca
+	  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
+	= ([ fun : fun_defs ], node_defs, ca)
+reorganizeLocalDefinitions [PD_TypeSpec pos1 name1 prio type specials : defs] ca
+	= case defs of
+		[PD_Function pos name is_infix args rhs fun_kind : defs]
+			| belongsToTypeSpec name1 prio name is_infix
+				# (fun_arity, ca) = determineArity args type pos ca
+				# (bodies, fun_kind, defs, ca) = collectFunctionBodies name1 fun_arity prio fun_kind defs ca
+				  (fun_defs, node_defs, ca) = reorganizeLocalDefinitions defs ca
+				  fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio type pos
+				-> ([fun : fun_defs], node_defs, ca)
+				-> reorganizeLocalDefinitions defs (postParseError pos "function body expected" ca)
+		[PD_NodeDef pos pattern=:(PE_Ident id)  {rhs_alts,rhs_locals} : defs]
+			| belongsToTypeSpec name1 prio id False
+				# (fun_defs, node_defs, ca) = reorganizeLocalDefinitions defs ca
+//	 			  (rhs_expr, ca) = checkRhsOfNodeDef pos rhs ca
+				-> (fun_defs, [(type, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals }) : node_defs], ca)
+//				-> (fun_defs, [(type, { bind_dst = pattern, bind_src = rhs_expr }) : node_defs], ca)
+				-> reorganizeLocalDefinitions defs (postParseError pos "function body expected" ca)
+		_
+			-> reorganizeLocalDefinitions defs (postParseError pos1 "function body expected" ca)
+reorganizeLocalDefinitions [] ca
+	= ([], [], ca)
+
+
+belongsToTypeSpec name prio new_name is_infix :==
+	name == new_name && sameFixity prio is_infix
+
+determineArity args (Yes {st_arity}) pos ca
+	# arity = length args
+	| arity == st_arity
+		= (arity, ca)
+determineArity args No pos ca
+	= (length args, ca)
+	
+sameFixity (Prio _ _) is_infix = is_infix
+sameFixity NoPrio is_infix = not is_infix
+
+
+		  
diff --git a/frontend/predef.dcl b/frontend/predef.dcl
new file mode 100644
index 0000000..585a764
--- /dev/null
+++ b/frontend/predef.dcl
@@ -0,0 +1,90 @@
+definition module predef
+
+	
+import syntax, hashtable
+
+::	PredefinedSymbols	:== {# PredefinedSymbol}
+
+::	PredefinedSymbol =
+	{	pds_ident	:: !Ident
+	,	pds_module	:: !Index
+	,	pds_def		:: !Index
+	}
+
+/* identifiers not present the hastable */
+
+
+
+PD_PredefinedModule			:== 0
+
+PD_StringType				:== 1
+PD_ListType					:== 2
+PD_Arity2TupleType			:== 3
+PD_Arity32TupleType			:== 33
+
+PD_LazyArrayType			:== 34
+PD_StrictArrayType			:== 35
+PD_UnboxedArrayType			:== 36
+
+PD_ConsSymbol				:== 37
+PD_NilSymbol				:== 38
+PD_Arity2TupleSymbol		:== 39
+PD_Arity32TupleSymbol		:== 69
+
+PD_TypeVar_a0				:== 70
+PD_TypeVar_a31				:== 101
+
+PD_TypeCodeMember			:== 123
+
+/* identifiers present in the hastable */
+
+PD_StdArray					:== 102
+PD_StdEnum					:== 103
+PD_StdBool					:== 104
+
+PD_AndOp					:== 105
+PD_OrOp						:== 106
+
+
+/* Array functions */
+
+PD_ArrayClass				:== 107
+
+PD_CreateArrayFun			:== 108
+PD__CreateArrayFun			:== 109
+PD_ArraySelectFun			:== 110
+PD_UnqArraySelectFun		:== 111
+PD_ArrayUpdateFun			:== 112
+PD_ArrayReplaceFun			:== 113
+PD_ArraySizeFun				:== 114
+PD_UnqArraySizeFun			:== 115
+
+/* Enum/Comprehension functions */
+
+PD_SmallerFun				:== 116
+PD_IncFun					:== 117
+PD_From						:== 118
+PD_FromThen					:== 119
+PD_FromTo					:== 120
+PD_FromThenTo				:== 121
+
+/* Dynamics */
+
+PD_TypeCodeClass			:== 122
+
+PD_TypeObjectType			:== 124
+PD_TypeConsSymbol			:== 125
+PD_unify					:== 126
+PD_variablePlaceholder		:== 127
+PD_StdDynamics				:== 128
+PD_undo_indirections		:== 129
+
+PD_NrOfPredefSymbols		:== 130
+
+
+GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
+GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
+
+buildPredefinedSymbols :: !*HashTable -> (!.PredefinedSymbols,!*HashTable)
+
+buildPredefinedModule :: !*PredefinedSymbols -> (!ScannedModule, !.PredefinedSymbols)
diff --git a/frontend/predef.icl b/frontend/predef.icl
new file mode 100644
index 0000000..403233e
--- /dev/null
+++ b/frontend/predef.icl
@@ -0,0 +1,272 @@
+implementation module predef
+
+import syntax, hashtable
+
+::	PredefinedSymbols	:== {# PredefinedSymbol}
+
+::	PredefinedSymbol =
+	{	pds_ident	:: !Ident
+	,	pds_module	:: !Index
+	,	pds_def		:: !Index
+	}
+
+/* identifiers not present the hastable */
+
+
+PD_PredefinedModule			:== 0
+
+PD_StringType				:== 1
+PD_ListType					:== 2
+PD_Arity2TupleType			:== 3
+PD_Arity32TupleType			:== 33
+
+PD_LazyArrayType			:== 34
+PD_StrictArrayType			:== 35
+PD_UnboxedArrayType			:== 36
+
+PD_ConsSymbol				:== 37
+PD_NilSymbol				:== 38
+PD_Arity2TupleSymbol		:== 39
+PD_Arity32TupleSymbol		:== 69
+
+PD_TypeVar_a0				:== 70
+PD_TypeVar_a31				:== 101
+
+PD_TypeCodeMember			:== 123
+
+/* identifiers present in the hastable */
+
+PD_StdArray					:== 102
+PD_StdEnum					:== 103
+PD_StdBool					:== 104
+
+PD_AndOp					:== 105
+PD_OrOp						:== 106
+
+
+/* Array functions */
+
+PD_ArrayClass				:== 107
+
+PD_CreateArrayFun			:== 108
+PD__CreateArrayFun			:== 109
+PD_ArraySelectFun			:== 110
+PD_UnqArraySelectFun		:== 111
+PD_ArrayUpdateFun			:== 112
+PD_ArrayReplaceFun			:== 113
+PD_ArraySizeFun				:== 114
+PD_UnqArraySizeFun			:== 115
+
+/* Enum/Comprehension functions */
+
+PD_SmallerFun				:== 116
+PD_IncFun					:== 117
+PD_From						:== 118
+PD_FromThen					:== 119
+PD_FromTo					:== 120
+PD_FromThenTo				:== 121
+
+/* Dynamics */
+
+PD_TypeCodeClass			:== 122
+
+PD_TypeObjectType			:== 124
+PD_TypeConsSymbol			:== 125
+PD_unify					:== 126
+PD_variablePlaceholder		:== 127
+PD_StdDynamics				:== 128
+PD_undo_indirections		:== 129
+
+PD_NrOfPredefSymbols		:== 130
+
+
+(<<=) infixl
+(<<=) state val
+	:==	let (array, symbol_table) = state
+			(name, index) = val
+			(id_info, new_symbol_table) = newPtr EmptySymbolTableEntry symbol_table
+	  	in 	({ array & [index] = { pds_ident = { id_name = name, id_info = id_info }, pds_module = NoIndex, pds_def = NoIndex } }, new_symbol_table)
+
+(<<-) infixl
+(<<-) (array, hash_table) (name, table_kind, index)
+	# (id, hash_table) = putIdentInHashTable name table_kind hash_table
+	= ({ array & [index] = { pds_ident = id, pds_module = NoIndex, pds_def = NoIndex } }, hash_table)
+	
+GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
+GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
+
+buildPredefinedSymbols :: !*HashTable -> (!.PredefinedSymbols,!*HashTable)
+buildPredefinedSymbols hash_table=:{hte_symbol_heap}
+	# predef_symbol_table = createArray PD_NrOfPredefSymbols { pds_ident = { id_name = "", id_info = nilPtr }, pds_module = NoIndex, pds_def = NoIndex }
+	  (predef_symbol_table, hte_symbol_heap) = fill_table_without_hashing (predef_symbol_table, hte_symbol_heap)
+	= fill_table_with_hashing (predef_symbol_table, { hash_table & hte_symbol_heap = hte_symbol_heap })
+where	
+	fill_table_without_hashing tables
+		= build_variables 0 32 (build_tuples 2 32 tables)
+			<<= ("_predefined", PD_PredefinedModule)
+			<<= ("_string", PD_StringType)
+			<<= ("_list", PD_ListType) <<= ("_cons", PD_ConsSymbol) <<= ("_nil", PD_NilSymbol)
+			<<= ("_array", PD_LazyArrayType) <<= ("_!array", PD_StrictArrayType) <<= ("_#array", PD_UnboxedArrayType)
+			<<= ("_type_code", PD_TypeCodeMember)
+	where
+
+		build_tuples tup_arity max_arity tables
+			| tup_arity > max_arity
+				= tables
+				# tup_name = "_tuple" +++ toString tup_arity
+				= build_tuples (inc tup_arity) max_arity (tables <<= (tup_name, GetTupleTypeIndex tup_arity)
+						<<= (tup_name, GetTupleConsIndex tup_arity))
+
+		build_variables var_number max_arity tables
+			| var_number == max_arity
+				= tables
+				# var_name = "a" +++ toString var_number
+				= build_variables (inc var_number) max_arity (tables <<= (var_name, PD_TypeVar_a0 + var_number))
+
+	fill_table_with_hashing tables
+		= tables	<<- ("StdArray", IC_Module, PD_StdArray) <<- ("StdEnum", IC_Module, PD_StdEnum) <<- ("StdBool", IC_Module, PD_StdBool)
+					<<- ("&&", IC_Expression, PD_AndOp) <<- ("||", IC_Expression, PD_OrOp)
+					<<- ("Array", IC_Class, PD_ArrayClass)
+					<<- ("createArray", IC_Expression, PD_CreateArrayFun)
+					<<- ("_createArray", IC_Expression, PD__CreateArrayFun)
+					<<- ("select", IC_Expression, PD_ArraySelectFun)
+					<<- ("uselect", IC_Expression, PD_UnqArraySelectFun) <<- ("update", IC_Expression, PD_ArrayUpdateFun)
+					<<- ("replace", IC_Expression, PD_ArrayReplaceFun) <<- ("size", IC_Expression, PD_ArraySizeFun)
+					<<- ("usize", IC_Expression, PD_UnqArraySizeFun)
+					<<- ("_smaller", IC_Expression, PD_SmallerFun) <<- ("_inc", IC_Expression, PD_IncFun)
+					<<- ("_from", IC_Expression, PD_From) <<- ("_from_then", IC_Expression, PD_FromThen)
+					<<- ("_from_to", IC_Expression, PD_FromTo) <<- ("_from_then_to", IC_Expression, PD_FromThenTo)
+					
+					<<- ("TC", 					IC_Class, PD_TypeCodeClass)
+					<<- ("T_ypeObjectType",		IC_Type, PD_TypeObjectType)
+					<<- ("T_ypeConsSymbol",		IC_Expression, PD_TypeConsSymbol)
+					<<- ("P_laceholder",		IC_Expression, PD_variablePlaceholder)
+					<<- ("_unify",				IC_Expression, PD_unify)
+					<<- ("StdDynamics",			IC_Module, PD_StdDynamics)
+					<<- ("_undo_indirections",	IC_Expression, PD_undo_indirections)
+
+
+MakeTupleConsSymbIndex arity 	:== arity - 2 + cArity2TupleConsSymbIndex
+MakeTupleTypeSymbIndex arity 	:== arity - 2 + cArity2TupleTypeSymbIndex
+
+MakeNilExpression pre_def_symbols			:== PE_List [PE_Ident pre_def_symbols.[PD_NilSymbol]]
+MakeConsExpression a1 a2 pre_def_symbols	:== PE_List [PE_Ident pre_def_symbols.[PD_ConsSymbol], a1, a2]
+
+MaxTupleArity				:== 32
+
+cLazyArray			:== 0
+cStrictArray		:== 1
+cUnboxedArray		:== 2
+
+cConsSymbIndex				:== 0
+cNilSymbIndex				:== 1
+cArity2TupleConsSymbIndex	:== 2
+//Arity32TupleConsSymbIndex	:== 32
+
+cListTypeSymbIndex			:== 0
+cArity2TupleTypeSymbIndex	:== 1
+//Arity32TupleTypeSymbIndex	:== 31
+cLazyArraySymbIndex			:== 32
+cStrictArraySymbIndex		:== 33
+cUnboxedArraySymbIndex		:== 34
+
+cLastPredefinedConstructor	:== 32
+cLastPredefinedType			:== 34
+
+cTCClassSymbIndex			:== 0
+
+cTCMemberSymbIndex			:== 0
+
+cTCInstanceSymbIndex		:== 0
+
+
+buildPredefinedModule :: !*PredefinedSymbols -> (!ScannedModule, !.PredefinedSymbols)
+buildPredefinedModule pre_def_symbols 
+	# (type_var_id, pre_def_symbols)	= pre_def_symbols![PD_TypeVar_a0]
+	  (cons_id, pre_def_symbols)		= pre_def_symbols![PD_ConsSymbol]
+	  (nil_id, pre_def_symbols)			= pre_def_symbols![PD_NilSymbol]
+	  (string_id, pre_def_symbols)		= pre_def_symbols![PD_StringType]
+	  (list_id, pre_def_symbols)		= pre_def_symbols![PD_ListType]
+	  (unb_array_id, pre_def_symbols)	= pre_def_symbols![PD_UnboxedArrayType]
+	  (pre_mod_symb, pre_def_symbols)	= pre_def_symbols![PD_PredefinedModule]
+	  (cons_symb, pre_def_symbols)		= new_defined_symbol PD_ConsSymbol 2 cConsSymbIndex pre_def_symbols
+	  (nil_symb, pre_def_symbols)		= new_defined_symbol PD_NilSymbol 0 cNilSymbIndex pre_def_symbols
+	  pre_mod_id						= pre_mod_symb.pds_ident
+
+	  type_var						= MakeTypeVar type_var_id.pds_ident
+	  type_var_with_attr			= MakeAttributedType (TV type_var)
+	  list_type						= MakeAttributedType (TA (MakeNewTypeSymbIdent list_id.pds_ident 1) [type_var_with_attr])
+	  unb_arr_of_char_type			= MakeAttributedType (TA (MakeNewTypeSymbIdent unb_array_id.pds_ident 1) [MakeAttributedType (TB BT_Char)])
+
+	  (string_def, pre_def_symbols)	= make_type_def PD_StringType [] (SynType unb_arr_of_char_type) pre_def_symbols
+	  (list_def, pre_def_symbols)	= make_type_def PD_ListType [type_var] (AlgType [cons_symb,nil_symb]) pre_def_symbols
+	
+	  cons_def			= { pc_cons_name = cons_id.pds_ident, pc_cons_arity = 2, pc_arg_types = [type_var_with_attr, list_type],
+	  						pc_cons_prio =  NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
+	  nil_def			= { pc_cons_name = nil_id.pds_ident, pc_cons_arity = 0, pc_arg_types = [],
+	  						pc_cons_prio =  NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
+
+	  (array_def, pre_def_symbols)		= make_type_def PD_LazyArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
+	  (strict_def, pre_def_symbols)		= make_type_def PD_StrictArrayType [type_var] (AbstractType cIsHyperStrict) pre_def_symbols
+	  (unboxed_def, pre_def_symbols)	= make_type_def PD_UnboxedArrayType [type_var] (AbstractType cIsHyperStrict) pre_def_symbols
+
+	  (type_defs, cons_defs, pre_def_symbols)	= add_tuple_defs pre_mod_id MaxTupleArity [array_def,strict_def,unboxed_def] [] pre_def_symbols
+	  (class_def, member_def, pre_def_symbols) = make_TC_class_def pre_def_symbols
+	= ({ mod_name = pre_mod_id, mod_type = MK_System, mod_imports = [],  mod_imported_objects = [],
+		 mod_defs = {
+			def_types = [string_def, list_def : type_defs], def_constructors = [cons_def, nil_def : cons_defs], def_selectors = [], def_classes = [class_def],
+			def_macros = { ir_from = 0, ir_to = 0 }, def_members = [member_def], def_funtypes = [], def_instances = [] }}, pre_def_symbols)
+where
+	add_tuple_defs pre_mod_id tup_arity type_defs cons_defs pre_def_symbols
+		| tup_arity >= 2
+			# (type_vars, pre_def_symbols)		= make_type_vars tup_arity [] pre_def_symbols
+			  (tuple_id, pre_def_symbols)		= pre_def_symbols![GetTupleConsIndex tup_arity]
+			  tuple_cons_symb					= { ds_ident = tuple_id.pds_ident, ds_index = MakeTupleConsSymbIndex tup_arity, ds_arity = tup_arity }
+			  
+			  (tuple_type_def, pre_def_symbols)	= make_type_def (GetTupleTypeIndex tup_arity) type_vars (AlgType [tuple_cons_symb]) pre_def_symbols
+			  tuple_cons_def	= { pc_cons_name = tuple_id.pds_ident, pc_cons_arity = tup_arity, pc_cons_pos = PreDefPos pre_mod_id,
+			  						pc_arg_types = [ MakeAttributedType (TV tv) \\ tv <- type_vars], pc_cons_prio =  NoPrio, pc_exi_vars = []}
+			= add_tuple_defs pre_mod_id (dec tup_arity) [tuple_type_def : type_defs] [tuple_cons_def : cons_defs] pre_def_symbols
+			= (type_defs, cons_defs, pre_def_symbols)
+	where
+		make_type_vars nr_of_vars type_vars pre_def_symbols
+			| nr_of_vars == 0
+				= (type_vars, pre_def_symbols)
+				# nr_of_vars = dec nr_of_vars
+				#! var_id = pre_def_symbols.[PD_TypeVar_a0 + nr_of_vars]
+				= make_type_vars nr_of_vars [MakeTypeVar var_id.pds_ident : type_vars] pre_def_symbols
+
+	new_defined_symbol symbol_index arity ds_index pre_def_symbols
+		#! ds_ident = pre_def_symbols.[symbol_index]
+		= ({ ds_ident = ds_ident.pds_ident, ds_arity = 2, ds_index = ds_index }, pre_def_symbols)
+	
+	make_type_def type_cons_index type_vars type_rhs pre_def_symbols
+		#! type_ident = pre_def_symbols.[type_cons_index]
+		= (MakeTypeDef type_ident.pds_ident (map (\tv -> MakeAttributedTypeVar tv) type_vars) type_rhs TA_None [] NoPos, pre_def_symbols)
+	
+	make_TC_class_def pre_def_symbols
+		# (tc_class_name, pre_def_symbols)		= pre_def_symbols![PD_TypeCodeClass]
+		  (type_var_id, pre_def_symbols)		= pre_def_symbols![PD_TypeVar_a0]
+		  (tc_member_name, pre_def_symbols)		= pre_def_symbols![PD_TypeCodeMember]
+		
+		  class_var = MakeTypeVar type_var_id.pds_ident
+
+		  me_type = { st_vars = [], st_args = [], st_arity = 0,
+					  st_result = { at_attribute = TA_None, at_annotation = AN_None, at_type = TV class_var },
+					  st_context = [ {tc_class = {glob_module = NoIndex, glob_object = {ds_ident = tc_class_name.pds_ident, ds_arity = 1, ds_index = NoIndex }},
+					   				tc_types = [ TV class_var ], tc_var = nilPtr }],
+					  st_attr_vars = [], st_attr_env = [] }
+
+		  member_def = { me_symb = tc_member_name.pds_ident, me_type = me_type, me_pos = NoPos, me_priority = NoPrio,
+						 me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr }
+		
+		  class_def = { class_name = tc_class_name.pds_ident, class_arity = 1, class_args = [class_var], class_context = [],
+		  				class_members = {{ds_ident = tc_member_name.pds_ident, ds_index = cTCMemberSymbIndex, ds_arity = 0 }}, class_cons_vars = 0,
+						class_dictionary = { ds_ident = { tc_class_name.pds_ident & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_pos = NoPos }
+
+		= (class_def, member_def, pre_def_symbols)
+
+		
+		
+
+
diff --git a/frontend/refmark.dcl b/frontend/refmark.dcl
new file mode 100644
index 0000000..0b8a1a3
--- /dev/null
+++ b/frontend/refmark.dcl
@@ -0,0 +1,6 @@
+definition module refmark
+
+import syntax, checksupport, unitype
+
+makeSharedReferencesNonUnique :: ![Int] !u:{# FunDef} !*Coercions !w:{! Type} !{# CommonDefs } !*VarHeap !*ExpressionHeap !*ErrorAdmin
+	-> (!u:{# FunDef}, !*Coercions, !w:{! Type}, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
diff --git a/frontend/refmark.icl b/frontend/refmark.icl
new file mode 100644
index 0000000..9b54103
--- /dev/null
+++ b/frontend/refmark.icl
@@ -0,0 +1,591 @@
+implementation module refmark
+
+import StdEnv
+import syntax, Heap, typesupport, check, overloading, unitype, utilities, RWSDebug
+
+
+NotASelector :== -1
+
+class refMark expr ::  ![[FreeVar]] !Int !expr !*VarHeap -> *VarHeap
+
+
+instance refMark [a] | refMark a
+where
+	refMark free_vars sel list var_heap
+		= foldSt (refMark free_vars sel) list var_heap
+
+collectAllSelections [] cum_sels
+	= cum_sels
+collectAllSelections [{su_multiply,su_uniquely} : sels ] cum_sels
+	= collectAllSelections sels (su_uniquely ++ su_multiply ++ cum_sels)
+
+addSelection var_expr_ptr sel []
+	= [ { su_field = sel, su_multiply = [], su_uniquely = [var_expr_ptr]  } ]
+addSelection var_expr_ptr sel sels=:[selection=:{ su_field,su_multiply,su_uniquely } : selections]
+	| sel == su_field
+		= [ { selection & su_multiply = su_multiply ++ [var_expr_ptr : su_multiply], su_uniquely = [] } : selections ]
+	| sel < su_field
+		= [ { su_field = sel, su_multiply = [], su_uniquely = [var_expr_ptr]  } : sels ]
+		= [ selection : addSelection var_expr_ptr sel selections ]
+		
+saveOccurrences free_vars var_heap
+	= foldSt (foldSt save_occurrence) free_vars var_heap
+where
+	save_occurrence {fv_name,fv_info_ptr} var_heap
+		# (VI_Occurrence old_occ=:{occ_ref_count,occ_previous}, var_heap) = readPtr fv_info_ptr var_heap
+		= var_heap <:= (fv_info_ptr, VI_Occurrence {old_occ & occ_ref_count = RC_Unused, occ_previous = [occ_ref_count : occ_previous] } )
+	
+
+adjustRefCount sel RC_Unused var_expr_ptr
+	| sel == NotASelector
+		= RC_Used {rcu_multiply = [], rcu_selectively = [], rcu_uniquely = [var_expr_ptr] }
+		# sel_ref = { su_field = sel, su_multiply = [], su_uniquely = [var_expr_ptr] }
+		= RC_Used {rcu_multiply = [], rcu_selectively = [{ su_field = sel, su_multiply = [], su_uniquely = [var_expr_ptr] }], rcu_uniquely = [] }
+adjustRefCount sel (RC_Used {rcu_multiply,rcu_uniquely,rcu_selectively}) var_expr_ptr
+	| sel == NotASelector
+		# rcu_multiply = collectAllSelections rcu_selectively (rcu_uniquely ++ [var_expr_ptr : rcu_multiply])
+		= RC_Used {rcu_multiply = rcu_multiply, rcu_uniquely = [], rcu_selectively = [] }
+		# rcu_selectively = addSelection var_expr_ptr sel rcu_selectively
+		  rcu_multiply = rcu_uniquely ++ rcu_multiply
+		= RC_Used {rcu_multiply = rcu_multiply, rcu_uniquely = [], rcu_selectively = rcu_selectively }
+
+markPatternVariables sel used_pattern_vars var_heap
+	| sel == NotASelector
+		= foldSt mark_variable [ fv \\ (fv,_) <- used_pattern_vars ] var_heap
+		= mark_pattern_variable sel used_pattern_vars var_heap
+where
+	mark_pattern_variable sel [] var_heap
+		= var_heap
+	mark_pattern_variable sel [(fv, var_number) : used_pattern_vars ] var_heap
+		| sel == var_number
+			= mark_variable fv var_heap
+			= mark_pattern_variable sel used_pattern_vars var_heap
+		
+	mark_variable {fv_info_ptr} var_heap
+		# (VI_Occurrence old_occ=:{occ_ref_count}, var_heap) = readPtr fv_info_ptr var_heap
+		= case occ_ref_count of
+			RC_Unused
+				# occ_ref_count = RC_Used {rcu_multiply = [], rcu_selectively = [], rcu_uniquely = [nilPtr] }
+				-> var_heap <:= (fv_info_ptr, VI_Occurrence {old_occ & occ_ref_count = occ_ref_count } )
+			RC_Used {rcu_multiply,rcu_uniquely,rcu_selectively}
+				# occ_ref_count = RC_Used { rcu_multiply = collectAllSelections rcu_selectively (rcu_uniquely ++ rcu_multiply),
+							 rcu_selectively = [], rcu_uniquely = [] }
+				-> var_heap <:= (fv_info_ptr, VI_Occurrence {old_occ & occ_ref_count = occ_ref_count } )
+
+
+instance refMark BoundVar
+where
+	refMark free_vars sel {var_name,var_expr_ptr,var_info_ptr} var_heap
+		# (VI_Occurrence var_occ, var_heap) = readPtr var_info_ptr var_heap
+		  occ_ref_count = adjustRefCount sel var_occ.occ_ref_count var_expr_ptr
+		= case var_occ.occ_bind of
+			OB_OpenLet let_expr
+				# var_heap = var_heap <:= (var_info_ptr, VI_Occurrence { var_occ & occ_ref_count = occ_ref_count, occ_bind = OB_LockedLet let_expr })
+				-> refMark free_vars sel let_expr var_heap
+			OB_Pattern used_pattern_vars occ_bind
+				-> markPatternVariables sel used_pattern_vars (var_heap <:= (var_info_ptr, VI_Occurrence { var_occ & occ_ref_count = occ_ref_count }))
+			_
+				-> var_heap <:= (var_info_ptr, VI_Occurrence { var_occ & occ_ref_count = occ_ref_count })
+			
+instance refMark Expression
+where
+	refMark free_vars sel (Var var) var_heap
+		= refMark free_vars sel var var_heap
+	refMark free_vars sel (App {app_args}) var_heap
+		= refMark free_vars NotASelector app_args var_heap
+	refMark free_vars sel (fun @ args) var_heap
+		= refMark free_vars NotASelector args (refMark free_vars NotASelector fun var_heap)
+	refMark free_vars sel (Let {let_strict,let_binds,let_expr}) var_heap
+		# let_vars = [ bind_dst \\ {bind_dst} <- let_binds ]
+		  new_free_vars = [ let_vars : free_vars]
+		| let_strict
+			# (observing, var_heap) = binds_are_observing let_binds var_heap
+			| observing
+				# var_heap = saveOccurrences free_vars var_heap
+				  var_heap = refMark new_free_vars NotASelector let_binds var_heap
+				  var_heap = saveOccurrences new_free_vars var_heap
+				  var_heap = refMark new_free_vars sel let_expr var_heap
+				= let_combine free_vars var_heap
+				= refMark new_free_vars sel let_expr (refMark new_free_vars NotASelector let_binds var_heap)
+			# var_heap = foldSt bind_variable let_binds var_heap
+			= refMark new_free_vars sel let_expr var_heap
+
+		where
+		    binds_are_observing binds var_heap
+		    	= foldr bind_is_observing (True, var_heap) binds
+			where
+				bind_is_observing {bind_dst={fv_info_ptr}} (observe, var_heap) 
+					#! info = sreadPtr fv_info_ptr var_heap
+					# (VI_Occurrence {occ_observing}) = info
+					= (occ_observing && observe, var_heap)
+			
+			let_combine free_vars var_heap
+				= foldSt (foldSt let_combine_ref_count) free_vars var_heap
+			where
+				let_combine_ref_count {fv_info_ptr} var_heap
+					# (VI_Occurrence old_occ=:{occ_ref_count,occ_previous=[prev_ref_count, pre_pref_recount:occ_previouses]}, var_heap)
+							= readPtr fv_info_ptr var_heap
+					  comb_ref_count = parCombineRefCount (seqCombineRefCount prev_ref_count occ_ref_count) pre_pref_recount
+					= var_heap <:= (fv_info_ptr, VI_Occurrence { old_occ & occ_ref_count = comb_ref_count, occ_previous = occ_previouses })
+
+			bind_variable {bind_src,bind_dst={fv_info_ptr}} var_heap
+				# (VI_Occurrence occ, var_heap) = readPtr fv_info_ptr var_heap
+				= var_heap <:= (fv_info_ptr, VI_Occurrence { occ & occ_bind = OB_OpenLet bind_src })
+
+	refMark free_vars sel (Case {case_expr,case_guards,case_default}) var_heap
+		= refMarkOfCase free_vars sel case_expr case_guards case_default var_heap
+	refMark free_vars sel (Selection _ expr selectors) var_heap
+		= refMark free_vars (field_number selectors) expr var_heap
+	where
+		field_number [ RecordSelection _ field_nr : _ ]
+			= field_nr	
+		field_number _
+			= NotASelector	
+	refMark free_vars sel (Update expr1 selectors expr2) var_heap
+		= refMark free_vars NotASelector expr2 (refMark free_vars NotASelector expr1 var_heap)
+	refMark free_vars sel (RecordUpdate cons_symbol expression expressions) var_heap
+		= ref_mark_of_record_expression free_vars expression expressions var_heap
+	where
+		ref_mark_of_record_expression free_vars (Var var) fields var_heap
+			= ref_mark_of_fields 0 free_vars fields var var_heap
+		ref_mark_of_record_expression free_vars expression fields var_heap
+			# var_heap = refMark free_vars NotASelector expression var_heap
+			= foldSt (ref_mark_of_field free_vars) fields var_heap
+	
+		ref_mark_of_fields field_nr free_vars [] var var_heap
+			= var_heap
+		ref_mark_of_fields field_nr free_vars [{bind_src = EE} : fields] var var_heap
+			# var_heap = refMark free_vars field_nr var var_heap
+			= ref_mark_of_fields (inc field_nr) free_vars fields var var_heap
+		ref_mark_of_fields field_nr free_vars [{bind_src} : fields] var var_heap
+			# var_heap = refMark free_vars NotASelector bind_src var_heap
+			= ref_mark_of_fields (inc field_nr) free_vars fields var var_heap
+
+		ref_mark_of_field free_vars {bind_src} var_heap
+			= refMark free_vars NotASelector bind_src var_heap
+
+	refMark free_vars sel (TupleSelect _ arg_nr expr) var_heap
+		= refMark free_vars arg_nr expr var_heap
+	refMark free_vars sel (MatchExpr _ _ expr) var_heap
+		= refMark free_vars sel expr var_heap
+	refMark free_vars sel EE var_heap
+		= var_heap
+	refMark _ _ _ var_heap
+		= var_heap
+
+
+isUsed RC_Unused	= False				
+isUsed _			= True				
+
+instance refMark Bind a b | refMark a
+where
+	refMark free_vars sel {bind_src} var_heap
+		= refMark free_vars NotASelector bind_src var_heap
+
+instance refMark Selection
+where
+	refMark free_vars _ (ArraySelection _ _ index_expr) var_heap
+		= refMark free_vars NotASelector index_expr var_heap
+
+collectUsedFreeVariables free_vars var_heap
+	= foldSt collectUsedVariables free_vars ([], var_heap)
+
+collectUsedVariables free_vars (collected_vars, var_heap)
+	= foldSt collect_used_var free_vars (collected_vars, var_heap)
+where
+	collect_used_var fv=:{fv_info_ptr} (collected_vars, var_heap)
+		# (VI_Occurrence occ=:{occ_ref_count}, var_heap) = readPtr fv_info_ptr var_heap
+		| isUsed occ_ref_count
+			= ([ fv : collected_vars ], var_heap)
+			= (collected_vars, var_heap)
+
+collectPatternsVariables pattern_vars
+	= collect_used_vars pattern_vars 0 []
+where
+	collect_used_vars [ fv=:{fv_count} : pattern_vars ] arg_nr collected_vars
+		| fv_count > 0
+			= collect_used_vars pattern_vars (inc arg_nr) [ (fv, arg_nr) : collected_vars ]
+			= collect_used_vars pattern_vars (inc arg_nr) collected_vars
+	collect_used_vars [] arg_nr collected_vars
+		= collected_vars
+
+markVariables variables var_heap
+	= foldSt markVariable variables var_heap
+
+markVariable {fv_name,fv_info_ptr} var_heap
+	# (VI_Occurrence var_occ=:{occ_ref_count}, var_heap) = readPtr fv_info_ptr var_heap
+	= case occ_ref_count of
+		RC_Unused
+			-> var_heap
+		RC_Used {rcu_multiply,rcu_uniquely,rcu_selectively}
+			# rcu_multiply = collectAllSelections rcu_selectively (rcu_uniquely ++ rcu_multiply)
+			-> var_heap <:= (fv_info_ptr, VI_Occurrence { var_occ &
+							occ_ref_count = RC_Used {rcu_multiply = rcu_multiply, rcu_uniquely = [], rcu_selectively = [] }})
+//				---> ("markVariable", fv_name, rcu_multiply)
+
+collectLocalLetVars free_vars var_heap
+	= foldSt (foldSt collect_local_let_var) free_vars ([], var_heap)
+where
+	collect_local_let_var fv=:{fv_info_ptr} (collected_vars, var_heap)
+		# (VI_Occurrence var_occ, var_heap) = readPtr fv_info_ptr var_heap
+		= case var_occ.occ_bind of
+			OB_OpenLet _
+				-> ([ fv_info_ptr : collected_vars], var_heap)
+			_
+				-> (collected_vars, var_heap)
+		
+collectUsedLetVars local_vars (used_vars, var_heap)
+	= foldSt collect_local_let_var local_vars (used_vars, var_heap)
+where
+	collect_local_let_var fv_info_ptr (used_vars, var_heap)
+		# (VI_Occurrence var_occ, var_heap) = readPtr fv_info_ptr var_heap
+		= case var_occ.occ_bind of
+			OB_LockedLet let_expr
+				-> ([ fv_info_ptr : used_vars], var_heap <:= (fv_info_ptr, VI_Occurrence { var_occ & occ_bind = OB_OpenLet let_expr }))
+			_
+				-> (used_vars, var_heap)
+
+setUsedLetVars used_vars var_heap
+	= foldSt set_used_let_var used_vars var_heap
+where
+	set_used_let_var fv_info_ptr var_heap
+		# (VI_Occurrence var_occ, var_heap) = readPtr fv_info_ptr var_heap
+		= case var_occ.occ_bind of
+			OB_OpenLet let_expr
+				-> var_heap <:= (fv_info_ptr, VI_Occurrence { var_occ & occ_bind = OB_LockedLet let_expr })
+			_
+				-> var_heap
+
+refMarkOfCase free_vars sel expr (AlgebraicPatterns type patterns) defaul var_heap
+	= ref_mark_of_algebraic_case free_vars sel expr patterns defaul var_heap
+where
+	ref_mark_of_algebraic_case free_vars sel (Var {var_name,var_info_ptr,var_expr_ptr}) patterns defaul var_heap
+		# (VI_Occurrence var_occ=:{occ_bind,occ_ref_count}, var_heap) = readPtr var_info_ptr var_heap
+		= case occ_bind of
+			OB_Empty
+		  		# (local_lets, var_heap) = collectLocalLetVars free_vars var_heap
+				-> ref_mark_of_algebraic_case_with_variable_pattern var_info_ptr var_expr_ptr var_occ free_vars sel local_lets patterns defaul var_heap
+			_
+				-> ref_mark_of_algebraic_case_with_non_variable_pattern free_vars sel expr patterns defaul var_heap
+	ref_mark_of_algebraic_case free_vars sel expr patterns defaul var_heap
+		= ref_mark_of_algebraic_case_with_non_variable_pattern free_vars sel expr patterns defaul var_heap
+
+	ref_mark_of_algebraic_case_with_variable_pattern var_info_ptr var_expr_ptr {occ_ref_count = RC_Unused}
+					free_vars sel local_lets patterns case_default var_heap
+		# (_, pattern_depth, used_lets, var_heap)
+				= foldSt (ref_mark_of_algebraic_pattern free_vars sel (Yes var_info_ptr) local_lets) patterns (False, 0, [], var_heap)		
+		  var_heap = refMarkOfDefault False pattern_depth free_vars sel case_default used_lets var_heap
+		  (VI_Occurrence var_occ, var_heap) = readPtr var_info_ptr var_heap
+		= case var_occ.occ_ref_count of
+				RC_Unused
+					-> var_heap <:= (var_info_ptr, VI_Occurrence { var_occ &
+								occ_ref_count = RC_Used {	rcu_multiply = [], rcu_uniquely = [var_expr_ptr], rcu_selectively = [] }})
+				RC_Used rcu
+					-> var_heap <:= (var_info_ptr, VI_Occurrence { var_occ &
+								occ_ref_count = RC_Used { rcu & rcu_uniquely = [var_expr_ptr : rcu.rcu_uniquely] }})					
+	ref_mark_of_algebraic_case_with_variable_pattern var_info_ptr var_expr_ptr var_occ=:{occ_ref_count = RC_Used {rcu_multiply,rcu_uniquely,rcu_selectively}}
+					free_vars sel local_lets patterns case_default var_heap
+		# var_occ = { var_occ & occ_ref_count = RC_Used { rcu_multiply = collectAllSelections rcu_selectively (rcu_uniquely ++ [var_expr_ptr : rcu_multiply]),
+														  rcu_uniquely = [], rcu_selectively = [] }}
+		  var_heap = var_heap <:= (var_info_ptr, VI_Occurrence var_occ )
+		  (with_pattern_bindings, pattern_depth, used_lets, var_heap)
+			= foldSt (ref_mark_of_algebraic_pattern free_vars sel (Yes var_info_ptr) local_lets) patterns (False, 0, [], var_heap)		
+		= refMarkOfDefault False pattern_depth free_vars sel case_default used_lets var_heap
+
+	ref_mark_of_algebraic_case_with_non_variable_pattern free_vars sel expr patterns case_default var_heap
+		# var_heap = refMark free_vars NotASelector expr var_heap
+		  (local_lets, var_heap) = collectLocalLetVars free_vars var_heap
+		  (with_pattern_bindings, pattern_depth, used_lets, var_heap)
+			= foldSt (ref_mark_of_algebraic_pattern free_vars sel No local_lets) patterns (False, 0, [], var_heap)		
+		= refMarkOfDefault with_pattern_bindings pattern_depth free_vars sel case_default used_lets var_heap
+
+	ref_mark_of_algebraic_pattern free_vars sel opt_pattern_var local_lets {ap_vars,ap_expr}
+					(with_pattern_bindings, pattern_depth, used_lets, var_heap) 
+		# pattern_depth = inc pattern_depth
+		  var_heap = saveOccurrences free_vars var_heap
+		  used_pattern_vars = collectPatternsVariables ap_vars
+		  var_heap = bind_optional_pattern_variable opt_pattern_var used_pattern_vars var_heap
+		  var_heap = refMark [ [ fv \\ (fv,_) <- used_pattern_vars ] : free_vars ] sel ap_expr var_heap
+		  var_heap = restore_bindinding_of_pattern_variable opt_pattern_var used_pattern_vars var_heap
+		  (used_lets, var_heap) = collectUsedLetVars local_lets (used_lets, var_heap)
+		= (with_pattern_bindings || not (isEmpty used_pattern_vars), pattern_depth, used_lets, var_heap)
+	
+	bind_optional_pattern_variable _ [] var_heap
+		= var_heap
+	bind_optional_pattern_variable (Yes var_info_ptr) used_pattern_vars var_heap
+		# (VI_Occurrence var_occ=:{occ_bind}, var_heap) = readPtr var_info_ptr var_heap
+		= var_heap <:= (var_info_ptr, VI_Occurrence { var_occ & occ_bind = OB_Pattern used_pattern_vars occ_bind })
+	bind_optional_pattern_variable _ used_pattern_vars var_heap
+		= var_heap
+
+	restore_bindinding_of_pattern_variable _ [] var_heap
+		= var_heap
+	restore_bindinding_of_pattern_variable (Yes var_info_ptr) used_pattern_vars var_heap
+		# (VI_Occurrence var_occ=:{occ_bind=OB_Pattern used_pattern_vars occ_bind}, var_heap) = readPtr var_info_ptr var_heap
+		= var_heap <:= (var_info_ptr, VI_Occurrence { var_occ & occ_bind = occ_bind})
+	restore_bindinding_of_pattern_variable _ used_pattern_vars var_heap
+		= var_heap
+	
+refMarkOfCase free_vars sel expr (BasicPatterns type patterns) defaul var_heap
+	# var_heap = refMark free_vars NotASelector expr var_heap
+	  (local_lets, var_heap) = collectLocalLetVars free_vars var_heap
+	  (pattern_depth, used_lets, var_heap) = foldSt (ref_mark_of_basic_pattern free_vars sel local_lets) patterns (0, [], var_heap)
+	= refMarkOfDefault False pattern_depth free_vars sel defaul used_lets var_heap
+where
+	ref_mark_of_basic_pattern free_vars sel local_lets {bp_expr} (pattern_depth, used_lets, var_heap)
+		# pattern_depth = inc pattern_depth
+		  var_heap = saveOccurrences free_vars var_heap
+		  var_heap = refMark free_vars sel bp_expr var_heap
+		  (used_lets, var_heap) = collectUsedLetVars local_lets (used_lets, var_heap)
+		= (pattern_depth, used_lets, var_heap)
+
+refMarkOfCase free_vars sel expr (DynamicPatterns patterns) defaul var_heap
+	# var_heap = saveOccurrences free_vars var_heap
+	  var_heap = refMark free_vars NotASelector expr var_heap
+	  (used_free_vars, var_heap) = collectUsedFreeVariables free_vars var_heap
+	  var_heap = parCombine free_vars var_heap
+	  (local_lets, var_heap) = collectLocalLetVars free_vars var_heap
+	  (pattern_depth, used_lets, var_heap) = foldSt (ref_mark_of_dynamic_pattern free_vars sel local_lets) patterns (0, [], var_heap)
+	= refMarkOfDefault True pattern_depth free_vars sel defaul used_lets var_heap
+where
+	ref_mark_of_dynamic_pattern free_vars sel local_lets {dp_var, dp_rhs} (pattern_depth, used_lets, var_heap)
+		# pattern_depth = inc pattern_depth
+		  var_heap = saveOccurrences free_vars var_heap
+		  used_pattern_vars = collectPatternsVariables [dp_var]
+		  var_heap = refMark [ [ fv \\ (fv,_) <- used_pattern_vars ] : free_vars ] sel dp_rhs var_heap
+		  (used_lets, var_heap) = collectUsedLetVars local_lets (used_lets, var_heap)
+		= (pattern_depth, used_lets, var_heap)
+
+refMarkOfDefault do_par_combine pattern_depth free_vars sel (Yes expr) used_lets var_heap
+	# pattern_depth = inc pattern_depth
+	  var_heap = saveOccurrences free_vars var_heap
+	  var_heap = refMark free_vars sel expr var_heap
+	  var_heap = setUsedLetVars used_lets var_heap
+	= caseCombine do_par_combine free_vars var_heap pattern_depth
+refMarkOfDefault do_par_combine pattern_depth free_vars sel No used_lets var_heap
+	# var_heap = setUsedLetVars used_lets var_heap
+	= caseCombine do_par_combine free_vars var_heap pattern_depth
+
+parCombine free_vars var_heap
+	= foldSt (foldSt (par_combine)) free_vars var_heap
+where
+	par_combine {fv_info_ptr} var_heap
+		#! old_info = sreadPtr fv_info_ptr var_heap
+		# (VI_Occurrence old_occ=:{occ_ref_count,occ_previous=[prev_ref_count:prev_counts]}) = old_info
+		= var_heap <:= (fv_info_ptr, VI_Occurrence { old_occ &
+				occ_ref_count = parCombineRefCount occ_ref_count prev_ref_count , occ_previous = prev_counts })
+
+
+caseCombine do_par_combine free_vars var_heap depth
+	= foldSt (foldSt (case_combine do_par_combine depth)) free_vars var_heap
+where
+	case_combine do_par_combine depth {fv_name,fv_info_ptr} var_heap
+		#! old_info = sreadPtr fv_info_ptr var_heap
+		# (VI_Occurrence old_occ=:{occ_ref_count,occ_previous}) = old_info
+		  (occ_ref_count, occ_previous) = case_combine_ref_counts do_par_combine occ_ref_count occ_previous (dec depth)
+		= var_heap <:= (fv_info_ptr, VI_Occurrence { old_occ & occ_ref_count = occ_ref_count , occ_previous = occ_previous })
+//				---> ("case_combine", fv_name, occ_ref_count)
+
+	case_combine_ref_counts do_par_combine comb_ref_count [occ_ref_count:occ_previous] 0
+		| do_par_combine
+			# new_comb_ref_count = parCombineRefCount comb_ref_count occ_ref_count
+			= (new_comb_ref_count, occ_previous)
+	//				---> ("parCombineRefCount", comb_ref_count, occ_ref_count, new_comb_ref_count)
+			# new_comb_ref_count = seqCombineRefCount comb_ref_count occ_ref_count
+			= (new_comb_ref_count, occ_previous)
+	//				---> ("seqCombineRefCount", comb_ref_count, occ_ref_count, new_comb_ref_count)
+	case_combine_ref_counts do_par_combine comb_ref_count [occ_ref_count:occ_previous] depth
+		# new_comb_ref_count = case_combine_ref_count comb_ref_count occ_ref_count
+		= case_combine_ref_counts do_par_combine new_comb_ref_count occ_previous (dec depth)
+//				---> ("case_combine_ref_count", comb_ref_count, occ_ref_count, new_comb_ref_count)
+
+	case_combine_ref_count RC_Unused ref_count
+		= ref_count
+	case_combine_ref_count ref_count RC_Unused
+		= ref_count
+	case_combine_ref_count (RC_Used {rcu_multiply,rcu_selectively,rcu_uniquely}) (RC_Used ref_count2)
+		= RC_Used { rcu_uniquely = rcu_uniquely ++ ref_count2.rcu_uniquely, rcu_multiply = rcu_multiply ++ ref_count2.rcu_multiply,
+					rcu_selectively = case_combine_of_selections rcu_selectively ref_count2.rcu_selectively }
+	where
+		case_combine_of_selections [] sels
+			= sels
+		case_combine_of_selections sels []
+			= sels
+		case_combine_of_selections sl1=:[sel1=:{ su_field, su_multiply, su_uniquely } : sels1] sl2=:[sel2 : sels2]
+			| su_field == sel2.su_field
+				# sel1 = { sel1 & su_multiply = sel2.su_multiply ++ su_multiply, su_uniquely =  sel2.su_uniquely ++ su_uniquely }
+				= [ sel1 : case_combine_of_selections sels1 sels2 ]
+			| su_field < sel2.su_field
+				= [sel1 : case_combine_of_selections sels1 sl2 ]
+				= [sel2 : case_combine_of_selections sl1 sels2 ]
+
+parCombineRefCount RC_Unused ref_count
+	= ref_count
+parCombineRefCount ref_count RC_Unused
+	= ref_count
+parCombineRefCount (RC_Used {rcu_multiply,rcu_selectively,rcu_uniquely}) (RC_Used ref_count2)
+	# rcu_multiply = ref_count2.rcu_uniquely ++ ref_count2.rcu_multiply ++ rcu_uniquely ++ rcu_multiply
+	| isEmpty rcu_multiply
+		=  RC_Used { rcu_multiply = [], rcu_uniquely = [], rcu_selectively = par_combine_selections rcu_selectively ref_count2.rcu_selectively }
+		# rcu_multiply = collectAllSelections ref_count2.rcu_selectively (collectAllSelections rcu_selectively rcu_multiply)
+		= RC_Used { rcu_multiply = rcu_multiply, rcu_uniquely = [], rcu_selectively = [] }
+where	
+	par_combine_selections [] sels
+		= sels
+	par_combine_selections sels []
+		= sels
+	par_combine_selections sl1=:[sel1=:{ su_field, su_multiply, su_uniquely } : sels1] sl2=:[sel2 : sels2]
+		| su_field == sel2.su_field
+			# sel1 = { sel1 & su_multiply = sel2.su_multiply ++ su_multiply ++ sel2.su_uniquely ++ su_uniquely, su_uniquely = [] }
+			= [ sel1 : par_combine_selections sels1 sels2 ]
+		| su_field < sel2.su_field
+			= [sel1 : par_combine_selections sels1 sl2 ]
+			= [sel2 : par_combine_selections sl1 sels2 ]
+
+seqCombineRefCount RC_Unused ref_count
+	= ref_count
+seqCombineRefCount ref_count RC_Unused
+	= ref_count
+seqCombineRefCount (RC_Used sec_ref) (RC_Used prim_ref)
+	# rcu_multiply = prim_ref.rcu_uniquely ++ prim_ref.rcu_multiply ++ sec_ref.rcu_multiply
+	| isEmpty rcu_multiply
+		| isEmpty sec_ref.rcu_uniquely /* so sec_ref contains selections only */
+			# rcu_selectively = seq_combine_selections sec_ref.rcu_selectively prim_ref.rcu_selectively /* rcu_selectively can't be empty */
+			= RC_Used { rcu_uniquely = [], rcu_multiply = [], rcu_selectively = rcu_selectively }
+			# prim_selections = make_primary_selections_on_unique prim_ref.rcu_selectively
+			  rcu_selectively = seq_combine_selections sec_ref.rcu_selectively prim_selections
+			= RC_Used { sec_ref & rcu_selectively = rcu_selectively }
+		= RC_Used { sec_ref & rcu_multiply = collectAllSelections prim_ref.rcu_selectively rcu_multiply }
+	where	
+		seq_combine_selections [] sels
+			= sels
+		seq_combine_selections sels []
+			= sels
+		seq_combine_selections sl1=:[sel1=:{ su_field, su_multiply, su_uniquely } : sels1] sl2=:[sel2 : sels2]
+			| su_field == sel2.su_field
+				# sel1 = { sel1 & su_multiply = sel2.su_multiply ++ sel2.su_uniquely ++ su_multiply }
+				= [ sel1 : seq_combine_selections sels1 sels2 ]
+			| su_field < sel2.su_field
+				= [sel1 : seq_combine_selections sels1 sl2 ]
+				= [sel2 : seq_combine_selections sl1 sels2 ]
+
+		make_primary_selections_on_unique [sel=:{su_multiply, su_uniquely } : sels]
+			= [ { sel & su_multiply = su_uniquely ++ su_multiply, su_uniquely = [] } : make_primary_selections_on_unique sels ]
+		make_primary_selections_on_unique []
+			= []
+
+makeSharedReferencesNonUnique :: ![Int] !u:{# FunDef} !*Coercions !w:{! Type} !{# CommonDefs } !*VarHeap !*ExpressionHeap !*ErrorAdmin
+	-> (!u:{# FunDef}, !*Coercions, !w:{! Type}, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin)
+makeSharedReferencesNonUnique [] fun_defs coercion_env subst defs var_heap expr_heap  error
+	= (fun_defs, coercion_env, subst, var_heap, expr_heap, error)
+makeSharedReferencesNonUnique [fun : funs] fun_defs coercion_env subst defs var_heap expr_heap error
+	#! fun_def = fun_defs.[fun] 
+	# (coercion_env, subst, var_heap, expr_heap, error)
+		= make_shared_references_of_funcion_non_unique fun_def coercion_env subst defs var_heap expr_heap error
+	= makeSharedReferencesNonUnique funs fun_defs coercion_env subst defs var_heap expr_heap error
+where
+	make_shared_references_of_funcion_non_unique {fun_symb, fun_pos, fun_body = TransformedBody {tb_args,tb_rhs},fun_info={fi_local_vars}}
+			coercion_env subst defs var_heap expr_heap error
+	# variables = tb_args ++ fi_local_vars
+	  (subst, var_heap, expr_heap) = clear_occurrences variables subst defs var_heap expr_heap
+	  var_heap = refMark [tb_args] NotASelector tb_rhs var_heap
+	  position = newPosition fun_symb fun_pos
+	  (coercion_env, var_heap, expr_heap, error) = make_shared_vars_non_unique variables coercion_env var_heap expr_heap
+	  		(setErrorAdmin position error)
+	= (coercion_env, subst, var_heap, expr_heap, error)
+	
+	where
+		clear_occurrences vars subst defs var_heap expr_heap
+			= foldSt (initial_occurrence defs) vars (subst, var_heap, expr_heap)
+		where
+			initial_occurrence defs {fv_name,fv_info_ptr} (subst, var_heap, expr_heap) 
+				# (VI_Type {at_type,at_attribute}, var_heap) = readPtr fv_info_ptr var_heap
+				= case at_type of
+					TempV tv_number
+						#! is_oberving = hasObservingType subst.[tv_number] defs
+						-> (subst, var_heap <:= (fv_info_ptr,
+								VI_Occurrence { occ_ref_count = RC_Unused, occ_previous = [],
+									occ_observing = is_oberving, occ_bind = OB_Empty }), expr_heap)
+					_
+						-> (subst, var_heap <:= (fv_info_ptr,
+								VI_Occurrence { occ_ref_count = RC_Unused, occ_previous = [],
+									occ_observing = False,  occ_bind = OB_Empty }), expr_heap)
+					
+
+		make_shared_vars_non_unique vars coercion_env var_heap expr_heap error
+			= foldl make_shared_var_non_unique (coercion_env, var_heap, expr_heap, error) vars
+
+		make_shared_var_non_unique (coercion_env, var_heap, expr_heap, error)  fv=:{fv_name,fv_info_ptr}
+			#! var_info = sreadPtr fv_info_ptr var_heap
+			# (VI_Occurrence occ) = var_info
+			= case occ.occ_ref_count of
+				RC_Used {rcu_multiply,rcu_selectively}
+					# (coercion_env, expr_heap, error) = make_shared_occurrences_non_unique fv rcu_multiply (coercion_env, expr_heap, error)
+//					  (coercion_env, expr_heap, error) = foldSt (make_selection_non_unique fv) rcu_selectively (coercion_env, expr_heap, error)  
+					-> (coercion_env, var_heap, expr_heap, error)
+				_
+					-> (coercion_env, var_heap, expr_heap, error)
+
+		make_shared_occurrences_non_unique fv multiply (coercion_env, expr_heap, error)
+			= foldSt (make_shared_occurrence_non_unique fv) multiply (coercion_env, expr_heap, error) 
+		
+		make_shared_occurrence_non_unique free_var var_expr_ptr (coercion_env, expr_heap, error) 
+			| isNilPtr var_expr_ptr
+				= (coercion_env, expr_heap, error)
+				#! expr_info = sreadPtr var_expr_ptr expr_heap
+				# (EI_Attribute sa_attr_nr) = expr_info
+				# (succ, coercion_env) = tryToMakeNonUnique sa_attr_nr coercion_env
+				| succ
+//						 ---> ("make_shared_occurrence_non_unique", free_var)
+					= (coercion_env, expr_heap, error)
+					= (coercion_env, expr_heap, uniquenessError { cp_expression = FreeVar free_var} " demanded attribute cannot be offered by shared object" error)
+
+		make_selection_non_unique fv {su_multiply} cee
+			= make_shared_occurrences_non_unique fv su_multiply cee
+
+hasObservingType TE defs
+	= True
+hasObservingType (TB basic_type) defs
+	= True
+hasObservingType (TempV var_number) defs 
+	= True
+hasObservingType (TA {type_index = {glob_object,glob_module}} type_args) defs
+	# {td_properties} = defs.[glob_module].com_type_defs.[glob_object]
+	= True
+//	= foldSt (\ {at_type} ok -> ok && hasObservingType at_type defs) type_args (td_properties bitand cIsHyperStrict <> 0)
+hasObservingType type defs
+	= False
+
+					
+instance <<< ReferenceCount
+where
+	(<<<) file RC_Unused = file
+	(<<<) file (RC_Used {rcu_multiply,rcu_uniquely,rcu_selectively}) = file <<< '\n' <<< "M:" <<< rcu_multiply <<< " U:" <<< rcu_uniquely <<< " S:" <<< rcu_selectively
+
+instance <<< SelectiveUse
+where
+	(<<<) file {su_field,su_multiply,su_uniquely} = file <<< su_field <<< " M:" <<< su_multiply <<< " U:" <<< su_uniquely
+
+
+
+instance <<< Ptr v
+where
+	(<<<) file ptr = file <<< '[' <<< ptrToInt ptr <<< ']'
+
+
+instance <<< FreeVar
+where
+	(<<<) file {fv_name,fv_info_ptr} = file <<< fv_name <<< fv_info_ptr
+
+
+import Debug
+
+show
+	=	debugShowWithOptions [DebugMaxChars 80, DebugMaxDepth 5]
+
+instance <<< VarInfo
+where
+	(<<<) file vi
+		 = file <<< show vi
+
+
diff --git a/frontend/scanner.dcl b/frontend/scanner.dcl
new file mode 100644
index 0000000..79aec04
--- /dev/null
+++ b/frontend/scanner.dcl
@@ -0,0 +1,155 @@
+definition module scanner
+
+import StdEnv, general
+
+::	SearchPaths	:== [String]
+
+::	* ScanState
+
+::	*Input
+
+::	* InputStream
+
+::	LongToken
+
+::	Buffer x
+
+::	FilePosition = {fp_line :: !Int, fp_col :: !Int}
+
+instance <<< FilePosition
+
+::	Token
+	= 	IdentToken !.String		//		an identifier
+	|	IntToken !.String		//		an integer
+	|	RealToken !.String		//		a real
+	|	StringToken !.String	//		a string
+	|	CharToken !.String		//		a character
+	|	CharListToken !.String	//		a character list '{char}*'
+	|	BoolToken !Bool			//		a boolean
+	|	OpenToken				//		(
+	|	CloseToken				//		)
+	|	CurlyOpenToken			//		{
+	|	CurlyCloseToken			//		}
+	|	SquareOpenToken			//		[
+	|	SquareCloseToken		//		]
+
+	|	DotToken				//		.
+	|	SemicolonToken			//		;
+	|	ColonToken				//		:
+	|	DoubleColonToken		//		::
+	|	CommaToken				//		,
+	|	ExclamationToken		//		!
+	|	BarToken				//		|
+	|	ArrowToken				//		->
+	|	DoubleArrowToken		//		=>
+	|	EqualToken				//		=
+	|	DefinesColonToken		//		=:
+	|	ColonDefinesToken		//		:==
+	|	WildCardToken			//		_
+	|	BackSlashToken			//		\
+	|	DoubleBackSlashToken	//		\\
+	|	LeftArrowToken			//		<-
+	|	LeftArrowColonToken		//		<-:
+	|	DotDotToken				//		..
+	|	AndToken				//		&
+	|	HashToken				//		#
+	|	AsteriskToken			//		*
+	|	LessThanOrEqualToken	//		<=
+
+	|	ModuleToken				//		module
+	|	ImpModuleToken			//		implementation
+	|	DefModuleToken			//		definition
+	|	SysModuleToken			//		system
+
+	|	ImportToken				//		import
+	|	FromToken				//		from
+	|	SpecialToken			//		special
+
+	|	IntTypeToken			//		Int
+	|	CharTypeToken			//		Char
+	|	RealTypeToken			//		Real
+	|	BoolTypeToken			//		Bool
+	|	StringTypeToken			//		String
+	|	FileTypeToken			//		File
+	|	WorldTypeToken			//		World
+	|	VoidTypeToken			//		Void
+	|	LeftAssocToken			//		left
+	|	RightAssocToken			//		right
+	|	ClassToken				//		class
+	|	InstanceToken			//		instance
+	|	OtherwiseToken			//		otherwise
+
+	|	IfToken					//		if
+	|	WhereToken				//		where
+	|	WithToken				//		with
+	|	CaseToken				//		case
+	|	OfToken					//		of
+	|	LetToken Bool			//		let!, let
+	|	SeqLetToken Bool		//		Let!, Let
+	|	InToken					//		in
+	
+	|	DynamicToken			//		dynamic
+	|	DynamicTypeToken		//		Dynamic
+
+	
+	|	PriorityToken Priority	//		infixX N
+
+	|	CodeToken				//		code
+	|	InlineToken				//		inline
+	|	CodeBlockToken [String]	//		{...}
+
+	|	NewDefinitionToken		//		generated automatically
+	|	EndGroupToken			//		generated automatically
+	|	EndOfFileToken			//		end of file
+	|	ErrorToken String		//		if an error occured
+	
+:: Context
+	=	GeneralContext
+	|	TypeContext
+	|	FunctionContext
+	|	CodeContext
+
+::	Assoc	= LeftAssoc | RightAssoc | NoAssoc
+
+::	Priority = Prio Assoc Int | NoPrio
+    
+class getFilename state :: !*state -> (!String,!*state)
+instance getFilename ScanState
+
+class tokenBack state :: !*state -> !*state
+instance tokenBack ScanState
+
+class nextToken state :: !Context !*state -> (!Token, !*state)
+instance nextToken ScanState
+
+class currentToken state :: !*state -> (!Token, !*state)
+instance currentToken ScanState
+
+class insertToken state :: !Token !Context !*state -> *state
+instance insertToken ScanState
+
+class replaceToken state :: !Token !*state -> *state
+instance replaceToken ScanState
+
+class getPosition state :: !*state -> (!FilePosition,!*state)  // Position of current Token (or Char)
+instance getPosition ScanState
+
+openScanner :: !String !SearchPaths !*Files -> (!Optional ScanState, !*Files)
+closeScanner :: !ScanState !*Files -> *Files
+
+setUseLayout :: !Bool !ScanState -> ScanState
+UseLayout :: !ScanState -> (!Bool, !ScanState)
+dropOffsidePosition :: !ScanState -> ScanState
+
+isLhsStartToken :: ! Token -> Bool
+isOffsideToken :: ! Token -> Bool
+isEndGroupToken :: ! Token -> Bool
+
+instance == Token
+
+instance <<< Token
+
+instance toString Token, Priority
+
+instance < Priority
+
diff --git a/frontend/scanner.icl b/frontend/scanner.icl
new file mode 100644
index 0000000..89e34da
--- /dev/null
+++ b/frontend/scanner.icl
@@ -0,0 +1,1518 @@
+implementation module scanner
+
+import	StdEnv, compare_constructor, StdCompare, general
+
+from utilities import revCharListToString, isSpecialChar
+
+/*
+Known bug:
+functions names starting with '->' require a ';' after the type. Solutions:
+1) Make '->' an ordinary token. This implies that we have to write 'a-> .b' instead 
+   of 'a->.b'.
+2) re-scan token in new context. Requires substantial changes.
+3) Determine offsides before token is generated. Tricky since we do not know the
+   actual context of the new token or/and have to take care of generating the right
+   amount of offsides. 
+*/
+::	SearchPaths	:== [String]
+
+::	* ScanState =
+	{	ss_input		::	ScanInput
+	,	ss_offsides		::	! [(Int, Bool) ]	// (column, defines newDefinition)
+	,	ss_useLayout	::	! Bool
+	,	ss_tokenBuffer	::	! Buffer LongToken
+	}
+
+::	* ScanInput
+	=	Input			Input
+	|	PushedToken		LongToken ScanInput
+
+::	* Input =
+	{	inp_stream		::	! InputStream
+	,	inp_filename	::	String
+	,	inp_pos			::	! FilePosition
+	,	inp_tabsize		::	! Int
+	,	inp_charBuffer	::	! Buffer (Char,FilePosition)
+	//,	inp_curToken	::	! [ Char ]
+	}
+
+::	* InputStream
+	=	InFile			! * File
+	|	InLOC			! [Char]
+	|	OldChar			! Char ! FilePosition ! InputStream
+	|	OldChars		! [Char] ! InputStream
+	|	OldToken		! LongToken	! InputStream
+
+::	FilePosition =
+	{	fp_line			::	! Int
+	,	fp_col			::	! Int
+	}
+
+::	LongToken =
+	{	lt_position		::	! FilePosition	// Start position of this token
+	,	lt_token		::	! Token			// The token itself
+//	,	lt_chars		::	! [Char]		// The chars in this token
+//	,	lt_context		::	! Context		// The context of the scanning of this token
+	}
+
+::	Buffer x
+	=	Buffer0
+	|	Buffer1 x
+	|	Buffer2 x x
+	|	Buffer3 x x x // buffer size is 3.
+
+::	Token
+	= 	IdentToken ! .String	//		an identifier
+	|	IntToken !.String		//		an integer
+	|	RealToken !.String		//		a real
+	|	StringToken !.String	//		a string
+	|	CharToken !.String		//		a character
+	|	CharListToken !.String	//		a character list '{char}*'
+	|	BoolToken !Bool			//		a boolean
+	|	OpenToken				//		(
+	|	CloseToken				//		)
+	|	CurlyOpenToken			//		{
+	|	CurlyCloseToken			//		}
+	|	SquareOpenToken			//		[
+	|	SquareCloseToken		//		]
+
+	|	DotToken				//		.
+	|	SemicolonToken			//		;
+	|	ColonToken				//		:
+	|	DoubleColonToken		//		::
+	|	CommaToken				//		,
+	|	ExclamationToken		//		!
+	|	BarToken				//		|
+	|	ArrowToken				//		->
+	|	DoubleArrowToken		//		=>
+	|	EqualToken				//		=
+	|	DefinesColonToken		//		=:
+	|	ColonDefinesToken		//		:==
+	|	WildCardToken			//		_
+	|	BackSlashToken			//		\
+	|	DoubleBackSlashToken	//		\\
+	|	LeftArrowToken			//		<-
+	|	LeftArrowColonToken		//		<-:
+	|	DotDotToken				//		..
+	|	AndToken				//		&
+	|	HashToken				//		#
+	|	AsteriskToken			//		*
+	|	LessThanOrEqualToken	//		<=
+
+	|	ModuleToken				//		module
+	|	ImpModuleToken			//		implementation
+	|	DefModuleToken			//		definition
+	|	SysModuleToken			//		system
+
+	|	ImportToken				//		import
+	|	FromToken				//		from
+	|	SpecialToken			//		special
+
+	|	IntTypeToken			//		Int
+	|	CharTypeToken			//		Char
+	|	RealTypeToken			//		Real
+	|	BoolTypeToken			//		Bool
+	|	StringTypeToken			//		String
+	|	FileTypeToken			//		File
+	|	WorldTypeToken			//		World
+	|	VoidTypeToken			//		Void
+	|	LeftAssocToken			//		left
+	|	RightAssocToken			//		right
+	|	ClassToken				//		class
+	|	InstanceToken			//		instance
+	|	OtherwiseToken			//		otherwise
+
+	|	IfToken					//		if
+	|	WhereToken				//		where
+	|	WithToken				//		with
+	|	CaseToken				//		case
+	|	OfToken					//		of
+	|	LetToken Bool			//		let!, let
+	|	SeqLetToken Bool		//		#!, #
+	|	InToken					//		in
+
+	|	DynamicToken			//		dynamic
+	|	DynamicTypeToken		//		Dynamic
+
+	|	PriorityToken Priority	//		infixX N
+
+	|	CodeToken				//		code
+	|	InlineToken				//		inline
+	|	CodeBlockToken [String]	//		{...}
+
+	|	NewDefinitionToken		//		generated automatically, OffsideToken.
+	|	EndGroupToken			//		generated automatically
+	|	EndOfFileToken			//		end of file
+	|	ErrorToken String		//		an error has occured
+
+::	Context
+	=	GeneralContext
+	|	TypeContext
+	|	FunctionContext
+	|	CodeContext
+
+instance == Context
+where
+	(==) co1 co2 = equal_constructor co1 co2
+
+::	Assoc
+	=	LeftAssoc
+	|	RightAssoc
+	|	NoAssoc
+
+::	Priority
+	=	Prio Assoc Int
+	|	NoPrio
+
+//
+//	Macros for error messages
+//
+ScanErrIllegal	:== "illegal char in input"
+ScanErrCharErr	:== "wrong character denotation"
+ScanErrNLString	:== "new line in string denotation"
+ScanErrWild		:== "ident should not start with _"
+
+class getFilename state :: !*state -> (!String,!*state)
+
+instance getFilename ScanInput
+where
+	getFilename (Input input)
+		# (filename,input) = input!inp_filename
+		= (filename,Input input)
+	getFilename (PushedToken tok input)
+		# (filename,input) = getFilename input
+		= (filename,PushedToken tok input)
+
+instance getFilename ScanState
+where
+	getFilename scanState=:{ss_input}
+		# (filename,ss_input) = getFilename ss_input
+		= (filename,{scanState & ss_input = ss_input })
+
+class getPosition state :: !*state -> (!FilePosition,!*state)  // Position of current Token (or Char)
+
+instance getPosition ScanState
+where
+	getPosition scanState=:{ss_tokenBuffer}
+		| isEmptyBuffer ss_tokenBuffer
+			= getCharPosition scanState
+		# (ltok,_) = get ss_tokenBuffer
+		= (ltok.lt_position, scanState)
+
+instance getPosition Input
+where
+	getPosition input=:{inp_pos} = (inp_pos, input)
+
+class getCharPosition state :: !*state -> (FilePosition,!*state)
+
+instance getCharPosition ScanState
+where
+	getCharPosition scanState=:{ss_input=Input input}
+		# (pos,input) = getPosition input
+		= (pos,{ scanState & ss_input = Input input })
+	getCharPosition scanState=:{ss_input=PushedToken longToken _}
+		= (longToken.lt_position,scanState)
+
+instance getCharPosition Input
+where getCharPosition input=:{inp_pos} = (inp_pos, input)
+
+class nextToken state :: !Context !*state -> (!Token, !*state)
+
+instance nextToken ScanState
+where
+	nextToken newContext scanState=:{ss_input=input=:PushedToken token=:{lt_position,lt_token/*,lt_context*/} rest,ss_tokenBuffer}
+//		| lt_context == newContext || ~ (contextDependent lt_token) || isGeneratedToken lt_token
+//		| True
+		=	(	lt_token
+			,	{ scanState
+				& ss_input			= rest
+				, ss_tokenBuffer	= store token ss_tokenBuffer
+				}
+			)  //-->> ("nextToken: pushed token", lt_token)
+/*		=	nextToken newContext { scanState & ss_input = pushTokensBack input}
+	where
+		pushTokensBack input=:(Input _) = input
+		pushTokensBack (PushedToken token input)
+			# (Input input=:{inp_stream}) = pushTokensBack input
+			= Input
+				{ input
+				& inp_stream = OldToken token inp_stream
+				}  //-->> ("pushTokensBack",token)
+*/	nextToken context scanState=:{ss_input=Input inp,ss_tokenBuffer,ss_offsides,ss_useLayout}
+		# (error, c, inp) 	= SkipWhites inp
+		  (pos, inp)		= inp!inp_pos
+		  scanState			= {scanState & ss_input = Input inp }
+		= case error of
+			Yes string	->	( ErrorToken string
+							,	{	scanState
+								&	ss_tokenBuffer	= store
+												{	lt_position 	= pos
+												,	lt_token		= ErrorToken string
+											//	,	lt_chars		= []
+											//	,	lt_context		= context
+												}
+												scanState.ss_tokenBuffer
+								}
+							) -->> ("Error token generated",string)
+			no			->	determineToken c scanState
+	where
+		determineToken c scanState=:{ss_input=Input inp}
+			#	(eof, inp)	= EndOfInput inp
+				(pos, inp)	= inp!inp_pos
+			|	eof && c == NewLineChar
+				#	newToken	= EndOfFileToken
+				=	checkOffside pos newToken
+						{ scanState
+						& ss_tokenBuffer	= store
+												{	lt_position 	= pos
+												,	lt_token		= newToken
+											//	,	lt_chars		= []
+											//	,	lt_context		= context
+												}
+												scanState.ss_tokenBuffer
+						, ss_input = Input inp
+						} // -->> (EndOfFileToken,pos)
+			// otherwise // ~ (eof && c == NewLineChar)
+				#	(token, inp)	= Scan c inp /* {inp & inp_curToken = [c]}*/ context
+			//	#	(chars, inp)	= inp!inp_curToken
+				= checkOffside pos token
+					{ scanState
+					& ss_input 			= Input inp
+					, ss_tokenBuffer	= store
+											{	lt_position 	= pos
+											,	lt_token		= token
+										//	,	lt_chars		= reverse chars
+										//	,	lt_context		= context
+											}
+											ss_tokenBuffer
+					}	// -->> (token,pos)
+	nextToken _ _ = abort "Scanner: Error in nextToken"
+
+class tokenBack state :: !*state -> !*state
+
+instance tokenBack ScanState
+where
+	tokenBack scanState=:{ss_tokenBuffer, ss_input}
+		| isEmptyBuffer ss_tokenBuffer = abort "tokenBack with empty token buffer"
+		# (tok, buf) = get ss_tokenBuffer
+		=	{ scanState
+			& ss_tokenBuffer	= buf
+			, ss_input			= PushedToken tok ss_input
+			
+			} // -->> ("tokenBack", tok, buf)
+
+class currentToken state :: !*state -> (!Token, !*state)
+
+instance currentToken ScanState
+where currentToken scanState=:{ss_tokenBuffer}
+		| isEmptyBuffer ss_tokenBuffer
+			= (ErrorToken "dummy", scanState)
+			= ((head ss_tokenBuffer).lt_token, scanState)
+
+class insertToken state :: !Token !Context !*state -> *state
+
+instance insertToken ScanState
+where
+	insertToken t c scanState
+/*		#	chars = if (isGeneratedToken t)
+						[]
+						(fromString (toString t))
+*/		#	(pos, scanState=:{ss_input}) = getPosition scanState
+		=	{ scanState
+			& ss_input = PushedToken
+							{ lt_position	= pos
+							, lt_token		= t
+						//	, lt_chars		= chars
+						//	, lt_context	= c
+							}
+							ss_input
+			}
+/*
+isGeneratedToken :: !Token -> Bool
+isGeneratedToken NewDefinitionToken = True
+isGeneratedToken EndGroupToken      = True
+isGeneratedToken (CodeBlockToken _) = True
+isGeneratedToken _					= False
+*/
+
+class replaceToken state :: !Token !*state -> *state
+
+instance replaceToken ScanState
+where
+	replaceToken tok scanState=:{ss_tokenBuffer}
+		# (longToken,buffer) = get ss_tokenBuffer
+		= { scanState
+		  & ss_tokenBuffer = store { longToken & lt_token = tok } buffer
+		  }
+
+SkipWhites :: !Input -> (!Optional String, !Char, !Input)
+SkipWhites input
+	# (eof, c, input)		= ReadChar input
+	| eof					= (No, NewLineChar, input) // -->> "EOF in SkipWhites"
+	| IsWhiteSpace c		= SkipWhites input
+							= TryScanComment c input
+
+TryScanComment :: !Char !Input -> (!Optional String, !Char, !Input)
+TryScanComment c1=:'/' input
+	# (eof,c2, input)		= ReadChar input
+	| eof					= (No, c1, input)
+	= case c2 of
+		'/' -> SkipWhites (SkipToEndOfLine input)
+		'*' -> case ScanComment input of
+				(No,input)	-> SkipWhites input
+				(er,input)	-> (er, c1, input)
+		_   -> (No, c1, charBack input)
+TryScanComment c input
+	= (No, c, input)
+
+ScanComment	:: !Input -> (!Optional String, !Input)
+ScanComment input
+	# (eof1, c1, input)	= ReadChar input
+	| eof1				= (Yes "end of file encountered inside comment", input)
+	| c1 == '/'
+		# (eof2, c2, input)	= ReadChar input
+		| eof2				= (Yes "end of file encountered inside comment", input)
+							= case c2 of
+								'/'	->	ScanComment (SkipToEndOfLine input)
+								'*'	->	case ScanComment input of
+											(No, input) -> ScanComment input
+											error		-> error
+								_	->	ScanComment input
+	| c1 == '*'
+		# (eof2, c2, input)	= ReadChar input
+		| eof2				= (Yes "end of file encountered inside comment", input)
+		| c2 == '/'			= (No, input)
+							= ScanComment input
+	| otherwise				= ScanComment input
+
+SkipToEndOfLine	:: !Input -> !Input
+SkipToEndOfLine input
+	# (eof, c, input)	= ReadChar input
+	| eof				= input
+	| c==NewLineChar	= input
+			= SkipToEndOfLine input
+/*
+SkipToChar :: ! Char ! Input -> Input
+SkipToChar c input
+	# (eof, c1, input)		= ReadChar input
+	| eof || c1 == c		= input
+							= SkipToChar c input
+*/
+Scan :: !Char !Input !Context -> (!Token, !Input)
+Scan '(' input co			= (OpenToken, input)
+Scan ')' input co			= (CloseToken, input)
+Scan '{' input CodeContext	= ScanCodeBlock input
+Scan '{' input co			= (CurlyOpenToken, input)
+Scan '}' input co			= (CurlyCloseToken, input)
+Scan '[' input co			= (SquareOpenToken, input)
+Scan ']' input co			= (SquareCloseToken, input)
+Scan c0=:'|' input co
+	# (eof, c1, input)		= ReadChar input
+	| eof					= (BarToken, input)
+	| isSpecialChar c1		= ScanOperator 1 input [c1, c0] co
+							= (BarToken, charBack input)
+Scan ',' input co			= (CommaToken, input)
+Scan ';' input co			= (SemicolonToken, input)
+Scan '#' input TypeContext	= (HashToken, input)
+Scan c0=:'#' input co
+	# (strict, input)		= determineStrictness input
+	| strict
+		= (SeqLetToken strict, input)
+	# (eof,c1, input)		= ReadChar input
+	| eof
+		= (SeqLetToken False, input)
+	| isSpecialChar c1
+		= ScanOperator 1 input [c1, c0] co
+	// otherwise
+		= (SeqLetToken strict, charBack input)
+Scan '*' input TypeContext	= (AsteriskToken, input)
+Scan c0=:'&' input co
+	# (eof, c1, input)		= ReadChar input
+	| eof					= (AndToken, input)
+	| isSpecialChar c1		= ScanOperator 1 input [c1, c0] co
+							= (AndToken, charBack input)
+Scan c0=:'.' input co
+	= case co of
+		TypeContext
+
+						-> (DotToken, input)
+		_	# (eof, c1, input) = ReadChar input
+			| eof		-> (DotToken, input)
+			| c1 <> '.'	-> (DotToken, charBack input)
+			# (eof, c2, input) = ReadChar input
+			| eof		-> (DotDotToken, input)
+			| isSpecialChar c2
+						-> ScanOperator 2 input [c2, c1, c0] co
+						-> (DotDotToken, charBack input)
+Scan '!' input TypeContext	= (ExclamationToken, input)
+Scan '\\' input co
+	# (eof, c, input)		= ReadChar input
+	| eof					= (BackSlashToken, input)
+	| c == '\\'				= (DoubleBackSlashToken, input)
+							= (BackSlashToken, charBack input)
+Scan c0=:'_' input co
+	# (eof, c1, input)		= ReadChar input
+	| eof					= (WildCardToken, input)
+	| IsIdentChar c1	co	= ScanIdent 1 input [c1, c0] co
+//	| isSpecialChar c1		= ScanOperator 1 input [c1, c0] co
+							= (WildCardToken, charBack input)
+Scan c0=:'<' input TypeContext
+	# (eof, c1, input)		= ReadChar input
+	| eof					= (ErrorToken "< just before end of file in TypeContext", input)
+	| c1 == '='				= (LessThanOrEqualToken, input)
+							=  ScanOperator 0 (charBack input) [c0] TypeContext
+Scan c0=:'<' input co
+	# (eof, c1, input)		= ReadChar input
+	| eof 					= (IdentToken "<", input)
+	| c1 <> '-'				= ScanOperator 0 (charBack input) [c0] co
+	# (eof, c2, input)		= ReadChar input
+	| eof					= (LeftArrowToken, input)
+	| c2 == ':'	
+		# (eof, c3, input)		= ReadChar input
+		| eof					= (LeftArrowColonToken, input)
+		| isSpecialChar c3		= ScanOperator 3 input [c3, c2, c1, c0] co
+								= (LeftArrowColonToken, charBack input)
+	| isSpecialChar c2		= ScanOperator 2 input [c2, c1, c0] co
+							= (LeftArrowToken, charBack input)
+Scan c0=:'-' input co
+	# (eof, c1, input)		= ReadChar input
+	| eof					= (IdentToken "-", input)
+	# new					= newExp input.inp_charBuffer
+	| IsDigit c1 && new		= ScanNumeral 1 input [c1,c0]
+	| c1 <> '>'				= ScanOperator 0 (charBack input) [c0] co
+	| co == TypeContext		= (ArrowToken, input)	// -> is a reserved symbol in a type context
+							// Can cause an error when token (like ->.) is read in wrong context
+	# (eof, c2, input)		= ReadChar input		
+	| eof					= (ArrowToken, input)
+	| isSpecialChar c2		= ScanOperator 2 input [c2, c1, c0] co
+							= (ArrowToken, charBack input)
+Scan c0=:'+' input co
+	# (eof, c1, input)		= ReadChar input
+	| eof					= (IdentToken "+", input)
+	# new					= newExp input.inp_charBuffer
+	| IsDigit c1 && new		= ScanNumeral 1 input [c1,c0]
+							= ScanOperator 0 (charBack input) [c0] co
+Scan c0=:'=' input co
+	# (eof, c, input)		= ReadChar input
+	| eof					= (EqualToken, input)
+	| c == ':'				= (DefinesColonToken, input)
+	| c == '>'				= (DoubleArrowToken, input)
+	| isSpecialChar c		= ScanOperator 1 input [c, c0] co
+							= (EqualToken, charBack input)
+Scan c0=:':' input co
+	# (eof,c1, input)		= ReadChar input
+	| eof					= (ColonToken, input)
+	| c1 == ':'				= (DoubleColonToken, input)
+	| c1 <> '='
+		| isSpecialChar c1	= ScanOperator 1 input [c1, c0] co
+							= (ColonToken, charBack input)
+	# (eof, c2, input)		= ReadChar input
+	| eof					= ScanOperator 1 input [c1, c0] co
+	| c2 == '='				= (ColonDefinesToken, input)
+							= ScanOperator 1 (charBack input) [c1, c0] co
+Scan c0=:'\'' input co		= ScanChar input [c0]
+Scan c0=:'\"' input co		= ScanString 0 input [c0]
+Scan c    input co
+	| IsDigit c				= ScanNumeral 0 input [c]
+	| IsIdentChar c	co		= ScanIdent 0 input [c] co
+	| isSpecialChar c		= ScanOperator 0 input [c] co
+							= (ErrorToken ScanErrIllegal, input)
+
+newExp :: !(Buffer (Char,FilePosition)) -> Bool
+newExp buffer
+	# (c, _)	= case buffer of
+					Buffer3 _ _ cp	-> cp
+					_				-> (' ',{fp_line=0,fp_col=0})
+	= new_exp_char c
+where
+	new_exp_char ',' = True
+	new_exp_char '[' = True
+	new_exp_char '(' = True
+	new_exp_char '/' = True // to handle end of comment symbol: */
+	new_exp_char c	 = isSpace c
+
+ScanIdent :: !Int !Input ![Char] !Context -> (!Token, !Input)
+ScanIdent n input token co
+	# (eof, c, input)		= ReadChar input
+	| eof					= CheckReserved co (revCharListToString n token) input
+	| IsIdentChar c co		= ScanIdent (n + 1) input [c:token] co
+							= CheckReserved co (revCharListToString n token) (charBack input)
+
+
+ScanOperator :: !Int !Input ![Char] !Context -> (!Token, !Input)
+ScanOperator n input token co
+	#  (eof, c, input)		= ReadChar input
+	| eof					= (IdentToken (revCharListToString n token), input)
+	| isSpecialChar c		= ScanOperator (n + 1) input [c:token] co
+							= CheckReserved co (revCharListToString n token) (charBack input)
+
+CheckReserved :: !Context !String !Input -> (!Token, !Input)
+CheckReserved GeneralContext    s i = CheckGeneralContext s i
+CheckReserved TypeContext       s i = CheckTypeContext s i
+CheckReserved FunctionContext	s i = CheckFunctContext s i
+CheckReserved CodeContext		s i = CheckCodeContext s i
+
+CheckGeneralContext	:: !String !Input -> (!Token, !Input)
+CheckGeneralContext s input
+ = case s of
+	"module"     		-> (ModuleToken		, input)
+	"definition"  		-> (DefModuleToken	, input)
+	"implementation"	-> (ImpModuleToken	, input)
+	"system"			-> (SysModuleToken	, input)
+	"import"     		-> (ImportToken		, input)
+	"from" 				-> (FromToken		, input)
+	"in"  	    		-> (InToken			, input)
+	s					-> CheckEveryContext s input
+
+CheckEveryContext :: !String !Input -> (!Token, !Input)
+CheckEveryContext s input
+ = case s of
+	"where"		->	(WhereToken			, input)
+	"with"		->	(WithToken			, input)
+	"class" 	->	(ClassToken			, input)
+	"instance"	->	(InstanceToken		, input)
+	"otherwise"	->	(OtherwiseToken		, input)
+//	"!"			->	(ExclamationToken	, input)
+//	"::"		->	(DoubleColonToken	, input)
+	"*/"		->	(ErrorToken "Unexpected end of comment, */", input)
+	"infixr"	#	(error, n, input) = GetPrio  input
+				->	case error of
+						Yes err -> (ErrorToken err						, input)  //-->> ("Error token generated: "+err)
+						No		-> (PriorityToken (Prio RightAssoc n)	, input)
+	"infixl"	#	(error, n, input) = GetPrio  input
+				->	case error of
+						Yes err -> (ErrorToken err						, input)  //-->> ("Error token generated: "+err)
+						No		-> (PriorityToken (Prio LeftAssoc n)	, input)
+	"infix"		#	(error, n, input) = GetPrio  input
+				->	case error of
+						Yes err -> (ErrorToken err						, input)  //-->> ("Error token generated: "+err)
+						No		-> (PriorityToken (Prio NoAssoc n)		, input)
+	s			->	(IdentToken s		, input)
+
+CheckTypeContext :: !String !Input -> (!Token, !Input)
+CheckTypeContext s input
+ = case s of
+ 	"Int"		->	(IntTypeToken		, input)
+	"Char"		->	(CharTypeToken		, input)
+	"Real"		->	(RealTypeToken		, input)
+	"Bool"		->	(BoolTypeToken		, input)
+	"String"	->	(StringTypeToken	, input)
+	"File"		->	(FileTypeToken		, input)
+	"World"		->	(WorldTypeToken		, input)
+	"Dynamic"	->	(DynamicTypeToken	, input)
+	"special"	->	(SpecialToken		, input)
+	"from" 		->	(FromToken			, input)
+	s			->	CheckEveryContext s input
+
+CheckFunctContext :: !String !Input -> (!Token, !Input)
+CheckFunctContext s input
+ = case s of
+	"if"		->	(IfToken			, input)
+	"True"		->	(BoolToken True		, input)
+	"False"		->	(BoolToken False	, input)
+	"case"		->	(CaseToken			, input)
+	"of"		->	(OfToken			, input)
+	"system"	->	(SysModuleToken		, input)
+	"import"	->	(ImportToken		, input)
+	"from"		->	(FromToken			, input)
+	"let" 	    #	(strict, input) = determineStrictness input
+				->	(LetToken strict, input)
+//	"Let" 	    #	(strict, input) = determineStrictness input
+//				->	(SeqLetToken strict	, input)
+	"in"  	    ->	(InToken			, input)
+	"dynamic"  	->	(DynamicToken		, input)
+	"code"		->	(CodeToken			, input)
+	s			->	CheckEveryContext s input
+
+CheckCodeContext :: !String !Input -> (!Token, !Input)
+CheckCodeContext s input
+ = case s of
+	"inline"	->	(InlineToken		, input)
+	s			->	CheckEveryContext s input	
+
+GetPrio :: !Input -> (!Optional String, !Int, !Input)
+GetPrio input
+	# (error, c, input) = SkipWhites input
+	| IsDigit c
+		= (error, digitToInt c, input)
+		= (error, defaultPrio , charBack input)
+where defaultPrio = 0
+
+determineStrictness :: !Input -> (!Bool, !Input)
+determineStrictness input
+	# (eof, c, input)		= ReadChar input
+	| eof					= (False, input)
+	| c == '!'				= (True, input)
+							= (False, charBack input)
+
+ScanCodeBlock :: !Input -> (!Token, !Input)
+ScanCodeBlock input
+	= scan_code_block [] input
+where
+	scan_code_block :: ![String] !Input -> (!Token,!Input)
+	scan_code_block acc input
+		# (eof, c, input)	= ReadChar input
+		| c == '}'
+			= (CodeBlockToken (reverse acc), input)
+		| isNewLine c
+			| eof
+				= (ErrorToken "eof in code block", input)
+				= scan_code_block acc input
+		| IsWhiteSpace c
+				= scan_code_block acc input
+		# (line, input)		= ReadLine input
+		= scan_code_block [toString c+stripNewline line:acc] input
+
+stripNewline :: !String -> String
+stripNewline string
+	# size = size string
+	= case size of
+		0 -> string
+		1 | isNewLine string.[0]
+			-> ""
+			-> string
+		_ | isNewLine string.[size-1]
+			| isNewLine string.[size-2]
+				-> string%(0,size-3)
+				-> string%(0,size-2)
+			-> string
+		
+
+ScanNumeral	:: !Int !Input [Char] -> (!Token, !Input)
+ScanNumeral n input chars=:['0':r]
+	| isEmpty r || r == ['+']
+		# (eof, c, input)		= ReadChar input
+		| eof					= (IntToken (revCharListToString n chars), input)
+		| c == 'x'
+			# (eof, c1, input)	= ReadChar input
+			| eof				= (IntToken "0", charBack input)
+			| isHexDigit c1		= ScanHexNumeral (hexDigitToInt c1) input
+								= (IntToken "0", charBack (charBack input))
+		| isOctDigit c			= ScanOctNumeral (digitToInt c) input
+		| c == '.'				= TestFraction n input chars
+								= (IntToken "0", charBack input)
+	| r == ['-']
+		# (eof, c, input)		= ReadChar input
+		| eof					= (IntToken (revCharListToString n chars), input)
+		| c == 'x'
+			# (eof, c1, input)	= ReadChar input
+			| eof				= (IntToken "0", charBack input)
+			| isHexDigit c1		= ScanHexNumeral (~ (hexDigitToInt c1)) input
+								= (IntToken "0", charBack (charBack input))
+		| isOctDigit c			= ScanOctNumeral (~ (digitToInt c)) input
+		| c == '.'				= TestFraction n input chars
+								= (IntToken "0", charBack input)
+ScanNumeral n input chars
+	# (eof, c, input)		= ReadChar input
+	| eof					= (IntToken (revCharListToString n chars), input)
+	| IsDigit c				= ScanNumeral (n + 1) input [c:chars]
+	| c == 'E'				= ScanExponentSign (n + 1) input [c:chars]
+	| c == '.'				= TestFraction n input chars
+							= (IntToken (revCharListToString n chars), charBack input)
+
+TestFraction :: !Int !Input ![Char] -> (!Token, !Input)
+TestFraction n input chars
+	# (eof, c, input)		= ReadChar input
+	| eof					= (ErrorToken ("Incorrect Real at end of file: "+(revCharListToString (n+1) ['.':chars])), input)
+	| IsDigit c				= ScanFraction (n + 2) input [c,'.':chars]
+			 				= (IntToken (revCharListToString n chars), charBack (charBack input))
+
+ScanFraction :: !Int !Input ![Char] -> (!Token, !Input)
+ScanFraction n input chars
+	# (eof, c, input)		= ReadChar input
+	| eof					= (RealToken (revCharListToString n chars), input)
+	| c == 'E'				= case chars of
+								[c:_] | IsDigit c	-> ScanExponentSign (n + 1) input [c:chars]
+								_					-> ScanExponentSign (n + 2) input [c,'0':chars]
+	| IsDigit c				= ScanFraction (n + 1) input [c:chars]
+							= case chars of
+								[c:_] | IsDigit c	-> (RealToken (revCharListToString n chars), charBack input)
+								_					-> (RealToken (revCharListToString (n+1) ['0':chars]), charBack input)
+
+ScanExponentSign :: !Int !Input ![Char] -> (!Token, !Input)
+ScanExponentSign n input chars
+	# (eof, c, input)		= ReadChar input
+	| eof					= (RealToken (revCharListToString n chars), input)
+	| c == '+'				= ScanExponent n input chars
+	| c == '-' || IsDigit c	= ScanExponent (n+1) input [c:chars]
+	| otherwise				= (ErrorToken ("Digit or sign expected after "+revCharListToString n chars), charBack input)
+
+ScanExponent :: !Int !Input ![Char] -> (!Token, !Input)
+ScanExponent n input chars
+	# (eof, c, input)		= ReadChar input
+	| eof					= (RealToken (revCharListToString n chars), input)
+	| IsDigit c				= ScanExponent (n + 1) input [c:chars]
+							= case chars of
+								[c:_] | IsDigit c	-> (RealToken (revCharListToString n chars), charBack input)
+								_					-> (ErrorToken ("Digit expected after "+revCharListToString n chars), charBack input)
+
+ScanHexNumeral	:: !Int !Input -> (!Token, !Input)
+ScanHexNumeral n input
+	# (eof, c, input)		= ReadChar input
+	| eof					= (IntToken (toString n), input)
+	| isHexDigit c			= ScanHexNumeral (n*16+hexDigitToInt c) input
+							= (IntToken (toString n), charBack input)
+
+ScanOctNumeral	:: !Int !Input -> (!Token, !Input)
+ScanOctNumeral n input
+	# (eof, c, input)		= ReadChar input
+	| eof					= (IntToken (toString n), input)
+	| isOctDigit c			= ScanOctNumeral (n*8+digitToInt c) input
+							= (IntToken (toString n), charBack input)
+
+ScanChar :: !Input ![Char] -> (!Token, !Input)
+ScanChar input chars
+	# (eof, c, input)		= ReadChar input
+	| eof					= (ErrorToken "End of file inside Char denotation", input)
+	| '\\' <> c				= ScanEndOfChar 1 [c: chars] input
+	# (chars, n, input)		= ScanBSChar 0 chars input
+	= ScanEndOfChar n chars input
+
+ScanBSChar :: !Int ![Char] !Input -> (![Char], !Int, !Input)
+ScanBSChar n chars input
+	# (eof, c, input)		= ReadChar input
+	| eof					= (chars, n, input)
+	= case c of
+		'n'		->	(['n','\\':chars], n + 2, input)
+		'r'		->	(['r','\\':chars], n + 2, input)
+		'f'		->	(['f','\\':chars], n + 2, input)
+		'b'		->	(['b','\\':chars], n + 2, input)
+		't'		->	(['t','\\':chars], n + 2, input)
+		'v'		->	(['v','\\':chars], n + 2, input)
+		'\\'	->	(['\\','\\':chars], n + 2, input)
+		'"'		->	(['"' ,'\\':chars], n + 2, input)
+		'\''	->	(['\'','\\':chars], n + 2, input)
+		'x'		#	(cc,input) = ScanNumChar Hex isHexDigit 2 0 input // max 2 characters
+				->	to_chars cc n input
+		'd'		#	(cc,input) = ScanNumChar Dec isDigit 3 0 input // max 3 characters
+				->	to_chars cc n input
+		c | IsOct c
+				#	(cc,input) = ScanNumChar Oct IsOct 2 (digitToInt c) input // max 3 characters, including current
+				->	to_chars cc n input
+				->	([c:chars], n + 1, input)
+where
+	ScanNumChar base valid 0 acc input
+		= (acc, input)
+	ScanNumChar base valid n acc input
+		# (eof, c, input)		= ReadChar input
+		| eof					= (acc, input)
+		| valid c				= ScanNumChar base valid (n-1) (base*acc+digitToInt c) input
+								= (acc, charBack input)	
+	Hex = 16
+	Oct = 8
+	Dec = 10
+	
+	to_chars cc n input
+	 = case toChar cc of
+		'\n'	->	(['n','\\':chars], n + 2, input)
+		'\r'	->	(['r','\\':chars], n + 2, input)
+		'\f'	->	(['f','\\':chars], n + 2, input)
+		'\b'	->	(['b','\\':chars], n + 2, input)
+		'\t'	->	(['t','\\':chars], n + 2, input)
+		'\v'	->	(['v','\\':chars], n + 2, input)
+		'\\'	->	(['\\','\\':chars], n + 2, input)
+//		'"'		->	(['"' ,'\\':chars], n + 2, input)
+		'\''	->	(['\'','\\':chars], n + 2, input)
+	 	c		->	([c:chars], n + 1, input)
+
+ScanEndOfChar :: !Int ![Char] !Input -> (!Token, !Input)
+ScanEndOfChar n chars input
+	# (eof, c, input)		= ReadChar input
+	| eof					= (ErrorToken "End of file inside char denotation", input)
+	| '\'' == c				= (CharToken (revCharListToString (n + 1) [c:chars]), input)
+							= ScanCharList (n+1) [c:chars] input
+//							= (ErrorToken ScanErrCharErr, input)
+
+ScanCharList :: !Int ![Char] !Input -> (!Token, !Input)
+ScanCharList n chars input
+	# (eof, c, input)		= ReadChar input
+	| eof					= (ErrorToken "End of file inside char list denotation", input)
+	= case c of
+		'\''		#	charList	= revCharListToString n chars % (1,n) // without '\''
+					->	(CharListToken charList, input)
+		'\\'		#	(chars, n, input)	= ScanBSChar n chars input
+					->	ScanCharList n chars input
+		NewLineChar	->	(ErrorToken "newline in char list", input)
+		_			->	ScanCharList (n+1) [c:chars] input
+
+ScanString :: !Int !Input ![Char] -> (!Token, !Input)
+ScanString n input chars
+ # (eof, c, input)		= ReadChar input
+ | eof					= (ErrorToken "End of file inside String denotation", input)
+ = case c of 
+	'\\' 		#  (chars, n, input) = ScanBSChar n chars input
+		 		-> ScanString n input chars
+	'\"' 		-> (StringToken (revCharListToString (n + 1) [c:chars]), input)
+	NewLineChar -> (ErrorToken ScanErrNLString, input)
+	_	 		-> ScanString (n + 1) input [c:chars]
+
+/*
+	some predicates on tokens
+*/
+
+isLhsStartToken :: ! Token -> Bool
+isLhsStartToken OpenToken       = True
+isLhsStartToken SquareOpenToken	= True
+isLhsStartToken CurlyOpenToken	= True
+isLhsStartToken (IdentToken id) = True
+isLhsStartToken token           = False
+
+isOffsideToken :: ! Token -> Bool
+isOffsideToken NewDefinitionToken	= True
+isOffsideToken EndGroupToken		= True
+isOffsideToken EndOfFileToken		= True
+isOffsideToken token				= False
+
+isEndGroupToken :: ! Token -> Bool
+isEndGroupToken EndGroupToken = True
+isEndGroupToken CurlyCloseToken = True
+isEndGroupToken token = False
+/*
+contextDependent :: !Token -> Bool
+contextDependent HashToken 			= True
+//contextDependent (SeqLetToken _)	= True // Do not do this XXXXXX
+contextDependent _					= False
+*/
+/*
+	character functions
+*/
+
+//IsWhiteSpace	:: Char	-> Bool
+IsWhiteSpace c :== isSpace c
+
+//IsDigit	:: Char	-> Bool
+IsDigit c :== isDigit c
+
+IsOct c :== '0' <= c && c <= '7'
+
+//IsHex c :== isDigit c || ('A' <= c && c <= 'F') || ('a' <= c && c <= 'f') 
+/*
+isHexDigit :: !Char -> Bool // Defined in StdChar
+isHexDigit c
+	| isDigit c
+		= True
+	| c < 'g'
+		= c >= 'a'
+	| c < 'G'
+		= c >= 'A'
+		= False
+*/
+//IsIdentChar	:: !Char !Context -> Bool
+//IsIdentChar c co
+// :== isAlphanum c ||	c == '_' ||	c == '`' ||	(c == '^' && co == TypeContext)
+
+hexDigitToInt :: !Char -> Int
+hexDigitToInt 'a' = 10
+hexDigitToInt 'A' = 10
+hexDigitToInt 'b' = 11
+hexDigitToInt 'B' = 11
+hexDigitToInt 'c' = 12
+hexDigitToInt 'C' = 12
+hexDigitToInt 'd' = 13
+hexDigitToInt 'D' = 13
+hexDigitToInt 'e' = 14
+hexDigitToInt 'E' = 14
+hexDigitToInt 'f' = 15
+hexDigitToInt 'F' = 15
+hexDigitToInt c   = digitToInt c
+
+IsIdentChar :: !Char !Context -> Bool
+IsIdentChar  c	_ | isAlphanum c	= True
+IsIdentChar '_'	_ 					= True
+IsIdentChar '`'	_					= True
+IsIdentChar '^'	TypeContext			= True
+IsIdentChar  _	_					= False
+
+/*
+	Input functions
+*/
+
+EndOfInput :: !Input -> (!Bool, !Input)
+EndOfInput input=:{inp_stream = InFile file}
+	# (endoffile, file) = fend file
+	= (endoffile, { input & inp_stream = InFile file })
+EndOfInput f=:{inp_stream = InLOC []}	= (True, f)
+EndOfInput input						= (False, input)
+
+ReadChar :: !Input -> (!Bool, !Char, !Input) // Bool indicates end of file, we read always newlines in an empty file
+ReadChar input=:{inp_stream = InFile file, inp_pos, inp_tabsize, inp_charBuffer /*, inp_curToken*/}
+	#!	(s, file) = freadline file
+		eof = s == ""
+	| eof
+		#	c	= NewLineChar
+			pos	= NextPos c inp_pos inp_tabsize
+		=	(	eof
+			,	c
+			,	{	input
+				&	inp_stream		= InFile file
+				,	inp_pos			= pos
+				,	inp_charBuffer	= store (c,pos) inp_charBuffer
+			//	,	inp_curToken	= [c:inp_curToken]
+				}
+			) // -->> ("EOF in " + input.inp_filename + " found in ReadChar")
+	// otherwise // s <> ""
+		# chars = fromString s
+		= ReadChar { input & inp_stream = OldChars chars (InFile file) }
+/*	#! (eof, file) = fend file								// old, too slow
+	| eof
+		#	c	= NewLineChar
+			pos	= NextPos c inp_pos inp_tabsize
+		=	(	eof
+			,	c
+			,	{	input
+				&	inp_stream		= InFile file
+				,	inp_pos			= pos
+				,	inp_charBuffer	= store (c,pos) inp_charBuffer
+			//	,	inp_curToken	= [c:inp_curToken]
+				}
+			) // -->> ("EOF in " + input.inp_filename + " found in ReadChar")
+	#! (ok, c, file) = freadc file
+	| ok
+		#	pos			= NextPos c inp_pos inp_tabsize
+			(c,input`)	= correctNewline c pos inp_tabsize (InFile file)
+		=	(	False
+			,	c
+			,	{	input
+				&	inp_stream		= input`
+				,	inp_pos			= pos
+				,	inp_charBuffer	= store (c,pos) inp_charBuffer
+			//	,	inp_curToken	= [c:inp_curToken]
+				}
+			)
+		= abort "ReadChar failure" */
+ReadChar input =: {inp_stream = OldChar c pos oldfile, inp_charBuffer /*, inp_curToken*/}
+	=	(	False
+		,	c
+		,	{	input
+			&	inp_stream		= oldfile
+			,	inp_pos			= pos
+			,	inp_charBuffer	= store (c,pos) inp_charBuffer
+		//	,	inp_curToken	= [c:inp_curToken]
+			}
+		)
+ReadChar input =: {inp_stream = OldChars [c:rest] stream, inp_pos, inp_tabsize, inp_charBuffer /*, inp_curToken*/}
+	#	pos			= NextPos c inp_pos inp_tabsize
+		(c,input`)	= correctNewline c pos inp_tabsize (OldChars rest stream)
+	=	(	False
+		,	c
+		,	{	input
+			&	inp_stream		= input`
+			,	inp_pos			= pos
+			,	inp_charBuffer	= store (c,pos) inp_charBuffer
+		//	,	inp_curToken	= [c:inp_curToken]
+			}
+		)
+ReadChar input =: {inp_stream = OldChars [] stream, inp_pos}
+		= ReadChar {input & inp_stream = stream}
+ReadChar input =: {inp_stream = InLOC [c : r], inp_pos, inp_tabsize /*, inp_curToken*/, inp_charBuffer}
+	# pos	= NextPos c inp_pos inp_tabsize
+	=	(	False
+		,	c
+		,	{	input
+			&	inp_stream		= InLOC r
+			,	inp_pos			= pos
+			,	inp_charBuffer	= store (c,pos) inp_charBuffer
+		//	,	inp_curToken	= [c:inp_curToken]
+			}
+		)
+ReadChar input =: {inp_stream = InLOC [], inp_pos, inp_tabsize /*, inp_curToken*/, inp_charBuffer}
+	#	c	= NewLineChar
+		pos	= NextPos c inp_pos inp_tabsize
+	=	(	True
+		,	c
+		,	{	input
+			&	inp_pos			= pos
+			,	inp_charBuffer	= store (c,pos) inp_charBuffer
+		//	,	inp_curToken	= [c:inp_curToken]
+			}
+		)
+		//-->> ("EOF of InLOC found in ReadChar")
+/*
+ReadChar input =: {inp_stream = OldToken {lt_chars,lt_position} stream, inp_charBuffer}
+	#	pos	= lt_position
+		c	= hd lt_chars
+	=	(	False
+		,	c
+		,	{	input
+			&	inp_stream		= OldChars (tl lt_chars) stream
+			,	inp_pos			= pos
+			,	inp_charBuffer	= store (c,pos) inp_charBuffer
+		//	,	inp_curToken	= [c]
+			}
+		)
+*/
+ReadLine :: !Input -> (!String, !Input)
+ReadLine input=:{inp_stream = OldChars cs oldfile, inp_pos}
+	# input			= {input & inp_stream = oldfile, inp_pos = NextPos CRChar inp_pos 0}
+	| isEmpty cs	= ReadLine input
+	| otherwise		= (toString cs, input)
+ReadLine input=:{inp_stream = InFile infile,inp_pos}
+	# (eof, file) 	= fend infile
+	| eof			= ("", {input & inp_stream = InFile file})
+	# (l, file )	= freadline file
+	= (l,  {input & inp_stream = InFile file, inp_pos = NextPos CRChar inp_pos 0})
+ReadLine input =: {inp_stream = InLOC [a : c], inp_pos, inp_tabsize}
+	| a==NewLineChar= ("\n", {input & inp_stream = InLOC c, inp_pos = inp_pos})
+	# (line, input)	= ReadLine {input & inp_stream = InLOC c, inp_pos = inp_pos}
+	= (toString a + line, input)
+ReadLine input=:{inp_stream = OldChar c p oldfile}
+	# input			= {input & inp_stream = oldfile}
+	| c==NewLineChar= ("\n", input)
+	# (line, input)	= ReadLine input
+	= (toString c + line, input)
+ReadLine input		= ("", input)
+
+NextPos :: !Char !FilePosition !Int -> FilePosition
+NextPos c pos=:{fp_line, fp_col} t
+	= case c of
+		LFChar	-> NextPos CRChar pos t		//	-->> "LF in Nextpos"
+		CRChar	-> {fp_line = fp_line + 1, fp_col = 0}	// -->> ("line " +toString (fp_line + 1))
+		'\t'	-> {pos & fp_col = t * (fp_col / t + 1)}
+		_		-> {pos & fp_col = fp_col + 1}
+
+correctNewline :: !Char !FilePosition !Int !InputStream -> (!Char, !InputStream)
+correctNewline c pos tab_size (InFile file) 	// Correct newline convention: Mac: CR, Unix: LF, DOS CR LF
+	=	case c of
+			LFChar	-> (NewLineChar,InFile file)	//-->> "UNIX newline"
+			CRChar 
+				# (ok,c2,file) =  freadc file
+				| ok
+					| c2 == LFChar -> (NewLineChar,InFile file) // -->> "DOS newline corrected"
+					               -> (NewLineChar,OldChar c2 (NextPos c2 pos tab_size) (InFile file))
+					-> (NewLineChar, InFile file)
+			_		-> (c, InFile file)
+correctNewline c pos tab_size (OldChars [] input)
+	= correctNewline c pos tab_size input
+correctNewline c pos tab_size (OldChars chars input)
+	=	case c of
+			LFChar	-> (NewLineChar,OldChars chars input)	//-->> "UNIX newline"
+			CRChar
+				# [c2:rest] = chars
+				| c2 == LFChar -> (NewLineChar,OldChars rest input) // -->> "DOS newline corrected"
+				               -> (NewLineChar,OldChars chars input)
+			_		-> (c,OldChars chars input)
+correctNewline c _ _ input = (c, input)
+
+charBack :: !Input -> Input
+charBack input=:{inp_stream,inp_charBuffer}
+	|	isEmptyBuffer inp_charBuffer
+		=	abort "charBack with empty character buffer"
+	#	((c,p),rest) = get inp_charBuffer
+	=	{	input
+		&	inp_stream		= OldChar c p inp_stream
+		,	inp_charBuffer	= rest
+		}
+
+qw s :== "\"" + s + "\""
+
+instance <<< Token
+where
+	(<<<) f t = f <<< (toString t)
+
+instance <<< LongToken
+where
+	(<<<) f lt = f <<< lt.lt_token <<< " from " <<< lt.lt_position
+
+instance <<< FilePosition
+where
+	(<<<) f {fp_line,fp_col} = f <<< fp_line <<< ";" <<< fp_col
+
+instance toString Token
+where
+	toString (IdentToken id)		= id // qw id
+	toString (IntToken id)			= id
+	toString (RealToken id)			= id
+	toString (StringToken id)		= id
+	toString (CharToken id)			= id
+	toString (CharListToken id)		= "['"+id+"']"
+	toString (BoolToken id)			= toString id
+	toString OpenToken				= "("
+	toString CloseToken				= ")"
+	toString CurlyOpenToken			= "{"
+	toString CurlyCloseToken		= "}"
+	toString SquareOpenToken		= "["
+	toString SquareCloseToken		= "]"
+	toString DotToken				= "."
+	toString SemicolonToken			= ";"
+	toString ColonToken				= ": (ColonToken)"
+	toString DoubleColonToken		= "::"
+	toString CommaToken				= ","
+	toString ExclamationToken		= "!"
+	toString BarToken				= "|"
+	toString ArrowToken				= "->"
+	toString DoubleArrowToken		= "=>"
+	toString EqualToken				= "="
+	toString DefinesColonToken		= "=:"
+	toString ColonDefinesToken		= ":=="
+	toString WildCardToken			= "_"
+	toString BackSlashToken			= "\\"
+	toString DoubleBackSlashToken	= "\\\\"
+	toString LeftArrowToken			= "<-"
+	toString LeftArrowColonToken	= "<-:"
+	toString DotDotToken			= ".."
+	toString AndToken				= "&"
+	toString HashToken				= "#"
+	toString AsteriskToken			= "*"
+	toString LessThanOrEqualToken	= "<="
+	toString ModuleToken			= "module"
+	toString ImpModuleToken			= "implementation"
+	toString DefModuleToken			= "definition"
+	toString SysModuleToken			= "system"	
+	toString ImportToken			= "import"
+	toString FromToken				= "from"
+	toString SpecialToken			= "special"
+	toString IntTypeToken			= "Int"
+	toString CharTypeToken			= "Char"
+	toString RealTypeToken			= "Real"
+	toString BoolTypeToken			= "Bool"
+	toString StringTypeToken		= "String"
+	toString LeftAssocToken			= "left"
+	toString RightAssocToken		= "right"
+	toString ClassToken				= "class"
+	toString InstanceToken			= "instance"
+	toString OtherwiseToken			= "otherwise"
+	toString IfToken				= "if"
+	toString WhereToken				= "where"
+	toString WithToken				= "with"
+	toString CaseToken				= "case"
+	toString OfToken				= "of"
+	toString (LetToken strict)
+		| strict	= "let!"
+					= "let"
+	toString (SeqLetToken strict)
+		| strict	= "#!"
+					= "#"
+	toString InToken					= "in"
+
+	toString DynamicToken				= "dynamic"
+	toString DynamicTypeToken			= "Dynamic"
+
+	toString (PriorityToken priority)	= toString priority
+	toString NewDefinitionToken			= "offside token (new def)"
+	toString EndGroupToken				= "offside token (end group)"
+	toString EndOfFileToken				= "end of file"
+	toString (ErrorToken id)			= "Scanner error: " + id
+	toString CodeToken					= "code"
+	toString InlineToken				= "inline"
+	toString (CodeBlockToken the_code)	= "<code block>"
+	toString token						= "toString (Token) does not know this token"
+
+instance == Token
+where
+	(==) token1 token2
+		= equal_constructor token1 token2 && equal_args_of_tokens token1 token2
+	where
+		equal_args_of_tokens :: !Token !Token -> Bool
+		equal_args_of_tokens (IdentToken id1)		(IdentToken id2)		= id1 == id2
+		equal_args_of_tokens (RealToken real1) 		(RealToken real2)		= real1 == real2
+		equal_args_of_tokens (StringToken string1)	(StringToken string2)	= string1 == string2
+		equal_args_of_tokens (CharToken char1)		(CharToken char2)		= char1 == char2
+		equal_args_of_tokens (CharListToken chars1)	(CharListToken chars2)	= chars1 == chars2
+		equal_args_of_tokens (BoolToken bool1)		(BoolToken bool2)		= bool1 == bool2
+		equal_args_of_tokens (IntToken int1)		(IntToken int2)			= int1 == int2
+		equal_args_of_tokens (LetToken l1)			(LetToken l2)			= l1 == l2
+		equal_args_of_tokens (SeqLetToken l1)		(SeqLetToken l2)		= l1 == l2
+		equal_args_of_tokens (ErrorToken id1)		(ErrorToken id2)		= id1 == id2
+		equal_args_of_tokens _						_						= True
+
+instance < Priority
+where
+	(<) (Prio assoc1 prio1) (Prio assoc2 prio2)
+		= prio1 < prio2 || prio1 == prio2 && assoc1 < assoc2
+	(<) _ _ = abort "< of these Priorities (NoPrio) is undefined"
+			
+instance < Assoc
+where
+	(<) _ LeftAssoc = True
+	(<) LeftAssoc _ = False
+	(<) _ _ = True
+			
+instance toString Priority
+where
+	toString (Prio assoc prio) = toString assoc + toString prio
+	toString NoPrio = "infix"
+	
+instance toString Assoc
+where
+	toString LeftAssoc 	= "infixl "
+	toString RightAssoc = "infixr "
+	toString NoAssoc	= "infix "
+	
+
+openScanner :: !String !SearchPaths !*Files -> (!Optional ScanState, !*Files)
+openScanner file_name searchPaths files
+	= case fopenInSearchPaths file_name searchPaths FReadData files of
+		(No, files)
+			->	(No, files)
+		(Yes file, files)
+			->  (Yes	{	ss_input 		= Input
+												{ inp_stream		= InFile file
+									 			, inp_filename		= file_name
+									 			, inp_pos			= {fp_line = 1, fp_col = 0}
+												, inp_tabsize		= 4
+												, inp_charBuffer	= Buffer0
+											//	, inp_curToken		= []
+												}
+						,	ss_offsides		=	[(1,False)] // to generate offsides between global definitions
+						,	ss_useLayout	=	False
+						,	ss_tokenBuffer	=	Buffer0
+						}
+				, files
+				)
+
+fopenInSearchPaths :: !{#Char} [!{#Char}] !Int !*f -> (Optional *File,!*f) | FileSystem f
+fopenInSearchPaths fileName [] mode f
+	=	(No, f)
+fopenInSearchPaths fileName [path : paths] mode f
+	# (opened, file, f)
+		=	fopen (path + fileName) mode f
+	| opened
+		=	(Yes file, f)
+	// otherwise
+		=	fopenInSearchPaths fileName paths mode f
+
+closeScanner :: !ScanState !*Files -> *Files
+closeScanner scanState=:{ss_input=PushedToken _ input} files
+	= closeScanner {scanState & ss_input = input} files 
+closeScanner {ss_input=Input {inp_stream}} files
+	= case get_file inp_stream of
+		Yes file	#	(_,files) = fclose file files
+					->	files
+		No			->	files
+where
+	get_file (InFile file)			= Yes file
+	get_file (OldChar _ _ stream)	= get_file stream
+	get_file (OldChars _ stream)	= get_file stream
+	get_file (OldToken _ stream)	= get_file stream
+	get_file (InLOC _ )				= No
+
+NewLineChar	:== '\n'
+LFChar		:== '\xA'
+CRChar		:== '\xD'
+
+//isNewLine c :== c == LFChar || c == CRChar
+isNewLine :: !Char -> Bool
+isNewLine LFChar = True
+isNewLine CRChar = True
+isNewLine _      = False
+
+  //------------------------//
+ //--- Offside handling ---//
+//------------------------//
+
+UseLayout :: !ScanState -> (!Bool, !ScanState)
+UseLayout scanState = scanState!ss_useLayout
+
+setUseLayout :: !Bool !ScanState -> ScanState
+setUseLayout b ss = { ss & ss_useLayout = b } // -->> ("uselayout set to ",b)
+
+checkOffside :: !FilePosition !Token !ScanState -> (Token,ScanState)
+checkOffside pos token scanState=:{ss_offsides,ss_useLayout,ss_input}
+	| ~ ss_useLayout
+		=	(token, scanState)  //-->> (token,pos,"No layout rule applied")
+	| isEmpty ss_offsides
+		=	newOffside token scanState  //-->> "Empty offside stack"
+	#	(os_col, new_def)	= hd ss_offsides
+		col					= pos.fp_col
+	| col == os_col && canBeOffside token
+		# scanState	= tokenBack scanState
+		  newToken	= NewDefinitionToken
+		= (	newToken
+		  ,	{ scanState
+			& ss_tokenBuffer
+				= store 
+					{	lt_position		= pos
+					,	lt_token		= newToken
+				//	,	lt_chars		= []
+				//	,	lt_context		= FunctionContext
+					}
+					scanState.ss_tokenBuffer
+			}
+		  )	-->> (token,"NewDefinitionToken generated col==os && canBeOffside",pos,ss_offsides)
+	| col < os_col && token <> InToken
+		# (n,os_col,offsides) = scan_offsides 0 col os_col ss_offsides
+		  scanState	= { scanState & ss_offsides = offsides } -->> (n,"end groups",offsides,new_def)
+		  scanState	= snd (newOffside token scanState)
+		  scanState	= case new_def && col == os_col && canBeOffside token of
+  						True
+							#	scanState	= tokenBack scanState
+								newToken	= NewDefinitionToken
+							->	{ scanState
+								& ss_tokenBuffer
+									= store 
+										{	lt_position		= pos
+										,	lt_token		= newToken
+									//	,	lt_chars		= []
+									//	,	lt_context		= FunctionContext
+										}
+										scanState.ss_tokenBuffer
+								} -->> ("new definition generated",token)
+  						False
+  							->	scanState
+		= gen_end_groups n scanState
+		with
+			newToken		= EndGroupToken
+			scan_offsides n col os_col []
+				= (n, os_col, [])
+			scan_offsides n col _ offsides=:[(os_col,b):r]
+				| col < os_col
+					= scan_offsides (inc n) col os_col r
+					= (n, os_col, offsides)
+			gen_end_groups n scanState
+		  	  #	scanState	= tokenBack scanState	// push current token back
+		  		scanState	=	{ scanState
+								& ss_tokenBuffer
+									= store 
+										{	lt_position		= pos
+										,	lt_token		= newToken
+									//	,	lt_chars		= []
+									//	,	lt_context		= FunctionContext
+										}
+										scanState.ss_tokenBuffer
+								} // insert EndGroupToken 
+			  | n == 1
+			// 	# (new_offsides, scanState) = scanState!ss_offsides // for tracing XXX
+			  	= (newToken, scanState) // -->> ("new offsides",new_offsides)
+			  	= gen_end_groups (dec n) scanState
+	| token == InToken
+		# scanState			= tokenBack { scanState & ss_offsides = tl ss_offsides }
+		  newToken			= EndGroupToken
+		= ( newToken
+		  , { scanState
+			& ss_tokenBuffer
+				= store 
+					{	lt_position		= pos
+					,	lt_token		= newToken
+				//	,	lt_chars		= []
+				//	,	lt_context		= FunctionContext
+					}
+					scanState.ss_tokenBuffer
+			}
+		  ) -->> (token,"EndGroupToken generated: in",pos,ss_offsides)
+	// otherwise
+		= newOffside token scanState
+where
+	newOffside token scanState=:{ss_offsides}
+	| definesOffside token
+		#	( _, scanState )		= nextToken FunctionContext scanState
+			( os_pos, scanState )	= getPosition scanState // next token defines offside position
+			scanState				= tokenBack scanState
+			os						= os_pos.fp_col
+		|	os == 1
+			#	scanState			= tokenBack scanState
+				newToken			= ErrorToken "groups should not start in column 1"
+			=	( newToken
+				, 	{ scanState
+					& ss_tokenBuffer
+						= store 
+							{	lt_position		= pos
+							,	lt_token		= newToken
+						//	,	lt_chars		= ['groups should not start in column 1']
+						//	,	lt_context		= FunctionContext
+							}
+							scanState.ss_tokenBuffer
+					}
+				)
+		// otherwise // os <> 1
+			=	( token
+				, { scanState
+				  & ss_offsides = [ (os, needsNewDefinitionToken token) : ss_offsides ]
+				  }
+				) -->> (token,pos,"New offside defined at ",os_pos,[ (os, token == CaseToken) : ss_offsides ])
+	// otherwise // ~ (definesOffside token)
+	= (token, scanState) -->> (token,pos," not offside")
+
+definesOffside :: !Token -> Bool
+definesOffside (LetToken _) 	= True
+definesOffside (SeqLetToken _)	= True
+definesOffside WhereToken		= True
+definesOffside WithToken		= True
+definesOffside SpecialToken		= True
+definesOffside OfToken			= True
+//definesOffside BarToken			= True // There are too many BarTokens in Clean
+definesOffside _				= False
+
+needsNewDefinitionToken :: !Token -> Bool
+needsNewDefinitionToken OfToken			= True
+//needsNewDefinitionToken WithToken		= True
+needsNewDefinitionToken SpecialToken	= True
+needsNewDefinitionToken _				= False
+/*
+repeatedOffside :: !Token -> Bool
+repeatedOffside BarToken		= True
+repeatedOffside EqualToken		= True
+repeatedOffside (SeqLetToken _)	= True
+repeatedOffside _				= False
+*/
+canBeOffside :: !Token -> Bool
+canBeOffside EqualToken			= False
+canBeOffside ColonDefinesToken	= False
+canBeOffside DefinesColonToken	= False
+canBeOffside (SeqLetToken _)	= False
+canBeOffside WhereToken			= False
+canBeOffside SpecialToken		= False
+canBeOffside WithToken			= False
+canBeOffside BarToken			= False
+//canBeOffside CurlyOpenToken		= False // not allowed for record patterns
+canBeOffside (CodeBlockToken _) = False
+canBeOffside _					= True
+
+dropOffsidePosition :: !ScanState -> ScanState
+dropOffsidePosition scanState=:{ss_offsides} = { scanState & ss_offsides = drop 1 ss_offsides }
+
+/*
+addOffsidePosition :: !ScanState -> (Int, ScanState)
+addOffsidePosition scanState=:{ss_useLayout}
+	| ss_useLayout
+		# (position,scanState=:{ss_offsides})	= getPosition scanState
+		  new_offside							= position.fp_col
+		= (new_offside, { scanState & ss_offsides = [(new_offside,False): ss_offsides] })
+	| otherwise
+		= (1, scanState)
+
+atOffsidePosition :: !ScanState -> (!Bool, !ScanState)
+atOffsidePosition scanState=:{ss_offsides=[(col,_):_]}
+	#	(position, scanState)	= getPosition scanState
+	=	(position.fp_col == col, scanState) -->> ("atOffsidePosition",position.fp_col,col)
+atOffsidePosition scanState
+	=	(False, scanState)
+*/
+  //-----------------------//
+ //--- Buffer handling ---//
+//-----------------------//
+
+store :: !x !(Buffer x) -> Buffer x
+store x  Buffer0        = Buffer1 x
+store x (Buffer1 y)     = Buffer2 x y
+store x (Buffer2 y z)   = Buffer3 x y z
+store x (Buffer3 y z _) = Buffer3 x y z
+
+isEmptyBuffer :: !(Buffer x) -> Bool
+isEmptyBuffer Buffer0 = True
+isEmptyBuffer _       = False
+
+get :: !(Buffer x) -> (x,Buffer x)
+get  Buffer0        = abort "get from empty buffer"
+get (Buffer1 x)     = (x, Buffer0)
+get (Buffer2 x y)   = (x, Buffer1 y)
+get (Buffer3 x y z) = (x, Buffer2 y z)
+
+head :: !(Buffer x) -> x
+head  Buffer0			= abort "head of empty buffer"
+head (Buffer1 x)		= x
+head (Buffer2 x _)		= x
+head (Buffer3 x _ _)	= x
+
+instance <<< (Buffer a) | <<< a
+where
+	(<<<) file  Buffer0			= file <<< "Empty buffer"
+	(<<<) file (Buffer1 x)		= file <<< "Buffer1 (" <<< x <<< ")"
+	(<<<) file (Buffer2 x y)	= file <<< "Buffer2 (" <<< x <<< ") (" <<< y <<< ")"
+	(<<<) file (Buffer3 x y z)	= file <<< "Buffer3 (" <<< x <<< ") (" <<< y <<< ") (" <<< z <<< ")"
+
+  //---------------//
+ //--- Tracing ---//
+//---------------//
+
+(-->>) val _ :== val
+//(-->>) val message :== val ---> ("Scanner",message)
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
new file mode 100644
index 0000000..6b0e72a
--- /dev/null
+++ b/frontend/syntax.dcl
@@ -0,0 +1,1192 @@
+definition module syntax
+
+import StdEnv
+
+import scanner, general, typeproperties, Heap
+
+::	Ident =
+	{ 	id_name		:: !String
+	,	id_info 	:: !SymbolPtr
+	}
+
+instance toString Ident
+
+
+/*	Each Identifier is equipped with a pointer to a SymbolTableEntry that is
+	used for binding the identifier with its definition.
+*/
+
+::	SymbolTable			:== Heap SymbolTableEntry
+::	SymbolPtr 			:== Ptr SymbolTableEntry
+
+::	SymbolTableEntry = 
+	{	ste_kind		:: !STE_Kind
+	,	ste_index		:: !Index
+	,	ste_def_level	:: !Level
+	,	ste_previous	:: SymbolTableEntry
+	}
+
+::	STE_BoundTypeVariable	= { stv_count :: !Int, stv_attribute :: !TypeAttribute, stv_info_ptr :: !TypeVarInfoPtr}
+
+::	STE_Kind	= STE_FunctionOrMacro ![Index]
+				| STE_Type
+				| STE_Constructor
+				| STE_Selector ![Global Index]
+				| STE_Field !Ident
+				| STE_Class
+				| STE_Member
+				| STE_Instance
+				| STE_Variable !VarInfoPtr
+				| STE_TypeVariable !TypeVarInfoPtr
+				| STE_TypeAttribute !AttrVarInfoPtr
+				| STE_BoundTypeVariable !STE_BoundTypeVariable
+				| STE_BoundType !AType
+				| STE_Imported !STE_Kind !Index
+				| STE_DclFunction
+				| STE_Module !(Module (CollectedDefinitions ClassInstance IndexRange))
+				| STE_OpenModule !Int !(Module (CollectedDefinitions ClassInstance IndexRange))
+				| STE_ClosedModule
+				| STE_LockedModule
+				| STE_Empty
+					/* for creating class dictionaries */
+				| STE_DictType !CheckedTypeDef
+				| STE_DictCons !ConsDef
+				| STE_DictField !SelectorDef
+				| STE_Called ![Index] /* used during macro expansion to indicate that this function is called */
+
+::	Global object =
+	{	glob_object	:: !object
+	,	glob_module	:: !Index
+	}
+	
+::	Module defs = 
+	{	mod_name		:: !Ident
+	,	mod_type		:: !ModuleKind
+	, 	mod_imports		:: ![ParsedImport]
+// RWS ...
+	,	mod_imported_objects :: ![ImportedObject]
+// ... RWS
+//	,	mod_exports 	:: ![Export]
+	,	mod_defs		:: !defs
+	}
+
+::	ParsedModule	:== Module  [ParsedDefinition]
+::	ScannedModule 	:== Module  (CollectedDefinitions (ParsedInstance FunDef) IndexRange)
+
+	
+::	ModuleKind		= MK_Main | MK_Module | MK_System | MK_None
+
+::	RhsDefsOfType	= ConsList ![ParsedConstructor]
+					| SelectorList !Ident ![ATypeVar] ![ParsedSelector]
+					| TypeSpec !AType
+					| EmptyRhs !BITVECT
+
+
+::	CollectedDefinitions instance_kind macro_defs =
+	{	def_types 			:: ![TypeDef TypeRhs]
+	,	def_constructors	:: ![ParsedConstructor]
+	,	def_selectors		:: ![ParsedSelector]
+	,	def_macros			:: !macro_defs
+	,	def_classes			:: ![ClassDef]
+	,	def_members			:: ![MemberDef]
+	,	def_funtypes		:: ![FunType]
+	,	def_instances		:: ![instance_kind]
+	}
+
+::	LocalDefs	= LocalParsedDefs [ParsedDefinition]
+				| CollectedLocalDefs CollectedLocalDefs
+
+::	IndexRange	= { ir_from :: !Index, ir_to :: !Index }
+
+::  Index	:== Int
+NoIndex		:== -1
+
+
+::  Level	:== Int
+NotALevel 	:==  -1
+
+::	CollectedLocalDefs =
+	{	loc_functions	:: !IndexRange
+	,	loc_nodes		:: ![(Optional SymbolType, NodeDef ParsedExpr)]
+	}
+
+::	NodeDef dst =
+	{	nd_dst		::!dst,
+		nd_alts		::!OptGuardedAlts,
+		nd_locals	::!LocalDefs
+	}
+
+::	Rhs =
+	{	rhs_alts	:: !OptGuardedAlts
+	,	rhs_locals	:: !LocalDefs
+	}
+
+
+cIsAFunction	:== True
+cIsNotAFunction :== False
+
+::	ParsedDefinition 
+	=	PD_Function  Position Ident Bool [ParsedExpr] Rhs FunKind
+	|	PD_NodeDef  Position ParsedExpr Rhs
+	|	PD_Type ParsedTypeDef
+	|	PD_TypeSpec Position Ident Priority (Optional SymbolType) Specials
+	|	PD_Class ClassDef [ParsedDefinition]
+	|	PD_Instance (ParsedInstance ParsedDefinition)
+	|	PD_Instances [ParsedInstance ParsedDefinition]
+	|	PD_Import [ParsedImport]
+// RWS ...
+	|	PD_ImportedObjects [ImportedObject]
+// ... RWS
+	|	PD_Erroneous
+
+::	FunKind	= FK_Function | FK_Macro | FK_Caf | FK_Unknown
+
+::	ParsedSelector =
+	{	ps_field_name		:: !Ident
+	,	ps_selector_name	:: !Ident
+	,	ps_field_type		:: !AType
+	,	ps_field_var		:: !Ident
+	,	ps_field_pos		:: !Position
+	}
+
+::	ParsedConstructor =
+	{	pc_cons_name 	:: !Ident
+	,	pc_cons_arity	:: !Int
+	,	pc_exi_vars		:: ![ATypeVar]
+	,	pc_arg_types	:: ![AType]
+	,	pc_cons_prio	:: !Priority
+	,	pc_cons_pos		:: !Position
+	}
+	
+::	ParsedInstance member =
+	{	pi_class 	:: !Ident
+	,	pi_ident	:: !Ident
+	,	pi_types	:: ![Type]
+	,	pi_context	:: ![TypeContext]
+	,	pi_pos		:: !Position
+	,	pi_members	:: ![member]
+	,	pi_specials	:: !Specials
+	}
+
+/*
+	Objects of type Specials are used to specify specialized instances of overloaded functions.
+	These can only occur in definition modules. After parsing the SP_ParsedSubstitutions alternative
+	is used to indicate the specific instantiation. The SP_Substitutions alternative is used to deduce
+	the type of the specialized version. Finally the SP_ContextTypes alternative is set and used during 
+	the typing to check whether the this instance has been used. The auxiliary SP_Index alternative is used
+	to store the index of the function that has been specialized.
+*/
+
+
+::	Specials
+	= SP_ParsedSubstitutions 	![Env Type TypeVar]
+	| SP_Substitutions 		 	![SpecialSubstitution]
+	| SP_ContextTypes			![Special]
+	| SP_FunIndex				!Index
+	| SP_TypeOffset				!Int
+	| SP_None
+
+::	SpecialSubstitution =
+	{	ss_environ	:: !Env Type TypeVar
+	,	ss_context	:: ![TypeContext]
+	,	ss_vars		:: ![TypeVar]
+	,	ss_attrs	:: ![AttributeVar]
+	}
+
+::	Special =
+	{	spec_index	:: !Global Index
+	,	spec_types	:: ![[Type]]
+	,	spec_vars	:: ![TypeVar]
+	, 	spec_attrs	:: ![AttributeVar]
+	}
+
+::	AttrInequality =
+	{	ai_demanded :: !AttributeVar
+	,	ai_offered	:: !AttributeVar
+	}
+
+
+::	DefinedSymbol = 
+	{	ds_ident		:: !Ident
+	,	ds_arity		:: !Int
+	,	ds_index		:: !Index
+	}
+
+::	ClassDef =
+ 	{	class_name			:: !Ident
+	,	class_arity			:: !Int
+	,	class_args			:: ![TypeVar]
+	,	class_context		:: ![TypeContext]
+	,	class_members		:: !{# DefinedSymbol}
+	,	class_dictionary	:: !DefinedSymbol
+	,	class_pos			:: !Position
+	,	class_cons_vars		:: !BITVECT
+	}
+
+::	MemberDef =
+	{	me_symb			:: !Ident
+	,	me_class		:: !Global Index
+	,	me_offset		:: !Index
+	,	me_type			:: !SymbolType
+	,	me_type_ptr		:: !VarInfoPtr
+	,	me_class_vars	:: ![TypeVar]
+	,	me_pos			:: !Position
+	,	me_priority 	:: !Priority
+	}
+
+::	InstanceType =
+	{	it_vars			:: [TypeVar]
+	,	it_types		:: ![Type]
+	,	it_attr_vars	:: [AttributeVar]
+	,	it_context		:: ![TypeContext]
+	}
+
+::	ClassInstance =
+ 	{	ins_class		:: !Global DefinedSymbol
+	,	ins_ident		:: !Ident
+	,	ins_type		:: !InstanceType
+	,	ins_members		:: !{# DefinedSymbol}
+	,	ins_specials	:: !Specials
+	,	ins_pos			:: !Position
+	}
+
+/*
+::	Export =
+	{	export_class	:: Ident
+	,	export_types	:: [Type]
+	}
+*/
+::	Import from_symbol =
+	{	import_module		:: !Ident
+	,	import_symbols		:: ![from_symbol]
+	,	import_file_position:: !(!FileName, !Int)	// for error messages // MW++
+	}
+
+instance toString (Import from_symbol), AttributeVar, TypeAttribute, Annotation
+
+::	ParsedImport		:== Import ImportDeclaration
+
+::	ImportedIdent =
+	{	ii_ident	:: !Ident
+	,	ii_extended	:: !Bool
+	}
+
+::	ImportDeclaration	= ID_Function !ImportedIdent
+						| ID_Class !ImportedIdent !(Optional [ImportedIdent])
+						| ID_Type !ImportedIdent !(Optional [ImportedIdent])
+						| ID_Record !ImportedIdent !(Optional [ImportedIdent])
+						| ID_Instance !ImportedIdent !Ident !(![Type],![TypeContext])
+
+/* MOVE 
+::	ExplicitImports	:==	(![AtomicImport], ![StructureImport])
+::	AtomicImport	:==	(!Ident, !AtomType)
+::	StructureImport	:==	(!Ident, !StructureInfo, !StructureType, !OptimizeInfo)
+
+::	AtomType		=	AT_Function | AT_Class | AT_Instance | AT_RecordType | AT_AlgType | AT_Type
+
+::	StructureInfo	= SI_DotDot
+					// The .. notation was used for the structure
+					// (currently nothing is known about the elements)
+					| SI_Elements ![Ident] !Bool
+					// list of elements, that were not imported yet.
+					// Bool: the elements were listed explicitly in the structure
+::	StructureType	= ST_AlgType | ST_RecordType | ST_Class
+
+::	IdentWithKind	:==	(!Ident, !STE_Kind)
+::	IdentWithCKind	:==	(!Ident, !ConsequenceKind)
+
+::	OptimizeInfo	:==	(Optional !Index)
+*/
+
+// RWS ...
+cIsImportedLibrary :== True
+cIsImportedObject :== False
+:: ImportedObject =
+	{	io_is_library :: !Bool
+	,	io_name    :: !{#Char}
+	}
+// ... RWS 
+
+::	RecordType =
+	{	rt_constructor	:: !DefinedSymbol
+	,	rt_fields		:: !{# FieldSymbol}
+	}
+	
+::	FieldSymbol =
+	{	fs_name			:: !Ident
+	,	fs_var			:: !Ident
+	,	fs_index		:: !Index
+	}
+
+::	TypeRhs	= AlgType ![DefinedSymbol]
+			| SynType !AType
+			| RecordType !RecordType
+			| AbstractType !BITVECT
+			| UnknownType
+
+::	ParsedTypeDef	:== TypeDef RhsDefsOfType
+::	CheckedTypeDef	:== TypeDef TypeRhs
+
+/*
+cIsHyperStrict		:== True
+cIsNotHyperStrict	:== False
+*/
+
+cAllBitsClear			:== 0
+
+cIsHyperStrict			:== 1
+cIsNonCoercible			:== 2
+// cMayBeNonCoercible		:== 4
+
+::	TypeDef type_rhs =
+ 	{	td_name			:: !Ident
+	,	td_index		:: !Int
+	,	td_arity		:: !Int
+	,	td_args			:: ![ATypeVar]
+	,	td_attrs		:: ![AttributeVar]
+	,	td_context		:: ![TypeContext]
+	,	td_rhs			:: !type_rhs
+	,	td_attribute	:: !TypeAttribute
+	,	td_pos			:: !Position
+	}
+
+::	TypeDefInfo =
+	{	tdi_kinds			:: ![TypeKind]
+	,	tdi_properties		:: !BITVECT
+	,	tdi_group			:: ![Global Index]
+	,	tdi_group_nr		:: !Int
+	,	tdi_group_vars		:: ![Int]
+	,	tdi_cons_vars		:: ![Int]
+	,	tdi_classification	:: !TypeClassification
+	}
+
+::	TypeDefInfos :== {# .{# TypeDefInfo}}
+
+::	FunType =
+	{	ft_symb			:: !Ident
+	,	ft_arity		:: !Int
+	,	ft_priority		:: !Priority
+	,	ft_type			:: !SymbolType
+	,	ft_pos			:: !Position
+	,	ft_specials		:: !Specials
+	,	ft_type_ptr		:: !VarInfoPtr
+	}
+
+::	FreeVar =
+	{	fv_def_level	:: !Level
+	,	fv_name			:: !Ident
+	,	fv_info_ptr		:: !VarInfoPtr
+//	,	fv_expr_ptr		:: !ExprInfoPtr
+	,	fv_count		:: !Int
+	}
+	
+::	FunCall =
+	{	fc_level	:: !Level
+	,	fc_index	:: !Index
+	}
+
+::	FunInfo =
+	{	fi_calls			:: ![FunCall]
+	,	fi_group_index		:: !Index
+	,	fi_def_level		:: !Level
+	,	fi_free_vars		:: ![FreeVar]
+	,	fi_local_vars		:: ![FreeVar]
+	,	fi_dynamics			:: ![ExprInfoPtr]
+	}
+
+::	ParsedBody =
+	{	pb_args	:: ![ParsedExpr]
+	,	pb_rhs	:: !Rhs
+	}
+
+::	CheckedBody =
+	{	cb_args			:: ![FreeVar]
+	,	cb_rhs			:: ![Expression]
+	}
+
+::	TransformedBody =
+	{	tb_args			:: ![FreeVar]
+	,	tb_rhs			:: !Expression
+	}
+
+::	FunctionBody	= ParsedBody ![ParsedBody]
+					| CheckedBody !CheckedBody
+	/* The next three constructors are used during macro expansion (module transform) */
+					| PartioningMacro
+					| PartioningFunction !CheckedBody !Int
+					| RhsMacroBody !CheckedBody
+	/* macro expansion transforms a CheckedBody into a TransformedBody */
+					| TransformedBody !TransformedBody
+					| Expanding
+					| BackendBody ![BackendBody]
+					
+::	BackendBody =
+	{	bb_args	:: ![FunctionPattern]
+	,	bb_rhs	:: !Expression
+	}
+
+::	FunDef =
+	{	fun_symb		:: !Ident
+	,	fun_arity		:: !Int
+	,	fun_priority	:: !Priority
+	,	fun_body		:: !FunctionBody
+	,	fun_type		:: !Optional SymbolType
+	,	fun_pos			:: !Position
+	,	fun_index		:: !Int
+	,	fun_kind		:: !FunKind
+	,	fun_lifted		:: !Int
+//	,	fun_type_ptr	:: !TypeVarInfoPtr
+	,	fun_info		:: !FunInfo
+	}
+
+cIsAGlobalVar	:== True
+cIsALocalVar	:== False
+
+::	ConsClasses =
+	{	cc_size	::!Int
+	,	cc_args	::![ConsClass]
+	}
+					
+::	ConsClass	:== Int
+
+::	OptionalVariable :== Optional (Bind Ident VarInfoPtr)
+
+:: 	AuxiliaryPattern
+		= AP_Algebraic !(Global DefinedSymbol) !Index [AuxiliaryPattern] OptionalVariable
+		| AP_Variable !Ident !VarInfoPtr OptionalVariable
+		| AP_Basic !BasicValue OptionalVariable
+		| AP_Dynamic !AuxiliaryPattern !DynamicType !OptionalVariable
+		| AP_Constant !AP_Kind !(Global DefinedSymbol) !Priority
+		| AP_WildCard OptionalVariable
+		| AP_Empty !Ident
+
+:: AP_Kind = APK_Constructor !Index | APK_Macro
+
+::	VarInfo  =	VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar (!Ident, ![Int]) |
+				VI_Expression !Expression | VI_Variable !Ident !VarInfoPtr | VI_LiftedVariable !VarInfoPtr |
+				VI_Count !Int /* the reference count of a variable */ !Bool /* true if the variable is global, false otherwise */ |
+				VI_AccVar !ConsClass /* used during fusion to determine accumulating parameters of functions */ |
+				VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
+				 /* used during elimination and lifting of cases */
+				VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
+				VI_Forward !BoundVar | VI_LetVar !LetVarInfo | VI_LetExpression !LetExpressionInfo | VI_CaseVar !VarInfoPtr |
+				VI_CorrespondenceNumber !Int | VI_SequenceNumber !Int |
+				VI_Used | /* for indicating that an imported function has been used */
+				VI_PropagationType !SymbolType | /* for storing the type with propagation environment of an imported function */
+				VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */
+				VI_Record ![AuxiliaryPattern] |
+				VI_Pattern !AuxiliaryPattern |
+				VI_Default !Int /* used during conversion of dynamics; the Int indiacted the refenrence count */
+
+::	VarInfoPtr	:== Ptr VarInfo
+
+::	LetVarInfo =
+	{	lvi_count		:: !Int
+	,	lvi_depth		:: !Int
+	,	lvi_new			:: !Bool
+	,	lvi_var			:: !Ident
+	,	lvi_expression	:: !Expression	
+	,   lvi_previous	:: ![PreviousLetVarInfo]
+	}
+
+::	PreviousLetVarInfo =
+	{	plvi_count		:: !Int
+	,	plvi_depth		:: !Int
+	,	plvi_new		:: !Bool
+	}
+
+::	LetExpressionStatus	= LES_Untouched | LES_Moved | LES_Updated !Expression
+
+::	LetExpressionInfo =
+	{	lei_count			:: !Int
+	,	lei_depth			:: !Int 
+	,	lei_strict			:: !Bool 
+	,	lei_var				:: !FreeVar 
+	,   lei_expression		:: !Expression
+//	,	lei_moved			:: !Bool 
+//	,   lei_updated_expr	:: !Optional Expression
+	,   lei_status			:: !LetExpressionStatus
+	,   lei_type			:: !AType
+	}
+
+cNotVarNumber :== -1
+
+::	BoundVar = 
+	{	var_name		:: !Ident
+	,	var_info_ptr	:: !VarInfoPtr
+	,	var_expr_ptr	:: !ExprInfoPtr
+	}
+
+/*
+cRecursiveAppl		:== True
+cNonRecursiveAppl	:== False	
+
+::	ApplicationKind	:== Bool
+*/
+ 
+::	TypeSymbIdent =
+	{	type_name		:: !Ident
+//	,	type_appl_kind	:: !ApplicationKind
+	,	type_arity		:: !Int
+	,	type_index		:: !Global Index
+	,	type_prop		:: !TypeSymbProperties
+	}
+
+::	TypeSymbProperties =
+	{	tsp_sign		:: !SignClassification
+	,	tsp_propagation	:: !PropClassification
+	,	tsp_coercible	:: !Bool
+	}
+
+::	SymbKind	= SK_Unknown
+				| SK_Function !(Global Index)
+				| SK_OverloadedFunction !(Global Index)
+				| SK_Constructor !(Global Index)
+				| SK_Macro !(Global Index)
+//				| SK_RecordSelector !(Global Index)
+				| SK_GeneratedFunction !FunctionInfoPtr !Index
+				| SK_TypeCode
+
+// MW2 moved some type definitions
+
+/*	Some auxiliary type definitions used during fusion. Actually, these definitions
+	should have been given in seperate module. Unfortunately, Clean's module system
+	forbids cyclic dependencies between def modules.
+	
+*/
+
+::	FunctionHeap 	:== Heap FunctionInfo
+
+::	FunctionInfoPtr	:== Ptr FunctionInfo
+
+::	FunctionInfo	= FI_Empty | FI_Function !GeneratedFunction
+
+::	Producer	= PR_Empty
+				| PR_Function !SymbIdent !Index
+				| PR_Class !App ![BoundVar] ![Type]
+//				| PR_Constructor !SymbIdent ![Expression]
+				| PR_GeneratedFunction !SymbIdent !Index
+
+::	InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo
+
+::	GeneratedFunction = 
+	{	gf_fun_def			:: !FunDef
+	,	gf_instance_info	:: !InstanceInfo
+	,	gf_cons_args		:: !ConsClasses
+	,	gf_fun_index		:: !Index
+	}
+	
+/*	... main type definitions continued .... */
+
+::	ExpressionHeap 	:== Heap ExprInfo
+
+::	ExprInfoPtr		:== Ptr ExprInfo
+
+::	TempLocalVar	:== Int
+
+::	DynamicPtr		:== ExprInfoPtr
+
+::	ExprInfo		= EI_Empty
+
+		/* For handling overloading */
+
+					| EI_Overloaded !OverloadedCall 						/* initial, set by the type checker */
+					| EI_Instance 	!(Global DefinedSymbol) ![Expression]	/* intermedediate, used during resolving of overloading */ 
+					| EI_Selection 	![Selection] !BoundVar ![Expression]	/* intermedediate, used during resolving of overloading */
+					| EI_Context 	![Expression]							/* intermedediate, used during resolving of overloading */
+
+		/* For handling dynamics */
+
+					| EI_Dynamic 				!(Optional DynamicType)
+					| EI_DynamicType			!DynamicType ![DynamicPtr]
+//					| EI_DynamicType			!DynamicType !(Optional ExprInfoPtr)
+
+		/* Auxiliary, was EI_DynamicType before checking */
+
+					| EI_DynamicTypeWithVars	![TypeVar] !DynamicType ![DynamicPtr]				
+//					| EI_DynamicTypeWithVars	![TypeVar] !DynamicType !(Optional ExprInfoPtr)			
+
+		/* Auxiliary, used during type checking */
+
+					| EI_TempDynamicType 		!(Optional DynamicType) !AType ![TypeContext] !ExprInfoPtr !SymbIdent
+//					| EI_TempDynamicPattern 	![TypeVar] !DynamicType !(Optional ExprInfoPtr) ![TempLocalVar] !AType ![TypeContext] !ExprInfoPtr !SymbIdent
+					| EI_TempDynamicPattern 	![TypeVar] !DynamicType ![DynamicPtr] ![TempLocalVar] !AType ![TypeContext] !ExprInfoPtr !SymbIdent
+					
+					| EI_TypeOfDynamic 			![VarInfoPtr] !TypeCodeExpression				/* Final */
+					| EI_TypeOfDynamicPattern 	![VarInfoPtr] !TypeCodeExpression				/* Final */
+
+					| EI_TypeCode 		!TypeCodeExpression
+					| EI_TypeCodes 		![TypeCodeExpression]
+
+					| EI_Attribute !Int
+
+
+		/* EI_ClassTypes is used to store the instance types of a class These type are used during fusion to generate proper types for 
+		   the fusion result (i.e. the resulting function after elimination of dictionaries) */
+
+					| EI_ClassTypes ![Type]
+					| EI_CaseType !CaseType
+					| EI_LetType ![AType]
+					| EI_CaseTypeAndRefCounts !CaseType !RefCountsInCase
+					| EI_LetTypeAndRefCounts ![AType] ![Int]
+
+		/* for converting case into function patterns the following auxiliary constuctors are used */
+
+					| EI_Default !Expression !AType !ExprInfoPtr
+					| EI_DefaultFunction !SymbIdent ![Expression]
+
+::	RefCountsInCase = 
+	{	rcc_all_variables		:: ![CountedVariable]
+	,	rcc_default_variables	:: ![CountedVariable]
+	,	rcc_pattern_variables	:: ![[CountedVariable]]
+	}
+
+::	CountedVariable =
+	{	cv_variable	:: !VarInfoPtr
+	,	cv_count	:: !Int
+	}
+
+/*
+::	UnboundVariable =
+	{	free_name		:: !Ident
+	,	free_info_ptr	:: !VarInfoPtr
+	,	free_selections	:: ![Int]
+	}
+*/
+
+/*
+	OverloadedCall contains (type) information about functions that are overloaded. This structure is built during type checking
+	and used after (standard) unification to insert the proper instances of the corresponding functions.
+
+*/
+
+::	OverloadedCall = 
+	{	oc_symbol	:: !SymbIdent
+	,	oc_context	:: ![TypeContext]
+	,	oc_specials	:: ![Special]
+	}
+
+/*
+	CaseType contains the type information needed to type the corresponding case construct:
+		ct_pattern_type : the type of the pattern
+		ct_result_type  : the type of the result (of each pattern)
+		ct_cons_types   : the types of the arguments of each pattern constructor
+*/
+		
+::	CaseType =
+	{	ct_pattern_type	:: !AType
+	,	ct_result_type	:: !AType
+	,	ct_cons_types 	:: ![[AType]]
+	}
+		
+::	SymbIdent =
+	{	symb_name		:: !Ident
+	,	symb_kind		:: !SymbKind
+	,	symb_arity		:: !Int
+	}
+
+::	ConsDef =
+	{	cons_symb			:: !Ident
+	,	cons_type			:: !SymbolType
+	,	cons_arg_vars		:: ![[ATypeVar]]
+	,	cons_priority		:: !Priority
+	,	cons_index			:: !Index
+	,	cons_type_index		:: !Index
+	,	cons_exi_vars		:: ![ATypeVar]
+//	,	cons_exi_attrs		:: ![AttributeVar]
+	,	cons_type_ptr		:: !VarInfoPtr
+	,	cons_pos			:: !Position
+	}
+
+::	SelectorDef =
+	{	sd_symb			:: !Ident
+	,	sd_field		:: !Ident
+	,	sd_type			:: !SymbolType
+	,	sd_exi_vars		:: ![ATypeVar]
+//	,	sd_exi_attrs	:: ![AttributeVar]
+	,	sd_field_nr		:: !Int
+	,	sd_type_index	:: !Int
+	,	sd_type_ptr		:: !VarInfoPtr
+	,	sd_pos			:: !Position
+	}
+
+::	SymbolType =
+	{	st_vars			:: ![TypeVar]
+	,	st_args			:: ![AType]
+	,	st_arity		:: !Int
+	,	st_result		:: !AType
+	,	st_context		:: ![TypeContext]
+	,	st_attr_vars	:: ![AttributeVar]
+	,	st_attr_env		:: ![AttrInequality]
+	}
+
+::	TypeContext =
+	{	tc_class	:: !Global DefinedSymbol
+	,	tc_types	:: ![Type]
+	,	tc_var		:: !VarInfoPtr
+	}
+
+::	AType =
+	{	at_attribute	:: !TypeAttribute
+	,	at_annotation	:: !Annotation
+	,	at_type			:: !Type
+	}
+	
+::	TempAttrId		:== Int
+::	TempVarId		:== Int
+
+
+::	Type	=	TA !TypeSymbIdent ![AType]
+			|	(-->) infixr 9 !AType !AType
+			|	(:@:) infixl 9 !ConsVariable ![AType]
+			|	TB !BasicType
+
+//			|	TFA [ATypeVar] Type
+
+			| 	GTV !TypeVar
+			| 	TV !TypeVar
+			|	TempV !TempVarId				/* Auxiliary, used during type checking */
+
+			
+			|	TQV	TypeVar
+			|	TempQV !TempVarId				/* Auxiliary, used during type checking */
+
+			|	TLifted !TypeVar				/* Auxiliary, used during type checking of lifted arguments */
+			|	TE
+
+::	ConsVariable = CV 		!TypeVar
+				 | TempCV 	!TempVarId
+				 | TempQCV 	!TempVarId
+
+::	DynamicType =
+	{	dt_uni_vars 	:: ![ATypeVar]
+	,	dt_global_vars	:: ![TypeVar]
+	,	dt_type			:: !AType
+	}
+
+::	KindHeap	:== Heap KindInfo
+::	KindInfoPtr	:== Ptr KindInfo
+
+::	KindInfo	= KI_Var !KindInfoPtr
+				| KI_Indirection !KindInfo
+				| KI_Arrow ![KindInfo]
+				| KI_Const
+				
+				| KI_ConsVar
+				
+				| KI_VarBind !KindInfoPtr
+				| KI_NormVar !Int
+
+::	TypeVarInfo  	= TVI_Empty
+					| TVI_Type !Type
+					| TVI_Forward !TempVarId | TVI_TypeKind !KindInfoPtr
+					| TVI_SignClass !Index !SignClassification !TypeVarInfo | TVI_PropClass !Index !PropClassification !TypeVarInfo
+					| TVI_Attribute TypeAttribute
+					| TVI_CorrespondenceNumber !Int
+					| TVI_Used /* to administer that this variable is encountered (in checkOpenTypes) */
+//					| TVI_Clean !Int /* to keep the unique number that has been assigned to this variable during 'clean_up' */
+					| TVI_TypeCode !TypeCodeExpression
+
+::	TypeVarInfoPtr	:== Ptr TypeVarInfo
+::	TypeVarHeap 	:== Heap TypeVarInfo
+
+::	AttrVarInfo  	=	AVI_Empty | AVI_Attr !TypeAttribute | AVI_Forward !TempAttrId
+::	AttrVarInfoPtr	:== Ptr AttrVarInfo
+::	AttrVarHeap 	:== Heap AttrVarInfo
+
+::	TypeHeaps =
+	{	th_vars		:: ! .TypeVarHeap
+	,	th_attrs	:: ! .AttrVarHeap
+	}
+
+::	TypeVar =
+	{	tv_name				:: !Ident
+	,	tv_info_ptr			:: !TypeVarInfoPtr
+	}
+
+::	ATypeVar =
+	{	atv_attribute		:: !TypeAttribute
+	,	atv_annotation		:: !Annotation
+	,	atv_variable		:: !TypeVar
+	}
+
+::	TypeAttribute = TA_Unique | TA_Multi | TA_Var !AttributeVar | TA_RootVar !AttributeVar | TA_TempVar !Int  /* | TA_TempExVar !Int */
+				  | TA_Anonymous | TA_None | TA_List !Int !TypeAttribute | TA_Omega
+
+::	AttributeVar =
+	{	av_name			:: !Ident
+	,	av_info_ptr		:: !AttrVarInfoPtr
+	}
+
+::	Annotation	=  AN_Strict | AN_None 
+
+::	BasicType	= BT_Int | BT_Char | BT_Real | BT_Bool | BT_Dynamic
+				| BT_File | BT_World
+				| BT_String !Type /* the internal string type synonym only used to type string denotations */
+
+::	BasicValue	= BVI !String | BVC !String | BVB !Bool | BVR !String | BVS !String
+
+
+::	TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow !Int
+
+/* A few obscure type definitions */
+
+::	Occurrence =
+	{	occ_ref_count	:: !ReferenceCount
+//	,	occ_aliases		:: ![[(FreeVar,Int)]]
+//	,	occ_expression	:: !Expression
+	,	occ_bind		:: !OccurrenceBinding
+	,	occ_observing	:: !Bool
+//	,	occ_attribute	:: !ExprInfoPtr
+	,	occ_previous 	:: ![ReferenceCount]
+	}
+
+::	ReferenceCount = RC_Used !RC_Used | RC_Unused 
+
+::	SelectiveUse = { su_field :: !Int, su_multiply :: ![ExprInfoPtr], su_uniquely :: ![ExprInfoPtr]  }
+
+::	RC_Used = { rcu_multiply :: ![ExprInfoPtr], rcu_selectively :: ![SelectiveUse], rcu_uniquely :: ![ExprInfoPtr] }
+
+::	OccurrenceBinding	= OB_Empty | OB_OpenLet !Expression | OB_LockedLet !Expression
+						| OB_Pattern ![(FreeVar, Int)] !OccurrenceBinding
+//						| OB_Closed !LetOccurrences | OB_Marked !LetOccurrences
+
+/*
+::	LetOccurrences =
+	{	lo_used_lets		:: ![FreeVar]
+	,	lo_free_variables	:: ![(FreeVar, ReferenceCount)]
+	}
+*/
+::	OptGuardedAlts	= GuardedAlts ![GuardedExpr] !(Optional ExprWithLocalDefs)
+				 	| UnGuardedExpr !ExprWithLocalDefs
+
+::	GuardedExpr =
+	{	alt_nodes	:: ![NodeDefWithLocals]
+	,	alt_guard	:: !ParsedExpr
+	,	alt_expr	:: !OptGuardedAlts
+	}
+
+::	ExprWithLocalDefs = 
+	{	ewl_nodes	:: ![NodeDefWithLocals]
+	,	ewl_expr	:: !ParsedExpr
+	,	ewl_locals	:: !LocalDefs
+	}
+
+::	NodeDefWithLocals =
+	{	ndwl_strict	:: !Bool
+	,	ndwl_def	:: !Bind ParsedExpr ParsedExpr
+	,	ndwl_locals	:: !LocalDefs
+	}
+
+::	CaseAlt =
+	{	calt_pattern	:: !ParsedExpr
+	,	calt_rhs		:: !Rhs
+	}
+	
+:: LocalDef		:== ParsedDefinition
+
+cUniqueSelection	:== True
+cNonUniqueSelection	:== False
+
+::	ParsedExpr	= PE_List ![ParsedExpr]
+				| PE_Ident !Ident
+				| PE_Basic !BasicValue
+				| PE_Bound !BoundExpr
+				| PE_Lambda !Ident ![ParsedExpr] !ParsedExpr
+				| PE_Tuple ![ParsedExpr]				
+				| PE_Record !ParsedExpr !(Optional Ident) ![FieldAssignment]
+				| PE_Array  !ParsedExpr ![ElemAssignment] ![Qualifier] 
+				| PE_ArrayDenot ![ParsedExpr]
+				| PE_Selection !Bool !ParsedExpr ![ParsedSelection]
+				| PE_Update !ParsedExpr [ParsedSelection] ParsedExpr
+				| PE_Case !Ident !ParsedExpr [CaseAlt]
+				| PE_If !Ident !ParsedExpr !ParsedExpr !ParsedExpr
+				| PE_Let !Bool !LocalDefs !ParsedExpr
+				| PE_Compr !GeneratorKind !ParsedExpr ![Qualifier]
+				| PE_Sequ Sequence
+				| PE_WildCard
+				| PE_Field !ParsedExpr !(Global FieldSymbol) /* Auxiliary, used during checking */
+
+				| PE_ABC_Code ![String] !Bool
+				| PE_Any_Code !(CodeBinding Ident) !(CodeBinding Ident) ![String]
+
+				| PE_DynamicPattern !ParsedExpr !DynamicType
+				| PE_Dynamic !ParsedExpr !(Optional DynamicType)
+				| PE_Empty
+
+::	ParsedSelection	= PS_Record !Ident !(Optional Ident)
+					| PS_Array  !ParsedExpr
+					| PS_Erroneous
+
+::	GeneratorKind :== Bool
+
+cIsListGenerator 	:== True
+cIsArrayGenerator	:== False
+			
+::	Generator =
+	{	gen_kind	:: !GeneratorKind
+	,	gen_pattern :: !ParsedExpr
+	,	gen_expr	:: !ParsedExpr
+	,	gen_var		:: !Ident
+	}
+
+::	Qualifier	=
+	{	qual_generators	:: ![Generator]
+	,	qual_filter		:: !Optional ParsedExpr
+	,	qual_fun_id		:: !Ident
+	}
+
+::	Sequence	= SQ_FromThen ParsedExpr ParsedExpr
+				| SQ_FromThenTo ParsedExpr ParsedExpr ParsedExpr
+				| SQ_From ParsedExpr
+				| SQ_FromTo ParsedExpr ParsedExpr
+
+::	BoundExpr	:== Bind ParsedExpr Ident
+
+::	FieldAssignment :== Bind ParsedExpr Ident
+
+::	ElemAssignment :== Bind ParsedExpr ParsedExpr
+
+
+cIsStrict		:== True
+cIsNotStrict	:== False
+
+/*
+::	SelectorKind	= SEK_Normal | SEK_First | SEK_Next | SEK_Last
+
+::	ArraySelector	= DictionarySelection !(Global DefinedSymbol) !Int !Expression
+					| SelectorInstance !(Global DefinedSymbol)
+*/
+::	Expression	= Var !BoundVar 
+				| App !App
+				| (@) infixl 9  !Expression ![Expression]
+				| Let !Let
+				| Case !Case
+//				| RecordSelect !SelectorKind !(Global DefinedSymbol) !Int !Expression
+//				| ArraySelect !SelectorKind !ArraySelector !Expression !Expression
+				| Selection !(Optional (Global DefinedSymbol)) !Expression ![Selection]
+				| Update !Expression ![Selection] Expression
+				| RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)]
+				| TupleSelect !DefinedSymbol !Int !Expression
+				| Lambda .[FreeVar] !Expression
+				| BasicExpr !BasicValue !BasicType
+				| WildCard
+				| Conditional !Conditional
+
+				| AnyCodeExpr !(CodeBinding BoundVar) !(CodeBinding FreeVar) ![String]
+				| ABCCodeExpr ![String] !Bool
+
+				| MatchExpr !(Optional (Global DefinedSymbol)) !(Global DefinedSymbol) !Expression
+				| FreeVar FreeVar 
+				| Constant !SymbIdent !Int !Priority !Bool /* auxiliary clause used during checking */
+
+				| DynamicExpr !DynamicExpr
+//				| TypeCase !TypeCase
+
+				| TypeCodeExpression !TypeCodeExpression
+				| EE 
+
+
+::	CodeBinding	variable :== Env String variable
+
+::	App =
+	{	app_symb 		:: !SymbIdent
+	,	app_args 		:: ![Expression]
+	,	app_info_ptr	:: !ExprInfoPtr
+	}
+
+::	Case =
+	{	case_expr		:: !Expression
+//	,	case_guards		:: ![PatternExpression]
+	,	case_guards		:: !CasePatterns
+	,	case_default	:: !Optional Expression
+	,	case_ident		:: !Optional Ident
+	,	case_info_ptr	:: !ExprInfoPtr
+	}
+
+::	Let =
+	{	let_strict		:: !Bool
+	,	let_binds		:: !(Env Expression FreeVar)
+	,	let_expr		:: !Expression
+	,	let_info_ptr	:: !ExprInfoPtr
+	}
+
+::	Conditional =
+	{	if_cond		:: !Expression
+	,	if_then		:: !Expression
+	,	if_else		:: !Optional Expression
+	}
+
+/*
+::	Conditional =
+	{	if_cond		:: !Condition
+	,	if_then		:: !Expression
+	,	if_else		:: !Optional Expression
+	}
+
+
+::	Condition =
+	{	con_positive 	:: !Bool
+	,	con_expression	:: !Expression
+	}
+*/
+
+::	DynamicExpr =
+	{	dyn_expr		:: !Expression
+	,	dyn_opt_type	:: !Optional DynamicType
+	,	dyn_info_ptr	:: !ExprInfoPtr
+	,	dyn_uni_vars	:: ![VarInfoPtr]			/* filled after type checking */
+	,	dyn_type_code	:: !TypeCodeExpression		/* filled after type checking */
+	}	
+
+::	CasePatterns = AlgebraicPatterns !(Global Index) ![AlgebraicPattern]
+				 | BasicPatterns !BasicType [BasicPattern]
+				 | DynamicPatterns [DynamicPattern]						/* auxiliary */
+				 | NoPattern											/* auxiliary */
+
+::	Selection	= RecordSelection !(Global DefinedSymbol) !Int
+				| ArraySelection !(Global DefinedSymbol) !ExprInfoPtr !Expression
+				| DictionarySelection !BoundVar ![Selection] !ExprInfoPtr !Expression
+
+::	TypeCodeExpression = TCE_Empty | TCE_Var !VarInfoPtr | TCE_Constructor !Index ![TypeCodeExpression] | TCE_Selector ![Selection] !VarInfoPtr
+
+::	GlobalTCType = GTT_Basic !BasicType	| GTT_Constructor !TypeSymbIdent | GTT_Function
+	
+/*	
+::	PatternExpression =
+	{	guard_pattern 	:: !GuardPattern
+	,	guard_expr		:: !Expression
+	}
+
+::	GuardPattern = BasicPattern !BasicValue | AlgebraicPattern !(Global DefinedSymbol) ![FreeVar] | VariablePattern !FreeVar
+*/
+
+::	FunctionPattern	= FP_Basic !BasicValue !(Optional FreeVar)
+					| FP_Algebraic !(Global DefinedSymbol) ![FunctionPattern] !(Optional FreeVar)
+					| FP_Variable !FreeVar
+					| FP_Dynamic ![VarInfoPtr] !FreeVar !TypeCodeExpression !(Optional FreeVar)
+					| FP_Empty
+
+::	AlgebraicPattern =
+	{	ap_symbol	:: !(Global DefinedSymbol)
+	,	ap_vars		:: ![FreeVar]
+	,	ap_expr		:: !Expression
+	}
+	
+::	BasicPattern =
+	{	bp_value	:: !BasicValue
+	,	bp_expr		:: !Expression
+	}
+
+::	TypeCase =
+	{	type_case_dynamic	:: !Expression 
+	,	type_case_patterns 	:: ![DynamicPattern]
+	,	type_case_default	:: !Optional Expression
+	,	type_case_info_ptr	:: !ExprInfoPtr
+	}
+	
+::	DynamicPattern =
+	{	dp_var					:: !FreeVar
+	,	dp_type					:: !ExprInfoPtr
+	,	dp_type_patterns_vars	:: ![VarInfoPtr]			/* filled after type checking */
+	,	dp_type_code			:: !TypeCodeExpression		/* filled after type checking */
+	,	dp_rhs					:: !Expression
+	}
+	
+/*
+	error handling
+*/
+
+:: Position			= FunPos  FileName LineNr FunctName
+					| LinePos FileName LineNr
+					| PreDefPos Ident
+					| NoPos
+
+::	IdentPos =
+	{	ip_ident	:: !Ident
+	,	ip_line		:: !Int
+	,	ip_file		:: !FileName
+	}
+
+:: FileName			:== String
+
+:: FunctName		:== String
+
+:: LineNr			:== Int
+
+cNotALineNumber :== -1
+
+/* Used for hashing identifiers */
+
+instance == ModuleKind, Ident
+instance <<< Module a | <<< a, ParsedDefinition, InstanceType, AttributeVar, TypeVar, SymbolType, Expression, Type, Ident, Global object | <<< object,
+			 Position, CaseAlt, AType, FunDef, ParsedExpr, TypeAttribute, Bind a b | <<< a & <<< b, ParsedConstructor, TypeDef a | <<< a, TypeVarInfo,
+			 BasicValue, ATypeVar, TypeRhs, FunctionPattern, (Import from_symbol) | <<< from_symbol, ImportDeclaration, ImportedIdent, CasePatterns,
+			 Optional a | <<< a
+
+instance == TypeAttribute
+instance == Annotation
+/*
+ErrorToString :: Error -> String
+
+*/
+
+EmptySymbolTableEntry :== 
+	{	ste_kind = STE_Empty, ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" }
+
+cNotAGroupNumber :== -1
+
+EmptyTypeDefInfo :== { tdi_kinds = [], tdi_properties = cAllBitsClear, tdi_group = [], tdi_group_vars = [], tdi_cons_vars = [],
+					   tdi_classification = EmptyTypeClassification, tdi_group_nr = cNotAGroupNumber }
+
+MakeTypeVar name	:== { tv_name = name, tv_info_ptr = nilPtr }
+MakeVar name		:== { var_name = name, var_info_ptr = nilPtr, var_expr_ptr = nilPtr }
+
+MakeAttributedType type :== { at_attribute = TA_None, at_annotation = AN_None, at_type = type }
+MakeAttributedTypeVar type_var :== { atv_attribute = TA_None, atv_annotation = AN_None, atv_variable = type_var }
+
+EmptyFunInfo :== { fi_calls = [], fi_group_index = NoIndex, fi_def_level = NotALevel,
+				   fi_free_vars = [], fi_local_vars = [], fi_dynamics = [] }
+
+BottomSignClass		:== { sc_pos_vect = 0, sc_neg_vect = 0 }
+PostiveSignClass	:== { sc_pos_vect = bitnot 0, sc_neg_vect = 0 }
+
+NoPropClass			:== 0
+PropClass			:== bitnot 0
+
+MakeNewTypeSymbIdent name arity
+	:== MakeTypeSymbIdent { glob_object = NoIndex, glob_module = NoIndex } name arity
+
+MakeTypeSymbIdent type_index name arity
+	:== {	type_name = name, type_arity = arity, type_index = type_index,
+			type_prop = { tsp_sign = BottomSignClass, tsp_propagation = NoPropClass, tsp_coercible = True }}
+
+MakeSymbIdent name arity	:== { symb_name = name, symb_kind = SK_Unknown, symb_arity = arity  }
+MakeConstant name			:== MakeSymbIdent name 0
+
+ParsedSelectorToSelectorDef ps var_ptr :==
+	{	sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos =  ps.ps_field_pos, sd_type_index = NoIndex,
+		sd_exi_vars = [], /* sd_exi_attrs = [], */ sd_type_ptr = var_ptr, sd_field = ps.ps_field_name,
+		sd_type	= { st_vars = [], st_args = [], st_result = ps.ps_field_type, st_arity = 0, st_context = [],
+				    st_attr_env = [], st_attr_vars = [] }}
+
+ParsedConstructorToConsDef pc var_ptr :==
+	{	cons_symb = pc.pc_cons_name, cons_pos = pc.pc_cons_pos, cons_priority = pc.pc_cons_prio, cons_index = NoIndex, cons_type_index = NoIndex,
+		cons_type = { st_vars = [], st_args = pc.pc_arg_types, st_result = MakeAttributedType TE, 
+				  st_arity = pc.pc_cons_arity, st_context = [], st_attr_env = [], st_attr_vars = []},
+		cons_exi_vars = pc.pc_exi_vars, /* cons_exi_attrs = [], */ cons_type_ptr = var_ptr, cons_arg_vars = [] }
+
+ParsedInstanceToClassInstance pi members :==
+ 	{	ins_class = {glob_object = MakeDefinedSymbol pi.pi_class NoIndex (length pi.pi_types), glob_module = NoIndex}, ins_ident = pi.pi_ident, 
+ 		ins_type = { it_vars = [], it_types = pi.pi_types, it_attr_vars = [],
+ 					 it_context = pi.pi_context }, ins_members = members, ins_specials = pi.pi_specials, ins_pos = pi.pi_pos }
+
+MakeTypeDef name lhs rhs attr contexts pos  :== 
+	{	td_name = name, td_index = -1, td_arity = length lhs, td_args = lhs, td_attrs = [], td_attribute = attr, td_context = contexts,
+		td_pos = pos, td_rhs = rhs }
+
+MakeDefinedSymbol ident index arity :== { ds_ident = ident, ds_arity = arity, ds_index = index }
+
+MakeNewFunctionType name arity prio type pos specials var_ptr
+	:== { ft_symb = name, ft_arity = arity, ft_priority = prio, ft_type = type, ft_pos = pos, ft_specials = specials, ft_type_ptr = var_ptr  }
+
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
new file mode 100644
index 0000000..abf9140
--- /dev/null
+++ b/frontend/syntax.icl
@@ -0,0 +1,1774 @@
+implementation module syntax
+
+import StdEnv, compare_constructor
+
+import RWSDebug
+
+import scanner, general, Heap, typeproperties, utilities
+
+::	Ident =
+	{ 	id_name		:: !String
+	,	id_info 	:: !SymbolPtr
+	}
+
+instance toString Ident
+where toString {id_name} = id_name
+
+instance toString (Import from_symbol)
+where toString {import_module} = toString import_module
+
+
+/*	Each Identifier is equipped with a pointer to a SymbolTableEntry that is
+	used for binding the identifier with its definition.
+*/
+
+::	SymbolTable			:== Heap SymbolTableEntry
+::	SymbolPtr 			:== Ptr SymbolTableEntry
+
+::	SymbolTableEntry = 
+	{	ste_kind		:: !STE_Kind
+	,	ste_index		:: !Index
+	,	ste_def_level	:: !Level
+	,	ste_previous	:: SymbolTableEntry
+	}
+
+::	STE_BoundTypeVariable	= { stv_count :: !Int, stv_attribute :: !TypeAttribute, stv_info_ptr :: !TypeVarInfoPtr}
+
+::	STE_Kind	= STE_FunctionOrMacro ![Index]
+				| STE_Type
+				| STE_Constructor
+				| STE_Selector ![Global Index]
+				| STE_Field !Ident
+				| STE_Class
+				| STE_Member
+				| STE_Instance
+				| STE_Variable !VarInfoPtr
+				| STE_TypeVariable !TypeVarInfoPtr
+				| STE_TypeAttribute !AttrVarInfoPtr
+				| STE_BoundTypeVariable !STE_BoundTypeVariable
+				| STE_BoundType !AType
+				| STE_Imported !STE_Kind !Index
+				| STE_DclFunction
+				| STE_Module !(Module (CollectedDefinitions ClassInstance IndexRange))
+				| STE_OpenModule !Int !(Module (CollectedDefinitions ClassInstance IndexRange))
+				| STE_ClosedModule
+				| STE_LockedModule
+				| STE_Empty 
+				| STE_DictType !CheckedTypeDef
+				| STE_DictCons !ConsDef
+				| STE_DictField !SelectorDef
+				| STE_Called ![Index] /* used during macro expansion to indicate that this function is called */
+
+::	Global object =
+	{	glob_object	:: !object
+	,	glob_module	:: !Index
+	}
+	
+::	Module defs = 
+	{	mod_name		:: !Ident
+	,	mod_type		:: !ModuleKind
+	, 	mod_imports		:: ![ParsedImport]
+// RWS ...
+	,	mod_imported_objects :: ![ImportedObject]
+// ... RWS
+	,	mod_defs		:: !defs
+	}
+
+::	ParsedModule	:== Module  [ParsedDefinition]
+::	ScannedModule 	:== Module  (CollectedDefinitions (ParsedInstance FunDef) IndexRange)
+
+	
+::	ModuleKind	= MK_Main | MK_Module | MK_System | MK_None
+
+::	RhsDefsOfType	= ConsList ![ParsedConstructor]
+					| SelectorList !Ident ![ATypeVar] ![ParsedSelector]
+					| TypeSpec !AType
+					| EmptyRhs !BITVECT
+
+
+::	CollectedDefinitions instance_kind macro_defs =
+	{	def_types 			:: ![TypeDef TypeRhs]
+	,	def_constructors	:: ![ParsedConstructor]
+	,	def_selectors		:: ![ParsedSelector]
+	,	def_macros			:: !macro_defs
+	,	def_classes			:: ![ClassDef]
+	,	def_members			:: ![MemberDef]
+	,	def_funtypes		:: ![FunType]
+	,	def_instances		:: ![instance_kind]
+	}
+
+::	LocalDefs = LocalParsedDefs [ParsedDefinition] | CollectedLocalDefs CollectedLocalDefs
+
+::	IndexRange	= { ir_from :: !Index, ir_to :: !Index }
+
+::  Index	:== Int
+NoIndex		:== -1
+
+
+::  Level	:== Int
+NotALevel 	:==  -1
+
+::	CollectedLocalDefs =
+	{	loc_functions	:: !IndexRange
+	,	loc_nodes		:: ![(Optional SymbolType, NodeDef ParsedExpr)]
+	}
+
+::	NodeDef dst =
+	{	nd_dst		::!dst,
+		nd_alts		::!OptGuardedAlts,
+		nd_locals	::!LocalDefs
+	}
+
+::	Rhs =
+	{	rhs_alts	:: !OptGuardedAlts
+	,	rhs_locals	:: !LocalDefs
+	}
+
+cIsAFunction	:== True
+cIsNotAFunction :== False
+
+::	ParsedDefinition 
+	=	PD_Function  Position Ident Bool [ParsedExpr] Rhs FunKind
+	|	PD_NodeDef  Position ParsedExpr Rhs
+	|	PD_Type ParsedTypeDef
+	|	PD_TypeSpec Position Ident Priority (Optional SymbolType) Specials
+	|	PD_Class ClassDef [ParsedDefinition]
+	|	PD_Instance (ParsedInstance ParsedDefinition)
+	|	PD_Instances [ParsedInstance ParsedDefinition]
+	|	PD_Import [ParsedImport]
+// RWS ...
+	|	PD_ImportedObjects [ImportedObject]
+// ... RWS
+	|	PD_Erroneous
+
+::	FunKind	= FK_Function | FK_Macro | FK_Caf | FK_Unknown
+
+::	ParsedSelector =
+	{	ps_field_name		:: !Ident
+	,	ps_selector_name	:: !Ident
+	,	ps_field_type		:: !AType
+	,	ps_field_var		:: !Ident
+	,	ps_field_pos		:: !Position
+	}
+
+::	ParsedConstructor =
+	{	pc_cons_name 	:: !Ident
+	,	pc_cons_arity	:: !Int
+	,	pc_exi_vars		:: ![ATypeVar]
+	,	pc_arg_types	:: ![AType]
+	,	pc_cons_prio	:: !Priority
+	,	pc_cons_pos		:: !Position
+	}
+	
+::	ParsedInstance member =
+	{	pi_class 	:: !Ident
+	,	pi_ident	:: !Ident
+	,	pi_types	:: ![Type]
+	,	pi_context	:: ![TypeContext]
+	,	pi_pos		:: !Position
+	,	pi_members	:: ![member]
+	,	pi_specials	:: !Specials
+	}
+
+
+::	Specials
+	= SP_ParsedSubstitutions 	![Env Type TypeVar]
+	| SP_Substitutions 		 	![SpecialSubstitution]
+	| SP_ContextTypes			![Special]
+	| SP_FunIndex				!Index
+	| SP_TypeOffset				!Int
+	| SP_None
+
+::	SpecialSubstitution =
+	{	ss_environ	:: !Env Type TypeVar
+	,	ss_context	:: ![TypeContext]
+	,	ss_vars		:: ![TypeVar]
+	,	ss_attrs	:: ![AttributeVar]
+	}
+
+::	Special =
+	{	spec_index	:: !Global Index
+	,	spec_types	:: ![[Type]]
+	,	spec_vars	:: ![TypeVar]
+	, 	spec_attrs	:: ![AttributeVar]
+	}
+
+
+::	AttrInequality =
+	{	ai_demanded :: !AttributeVar
+	,	ai_offered	:: !AttributeVar
+	}
+
+::	DefinedSymbol = 
+	{	ds_ident		:: !Ident
+	,	ds_arity		:: !Int
+	,	ds_index		:: !Index
+	}
+
+::	ClassSymbIdent =
+	{	cs_name		:: !Ident
+	,	cs_arity 	:: !Int
+	,	cs_index 	:: !Int
+	}
+
+::	ClassDef =
+ 	{	class_name			:: !Ident
+	,	class_arity			:: !Int
+	,	class_args			:: ![TypeVar]
+	,	class_context		:: ![TypeContext]
+	,	class_members		:: !{# DefinedSymbol}
+	,	class_dictionary	:: !DefinedSymbol
+	,	class_pos			:: !Position
+	,	class_cons_vars		:: !BITVECT
+	}
+
+::	MemberDef =
+	{	me_symb			:: !Ident
+	,	me_class		:: !Global Index
+	,	me_offset		:: !Index
+	,	me_type			:: !SymbolType
+	,	me_type_ptr		:: !VarInfoPtr
+	,	me_class_vars	:: ![TypeVar]
+	,	me_pos			:: !Position
+	,	me_priority 	:: !Priority
+	}
+
+
+::	InstanceType =
+	{	it_vars			:: [TypeVar]
+	,	it_types		:: ![Type]
+	,	it_attr_vars	:: [AttributeVar]
+	,	it_context		:: ![TypeContext]
+	}
+
+::	ClassInstance =
+ 	{	ins_class		:: !Global DefinedSymbol
+	,	ins_ident		:: !Ident
+	,	ins_type		:: !InstanceType
+	,	ins_members		:: !{# DefinedSymbol}
+	,	ins_specials	:: !Specials
+	,	ins_pos			:: !Position
+	}
+
+::	Import from_symbol =
+	{	import_module		:: !Ident
+	,	import_symbols		:: ![from_symbol]
+	,	import_file_position:: !(!FileName, !Int)	// for error messages // MW++
+	}
+
+::	ParsedImport		:== Import ImportDeclaration
+
+::	ImportedIdent =
+	{	ii_ident	:: !Ident
+	,	ii_extended	:: !Bool
+	}
+
+::	ImportDeclaration	= ID_Function !ImportedIdent
+						| ID_Class !ImportedIdent !(Optional [ImportedIdent])
+						| ID_Type !ImportedIdent !(Optional [ImportedIdent])
+						| ID_Record !ImportedIdent !(Optional [ImportedIdent])
+						| ID_Instance !ImportedIdent !Ident !(![Type],![TypeContext])
+
+// MW2 moved some type definitions
+
+// RWS ...
+cIsImportedLibrary :== True
+cIsImportedObject :== False
+:: ImportedObject =
+	{	io_is_library :: !Bool
+	,	io_name    :: !{#Char}
+	}
+// ... RWS 
+
+::	RecordType =
+	{	rt_constructor	:: !DefinedSymbol
+	,	rt_fields		:: !{# FieldSymbol}
+	}
+	
+::	FieldSymbol =
+	{	fs_name			:: !Ident
+	,	fs_var			:: !Ident
+	,	fs_index		:: !Index
+	}
+
+
+::	TypeRhs	= AlgType ![DefinedSymbol]
+			| SynType !AType
+			| RecordType !RecordType
+			| AbstractType !BITVECT
+			| UnknownType
+
+::	ParsedTypeDef :== TypeDef RhsDefsOfType
+::	CheckedTypeDef :== TypeDef TypeRhs
+
+cAllBitsClear			:== 0
+
+cIsHyperStrict			:== 1
+cIsNonCoercible			:== 2
+cMayBeNonCoercible		:== 4
+
+::	TypeDef type_rhs =
+ 	{	td_name			:: !Ident
+	,	td_index		:: !Int
+	,	td_arity		:: !Int
+	,	td_args			:: ![ATypeVar]
+	,	td_attrs		:: ![AttributeVar]
+	,	td_context		:: ![TypeContext]
+	,	td_rhs			:: !type_rhs
+	,	td_attribute	:: !TypeAttribute
+	,	td_pos			:: !Position
+	}
+
+::	FunType =
+	{	ft_symb			:: !Ident
+	,	ft_arity		:: !Int
+	,	ft_priority		:: !Priority
+	,	ft_type			:: !SymbolType
+	,	ft_pos			:: !Position
+	,	ft_specials		:: !Specials
+	,	ft_type_ptr		:: !VarInfoPtr
+	}
+
+::	FreeVar =
+	{	fv_def_level	:: !Level
+	,	fv_name			:: !Ident
+	,	fv_info_ptr		:: !VarInfoPtr
+	,	fv_count		:: !Int
+	}
+	
+::	FunCall =
+	{	fc_level		:: !Level
+	,	fc_index		:: !Index
+	}
+
+::	FunInfo =
+	{	fi_calls			:: ![FunCall]
+	,	fi_group_index		:: !Index
+	,	fi_def_level		:: !Level
+	,	fi_free_vars		:: ![FreeVar]
+	,	fi_local_vars		:: ![FreeVar]
+	,	fi_dynamics			:: ![ExprInfoPtr]
+	}
+
+::	ParsedBody =
+	{	pb_args	:: ![ParsedExpr]
+	,	pb_rhs	:: !Rhs
+	}
+
+::	CheckedBody =
+	{	cb_args			:: ![FreeVar]
+	,	cb_rhs			:: ![Expression]
+	}
+
+::	TransformedBody =
+	{	tb_args			:: ![FreeVar]
+	,	tb_rhs			:: !Expression
+	}
+
+::	FunctionBody	= ParsedBody ![ParsedBody]
+					| CheckedBody !CheckedBody
+	/* The next three constructors are used during macro expansion (module transform) */
+					| PartioningMacro
+					| PartioningFunction !CheckedBody !Int
+					| RhsMacroBody !CheckedBody
+	/* macro expansion the transforms a CheckedBody into a TransformedBody */
+					| TransformedBody !TransformedBody
+					| Expanding
+					| BackendBody ![BackendBody]
+					
+::	BackendBody =
+	{	bb_args	:: ![FunctionPattern]
+	,	bb_rhs	:: !Expression
+	}
+
+::	FunDef =
+	{	fun_symb		:: !Ident
+	,	fun_arity		:: !Int
+	,	fun_priority	:: !Priority
+	,	fun_body		:: !FunctionBody
+	,	fun_type		:: !Optional SymbolType
+	,	fun_pos			:: !Position
+	,	fun_index		:: !Int
+	,	fun_kind		:: !FunKind
+	,	fun_lifted		:: !Int
+//	,	fun_type_ptr	:: !TypeVarInfoPtr
+	,	fun_info		:: !FunInfo
+	}
+
+cIsAGlobalVar	:== True
+cIsALocalVar	:== False
+
+::	ConsClasses =
+	{	cc_size	::!Int
+	,	cc_args	::![ConsClass]
+	}
+					
+::	ConsClass	:== Int
+
+::	OptionalVariable :== Optional (Bind Ident VarInfoPtr)
+
+:: 	AuxiliaryPattern
+		= AP_Algebraic !(Global DefinedSymbol) !Index [AuxiliaryPattern] OptionalVariable
+		| AP_Variable !Ident !VarInfoPtr OptionalVariable
+		| AP_Basic !BasicValue OptionalVariable
+		| AP_Dynamic !AuxiliaryPattern !DynamicType !OptionalVariable
+		| AP_Constant !AP_Kind !(Global DefinedSymbol) !Priority
+		| AP_WildCard OptionalVariable
+		| AP_Empty !Ident
+
+:: AP_Kind = APK_Constructor !Index | APK_Macro
+
+::	VarInfo  =	VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar (!Ident, ![Int]) |
+				VI_Expression !Expression | VI_Variable !Ident !VarInfoPtr | VI_LiftedVariable !VarInfoPtr |
+				VI_Count !Int /* the reference count of a variable */ !Bool /* true if the variable is global, false otherwise */ |
+				VI_AccVar !ConsClass /* used during fusion to determine accumulating parameters of functions */ |
+				VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
+				 /* used during elimination and lifting of cases */
+				VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
+				VI_Forward !BoundVar | VI_LetVar !LetVarInfo | VI_LetExpression !LetExpressionInfo | VI_CaseVar !VarInfoPtr |
+				VI_CorrespondenceNumber !Int | VI_SequenceNumber !Int |
+				VI_Used | /* for indicating that an imported function has been used */
+				VI_PropagationType !SymbolType | /* for storing the type with propagation environment of an imported function */
+				VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */
+				VI_Record ![AuxiliaryPattern] |
+				VI_Pattern !AuxiliaryPattern |
+				VI_Default !Int /* used during conversion of dynamics; the Int indiacted the refenrence count */
+
+::	VarInfoPtr	:== Ptr VarInfo
+
+::	LetVarInfo =
+	{	lvi_count		:: !Int
+	,	lvi_depth		:: !Int
+	,	lvi_new			:: !Bool
+	,	lvi_var			:: !Ident
+	,	lvi_expression	:: !Expression	
+	,   lvi_previous	:: ![PreviousLetVarInfo]
+	}
+
+::	PreviousLetVarInfo =
+	{	plvi_count		:: !Int
+	,	plvi_depth		:: !Int
+	,	plvi_new		:: !Bool
+	}
+
+::	LetExpressionStatus	= LES_Untouched | LES_Moved | LES_Updated !Expression
+
+::	LetExpressionInfo =
+	{	lei_count			:: !Int
+	,	lei_depth			:: !Int 
+	,	lei_strict			:: !Bool 
+	,	lei_var				:: !FreeVar 
+	,   lei_expression		:: !Expression
+	,   lei_status			:: !LetExpressionStatus
+	,   lei_type			:: !AType
+	}
+
+cNotVarNumber :== -1
+
+::	BoundVar = 
+	{	var_name		:: !Ident
+	,	var_info_ptr	:: !VarInfoPtr
+	,	var_expr_ptr	:: !ExprInfoPtr
+	}
+
+::	TypeSymbIdent =
+	{	type_name		:: !Ident
+	,	type_arity		:: !Int
+	,	type_index		:: !Global Index
+	,	type_prop		:: !TypeSymbProperties
+	}
+
+::	TypeSymbProperties =
+	{	tsp_sign		:: !SignClassification
+	,	tsp_propagation	:: !PropClassification
+	,	tsp_coercible	:: !Bool
+	}
+
+::	SymbKind	= SK_Unknown
+				| SK_Function !(Global Index)
+				| SK_OverloadedFunction !(Global Index)
+				| SK_Constructor !(Global Index)
+				| SK_Macro !(Global Index)
+//				| SK_RecordSelector !(Global Index)
+				| SK_GeneratedFunction !FunctionInfoPtr !Index
+				| SK_TypeCode
+
+// MW2 moved some type definitions
+
+/*	Some auxiliary type definitions used during fusion. Actually, these definitions
+	should have beengiven in seperate module. Unfortunately, Clean's module system
+	forbids cyclic dependencies between def modules.
+	
+*/
+
+::	FunctionHeap 	:== Heap FunctionInfo
+
+::	FunctionInfoPtr	:== Ptr FunctionInfo
+
+::	FunctionInfo	= FI_Empty | FI_Function !GeneratedFunction
+
+::	Producer	= PR_Empty
+				| PR_Function !SymbIdent !Index
+				| PR_Class !App ![BoundVar] ![Type]
+//				| PR_Constructor !SymbIdent ![Expression]
+				| PR_GeneratedFunction !SymbIdent !Index
+
+::	InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo
+
+::	GeneratedFunction = 
+	{	gf_fun_def			:: !FunDef
+	,	gf_instance_info	:: !InstanceInfo
+	,	gf_cons_args		:: !ConsClasses
+	,	gf_fun_index		:: !Index
+	}
+	
+/*	... main type definitions continued .... */
+
+::	ExpressionHeap 	:== Heap ExprInfo
+
+::	ExprInfoPtr		:== Ptr ExprInfo
+
+::	TempLocalVar	:== Int
+
+::	DynamicPtr		:== ExprInfoPtr
+
+::	ExprInfo		= EI_Empty
+
+		/* For handling overloading */
+
+					| EI_Overloaded !OverloadedCall 						/* initial, set by the type checker */
+					| EI_Instance 	!(Global DefinedSymbol) ![Expression]	/* intermedediate, used during resolving of overloading */ 
+					| EI_Selection 	![Selection] !BoundVar ![Expression]	/* intermedediate, used during resolving of overloading */
+					| EI_Context 	![Expression]							/* intermedediate, used during resolving of overloading */
+
+		/* For handling dynamics */
+
+					| EI_Dynamic 				!(Optional DynamicType)
+					| EI_DynamicType			!DynamicType ![DynamicPtr]
+
+		/* Auxiliary, was EI_DynamicType before checking */
+
+					| EI_DynamicTypeWithVars	![TypeVar] !DynamicType ![DynamicPtr]				
+
+		/* Auxiliary, used during type checking */
+
+					| EI_TempDynamicType 		!(Optional DynamicType) !AType ![TypeContext] !ExprInfoPtr !SymbIdent
+					| EI_TempDynamicPattern 	![TypeVar] !DynamicType ![DynamicPtr] ![TempLocalVar] !AType ![TypeContext] !ExprInfoPtr !SymbIdent
+					
+					| EI_TypeOfDynamic 			![VarInfoPtr] !TypeCodeExpression				/* Final */
+					| EI_TypeOfDynamicPattern 	![VarInfoPtr] !TypeCodeExpression				/* Final */
+
+					| EI_TypeCode 		!TypeCodeExpression
+					| EI_TypeCodes 		![TypeCodeExpression]
+
+					| EI_Attribute !Int
+
+
+		/*	EI_FreeVariables is uded to store the (free) variables occurring in the case expression */
+
+//					| EI_FreeVariables ![UnboundVariable] !ExprInfo
+
+		/* EI_ClassTypes is used to store the instance types of a class These type are used during fusion to generate proper types for 
+		   the fusion result (i.e. the resulting function after elimination of dictionaries) */
+
+					| EI_ClassTypes ![Type]
+					| EI_CaseType !CaseType
+					| EI_LetType ![AType]
+					| EI_CaseTypeAndRefCounts !CaseType !RefCountsInCase
+					| EI_LetTypeAndRefCounts ![AType] ![Int]
+
+		/* for converting case into function patterns the following auxiliary constuctors are used */
+
+					| EI_Default !Expression !AType !ExprInfoPtr
+					| EI_DefaultFunction !SymbIdent ![Expression]
+
+::	RefCountsInCase = 
+	{	rcc_all_variables		:: ![CountedVariable]
+	,	rcc_default_variables	:: ![CountedVariable]
+	,	rcc_pattern_variables	:: ![[CountedVariable]]
+	}
+
+::	CountedVariable =
+	{	cv_variable	:: !VarInfoPtr
+	,	cv_count	:: !Int
+	}
+
+
+/*
+	OverloadedCall contains (type) information about functions that are overloaded. This structure is built during type checking
+	and used after (standard) unification to insert the proper instances of the corresponding functions.
+
+*/
+
+::	OverloadedCall = 
+	{	oc_symbol	:: !SymbIdent
+	,	oc_context	:: ![TypeContext]
+	,	oc_specials	:: ![Special]
+	}
+
+/*
+	CaseType contains the type information needed to type the corresponding case construct:
+		ct_pattern_type : the type of the pattern
+		ct_result_type  : the type of the result (of each pattern)
+		ct_cons_types   : the types of the arguments of each pattern constructor
+*/
+		
+::	CaseType =
+	{	ct_pattern_type	:: !AType
+	,	ct_result_type	:: !AType
+	,	ct_cons_types 	:: ![[AType]]
+	}
+		
+
+::	SymbIdent =
+	{	symb_name		:: !Ident
+	,	symb_kind		:: !SymbKind
+	,	symb_arity		:: !Int
+	}
+
+::	ConsDef =
+	{	cons_symb			:: !Ident
+	,	cons_type			:: !SymbolType
+	,	cons_arg_vars		:: ![[ATypeVar]]
+	,	cons_priority		:: !Priority
+	,	cons_index			:: !Index
+	,	cons_type_index		:: !Index
+	,	cons_exi_vars		:: ![ATypeVar]
+//	,	cons_exi_attrs		:: ![AttributeVar]
+	,	cons_type_ptr		:: !VarInfoPtr
+	,	cons_pos			:: !Position
+	}
+
+::	SelectorDef =
+	{	sd_symb			:: !Ident
+	,	sd_field		:: !Ident
+	,	sd_type			:: !SymbolType
+	,	sd_exi_vars		:: ![ATypeVar]
+//	,	sd_exi_attrs	:: ![AttributeVar]
+	,	sd_field_nr		:: !Int
+	,	sd_type_index	:: !Int
+	,	sd_type_ptr		:: !VarInfoPtr
+	,	sd_pos			:: !Position
+	}
+
+::	SymbolType =
+	{	st_vars			:: ![TypeVar]
+	,	st_args			:: ![AType]
+	,	st_arity		:: !Int
+	,	st_result		:: !AType
+	,	st_context		:: ![TypeContext]
+	,	st_attr_vars	:: ![AttributeVar]
+	,	st_attr_env		:: ![AttrInequality]
+	}
+
+::	TypeContext =
+	{	tc_class	:: !Global DefinedSymbol
+	,	tc_types	:: ![Type]
+	,	tc_var		:: !VarInfoPtr
+	}
+
+::	AType =
+	{	at_attribute	:: !TypeAttribute
+	,	at_annotation	:: !Annotation
+	,	at_type			:: !Type
+	}
+	
+::	TempAttrId		:== Int
+::	TempVarId		:== Int
+
+::	Type	=	TA !TypeSymbIdent ![AType]
+			|	(-->) infixr 9 !AType !AType
+			|	(:@:) infixl 9 !ConsVariable ![AType]
+			|	TB !BasicType
+
+//			|	TFA [ATypeVar] Type
+
+			| 	GTV !TypeVar
+			| 	TV !TypeVar
+			|	TempV !TempVarId				/* Auxiliary, used during type checking */
+
+			
+			|	TQV	TypeVar
+			|	TempQV !TempVarId				/* Auxiliary, used during type checking */
+
+			|	TLifted !TypeVar				/* Auxiliary, used during type checking of lifted arguments */
+			|	TE
+
+::	ConsVariable = CV 		!TypeVar
+				 | TempCV 	!TempVarId
+				 | TempQCV 	!TempVarId
+
+
+::	DynamicType =
+	{	dt_uni_vars 	:: ![ATypeVar]
+	,	dt_global_vars	:: ![TypeVar]
+	,	dt_type			:: !AType
+	}
+
+::	KindHeap	:== Heap KindInfo
+::	KindInfoPtr	:== Ptr KindInfo
+
+::	KindInfo	= KI_Var !KindInfoPtr
+				| KI_Indirection !KindInfo
+				| KI_Arrow ![KindInfo]
+				| KI_Const
+				
+				| KI_ConsVar
+				
+				| KI_VarBind !KindInfoPtr
+				| KI_NormVar !Int
+
+
+::	TypeVarInfo  	= TVI_Empty | TVI_Type !Type | TVI_Forward !TempVarId | TVI_TypeKind !KindInfoPtr
+					| TVI_SignClass !Index !SignClassification !TypeVarInfo | TVI_PropClass !Index !PropClassification !TypeVarInfo
+					| TVI_Attribute TypeAttribute
+					| TVI_CorrespondenceNumber !Int
+					| TVI_Used /* to adminster that this variable is encountered (in checkOpenTypes) */
+					| TVI_TypeCode !TypeCodeExpression
+
+::	TypeVarInfoPtr	:== Ptr TypeVarInfo
+::	TypeVarHeap 	:== Heap TypeVarInfo
+
+::	AttrVarInfo  	=	AVI_Empty | AVI_Attr !TypeAttribute | AVI_Forward !TempAttrId
+::	AttrVarInfoPtr	:== Ptr AttrVarInfo
+::	AttrVarHeap 	:== Heap AttrVarInfo
+
+::	TypeHeaps =
+	{	th_vars		:: ! .TypeVarHeap
+	,	th_attrs	:: ! .AttrVarHeap
+	}
+
+::	TypeVar =
+	{	tv_name				:: !Ident
+	,	tv_info_ptr			:: !TypeVarInfoPtr
+	}
+
+
+::	ATypeVar =
+	{	atv_attribute		:: !TypeAttribute
+	,	atv_annotation		:: !Annotation
+	,	atv_variable		:: !TypeVar
+	}
+
+::	TypeAttribute = TA_Unique | TA_Multi | TA_Var !AttributeVar | TA_RootVar !AttributeVar | TA_TempVar !Int
+				  | TA_Anonymous | TA_None | TA_List !Int !TypeAttribute | TA_Omega
+
+::	AttributeVar =
+	{	av_name			:: !Ident
+	,	av_info_ptr		:: !AttrVarInfoPtr
+	}
+
+::	Annotation	=  AN_Strict | AN_None 
+
+::	BasicType	= BT_Int | BT_Char | BT_Real | BT_Bool | BT_Dynamic
+				| BT_File | BT_World
+				| BT_String !Type /* the internal string type synonym only used to type string denotations */
+
+
+::	BasicValue	= BVI !String | BVC !String | BVB !Bool | BVR !String | BVS !String
+
+
+::	TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow !Int
+
+::	Occurrence =
+	{	occ_ref_count	:: !ReferenceCount
+	,	occ_bind		:: !OccurrenceBinding
+	,	occ_observing	:: !Bool
+	,	occ_previous 	:: ![ReferenceCount]
+	}
+
+::	ReferenceCount = RC_Used !RC_Used | RC_Unused 
+
+::	SelectiveUse = { su_field :: !Int, su_multiply :: ![ExprInfoPtr], su_uniquely :: ![ExprInfoPtr]  }
+
+::	RC_Used = { rcu_multiply :: ![ExprInfoPtr], rcu_selectively :: ![SelectiveUse], rcu_uniquely :: ![ExprInfoPtr] }
+
+::	OccurrenceBinding	= OB_Empty | OB_OpenLet !Expression | OB_LockedLet !Expression
+						| OB_Pattern ![(FreeVar, Int)] !OccurrenceBinding
+//						| OB_Closed !LetOccurrences | OB_Marked !LetOccurrences
+
+::	TypeDefInfo =
+	{	tdi_kinds			:: ![TypeKind]
+	,	tdi_properties		:: !BITVECT
+	,	tdi_group			:: ![Global Index]
+	,	tdi_group_nr		:: !Int
+	,	tdi_group_vars		:: ![Int]
+	,	tdi_cons_vars		:: ![Int]
+	,	tdi_classification	:: !TypeClassification
+	}
+
+::	TypeDefInfos :== {# .{# TypeDefInfo}}
+
+::	OptGuardedAlts	= GuardedAlts ![GuardedExpr] !(Optional ExprWithLocalDefs)
+				 	| UnGuardedExpr !ExprWithLocalDefs
+
+::	GuardedExpr =
+	{	alt_nodes	:: ![NodeDefWithLocals]
+	,	alt_guard	:: !ParsedExpr
+	,	alt_expr	:: !OptGuardedAlts
+	}
+
+::	ExprWithLocalDefs = 
+	{	ewl_nodes	:: ![NodeDefWithLocals]
+	,	ewl_expr	:: !ParsedExpr
+	,	ewl_locals	:: !LocalDefs
+	}
+
+::	NodeDefWithLocals =
+	{	ndwl_strict	:: !Bool
+	,	ndwl_def	:: !Bind ParsedExpr ParsedExpr
+	,	ndwl_locals	:: !LocalDefs
+	}
+
+
+::	CaseAlt =
+	{	calt_pattern	:: !ParsedExpr
+	,	calt_rhs		:: !Rhs
+	}
+	
+:: LocalDef		:== ParsedDefinition
+
+cUniqueSelection	:== True
+cNonUniqueSelection	:== False
+
+:: ParsedExpr	= PE_List ![ParsedExpr]
+				| PE_Ident !Ident
+				| PE_Basic !BasicValue
+				| PE_Bound !BoundExpr
+				| PE_Lambda !Ident ![ParsedExpr] !ParsedExpr
+				| PE_Tuple ![ParsedExpr]				
+				| PE_Record !ParsedExpr !(Optional Ident) ![FieldAssignment]
+				| PE_Array  !ParsedExpr ![ElemAssignment] ![Qualifier] 
+				| PE_ArrayDenot ![ParsedExpr]
+				| PE_Selection !Bool !ParsedExpr ![ParsedSelection]
+				| PE_Update !ParsedExpr [ParsedSelection] ParsedExpr
+				| PE_Case !Ident !ParsedExpr [CaseAlt]
+				| PE_If !Ident !ParsedExpr !ParsedExpr !ParsedExpr
+				| PE_Let !Bool !LocalDefs !ParsedExpr
+				| PE_Compr !GeneratorKind !ParsedExpr ![Qualifier]
+				| PE_Sequ Sequence
+				| PE_WildCard
+				| PE_Field !ParsedExpr !(Global FieldSymbol) /* Auxiliary, used during checking */
+
+				| PE_ABC_Code ![String] !Bool
+				| PE_Any_Code !(CodeBinding Ident) !(CodeBinding Ident) ![String]
+
+				| PE_DynamicPattern !ParsedExpr !DynamicType
+				| PE_Dynamic !ParsedExpr !(Optional DynamicType)
+				| PE_Empty
+
+::	ParsedSelection	= PS_Record !Ident !(Optional Ident)
+					| PS_Array  !ParsedExpr
+					| PS_Erroneous
+
+
+::	GeneratorKind :== Bool
+
+cIsListGenerator 	:== True
+cIsArrayGenerator	:== False
+			
+::	Generator =
+	{	gen_kind	:: !GeneratorKind
+	,	gen_pattern :: !ParsedExpr
+	,	gen_expr	:: !ParsedExpr
+	,	gen_var		:: !Ident
+	}
+
+::	Qualifier	=
+	{	qual_generators	:: ![Generator]
+	,	qual_filter		:: !Optional ParsedExpr
+	,	qual_fun_id		:: !Ident
+	}
+
+::	Sequence	= SQ_FromThen ParsedExpr ParsedExpr
+				| SQ_FromThenTo ParsedExpr ParsedExpr ParsedExpr
+				| SQ_From ParsedExpr
+				| SQ_FromTo ParsedExpr ParsedExpr
+
+::	BoundExpr	:== Bind ParsedExpr Ident
+
+::	FieldAssignment :== Bind ParsedExpr Ident
+
+::	ElemAssignment :== Bind ParsedExpr ParsedExpr
+
+//::	NodeDef :== Bind ParsedExpr ParsedExpr
+
+cIsStrict		:== True
+cIsNotStrict	:== False
+
+::	Expression	= Var !BoundVar 
+				| App !App
+				| (@) infixl 9  !Expression ![Expression]
+				| Let !Let
+				| Case !Case
+				| Selection !(Optional (Global DefinedSymbol)) !Expression ![Selection]
+				| Update !Expression ![Selection] Expression
+				| RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)]
+				| TupleSelect !DefinedSymbol !Int !Expression
+				| Lambda .[FreeVar] !Expression
+				| BasicExpr !BasicValue !BasicType
+				| WildCard
+				| Conditional !Conditional
+
+				| AnyCodeExpr !(CodeBinding BoundVar) !(CodeBinding FreeVar) ![String]
+				| ABCCodeExpr ![String] !Bool
+
+				| MatchExpr !(Optional (Global DefinedSymbol)) !(Global DefinedSymbol) !Expression
+				| FreeVar FreeVar 
+				| Constant !SymbIdent !Int !Priority !Bool /* auxiliary clause used during checking */
+
+				| DynamicExpr !DynamicExpr
+//				| TypeCase !TypeCase
+
+				| TypeCodeExpression !TypeCodeExpression
+				| EE 
+
+
+::	CodeBinding	variable :== Env String variable
+
+::	App =
+	{	app_symb 		:: !SymbIdent
+	,	app_args 		:: ![Expression]
+	,	app_info_ptr	:: !ExprInfoPtr
+	}
+
+::	Case =
+	{	case_expr		:: !Expression
+	,	case_guards		:: !CasePatterns
+	,	case_default	:: !Optional Expression
+	,	case_ident		:: !Optional Ident
+	,	case_info_ptr	:: !ExprInfoPtr
+	}
+
+::	Let =
+	{	let_strict		:: !Bool
+	,	let_binds		:: !(Env Expression FreeVar)
+	,	let_expr		:: !Expression
+	,	let_info_ptr	:: !ExprInfoPtr
+	}
+
+
+::	DynamicExpr =
+	{	dyn_expr		:: !Expression
+	,	dyn_opt_type	:: !Optional DynamicType
+	,	dyn_info_ptr	:: !ExprInfoPtr
+	,	dyn_uni_vars	:: ![VarInfoPtr]			/* filled after type checking */
+	,	dyn_type_code	:: !TypeCodeExpression		/* filled after type checking */
+	}	
+
+::	CasePatterns = AlgebraicPatterns !(Global Index) ![AlgebraicPattern]
+				 | BasicPatterns !BasicType [BasicPattern]
+				 | DynamicPatterns [DynamicPattern]						/* auxiliary */
+				 | NoPattern											/* auxiliary */
+
+
+::	Selection	= RecordSelection !(Global DefinedSymbol) !Int
+				| ArraySelection !(Global DefinedSymbol) !ExprInfoPtr !Expression
+				| DictionarySelection !BoundVar ![Selection] !ExprInfoPtr !Expression
+
+::	TypeCodeExpression = TCE_Empty | TCE_Var !VarInfoPtr | TCE_Constructor !Index ![TypeCodeExpression] | TCE_Selector ![Selection] !VarInfoPtr
+
+::	GlobalTCType = GTT_Basic !BasicType	| GTT_Constructor !TypeSymbIdent | GTT_Function
+
+::	FunctionPattern	= FP_Basic !BasicValue !(Optional FreeVar)
+					| FP_Algebraic !(Global DefinedSymbol) ![FunctionPattern] !(Optional FreeVar)
+					| FP_Variable !FreeVar
+					| FP_Dynamic ![VarInfoPtr] !FreeVar !TypeCodeExpression !(Optional FreeVar)
+					| FP_Empty
+
+::	AlgebraicPattern =
+	{	ap_symbol	:: !(Global DefinedSymbol)
+	,	ap_vars		:: ![FreeVar]
+	,	ap_expr		:: !Expression
+	}
+	
+::	BasicPattern =
+	{	bp_value	:: !BasicValue
+	,	bp_expr		:: !Expression
+	}
+
+::	TypeCase =
+	{	type_case_dynamic	:: !Expression 
+	,	type_case_patterns 	:: ![DynamicPattern]
+	,	type_case_default	:: !Optional Expression
+	,	type_case_info_ptr	:: !ExprInfoPtr
+	}
+	
+::	DynamicPattern =
+	{	dp_var					:: !FreeVar
+	,	dp_type					:: !ExprInfoPtr
+	,	dp_type_patterns_vars	:: ![VarInfoPtr]			/* filled after type checking */
+	,	dp_type_code			:: !TypeCodeExpression		/* filled after type checking */
+	,	dp_rhs					:: !Expression
+	}
+	
+	
+::	Conditional =
+	{	if_cond		:: !Expression
+	,	if_then		:: !Expression
+	,	if_else		:: !Optional Expression
+	}
+
+/*
+	error handling
+*/
+
+:: Position			= FunPos  FileName LineNr FunctName
+					| LinePos FileName LineNr
+					| PreDefPos Ident
+					| NoPos
+
+::	IdentPos =
+	{	ip_ident	:: !Ident
+	,	ip_line		:: !Int
+	,	ip_file		:: !FileName
+	}
+
+
+:: FileName			:== String
+
+:: FunctName		:== String
+
+:: LineNr			:== Int
+
+cNotALineNumber :== -1
+
+/* Used for hashing identifiers */
+
+class needs_brackets a :: a -> Bool
+
+instance == BoundVar
+where
+	(==) varid1 varid2
+		= varid1.var_name == varid2.var_name
+
+instance == Ident
+where
+	(==) id1 id2
+		= id1.id_info == id2.id_info
+
+instance needs_brackets AType
+where
+	needs_brackets {at_type}
+		= needs_brackets at_type
+
+instance needs_brackets Type
+where
+	needs_brackets (TA {type_arity} _)
+		= type_arity > 0
+	needs_brackets (_ --> _)
+		= True
+	needs_brackets (_ :@: _)
+		= True
+/*	needs_brackets (TFA _ _)
+		= True
+*/	needs_brackets _
+		= False
+
+instance needs_brackets Expression
+where
+	needs_brackets (App app)
+		= app.app_symb.symb_arity > 0
+	needs_brackets (_ @ _)
+		= True
+	needs_brackets (Let _)
+		= True
+	needs_brackets (Case _)
+		= True
+	needs_brackets (Lambda _ _)
+		= True
+	needs_brackets (Selection _ _ _)
+		= True
+	needs_brackets _
+		= False
+
+instance needs_brackets a
+where
+	needs_brackets _ = False
+
+	
+instance <<< BasicType
+where
+	(<<<) file BT_Int			= file <<< "Int"
+	(<<<) file BT_Char			= file <<< "Char"
+	(<<<) file BT_Real			= file <<< "Real"
+	(<<<) file BT_Bool			= file <<< "Bool"
+/*	(<<<) file (BT_String _)	= file <<< "String" */
+	(<<<) file BT_Dynamic		= file <<< "Dynamic"
+	(<<<) file BT_File			= file <<< "File"
+	(<<<) file BT_World			= file <<< "World"
+
+instance <<< TypeVar
+where
+	(<<<) file varid = file <<< varid.tv_name <<< '[' <<< ptrToInt varid.tv_info_ptr <<< ']'
+
+instance <<< AttributeVar
+where
+	(<<<) file {av_name,av_info_ptr} = file <<< av_name <<< '[' <<< ptrToInt av_info_ptr <<< ']'
+
+instance toString AttributeVar
+where
+	toString {av_name,av_info_ptr} = toString av_name + "[" + toString (ptrToInt av_info_ptr) + "]"
+
+instance <<< AType
+where
+	(<<<) file {at_annotation,at_attribute,at_type}
+		= file <<< at_annotation <<< at_attribute <<< at_type
+
+instance <<< TypeAttribute
+where
+	(<<<) file ta
+		= file <<< toString ta
+
+instance toString TypeAttribute
+where
+	toString (TA_Unique)
+		= "* "
+	toString (TA_TempVar tav_number)
+		= "u" + toString tav_number + ": "
+	toString (TA_Var avar)
+		= toString avar + ": "
+/*	toString (TA_TempExVar tav_number)
+		= "e" + toString tav_number + ": "
+	toString (TA_ExVar avar)
+		= toString avar + "': "
+*/
+	toString (TA_RootVar avar)
+		= toString avar + ": "
+	toString (TA_Anonymous)
+		= ". "
+	toString TA_None
+		= ""
+	toString TA_Multi
+		= "o "
+	toString TA_Omega
+		= "w "
+	toString (TA_List _ _)
+		= "??? "
+
+instance <<< Annotation
+where
+	(<<<) file an = file <<< toString an
+
+instance toString Annotation
+where
+	toString AN_Strict	= "!" 
+	toString _			= "" 
+
+instance <<< ATypeVar
+where
+	(<<<) file {atv_annotation,atv_attribute,atv_variable}
+		= file <<< atv_annotation <<< atv_attribute <<< atv_variable
+
+instance <<< ConsVariable
+where
+	(<<<) file (CV tv)
+		= file <<< tv
+	(<<<) file (TempCV tv)
+		= file <<<  "v" <<< tv <<< ' ' 
+
+instance <<< Type
+where
+	(<<<) file (TV varid)
+		= file <<< varid
+	(<<<) file (TempV tv_number)
+		= file  <<< 'v' <<< tv_number <<< ' ' 
+	(<<<) file (TA consid types)
+		= file  <<< consid <<< " " <<< types
+	(<<<) file (arg_type --> res_type)
+		= file <<< arg_type <<< " -> " <<< res_type
+	(<<<) file (type :@: types)
+		= file <<< type <<< " @" <<< types
+	(<<<) file (TB tb)
+		= file <<< tb
+/*	(<<<) file (TFA vars types)
+		= file <<< "A." <<< vars <<< ':' <<< types
+*/	(<<<) file (TQV varid)
+		= file <<< "E." <<< varid
+	(<<<) file (TempQV tv_number)
+		= file  <<< "E." <<< tv_number <<< ' ' 
+	(<<<) file TE
+		= file <<< "### EMPTY ###"
+/*
+instance <<< [a] | <<< , needs_brackets a
+where
+	(<<<) file [] 		= file
+	(<<<) file [x:xs]
+		| needs_brackets x
+			= file <<< " (" <<< x <<< ')' <<< xs
+			= file <<< ' ' <<< x <<< xs
+*/
+
+instance <<< SymbolType
+where
+	(<<<) file st=:{st_vars,st_attr_vars}
+		| st.st_arity == 0
+			= write_inequalities st.st_attr_env (write_contexts st.st_context (file <<< '[' <<< st_vars <<< ',' <<< st_attr_vars <<< ']' <<< st.st_result))
+			= write_inequalities st.st_attr_env (write_contexts st.st_context (file <<< '[' <<< st_vars <<< ',' <<< st_attr_vars <<< ']' <<< st.st_args <<< " -> " <<< st.st_result))
+
+write_contexts [] file
+	= file
+write_contexts [tc : tcs] file
+	= write_contexts2 tcs (file <<< " | " <<< tc) 
+where
+	write_contexts2 [] file
+		= file
+	write_contexts2 [tc : tcs] file
+		= write_contexts2 tcs (file <<< " & " <<< tc)
+
+instance <<< AttrInequality
+where
+	(<<<) file {ai_demanded,ai_offered}
+		= file <<< ai_offered <<< " <= " <<< ai_demanded
+	
+write_inequalities [] file
+	= file
+write_inequalities [ineq:ineqs] file
+	= write_remaining_inequalities ineqs (file <<< ',' <<< ineq)
+where
+	write_remaining_inequalities [] file
+		= file
+	write_remaining_inequalities [ineq:ineqs] file
+		= write_remaining_inequalities ineqs (file <<< ' ' <<< ineq)
+
+instance <<< TypeContext
+where
+	(<<<) file co = file <<< co.tc_class <<< " " <<< co.tc_types
+
+instance <<< SymbIdent
+where
+	(<<<) file symb=:{symb_kind = SK_Function symb_index } = file <<< symb.symb_name <<<  '.' <<< symb_index
+	(<<<) file symb=:{symb_kind = SK_GeneratedFunction _ symb_index } = file <<< symb.symb_name <<<  '.' <<< symb_index
+	(<<<) file symb=:{symb_kind = SK_OverloadedFunction symb_index } = file <<< symb.symb_name <<<  "OL"
+	(<<<) file symb = file <<< symb.symb_name 
+
+instance <<< TypeSymbIdent
+where
+	(<<<) file symb	= file <<< symb.type_name <<< '.' <<< symb.type_arity
+
+instance <<< ClassSymbIdent
+where
+	(<<<) file symb	= file <<< symb.cs_name 
+
+instance <<< BoundVar
+where
+	(<<<) file {var_name,var_info_ptr,var_expr_ptr}
+		= file <<< var_name <<< '<' <<< ptrToInt var_info_ptr <<< ',' <<< ptrToInt var_expr_ptr <<< '>'
+
+instance <<< Bind a b | <<< a & <<< b 
+where
+	(<<<) file {bind_src,bind_dst} = file <<< bind_dst <<<  " = " <<< bind_src 
+
+
+instance <<< AlgebraicPattern
+where
+	(<<<) file g = file <<< g.ap_symbol <<< g.ap_vars <<< " -> " <<< g.ap_expr
+
+instance <<< BasicPattern
+where
+	(<<<) file g = file <<< g.bp_value <<< " -> " <<< g.bp_expr
+
+instance <<< CasePatterns
+where
+	(<<<) file (BasicPatterns type patterns) = file <<< patterns
+	(<<<) file (AlgebraicPatterns type patterns) = file <<< patterns
+	(<<<) file (DynamicPatterns patterns) = file <<< patterns
+	(<<<) file NoPattern = file 
+
+instance <<< Qualifier
+where
+	(<<<) file {qual_generators,qual_filter = Yes qual_filter} = file <<< qual_generators <<< "| " <<< qual_filter
+	(<<<) file {qual_generators,qual_filter = No} = file <<< qual_generators
+
+instance <<< Generator
+where
+	(<<<) file {gen_kind,gen_pattern,gen_expr}
+		= file <<< gen_pattern <<< (if gen_kind "<-" "<-:") <<< gen_expr
+
+instance <<< BasicValue
+where
+	(<<<) file (BVI int)	= file <<< int
+	(<<<) file (BVC char)	= file <<< char
+	(<<<) file (BVB bool)	= file <<< bool
+	(<<<) file (BVR real)	= file <<< real
+	(<<<) file (BVS string)	= file <<< string
+	
+instance <<< Sequence
+where
+	(<<<) file (SQ_From expr) = file <<< expr
+	(<<<) file (SQ_FromTo from_expr to_expr) = file <<< from_expr <<< ".."  <<< to_expr
+	(<<<) file (SQ_FromThen from_expr then_expr) = file <<< from_expr  <<< ',' <<< then_expr <<< ".."
+	(<<<) file (SQ_FromThenTo from_expr then_expr to_expr) = file <<< from_expr  <<< ',' <<< then_expr <<< ".." <<< to_expr
+
+instance <<< Expression
+where
+	(<<<) file (Var ident) = file <<< ident
+	(<<<) file (App {app_symb, app_args})
+		= file <<< app_symb <<< ' ' <<< app_args
+	(<<<) file (f_exp @ a_exp) = file <<< '(' <<< f_exp <<< " @ " <<< a_exp <<< ')'
+	(<<<) file (Let {let_binds, let_expr}) = write_binds (file <<< "let " <<< '\n') let_binds <<< "in\n" <<< let_expr
+	where
+		write_binds file []
+			= file
+		write_binds file [bind : binds]
+			= write_binds (file <<< bind <<< '\n') binds
+	(<<<) file (Case {case_expr,case_guards,case_default=No})
+		= file <<< "case " <<< case_expr <<< " of\n" <<< case_guards
+	(<<<) file (Case {case_expr,case_guards,case_default= Yes def_expr})
+		= file <<< "case " <<< case_expr <<< " of\n" <<< case_guards <<< "\n\t-> " <<< def_expr
+	(<<<) file (BasicExpr basic_value basic_type) = file <<< basic_value
+	(<<<) file (Conditional {if_cond,if_then,if_else}) =
+			else_part (file <<< "IF " <<< if_cond <<< "\nTHEN\n" <<< if_then) if_else
+	where
+		else_part file No = file <<< '\n'
+		else_part file (Yes else) = file <<< "\nELSE\n" <<< else <<< '\n'
+
+/*	(<<<) file (Conditional {if_cond = {con_positive,con_expression},if_then,if_else}) =
+			else_part (file <<< (if con_positive "IF " "IFNOT ") <<< con_expression <<< "\nTHEN\n" <<< if_then) if_else
+	where
+		else_part file No = file <<< '\n'
+		else_part file (Yes else) = file <<< "\nELSE\n" <<< else <<< '\n'
+*/
+ 	(<<<) file (Selection opt_tuple expr selectors) = file <<< expr <<< selector_kind opt_tuple <<< selectors
+	where
+		selector_kind No		= '.'
+		selector_kind (Yes _)	= '!'
+	(<<<) file (Update expr1 selections expr2) =  file <<< '{' <<< expr1  <<< " & " <<<  selections <<< " = " <<< expr2 <<< '}'
+	(<<<) file (RecordUpdate cons_symbol expression expressions) = file <<< '{' <<< cons_symbol <<< ' ' <<< expression <<< " & " <<< expressions <<< '}'
+	(<<<) file (TupleSelect field field_nr expr) = file <<< expr <<<'.' <<< field_nr
+	(<<<) file (Lambda vars expr) = file <<< '\\' <<< vars <<< " -> " <<< expr
+	(<<<) file WildCard = file <<< '_'
+	(<<<) file (MatchExpr _ cons expr) = file <<< cons <<< " =: " <<< expr
+	(<<<) file EE = file <<< "** E **"
+	(<<<) file (DynamicExpr {dyn_expr,dyn_uni_vars,dyn_type_code})     = writeVarPtrs (file <<< "dynamic " <<< dyn_expr <<< " :: ") dyn_uni_vars <<< dyn_type_code 
+//	(<<<) file (TypeCase type_case)      = file <<< type_case
+	(<<<) file (TypeCodeExpression type_code)      = file <<< type_code
+	(<<<) file (Constant symb _ _ _)         = file <<<  "** Constant **" <<< symb
+
+	(<<<) file (ABCCodeExpr code_sequence do_inline)      = file <<< (if do_inline "code inline\n" "code\n") <<< code_sequence
+	(<<<) file (AnyCodeExpr input output code_sequence)   = file <<< "code\n" <<< input <<< "\n" <<< output <<< "\n" <<< code_sequence
+
+	(<<<) file (FreeVar {fv_name})         	= file <<< "FREEVAR " <<< fv_name
+	(<<<) file expr         				= abort ("<<< (Expression) [line 1290]" <<- expr)
+	
+instance <<< TypeCase
+where
+	(<<<) file {type_case_dynamic,type_case_patterns,type_case_default}
+			= file <<< "typecase " <<< type_case_dynamic <<< "of\n" <<<
+				type_case_patterns <<< type_case_default
+
+instance <<< DynamicPattern
+where
+	(<<<) file {dp_type_patterns_vars,dp_var,dp_rhs,dp_type_code}
+			= writeVarPtrs (file <<< dp_var <<< " :: ")  dp_type_patterns_vars <<<  dp_type_code <<< " = " <<< dp_rhs
+
+writeVarPtrs file []
+	= file
+writeVarPtrs file vars
+	= write_var_ptrs (file <<< '<') vars <<< '>'
+	where
+		write_var_ptrs file [var]
+			= file <<< ptrToInt var
+		write_var_ptrs file [var : vars]
+			= write_var_ptrs (file <<< ptrToInt var <<< '.') vars
+		
+		
+instance <<< TypeCodeExpression
+where
+	(<<<) file TCE_Empty
+		= file
+	(<<<) file (TCE_Var info_ptr)
+		= file <<< "VAR " <<< ptrToInt info_ptr
+	(<<<) file (TCE_Constructor index exprs)
+		= file <<< "CONS " <<< index <<< ' ' <<< exprs
+	(<<<) file (TCE_Selector selectors info_ptr)
+		= file <<< "CONS " <<< selectors <<< "VAR " <<< ptrToInt info_ptr
+
+instance <<< Selection
+where
+	(<<<) file (RecordSelection selector _) = file <<< selector
+	(<<<) file (ArraySelection _ _ index_expr) = file <<< '[' <<< index_expr <<< ']'
+	(<<<) file (DictionarySelection var selections _ index_expr) = file <<< '(' <<< var <<< '.' <<< selections <<< ')' <<< '[' <<< index_expr <<< ']'
+
+instance <<< LocalDefs
+where
+	(<<<) file (LocalParsedDefs defs) = file <<< defs
+	(<<<) file (CollectedLocalDefs defs) = file <<< defs
+
+instance <<< NodeDef dst | <<< dst 
+where
+	(<<<) file {nd_dst,nd_alts,nd_locals} = file <<< nd_dst <<< nd_alts <<< nd_locals
+
+
+instance <<< CollectedLocalDefs
+where
+	(<<<) file {loc_functions,loc_nodes}
+		= file <<< loc_functions <<< loc_nodes
+/*
+	(<<<) file {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances}
+		= file <<< def_types <<< def_constructors <<< def_selectors <<< def_macros <<< def_classes <<< def_members <<< def_instances
+*/
+
+instance <<< ParsedExpr
+where
+	(<<<) file (PE_List exprs) = file <<< exprs
+	(<<<) file (PE_Tuple args) = file <<< '(' <<< args <<< ')'
+	(<<<) file (PE_Basic basic_value) = file <<< basic_value
+	(<<<) file (PE_Selection is_unique expr selectors) =  file <<< expr <<< (if is_unique '!' '.') <<< selectors
+	(<<<) file (PE_Update expr1 selections expr2) =  file <<< '{' <<< expr1  <<< " & " <<<  selections <<< " = " <<< expr2 <<< '}'
+	(<<<) file (PE_Record PE_Empty _ fields) = file <<< '{' <<< fields <<< '}'
+	(<<<) file (PE_Record rec _ fields) = file <<< '{' <<< rec <<< " & " <<< fields <<< '}'
+	(<<<) file (PE_Compr True expr quals) = file <<< '[' <<< expr <<< " \\ " <<< quals <<< ']'
+	(<<<) file (PE_Compr False expr quals) = file <<< '{' <<< expr <<< " \\ " <<< quals <<< '}'
+	(<<<) file (PE_Sequ seq) = file <<< '[' <<< seq <<< ']'
+	(<<<) file PE_Empty = file <<< "** E **"
+	(<<<) file (PE_Ident symb) = file <<< symb
+	(<<<) file PE_WildCard = file <<< '_'
+	(<<<) file (PE_Lambda _ exprs expr) = file <<< '\\' <<< exprs <<< " -> " <<< expr
+	(<<<) file (PE_Bound bind) = file <<< bind
+	(<<<) file (PE_Case _ expr alts) = file <<< "case " <<< expr <<< " of\n" <<< alts
+	(<<<) file (PE_Let _ defs expr) = file <<< "let " <<< defs <<< " in\n" <<< expr
+	(<<<) file (PE_DynamicPattern expr type) = file <<< expr <<< "::" <<< type
+	(<<<) file (PE_Dynamic expr maybetype)
+		= case maybetype of
+			Yes type
+				-> file <<< "dynamic " <<< expr <<< "::" <<< type
+			No
+				-> file <<< "dynamic " <<< expr
+	(<<<) file _ = file <<< "some expression"
+
+
+instance <<< ParsedSelection
+where
+	(<<<) file (PS_Record selector _)	= file <<< selector
+	(<<<) file (PS_Array index_expr)	= file <<< '[' <<< index_expr <<< ']'
+	(<<<) file PS_Erroneous				= file <<< "Erroneous selector" // PK
+
+instance <<< CaseAlt
+where
+	(<<<) file {calt_pattern,calt_rhs} = file <<< calt_pattern <<< " -> " <<< calt_rhs
+
+instance <<< ParsedBody
+where
+	(<<<) file {pb_args,pb_rhs} = file <<< pb_args <<< " = " <<< pb_rhs
+	
+instance <<< BackendBody
+where
+	(<<<) file {bb_args,bb_rhs} = file <<< bb_args <<< " = " <<< bb_rhs
+
+instance <<< FunctionPattern
+where
+	(<<<) file (FP_Basic val (Yes var))
+		= file <<< var <<< "=:" <<< val
+	(<<<) file (FP_Basic val No)
+		= file <<< val
+	(<<<) file (FP_Algebraic constructor vars (Yes var))
+		= file <<< var <<< "=:" <<< constructor <<< vars
+	(<<<) file (FP_Algebraic constructor vars No)
+		= file <<< constructor <<< vars
+	(<<<) file (FP_Variable var) = file <<< var 
+	(<<<) file (FP_Dynamic vars var type_code _)
+		= writeVarPtrs (file <<< var <<< " :: ") vars <<<  type_code
+	(<<<) file (FP_Empty) = file <<< '_' 
+
+
+instance <<< FunDef
+where
+	(<<<) file {fun_symb,fun_index,fun_body=ParsedBody bodies} = file <<< fun_symb <<< '.' <<< fun_index <<< ' ' <<< bodies 
+	(<<<) file {fun_symb,fun_index,fun_body=CheckedBody {cb_args,cb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} = file <<< fun_symb <<< '.'
+			<<< fun_index <<< "C " <<< cb_args <<< " = " <<< cb_rhs 
+//			<<< fun_index <<< '.' <<< fi_def_level <<< ' ' <<< '[' <<< fi_free_vars <<< ']' <<< cb_args <<< " = " <<< cb_rhs 
+	(<<<) file {fun_symb,fun_index,fun_body=TransformedBody {tb_args,tb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} = file <<< fun_symb <<< '.'
+			<<< fun_index <<< "T "  <<< tb_args <<< '[' <<< fi_calls <<< ']' <<< " = " <<< tb_rhs 
+//			<<< fun_index <<< '.' <<< fi_def_level <<< ' ' <<< '[' <<< fi_free_vars <<< ']' <<< tb_args <<< " = " <<< tb_rhs 
+	(<<<) file {fun_symb,fun_index,fun_body=BackendBody body,fun_type=Yes type} = file <<< type <<< '\n' <<< fun_symb <<< '.'
+			<<< fun_index <<< body <<< '\n'
+instance <<< FunCall
+where
+	(<<<) file { fc_level,fc_index }
+			= file <<< fc_index <<< '.' <<< fc_level
+
+instance <<< FreeVar
+where
+	(<<<) file {fv_name,fv_info_ptr} = file <<< fv_name <<< '<' <<< ptrToInt fv_info_ptr <<< '>'
+
+instance <<< DynamicType
+where
+	(<<<) file {dt_uni_vars,dt_type}
+		| isEmpty dt_uni_vars
+			= file <<< dt_type
+			= file <<< "A." <<< dt_uni_vars <<< ":" <<< dt_type
+			
+
+instance <<< SignClassification
+where
+	(<<<) file {sc_pos_vect,sc_neg_vect} = write_signs file sc_pos_vect sc_neg_vect 0
+	where
+		write_signs file sc_pos_vect sc_neg_vect index
+			| sc_pos_vect == 0 && sc_neg_vect == 0
+				= file
+			#	index_bit = (1 << index)
+			| sc_pos_vect bitand index_bit == 0
+				| sc_neg_vect bitand index_bit == 0
+					= write_signs (file <<< 'O') sc_pos_vect sc_neg_vect (inc index)
+					= write_signs (file <<< '-') sc_pos_vect (sc_neg_vect bitand (bitnot index_bit)) (inc index)
+				| sc_neg_vect bitand index_bit == 0
+					= write_signs (file <<< '+') (sc_pos_vect bitand (bitnot index_bit)) sc_neg_vect (inc index)
+					= write_signs (file <<< 'T') (sc_pos_vect bitand (bitnot index_bit)) (sc_neg_vect bitand (bitnot index_bit)) (inc index)
+				
+instance <<< TypeKind
+where
+	(<<<) file (KindVar _) = file <<< "**"
+	(<<<) file KindConst
+		= file <<< '*'
+	(<<<) file (KindArrow arity)
+		= write_kinds file arity
+	where
+		write_kinds file 1
+			= file <<< "* -> *"
+		write_kinds file n
+			= write_kinds (file <<< "* -> ") (dec n)
+		
+
+instance <<< TypeDefInfo
+where
+	(<<<) file {tdi_group,tdi_group_vars,tdi_cons_vars}
+		= file <<< '[' <<< tdi_group <<< '=' <<< tdi_group_vars <<< '=' <<< tdi_cons_vars <<< ']'
+
+instance <<< DefinedSymbol
+where
+	(<<<) file {ds_ident}
+		= file <<< ds_ident 
+
+instance <<< TypeDef a | <<< a
+where
+	(<<<) file {td_name, td_args, td_rhs}
+		= file <<< ":: " <<< td_name <<< ' ' <<< td_args <<< td_rhs
+
+instance <<< TypeRhs
+where
+	(<<<) file (SynType type)
+		= file <<< " :== " <<< type 
+	(<<<) file (AlgType data)
+		= file <<< " = " <<< data 
+	(<<<) file (RecordType record)
+		= file <<< " = " <<< '{' <<< record <<< '}'
+	(<<<) file _
+		= file 
+
+
+instance <<< RecordType
+where
+	(<<<) file {rt_fields} = iFoldSt (\index file -> file <<< rt_fields.[index]) 0 (size rt_fields) file
+
+instance <<< FieldSymbol
+where
+	(<<<) file {fs_name} = file <<< fs_name
+
+/*
+	where
+		write_data_defs file []
+			= file
+		write_data_defs file [d:ds]
+			= write_data_defs (file <<< d <<< '\n') ds
+*/
+
+instance <<< InstanceType
+where
+	(<<<) file it = write_contexts it.it_context (file <<< it.it_types) 
+
+instance <<< RhsDefsOfType
+where
+	(<<<) file (ConsList cons_defs) = file <<< cons_defs
+	(<<<) file (SelectorList _ _ sel_defs) = file <<< sel_defs
+	(<<<) file (TypeSpec type) = file <<< type
+	(<<<) file _ = file
+
+instance <<< ParsedConstructor
+where
+	(<<<) file {pc_cons_name,pc_arg_types} = file <<< pc_cons_name <<< pc_arg_types
+
+instance <<< ParsedSelector
+where
+	(<<<) file {ps_field_name,ps_field_type} = file <<< ps_field_name <<< ps_field_type
+
+
+instance <<< ModuleKind
+where
+	(<<<) file kind 		= file
+
+instance <<< ConsDef
+where
+	(<<<) file {cons_symb,cons_type} = file <<< cons_symb <<< " :: " <<< cons_type
+
+instance <<< SelectorDef
+where
+	(<<<) file {sd_symb} = file <<< sd_symb
+
+instance <<< ClassDef
+where
+	(<<<) file {class_name} = file <<< class_name
+
+instance <<< ClassInstance
+where
+	(<<<) file {ins_class,ins_type} = file <<< ins_class <<< " :: " <<< ins_type
+
+instance <<< Optional a | <<< a
+where
+	(<<<) file (Yes x) = file <<< x
+	(<<<) file No = file
+	
+instance <<< Module a | <<< a
+where
+	(<<<) file {mod_name,mod_type,mod_defs} = file <<< mod_type <<< mod_name <<< mod_defs
+
+instance <<< CollectedDefinitions a b | <<< a & <<< b
+where
+	(<<<) file {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances}
+		= file
+
+instance <<< ParsedDefinition
+where
+	(<<<) file (PD_Function _ name _ exprs rhs _ ) = file <<< name <<< exprs <<< " = " <<< rhs
+	(<<<) file (PD_NodeDef  _ pattern rhs) = file <<< pattern <<< " =: " <<< rhs
+	(<<<) file (PD_TypeSpec _ name prio st sp) = file <<< name <<< st
+	(<<<) file (PD_Type td) = file <<< td
+	(<<<) file _ = file
+
+instance <<< Rhs
+where
+	(<<<) file {rhs_alts,rhs_locals} = file <<< rhs_alts <<< rhs_locals
+
+instance <<< OptGuardedAlts
+where
+	(<<<) file (GuardedAlts guarded_exprs def_expr) = file <<<guarded_exprs <<< def_expr
+	(<<<) file (UnGuardedExpr unguarded_expr) = file <<< unguarded_expr
+
+instance <<< ExprWithLocalDefs
+where
+	(<<<) file {ewl_expr,ewl_locals} = file <<< ewl_expr <<< ewl_locals
+
+instance <<< GuardedExpr
+where
+	(<<<) file {alt_nodes,alt_guard,alt_expr} = file <<< '|' <<< alt_guard <<< alt_expr
+
+
+instance <<< IndexRange
+where
+	(<<<) file {ir_from,ir_to}
+		| ir_from == ir_to
+			= file
+			= file <<< ir_from <<< "---" <<< ir_to
+
+instance <<< Ident
+where
+//	(<<<) file {id_name,id_index} = file <<< id_name <<< '.' <<< id_index
+	(<<<) file {id_name} = file <<< id_name
+
+instance <<< Global a | <<< a
+where
+	(<<<) file {glob_object,glob_module} = file <<< glob_object <<< '.' <<< glob_module
+
+instance <<< Position
+where
+	(<<<) file (FunPos file_name line func) = file <<< '[' <<< file_name <<< ',' <<< line <<< ',' <<< func <<< ']'
+	(<<<) file (LinePos file_name line) = file <<< '[' <<< file_name <<< ',' <<< line <<< ']'
+	(<<<) file _ = file
+
+instance <<< TypeVarInfo
+where
+	(<<<) file TVI_Empty				= file <<< "TVI_Empty"
+	(<<<) file (TVI_Type _)				= file <<< "TVI_Type"
+	(<<<) file (TVI_Forward	_) 			= file <<< "TVI_Forward"
+	(<<<) file (TVI_TypeKind _)			= file <<< "TVI_TypeKind"
+	(<<<) file (TVI_SignClass _ _ _) 	= file <<< "TVI_SignClass"
+	(<<<) file (TVI_PropClass _ _ _) 	= file <<< "TVI_PropClass"
+
+instance <<< (Import from_symbol) | <<< from_symbol
+where
+	(<<<) file {import_module, import_symbols}
+		= file <<< "import " <<< import_module <<< import_symbols
+
+instance <<< ImportDeclaration
+where
+	(<<<) file (ID_Function ident)			= file <<< ident
+	(<<<) file (ID_Class ident optIdents)	= file <<< "class " <<< ident <<< optIdents
+	(<<<) file (ID_Type ident optIdents)	= file <<< ":: " <<< ident <<< optIdents
+	(<<<) file (ID_Record ident optIdents)	= file <<< ident <<< " { " <<< optIdents <<< " } "
+	(<<<) file (ID_Instance i1 i2 tup)		= file <<< "instance " <<< i1 <<< i2 <<< tup // !ImportedIdent !Ident !(![Type],![TypeContext])
+
+instance <<< ImportedIdent
+where
+	(<<<) file {ii_ident, ii_extended}	= file <<< ii_ident <<< ' ' <<< ii_extended
+
+instance == ModuleKind
+where
+	(==) mk1 mk2 = equal_constructor mk1 mk2
+
+instance == TypeAttribute
+where
+	(==) attr1 attr2 = equal_constructor attr1 attr2
+
+instance == Annotation
+where
+	(==) a1 a2 = equal_constructor a1 a2
+
+EmptySymbolTableEntry :== 
+	{	ste_kind = STE_Empty, ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" }
+
+cNotAGroupNumber :== -1
+
+EmptyTypeDefInfo :== { tdi_kinds = [], tdi_properties = cAllBitsClear, tdi_group = [], tdi_group_vars = [], tdi_cons_vars = [],
+					   tdi_classification = EmptyTypeClassification, tdi_group_nr = cNotAGroupNumber }
+
+MakeTypeVar name :== { tv_name = name, tv_info_ptr = nilPtr }
+MakeVar name :== { var_name = name, var_info_ptr = nilPtr, var_expr_ptr = nilPtr }
+
+MakeAttributedType type :== { at_attribute = TA_None, at_annotation = AN_None, at_type = type }
+MakeAttributedTypeVar type_var :== { atv_attribute = TA_None, atv_annotation = AN_None, atv_variable = type_var }
+
+EmptyFunInfo :== { fi_calls = [], fi_group_index = NoIndex, fi_def_level = NotALevel,
+				   fi_free_vars = [], fi_local_vars = [], fi_dynamics = [] }
+
+BottomSignClass		:== { sc_pos_vect = 0, sc_neg_vect = 0 }
+PostiveSignClass	:== { sc_pos_vect = bitnot 0, sc_neg_vect = 0 }
+
+NoPropClass			:== 0
+PropClass			:== bitnot 0
+
+MakeNewTypeSymbIdent name arity
+	:== MakeTypeSymbIdent { glob_object = NoIndex, glob_module = NoIndex } name arity
+
+MakeTypeSymbIdent type_index name arity
+	:== {	type_name = name, type_arity = arity, type_index = type_index,
+			type_prop = { tsp_sign = BottomSignClass, tsp_propagation = NoPropClass, tsp_coercible = True }}
+
+MakeSymbIdent name arity	:== { symb_name = name, symb_kind = SK_Unknown, symb_arity = arity }
+MakeConstant name			:== MakeSymbIdent name 0
+
+ParsedSelectorToSelectorDef ps var_ptr :==
+	{	sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos =  ps.ps_field_pos, sd_type_index = NoIndex,
+		sd_exi_vars = [], /* sd_exi_attrs = [], */ sd_type_ptr = var_ptr, sd_field = ps.ps_field_name,
+		sd_type	= { st_vars = [], st_args = [], st_result = ps.ps_field_type, st_arity = 0, st_context = [],
+				    st_attr_env = [], st_attr_vars = [] }}
+
+ParsedConstructorToConsDef pc var_ptr :==
+	{	cons_symb = pc.pc_cons_name, cons_pos = pc.pc_cons_pos, cons_priority = pc.pc_cons_prio, cons_index = NoIndex, cons_type_index = NoIndex,
+		cons_type = { st_vars = [], st_args = pc.pc_arg_types, st_result = MakeAttributedType TE, 
+				  st_arity = pc.pc_cons_arity, st_context = [], st_attr_env = [], st_attr_vars = []},
+		cons_exi_vars = pc.pc_exi_vars, /* cons_exi_attrs = [], */ cons_type_ptr = var_ptr, cons_arg_vars = [] }
+
+ParsedInstanceToClassInstance pi members :==
+ 	{	ins_class = {glob_object = MakeDefinedSymbol pi.pi_class NoIndex (length pi.pi_types), glob_module = NoIndex}, ins_ident = pi.pi_ident, 
+ 		ins_type = { it_vars = [], it_types = pi.pi_types, it_attr_vars = [],
+ 					 it_context = pi.pi_context }, ins_members = members, ins_specials = pi.pi_specials, ins_pos = pi.pi_pos }
+
+MakeTypeDef name lhs rhs attr contexts pos  :== 
+	{	td_name = name, td_index = -1, td_arity = length lhs, td_args = lhs, td_attrs = [], td_attribute = attr, td_context = contexts,
+		td_pos = pos, td_rhs = rhs }
+
+MakeDefinedSymbol ident index arity :== { ds_ident = ident, ds_arity = arity, ds_index = index }
+
+MakeNewFunctionType name arity prio type pos specials var_ptr
+	:== { ft_symb = name, ft_arity = arity, ft_priority = prio, ft_type = type, ft_pos = pos, ft_specials = specials, ft_type_ptr = var_ptr  }
+
diff --git a/frontend/trans.dcl b/frontend/trans.dcl
new file mode 100644
index 0000000..7c24ebf
--- /dev/null
+++ b/frontend/trans.dcl
@@ -0,0 +1,21 @@
+definition module trans
+
+import StdEnv
+
+import syntax, transform
+
+cPassive   		:== -1
+cActive			:== -2
+cAccumulating   :== -3
+
+analyseGroups :: !*{! Group} !*{#FunDef} !*VarHeap -> (!*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap)
+
+transformGroups :: !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs}  !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
+	-> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
+
+partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef})
+
+::	ImportedConstructors	:== [Global Index]
+
+convertSymbolType :: !{# CommonDefs} !SymbolType !*{#{# CheckedTypeDef}} !ImportedConstructors !*TypeHeaps !*VarHeap
+	-> (!SymbolType, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
diff --git a/frontend/trans.icl b/frontend/trans.icl
new file mode 100644
index 0000000..77f7e0d
--- /dev/null
+++ b/frontend/trans.icl
@@ -0,0 +1,1172 @@
+implementation module trans
+
+import StdEnv
+
+import syntax, transform, checksupport, StdCompare, check, utilities
+
+import RWSDebug
+
+::	PartitioningInfo = 
+	{	pi_marks :: 		!.{# Int}
+	,	pi_next_num ::		!Int
+	,	pi_next_group ::	!Int
+	,	pi_groups ::		![[Int]]
+	,	pi_deps ::			![Int]
+	}
+
+NotChecked :== -1	
+
+partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef})
+partitionateFunctions fun_defs ranges
+	#! max_fun_nr = size fun_defs
+	# partitioning_info = { pi_marks = createArray max_fun_nr NotChecked, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] }
+	  (fun_defs, {pi_groups,pi_next_group}) = 
+	  		foldSt (partitionate_functions max_fun_nr) ranges (fun_defs, partitioning_info)
+	  groups = { {group_members = group} \\ group <- reverse pi_groups }
+	= (groups, fun_defs)
+where
+	partitionate_functions :: !Index !IndexRange !(!*{# FunDef}, !*PartitioningInfo) -> (!*{# FunDef}, !*PartitioningInfo)
+	partitionate_functions max_fun_nr ir=:{ir_from,ir_to} (fun_defs, pi=:{pi_marks})
+		| ir_from == ir_to
+			= (fun_defs, pi)
+		| pi_marks.[ir_from] == NotChecked
+			# (_, fun_defs, pi) = partitionate_function ir_from max_fun_nr fun_defs pi
+			= partitionate_functions max_fun_nr { ir & ir_from = inc ir_from } (fun_defs, pi)
+			= partitionate_functions max_fun_nr { ir & ir_from = inc ir_from } (fun_defs, pi)
+
+	partitionate_function :: !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo)
+	partitionate_function fun_index max_fun_nr fun_defs pi=:{pi_next_num}
+		#! fd = fun_defs.[fun_index]
+		# {fi_calls} = fd.fun_info
+		  (min_dep, fun_defs, pi) = visit_functions fi_calls max_fun_nr max_fun_nr fun_defs (push_on_dep_stack fun_index pi)
+		= try_to_close_group fun_index pi_next_num min_dep max_fun_nr fun_defs pi
+
+/*				  
+	partitionate_function :: !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo)
+	partitionate_function fun_index max_fun_nr fun_defs pi=:{pi_next_num}
+		#! fd = fun_defs.[fun_index]
+		| fd.fun_kind
+			# {fi_calls} = fd.fun_info
+			  (min_dep, fun_defs, pi) = visit_functions fi_calls max_fun_nr max_fun_nr fun_defs (push_on_dep_stack fun_index pi)
+			= try_to_close_group fun_index pi_next_num min_dep max_fun_nr fun_defs pi
+			= (max_fun_nr, fun_defs, pi)
+*/
+	push_on_dep_stack :: !Int !*PartitioningInfo -> *PartitioningInfo;
+	push_on_dep_stack fun_index pi=:{pi_deps,pi_marks,pi_next_num}
+		= { pi & pi_deps = [fun_index : pi_deps], pi_marks = { pi_marks & [fun_index] = pi_next_num}, pi_next_num = inc pi_next_num}
+
+	visit_functions :: ![FunCall] !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo)
+	visit_functions [{fc_index}:funs] min_dep max_fun_nr fun_defs pi=:{pi_marks} 
+		#! mark = pi_marks.[fc_index]
+		| mark == NotChecked
+			# (mark, fun_defs, pi) = partitionate_function fc_index max_fun_nr fun_defs  pi
+			= visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi
+			= visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi
+	visit_functions [] min_dep max_fun_nr fun_defs pi
+		= (min_dep, fun_defs, pi)
+		
+
+	try_to_close_group :: !Int !Int !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo)
+	try_to_close_group fun_index fun_nr min_dep max_fun_nr fun_defs pi=:{pi_marks, pi_deps, pi_groups, pi_next_group}
+		| fun_nr <= min_dep
+			# (pi_deps, pi_marks, group, fun_defs)
+				= close_group fun_index pi_deps pi_marks [] max_fun_nr pi_next_group fun_defs
+			  pi = { pi & pi_deps = pi_deps, pi_marks = pi_marks, pi_next_group = inc pi_next_group,  pi_groups = [group : pi_groups] }
+			= (max_fun_nr, fun_defs, pi)
+			= (min_dep, fun_defs, pi)
+	where
+		close_group :: !Int ![Int] !*{# Int} ![Int] !Int !Int !*{# FunDef} -> (![Int], !*{# Int}, ![Int], !*{# FunDef})
+		close_group fun_index [d:ds] marks group max_fun_nr group_number fun_defs
+			# marks = { marks & [d] = max_fun_nr }
+			#! fd = fun_defs.[d]
+			# fun_defs = { fun_defs & [d] = { fd & fun_info.fi_group_index = group_number }}
+			| d == fun_index
+				= (ds, marks, [d : group], fun_defs)
+				= close_group fun_index ds marks [d : group] max_fun_nr group_number fun_defs
+
+::	BitVector :== Int
+
+::	*AnalyseInfo =
+	{	ai_heap			:: !*VarHeap
+	,	ai_cons_class	:: !*{! ConsClasses}
+	,	ai_class_subst	:: !* ConsClassSubst
+	,	ai_next_var		:: !Int
+	}
+
+::	ConsClassSubst	:== {# ConsClass}
+
+/*
+	The argument classification (i.e. 'accumulating', 'active' or 'passive') of consumers
+	is represented by an negative integer value.
+	Possitive classifications are used to identify variables.
+	Unification of classifications is done on-the-fly
+*/
+
+
+cPassive   		:== -1
+cActive			:== -2
+cAccumulating   :== -3
+
+IsAVariable cons_class :== cons_class >= 0
+
+combineClasses cc1 cc2
+	| IsAVariable cc1
+		= cAccumulating
+	| IsAVariable cc2
+		= cAccumulating
+		= min cc1 cc2
+ 
+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 :: Int !*ConsClassSubst -> (!Int,!*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
+			
+	combine_cons_classes :: !Int !Int !*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
+				   
+	combine_cons_constants cc1 cc2
+		= min cc1 cc2
+
+write_ptr ptr val heap mess
+	| isNilPtr ptr
+		= abort mess
+		= heap <:=  (ptr,val)
+
+class consumerRequirements a :: !a !AnalyseInfo -> (!ConsClass, !AnalyseInfo)
+
+instance consumerRequirements BoundVar
+where
+	consumerRequirements {var_info_ptr} ai=:{ai_heap}
+		#! var_info = sreadPtr var_info_ptr ai_heap
+		= case var_info of
+			VI_AccVar temp_var
+				-> (temp_var, ai)
+			_
+				-> (cPassive, ai)
+
+instance consumerRequirements Expression where
+	consumerRequirements (Var var) ai
+		= consumerRequirements var ai
+	consumerRequirements (App app) ai
+		= consumerRequirements app ai
+	consumerRequirements (fun_expr @ exprs) ai
+		# (cc_fun, ai) = consumerRequirements fun_expr ai
+		  ai_class_subst = unifyClassifications cActive cc_fun ai.ai_class_subst
+		= consumerRequirements exprs { ai & ai_class_subst = ai_class_subst }
+	consumerRequirements (Let {let_binds,let_expr}) ai=:{ai_next_var,ai_heap}
+		# (new_next_var, ai_heap) = init_variables let_binds ai_next_var ai_heap
+		# ai = acc_requirements_of_let_binds let_binds ai_next_var { ai & ai_next_var = new_next_var, ai_heap = ai_heap }
+		= consumerRequirements let_expr ai
+		where
+			init_variables [{bind_dst={fv_info_ptr}} : binds] ai_next_var ai_heap
+				= init_variables binds (inc ai_next_var) (write_ptr fv_info_ptr (VI_AccVar ai_next_var) ai_heap "init_variables")
+			init_variables [] ai_next_var ai_heap
+				= (ai_next_var, ai_heap)
+				
+			acc_requirements_of_let_binds [ {bind_src, bind_dst={fv_info_ptr}} : binds ] ai_next_var ai
+				# (bind_var, ai) = consumerRequirements bind_src ai
+		  		  ai_class_subst = unifyClassifications ai_next_var bind_var ai.ai_class_subst
+				= acc_requirements_of_let_binds binds (inc ai_next_var) { ai & ai_class_subst = ai_class_subst }
+			acc_requirements_of_let_binds [] ai_next_var ai
+				= ai
+				
+	consumerRequirements (Case case_expr) ai
+		= consumerRequirements case_expr ai
+	consumerRequirements (BasicExpr _ _) ai
+		= (cPassive, ai)
+	consumerRequirements (MatchExpr _ _ expr) ai
+		= consumerRequirements expr ai
+	consumerRequirements (Selection _ expr selectors) ai
+		# (cc, ai) = consumerRequirements expr ai
+		  ai_class_subst = unifyClassifications cActive cc ai.ai_class_subst
+		  ai = requirementsOfSelectors selectors { ai & ai_class_subst = ai_class_subst }
+		= (cPassive, ai)
+	consumerRequirements (Update expr1 selectors expr2) ai
+		# (cc, ai) = consumerRequirements expr1 ai
+		  ai = requirementsOfSelectors selectors ai
+		  (cc, ai) = consumerRequirements expr2 ai
+		= (cPassive, ai)
+	consumerRequirements (RecordUpdate cons_symbol expression expressions) ai
+		# (cc, ai) = consumerRequirements expression ai
+		  (cc, ai) = consumerRequirements expressions ai
+		= (cPassive, ai)
+	consumerRequirements (TupleSelect tuple_symbol arg_nr expr) ai
+		= consumerRequirements expr ai
+	consumerRequirements (AnyCodeExpr _ _ _) ai
+		= (cPassive, ai)
+	consumerRequirements (ABCCodeExpr _ _) ai
+		= (cPassive, ai)
+	consumerRequirements (DynamicExpr dynamic_expr) ai
+		= consumerRequirements dynamic_expr ai
+	consumerRequirements (TypeCodeExpression _) ai
+		= (cPassive, ai)
+	consumerRequirements EE ai
+		= (cPassive, ai)
+	consumerRequirements expr ai
+		= abort ("consumerRequirements " <<- expr)
+
+requirementsOfSelectors selectors ai
+	= foldSt reqs_of_selector selectors ai
+where
+	reqs_of_selector (ArraySelection _ _ index_expr) ai
+		# (_, ai) = consumerRequirements index_expr ai
+		= ai
+	reqs_of_selector (DictionarySelection dict_var _ _ index_expr) ai
+		# (_, ai) = consumerRequirements index_expr ai
+		  (cc_var, ai) = consumerRequirements dict_var ai
+		= { ai & ai_class_subst = unifyClassifications cActive cc_var ai.ai_class_subst }
+	reqs_of_selector _ ai
+		= ai
+			
+instance consumerRequirements App where
+	consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object}, symb_arity, symb_name}, app_args} ai=:{ai_cons_class}
+		| glob_module == cIclModIndex
+			| glob_object < size ai_cons_class
+				#! fun_class = ai_cons_class.[glob_object]
+				= reqs_of_args fun_class.cc_args app_args cPassive ai
+				= consumerRequirements app_args ai
+			= consumerRequirements app_args ai
+	where
+		reqs_of_args _ [] cumm_arg_class ai
+			= (cumm_arg_class, ai)
+		reqs_of_args [] _ cumm_arg_class ai
+			= (cumm_arg_class, ai)
+		reqs_of_args [form_cc : ccs] [arg : args] cumm_arg_class ai
+			# (act_cc, ai) = consumerRequirements arg ai
+			  ai_class_subst = unifyClassifications form_cc act_cc ai.ai_class_subst
+			= reqs_of_args ccs args (combineClasses act_cc cumm_arg_class) { ai & ai_class_subst = ai_class_subst }
+/*
+	consumerRequirements {app_symb={symb_kind = SK_InternalFunction _}, app_args=[arg:_]} ai
+		# (cc, ai) = consumerRequirements arg ai
+		  ai_class_subst = unifyClassifications cActive cc ai.ai_class_subst
+		= (cPassive, { ai & ai_class_subst = ai_class_subst })
+*/
+	consumerRequirements {app_args} ai
+		=  consumerRequirements app_args ai
+
+instance consumerRequirements Case where
+	consumerRequirements {case_expr,case_guards,case_default} ai
+		# (cce, ai) = consumerRequirements case_expr ai
+//		  ai_class_subst = unifyClassifications cActive cce ai.ai_class_subst
+		  (ccgs, ai) = consumerRequirements (case_guards,case_default) ai //{ ai & ai_class_subst = ai_class_subst }
+		= (ccgs, ai)
+
+instance consumerRequirements DynamicExpr where
+	consumerRequirements {dyn_expr} ai
+		= consumerRequirements dyn_expr ai
+
+/*
+instance consumerRequirements TypeCase where
+	consumerRequirements {type_case_dynamic,type_case_patterns,type_case_default} ai
+		# (_, ai) = consumerRequirements type_case_dynamic ai
+		  (ccgs, ai) = consumerRequirements (type_case_patterns,type_case_default) ai
+		= (ccgs, ai)
+*/
+
+instance consumerRequirements DynamicPattern where
+	consumerRequirements {dp_rhs} ai
+		= consumerRequirements dp_rhs ai
+
+instance consumerRequirements CasePatterns where
+	consumerRequirements (AlgebraicPatterns type patterns) ai
+		= consumerRequirements patterns ai
+	consumerRequirements (BasicPatterns type patterns) ai
+		= consumerRequirements patterns ai
+	consumerRequirements (DynamicPatterns dyn_patterns) ai
+		= consumerRequirements dyn_patterns ai
+	
+instance consumerRequirements AlgebraicPattern where
+	consumerRequirements {ap_vars,ap_expr} ai=:{ai_heap}
+		# ai_heap = bind_pattern_vars ap_vars ai_heap
+		= consumerRequirements ap_expr { ai & ai_heap = ai_heap }
+	where
+		bind_pattern_vars [{fv_info_ptr,fv_count} : vars] var_heap
+			| fv_count > 0
+				= bind_pattern_vars vars (write_ptr fv_info_ptr (VI_AccVar cPassive) var_heap "bind_pattern_vars")
+				= bind_pattern_vars vars var_heap
+		bind_pattern_vars [] var_heap
+			= var_heap
+
+instance consumerRequirements BasicPattern where
+	consumerRequirements {bp_expr} ai
+		= consumerRequirements bp_expr ai
+
+instance consumerRequirements (Optional a) | consumerRequirements a where
+	consumerRequirements (Yes x) ai
+		= consumerRequirements x ai
+	consumerRequirements No ai
+		= (cPassive, ai)
+
+instance consumerRequirements (!a,!b) | consumerRequirements a & consumerRequirements b where
+	consumerRequirements (x, y) ai
+		# (ccx, ai) = consumerRequirements x ai
+		  (ccy, ai) = consumerRequirements y ai
+		= (combineClasses ccx ccy, ai)
+		
+instance consumerRequirements [a] | consumerRequirements a where
+	consumerRequirements [x : xs] ai
+		# (ccx, ai) = consumerRequirements x ai
+		  (ccxs, ai) = consumerRequirements xs ai
+		= (combineClasses ccx ccxs, ai)
+	consumerRequirements [] ai
+		= (cPassive, ai)
+
+instance consumerRequirements (Bind a b) | consumerRequirements a where
+	consumerRequirements {bind_src} ai
+		= consumerRequirements bind_src ai
+
+analyseGroups :: !*{! Group} !*{#FunDef} !*VarHeap -> (!*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap)
+analyseGroups groups fun_defs var_heap
+	#! nr_of_funs = size fun_defs
+	= analyse_groups 0 groups var_heap (createArray nr_of_funs { cc_size = 0, cc_args = [] }) fun_defs
+where	
+	analyse_groups group_nr groups var_heap class_env fun_defs
+		| group_nr == size groups
+			= (class_env, groups, fun_defs, var_heap)
+			#! fun_indexes = groups.[group_nr]
+			# (class_env, fun_defs, var_heap) = analyse_group fun_indexes.group_members var_heap class_env fun_defs
+			= analyse_groups (inc group_nr) groups var_heap class_env fun_defs
+
+	analyse_group group var_heap class_env fun_defs
+		# (nr_of_vars, nr_of_local_vars, var_heap, class_env, fun_defs) = initial_cons_class group 0 0 var_heap class_env fun_defs
+		  initial_subst = createArray (nr_of_vars + nr_of_local_vars) cPassive
+		  (ai, fun_defs) = analyse_functions group { ai_heap = var_heap, ai_cons_class = class_env,
+		  											 ai_class_subst = initial_subst, ai_next_var = nr_of_vars } fun_defs
+		  class_env = collect_classifications group ai.ai_cons_class ai.ai_class_subst
+		= (class_env, fun_defs, ai.ai_heap)
+		
+	
+	initial_cons_class [fun : funs] next_var_number nr_of_local_vars var_heap class_env fun_defs
+		#! fun_def = fun_defs.[fun]
+		#  (TransformedBody {tb_args}) = fun_def.fun_body
+		   (fresh_vars, next_var_number, var_heap) = fresh_variables tb_args next_var_number var_heap
+		= initial_cons_class funs next_var_number (length fun_def.fun_info.fi_local_vars + nr_of_local_vars) var_heap
+			{ class_env & [fun] = { cc_size = 0, cc_args = fresh_vars }} fun_defs
+	initial_cons_class [] next_var_number nr_of_local_vars var_heap class_env fun_defs
+		= (next_var_number, nr_of_local_vars, var_heap, class_env, fun_defs)
+		
+	fresh_variables [{fv_name,fv_info_ptr} : vars] next_var_number var_heap
+		# (fresh_vars, last_var_number, var_heap) = fresh_variables vars (inc next_var_number) var_heap
+		  var_heap = write_ptr fv_info_ptr (VI_AccVar next_var_number) var_heap "fresh_variables"
+		= ([next_var_number : fresh_vars], last_var_number, var_heap)
+	fresh_variables [] next_var_number var_heap
+		= ([], next_var_number, var_heap)
+
+	analyse_functions [fun : funs] ai fun_defs
+		#! fun_def = fun_defs.[fun]
+		#  (TransformedBody {tb_rhs}) = fun_def.fun_body
+		   (_, ai) = consumerRequirements tb_rhs ai
+		= analyse_functions funs ai fun_defs
+	analyse_functions [] ai fun_defs
+		= (ai, fun_defs)
+
+	collect_classifications [] class_env class_subst
+		= class_env
+	collect_classifications [fun : funs] class_env class_subst
+		#! fun_class = class_env.[fun]
+		= collect_classifications funs { class_env & [fun] = determine_classification fun_class.cc_args class_subst } class_subst
+	where
+		determine_classification cc class_subst
+			# (cc_size, cc_args) = mapAndLength (skip_indirections class_subst) cc
+			= { cc_size = cc_size, cc_args = cc_args }
+
+		skip_indirections class_subst cc
+			| IsAVariable cc
+				= skip_indirections class_subst class_subst.[cc]
+				= cc
+
+mapAndLength f [x : xs]
+	#! x = f x
+	   (length, xs) = mapAndLength f xs
+	=  (inc length, [x : xs])
+mapAndLength f []
+	= (0, [])
+	
+::	*TransformInfo =
+	{	ti_fun_defs			:: !*{# FunDef}
+	,	ti_instances 		:: !*{! InstanceInfo }
+	,	ti_cons_args 		:: !{! ConsClasses}
+	,	ti_new_functions 	:: ![FunctionInfoPtr]
+	,	ti_fun_heap			:: !*FunctionHeap
+	,	ti_var_heap			:: !*VarHeap
+	,	ti_symbol_heap		:: !*ExpressionHeap
+	,	ti_type_heaps		:: !*TypeHeaps
+	,	ti_next_fun_nr		:: !Index
+	}
+
+class transform a :: !a !{# {# FunType} } !TransformInfo -> (!a, !TransformInfo)
+
+instance transform Expression
+where
+	transform expr=:(App app=:{app_symb,app_args}) imported_funs ti
+		# (app_args, ti) = transform app_args imported_funs ti
+		= transformApplication { app & app_args = app_args } [] imported_funs ti
+	transform appl_expr=:(expr @ exprs) imported_funs ti
+		# (expr, ti) = transform expr imported_funs ti
+		  (exprs, ti) = transform exprs imported_funs ti
+		= case expr of
+			App app
+				-> transformApplication app exprs imported_funs ti
+			_
+				-> (expr @ exprs, ti)
+	transform (Let lad=:{let_binds, let_expr}) imported_funs ti
+		# (let_binds, ti) = transform let_binds imported_funs ti
+		  (let_expr, ti) = transform let_expr imported_funs ti
+		= (Let { lad & let_binds = let_binds, let_expr = let_expr}, ti)
+	transform (Case case_expr) imported_funs ti
+//		= transformCase case_expr imported_funs ti
+		# (case_expr, ti) = transform case_expr imported_funs ti
+		= (Case case_expr, ti)
+	transform (Selection opt_type expr selectors) imported_funs ti
+		# (expr, ti) = transform expr imported_funs ti
+		= transformSelection opt_type selectors expr ti
+	transform (DynamicExpr dynamic_expr) imported_funs ti
+		# (dynamic_expr, ti) = transform dynamic_expr imported_funs ti
+		= (DynamicExpr dynamic_expr, ti)
+	transform expr imported_funs ti
+		= (expr, ti)
+
+neverMatchingCase = { case_expr = EE, case_guards = NoPattern, case_default = No, case_ident = No, case_info_ptr = nilPtr }
+
+instance transform Case
+where
+	transform kees=:{case_expr, case_guards, case_default} imported_funs ti
+		# (case_expr, ti) = transform case_expr imported_funs ti
+		  (case_guards, ti) = transform case_guards imported_funs ti
+		  (case_default, ti) = transform case_default imported_funs ti
+		= ({kees & case_expr = case_expr, case_guards = case_guards, case_default = case_default}, ti)
+
+instance transform DynamicExpr where
+	transform dyn=:{dyn_expr} imported_funs ti
+		# (dyn_expr, ti) = transform dyn_expr imported_funs ti
+		= ({dyn & dyn_expr = dyn_expr}, ti)
+
+instance transform DynamicPattern where
+	transform dp=:{dp_rhs} imported_funs ti
+		# (dp_rhs, ti) = transform dp_rhs imported_funs ti
+		= ({ dp & dp_rhs = dp_rhs }, ti)
+
+/*		
+transformCase :: !Case !*TransformInfo -> *(!Expression, !*TransformInfo)
+transformCase this_case=:{case_expr,case_guards,case_default,case_ident} imported_funs ti
+	= case case_expr of
+		Case case_in_case
+	  		-> lift_case case_in_case case_guards case_default case_ident ti
+	  	App {app_symb,app_args}
+	  		-> case app_symb.symb_kind of
+	  			SK_Constructor cons_index
+					# (may_be_match_expr, ti) = match_and_instantiate cons_index app_args case_guards case_default ti
+					-> case may_be_match_expr of
+						Yes match_expr
+							-> (match_expr, ti)
+						No
+							-> (Case neverMatchingCase, ti)
+	  			_
+	  				# (may_be_unfolded_expr, ti) = tryToUnfoldExpression app_symb app_args ti
+	  				-> case may_be_unfolded_expr of
+	  					(Yes unfolded_expr)
+	  						-> transformCase {this_case & case_expr = unfolded_expr } ti
+	  					No
+							# (this_case, ti) = transform this_case ti
+							-> (Case this_case, ti)
+	  	_
+			# (this_case, ti) = transform this_case ti
+			-> (Case this_case, ti)
+
+where
+	lift_case :: !Case ![PatternExpression] !(Optional Expression) !(Optional Ident) !*TransformInfo -> *(!Expression, !*TransformInfo)
+	lift_case nested_case=:{case_guards,case_default} outer_guards outer_default outer_ident ti
+		# (case_guards, ti) = lift_patterns case_guards outer_guards outer_default outer_ident ti
+		  (case_default, ti) = lift_default case_default outer_guards outer_default outer_ident ti
+		= (Case {nested_case & case_guards = case_guards, case_default = case_default}, ti)
+
+	lift_patterns :: ![PatternExpression] ![PatternExpression] !(Optional Expression) !(Optional Ident) !*TransformInfo -> *(![PatternExpression], !*TransformInfo)
+	lift_patterns [guard=:{guard_expr}] outer_guards outer_default outer_ident ti
+		# (guard_expr, ti) = transformCase {case_expr = guard_expr,case_guards = outer_guards,case_default = outer_default, case_ident = outer_ident} ti
+		= ([{guard & guard_expr = guard_expr}], ti)
+	lift_patterns [guard=:{guard_expr} : nested_guards] outer_guards outer_default outer_ident ti=:{ti_var_heap}
+		# (outer_guards, ti_var_heap) = copy_guards outer_guards ti_var_heap
+		# (guard_expr, ti) = transformCase {case_expr = guard_expr,case_guards = outer_guards,case_default = outer_default, case_ident = outer_ident} { ti & ti_var_heap = ti_var_heap }
+		  (nested_guards, ti) = lift_patterns nested_guards outer_guards outer_default outer_ident ti
+		= ([{guard & guard_expr = guard_expr} : nested_guards], ti)
+	lift_patterns [] outer_guards outer_default outer_ident ti
+		= ([], ti)
+		
+	copy_guards [guard : guards] var_heap
+		# (guard, _, var_heap) = unfold guard 0 var_heap
+		  (guards, var_heap) = copy_guards guards var_heap
+		= ([ guard : guards ], var_heap)
+	copy_guards [] var_heap
+		= ([], var_heap)
+	
+	lift_default :: !(Optional Expression) ![PatternExpression] !(Optional Expression) !(Optional Ident) !*TransformInfo -> *(!Optional Expression, !*TransformInfo)
+	lift_default (Yes default_expr) outer_guards outer_default outer_ident ti
+		# (default_expr, ti) = transformCase {case_expr = default_expr, case_guards = outer_guards, case_default = outer_default, case_ident = outer_ident} ti
+		= (Yes default_expr, ti)
+	lift_default No outer_guards outer_default outer_ident ti
+		= (No, ti)
+		
+	match_and_instantiate :: !(Global Index) ![Expression] ![PatternExpression] !(Optional Expression) !*TransformInfo -> *(!Optional Expression, !*TransformInfo)
+	match_and_instantiate cons_index app_args [{guard_pattern = AlgebraicPattern {glob_module,glob_object={ds_index}} vars, guard_expr} : guards]
+			case_default ti
+		| cons_index.glob_module == glob_module && cons_index.glob_object == ds_index
+			# (unfolded_guard_expr, _, ti_var_heap) = unfold guard_expr 0 (bindVariables vars app_args  ti.ti_var_heap)
+			  (guard_expr, ti) = transform unfolded_guard_expr { ti & ti_var_heap = ti_var_heap }
+			= (Yes guard_expr, ti)
+			= match_and_instantiate cons_index app_args guards case_default ti
+	match_and_instantiate cons_index app_args [guard : guards] case_default ti
+		= match_and_instantiate cons_index app_args guards case_default ti
+	match_and_instantiate cons_index app_args [] default_expr ti
+		= transform default_expr ti
+
+		
+tryToUnfoldExpression :: !SymbIdent ![Expression] !*TransformInfo -> *(!Optional Expression, ! *TransformInfo)
+tryToUnfoldExpression {symb_kind = SK_Function {glob_module,glob_object},symb_arity} app_args ti=:{ti_fun_defs, ti_var_heap, ti_symbol_heap}
+	| glob_module == cIclModIndex
+		#! fd = ti_fun_defs.[glob_object]
+		| fd.fun_arity == symb_arity
+			# (expr, ti_var_heap, ti_symbol_heap) = unfoldFunction fd.fun_body app_args ti_var_heap ti_symbol_heap
+			= (Yes expr, { ti & ti_var_heap = ti_var_heap, ti_symbol_heap = ti_symbol_heap})
+			= (No, ti)
+		= (No, ti)
+tryToUnfoldExpression {symb_kind = SK_GeneratedFunction fun_ptr fun_index,symb_arity} app_args ti=:{ti_fun_heap, ti_var_heap, ti_symbol_heap}
+	#! fun_info = sreadPtr fun_ptr ti_fun_heap
+	# (FI_Function {gf_fun_def}) = fun_info
+	| gf_fun_def.fun_arity == symb_arity
+		# (expr, ti_var_heap, ti_symbol_heap) = unfoldFunction gf_fun_def.fun_body app_args ti_var_heap ti_symbol_heap
+		= (Yes expr, { ti & ti_var_heap = ti_var_heap, ti_symbol_heap = ti_symbol_heap })
+		= (No, ti)
+tryToUnfoldExpression expr app_args ti
+	= (No, ti)
+
+unfoldFunction :: !FunctionBody ![Expression] !*VarHeap !*ExpressionHeap -> (!Expression, !*VarHeap, !*ExpressionHeap)
+unfoldFunction (TransformedBody {tb_args,tb_rhs}) act_args var_heap symbol_heap
+	# var_heap = foldr2 (\{fv_info_ptr} arg -> writePtr fv_info_ptr (VI_Expression arg)) var_heap tb_args act_args
+	# (unfolded_rhs, {us_var_heap,us_symbol_heap}) = unfold tb_rhs { us_var_heap = var_heap, us_symbol_heap = symbol_heap }
+	= (unfolded_rhs, us_var_heap, us_symbol_heap)
+*/
+
+instance transform Bind a b | transform a
+where
+	transform bind=:{bind_src} imported_funs ti
+		# (bind_src, ti) = transform bind_src imported_funs ti
+		= ({ bind & bind_src = bind_src }, ti)
+
+instance transform BasicPattern
+where
+	transform pattern=:{bp_expr} imported_funs ti
+		# (bp_expr, ti) = transform bp_expr imported_funs ti
+		= ({ pattern & bp_expr = bp_expr }, ti)
+
+instance transform AlgebraicPattern
+where
+	transform pattern=:{ap_expr} imported_funs ti
+		# (ap_expr, ti) = transform ap_expr imported_funs ti
+		= ({ pattern & ap_expr = ap_expr }, ti)
+
+instance transform CasePatterns
+where
+	transform (AlgebraicPatterns type patterns) imported_funs ti
+		# (patterns, ti) = transform patterns imported_funs ti
+		= (AlgebraicPatterns type patterns, ti)
+	transform (BasicPatterns type patterns) imported_funs ti
+		# (patterns, ti) = transform patterns imported_funs ti
+		= (BasicPatterns type patterns, ti)
+	transform (DynamicPatterns patterns) imported_funs ti
+		# (patterns, ti) = transform patterns imported_funs ti
+		= (DynamicPatterns patterns, ti)
+
+instance transform Optional a | transform a
+where
+	transform (Yes x) imported_funs ti
+		# (x, ti) = transform x imported_funs ti
+		= (Yes x, ti)
+	transform no imported_funs ti
+		= (no, ti)
+
+instance transform [a] | transform a
+where
+	transform [x : xs]  imported_funs ti
+		# (x, ti) = transform x imported_funs ti
+		  (xs, ti) = transform xs imported_funs ti
+		= ([x : xs], ti)
+	transform [] imported_funs ti
+		= ([], ti)
+
+compareProducers prods1 prods2
+	#! nr_of_prods = size prods1
+	= compare_producers 0 nr_of_prods prods1 prods2
+where
+	compare_producers prod_index nr_of_prods prods1 prods2
+		| prod_index == nr_of_prods
+			= Equal
+			# cmp = prods1.[prod_index] =< prods2.[prod_index]
+			| cmp == Equal
+				= compare_producers (inc prod_index) nr_of_prods prods1 prods2
+				= cmp
+
+instance =< Producer
+where
+	(=<) pr1 pr2
+		| equal_constructor pr1 pr2
+			= compare_constructor_arguments  pr1 pr2
+		| less_constructor pr1 pr2
+			= Smaller
+			= Greater
+	where
+		compare_constructor_arguments (PR_Function _ index1) (PR_Function _ index2)
+			= index1 =< index2
+		compare_constructor_arguments (PR_GeneratedFunction _ index1) (PR_GeneratedFunction _ index2)
+			= index1 =< index2
+		compare_constructor_arguments (PR_Class app1 _ _) (PR_Class app2 _ _) 
+			= app1.app_args =< app2.app_args
+		compare_constructor_arguments _ _
+			= Equal
+
+cIsANewFunction		:== True
+cIsNotANewFunction	:== False
+
+tryToFindInstance :: !{! Producer} !InstanceInfo !*(Heap FunctionInfo) -> (!Bool, !FunctionInfoPtr, !InstanceInfo, !.FunctionHeap)
+tryToFindInstance new_prods II_Empty fun_heap
+	# (fun_def_ptr, fun_heap) = newPtr FI_Empty fun_heap
+	= (cIsANewFunction, fun_def_ptr, II_Node new_prods fun_def_ptr II_Empty II_Empty, fun_heap)
+tryToFindInstance new_prods instances=:(II_Node prods fun_def_ptr left right) fun_heap
+	# cmp = compareProducers new_prods prods
+	| cmp == Equal
+		= (cIsNotANewFunction, fun_def_ptr, instances, fun_heap)
+	| cmp == Greater
+		# (is_new, new_fun_def_ptr, right, fun_heap) = tryToFindInstance new_prods right fun_heap
+		= (is_new, new_fun_def_ptr, II_Node prods fun_def_ptr left right, fun_heap)
+		# (is_new, new_fun_def_ptr, left, fun_heap) = tryToFindInstance new_prods left fun_heap
+		= (is_new, new_fun_def_ptr, II_Node prods fun_def_ptr left right, fun_heap)
+
+
+generateFunction :: !FunDef ![Int] !{! Producer} !FunctionInfoPtr !{# {# FunType} } !*TransformInfo -> (!Index, !Int, !*TransformInfo)
+generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = info =: {fi_group_index}} cc_args prods fun_def_ptr
+			imported_funs ti=:{ti_var_heap,ti_next_fun_nr,ti_new_functions,ti_fun_heap,ti_symbol_heap,ti_fun_defs,ti_type_heaps,ti_cons_args}
+	#! fi_group_index = max_group_index 0 prods fi_group_index ti_fun_defs ti_fun_heap ti_cons_args
+	# (Yes fun_type=:{st_vars,st_attr_vars,st_args,st_result}) = fd.fun_type
+	
+	  th_vars = foldSt (\tv type_var_heap -> type_var_heap <:= (tv.tv_info_ptr, TVI_Type (TV tv))) st_vars ti_type_heaps.th_vars 
+	  th_attrs = foldSt (\av attr_var_heap -> attr_var_heap <:= (av.av_info_ptr, AVI_Attr (TA_Var av))) st_attr_vars ti_type_heaps.th_attrs 
+
+	  (new_fun_args, new_arg_types, new_cons_args, th_vars, ti_var_heap) = determine_args cc_args 0 prods tb_args st_args th_vars ti_var_heap
+
+	  (fresh_arg_types, ti_type_heaps) = substitute new_arg_types { ti_type_heaps & th_vars = th_vars, th_attrs = th_attrs }
+	  (fresh_result_type, ti_type_heaps) = substitute st_result ti_type_heaps
+
+	  new_gen_fd = { gf_fun_def = { fd & fun_body = Expanding, fun_info = { info & fi_group_index = fi_group_index }},
+	  					gf_instance_info = II_Empty,
+	  					gf_fun_index = ti_next_fun_nr, gf_cons_args = {cc_args = new_cons_args, cc_size = length new_cons_args} }
+	  ti_fun_heap = writePtr fun_def_ptr (FI_Function new_gen_fd) ti_fun_heap
+
+	  (tb_rhs, {us_var_heap,us_symbol_heap}) = unfold tb_rhs { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap }
+
+	  (new_fun_rhs, ti) = transform tb_rhs imported_funs { ti & ti_var_heap = us_var_heap, ti_fun_heap = ti_fun_heap, ti_symbol_heap = us_symbol_heap,
+	  			ti_next_fun_nr = inc ti_next_fun_nr, ti_new_functions = [fun_def_ptr : ti_new_functions], ti_type_heaps = ti_type_heaps }
+	  fun_arity = length new_fun_args
+	  new_fd = { fd & fun_body = TransformedBody {tb_args = new_fun_args, tb_rhs = new_fun_rhs}, fun_arity = fun_arity, fun_index = ti_next_fun_nr,
+	  				fun_type = Yes { fun_type & st_args = fresh_arg_types, st_result = fresh_result_type }}
+	= (ti_next_fun_nr, fun_arity, { ti & ti_fun_heap = ti.ti_fun_heap <:= (fun_def_ptr, FI_Function { new_gen_fd & gf_fun_def = new_fd })})
+where
+	determine_args [] prod_index producers forms types type_var_heap var_heap
+		# (vars, var_heap) = new_variables forms var_heap
+		= (vars, types, [], type_var_heap, var_heap)
+	determine_args [cons_arg : cons_args ] prod_index producers [form : forms] [type : types] type_var_heap var_heap
+		| cons_arg == cActive
+			# new_args = determine_args cons_args (inc prod_index) prods forms types type_var_heap var_heap
+			= determine_arg producers.[prod_index] form type new_args
+			# (vars, types, new_cons_args, type_var_heap, var_heap) = determine_args cons_args prod_index prods forms types type_var_heap var_heap
+			  (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+			= ([{ form & fv_info_ptr = new_info_ptr } : vars], [type : types], [cons_arg : new_cons_args], type_var_heap, 
+					var_heap <:= (form.fv_info_ptr, VI_Variable form.fv_name new_info_ptr))
+	where
+/*
+		build_var_args new_name arity form_vars act_vars var_heap
+			| arity == 0
+				= (form_vars, act_vars, var_heap)
+				# (info_ptr, var_heap) = newPtr VI_Empty var_heap
+				  form_var = { fv_name = new_name, fv_info_ptr = info_ptr, fv_count = 0, fv_def_level = NotALevel }
+				  act_var = { var_name = new_name, var_info_ptr = info_ptr, var_expr_ptr = nilPtr }
+				= build_var_args new_name (dec arity) [form_var : form_vars] [Var act_var : act_vars] var_heap
+*/		
+		determine_arg PR_Empty form=:{fv_name,fv_info_ptr} type (vars, types, new_cons_args, type_var_heap, var_heap)
+			# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+			= ([{ form & fv_info_ptr = new_info_ptr } : vars], [ type : types ], [cActive : new_cons_args], type_var_heap,
+					var_heap <:= (fv_info_ptr, VI_Variable fv_name new_info_ptr))
+/*
+		determine_arg (PR_Function symbol _) vars {fv_info_ptr,fv_name} new_cons_args var_heap
+			# (form_vars, act_vars, var_heap) = build_var_args fv_name symbol.symb_arity vars [] var_heap
+			= (form_vars, writePtr fv_info_ptr (
+						VI_Expression (App { app_symb = symbol, app_args = act_vars, app_info_ptr = nilPtr })) var_heap)
+		determine_arg (PR_GeneratedFunction symbol _) vars {fv_info_ptr,fv_name} var_heap
+			# (form_vars, act_vars, var_heap) = build_var_args fv_name symbol.symb_arity vars [] var_heap
+			= (form_vars, writePtr fv_info_ptr (
+						VI_Expression (App { app_symb = symbol, app_args = act_vars, app_info_ptr = nilPtr  })) var_heap)
+*/
+		determine_arg (PR_Class class_app free_vars class_types) {fv_info_ptr,fv_name} type (vars, types, new_cons_args, type_var_heap, var_heap)
+			= (mapAppend (\{var_info_ptr,var_name} -> {	fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0 }) free_vars vars,
+		        	mapAppend (\_ -> { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TE }) free_vars types,
+				        mapAppend (\_ -> cActive) free_vars new_cons_args,
+				        	bind_class_types type.at_type class_types type_var_heap,
+								var_heap <:= (fv_info_ptr, VI_Expression (App class_app)))
+		
+		bind_class_types (TA _ context_types) instance_types type_var_heap
+			= bind_context_types context_types instance_types type_var_heap
+		where
+			bind_context_types [atype : atypes] [type : types] type_var_heap
+				= bind_context_types atypes types (bind_type atype.at_type type type_var_heap)
+			bind_context_types [] [] type_var_heap
+				= type_var_heap
+		bind_class_types _ _ type_var_heap
+			= type_var_heap
+			
+		bind_type (TV {tv_info_ptr}) type type_var_heap
+			= type_var_heap <:= (tv_info_ptr, TVI_Type type)
+		bind_type (TA _ arg_types1) (TA _ arg_types2) type_var_heap
+			= bind_types arg_types1 arg_types2 type_var_heap
+		bind_type _ _ type_var_heap
+			= type_var_heap
+		
+		bind_types [type1 : types1] [type2 : types2] type_var_heap
+			= bind_types types1 types2 (bind_type type1.at_type type2.at_type type_var_heap)
+		bind_types [] [] type_var_heap
+			= type_var_heap
+		
+	new_variables [] var_heap
+		= ([], var_heap)
+	new_variables [form=:{fv_name,fv_info_ptr}:forms] var_heap
+		# (vars, var_heap) = new_variables forms var_heap
+		  (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+		= ([{ form & fv_info_ptr = new_info_ptr } : vars], writePtr fv_info_ptr (VI_Variable fv_name new_info_ptr) var_heap)
+
+	max_group_index prod_index producers current_max fun_defs fun_heap cons_args
+		| prod_index == size producers
+			= current_max
+			# current_max = max_group_index_of_producer producers.[prod_index] current_max fun_defs fun_heap cons_args
+			= max_group_index (inc prod_index) producers current_max fun_defs fun_heap cons_args
+
+	max_group_index_of_producer PR_Empty current_max fun_defs fun_heap cons_args
+		= current_max
+	max_group_index_of_producer (PR_Class {app_args} _ _) current_max fun_defs fun_heap cons_args
+		= max_group_index_of_members app_args current_max fun_defs fun_heap cons_args
+	max_group_index_of_producer prod current_max fun_defs fun_heap cons_args
+		= abort ("trans.icl: max_group_index_of_producer" ---> prod)
+
+	max_group_index_of_member fun_defs fun_heap cons_args current_max (App {app_symb = {symb_name, symb_kind = SK_Function { glob_object = fun_index, glob_module = mod_index}}}) 
+		| mod_index == cIclModIndex
+			| fun_index < size cons_args
+				# {fun_info = {fi_group_index}} = fun_defs.[fun_index]
+				= max fi_group_index current_max
+			= current_max
+		= current_max
+	max_group_index_of_member fun_defs fun_heap cons_args current_max (App {app_symb = {symb_kind = SK_GeneratedFunction fun_ptr fun_index }})
+		# (FI_Function {gf_fun_def={fun_info = {fi_group_index}}}) = sreadPtr fun_ptr fun_heap
+		= max fi_group_index current_max
+	max_group_index_of_member fun_defs fun_heap cons_args current_max (App {app_symb = {symb_kind = SK_Constructor _}, app_args}) 
+		= max_group_index_of_members app_args current_max fun_defs fun_heap cons_args
+	
+	max_group_index_of_members members current_max fun_defs fun_heap cons_args
+		= foldl (max_group_index_of_member fun_defs fun_heap cons_args) current_max members
+			
+
+transformFunctionApplication fun_def instances {cc_size, cc_args} app=:{app_symb,app_args} extra_args imported_funs ti
+	# (app_symb, app_args, extra_args) = complete_application app_symb fun_def.fun_arity app_args extra_args
+	| cc_size > 0
+	  	# (producers, new_args, ti) = determineProducers cc_args app_args 0 (createArray cc_size PR_Empty) ti
+	  	| containsProducer cc_size producers
+	  		# (is_new, fun_def_ptr, instances, ti_fun_heap) = tryToFindInstance producers instances ti.ti_fun_heap
+	  		| is_new
+	  			# (fun_index, fun_arity, ti) = generateFunction fun_def cc_args producers fun_def_ptr imported_funs
+	  					(update_instance_info app_symb.symb_kind instances { ti & ti_fun_heap = ti_fun_heap })
+	  			  app_symb = { app_symb & symb_kind = SK_GeneratedFunction fun_def_ptr fun_index, symb_arity = length new_args}
+				  (app_symb, app_args, extra_args) = complete_application app_symb fun_arity new_args extra_args
+	  			= (build_application { app & app_symb = app_symb, app_args = app_args } extra_args, ti)
+	  			# (FI_Function {gf_fun_index, gf_fun_def}, ti_fun_heap) = readPtr fun_def_ptr ti_fun_heap
+	  			  app_symb = { app_symb & symb_kind = SK_GeneratedFunction fun_def_ptr gf_fun_index, symb_arity = length new_args}
+				  (app_symb, app_args, extra_args) = complete_application app_symb gf_fun_def.fun_arity new_args extra_args
+	  			= (build_application { app & app_symb = app_symb, app_args = app_args } extra_args, {ti & ti_fun_heap = ti_fun_heap })
+			= (build_application { app & app_symb = app_symb, app_args = app_args } extra_args, ti)
+		= (build_application { app & app_symb = app_symb, app_args = app_args } extra_args, ti)
+where
+	update_instance_info (SK_Function {glob_object}) instances ti=:{ti_instances}
+		 = { ti & ti_instances = { ti_instances & [glob_object] = instances } }
+	update_instance_info (SK_GeneratedFunction fun_def_ptr _) instances ti=:{ti_fun_heap}
+		# (FI_Function fun_info, ti_fun_heap) = readPtr fun_def_ptr ti_fun_heap
+		= { ti & ti_fun_heap = ti_fun_heap <:= (fun_def_ptr, FI_Function { fun_info & gf_instance_info = instances })}
+
+	complete_application symb form_arity args []
+		= (symb, args, [])
+	complete_application symb=:{symb_arity} form_arity args extra_args
+		# arity_diff = min (form_arity - symb_arity) (length extra_args)
+		= ({ symb & symb_arity = symb_arity + arity_diff }, args ++ take arity_diff extra_args, drop arity_diff extra_args)
+
+	build_application app []
+		= App app
+	build_application app extra_args
+		= App app @ extra_args
+		
+transformApplication :: !App ![Expression] !{# {# FunType} } !*TransformInfo -> *(!Expression,!*TransformInfo)
+transformApplication app=:{app_symb=symb=:{symb_kind = SK_Function {glob_module, glob_object},symb_arity}, app_args} extra_args
+	imported_funs ti=:{ti_cons_args,ti_instances,ti_fun_defs}
+	| glob_module == cIclModIndex
+		| glob_object < size ti_cons_args
+			#! cons_class = ti_cons_args.[glob_object]
+			   instances = ti_instances.[glob_object]
+			   fun_def = ti_fun_defs.[glob_object]
+			= transformFunctionApplication fun_def instances cons_class app extra_args imported_funs ti
+// It seems as if we have an array function 
+			| isEmpty extra_args
+				= (App app, ti)
+				= (App { app & app_symb = { symb & symb_arity = symb_arity + length extra_args}, app_args = app_args ++ extra_args}, ti)
+// This function is imported
+		| isEmpty extra_args
+			= (App app, ti)
+			# ar_diff = imported_funs.[glob_module].[glob_object].ft_arity - symb_arity
+			  nr_of_extra_args = length extra_args
+			| nr_of_extra_args <= ar_diff
+				= (App {app  &  app_args = app_args ++ extra_args, app_symb = { symb & symb_arity = symb_arity + nr_of_extra_args }}, ti)
+				= (App {app  &  app_args = app_args ++ take ar_diff extra_args, app_symb = { symb & symb_arity = symb_arity + ar_diff }} @
+						drop ar_diff extra_args, ti)
+				
+transformApplication app=:{app_symb={symb_kind = SK_GeneratedFunction fun_def_ptr fun_index}} extra_args imported_funs ti=:{ti_fun_heap}
+	# (FI_Function {gf_fun_def,gf_instance_info,gf_cons_args}, ti_fun_heap) = readPtr fun_def_ptr ti_fun_heap
+	= transformFunctionApplication gf_fun_def gf_instance_info gf_cons_args app extra_args imported_funs { ti & ti_fun_heap = ti_fun_heap }
+transformApplication app [] imported_funs ti
+	= (App app, ti)
+transformApplication app extra_args imported_funs ti
+	= (App app @ extra_args, ti)
+
+transformSelection opt_type [RecordSelection _ field_index : selectors] (App {app_symb={symb_kind= SK_Constructor _ }, app_args}) ti
+	= transform_selections selectors (app_args !! field_index) ti
+where
+	transform_selections [] expr ti
+		= (expr, ti)
+	transform_selections [RecordSelection _ field_index : selectors] (App {app_symb={symb_kind= SK_Constructor _ }, app_args}) ti
+		= transform_selections selectors (app_args !! field_index) ti
+	transform_selections selectors expr ti
+		= (Selection No expr selectors, ti)
+transformSelection opt_type selectors expr ti
+	= (Selection opt_type expr selectors, ti)
+
+determineProducers :: ![Int] ![Expression] !Index !*{! Producer} !*TransformInfo -> (!*{! Producer},![Expression],!*TransformInfo)
+determineProducers cons_args [] prod_index producers ti
+	= (producers, [], ti)
+determineProducers [ cons_arg : cons_args ] [ arg : args ] prod_index producers ti
+	| cons_arg == cActive
+		# (producers, new_args, ti) = determineProducers cons_args args (inc prod_index) producers ti
+		= determine_producer arg new_args prod_index producers ti
+		# (producers, new_args, ti) = determineProducers cons_args args prod_index producers ti
+		= (producers, [arg : new_args], ti)
+where
+	determine_producer arg=:(App app=:{app_info_ptr}) new_args prod_index producers ti
+		| isNilPtr app_info_ptr
+			= (producers, [arg : new_args], ti)
+			# (app_info, ti_symbol_heap) = readPtr app_info_ptr ti.ti_symbol_heap
+			= determineProducer app  app_info new_args prod_index producers { ti & ti_symbol_heap = ti_symbol_heap }
+	determine_producer arg new_args prod_index producers ti
+		= (producers, [arg : new_args], ti)
+		
+determineProducer :: !App !ExprInfo ![Expression] !Index !*{! Producer} !*TransformInfo -> (!*{! Producer}, ![Expression], !*TransformInfo)
+determineProducer app=:{app_symb = symb=:{symb_kind = SK_Constructor _}, app_args} (EI_ClassTypes types) new_args prod_index producers ti
+	# (app_args, (new_vars, ti_var_heap)) = renewVariables app_args ([], ti.ti_var_heap)
+	  (new_args, ti_var_heap) = mapAppendSt retrieve_old_var new_vars new_args ti_var_heap
+	= ({ producers & [prod_index] = PR_Class { app & app_args = app_args } new_vars types}, new_args, { ti & ti_var_heap = ti_var_heap })
+where
+	retrieve_old_var {var_info_ptr} var_heap
+		#! var_info = sreadPtr var_info_ptr var_heap
+		# (VI_Forward var) = var_info
+		= (Var var, writePtr var_info_ptr VI_Empty (writePtr var.var_info_ptr VI_Empty var_heap))
+/*
+determineProducer app=:{app_symb = symb=:{symb_kind = SK_Function { glob_module, glob_object }}, app_args} new_args prod_index producers ti
+	| glob_module == cIclModIndex
+		= ({ producers & [prod_index] = PR_Function symb glob_object}, app_args ++ new_args, ti)
+		= (producers, [App app : new_args ], ti)
+determineProducer app=:{app_symb = symb=:{ symb_kind = SK_GeneratedFunction _ fun_index}, app_args} new_args prod_index producers ti=:{ti_fun_heap}
+	= ({ producers & [prod_index] = PR_GeneratedFunction symb fun_index }, app_args ++ new_args, ti)
+determineProducer {app_symb = symb=:{symb_kind = SK_Constructor glob_index}, app_args} new_args prod_index producers ti
+	= ({ producers & [prod_index] = PR_Constructor symb app_args}, new_args, ti)
+*/
+determineProducer app _ new_args _ producers ti
+	= (producers, [App app : new_args ], ti)
+	
+		
+/*
+	verify_class_members [ App {app_symb, app_args} : mems]
+		= verify_class_members app_args && verify_class_members mems
+	verify_class_members [ _ : mems]
+		= False
+	verify_class_members []
+		= True
+	
+
+	verify_function fun_nr act_arity ti=:{ti_fun_defs,ti_new_functions}
+		| fun_nr < size ti_fun_defs
+			#! fd = ti_fun_defs.[fun_nr]
+			= (True, ti)
+			= (verify_new_function fun_nr act_arity ti_new_functions, ti)
+	where
+		verify_new_function fun_nr act_arity [{nf_fun_def={fun_index,fun_arity}}:new_functions]
+			| fun_nr == fun_index
+				= True
+				= verify_new_function fun_nr act_arity new_functions
+		verify_new_function fun_nr _ []
+			= False
+/*
+	verify_function fun_nr act_arity ti=:{ti_fun_defs,ti_new_functions}
+		| fun_nr < size ti_fun_defs
+			#! fd = ti_fun_defs.[fun_nr]
+			= (fd.fun_arity > act_arity, ti)
+			= (verify_new_function fun_nr act_arity ti_new_functions, ti)
+	where
+		verify_new_function fun_nr act_arity [{nf_fun_def={fun_index,fun_arity}}:new_functions]
+			| fun_nr == fun_index
+				= fun_arity > act_arity
+				= verify_new_function fun_nr act_arity new_functions
+		verify_new_function fun_nr _ []
+			= False ---> fun_nr
+*/
+*/
+
+containsProducer prod_index producers
+	| prod_index == 0
+		= False
+		#! prod_index = dec prod_index
+		= is_a_producer producers.[prod_index] || containsProducer prod_index producers
+where
+	is_a_producer PR_Empty	= False
+	is_a_producer _ 		= True
+
+class renewVariables a :: !a !(![BoundVar], !*VarHeap) -> (!a, !(![BoundVar], !*VarHeap))
+
+instance renewVariables Expression
+where
+	renewVariables (Var var=:{var_info_ptr}) (new_vars, var_heap)
+		#! var_info = sreadPtr var_info_ptr var_heap
+		= case var_info of
+			VI_Forward new_var
+				-> (Var { var & var_info_ptr = new_var.var_info_ptr }, (new_vars, var_heap))
+			_
+				# (new_info_ptr, var_heap) = newPtr (VI_Forward var) var_heap
+				  new_var = { var & var_info_ptr = new_info_ptr }
+				  var_heap = writePtr var_info_ptr (VI_Forward new_var) var_heap
+				-> (Var new_var, ([new_var : new_vars], var_heap))
+	renewVariables (App app=:{app_args}) state
+		# (app_args, state) = renewVariables app_args state
+		= (App { app & app_args = app_args }, state)
+	renewVariables expr state
+		= (expr, state)
+		
+instance renewVariables [a] | renewVariables a
+where
+	renewVariables l state = mapSt renewVariables l state
+
+::	ImportedConstructors	:== [Global Index]
+
+transformGroups :: !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs}  !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
+	-> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
+transformGroups groups fun_defs cons_args common_defs imported_funs var_heap type_heaps symbol_heap
+	#! nr_of_funs = size fun_defs
+	# imported_types = {com_type_defs \\ {com_type_defs} <-: common_defs }
+	  (groups, imported_types, collected_imports, {ti_fun_defs,ti_new_functions,ti_var_heap,ti_symbol_heap,ti_fun_heap,ti_next_fun_nr,ti_type_heaps})
+		= transform_groups 0 groups common_defs imported_funs imported_types []
+			{ti_fun_defs = fun_defs, ti_instances = createArray nr_of_funs II_Empty, ti_cons_args = cons_args,
+				ti_new_functions = [], ti_fun_heap = newHeap, ti_var_heap = var_heap, ti_symbol_heap = symbol_heap,
+					ti_type_heaps = type_heaps, ti_next_fun_nr = nr_of_funs}
+	  (groups, new_fun_defs, imported_types, collected_imports, ti_type_heaps, ti_var_heap) 
+	  		= foldSt (add_new_function_to_group common_defs ti_fun_heap) ti_new_functions
+	  				(groups, [], imported_types, collected_imports, ti_type_heaps, ti_var_heap)
+	= ( groups, { fundef \\ fundef <- [ fundef \\ fundef <-: ti_fun_defs ] ++ new_fun_defs }, imported_types, collected_imports,
+			ti_var_heap, ti_type_heaps, ti_symbol_heap)
+
+where
+	transform_groups group_nr groups common_defs imported_funs imported_types collected_imports ti
+		| group_nr < size groups
+			#! group = groups.[group_nr]
+			# {group_members} = group
+			# (ti_fun_defs, imported_types, collected_imports, ti_type_heaps, ti_var_heap) = foldSt (convert_function_type common_defs) group_members
+				(ti.ti_fun_defs, imported_types, collected_imports, ti.ti_type_heaps, ti.ti_var_heap)
+			= transform_groups (inc  group_nr) groups common_defs imported_funs imported_types collected_imports
+					(foldSt (transform_function imported_funs) group_members
+						{ ti & ti_fun_defs = ti_fun_defs, ti_type_heaps = ti_type_heaps, ti_var_heap = ti_var_heap })
+			= (groups, imported_types, collected_imports, ti)
+	
+	transform_function imported_funs fun ti=:{ti_fun_defs}
+		#! fun_def = ti_fun_defs.[fun]
+		# {fun_body = TransformedBody tb} = fun_def
+		  (fun_rhs, ti) = transform tb.tb_rhs imported_funs ti
+		= { ti & ti_fun_defs = {ti.ti_fun_defs & [fun] = { fun_def & fun_body = TransformedBody { tb & tb_rhs = fun_rhs }}}}
+
+	add_new_function_to_group ::  !{# CommonDefs} !FunctionHeap  !FunctionInfoPtr !(!*{! Group}, ![FunDef], !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
+		-> (!*{! Group}, ![FunDef], !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
+	add_new_function_to_group common_defs ti_fun_heap fun_ptr (groups, fun_defs, imported_types, collected_imports, type_heaps, var_heap)
+		# (FI_Function {gf_fun_def,gf_fun_index}) = sreadPtr fun_ptr ti_fun_heap
+		  group_index = gf_fun_def.fun_info.fi_group_index
+		  (Yes ft=:{st_args,st_result}) = gf_fun_def.fun_type
+		  ((st_result,st_args), {ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap}) = expandSynTypes common_defs (st_result,st_args)
+		  		{ ets_type_defs = imported_types, ets_collected_conses = collected_imports, ets_type_heaps = type_heaps, ets_var_heap = var_heap }
+		#! group = groups.[group_index]
+		= ({ groups & [group_index] = { group & group_members = [gf_fun_index : group.group_members]} },
+				[ { gf_fun_def & fun_type = Yes { ft &  st_result = st_result, st_args = st_args }} : fun_defs],
+					ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap)
+	
+	convert_function_type common_defs fun_index (fun_defs, imported_types, collected_imports, type_heaps, var_heap)
+		# (fun_def=:{fun_type = Yes fun_type}, fun_defs) = fun_defs![fun_index]
+		  (fun_type, imported_types, collected_imports, type_heaps, var_heap)
+		  		= convertSymbolType common_defs fun_type imported_types collected_imports type_heaps var_heap
+		= ({ fun_defs & [fun_index] = { fun_def & fun_type = Yes fun_type }}, imported_types, collected_imports, type_heaps, var_heap)
+
+convertSymbolType :: !{# CommonDefs} !SymbolType !*{#{# CheckedTypeDef}} !ImportedConstructors !*TypeHeaps !*VarHeap 
+	-> (!SymbolType, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
+convertSymbolType  common_defs st imported_types collected_imports type_heaps var_heap
+	# (st, {ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap}) = expandSynTypes common_defs st
+		  		{ ets_type_defs = imported_types, ets_collected_conses = collected_imports, ets_type_heaps= type_heaps, ets_var_heap = var_heap }
+	= (st, ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap)
+
+
+::	ExpandTypeState =
+	{	ets_type_defs			:: !.{#{#CheckedTypeDef}}
+	,	ets_collected_conses	:: !ImportedConstructors
+	,	ets_type_heaps			:: !.TypeHeaps
+	,	ets_var_heap			:: !.VarHeap
+	}
+	
+class expandSynTypes a :: !{# CommonDefs} !a !*ExpandTypeState -> (!a, !*ExpandTypeState)
+
+/*
+class expandSynTypes a ::   !a (!*{#{#CheckedTypeDef}}, !*TypeHeaps) -> (!a, (!*{#{#CheckedTypeDef}}, !*TypeHeaps))
+*/
+
+instance expandSynTypes SymbolType
+where
+	expandSynTypes common_defs st=:{st_args,st_result,st_context} ets
+		# ((st_args,st_result), ets) = expandSynTypes common_defs (st_args,st_result) ets
+		# st_args = mapAppend (add_types_of_dictionary common_defs) st_context st_args
+		= ({st & st_args = st_args, st_result = st_result, st_arity = length st_args, st_context = [] }, ets)
+	where
+		add_types_of_dictionary common_defs {tc_class = {glob_module, glob_object={ds_index}}, tc_types}
+			# {class_arity, class_dictionary={ds_ident,ds_index}} = common_defs.[glob_module].com_class_defs.[ds_index]
+			  dict_type_symb = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident class_arity
+			= { at_attribute = TA_Multi, at_annotation = AN_Strict, at_type = TA dict_type_symb (
+					map (\type -> { at_attribute = TA_Multi, at_annotation = AN_None, at_type = type }) tc_types) }
+
+instance expandSynTypes Type
+where
+	expandSynTypes common_defs (TA type_symb=:{type_index={glob_object,glob_module},type_name} types) ets=:{ets_type_defs}
+		# ({td_rhs,td_name,td_args},ets_type_defs) = ets_type_defs![glob_module].[glob_object]
+		  ets = { ets & ets_type_defs = ets_type_defs }
+		= case td_rhs of
+			SynType rhs_type
+				# (type, ets_type_heaps) = substitute rhs_type.at_type (fold2St bind_var_and_attr td_args types ets.ets_type_heaps)
+						// ---> (td_name, td_args, rhs_type.at_type))
+				-> expandSynTypes common_defs type { ets & ets_type_heaps = ets_type_heaps }
+			_
+				# (types, ets) = expandSynTypes common_defs types ets
+				| glob_module == cIclModIndex
+					-> (TA type_symb types, ets)
+					-> (TA type_symb types, collect_imported_constructors common_defs glob_module td_rhs ets)
+	where	
+		bind_var_and_attr {	atv_attribute = TA_Var {av_info_ptr},  atv_variable = {tv_info_ptr} } {at_attribute,at_type} type_heaps=:{th_vars,th_attrs}
+			= { type_heaps & th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type), th_attrs = th_attrs <:= (av_info_ptr, AVI_Attr at_attribute) }
+		bind_var_and_attr { atv_variable  = {tv_info_ptr}} {at_type} type_heaps=:{th_vars}
+			= { type_heaps & th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type) }
+
+		collect_imported_constructors common_defs mod_index (RecordType {rt_constructor}) ets=:{ets_collected_conses,ets_var_heap}
+			# (ets_collected_conses, ets_var_heap)
+					= collect_imported_constructor mod_index common_defs.[mod_index].com_cons_defs rt_constructor (ets_collected_conses, ets_var_heap)
+			= { ets & ets_collected_conses = ets_collected_conses, ets_var_heap = ets_var_heap }
+		collect_imported_constructors common_defs mod_index (AlgType constructors) ets=:{ets_collected_conses,ets_var_heap}
+			# (ets_collected_conses, ets_var_heap) 
+					= foldSt (collect_imported_constructor mod_index common_defs.[mod_index].com_cons_defs) constructors (ets_collected_conses, ets_var_heap)
+			= { ets & ets_collected_conses = ets_collected_conses, ets_var_heap = ets_var_heap }
+		collect_imported_constructors common_defs mod_index _ ets
+			= ets
+
+		collect_imported_constructor mod_index cons_defs {ds_index} (collected_conses, var_heap)
+			# {cons_type_ptr} = cons_defs.[ds_index]
+			  (type_info, var_heap) = readPtr cons_type_ptr var_heap
+			| has_been_collected (sreadPtr cons_type_ptr var_heap)
+				= (collected_conses, var_heap)
+				= ([{ glob_module = mod_index, glob_object = ds_index } : collected_conses ], var_heap <:= (cons_type_ptr, VI_Used))
+
+		has_been_collected VI_Used				= True
+		has_been_collected (VI_ExpandedType _)	= True
+		has_been_collected _					= False
+
+
+	expandSynTypes common_defs (arg_type --> res_type) ets
+		# ((arg_type, res_type), ets) = expandSynTypes common_defs (arg_type, res_type) ets
+		= (arg_type --> res_type, ets)
+	expandSynTypes common_defs (cons_var :@: types) ets
+		# (types, ets) = expandSynTypes common_defs types ets
+		= (cons_var :@: types, ets) 
+	expandSynTypes common_defs type ets
+		= (type, ets)
+
+instance expandSynTypes [a] | expandSynTypes a
+where
+	expandSynTypes common_defs list ets
+		= mapSt (expandSynTypes common_defs) list ets
+
+
+instance expandSynTypes (a,b) | expandSynTypes a & expandSynTypes b
+where
+	expandSynTypes common_defs tuple ets
+		= app2St (expandSynTypes common_defs, expandSynTypes common_defs) tuple ets
+
+instance expandSynTypes AType
+where
+	expandSynTypes common_defs atype=:{at_type} ets
+		# (at_type, ets) = expandSynTypes common_defs at_type ets
+		= ({ atype & at_type = at_type }, ets)
+
+
+/*
+instance <<< InstanceInfo
+where
+	(<<<) file (II_Node prods _ left right) = file <<< left <<< prods <<< right 
+	(<<<) file II_Empty = file 
+*/	
+
+	
+instance <<< Producer
+where
+	(<<<) file (PR_Function symbol index)
+		= file <<< "F" <<< symbol.symb_name
+	(<<<) file (PR_GeneratedFunction symbol index)
+		= file <<< "G" <<< symbol.symb_name <<< index
+	(<<<) file PR_Empty = file <<< 'E'
+	(<<<) file _ = file
+
+instance <<< FunCall
+where
+	(<<<) file {fc_index} = file <<< fc_index
+	
+	
diff --git a/frontend/transform.dcl b/frontend/transform.dcl
new file mode 100644
index 0000000..79e47e8
--- /dev/null
+++ b/frontend/transform.dcl
@@ -0,0 +1,75 @@
+definition module transform
+
+import syntax, checksupport
+
+::	Group =
+	{	group_members	:: ![Int]
+	}
+
+partitionateAndLiftFunctions :: ![IndexRange] !Index !*{# FunDef} !u:{# DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin
+	-> (!*{! Group}, !*{# FunDef}, !u:{# DclModule}, !*VarHeap, !*ExpressionHeap,  !*SymbolTable, !*ErrorAdmin )
+
+partitionateMacros :: !IndexRange !Index !*{# FunDef} !u:{# DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin
+	-> (!*{# FunDef}, !u:{# DclModule}, !*VarHeap, !*ExpressionHeap, !*SymbolTable, !*ErrorAdmin )
+
+::	UnfoldState =
+	{	us_var_heap		:: !.VarHeap
+	,	us_symbol_heap	:: !.ExpressionHeap
+	}
+	
+class unfold a :: !a !*UnfoldState -> (!a, !*UnfoldState)
+
+instance unfold Expression//, PatternExpression
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/frontend/transform.icl b/frontend/transform.icl
new file mode 100644
index 0000000..2311449
--- /dev/null
+++ b/frontend/transform.icl
@@ -0,0 +1,1241 @@
+implementation module transform
+
+import syntax, check, StdCompare, utilities, RWSDebug
+
+::	LiftState =
+	{	ls_var_heap		:: !.VarHeap
+	,	ls_fun_defs		:: !.{#FunDef}
+	,	ls_expr_heap	:: !.ExpressionHeap
+	}
+	
+class lift a :: !a !*LiftState -> (!a, !*LiftState)
+
+instance lift [a] | lift a
+where
+	lift l ls = mapSt lift l ls
+
+instance lift (a,b) | lift a & lift b
+where
+	lift t ls = app2St (lift,lift) t ls
+
+instance lift (Optional a) | lift a
+where
+	lift (Yes x) ls
+		# (x, ls) = lift x ls
+		= (Yes x, ls)
+	lift no ls
+		= (no, ls)
+	
+instance lift Expression
+where
+	lift (FreeVar {fv_name,fv_info_ptr}) ls=:{ls_var_heap}
+		#! var_info = sreadPtr fv_info_ptr ls_var_heap
+		= case var_info of
+			 VI_LiftedVariable var_info_ptr
+			 	# (var_expr_ptr, ls_expr_heap) = newPtr EI_Empty ls.ls_expr_heap
+			 	-> (Var { var_name = fv_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr }, { ls & ls_expr_heap = ls_expr_heap})
+			 _
+			 	# (var_expr_ptr, ls_expr_heap) = newPtr EI_Empty ls.ls_expr_heap
+			 	-> (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, { ls & ls_expr_heap = ls_expr_heap})
+	lift (App app) ls
+		# (app, ls) = lift app ls
+		= (App app, ls)
+	lift (expr @ exprs) ls
+		# ((expr,exprs), ls) = lift (expr,exprs) ls
+		= (expr @ exprs, ls)
+	lift (Let lad=:{let_binds, let_expr}) ls
+		# ((let_binds,let_expr), ls) = lift (let_binds,let_expr) ls
+		= (Let {lad & let_binds = let_binds, let_expr = let_expr}, ls)
+	lift (Case case_expr) ls
+		# (case_expr, ls) = lift case_expr ls
+		= (Case case_expr, ls)
+	lift (Selection is_unique expr selectors) ls
+		# (selectors, ls) = lift selectors ls
+		  (expr, ls) = lift expr ls
+		= (Selection is_unique expr selectors, ls)
+	lift (Update expr1 selectors expr2) ls
+		# (selectors, ls) = lift selectors ls
+		  (expr1, ls) = lift expr1 ls
+		  (expr2, ls) = lift expr2 ls
+		= (Update expr1 selectors expr2, ls)
+	lift (RecordUpdate cons_symbol expression expressions) ls
+		# (expression, ls) = lift expression ls
+		  (expressions, ls) = lift expressions ls
+		= (RecordUpdate cons_symbol expression expressions, ls)
+	lift (TupleSelect symbol argn_nr expr) ls
+		# (expr, ls) = lift expr ls
+		= (TupleSelect symbol argn_nr expr, ls)
+	lift (Lambda vars expr) ls
+		# (expr, ls) = lift expr ls
+		= (Lambda vars expr, ls)
+	lift (MatchExpr opt_tuple cons_symb expr) ls
+		# (expr, ls) = lift expr ls
+		= (MatchExpr opt_tuple cons_symb expr, ls)
+	lift expr ls
+		= (expr, ls)
+
+instance lift Selection
+where
+	lift (ArraySelection array_select expr_ptr index_expr) ls
+		# (index_expr, ls) = lift index_expr ls
+		= (ArraySelection array_select expr_ptr index_expr, ls)
+	lift record_selection ls
+		= (record_selection, ls)
+
+instance lift App
+where
+	lift app=:{app_symb = app_symbol=:{symb_arity,symb_kind = SK_Function {glob_object,glob_module}}, app_args} ls
+		# (app_args, ls) = lift app_args ls
+		| glob_module == cIclModIndex
+			#! fun_def = ls.ls_fun_defs.[glob_object]
+			# {fun_info={fi_free_vars}} = fun_def
+			  fun_lifted = length fi_free_vars
+			| fun_lifted > 0
+				# (app_args, ls_var_heap, ls_expr_heap) = add_free_variables fi_free_vars app_args ls.ls_var_heap ls.ls_expr_heap
+				= ({ app & app_args = app_args, app_symb = { app_symbol & symb_arity = symb_arity + fun_lifted }},
+						{ ls & ls_var_heap = ls_var_heap, ls_expr_heap = ls_expr_heap })
+				= ({ app & app_args = app_args }, ls)
+			= ({ app & app_args = app_args }, ls)
+	where
+		add_free_variables :: ![FreeVar] ![Expression] !u:VarHeap !*ExpressionHeap -> (![Expression],!u:VarHeap,!*ExpressionHeap)
+		add_free_variables [] app_args var_heap expr_heap
+			= (app_args, var_heap, expr_heap)
+		add_free_variables [{fv_name, fv_info_ptr} : free_vars] app_args var_heap expr_heap
+			#! var_info = sreadPtr fv_info_ptr var_heap
+			= case var_info of
+				VI_LiftedVariable var_info_ptr
+				 	# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+					-> add_free_variables free_vars [Var { var_name = fv_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr } : app_args]
+							var_heap expr_heap
+				_
+				 	# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+					-> add_free_variables free_vars [Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr } : app_args]
+							var_heap expr_heap
+
+	lift app=:{app_args} ls
+		# (app_args, ls) = lift app_args ls
+		= ({ app & app_args = app_args }, ls)
+
+instance lift (Bind a b) | lift a
+where
+	lift bind=:{bind_src} ls
+		# (bind_src, ls) = lift bind_src ls
+		= ({ bind & bind_src = bind_src }, ls)
+
+instance lift Case
+where
+	lift kees=:{ case_expr,case_guards,case_default } ls
+		# ((case_expr,(case_guards,case_default)), ls) = lift (case_expr,(case_guards,case_default)) ls
+		= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default }, ls)
+
+instance lift CasePatterns
+where
+	lift (AlgebraicPatterns type patterns) ls
+		# (patterns, ls) = lift patterns ls
+		= (AlgebraicPatterns type patterns, ls)
+	lift (BasicPatterns type patterns) ls
+		# (patterns, ls) = lift patterns ls
+		= (BasicPatterns type patterns, ls)
+	lift (DynamicPatterns patterns) ls
+		# (patterns, ls) = lift patterns ls
+		= (DynamicPatterns patterns, ls)
+
+instance lift AlgebraicPattern
+where
+	lift pattern=:{ap_expr} ls
+		# (ap_expr, ls) = lift ap_expr ls
+		= ({ pattern & ap_expr = ap_expr }, ls)
+
+instance lift BasicPattern
+where
+	lift pattern=:{bp_expr} ls
+		# (bp_expr, ls) = lift bp_expr ls
+		= ({ pattern & bp_expr = bp_expr }, ls)
+
+instance lift DynamicPattern
+where
+	lift pattern=:{dp_rhs} ls
+		# (dp_rhs, ls) = lift dp_rhs ls
+		= ({ pattern & dp_rhs = dp_rhs }, ls)
+
+::	UnfoldState =
+	{	us_var_heap		:: !.VarHeap
+	,	us_symbol_heap	:: !.ExpressionHeap
+	}
+	
+class unfold a :: !a !*UnfoldState -> (!a, !*UnfoldState)
+
+instance unfold [a] | unfold a
+where
+	unfold l us = mapSt unfold l us
+
+instance unfold (a,b) | unfold a & unfold b
+where
+	unfold t us = app2St (unfold,unfold) t us
+
+instance unfold (Optional a) | unfold a
+where
+	unfold (Yes x) us
+		# (x, us) = unfold x us
+		= (Yes x, us)
+	unfold no us
+		= (no, us)
+
+unfoldVariable :: !BoundVar !*UnfoldState -> (!Expression, !*UnfoldState)
+unfoldVariable var=:{var_name,var_info_ptr} us=:{us_var_heap}
+	#! var_info = sreadPtr var_info_ptr us_var_heap
+	= case var_info of 
+		VI_Expression expr
+			-> (expr, us)
+		VI_Variable var_name var_info_ptr
+			 	# (var_expr_ptr, us_symbol_heap) = newPtr EI_Empty us.us_symbol_heap
+			-> (Var {var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr}, { us & us_symbol_heap = us_symbol_heap})
+		_
+			-> (Var var, us)
+		
+instance unfold Expression
+where
+	unfold (Var var) us
+		= unfoldVariable var us
+	unfold (App app) us
+		# (app, us) = unfold app us
+		= (App app, us)
+	unfold (expr @ exprs) us
+		# ((expr,exprs), us) = unfold (expr,exprs) us
+		= (expr @ exprs, us)
+	unfold (Let lad) us
+		# (lad, us) = unfold lad us
+		= (Let lad, us)
+	unfold (Case case_expr) us
+		# (case_expr, us) = unfold case_expr us
+		= (Case case_expr, us)
+	unfold (Selection is_unique expr selectors) us
+		# ((expr, selectors), us) = unfold (expr, selectors) us
+		= (Selection is_unique expr selectors, us)
+	unfold (Update expr1 selectors expr2) us
+		# (((expr1, expr2), selectors), us) = unfold ((expr1, expr2), selectors) us
+		= (Update expr1 selectors expr2, us)
+	unfold (RecordUpdate cons_symbol expression expressions) us
+		# ((expression, expressions), us) = unfold (expression, expressions) us
+		= (RecordUpdate cons_symbol expression expressions, us)
+	unfold (TupleSelect symbol argn_nr expr) us
+		# (expr, us) = unfold expr us
+		= (TupleSelect symbol argn_nr expr, us)
+	unfold (Lambda vars expr) us
+		# (expr, us) = unfold expr us
+		= (Lambda vars expr, us)
+	unfold (MatchExpr opt_tuple cons_symb expr) us
+		# (expr, us) = unfold expr us
+		= (MatchExpr opt_tuple cons_symb expr, us)
+	unfold expr us
+		= (expr, us)
+
+instance unfold Selection
+where
+	unfold (ArraySelection array_select expr_ptr index_expr) us
+		# (index_expr, us) = unfold index_expr us
+		= (ArraySelection array_select expr_ptr index_expr, us)
+	unfold (DictionarySelection var selectors expr_ptr index_expr) us
+		# (index_expr, us) = unfold index_expr us
+		  (var_expr, us) = unfoldVariable var us
+		= case var_expr of 
+			App {app_symb={symb_kind= SK_Constructor _ }, app_args}
+				# [RecordSelection _ field_index:_] = selectors
+				  (App { app_symb = {symb_name, symb_kind = SK_Function array_select}}) =  app_args !! field_index
+				-> (ArraySelection { array_select & glob_object = { ds_ident = symb_name, ds_arity = 2, ds_index = array_select.glob_object}}
+							expr_ptr index_expr, us)
+			Var var
+				-> (DictionarySelection var selectors expr_ptr index_expr, us)
+	unfold record_selection ls
+		= (record_selection, ls)
+
+instance unfold FreeVar
+where
+	unfold fv=:{fv_info_ptr,fv_name} us=:{us_var_heap}
+		# (new_info_ptr, us_var_heap) = newPtr VI_Empty us_var_heap
+		= ({ fv & fv_info_ptr = new_info_ptr }, { us & us_var_heap = writePtr fv_info_ptr (VI_Variable fv_name new_info_ptr) us_var_heap })
+
+instance unfold App
+where
+	unfold app=:{app_symb, app_args} us
+		# (app_args, us) = unfold app_args us
+		| is_function_or_macro app_symb.symb_kind
+			# (new_info_ptr, us_symbol_heap) = newPtr EI_Empty us.us_symbol_heap
+			= ({ app & app_args = app_args, app_info_ptr = new_info_ptr}, { us & us_symbol_heap = us_symbol_heap }) 
+			= ({ app & app_args = app_args,  app_info_ptr = nilPtr }, us)
+	where
+		is_function_or_macro (SK_Function _)
+			= True
+		is_function_or_macro (SK_Macro _)
+			= True
+		is_function_or_macro (SK_OverloadedFunction _)
+			= True
+		is_function_or_macro symb_kind
+			= False
+
+instance unfold (Bind a b) | unfold a
+where
+	unfold bind=:{bind_src} us
+		# (bind_src, us) = unfold bind_src us
+		= ({ bind & bind_src = bind_src }, us)
+
+instance unfold Case
+where
+	unfold kees=:{ case_expr,case_guards,case_default,case_info_ptr} us
+		# ((case_expr,(case_guards,case_default)), us) = unfold (case_expr,(case_guards,case_default)) us
+		  (old_case_info, us_symbol_heap) = readPtr case_info_ptr us.us_symbol_heap
+		  (new_info_ptr, us_symbol_heap) = newPtr old_case_info us_symbol_heap
+		= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default, case_info_ptr =  new_info_ptr},
+				{ us & us_symbol_heap = us_symbol_heap })
+
+instance unfold Let
+where
+	unfold lad=:{let_binds, let_expr, let_info_ptr} us
+		# (let_binds, us) = copy_bound_vars let_binds us
+		# ((let_binds,let_expr), us) = unfold (let_binds,let_expr) us
+		  (old_let_info, us_symbol_heap) = readPtr let_info_ptr us.us_symbol_heap
+		  (new_info_ptr, us_symbol_heap) = newPtr old_let_info us_symbol_heap
+		= ({lad & let_binds = let_binds, let_expr = let_expr, let_info_ptr = new_info_ptr}, { us & us_symbol_heap = us_symbol_heap })
+		where
+			copy_bound_vars [bind=:{bind_dst} : binds] us
+				# (bind_dst, us) = unfold bind_dst us
+				  (binds, us) = copy_bound_vars binds us
+				= ([ {bind & bind_dst = bind_dst} : binds ], us)
+			copy_bound_vars [] us
+				= ([], us)
+
+instance unfold CasePatterns
+where
+	unfold (AlgebraicPatterns type patterns) us
+		# (patterns, us) = unfold patterns us
+		= (AlgebraicPatterns type patterns, us)
+	unfold (BasicPatterns type patterns) us
+		# (patterns, us) = unfold patterns us
+		= (BasicPatterns type patterns, us)
+	unfold (DynamicPatterns patterns) us
+		# (patterns, us) = unfold patterns us
+		= (DynamicPatterns patterns, us)
+
+instance unfold BasicPattern
+where
+	unfold guard=:{bp_expr} us
+		# (bp_expr, us) = unfold bp_expr us
+		= ({ guard & bp_expr = bp_expr }, us)
+
+instance unfold AlgebraicPattern
+where
+	unfold guard=:{ap_vars,ap_expr} us
+		# (ap_vars, us) = unfold ap_vars us
+		  (ap_expr, us) = unfold ap_expr us
+		= ({ guard & ap_vars = ap_vars, ap_expr = ap_expr }, us)
+
+instance unfold DynamicPattern
+where
+	unfold guard=:{dp_var,dp_rhs} us
+		# (dp_var, us) = unfold dp_var us
+		  (dp_rhs, us) = unfold dp_rhs us
+		= ({ guard & dp_var = dp_var, dp_rhs = dp_rhs }, us)
+
+updateFunctionCalls :: ![FunCall] ![FunCall] !*{# FunDef} !*SymbolTable
+	-> (![FunCall], !*{# FunDef}, !*SymbolTable)
+updateFunctionCalls calls collected_calls fun_defs symbol_table
+	= foldSt add_function_call calls (collected_calls, fun_defs, symbol_table)
+where
+	add_function_call fc (collected_calls, fun_defs, symbol_table)
+		# ({fun_symb}, fun_defs) = fun_defs![fc.fc_index]
+		  (collected_calls, symbol_table) = examineFunctionCall fun_symb fc (collected_calls, symbol_table) 
+		= (collected_calls, fun_defs, symbol_table)
+
+examineFunctionCall {id_info} fc=:{fc_index} (calls, symbol_table)
+	#! entry = sreadPtr id_info symbol_table
+	= case entry.ste_kind of
+		STE_Called indexes
+			| isMember fc_index indexes
+				-> (calls, symbol_table)
+				-> ([ fc : calls ], symbol_table <:= (id_info, { entry & ste_kind = STE_Called [ fc_index : indexes ]}))
+		_
+			-> ( [ fc : calls ], symbol_table <:=
+					(id_info, { ste_kind = STE_Called [fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry }))
+
+//unfoldMacro :: !FunDef ![Expression] !*ExpandInfo -> (!Expression, !*ExpandInfo)
+unfoldMacro {fun_body = TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls}} args fun_defs (calls, es=:{es_var_heap,es_symbol_heap, es_symbol_table})
+	# (let_binds, var_heap) = bind_expressions tb_args args [] es_var_heap
+	  (result_expr, {us_symbol_heap,us_var_heap}) = unfold tb_rhs { us_symbol_heap = es_symbol_heap, us_var_heap = var_heap }
+	  (calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls fun_defs es_symbol_table
+	| isEmpty let_binds
+		= (result_expr, fun_defs, (calls, { es & es_var_heap = us_var_heap, es_symbol_heap = us_symbol_heap, es_symbol_table = es_symbol_table }))
+		#  (new_info_ptr, us_symbol_heap) = newPtr EI_Empty us_symbol_heap
+		= (Let { let_strict = cIsNotStrict, let_binds = let_binds, let_expr = result_expr, let_info_ptr = new_info_ptr}, fun_defs, 
+					(calls, { es & es_var_heap = us_var_heap, es_symbol_heap = us_symbol_heap, es_symbol_table = es_symbol_table }))
+where
+
+	bind_expressions [var : vars] [expr : exprs] binds var_heap
+		# (binds, var_heap) = bind_expressions vars exprs binds var_heap
+		= bind_expression var expr binds var_heap
+	bind_expressions _ _ binds var_heap
+		= (binds, var_heap)
+
+	bind_expression {fv_count} expr binds var_heap
+		| fv_count == 0
+			= (binds, var_heap)
+	bind_expression {fv_info_ptr} (Var {var_name,var_info_ptr}) binds var_heap
+		= (binds, writePtr fv_info_ptr (VI_Variable var_name var_info_ptr) var_heap)
+	bind_expression {fv_name,fv_info_ptr,fv_count} expr binds var_heap
+		| fv_count == 1
+			= (binds, writePtr fv_info_ptr (VI_Expression expr) var_heap)
+		# (new_info, var_heap) = newPtr VI_Empty var_heap
+		  new_var = { fv_name = fv_name, fv_def_level = NotALevel, fv_info_ptr = new_info, fv_count = 0 }
+		= ([{ bind_src = expr, bind_dst = new_var} : binds], writePtr fv_info_ptr (VI_Variable fv_name new_info) var_heap)
+
+
+::	Group =
+	{	group_members	:: ![Int]
+//	,	group_number	:: !Int
+	}
+
+::	PartitioningInfo = 
+	{	pi_symbol_table	:: !.SymbolTable
+//	,	pi_marks		:: !.{# Int}
+	,	pi_var_heap		:: !.VarHeap
+	,	pi_symbol_heap	:: !.ExpressionHeap
+	,	pi_error		:: !.ErrorAdmin
+	,	pi_next_num		:: !Int
+	,	pi_next_group	:: !Int
+	,	pi_groups		:: ![[Int]]
+	,	pi_deps			:: ![Int]
+	}
+
+NotChecked :== -1	
+
+partitionateMacros :: !IndexRange !Index !*{# FunDef} !u:{# DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin
+	-> (!*{# FunDef}, !u:{# DclModule}, !*VarHeap, !*ExpressionHeap, !*SymbolTable, !*ErrorAdmin )
+partitionateMacros {ir_from,ir_to} mod_index fun_defs modules var_heap symbol_heap symbol_table error
+	#! max_fun_nr = size fun_defs
+	# partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap,
+							pi_symbol_table = symbol_table,
+							pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] }
+	  (fun_defs, modules, {pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_error, pi_next_group, pi_groups, pi_marks})
+	  		= iFoldSt (pationate_macro mod_index max_fun_nr) ir_from ir_to (fun_defs, modules, partitioning_info)
+	= (iFoldSt reset_body_of_rhs_macro ir_from ir_to fun_defs, modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error)
+where
+	
+	reset_body_of_rhs_macro macro_index macro_defs
+		# (macro_def, macro_defs) = macro_defs![macro_index]
+		= case macro_def.fun_body of
+			RhsMacroBody body
+				-> { macro_defs & [macro_index] = { macro_def & fun_body = CheckedBody body }}
+			_
+				-> macro_defs
+
+	pationate_macro mod_index max_fun_nr macro_index (macro_defs, modules, pi)
+		# (macro_def, macro_defs) = macro_defs![macro_index]
+		| macro_def.fun_kind == FK_Macro
+		 	= case macro_def.fun_body of
+		 		CheckedBody body
+			  		# macros_modules_pi = foldSt (visit_macro mod_index max_fun_nr) macro_def.fun_info.fi_calls (
+			  						{ macro_defs & [macro_index] = { macro_def & fun_body = PartioningMacro }}, modules, pi)
+					-> expand_simple_macro mod_index macro_index macro_def macros_modules_pi
+		 		PartioningMacro
+		  			# identPos = newPosition macro_def.fun_symb macro_def.fun_pos
+		 			-> (macro_defs,  modules, { pi &  pi_error = checkError macro_def.fun_symb "recursive macro definition" (setErrorAdmin identPos pi.pi_error)  })
+		 		_
+		 			-> (macro_defs, modules, pi)
+			= (macro_defs, modules, pi)
+
+	visit_macro mod_index max_fun_nr {fc_index} macros_modules_pi
+		= pationate_macro mod_index max_fun_nr fc_index macros_modules_pi
+		
+	expand_simple_macro mod_index macro_index macro=:{fun_body = CheckedBody body, fun_info, fun_symb, fun_pos}
+			(macro_defs, modules, pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_error})
+		| macros_are_simple fun_info.fi_calls macro_defs
+		  	# identPos = newPosition fun_symb fun_pos
+			  es = { es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap,
+					 es_symbol_heap = pi_symbol_heap, es_error = setErrorAdmin identPos pi_error }
+			  (tb_args, tb_rhs, local_vars, fi_calls, macro_defs, modules, {es_symbol_table, es_var_heap, es_symbol_heap, es_error})
+					= expandMacrosInBody [] body macro_defs mod_index modules es
+			  macro = { macro & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
+			  			fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = local_vars }}
+			= ({ macro_defs & [macro_index] = macro }, modules,
+					{ pi & pi_symbol_table = es_symbol_table, pi_symbol_heap = es_symbol_heap, pi_var_heap = es_var_heap, pi_error = es_error })
+			= ({ macro_defs & [macro_index] = { macro & fun_body = RhsMacroBody body }}, modules, pi)
+
+	macros_are_simple [] macro_defs
+		= True
+	macros_are_simple [ {fc_index} : calls ] macro_defs
+		# {fun_kind,fun_body} = macro_defs.[fc_index]
+		= is_a_pattern_macro fun_kind fun_body && macros_are_simple calls macro_defs
+	where
+		is_a_pattern_macro FK_Macro (TransformedBody {tb_args})
+			= True
+		is_a_pattern_macro _ _
+			= False
+			
+partitionateAndLiftFunctions :: ![IndexRange] !Index !*{# FunDef} !u:{# DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin
+	-> (!*{! Group}, !*{# FunDef}, !u:{# DclModule}, !*VarHeap, !*ExpressionHeap,  !*SymbolTable, !*ErrorAdmin )
+partitionateAndLiftFunctions ranges mod_index fun_defs modules var_heap symbol_heap symbol_table error
+	#! max_fun_nr = size fun_defs
+	# partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap, pi_symbol_table = symbol_table,
+							pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] }
+	  (fun_defs, modules, {pi_groups, pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_error})
+	  		= foldSt (partitionate_functions mod_index max_fun_nr) ranges (fun_defs, modules, partitioning_info)
+	  groups = { {group_members = group} \\ group <- reverse pi_groups }
+	= (groups, fun_defs, modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error)
+where
+		
+	partitionate_functions mod_index max_fun_nr {ir_from,ir_to} funs_modules_pi
+		= iFoldSt (partitionate_global_function mod_index max_fun_nr) ir_from ir_to funs_modules_pi
+		
+	partitionate_global_function mod_index max_fun_nr fun_index funs_modules_pi
+		# (_, funs_modules_pi) = partitionate_function mod_index max_fun_nr fun_index funs_modules_pi
+		= funs_modules_pi
+
+	partitionate_function mod_index max_fun_nr fun_index (fun_defs, modules, pi)
+		# (fun_def, fun_defs) = fun_defs![fun_index]
+		= case fun_def.fun_body of
+			CheckedBody body
+				# fun_number = pi.pi_next_num
+				# (min_dep, funs_modules_pi) = foldSt (visit_function mod_index max_fun_nr) fun_def.fun_info.fi_calls
+						(max_fun_nr, ({ fun_defs & [fun_index] = { fun_def & fun_body = PartioningFunction body fun_number }}, modules,
+							{ pi & pi_next_num = inc fun_number, pi_deps = [fun_index : pi.pi_deps] }))
+				-> try_to_close_group mod_index max_fun_nr fun_index fun_number min_dep fun_def.fun_info.fi_def_level funs_modules_pi
+			PartioningFunction _ fun_number
+				-> (fun_number, (fun_defs, modules, pi))
+			TransformedBody _
+				| fun_def.fun_info.fi_group_index == NoIndex
+					-> (max_fun_nr, ({ fun_defs & [fun_index] = {fun_def & fun_info.fi_group_index = pi.pi_next_group }}, modules,
+							{pi & pi_next_group = inc pi.pi_next_group, pi_groups = [ [fun_index] : pi.pi_groups]}))
+					-> (max_fun_nr, (fun_defs, modules, pi))
+
+	visit_function mod_index max_fun_nr {fc_index} (min_dep, funs_modules_pi)
+		# (next_min, funs_modules_pi) = partitionate_function mod_index max_fun_nr fc_index funs_modules_pi
+		= (min next_min min_dep, funs_modules_pi)
+		
+	try_to_close_group mod_index max_fun_nr fun_index fun_number min_dep def_level (fun_defs, modules,
+					pi=:{pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_deps, pi_groups, pi_next_group, pi_error})
+		| fun_number <= min_dep
+			# (pi_deps, group_without_macros, group_without_funs, fun_defs)
+					= close_group fun_index pi_deps [] [] max_fun_nr pi_next_group fun_defs
+			  (fun_defs, pi_var_heap, pi_symbol_heap)
+			  		= liftFunctions def_level (group_without_macros ++ group_without_funs) pi_next_group fun_defs pi_var_heap pi_symbol_heap
+			  (fun_defs, modules, es)
+			  		= expand_macros_in_group mod_index group_without_funs (fun_defs, modules,
+			  				{ es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap, es_symbol_heap = pi_symbol_heap,
+			  				  es_error = pi_error })
+			  (fun_defs, modules, {es_symbol_table, es_var_heap, es_symbol_heap, es_error})
+			  		= expand_macros_in_group mod_index group_without_macros (fun_defs, modules, es)
+			= (max_fun_nr, (fun_defs, modules, { pi & pi_deps = pi_deps, pi_var_heap = es_var_heap,
+						pi_symbol_table = es_symbol_table, pi_error = es_error, pi_symbol_heap = es_symbol_heap, 
+						pi_next_group = inc pi_next_group, pi_groups = [ group_without_macros ++ group_without_funs : pi_groups ] }))
+			= (min_dep, (fun_defs, modules, pi))
+	where
+		close_group fun_index [d:ds] group_without_macros group_without_funs nr_of_fun_defs group_number fun_defs
+			# (fun_def, fun_defs) = fun_defs![d]
+			  fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }}
+			| fun_def.fun_kind == FK_Macro
+				# group_without_funs = [d : group_without_funs]
+				| d == fun_index
+					= (ds, group_without_macros, group_without_funs, fun_defs)
+					= close_group fun_index ds group_without_macros group_without_funs nr_of_fun_defs group_number fun_defs
+				# group_without_macros = [d : group_without_macros]
+				| d == fun_index
+					= (ds, group_without_macros, group_without_funs, fun_defs)
+					= close_group fun_index ds group_without_macros group_without_funs nr_of_fun_defs group_number fun_defs
+		
+		expand_macros_in_group mod_index group funs_modules_es
+			= foldSt (expand_macros mod_index) group (funs_modules_es)
+
+		expand_macros mod_index fun_index (fun_and_macro_defs, modules, es)
+			# (fun_def, fun_and_macro_defs) = fun_and_macro_defs![fun_index]
+			  {fun_symb,fun_body = PartioningFunction body _, fun_info, fun_pos} = fun_def
+		  	  identPos = newPosition fun_symb fun_pos
+			  (tb_args, tb_rhs, fi_local_vars, fi_calls, fun_and_macro_defs, modules, es)
+					= expandMacrosInBody fun_info.fi_calls body fun_and_macro_defs mod_index modules { es & es_error = setErrorAdmin identPos es.es_error }
+			  fun_def = { fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
+			  			fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars }}
+			= ({ fun_and_macro_defs & [fun_index] = fun_def }, modules, es) 
+
+addFunctionCallsToSymbolTable calls fun_defs symbol_table
+	= foldSt add_function_call_to_symbol_table calls ([], fun_defs, symbol_table)
+where
+	add_function_call_to_symbol_table fc=:{fc_index} (collected_calls, fun_defs, symbol_table)
+		# ({fun_symb = { id_info }, fun_kind}, fun_defs) = fun_defs![fc_index]
+		| fun_kind == FK_Macro
+			= (collected_calls, fun_defs, symbol_table)
+			#! entry = sreadPtr id_info symbol_table
+			= ([fc : collected_calls], fun_defs,
+					symbol_table <:= (id_info, { ste_kind = STE_Called [fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry }))
+
+removeFunctionCallsFromSymbolTable calls fun_defs symbol_table
+	= foldSt remove_function_call_from_symbol_table calls (fun_defs, symbol_table)
+where
+	remove_function_call_from_symbol_table {fc_index} (fun_defs, symbol_table)
+		# ({fun_symb = { id_info }}, fun_defs) = fun_defs![fc_index]
+		#! entry = sreadPtr id_info symbol_table
+		= (fun_defs, symbol_table <:= (id_info, entry.ste_previous))
+		
+
+expandMacrosInBody fi_calls {cb_args,cb_rhs} fun_defs mod_index modules es=:{es_symbol_table}
+	# (prev_calls, fun_defs, es_symbol_table) = addFunctionCallsToSymbolTable fi_calls fun_defs es_symbol_table
+	  ([rhs:rhss], fun_defs, modules, (all_calls, es)) = expand cb_rhs fun_defs mod_index modules (prev_calls, { es & es_symbol_table = es_symbol_table })
+	  (fun_defs, es_symbol_table) = removeFunctionCallsFromSymbolTable all_calls fun_defs es.es_symbol_table
+	  (merge_rhs, es_var_heap, es_symbol_heap, es_error) = mergeCases rhs rhss es.es_var_heap es.es_symbol_heap es.es_error
+	  (merge_rhs, cb_args, local_vars, {cos_error, cos_var_heap, cos_symbol_heap}) = determineVariablesAndRefCounts cb_args merge_rhs // (merge_rhs ---> (cb_args, merge_rhs))
+	  		{ cos_error = es_error, cos_var_heap = es_var_heap, cos_symbol_heap = es_symbol_heap }
+	= (cb_args, merge_rhs, local_vars, all_calls, fun_defs, modules,
+		{ es & es_error = cos_error, es_var_heap = cos_var_heap, es_symbol_heap = cos_symbol_heap,
+												es_symbol_table = es_symbol_table })
+//		---> (cb_args, local_vars, merge_rhs)
+
+cContainsFreeVars 	:== True
+cContainsNoFreeVars :== False
+
+cMacroIsCalled 		:== True
+cNoMacroIsCalled 	:== False
+
+
+mergeCases :: !Expression ![Expression] !*VarHeap !*ExpressionHeap !*ErrorAdmin -> *(!Expression, !*VarHeap, !*ExpressionHeap, !*ErrorAdmin);
+mergeCases expr [] var_heap symbol_heap error
+	= (expr, var_heap, symbol_heap, error)
+mergeCases (Let lad=:{let_expr}) exprs var_heap symbol_heap error
+	# (let_expr, var_heap, symbol_heap, error) = mergeCases let_expr exprs var_heap symbol_heap error
+	= (Let {lad & let_expr = let_expr}, var_heap,symbol_heap, error)
+mergeCases case_expr=:(Case first_case=:{case_expr = Var {var_info_ptr}, case_default = No}) [expr : exprs] var_heap symbol_heap error
+	= case (split_case var_info_ptr expr) of
+		Yes {case_guards,case_default}
+			# (case_guards, var_heap, symbol_heap, error) = merge_guards first_case.case_guards case_guards var_heap symbol_heap error
+			-> mergeCases (Case { first_case & case_guards = case_guards, case_default = case_default }) exprs var_heap symbol_heap error
+		No
+			# (case_default, var_heap, symbol_heap, error) = mergeCases expr exprs var_heap symbol_heap error
+			-> (Case { first_case & case_default = Yes case_default}, var_heap, symbol_heap, error)
+
+where
+	split_case split_var_info_ptr (Case this_case=:{case_expr = Var {var_info_ptr}, case_guards, case_default})
+		| split_var_info_ptr == var_info_ptr
+			= Yes this_case
+		| has_no_default case_default
+			= case case_guards of
+				AlgebraicPatterns type [alg_pattern]
+					-> case (split_case split_var_info_ptr alg_pattern.ap_expr) of
+						Yes split_case
+							-> Yes { split_case & case_guards = push_expression_into_guards (
+										\guard_expr -> Case { this_case & case_guards = 
+												AlgebraicPatterns type [ { alg_pattern & ap_expr = guard_expr }] })
+													split_case.case_guards }
+									
+						No
+							-> No
+				BasicPatterns type [basic_pattern]
+					-> case (split_case split_var_info_ptr basic_pattern.bp_expr) of
+						Yes split_case
+							-> Yes { split_case & case_guards = push_expression_into_guards (
+										\guard_expr -> Case { this_case & case_guards = 
+												BasicPatterns type [ { basic_pattern & bp_expr = guard_expr }] })
+													split_case.case_guards }
+									
+						No
+							-> No
+				DynamicPatterns [dynamic_pattern]
+					-> case (split_case split_var_info_ptr dynamic_pattern.dp_rhs) of
+						Yes split_case
+							-> Yes { split_case & case_guards = push_expression_into_guards (
+										\guard_expr -> Case { this_case & case_guards = 
+												DynamicPatterns [ { dynamic_pattern & dp_rhs = guard_expr }] })
+													split_case.case_guards }
+									
+						No
+							-> No
+				_
+					-> No
+		| otherwise
+			= No
+	split_case split_var_info_ptr (Let lad=:{let_expr})
+		= case (split_case split_var_info_ptr let_expr) of
+			Yes split_case		
+				-> Yes { split_case & case_guards = push_expression_into_guards (
+						\let_expr -> Let { lad & let_expr = let_expr}) split_case.case_guards }
+			No
+				-> No
+	split_case split_var_info_ptr expr
+		= No
+	
+	has_no_default No 		= True
+	has_no_default (Yes _) 	= False
+
+	push_expression_into_guards expr_fun (AlgebraicPatterns type patterns) 
+		= AlgebraicPatterns type (map (\algpattern -> { algpattern & ap_expr = expr_fun algpattern.ap_expr }) patterns)
+	push_expression_into_guards expr_fun (BasicPatterns type patterns) 
+		= BasicPatterns type (map (\baspattern -> { baspattern & bp_expr = expr_fun baspattern.bp_expr }) patterns)
+	push_expression_into_guards expr_fun (DynamicPatterns patterns) 
+		= DynamicPatterns (map (\dynpattern -> { dynpattern & dp_rhs = expr_fun dynpattern.dp_rhs }) patterns)
+
+/*  Happened already */
+/*
+	skip_aliases info_ptr []
+		= info_ptr
+	skip_aliases info_ptr [{bind_src=Var {var_info_ptr},bind_dst} : binds ]
+		| info_ptr == var_info_ptr
+			= skip_aliases bind_dst.fv_info_ptr binds
+			= skip_aliases info_ptr binds
+*/
+
+
+	merge_guards guards=:(AlgebraicPatterns type1 patterns1) (AlgebraicPatterns type2 patterns2) var_heap symbol_heap error
+		| type1 == type2
+			# (merged_patterns, var_heap, symbol_heap, error) = merge_algebraic_patterns patterns1 patterns2 var_heap symbol_heap error
+			= (AlgebraicPatterns type1 merged_patterns, var_heap, symbol_heap, error) 
+			= (guards, var_heap, symbol_heap, checkError "" "incompatible patterns in case" error)
+	merge_guards guards=:(BasicPatterns basic_type1 patterns1) (BasicPatterns basic_type2 patterns2) var_heap symbol_heap error
+		| basic_type1 == basic_type2
+			# (merged_patterns, var_heap, symbol_heap, error) = merge_basic_patterns patterns1 patterns2 var_heap symbol_heap error
+			= (BasicPatterns basic_type1 merged_patterns, var_heap, symbol_heap, error) 
+			= (guards, var_heap, symbol_heap, checkError "" "incompatible patterns in case" error)
+	merge_guards guards=:(DynamicPatterns  patterns1) (DynamicPatterns  patterns2) var_heap symbol_heap error
+		# (merged_patterns, var_heap, symbol_heap, error) = merge_dynamic_patterns patterns1 patterns2 var_heap symbol_heap error
+		= (DynamicPatterns merged_patterns, var_heap, symbol_heap, error) 
+	merge_guards patterns1 patterns2 var_heap symbol_heap error
+		= (patterns1, var_heap, symbol_heap, checkError "" "incompatible patterns in case" error)
+		
+	merge_algebraic_patterns patterns [alg_pattern : alg_patterns] var_heap symbol_heap error
+		# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns alg_pattern patterns var_heap symbol_heap error
+		= merge_algebraic_patterns patterns alg_patterns var_heap symbol_heap error
+	merge_algebraic_patterns patterns [] var_heap symbol_heap error
+		= (patterns, var_heap, symbol_heap, error)
+	
+	merge_basic_patterns patterns [alg_pattern : alg_patterns] var_heap symbol_heap error
+		# (patterns, var_heap, symbol_heap, error) = merge_basic_pattern_with_patterns alg_pattern patterns var_heap symbol_heap error
+		= merge_basic_patterns patterns alg_patterns var_heap symbol_heap error
+	merge_basic_patterns patterns [] var_heap symbol_heap error
+		= (patterns, var_heap, symbol_heap, error)
+	
+	merge_dynamic_patterns patterns1 patterns2 var_heap symbol_heap error
+		= (patterns1 ++ patterns2, var_heap, symbol_heap, error)
+
+	merge_algebraic_pattern_with_patterns new_pattern [pattern=:{ap_symbol,ap_vars,ap_expr} : patterns] var_heap symbol_heap error
+		| new_pattern.ap_symbol == ap_symbol
+			# (new_expr, var_heap, symbol_heap) = replace_variables new_pattern.ap_vars new_pattern.ap_expr ap_vars var_heap symbol_heap
+			  (ap_expr, var_heap, symbol_heap, error) = mergeCases ap_expr [new_expr] var_heap symbol_heap error
+			= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
+			# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns new_pattern patterns var_heap symbol_heap error		
+			= ([ pattern : patterns ], var_heap, symbol_heap, error)
+	where
+		replace_variables [] expr ap_vars var_heap symbol_heap
+			= (expr, var_heap, symbol_heap)
+		replace_variables vars expr ap_vars var_heap symbol_heap
+			# (expr, us) = unfold expr { us_var_heap = build_aliases vars ap_vars var_heap, us_symbol_heap = symbol_heap }
+			= (expr, us.us_var_heap, us.us_symbol_heap)
+
+		build_aliases [var1 : vars1] [ {fv_name,fv_info_ptr} : vars2 ] var_heap
+			= build_aliases vars1 vars2 (writePtr var1.fv_info_ptr (VI_Variable fv_name fv_info_ptr) var_heap)
+		build_aliases [] [] var_heap
+			= var_heap
+
+	merge_algebraic_pattern_with_patterns new_pattern [] var_heap symbol_heap error
+		= ([new_pattern], var_heap, symbol_heap, error)
+	
+	merge_basic_pattern_with_patterns new_pattern [pattern=:{bp_value,bp_expr} : patterns]  var_heap symbol_heap error
+		| new_pattern.bp_value == bp_value
+			# (bp_expr, var_heap, symbol_heap, error) = mergeCases bp_expr [new_pattern.bp_expr] var_heap symbol_heap error
+			= ([{ pattern & bp_expr = bp_expr} : patterns], var_heap, symbol_heap, error)
+			# (patterns, var_heap, symbol_heap, error) = merge_basic_pattern_with_patterns new_pattern patterns var_heap symbol_heap error		
+			= ([ pattern : patterns ], var_heap, symbol_heap, error)
+	merge_basic_pattern_with_patterns new_pattern [] var_heap symbol_heap error
+		= ([new_pattern], var_heap, symbol_heap, error)
+	
+mergeCases case_expr=:(Case first_case=:{case_default}) [expr : exprs] var_heap symbol_heap error
+	= case case_default of
+		Yes default_expr
+			# (default_expr, var_heap, symbol_heap, error) = mergeCases default_expr [expr : exprs] var_heap symbol_heap error
+			-> (Case { first_case & case_default = Yes default_expr }, var_heap, symbol_heap, error)
+		No
+			# (default_expr, var_heap, symbol_heap, error) = mergeCases expr exprs var_heap symbol_heap error
+			-> (Case { first_case & case_default = Yes default_expr }, var_heap, symbol_heap, error)
+mergeCases expr _ var_heap symbol_heap error
+	= (expr, var_heap, symbol_heap, checkWarning "" " alternative will never match" error)
+
+ 
+liftFunctions min_level group group_index fun_defs var_heap expr_heap
+	# (contains_free_vars, lifted_function_called, fun_defs)
+			= foldSt (add_free_vars_of_non_recursive_calls_to_function group_index) group (False, False, fun_defs)
+	| contains_free_vars
+		# fun_defs = iterateSt (foldSt (add_free_vars_of_recursive_calls_to_function group_index) group) fun_defs
+		= lift_functions group fun_defs var_heap expr_heap
+	| lifted_function_called
+		= lift_functions group fun_defs var_heap expr_heap
+		= (fun_defs, var_heap, expr_heap)
+where
+
+	add_free_vars_of_non_recursive_calls_to_function group_index fun (contains_free_vars, lifted_function_called, fun_defs)
+		# (fun_def=:{fun_info}, fun_defs) = fun_defs![fun]
+		  { fi_free_vars,fi_def_level,fi_calls } = fun_info
+		  (lifted_function_called, fi_free_vars, fun_defs)
+				= foldSt (add_free_vars_of_non_recursive_call fi_def_level group_index) fi_calls (lifted_function_called, fi_free_vars, fun_defs)
+		= (contains_free_vars || not (isEmpty fi_free_vars), lifted_function_called, 
+			{ fun_defs & [fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}})
+	where
+		add_free_vars_of_non_recursive_call fun_def_level group_index {fc_index} (lifted_function_called, free_vars, fun_defs)
+			# ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index]
+			| fi_group_index == group_index
+				= (lifted_function_called, free_vars, fun_defs)
+				| isEmpty fi_free_vars
+					= (lifted_function_called, free_vars, fun_defs)
+					# (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (False, free_vars)
+					= (True, free_vars, fun_defs)
+	
+	add_free_vars_of_recursive_calls_to_function group_index fun (free_vars_added, fun_defs)
+		# (fun_def=:{fun_info}, fun_defs) = fun_defs![fun]
+		  { fi_free_vars,fi_def_level,fi_calls } = fun_info
+		  (free_vars_added, fi_free_vars, fun_defs)
+				= foldSt (add_free_vars_of_recursive_call fi_def_level group_index) fi_calls (free_vars_added, fi_free_vars, fun_defs)
+		= (free_vars_added, { fun_defs & [fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}})
+	where
+		add_free_vars_of_recursive_call fun_def_level group_index {fc_index} (free_vars_added, free_vars, fun_defs)
+			# ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index]
+			| fi_group_index == group_index
+				# (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (free_vars_added, free_vars)
+				= (free_vars_added, free_vars, fun_defs)
+				= (free_vars_added, free_vars, fun_defs)
+
+	add_free_variables fun_level new_vars (free_vars_added, free_vars)
+		= add_free_global_variables (skip_local_variables fun_level new_vars) (free_vars_added, free_vars)
+	where
+		skip_local_variables level vars=:[{fv_def_level}:rest_vars]
+			| fv_def_level > level
+				= skip_local_variables level rest_vars
+				= vars
+		skip_local_variables _ []
+			= []
+
+		add_free_global_variables []  (free_vars_added, free_vars)
+			= (free_vars_added, free_vars)
+		add_free_global_variables free_vars (free_vars_added, [])
+			= (True, free_vars)
+		add_free_global_variables [var:vars] (free_vars_added, free_vars)
+			# (free_var_added, free_vars) = newFreeVariable var free_vars
+			= add_free_global_variables vars (free_var_added || free_vars_added, free_vars)
+
+	lift_functions group fun_defs var_heap expr_heap
+		= foldSt lift_function group (fun_defs, var_heap, expr_heap)
+	where
+		lift_function fun (fun_defs=:{[fun] = fun_def}, var_heap, expr_heap)
+			# {fi_free_vars} = fun_def.fun_info
+			  fun_lifted = length fi_free_vars
+			  (PartioningFunction {cb_args,cb_rhs} fun_number) = fun_def.fun_body
+			  (cb_args, var_heap) = add_lifted_args fi_free_vars cb_args var_heap
+			  (cb_rhs, {ls_fun_defs,ls_var_heap,ls_expr_heap}) = lift cb_rhs { ls_fun_defs = fun_defs, ls_var_heap = var_heap, ls_expr_heap = expr_heap }
+			  ls_var_heap = remove_lifted_args fi_free_vars ls_var_heap
+			  ls_fun_defs = { ls_fun_defs & [fun] = { fun_def & fun_lifted = fun_lifted, fun_body = PartioningFunction {cb_args = cb_args, cb_rhs = cb_rhs} fun_number}}
+			= (ls_fun_defs, ls_var_heap, ls_expr_heap)
+//				 ---> ("lift_function", fun_def.fun_symb, fi_free_vars, cb_args, cb_rhs)
+
+		remove_lifted_args vars var_heap
+			= foldl (\var_heap {fv_name,fv_info_ptr} -> writePtr fv_info_ptr VI_Empty var_heap) var_heap vars
+	
+		add_lifted_args [lifted_arg=:{fv_name,fv_info_ptr} : lifted_args] args var_heap
+			# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+			  args = [{ lifted_arg & fv_info_ptr = new_info_ptr } : args ]
+			= add_lifted_args lifted_args args (writePtr fv_info_ptr (VI_LiftedVariable new_info_ptr) var_heap)
+		add_lifted_args [] args var_heap
+			= (args, var_heap)
+
+::	ExpandInfo :== (![FunCall], !.ExpandState)
+
+::	ExpandState =
+	{	es_symbol_table	:: !.SymbolTable
+	,	es_var_heap		:: !.VarHeap
+	,	es_symbol_heap 	:: !.ExpressionHeap
+	,	es_error 		:: !.ErrorAdmin
+	}
+
+class expand a :: !a !*{#FunDef} !Int !v:{# DclModule} !*ExpandInfo -> (!a, !*{#FunDef}, !v:{# DclModule}, !*ExpandInfo)
+
+instance expand [a] | expand a
+where
+	expand [x:xs] fun_and_macro_defs mod_index modules es
+		# (x, fun_and_macro_defs, modules, es) = expand x fun_and_macro_defs mod_index modules es
+		  (xs, fun_and_macro_defs, modules, es) = expand xs fun_and_macro_defs mod_index modules es
+		= ([x:xs], fun_and_macro_defs, modules, es)
+	expand [] fun_and_macro_defs mod_index modules es
+		= ([], fun_and_macro_defs, modules, es)
+
+instance expand (a,b) | expand a & expand b
+where
+	expand (x,y) fun_and_macro_defs mod_index modules es
+		# (x, fun_and_macro_defs, modules, es) = expand x fun_and_macro_defs mod_index modules es
+		  (y, fun_and_macro_defs, modules, es) = expand y fun_and_macro_defs mod_index modules es
+		= ((x,y), fun_and_macro_defs, modules, es)
+
+instance expand (Optional a) | expand a
+where
+	expand (Yes x) fun_and_macro_defs mod_index modules es
+		# (x, fun_and_macro_defs, modules, es) = expand x fun_and_macro_defs mod_index modules es
+		= (Yes x, fun_and_macro_defs, modules, es)
+	expand no fun_and_macro_defs mod_index modules es
+		= (no, fun_and_macro_defs, modules, es)
+/*
+determineArity (SK_Function)
+determineArity (SK_OverloadedFunction
+determineArity (SK_Constructor
+*/
+instance expand Expression
+where
+
+	expand (App app=:{app_symb = symb=:{symb_arity, symb_kind = SK_Macro {glob_object,glob_module}}, app_args}) fun_and_macro_defs mod_index modules es
+		# (app_args, fun_and_macro_defs, modules, (calls, state)) = expand app_args fun_and_macro_defs mod_index modules es
+		#! macro = fun_and_macro_defs.[glob_object]
+		| macro.fun_arity == symb_arity
+			# (expr, fun_and_macro_defs, es) = unfoldMacro macro app_args fun_and_macro_defs (calls, state)
+			= (expr, fun_and_macro_defs, modules, es)
+			# (calls, es_symbol_table) = examineFunctionCall macro.fun_symb {fc_index = glob_object, fc_level = NotALevel} (calls, state.es_symbol_table)
+			= (App { app & app_symb = { symb & symb_kind = SK_Function {glob_object = glob_object, glob_module = glob_module} }, app_args = app_args },
+					fun_and_macro_defs, modules, (calls, { state & es_symbol_table = es_symbol_table }))
+	expand (App app=:{app_args}) fun_and_macro_defs mod_index modules es
+		# (app_args, fun_and_macro_defs, modules, es) = expand app_args fun_and_macro_defs mod_index modules es
+		= (App { app & app_args = app_args }, fun_and_macro_defs, modules, es)
+	expand (expr @ exprs) fun_and_macro_defs mod_index modules es
+		# ((expr,exprs), fun_and_macro_defs, modules, es) = expand (expr,exprs) fun_and_macro_defs mod_index modules es
+		= (expr @ exprs, fun_and_macro_defs, modules, es)
+	expand (Let lad=:{let_binds, let_expr}) fun_and_macro_defs mod_index modules es
+		# ((let_binds,let_expr), fun_and_macro_defs, modules, es) = expand (let_binds,let_expr) fun_and_macro_defs mod_index modules es
+		= (Let {lad & let_expr = let_expr, let_binds = let_binds}, fun_and_macro_defs, modules, es)
+	expand (Case case_expr) fun_and_macro_defs mod_index modules es
+		# (case_expr, fun_and_macro_defs, modules, es) = expand case_expr fun_and_macro_defs mod_index modules es
+		= (Case case_expr, fun_and_macro_defs, modules, es)
+	expand (Selection is_unique expr selectors) fun_and_macro_defs mod_index modules es
+		# ((expr, selectors), fun_and_macro_defs, modules, es) = expand (expr, selectors) fun_and_macro_defs mod_index modules es
+		= (Selection is_unique expr selectors, fun_and_macro_defs, modules, es)
+	expand (Update expr1 selectors expr2) fun_and_macro_defs mod_index modules es
+		# (((expr1, expr2), selectors), fun_and_macro_defs, modules, es) = expand ((expr1, expr2), selectors) fun_and_macro_defs mod_index modules es
+		= (Update expr1 selectors expr2, fun_and_macro_defs, modules, es)
+	expand (RecordUpdate cons_symbol expression expressions) fun_and_macro_defs mod_index modules es
+		# ((expression, expressions), fun_and_macro_defs, modules, es) = expand (expression, expressions) fun_and_macro_defs mod_index modules es
+		= (RecordUpdate cons_symbol expression expressions, fun_and_macro_defs, modules, es)
+	expand (TupleSelect symbol argn_nr expr) fun_and_macro_defs mod_index modules es
+		# (expr, fun_and_macro_defs, modules, es) = expand expr fun_and_macro_defs mod_index modules es
+		= (TupleSelect symbol argn_nr expr, fun_and_macro_defs, modules, es)
+	expand (Lambda vars expr) fun_and_macro_defs mod_index modules es
+		# (expr, fun_and_macro_defs, modules, es) = expand expr fun_and_macro_defs mod_index modules es
+		= (Lambda vars expr, fun_and_macro_defs, modules, es)
+	expand (MatchExpr opt_tuple cons_symb expr) fun_and_macro_defs mod_index modules es
+		# (expr, fun_and_macro_defs, modules, es) = expand expr fun_and_macro_defs mod_index modules es
+		= (MatchExpr opt_tuple cons_symb expr, fun_and_macro_defs, modules, es)
+	expand expr fun_and_macro_defs mod_index modules es
+		= (expr, fun_and_macro_defs, modules, es)
+
+instance expand Selection
+where
+	expand (ArraySelection array_select expr_ptr index_expr) fun_and_macro_defs mod_index modules es
+		# (index_expr, fun_and_macro_defs, modules, es) = expand index_expr fun_and_macro_defs mod_index modules es
+		= (ArraySelection array_select expr_ptr index_expr, fun_and_macro_defs, modules, es)
+	expand record_selection fun_and_macro_defs mod_index modules es
+		= (record_selection, fun_and_macro_defs, modules, es)
+
+
+instance expand (Bind a b) | expand a
+where
+	expand bind=:{bind_src} fun_and_macro_defs mod_index modules es
+		# (bind_src, fun_and_macro_defs, modules, es) = expand bind_src fun_and_macro_defs mod_index modules es
+		= ({ bind & bind_src = bind_src }, fun_and_macro_defs, modules, es)
+
+instance expand Case
+where
+	expand kees=:{ case_expr,case_guards,case_default } fun_and_macro_defs mod_index modules es
+		# ((case_expr,(case_guards,case_default)), fun_and_macro_defs, modules, es) = expand (case_expr,(case_guards,case_default)) fun_and_macro_defs mod_index modules es
+		= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default }, fun_and_macro_defs, modules, es)
+
+instance expand CasePatterns
+where
+	expand (AlgebraicPatterns type patterns) fun_and_macro_defs mod_index modules es
+		# (patterns, fun_and_macro_defs, modules, es) = expand patterns fun_and_macro_defs mod_index modules es
+		= (AlgebraicPatterns type patterns, fun_and_macro_defs, modules, es) 
+	expand (BasicPatterns type patterns) fun_and_macro_defs mod_index modules es
+		# (patterns, fun_and_macro_defs, modules, es) = expand patterns fun_and_macro_defs mod_index modules es
+		= (BasicPatterns type patterns, fun_and_macro_defs, modules, es) 
+	expand (DynamicPatterns patterns) fun_and_macro_defs mod_index modules es
+		# (patterns, fun_and_macro_defs, modules, es) = expand patterns fun_and_macro_defs mod_index modules es
+		= (DynamicPatterns patterns, fun_and_macro_defs, modules, es) 
+
+instance expand AlgebraicPattern
+where
+	expand alg_pattern=:{ap_expr} fun_and_macro_defs mod_index modules es
+		# (ap_expr, fun_and_macro_defs, modules, es) = expand ap_expr fun_and_macro_defs mod_index modules es
+		= ({ alg_pattern & ap_expr = ap_expr }, fun_and_macro_defs, modules, es)
+
+instance expand BasicPattern
+where
+	expand bas_pattern=:{bp_expr} fun_and_macro_defs mod_index modules es
+		# (bp_expr, fun_and_macro_defs, modules, es) = expand bp_expr fun_and_macro_defs mod_index modules es
+		= ({ bas_pattern & bp_expr = bp_expr }, fun_and_macro_defs, modules, es)
+
+instance expand DynamicPattern
+where
+	expand dyn_pattern=:{dp_rhs} fun_and_macro_defs mod_index modules es
+		# (dp_rhs, fun_and_macro_defs, modules, es) = expand dp_rhs fun_and_macro_defs mod_index modules es
+		= ({ dyn_pattern & dp_rhs = dp_rhs }, fun_and_macro_defs, modules, es)
+
+
+::	CollectState =
+	{	cos_var_heap	:: !.VarHeap
+	,	cos_symbol_heap :: !.ExpressionHeap
+	,	cos_error		:: !.ErrorAdmin
+	}
+
+determineVariablesAndRefCounts :: ![FreeVar] !Expression !*CollectState -> (!Expression , ![FreeVar], ![FreeVar], !*CollectState)
+determineVariablesAndRefCounts free_vars expr cos=:{cos_var_heap}
+	# (expr, local_vars, cos) = collectVariables expr [] { cos & cos_var_heap = clearCount free_vars cIsAGlobalVar cos_var_heap }
+	  (free_vars, cos_var_heap) = retrieveRefCounts free_vars cos.cos_var_heap
+	  (local_vars, cos_var_heap) = retrieveRefCounts local_vars cos_var_heap
+	= (expr, free_vars, local_vars, { cos & cos_var_heap = cos_var_heap })
+
+retrieveRefCounts free_vars var_heap
+	= mapSt retrieveRefCount free_vars var_heap
+
+retrieveRefCount fv=:{fv_info_ptr} var_heap
+	# (VI_Count count _, var_heap) = readPtr fv_info_ptr var_heap
+	= ({ fv & fv_count = count }, var_heap)
+
+/*
+	'clearCount' initialises the 'fv_info_ptr' field of each 'FreeVar'
+*/
+
+class clearCount a :: !a !Bool !*VarHeap -> *VarHeap
+
+instance clearCount [a] | clearCount a
+where
+	clearCount [x:xs] locality var_heap
+		= clearCount x locality (clearCount xs locality var_heap)
+	clearCount [] locality var_heap
+		= var_heap
+
+instance clearCount (Bind a b) | clearCount b
+where
+	clearCount bind=:{bind_dst} locality var_heap
+		= clearCount bind_dst locality var_heap
+
+instance clearCount FreeVar
+where
+	clearCount{fv_info_ptr} locality var_heap
+		= var_heap <:= (fv_info_ptr, VI_Count 0 locality)
+
+/*
+	In 'collectVariables' all local variables are collected. Moreover the reference counts
+	of the local as well as of the global variables are determined. Aliases and unreachable 
+	bindings introduced in a 'let' are removed.
+*/	
+
+class collectVariables a :: !a ![FreeVar] !*CollectState -> !(!a, ![FreeVar],!*CollectState)
+
+cContainsACycle		:== True
+cContainsNoCycle	:== False
+
+instance collectVariables Expression
+where
+	collectVariables (Var var) free_vars cos
+		# (var, free_vars, cos) = collectVariables var free_vars cos
+		= (Var var, free_vars, cos)
+	collectVariables (App app=:{app_args}) free_vars cos
+		# (app_args, free_vars, cos) = collectVariables app_args free_vars cos
+		= (App { app & app_args = app_args}, free_vars, cos)
+	collectVariables (expr @ exprs) free_vars cos
+		# ((expr, exprs), free_vars, cos) = collectVariables (expr, exprs) free_vars cos
+		= (expr @ exprs, free_vars, cos)
+	collectVariables (Let lad=:{let_binds, let_expr}) free_vars cos=:{cos_var_heap}
+		# cos_var_heap = determine_aliases let_binds cos_var_heap
+		  (is_cyclic, let_binds, cos_var_heap) = detect_cycles_and_remove_alias_binds let_binds cos_var_heap
+		| is_cyclic
+			= (Let {lad & let_binds = let_binds }, free_vars, { cos & cos_var_heap = cos_var_heap, cos_error = checkError "" "cyclic let definition" cos.cos_error})
+		| otherwise
+			# (let_expr, free_vars, cos) = collectVariables let_expr free_vars { cos & cos_var_heap = cos_var_heap }
+			  (let_binds, free_vars, cos) = collect_variables_in_binds let_binds [] free_vars cos
+			| isEmpty let_binds
+				= (let_expr, free_vars, cos)
+				= (Let {lad & let_expr = let_expr, let_binds = let_binds}, free_vars, cos)
+		where
+		
+		/*	Set the 'var_info_field' of each  bound variable to either 'VI_Alias var' (if
+			this variable is an alias for 'var') or to 'VI_Count 0 cIsALocalVar' to initialise
+		   	the reference count info.
+		*/	   
+		   
+			determine_aliases [{bind_dst={fv_info_ptr}, bind_src = Var var} : binds] var_heap
+				= determine_aliases binds (writePtr fv_info_ptr (VI_Alias var) var_heap)
+			determine_aliases [bind : binds] var_heap
+				= determine_aliases binds (clearCount bind cIsALocalVar var_heap)
+			determine_aliases [] var_heap
+				= var_heap
+
+			
+		/*	Remove all aliases from the list of 'let'-binds. Be carefull with cycles! */
+		
+			detect_cycles_and_remove_alias_binds [] var_heap
+				= (cContainsNoCycle, [], var_heap)
+			detect_cycles_and_remove_alias_binds [bind=:{bind_dst={fv_info_ptr}} : binds] var_heap
+				#! var_info = sreadPtr fv_info_ptr var_heap
+				= case var_info of
+					VI_Alias {var_info_ptr}
+						| is_cyclic fv_info_ptr var_info_ptr var_heap
+							-> (cContainsACycle, binds, var_heap)
+							-> detect_cycles_and_remove_alias_binds binds var_heap
+					_
+						# (is_cyclic, binds, var_heap) = detect_cycles_and_remove_alias_binds binds var_heap
+						-> (is_cyclic, [bind : binds], var_heap)
+			where
+				is_cyclic orig_info_ptr info_ptr var_heap
+					| orig_info_ptr == info_ptr
+						= True
+						#! var_info = sreadPtr info_ptr var_heap
+						= case var_info of
+							VI_Alias {var_info_ptr}
+								-> is_cyclic orig_info_ptr var_info_ptr var_heap
+							_
+								-> False
+								
+		/*	Apply 'collectVariables' to the bound expressions (the 'bind_src' field of 'let'-bind) if
+		    the corresponding bound variable (the 'bind_dst' field) has been used. This can be determined
+		    by examining the reference count.
+		*/
+
+			collect_variables_in_binds binds collected_binds free_vars cos
+				# (continue, binds, collected_binds, free_vars, cos) = examine_reachable_binds False binds collected_binds free_vars cos
+				| continue
+					= collect_variables_in_binds binds collected_binds free_vars cos
+					= (collected_binds, free_vars, cos)
+		
+			examine_reachable_binds bind_found [bind=:{bind_dst={fv_info_ptr},bind_src} : binds] collected_binds free_vars cos
+				# (bind_found, binds, collected_binds, free_vars, cos) = examine_reachable_binds bind_found binds collected_binds free_vars cos
+				#! var_info = sreadPtr fv_info_ptr cos.cos_var_heap
+				# (VI_Count count is_global) = var_info
+				| count > 0
+					# (bind_src, free_vars, cos) = collectVariables bind_src free_vars cos
+					= (True, binds, [ { bind & bind_src = bind_src } : collected_binds ], free_vars, cos)
+					= (bind_found, [bind : binds], collected_binds, free_vars, cos)
+			examine_reachable_binds bind_found [] collected_binds free_vars cos
+				= (bind_found, [], collected_binds, free_vars, cos)
+
+	collectVariables (Case case_expr) free_vars cos
+		# (case_expr, free_vars, cos) = collectVariables case_expr free_vars cos
+		= (Case case_expr, free_vars, cos)
+	collectVariables (Selection is_unique expr selectors) free_vars cos
+		# ((expr, selectors), free_vars, cos) = collectVariables (expr, selectors) free_vars cos
+		= (Selection is_unique expr selectors, free_vars, cos)
+	collectVariables (Update expr1 selectors expr2) free_vars cos
+		# (((expr1, expr2), selectors), free_vars, cos) = collectVariables ((expr1, expr2), selectors) free_vars cos
+		= (Update expr1 selectors expr2, free_vars, cos)
+	collectVariables (RecordUpdate cons_symbol expression expressions) free_vars cos
+		# ((expression, expressions), free_vars, cos) = collectVariables (expression, expressions) free_vars cos
+		= (RecordUpdate cons_symbol expression expressions, free_vars, cos)
+	collectVariables (TupleSelect symbol argn_nr expr) free_vars cos
+		# (expr, free_vars, cos) = collectVariables expr free_vars cos
+		= (TupleSelect symbol argn_nr expr, free_vars, cos)
+	collectVariables (MatchExpr opt_tuple cons_symb expr) free_vars cos
+		# (expr, free_vars, cos) = collectVariables expr free_vars cos
+		= (MatchExpr opt_tuple cons_symb expr, free_vars, cos)
+	collectVariables expr free_vars cos
+		= (expr, free_vars, cos)
+
+instance collectVariables Selection
+where
+	collectVariables (ArraySelection array_select expr_ptr index_expr) free_vars cos
+		# (index_expr, free_vars, cos) = collectVariables index_expr free_vars cos
+		= (ArraySelection array_select expr_ptr index_expr, free_vars, cos)
+	collectVariables record_selection free_vars cos
+		= (record_selection, free_vars, cos)
+
+
+instance collectVariables [a] | collectVariables a
+where
+	collectVariables [x:xs] free_vars cos
+		# (x, free_vars, cos) = collectVariables x free_vars cos
+		# (xs, free_vars, cos) = collectVariables xs free_vars cos
+		= ([x:xs], free_vars, cos)
+	collectVariables [] free_vars cos
+		= ([], free_vars, cos)
+
+instance collectVariables !(!a,!b) | collectVariables a & collectVariables b
+where
+	collectVariables (x,y) free_vars cos
+		# (x, free_vars, cos) = collectVariables x free_vars cos
+		# (y, free_vars, cos) = collectVariables y free_vars cos
+		= ((x,y), free_vars, cos)
+
+instance collectVariables (Optional a) | collectVariables a
+where
+	collectVariables (Yes x) free_vars cos
+		# (x, free_vars, cos) = collectVariables x free_vars cos
+		= (Yes x, free_vars, cos)
+	collectVariables no free_vars cos
+		= (no, free_vars, cos)
+
+instance collectVariables (Bind a b) | collectVariables a where
+	collectVariables bind=:{bind_src} free_vars cos
+		# (bind_src, free_vars, cos) = collectVariables bind_src free_vars cos
+		= ({bind & bind_src = bind_src}, free_vars, cos)
+
+instance collectVariables Case
+where
+	collectVariables kees=:{ case_expr, case_guards, case_default } free_vars cos
+		# (case_expr, free_vars, cos) = collectVariables case_expr free_vars cos
+		# (case_guards, free_vars, cos) = collectVariables case_guards free_vars cos
+		# (case_default, free_vars, cos) = collectVariables case_default free_vars cos
+		=  ({ kees & case_expr = case_expr, case_guards = case_guards, case_default = case_default }, free_vars, cos)
+
+
+instance collectVariables CasePatterns
+where
+	collectVariables (AlgebraicPatterns type patterns) free_vars cos
+		# (patterns, free_vars, cos) = collectVariables patterns free_vars cos
+		= (AlgebraicPatterns type patterns, free_vars, cos)
+	collectVariables (BasicPatterns type patterns) free_vars cos
+		# (patterns, free_vars, cos) = collectVariables patterns free_vars cos
+		= (BasicPatterns type patterns, free_vars, cos)
+	collectVariables (DynamicPatterns patterns) free_vars cos
+		# (patterns, free_vars, cos) = collectVariables patterns free_vars cos
+		= (DynamicPatterns patterns, free_vars, cos)
+
+
+instance collectVariables AlgebraicPattern
+where
+	collectVariables pattern=:{ap_vars,ap_expr} free_vars cos
+		# (ap_expr, free_vars, cos) = collectVariables ap_expr free_vars { cos & cos_var_heap = clearCount ap_vars cIsALocalVar cos.cos_var_heap}
+		  (ap_vars, cos_var_heap) = retrieveRefCounts ap_vars cos.cos_var_heap
+		= ({ pattern & ap_expr = ap_expr, ap_vars = ap_vars }, free_vars, { cos & cos_var_heap = cos_var_heap })
+	
+instance collectVariables BasicPattern
+where
+	collectVariables pattern=:{bp_expr} free_vars cos
+		# (bp_expr, free_vars, cos) = collectVariables bp_expr free_vars cos
+		= ({ pattern & bp_expr = bp_expr }, free_vars, cos)
+
+instance collectVariables DynamicPattern
+where
+	collectVariables pattern=:{dp_var,dp_rhs} free_vars cos
+		# (dp_rhs, free_vars, cos) = collectVariables dp_rhs free_vars { cos & cos_var_heap = clearCount dp_var cIsALocalVar cos.cos_var_heap}
+		  (dp_var, cos_var_heap) = retrieveRefCount dp_var cos.cos_var_heap
+		= ({ pattern & dp_rhs = dp_rhs, dp_var = dp_var }, free_vars, { cos & cos_var_heap = cos_var_heap })
+
+instance collectVariables BoundVar
+where
+	collectVariables var=:{var_name,var_info_ptr} free_vars cos=:{cos_var_heap}
+		#! var_info = sreadPtr var_info_ptr cos_var_heap
+		= case var_info of
+			VI_Alias alias
+				-> collectVariables alias free_vars cos
+			VI_Count count is_global
+				| count > 0 || is_global
+					-> (var, free_vars, { cos & cos_var_heap = writePtr var_info_ptr (VI_Count (inc count) is_global) cos.cos_var_heap })
+					-> (var, [{fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0} : free_vars ],
+								{ cos & cos_var_heap = writePtr var_info_ptr (VI_Count 1 is_global) cos.cos_var_heap })
+			_
+				-> abort "collectVariables [BoundVar] (transform, 1227)" <<- (var_info ---> var_name)
+
+instance <<< FreeVar
+where
+	(<<<) file { fv_name } = file <<< fv_name
+	
+instance <<< Ptr a
+where
+	(<<<) file p = file <<< ptrToInt p
+
+instance <<< FunCall
+where
+	(<<<) file {fc_index} = file <<< fc_index
+
diff --git a/frontend/type.dcl b/frontend/type.dcl
new file mode 100644
index 0000000..259fb70
--- /dev/null
+++ b/frontend/type.dcl
@@ -0,0 +1,8 @@
+definition module type
+
+import StdArray
+import syntax, check
+
+typeProgram ::!{! Group} !*{# FunDef} !IndexRange !CommonDefs ![Declaration] !{# DclModule} !*Heaps !*PredefinedSymbols !*File
+	-> (!Bool, !*{# FunDef}, !{! (!Index, !SymbolType)}, {! GlobalTCType}, !{# CommonDefs}, !{# {# FunType} }, !*Heaps, !*PredefinedSymbols, !*File)
+
diff --git a/frontend/type.icl b/frontend/type.icl
new file mode 100644
index 0000000..370ef07
--- /dev/null
+++ b/frontend/type.icl
@@ -0,0 +1,1729 @@
+implementation module type
+
+
+import StdEnv
+import syntax, typesupport, check, analtypes, overloading, unitype, refmark, predef, utilities, compare_constructor
+import RWSDebug
+
+::	TypeInput =
+	{	ti_common_defs	:: {# CommonDefs }
+	,	ti_functions	:: {# {# FunType }}
+	}
+
+::	FunctionType = CheckedType !SymbolType | SpecifiedType !SymbolType ![AType] !TempSymbolType
+				 | UncheckedType !TempSymbolType | ExpandedType !SymbolType !TempSymbolType !TempSymbolType  | EmptyFunctionType
+
+::	TypeState =
+	{	ts_fun_env		:: !.{! FunctionType}
+	,	ts_var_store	:: !Int
+	,	ts_attr_store	:: !Int
+	,	ts_var_heap		:: !.VarHeap 
+	,	ts_type_heaps	:: !.TypeHeaps
+	,	ts_expr_heap	:: !.ExpressionHeap 
+	,	ts_td_infos		:: !.TypeDefInfos
+	,	ts_error		:: !.ErrorAdmin
+	}
+
+::	TypeCoercion =
+	{	tc_demanded		:: !AType
+	,	tc_offered		:: !AType
+	,	tc_position		:: !CoercionPosition
+	,	tc_coercible	:: !Bool
+	}
+
+::	SharedAttribute = 
+	{	sa_attr_nr	::	!Int
+	,	sa_position	:: !Expression
+	}
+
+::	Requirements =
+	{	req_overloaded_calls	:: ![ExprInfoPtr]
+	,	req_type_coercions		:: ![TypeCoercion]
+	,	req_attr_coercions		:: ![AttrCoercion]
+	,	req_cons_variables		:: ![[TempVarId]]
+	,	req_case_and_let_exprs	:: ![ExprInfoPtr]
+	}
+	
+instance toString BoundVar
+where
+	toString varid = varid.var_name.id_name
+	
+class arraySubst type :: !type !u:{!Type} -> (!type, !u:{! Type})
+
+instance arraySubst AType
+where
+	arraySubst atype=:{at_type} subst
+		# (at_type, subst) = arraySubst at_type subst
+		= ({ atype & at_type = at_type }, subst)
+		
+instance arraySubst Type
+where
+	arraySubst tv=:(TempV tv_number) subst
+		#! type = subst.[tv_number]
+		= case type of
+			TE	-> (tv, subst)
+			_	-> arraySubst type subst
+	arraySubst (arg_type --> res_type) subst
+		# (arg_type, subst) = arraySubst arg_type subst
+		  (res_type, subst) = arraySubst res_type subst
+		= (arg_type --> res_type, subst)
+	arraySubst (TA cons_id cons_args) subst
+		# (cons_args, subst) = arraySubst cons_args subst
+		= (TA cons_id cons_args, subst) 
+	arraySubst (TempCV tv_number :@: types) subst
+		#! type = subst.[tv_number]
+		= case type of
+			TE
+				# (types, subst) = arraySubst types subst
+				-> (TempCV tv_number :@: types, subst)
+			_
+				# (type, subst) = arraySubst type subst
+				  (types, subst) = arraySubst types subst
+				-> (simplify_type_appl type types, subst)
+	where
+		simplify_type_appl :: !Type ![AType] -> Type
+		simplify_type_appl (TA type_cons=:{type_arity} cons_args) type_args
+			= TA { type_cons & type_arity = type_arity + length type_args } (cons_args ++ type_args)
+		simplify_type_appl (cons_var :@: types) type_args
+			= cons_var :@: (types ++ type_args)
+		simplify_type_appl (TempV tv_number) type_args
+			= TempCV tv_number :@: type_args
+		simplify_type_appl (TempQV tv_number) type_args
+			= TempQCV tv_number :@: type_args
+	arraySubst type subst
+		= (type, subst)
+
+instance arraySubst [a] | arraySubst a
+where
+	arraySubst l subst
+		= mapSt arraySubst l subst
+
+instance arraySubst TempSymbolType
+where
+	arraySubst tst=:{tst_args,tst_result,tst_context} subst
+		# (tst_args, subst) = arraySubst tst_args subst
+		  (tst_result, subst) = arraySubst tst_result subst
+		  (tst_context, subst) = arraySubst tst_context subst
+		= ({tst & tst_args = tst_args,tst_result = tst_result,tst_context = tst_context}, subst)
+
+instance arraySubst TypeContext
+where
+	arraySubst tc=:{tc_types} subst
+		# (tc_types, subst) = arraySubst tc_types subst
+		= ({ tc & tc_types = tc_types}, subst)
+
+/*
+instance arraySubst OverloadedCall
+where
+	arraySubst oc=:{oc_context} subst
+		# (oc_context, subst) = arraySubst oc_context subst
+		= ({ oc & oc_context = oc_context },  subst)
+*/
+
+instance arraySubst CaseType
+where
+	arraySubst ct=:{ct_pattern_type,ct_result_type,ct_cons_types} subst
+		# (ct_pattern_type, subst) = arraySubst ct_pattern_type subst
+		  (ct_result_type, subst) = arraySubst ct_result_type subst
+		  (ct_cons_types, subst) = arraySubst ct_cons_types subst
+		= ({ ct & ct_pattern_type = ct_pattern_type, ct_result_type = ct_result_type, ct_cons_types = ct_cons_types }, subst)
+
+class contains_var a :: !Int !a -> Bool
+
+instance contains_var [a] | contains_var a
+where
+	contains_var var_id [elem:list]
+		= contains_var var_id elem || contains_var var_id list	
+	contains_var var_id []
+		= False
+
+instance contains_var AType
+where
+	contains_var var_id {at_type} = contains_var var_id at_type
+
+instance contains_var Type
+where
+	contains_var var_id (TempV tv_number) 
+		= var_id == tv_number
+	contains_var var_id (arg_type --> res_type) 
+		= contains_var var_id arg_type || contains_var var_id res_type
+	contains_var var_id (TA cons_id cons_args)
+		= contains_var var_id cons_args
+	contains_var var_id (type :@: types)
+		= contains_var var_id type || contains_var var_id types
+	contains_var _ _ 
+		= False
+
+instance contains_var ConsVariable
+where
+	contains_var var_id (TempCV tv_number) 
+		= var_id == tv_number
+	contains_var var_id _
+		= False
+
+cannotUnify t1 t2 position err=:{ea_file,ea_loc} 
+	# ea_file = ea_file <<< hd ea_loc <<< ": cannot unify " <<< t1 <<< " with " <<< t2 <<< " near " <<< position <<< '\n'
+	= { err & ea_file = ea_file, ea_ok = False}
+
+/*
+simplifyType ta=:(type :@: type_args)
+	# type = simplify_type type
+	= case type of
+		TA type_cons cons_args
+			-> TA { type_cons & type_arity = type_cons.type_arity + length type_args } (cons_args ++ type_args)
+	 	_ 	-> ta
+simplifyType type
+	= type
+*/
+
+class unify a :: !a !a !TypeInput !*{! Type} !*TypeHeaps -> (!Bool, !*{! Type}, !*TypeHeaps)
+
+instance unify (a, b) | unify, arraySubst a & unify, arraySubst b
+where
+	unify (t1x, t1y) (t2x, t2y) modules subst heaps
+		# (succ, subst, heaps) =  unify t1y t2y modules subst heaps
+		| succ
+	      # (t1x, subst) = arraySubst t1x subst
+	        (t2x, subst) = arraySubst t2x subst
+	      = unify t1x t2x modules subst heaps
+	      = (False, subst, heaps)
+
+instance unify [a] | unify, arraySubst a
+where
+	unify [t1 : ts1] [t2 : ts2] modules subst heaps
+		= unify (t1,ts1) (t2,ts2) modules subst heaps
+	unify [] [] modules subst heaps
+		= (True, subst, heaps)
+	unify _ _ modules subst heaps
+		= (False, subst, heaps)
+
+instance unify AType
+where
+	unify t1 t2 modules subst heaps = unifyTypes t1.at_type t1.at_attribute t2.at_type t2.at_attribute modules subst heaps
+
+
+unifyTypes :: !Type !TypeAttribute !Type !TypeAttribute !TypeInput !*{! Type} !*TypeHeaps -> (!Bool, !*{! Type}, !*TypeHeaps)
+unifyTypes (TempV tv_number1) attr1 tv=:(TempV tv_number2) attr2 modules subst heaps
+	= unifyTempVarIds tv_number1 tv_number2 subst heaps
+unifyTypes tv=:(TempV tv_number) attr1 type attr2 modules subst heaps
+	| contains_var tv_number type
+		= (False, subst, heaps)
+		= (True, { subst & [tv_number] = type}, heaps)
+unifyTypes type attr1 tv=:(TempV _) attr2 modules subst heaps
+	= unifyTypes tv attr2 type attr1 modules subst heaps
+unifyTypes t1=:(TB tb1) attr1 t2=:(TB tb2) attr2 modules subst heaps
+	| tb1 == tb2
+		= (True, subst, heaps)
+		= (False, subst, heaps)
+unifyTypes (arg_type1 --> res_type1) attr1 (arg_type2 --> res_type2) attr2 modules subst heaps
+	= unify (arg_type1,res_type1) (arg_type2,res_type2) modules subst heaps
+unifyTypes t1=:(TA cons_id1 cons_args1) attr1 t2=:(TA cons_id2 cons_args2) attr2 modules subst heaps
+	| cons_id1 == cons_id2
+		= unify cons_args1 cons_args2 modules subst heaps
+		# (succ1, t1, heaps) = trytoExpand t1 attr1 modules heaps
+		  (succ2, t2, heaps) = trytoExpand t2 attr2 modules heaps
+		| succ1 || succ2
+			= unifyTypes t1 attr1 t2 attr2 modules subst heaps
+			= (False, subst, heaps)
+unifyTypes (cons_var :@: types) attr1 type2 attr2 modules subst heaps
+	# (_, type2, heaps) = trytoExpand type2 attr2 modules heaps
+	= unifyTypeApplications cons_var types type2 modules subst heaps
+unifyTypes type1 attr1 (cons_var :@: types) attr2 modules subst heaps
+	# (_, type1, heaps) = trytoExpand type1 attr1 modules heaps
+	= unifyTypeApplications cons_var types type1 modules subst heaps
+unifyTypes t1=:(TempQV qv_number1) attr1 t2=:(TempQV qv_number2) attr2 modules subst heaps
+	= (qv_number1 == qv_number2, subst, heaps)
+unifyTypes (TempQV qv_number) attr1 type attr2 modules subst heaps
+	= (False, subst, heaps)
+unifyTypes type attr1 (TempQV qv_number1) attr2 modules subst heaps
+	= (False, subst, heaps)
+unifyTypes type1 attr1 type2 attr2 modules subst heaps
+	# (succ1, type1, heaps) = trytoExpand type1 attr1 modules heaps
+	  (succ2, type2, heaps) = trytoExpand type2 attr2 modules heaps
+	| succ1 || succ2
+		= unifyTypes type1 attr1 type2 attr2 modules subst heaps
+		= (False, subst, heaps)
+
+trytoExpand type=:(TA {type_index={glob_object,glob_module}} type_args) type_attr {ti_common_defs} type_heaps
+	#! type_def = ti_common_defs.[glob_module].com_type_defs.[glob_object]
+	= case type_def.td_rhs of
+		SynType {at_type}
+			# (res_type, type_heaps) = expandTypeApplication type_def.td_args type_def.td_attribute at_type type_args type_attr type_heaps
+			-> (True, res_type, type_heaps)
+		_
+			-> (False, type, type_heaps)
+trytoExpand type type_attr modules type_heaps
+	= (False, type, type_heaps)
+
+unifyConsVariables (TempCV tv_number1) (TempCV tv_number2) subst heaps
+	= unifyTempVarIds tv_number1 tv_number2 subst heaps
+unifyConsVariables (TempCV tv_number1) (TempQCV tv_number2) subst heaps
+	= (True, { subst & [tv_number1] = TempQV tv_number2}, heaps)
+unifyConsVariables (TempQCV tv_number1) (TempCV tv_number2) subst heaps
+	= (True, { subst & [tv_number2] = TempQV tv_number1}, heaps)
+unifyConsVariables (TempQCV tv_number1) (TempQCV tv_number2) subst heaps
+	= (tv_number1 == tv_number2, subst, heaps)
+
+unifyTempVarIds tv_number1 tv_number2 subst heaps
+	| tv_number1 == tv_number2
+		= (True, subst, heaps)
+		= (True, { subst & [tv_number1] = TempV tv_number2}, heaps)
+
+constructorVariableToTypeVariable (TempCV temp_var_id)
+	= TempV temp_var_id
+constructorVariableToTypeVariable (TempQCV temp_var_id)
+	= TempQV temp_var_id
+
+unifyTypeApplications cons_var type_args type=:(TA type_cons cons_args) modules subst heaps
+	# diff = type_cons.type_arity - length type_args
+	| diff >= 0 
+		# (succ, subst, heaps) = unify type_args (drop diff cons_args) modules subst heaps
+		| succ
+			# (rest_args, subst) = arraySubst (take diff cons_args) subst
+			= unifyTypes (constructorVariableToTypeVariable cons_var) TA_Multi (TA { type_cons & type_arity = diff } rest_args) TA_Multi modules subst heaps
+		    = (False, subst, heaps)
+		= (False, subst, heaps)
+unifyTypeApplications cons_var1 type_args type=:(cons_var2 :@: types) modules subst heaps
+	# arity1 = length type_args
+	  arity2 = length types
+	  diff = arity1 - arity2
+	| diff == 0
+		# (succ, subst, heaps) = unifyConsVariables cons_var1 cons_var2 subst heaps
+		| succ
+		    # (type_args, subst) = arraySubst type_args subst
+		      (types, subst) = arraySubst types subst
+		    = unify type_args types modules subst heaps
+			= (False, subst, heaps)
+	| diff < 0
+		# diff = 0 - diff
+		  (succ, subst, heaps) = unifyTypes (constructorVariableToTypeVariable cons_var1) TA_Multi (cons_var2 :@: take diff types) TA_Multi modules subst heaps
+		| succ
+		    # (type_args, subst) = arraySubst type_args subst
+		      (types, subst) = arraySubst (drop diff types) subst
+		    = unify type_args types modules subst heaps
+			= (False, subst, heaps)
+	| otherwise
+		# (succ, subst, heaps) = unifyTypes (cons_var1 :@: take diff type_args) TA_Multi (constructorVariableToTypeVariable cons_var2) TA_Multi modules subst heaps
+		| succ
+		    # (type_args, subst) = arraySubst (drop diff type_args) subst
+		      (types, subst) = arraySubst types subst
+		    = unify type_args types modules subst heaps
+			= (False, subst, heaps)
+unifyTypeApplications cons_var type_args type modules subst heaps
+	= (False, subst, heaps)
+
+
+::	CopyState =
+	{	copy_heaps			:: !.TypeHeaps
+	}
+	
+instance fromInt TypeAttribute
+where
+	fromInt AttrUni		= TA_Unique
+	fromInt AttrMulti	= TA_Multi
+	fromInt av_number	= TA_TempVar av_number
+
+class freshCopy a :: !a !*CopyState -> (!a, !*CopyState)
+
+instance freshCopy [a] | freshCopy a
+where
+	freshCopy l ls = mapSt freshCopy l ls
+
+/*
+cDoExtendAttrEnv	:== True
+cDontExtendAttrEnv	:== False
+
+freshCopies :: !Bool ![a] !{# CommonDefs } !*CopyState -> (![a], !*CopyState) | freshCopy a
+freshCopies extend_env [] modules cs
+	= ([], [], cs)
+freshCopies extend_env [t:ts] modules cs
+	# (t, prop, cs) = freshCopy extend_env t modules cs
+	  (ts, props, cs) = freshCopies extend_env ts modules cs
+	= ([t:ts], [prop:props], cs)
+*/
+
+freshCopyOfAttributeVar {av_name,av_info_ptr} attr_var_heap
+	# (av_info, attr_var_heap) = readPtr av_info_ptr attr_var_heap
+	= case av_info of
+		AVI_Attr attr
+			-> (attr, attr_var_heap)
+		_
+			-> abort ("freshCopyOfAttributeVar (type,icl)" ---> av_name)
+
+freshCopyOfTypeAttribute (TA_Var avar) attr_var_heap
+	= freshCopyOfAttributeVar avar attr_var_heap
+freshCopyOfTypeAttribute (TA_RootVar avar) attr_var_heap
+	= freshCopyOfAttributeVar avar attr_var_heap
+freshCopyOfTypeAttribute TA_None attr_var_heap
+	= (TA_Multi, attr_var_heap)
+freshCopyOfTypeAttribute TA_Unique attr_var_heap
+	= (TA_Unique, attr_var_heap)
+freshCopyOfTypeAttribute attr attr_var_heap
+	= (attr, attr_var_heap)
+
+cIsExistential 		:== True
+cIsNotExistential	:== False
+
+freshCopyOfTypeVariable {tv_name,tv_info_ptr} cs=:{copy_heaps}
+	#! tv_info 	= sreadPtr tv_info_ptr copy_heaps.th_vars
+	= case tv_info of
+		 TVI_Type fresh_var
+			-> (fresh_var, cs)
+
+freshConsVariable {tv_info_ptr} type_var_heap
+	#! tv_info 			= sreadPtr tv_info_ptr type_var_heap
+	= (to_constructor_variable tv_info, type_var_heap)
+	where
+		to_constructor_variable (TVI_Type (TempV temp_var_id))
+			= TempCV temp_var_id
+		to_constructor_variable (TVI_Type (TempQV temp_var_id))
+			= TempQCV temp_var_id
+
+instance freshCopy AType
+where 	
+	freshCopy type=:{at_type = CV tv :@: types, at_attribute}  cs=:{copy_heaps}
+		# (fresh_cons_var, th_vars)		= freshConsVariable tv copy_heaps.th_vars
+		  (fresh_attribute, th_attrs)	= freshCopyOfTypeAttribute at_attribute copy_heaps.th_attrs
+		  (types, cs)					= freshCopy types { cs & copy_heaps = { copy_heaps & th_attrs = th_attrs, th_vars = th_vars }}
+		= ({type & at_type = fresh_cons_var :@: types, at_attribute = fresh_attribute }, cs)
+	freshCopy type=:{at_type, at_attribute} cs=:{copy_heaps}
+		# (fresh_attribute, th_attrs)	= freshCopyOfTypeAttribute at_attribute copy_heaps.th_attrs
+		  (fresh_type, cs)				= freshCopy at_type { cs & copy_heaps = { copy_heaps & th_attrs = th_attrs }}
+		= ({ type & at_type = fresh_type, at_attribute = fresh_attribute }, cs)
+		
+instance freshCopy Type
+where
+	freshCopy (TV tv) cs=:{copy_heaps}
+		= freshCopyOfTypeVariable tv cs
+	freshCopy (TA cons_id=:{type_index={glob_object,glob_module}} cons_args)  cs
+		# (cons_args, cs) = freshCopy cons_args cs
+		= (TA cons_id cons_args, cs)
+	freshCopy (arg_type --> res_type) cs
+		# (arg_type, cs) = freshCopy arg_type cs
+		  (res_type, cs) = freshCopy res_type cs
+		= (arg_type --> res_type, cs)
+	freshCopy type cs
+		= (type, cs)
+
+freshExistentialVariables type_variables state
+	= foldSt fresh_existential_variable type_variables state 
+where
+	fresh_existential_variable {atv_variable={tv_info_ptr}} (var_heap, var_store)
+		= (var_heap <:= (tv_info_ptr, TVI_Type (TempQV var_store)), inc var_store)
+
+freshAlgebraicType :: !(Global Int) ![AlgebraicPattern] !{#CommonDefs} !*TypeState -> (![[AType]],!AType,![AttrCoercion],!*TypeState)
+freshAlgebraicType {glob_module, glob_object} patterns common_defs ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_td_infos}
+	# {td_rhs,td_args,td_attrs,td_name,td_attribute} = common_defs.[glob_module].com_type_defs.[glob_object]
+	# (th_vars, ts_var_store)		= fresh_type_variables td_args (ts_type_heaps.th_vars, ts_var_store)
+	  (th_attrs, ts_attr_store)		= fresh_attributes td_attrs (ts_type_heaps.th_attrs, ts_attr_store)
+	  cs = { copy_heaps = { ts_type_heaps & th_vars = th_vars, th_attrs = th_attrs }}
+	  (cons_types, alg_type, ts_var_store, ts_attr_store, attr_env, cs)
+	  		= fresh_symbol_types patterns common_defs.[glob_module].com_cons_defs ts_var_store ts_attr_store cs
+	= (cons_types, alg_type, attr_env, { ts & ts_var_store = ts_var_store, ts_attr_store = ts_attr_store, ts_type_heaps = cs.copy_heaps })
+//		---> ("freshAlgebraicType", alg_type, cons_types)
+where
+	fresh_symbol_types [{ap_symbol={glob_object}}] cons_defs var_store attr_store cs=:{copy_heaps}
+		# {cons_type = {st_args,st_attr_env,st_result}, cons_index, cons_exi_vars, cons_exi_attrs} = cons_defs.[glob_object.ds_index]
+		  (th_vars, var_store)		= freshExistentialVariables  cons_exi_vars (copy_heaps.th_vars, var_store)
+//	  	  (th_attrs, attr_store)	= fresh_existential_attributes cons_exi_attrs (copy_heaps.th_attrs, attr_store)
+	  	  (attr_env, th_attrs) 		= fresh_environment st_attr_env ([], copy_heaps.th_attrs)
+	  	  (result_type, cs)			= freshCopy st_result { cs & copy_heaps = { copy_heaps & th_attrs = th_attrs, th_vars = th_vars } }
+	  	  (fresh_args, cs)			= freshCopy st_args cs
+		= ([fresh_args], result_type, var_store, attr_store, attr_env, cs)
+	fresh_symbol_types [{ap_symbol={glob_object}} : patterns] cons_defs var_store attr_store cs
+		# (cons_types, result_type, var_store, attr_store, attr_env, cs=:{copy_heaps})
+				= fresh_symbol_types patterns cons_defs var_store attr_store cs
+//		  {cons_type = {st_args,st_attr_env}, cons_index, cons_exi_vars, cons_exi_attrs} = cons_defs.[glob_object.ds_index]
+		  {cons_type = {st_args,st_attr_env}, cons_index, cons_exi_vars} = cons_defs.[glob_object.ds_index]
+		  (th_vars, var_store)		= freshExistentialVariables cons_exi_vars (copy_heaps.th_vars, var_store)
+//	  	  (th_attrs, attr_store)	= fresh_existential_attributes cons_exi_attrs (copy_heaps.th_attrs, attr_store)
+		  (attr_env, th_attrs) 		= fresh_environment st_attr_env (attr_env, copy_heaps.th_attrs)
+	  	  (fresh_args, cs) 			= freshCopy st_args { cs & copy_heaps = { copy_heaps & th_attrs = th_attrs, th_vars = th_vars }}
+		= ([fresh_args : cons_types], result_type, var_store, attr_store, attr_env, cs)
+
+	
+	fresh_type_variables type_variables state
+		= foldSt (\{atv_variable={tv_info_ptr}} (var_heap, var_store) -> (var_heap <:= (tv_info_ptr, TVI_Type (TempV var_store)), inc var_store))
+						type_variables state 
+	fresh_attributes attributes state
+		= foldSt (\{av_info_ptr} (attr_heap, attr_store) -> (attr_heap <:= (av_info_ptr, AVI_Attr (TA_TempVar attr_store)), inc attr_store))
+						attributes state
+/*
+	fresh_existential_attributes attributes state
+		= foldSt (\{av_info_ptr} (attr_heap, attr_store) -> (attr_heap <:= (av_info_ptr, AVI_Attr (TA_TempExVar attr_store)), inc attr_store))
+						attributes state
+*/
+	fresh_environment inequalities (attr_env, attr_heap)
+		= foldSt fresh_inequality inequalities (attr_env, attr_heap)
+
+	fresh_inequality {ai_demanded,ai_offered} (attr_env, attr_heap)
+		# (AVI_Attr dem_temp_attr, attr_heap) = readPtr ai_demanded.av_info_ptr attr_heap
+		  (AVI_Attr off_temp_attr, attr_heap) = readPtr ai_offered.av_info_ptr attr_heap
+		= case dem_temp_attr of
+			TA_TempVar dem_attr_var
+				-> case off_temp_attr of
+					TA_TempVar off_attr_var
+						| is_new_ineqality  dem_attr_var off_attr_var attr_env
+							-> ([{ac_demanded = dem_attr_var, ac_offered = off_attr_var} : attr_env ], attr_heap)
+							-> (attr_env, attr_heap)
+					_
+						-> (attr_env, attr_heap)
+			_
+				-> (attr_env, attr_heap)
+		
+	is_new_ineqality dem_attr_var off_attr_var [{ac_demanded, ac_offered} : attr_env]
+		= (dem_attr_var <> ac_demanded || off_attr_var <> ac_offered) && is_new_ineqality dem_attr_var off_attr_var  attr_env
+	is_new_ineqality dem_attr_var off_attr_var []
+		= True
+		
+freshSymbolType st=:{st_vars,st_args,st_result,st_context,st_attr_vars,st_attr_env,st_arity} common_defs
+				ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_td_infos}
+	# (th_vars, var_store)		= fresh_type_variables st_vars (ts_type_heaps.th_vars, ts_var_store)
+	  (th_attrs, attr_store)	= fresh_attributes st_attr_vars (ts_type_heaps.th_attrs, ts_attr_store)
+	  (attr_env, th_attrs)		= freshEnvironment st_attr_env th_attrs 
+	  cs = { copy_heaps = { ts_type_heaps & th_vars = th_vars, th_attrs = th_attrs }}
+	  (tst_args, cs)				= freshCopy st_args  cs
+	  (tst_result, cs)				= freshCopy st_result cs
+	  (tst_context, {copy_heaps}) 	= freshTypeContexts st_context cs
+	  cons_variables				= foldSt (collect_cons_variables_in_tc common_defs) tst_context []
+	= ({ tst_args = tst_args, tst_result = tst_result, tst_context = tst_context, tst_attr_env = attr_env, tst_arity = st_arity, tst_lifted = 0 }, cons_variables,
+	   { ts & ts_var_store = var_store, ts_attr_store = attr_store, ts_type_heaps = copy_heaps})
+//		---> ("freshSymbolType", tst_args, tst_result)
+	where
+		fresh_type_variables type_variables state
+			= foldr (\{tv_info_ptr} (var_heap, var_store) -> (writePtr tv_info_ptr (TVI_Type (TempV var_store)) var_heap, inc var_store))
+							state type_variables
+		fresh_attributes attributes state
+			= foldr (\{av_info_ptr} (attr_heap, attr_store) -> (writePtr av_info_ptr (AVI_Attr (TA_TempVar attr_store)) attr_heap, inc attr_store))
+							state attributes
+		
+		collect_cons_variables_in_tc common_defs tc=:{tc_class={glob_module,glob_object={ds_index}}, tc_types} collected_cons_vars
+			# {class_cons_vars} = common_defs.[glob_module].com_class_defs.[ds_index]
+			= collect_cons_variables tc_types class_cons_vars collected_cons_vars
+		
+		collect_cons_variables [] class_cons_vars collected_cons_vars
+			= collected_cons_vars
+		collect_cons_variables [type : tc_types] class_cons_vars collected_cons_vars
+			| class_cons_vars bitand 1 == 0
+				= collect_cons_variables tc_types (class_cons_vars >> 1) collected_cons_vars
+				= case type of
+					TempV temp_var_id 
+						-> collect_cons_variables tc_types (class_cons_vars >> 1) (add_variable temp_var_id collected_cons_vars)
+//							---> ("collect_cons_variables", temp_var_id)
+					_
+						-> collect_cons_variables tc_types (class_cons_vars >> 1) collected_cons_vars
+						
+		add_variable new_var_id []
+			= [new_var_id]
+		add_variable new_var_id vars=:[var_id : var_ids]
+			| new_var_id == var_id
+				= vars
+				= [var_id : add_variable new_var_id var_ids]
+		
+			
+freshInequality {ai_demanded,ai_offered} attr_heap
+	# (av_dem_info, attr_heap) = readPtr ai_demanded.av_info_ptr attr_heap
+	  (av_off_info, attr_heap) = readPtr ai_offered.av_info_ptr attr_heap
+	  (AVI_Attr (TA_TempVar dem_attr_var)) = av_dem_info
+	  (AVI_Attr (TA_TempVar off_attr_var)) = av_off_info
+	= ({ac_demanded = dem_attr_var, ac_offered = off_attr_var}, attr_heap) // <<- (av_dem_info,av_off_info)
+	
+freshEnvironment [ineq : ineqs] attr_heap
+	# (fresh_ineq, attr_heap) = freshInequality ineq attr_heap
+	  (fresh_env, attr_heap) = freshEnvironment ineqs attr_heap
+	= ([fresh_ineq : fresh_env], attr_heap)
+freshEnvironment [] attr_heap
+	= ([], attr_heap)
+
+freshTypeContexts tcs cs
+	= mapSt fresh_type_context tcs cs
+where	
+	fresh_type_context tc=:{tc_types} cs
+		# (tc_types, cs) = mapSt fresh_context_type tc_types cs
+		= ({ tc & tc_types = tc_types}, cs)
+
+	fresh_context_type (CV tv :@: types) cs=:{copy_heaps}
+		# (fresh_cons_var, th_vars)		= freshConsVariable tv copy_heaps.th_vars
+		  (types, cs) = freshCopy types { cs & copy_heaps = { copy_heaps & th_vars = th_vars }}
+		= (fresh_cons_var :@: types, cs)
+	fresh_context_type type cs
+		= freshCopy type cs
+
+freshAttributedVariable :: !u:TypeState -> (!AType, !u:TypeState)
+freshAttributedVariable ts=:{ts_var_store,ts_attr_store}
+	= ({ at_attribute = TA_TempVar ts_attr_store, at_annotation = AN_None, at_type = TempV ts_var_store },
+	     {ts & ts_var_store = inc ts_var_store, ts_attr_store = inc ts_attr_store})
+
+freshNonUniqueVariable :: !u:TypeState -> (!AType, !u:TypeState)
+freshNonUniqueVariable ts=:{ts_var_store}
+	= ({ at_attribute = TA_Multi, at_annotation = AN_None, at_type = TempV ts_var_store },
+	     {ts & ts_var_store = inc ts_var_store})
+
+freshAttribute :: !u:TypeState -> (!TypeAttribute, !u:TypeState)
+freshAttribute ts=:{ts_attr_store}
+	= (TA_TempVar ts_attr_store, {ts & ts_attr_store = inc ts_attr_store})
+
+
+::	PropState =
+	{	prop_type_heaps	:: !.TypeHeaps
+	,	prop_td_infos	:: !.TypeDefInfos
+	,	prop_attr_vars	:: ![AttributeVar]
+	,	prop_attr_env	:: ![AttrInequality]
+	,	prop_error		:: !.ErrorAdmin
+	}
+
+
+attribute_error type_attr err
+	= TypeError "* attribute expected insted of" type_attr "" err
+
+addPropagationAttributesToAType modules type=:{at_type = TA cons_id=:{type_index={glob_object,glob_module}} cons_args, at_attribute} ps
+	# (cons_args, props, ps=:{prop_td_infos,prop_type_heaps,prop_attr_vars,prop_attr_env,prop_error})
+			= add_propagation_attributes_to_atypes modules cons_args ps
+	  (prop_class, th_vars, prop_td_infos) = propClassification glob_object glob_module props modules prop_type_heaps.th_vars prop_td_infos
+	  (at_attribute, prop_class, th_attrs, prop_attr_vars, prop_attr_env, prop_error)
+	  		= determine_attribute_of_cons modules at_attribute cons_args prop_class prop_type_heaps.th_attrs prop_attr_vars prop_attr_env prop_error
+	= ({ type & at_type = TA cons_id cons_args, at_attribute = at_attribute }, prop_class,  { ps & prop_attr_vars = prop_attr_vars,
+			prop_td_infos = prop_td_infos, prop_attr_env = prop_attr_env,
+				prop_type_heaps = { prop_type_heaps & th_vars = th_vars, th_attrs = th_attrs}, prop_error = prop_error })
+	where
+		add_propagation_attributes_to_atypes modules [] ps
+			= ([], [], ps) 
+		add_propagation_attributes_to_atypes modules [atype : atypes] ps
+			# (atype, prop_class, ps) = addPropagationAttributesToAType modules atype ps
+			  (atypes, prop_classes, ps) = add_propagation_attributes_to_atypes modules atypes ps
+			= ([atype : atypes], [prop_class : prop_classes], ps)
+	
+		determine_attribute_of_cons modules TA_Unique cons_args prop_class attr_var_heap attr_vars attr_env ps_error
+			= (TA_Unique, prop_class >> length cons_args, attr_var_heap, attr_vars, attr_env, ps_error)
+		determine_attribute_of_cons modules cons_attr cons_args prop_class attr_var_heap attr_vars attr_env ps_error
+			# (cumm_attr, prop_attrs, prop_class) = determine_cummulative_attribute cons_args TA_Multi [] prop_class
+			  (comb_attr, attr_var_heap, attr_vars, attr_env, ps_error)
+			  		= combine_attributes cons_attr cumm_attr prop_attrs attr_var_heap attr_vars attr_env ps_error
+			= (comb_attr, prop_class, attr_var_heap, attr_vars, attr_env, ps_error)
+			  
+		determine_cummulative_attribute [] cumm_attr attr_vars prop_class
+			= (cumm_attr, attr_vars, prop_class)
+		determine_cummulative_attribute [{at_attribute} : types ] cumm_attr attr_vars prop_class
+			| prop_class bitand 1 == 0
+				= determine_cummulative_attribute types cumm_attr attr_vars (prop_class >> 1)
+				= case at_attribute of
+					TA_Unique
+						-> (TA_Unique, [], prop_class >> length types)
+					TA_Multi
+						-> determine_cummulative_attribute types cumm_attr attr_vars (prop_class >> 1)
+					TA_Var attr_var
+						-> determine_cummulative_attribute types at_attribute [attr_var : attr_vars] (prop_class >> 1)
+		
+
+		combine_attributes (TA_Var attr_var) cumm_attr prop_vars attr_var_heap attr_vars attr_env ps_error
+			= case cumm_attr of
+				TA_Unique
+					-> (TA_Unique, attr_var_heap, attr_vars, attr_env, attribute_error attr_var ps_error)
+				
+				TA_Multi
+					-> (TA_Var attr_var, attr_var_heap, attr_vars, attr_env, ps_error)
+				TA_Var _
+					-> (TA_Var attr_var, attr_var_heap, attr_vars, foldSt (new_inequality attr_var) prop_vars attr_env, ps_error)
+		where
+			new_inequality off_attr_var dem_attr_var [] 
+				= [{ ai_demanded = dem_attr_var, ai_offered = off_attr_var }]
+			new_inequality off_attr_var dem_attr_var ins=:[ inequal : iequals ]
+				 | dem_attr_var.av_info_ptr == inequal.ai_demanded.av_info_ptr && off_attr_var.av_info_ptr == inequal.ai_offered.av_info_ptr
+				 	= ins
+				 	= [ inequal : new_inequality off_attr_var dem_attr_var iequals ]
+	
+		combine_attributes _ (TA_Var var) prop_vars attr_var_heap attr_vars attr_env ps_error
+			# (new_attr_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap
+			  new_attr_var = { var & av_info_ptr = new_attr_ptr }
+			= (TA_Var new_attr_var, attr_var_heap, [new_attr_var : attr_vars],
+					mapAppend (\ai_demanded -> { ai_demanded = ai_demanded, ai_offered = new_attr_var }) prop_vars attr_env, ps_error)
+		combine_attributes cons_attr TA_Unique _ attr_var_heap attr_vars attr_env ps_error
+			= (TA_Unique, attr_var_heap, attr_vars, attr_env, ps_error)
+		combine_attributes cons_attr _ _ attr_var_heap attr_vars attr_env ps_error
+			= (cons_attr, attr_var_heap, attr_vars, attr_env, ps_error)
+
+addPropagationAttributesToAType modules type=:{at_type} ps
+	# (at_type, ps) = addPropagationAttributesToType modules at_type ps
+	= ({ type & at_type = at_type }, NoPropClass, ps)
+
+addPropagationAttributesToType modules (arg_type --> res_type) ps
+	# (arg_type, prop_class, ps) = addPropagationAttributesToAType modules arg_type ps
+	  (res_type, prop_class, ps) = addPropagationAttributesToAType modules res_type ps
+	= (arg_type --> res_type, ps)
+addPropagationAttributesToType modules (type_var :@: types) ps
+	# (types, ps) = addPropagationAttributesToATypes modules types ps
+	= (type_var :@: types, ps)
+addPropagationAttributesToType modules type ps
+	= (type, ps)
+
+addPropagationAttributesToATypes modules types ps
+	= mapSt (add_propagation_attributes_to_atype modules) types ps
+where
+	add_propagation_attributes_to_atype modules type ps
+		# (type, prop_class, ps) = addPropagationAttributesToAType modules type ps
+		= (type, ps)
+
+:: Base :== {! AType}
+
+currySymbolType st=:{tst_args,tst_arity,tst_result,tst_attr_env} req_arity ts=:{ts_attr_store}
+	| tst_arity == req_arity
+		= (st, ts)
+	# (tst_args, rest_args, is_unique) = split_args req_arity tst_args 
+	| is_unique
+		# (type, _, _) = buildCurriedType rest_args tst_result TA_Unique [] 0
+		= ({ st & tst_args = tst_args, tst_arity = req_arity, tst_result = type }, ts)
+		# (type, tst_attr_env, ts_attr_store) = buildCurriedType rest_args tst_result (TA_TempVar ts_attr_store)
+		  		(build_attr_env ts_attr_store tst_args tst_attr_env) (inc ts_attr_store)
+		= ({ st & tst_args = tst_args, tst_arity = req_arity, tst_result = type, tst_attr_env = tst_attr_env }, { ts & ts_attr_store = ts_attr_store })
+where
+	split_args 0 args = ([], args, False)
+	split_args n [atype=:{at_attribute} : args]
+		# (left, right, is_unique) = split_args (dec n) args
+		= ([ atype : left ], right, is_unique || attr_is_unique at_attribute)
+	
+	attr_is_unique TA_Unique = True
+	attr_is_unique _ = False
+	
+	build_attr_env cum_attr_var [] attr_env
+		= attr_env
+	build_attr_env cum_attr_var [{at_attribute=(TA_TempVar attr_var)} : args] attr_env
+		= build_attr_env cum_attr_var args [{ ac_demanded = attr_var, ac_offered = cum_attr_var } : attr_env]
+	build_attr_env cum_attr_var [_ : args] attr_env
+		= build_attr_env cum_attr_var args attr_env
+
+
+emptyIdent =: { id_name = "", id_info = nilPtr }
+
+buildCurriedType [] type cum_attr attr_env attr_store
+	= (type, attr_env, attr_store)
+buildCurriedType [at=:{at_attribute}:ats] type cum_attr attr_env attr_store
+	# (next_cum_attr, attr_env, attr_store) = combine_attributes at_attribute cum_attr attr_env attr_store
+	  (res_type, attr_env, attr_store) = buildCurriedType ats type next_cum_attr attr_env attr_store
+	= ({at_annotation = AN_None, at_attribute = cum_attr , at_type = at --> res_type }, attr_env, attr_store)
+where
+	combine_attributes TA_Unique cum_attr attr_env attr_store
+		= (TA_Unique, attr_env, attr_store)
+	combine_attributes (TA_TempVar attr_var) (TA_TempVar cum_attr_var) attr_env attr_store
+		= (TA_TempVar attr_store, [{ ac_demanded = cum_attr_var,ac_offered = attr_store },{ ac_demanded = attr_var,ac_offered = attr_store }:attr_env], inc attr_store)
+	combine_attributes (TA_TempVar _) cum_attr attr_env attr_store
+		= (cum_attr, attr_env, attr_store)
+	combine_attributes _ (TA_TempVar cum_attr_var) attr_env attr_store
+		= (TA_TempVar attr_store, [{ ac_demanded = cum_attr_var,ac_offered = attr_store }:attr_env], inc attr_store)
+	combine_attributes _ cum_attr attr_env attr_store
+		= (cum_attr, attr_env, attr_store)
+
+determineSymbolTypeOfFunction ident act_arity st=:{st_args,st_result,st_attr_vars,st_attr_env} type_ptr common_defs ts=:{ts_var_heap}
+	# (type_info, ts_var_heap) = readPtr type_ptr ts_var_heap
+	  ts = { ts & ts_var_heap = ts_var_heap }
+	= case type_info of
+		VI_PropagationType symb_type
+	   		# (copy_symb_type, cons_variables, ts) = freshSymbolType symb_type common_defs ts 
+//				(ts  ---> ("determineSymbolTypeOfFunction1", ident, symb_type)) 
+			  (curried_st, ts) = currySymbolType copy_symb_type act_arity ts
+			-> (curried_st, cons_variables, ts)
+//				 ---> ("determineSymbolTypeOfFunction", ident, curried_st)
+		_	
+			# (st_args, ps) = addPropagationAttributesToATypes common_defs st_args
+					{ prop_type_heaps = ts.ts_type_heaps, prop_td_infos = ts.ts_td_infos,
+					  prop_attr_vars = st_attr_vars, prop_attr_env = st_attr_env, prop_error = ts.ts_error}
+			  (st_result, _, {prop_type_heaps,prop_td_infos,prop_attr_vars,prop_error,prop_attr_env})
+			  			= addPropagationAttributesToAType common_defs st_result ps
+			  st = { st & st_args = st_args, st_result = st_result, st_attr_vars = prop_attr_vars, st_attr_env = prop_attr_env }
+	   		# (copy_symb_type, cons_variables, ts) = freshSymbolType st common_defs { ts &
+	   										ts_type_heaps = prop_type_heaps, ts_td_infos = prop_td_infos, ts_error = prop_error,
+											ts_var_heap = ts.ts_var_heap <:= (type_ptr, VI_PropagationType st) }
+			  (curried_st, ts) = currySymbolType copy_symb_type act_arity ts
+			-> (curried_st, cons_variables, ts)
+//				 ---> ("determineSymbolTypeOfFunction", ident, st)
+
+standardFieldSelectorType {glob_object={ds_ident,ds_index},glob_module} {ti_common_defs} ts=:{ts_var_store,ts_type_heaps}
+	#! {sd_type,sd_exi_vars,sd_exi_attrs} = ti_common_defs.[glob_module].com_selector_defs.[ds_index]
+	# (th_vars, ts_var_store) = freshExistentialVariables sd_exi_vars (ts_type_heaps.th_vars, ts_var_store)
+	  (inst, cons_variables, ts) = freshSymbolType sd_type ti_common_defs { ts & ts_type_heaps = { ts_type_heaps & th_vars = th_vars }, ts_var_store = ts_var_store }
+	= (inst, ts)
+//		 ---> ("standardFieldSelectorType", ds_ident, inst)
+
+standardTupleSelectorType {ds_index} arg_nr {ti_common_defs} ts
+	#! {cons_type} = ti_common_defs.[cPredefinedModuleIndex].com_cons_defs.[ds_index]
+	   (fresh_type, cons_variables, ts) = freshSymbolType { cons_type & st_args = [cons_type.st_result], st_result = cons_type.st_args !! arg_nr } ti_common_defs ts
+	= (fresh_type, ts)
+
+standardRhsConstructorType index mod arity {ti_common_defs} ts
+	#! {cons_symb, cons_type, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index]
+	# cons_type = { cons_type & st_vars = mapAppend (\{atv_variable} -> atv_variable) cons_exi_vars cons_type.st_vars }
+	  (fresh_type, _, ts) = freshSymbolType cons_type ti_common_defs ts
+	= currySymbolType fresh_type arity ts
+//		 ---> ("standardRhsConstructorType", cons_symb, fresh_type)
+
+standardLhsConstructorType index mod arity {ti_common_defs} ts=:{ts_var_store,ts_type_heaps}
+	#! {cons_symb, cons_type, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index]
+	# (th_vars, ts_var_store) = freshExistentialVariables cons_exi_vars (ts_type_heaps.th_vars, ts_var_store)
+	  (fresh_type, _, ts) = freshSymbolType cons_type ti_common_defs { ts & ts_type_heaps = { ts_type_heaps & th_vars = th_vars }, ts_var_store = ts_var_store }
+	= (fresh_type, ts)
+//		 ---> ("standardLhsConstructorType", cons_symb, fresh_type)
+
+:: ReferenceMarking :== Bool
+
+cIsRecursive :== True
+cIsNotRecursive :== False
+
+storeAttribute (Yes expt_ptr) type_attribute symbol_heap
+	= writePtr expt_ptr (EI_Attribute (toInt type_attribute)) symbol_heap
+storeAttribute No type_attribute symbol_heap
+	= symbol_heap
+
+requirementsOfApplication :: !App !TempSymbolType ![Special] !u:Requirements !TypeInput !*TypeState
+	-> (!u:Requirements, !AType, !Optional ExprInfoPtr, !*TypeState)
+requirementsOfApplication {app_symb,app_args,app_info_ptr}
+		{tst_attr_env,tst_args,tst_result,tst_context} specials reqs=:{req_attr_coercions} ti ts
+  	# reqs = { reqs & req_attr_coercions = tst_attr_env ++ req_attr_coercions }
+	  (reqs, ts) = requirements_of_args app_args tst_args reqs ti ts
+	| isEmpty tst_context
+		= (reqs, tst_result, No, ts)
+		= ({ reqs & req_overloaded_calls = [app_info_ptr : reqs.req_overloaded_calls ]}, tst_result, No,
+				{ ts & ts_expr_heap = ts.ts_expr_heap <:= (app_info_ptr,
+						EI_Overloaded { oc_symbol = app_symb, oc_context = tst_context, oc_specials = specials })})
+where
+	requirements_of_args :: ![Expression] ![AType] !u:Requirements !TypeInput !*TypeState
+		-> (!u:Requirements,!*TypeState)
+	requirements_of_args [] [] reqs ti ts
+		= (reqs, ts)
+	requirements_of_args [expr:exprs] [lt:lts] reqs ti ts
+		# (reqs, e_type, opt_expr_ptr, ts) = requirements expr reqs ti ts
+		  req_type_coercions = [{ tc_demanded = lt, tc_offered = e_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions ]
+		  ts_expr_heap = storeAttribute opt_expr_ptr lt.at_attribute ts.ts_expr_heap
+		= requirements_of_args exprs lts { reqs & req_type_coercions = req_type_coercions} ti { ts & ts_expr_heap = ts_expr_heap }
+
+requirements :: !Expression !u:Requirements !TypeInput !*TypeState -> (!u:Requirements, !AType, !Optional ExprInfoPtr, !*TypeState)
+requirements (Var var=:{var_info_ptr,var_expr_ptr}) reqs ti ts=:{ts_var_store,ts_attr_store,ts_var_heap,ts_expr_heap}
+	#! var_info = sreadPtr var_info_ptr ts_var_heap
+	# (VI_Type type) = var_info
+	= (reqs, type, Yes var_expr_ptr, ts)
+
+requirements expr=:(App app=:{app_symb={symb_name,symb_kind = SK_Function {glob_module,glob_object}, symb_arity}}) reqs
+		ti=:{ti_functions,ti_common_defs} ts=:{ts_fun_env,ts_var_heap}
+	| glob_module == cIclModIndex
+		#! fun_type = ts_fun_env.[glob_object]
+		= case fun_type of
+			UncheckedType fun_type
+				# (fun_type_copy,ts) = currySymbolType fun_type symb_arity ts
+				-> requirementsOfApplication app fun_type_copy [] reqs ti ts
+			SpecifiedType fun_type lifted_arg_types _ 
+				# (fun_type_copy, cons_variables, ts) = freshSymbolType fun_type ti_common_defs ts
+//								---> ("requirements (App SpecifiedType)", symb_name, fun_type))
+				  (fun_type_copy,ts) = currySymbolType { fun_type_copy & tst_args = lifted_arg_types ++ fun_type_copy.tst_args } symb_arity ts
+				-> requirementsOfApplication app fun_type_copy [] { reqs & req_cons_variables = [ cons_variables : reqs.req_cons_variables ] } ti ts
+			CheckedType fun_type
+				# (fun_type_copy, cons_variables, ts) = freshSymbolType fun_type ti_common_defs ts
+//								---> ("requirements (App CheckedType)", symb_name, fun_type))
+				  (fun_type_copy,ts) = currySymbolType fun_type_copy symb_arity ts
+				-> requirementsOfApplication app fun_type_copy [] { reqs & req_cons_variables = [ cons_variables : reqs.req_cons_variables ] } ti ts
+			_
+				-> abort "requirements (App)" ---> (symb_name, fun_type)
+		# {ft_type,ft_type_ptr,ft_specials} = ti_functions.[glob_module].[glob_object]
+		  (fun_type_copy, cons_variables, ts) = determineSymbolTypeOfFunction symb_name symb_arity ft_type ft_type_ptr ti_common_defs ts
+		= requirementsOfApplication app fun_type_copy (get_specials ft_specials) { reqs & req_cons_variables = [ cons_variables : reqs.req_cons_variables ] } ti ts
+where
+	get_specials (SP_ContextTypes specials) = specials
+	get_specials SP_None 					= []
+
+
+requirements expr=:(App app=:{app_symb={symb_kind, symb_arity}}) reqs ti ts=:{ts_fun_env}
+	# (fresh_type, cons_variables, ts) = standard_type symb_kind symb_arity ti ts
+	= requirementsOfApplication app fresh_type [] { reqs & req_cons_variables = [ cons_variables : reqs.req_cons_variables ] } ti ts
+where
+	standard_type (SK_Constructor {glob_object,glob_module}) symb_arity ti ts
+		# (fresh_cons_type, ts) = standardRhsConstructorType glob_object glob_module symb_arity ti ts
+		= (fresh_cons_type, [], ts) 
+	standard_type (SK_OverloadedFunction {glob_object,glob_module}) symb_arity {ti_common_defs} ts 
+		#! {me_symb, me_type,me_type_ptr} = ti_common_defs.[glob_module].com_member_defs.[glob_object]
+		= determineSymbolTypeOfFunction me_symb symb_arity me_type me_type_ptr ti_common_defs ts
+requirements (function @ args) reqs ti ts
+	# (reqs, off_fun_type, opt_fun_expr_ptr, ts) = requirements function reqs ti ts
+	  (rev_off_arg_types, reqs, ts) = requirements_of_list args [] reqs ti ts
+	  (alpha, ts) = freshAttributedVariable ts
+	  (fun_type, req_type_coercions, ts) = apply_type rev_off_arg_types alpha reqs.req_type_coercions function ts
+	  ts_expr_heap = storeAttribute opt_fun_expr_ptr fun_type.at_attribute ts.ts_expr_heap
+	= ({ reqs & req_type_coercions = [{ tc_demanded = fun_type, tc_offered = off_fun_type, tc_position = { cp_expression = function }, tc_coercible = True } : req_type_coercions ]},
+		 alpha, No, { ts & ts_expr_heap = ts_expr_heap })
+where
+	requirements_of_list [] rev_list_types reqs ti ts
+		= (rev_list_types, reqs, ts)
+	requirements_of_list [expr:exprs] rev_list_types reqs ti ts
+		# (reqs, e_type, opt_expr_ptr, ts) = requirements expr reqs ti ts
+		= requirements_of_list exprs [(opt_expr_ptr,e_type) : rev_list_types] reqs ti ts
+
+	apply_type [] res_type type_coercions function ts
+		= (res_type, type_coercions, ts)
+	apply_type [(opt_expr_ptr,type) : types] res_type type_coercions function ts
+		# (type, type_coercions, ts) = determine_demanded_type type opt_expr_ptr type_coercions function ts
+		  (u, ts) = freshAttribute ts
+		= apply_type types { at_annotation = AN_None, at_attribute = u, at_type = type --> res_type } type_coercions function ts
+	
+	determine_demanded_type :: !AType !(Optional ExprInfoPtr) ![TypeCoercion] !Expression !*TypeState
+		-> (!AType, ![TypeCoercion], !*TypeState)
+	determine_demanded_type type (Yes expr_ptr) type_coercions expr ts
+		# (dem_type, ts) = freshAttributedVariable ts
+		  ts_expr_heap = writePtr expr_ptr (EI_Attribute (toInt dem_type.at_attribute)) ts.ts_expr_heap
+		= (dem_type, [ { tc_demanded = dem_type, tc_offered = type, tc_position = { cp_expression = expr }, tc_coercible = True } : type_coercions ],
+			{ ts & ts_expr_heap = ts_expr_heap })
+	determine_demanded_type type No type_coercions expr ts
+		= (type, type_coercions, ts) 
+	
+requirements bind_expr=:(Let {let_binds, let_expr, let_info_ptr}) reqs ti ts
+	# (rev_var_types, ts) = make_base let_binds [] ts
+	  var_types = reverse rev_var_types
+	  (reqs, res_type, opt_expr_ptr, ts) = requirements let_expr reqs ti ts
+	  (reqs, ts) = requirements_of_binds let_binds var_types reqs ti ts
+	  ts_expr_heap = writePtr let_info_ptr (EI_LetType var_types) ts.ts_expr_heap
+	= ({ reqs & req_case_and_let_exprs = [let_info_ptr : reqs.req_case_and_let_exprs]}, res_type, opt_expr_ptr, { ts & ts_expr_heap = ts_expr_heap })
+
+where
+
+	make_base [{bind_dst={fv_info_ptr}}:bs] var_types ts=:{ts_var_heap}
+		# (v, ts) = freshAttributedVariable ts
+		= make_base bs [v:var_types] { ts & ts_var_heap = writePtr fv_info_ptr (VI_Type v) ts.ts_var_heap }
+	make_base [] var_types ts
+		= (var_types, ts)
+
+	requirements_of_binds [] _ reqs ti ts
+		= (reqs, ts)
+	requirements_of_binds [{bind_src}:bs] [b_type:bts] reqs ti ts
+		# (reqs, exp_type, opt_expr_ptr, ts) = requirements bind_src reqs ti ts
+		  ts_expr_heap = storeAttribute opt_expr_ptr b_type.at_attribute ts.ts_expr_heap
+		  req_type_coercions = [ { tc_demanded = b_type, tc_offered = exp_type, tc_position = { cp_expression = bind_src }, tc_coercible = True }
+		  		: reqs.req_type_coercions ]
+		= requirements_of_binds bs bts { reqs & req_type_coercions = req_type_coercions } ti { ts & ts_expr_heap = ts_expr_heap }
+
+requirements (Case {case_expr,case_guards,case_default,case_info_ptr}) reqs ti ts
+	# (reqs, expr_type, opt_expr_ptr, ts) = requirements case_expr reqs ti ts
+	  (fresh_v, ts) = freshAttributedVariable ts
+	  (reqs, cons_types, ts) = requirements_of_guarded_expressions case_guards case_expr expr_type opt_expr_ptr fresh_v reqs ti ts
+	  (reqs, ts) = requirements_of_default case_default fresh_v reqs ti ts
+	  ts_expr_heap =  ts.ts_expr_heap <:= (case_info_ptr, EI_CaseType { ct_pattern_type = expr_type, ct_result_type = fresh_v, ct_cons_types = cons_types })
+	= ({ reqs & req_case_and_let_exprs = [case_info_ptr : reqs.req_case_and_let_exprs]}, fresh_v, No, { ts & ts_expr_heap = ts_expr_heap })
+where
+	requirements_of_guarded_expressions (AlgebraicPatterns alg_type patterns) match_expr pattern_type opt_pattern_ptr
+					goal_type reqs ti=:{ti_common_defs} ts
+		# (cons_types, result_type, new_attr_env, ts) = freshAlgebraicType alg_type patterns ti_common_defs ts
+		  (reqs, used_cons_types, ts) = requirements_of_algebraic_patterns patterns cons_types goal_type [] reqs ti ts
+		  ts_expr_heap = storeAttribute opt_pattern_ptr result_type.at_attribute ts.ts_expr_heap
+		= ({ reqs & req_type_coercions = [{tc_demanded = result_type,tc_offered = pattern_type, tc_position = { cp_expression = match_expr },
+				tc_coercible = True} : reqs.req_type_coercions],
+					req_attr_coercions = new_attr_env ++ reqs.req_attr_coercions }, reverse used_cons_types,
+						{ ts & ts_expr_heap = ts_expr_heap })
+
+	requirements_of_guarded_expressions (BasicPatterns bas_type patterns) match_expr pattern_type opt_pattern_ptr goal_type reqs ti ts
+		# (attr_bas_type, ts) = attributedBasicType bas_type ts
+		  (reqs, ts) = requirements_of_basic_patterns patterns goal_type reqs ti ts
+		  ts_expr_heap = storeAttribute opt_pattern_ptr attr_bas_type.at_attribute ts.ts_expr_heap
+		= ({ reqs & req_type_coercions = [{tc_demanded = attr_bas_type,tc_offered = pattern_type, tc_position = { cp_expression = match_expr }, tc_coercible = True} :
+					reqs.req_type_coercions]}, [], { ts & ts_expr_heap = ts_expr_heap })
+	requirements_of_guarded_expressions (DynamicPatterns dynamic_patterns) match_expr pattern_type opt_pattern_ptr goal_type reqs ti ts
+		# dyn_type = { at_type = TB BT_Dynamic, at_attribute = TA_Multi, at_annotation = AN_None }
+		  (reqs, used_dyn_types, ts) = requirements_of_dynamic_patterns goal_type dynamic_patterns [] reqs ti ts
+		  ts_expr_heap = storeAttribute opt_pattern_ptr TA_Multi ts.ts_expr_heap
+		= ({ reqs & req_type_coercions = [{tc_demanded = dyn_type, tc_offered = pattern_type, tc_position = { cp_expression = match_expr }, tc_coercible = True} :
+					reqs.req_type_coercions] }, reverse used_dyn_types, { ts & ts_expr_heap = ts_expr_heap })
+
+	requirements_of_algebraic_patterns [] cons_types goal_type used_cons_types reqs ti ts
+		= (reqs, used_cons_types, ts)
+	requirements_of_algebraic_patterns [{ap_vars, ap_expr }:gs] [ cons_arg_types : cons_types] goal_type used_cons_types reqs ti=:{ti_common_defs} ts
+		# (reqs, res_type, opt_expr_ptr, ts) = requirements ap_expr reqs ti { ts & ts_var_heap = makeBase ap_vars cons_arg_types ts.ts_var_heap}
+		  ts_expr_heap = storeAttribute opt_expr_ptr res_type.at_attribute ts.ts_expr_heap
+		= requirements_of_algebraic_patterns gs cons_types goal_type [ cons_arg_types : used_cons_types ]
+			{ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = { cp_expression = ap_expr }, tc_coercible = True } : reqs.req_type_coercions] }
+				  ti { ts & ts_expr_heap = ts_expr_heap }
+
+	requirements_of_basic_patterns [] goal_type reqs ti ts
+		= (reqs, ts)
+	requirements_of_basic_patterns [{bp_expr }:gs] goal_type reqs ti=:{ti_common_defs} ts
+	  	# (reqs, res_type, opt_expr_ptr, ts) = requirements bp_expr reqs ti ts
+		  ts_expr_heap = storeAttribute opt_expr_ptr res_type.at_attribute ts.ts_expr_heap
+		= requirements_of_basic_patterns gs goal_type
+			{ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = { cp_expression = bp_expr }, tc_coercible = True } : reqs.req_type_coercions] }
+					 ti { ts & ts_expr_heap = ts_expr_heap }
+
+	requirements_of_dynamic_patterns goal_type [{dp_var={fv_info_ptr},dp_type,dp_rhs} : dps] used_dyn_types reqs ti ts=:{ts_expr_heap, ts_var_heap}
+		# (EI_TempDynamicPattern _ _ _ _ dyn_type dyn_context dyn_expr_ptr type_code_symbol, ts_expr_heap) = readPtr dp_type ts_expr_heap
+		  ts_var_heap = ts_var_heap <:= (fv_info_ptr, VI_Type dyn_type)
+		  (reqs, dp_rhs_type, opt_expr_ptr, ts) = requirements dp_rhs reqs ti { ts & ts_expr_heap = ts_expr_heap, ts_var_heap = ts_var_heap }
+		  ts_expr_heap = storeAttribute opt_expr_ptr dp_rhs_type.at_attribute ts.ts_expr_heap
+		  type_coercion = { tc_demanded = goal_type, tc_offered = dp_rhs_type, tc_position = { cp_expression = dp_rhs }, tc_coercible = True }
+		| isEmpty dyn_context
+			# reqs = {reqs & req_type_coercions = [ type_coercion : reqs.req_type_coercions]}
+			= requirements_of_dynamic_patterns goal_type dps [ [dyn_type] : used_dyn_types ] reqs ti { ts &  ts_expr_heap = ts_expr_heap }
+			# reqs = { reqs & req_type_coercions = [ type_coercion : reqs.req_type_coercions], req_overloaded_calls = [dyn_expr_ptr : reqs.req_overloaded_calls ]}
+			= requirements_of_dynamic_patterns goal_type dps [ [dyn_type] : used_dyn_types ] reqs ti { ts & ts_expr_heap = ts_expr_heap <:=
+					(dyn_expr_ptr,  EI_Overloaded {  oc_symbol = type_code_symbol, oc_context = dyn_context, oc_specials = [] }) }
+	requirements_of_dynamic_patterns goal_type [] used_dyn_types reqs ti ts
+		= (reqs, used_dyn_types, ts)
+
+
+	requirements_of_default (Yes expr) goal_type reqs ti ts
+		# (reqs, res_type, opt_expr_ptr, ts) = requirements expr reqs ti ts
+		  ts_expr_heap = storeAttribute opt_expr_ptr res_type.at_attribute ts.ts_expr_heap
+		= ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions] },
+				{ ts & ts_expr_heap = ts_expr_heap })
+	requirements_of_default No goal_type reqs ti ts
+		= (reqs, ts) 
+requirements (DynamicExpr {dyn_expr,dyn_info_ptr}) reqs ti ts=:{ts_expr_heap}
+	# (EI_TempDynamicType _ dyn_type dyn_context dyn_expr_ptr type_code_symbol, ts_expr_heap) = readPtr dyn_info_ptr ts_expr_heap
+	  (reqs, dyn_expr_type, opt_expr_ptr, ts) = requirements dyn_expr reqs ti { ts & ts_expr_heap = ts_expr_heap }
+	  ts_expr_heap = storeAttribute opt_expr_ptr dyn_expr_type.at_attribute ts.ts_expr_heap
+	  type_coercion = { tc_demanded = dyn_type, tc_offered = dyn_expr_type, tc_position = { cp_expression = dyn_expr }, tc_coercible = True }
+	| isEmpty dyn_context
+		= ({reqs & req_type_coercions = [ type_coercion : reqs.req_type_coercions]}, 
+				{ at_type = TB BT_Dynamic, at_attribute = TA_Multi, at_annotation = AN_None }, No, { ts &  ts_expr_heap = ts_expr_heap })
+		= ({ reqs & req_type_coercions = [ type_coercion : reqs.req_type_coercions], req_overloaded_calls = [dyn_expr_ptr : reqs.req_overloaded_calls ]},
+				{ at_type = TB BT_Dynamic, at_attribute = TA_Multi, at_annotation = AN_None }, No,
+					{ ts & ts_expr_heap = ts_expr_heap <:= (dyn_expr_ptr, EI_Overloaded {
+							oc_symbol = type_code_symbol, oc_context = dyn_context, oc_specials = []}) })
+
+requirements (Selection result_type_symb expr selectors) reqs ti ts
+	# (reqs, expr_type, opt_expr_ptr, ts) = requirements expr reqs ti ts
+	= case result_type_symb of
+		Yes {glob_object={ds_ident,ds_index,ds_arity}, glob_module}
+			# (var, ts) = freshAttributedVariable ts
+		  	  (result_type, reqs, ts) =  requirementsOfSelectors expr selectors False var expr opt_expr_ptr reqs ti ts
+			  tuple_type = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident ds_arity
+			  non_unique_type_var = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TempV ts.ts_var_store }
+			  req_type_coercions
+					= [ { tc_demanded = non_unique_type_var, tc_offered = result_type, tc_position = { cp_expression = expr }, tc_coercible = False },
+						{ tc_demanded = var, tc_offered = expr_type, tc_position = { cp_expression = expr }, tc_coercible = True } :
+ 								reqs.req_type_coercions]
+			  result_type = { at_type = TA tuple_type [non_unique_type_var,var], at_attribute = TA_Unique, at_annotation = AN_None }
+			-> ({ reqs & req_type_coercions = req_type_coercions }, result_type, No,
+					{ts & ts_var_store = inc ts.ts_var_store, ts_expr_heap = storeAttribute opt_expr_ptr TA_Multi ts.ts_expr_heap})
+		_
+		  	# (result_type, reqs, ts) =  requirementsOfSelectors expr selectors True expr_type expr opt_expr_ptr reqs ti ts
+			-> (reqs, result_type, No, { ts & ts_expr_heap = storeAttribute opt_expr_ptr result_type.at_attribute ts.ts_expr_heap })
+
+requirements (Update expr1 selectors expr2) reqs ti ts
+	# (reqs, expr1_type, opt_expr1_ptr, ts) = requirements expr1 reqs ti ts
+	  ts = { ts & ts_expr_heap = storeAttribute opt_expr1_ptr expr1_type.at_attribute ts.ts_expr_heap }
+	  (reqs, expr2_type, opt_expr2_ptr, ts) = requirements expr2 reqs ti ts
+	  ts = { ts & ts_expr_heap = storeAttribute opt_expr2_ptr expr2_type.at_attribute ts.ts_expr_heap }
+	  (result_type, reqs, ts) =  requirementsOfSelectors expr1 selectors True expr1_type expr1 opt_expr1_ptr reqs ti ts
+      reqs = { reqs & req_type_coercions = [
+		      			{ tc_demanded = expr2_type, tc_offered = result_type, tc_position = { cp_expression = expr2 }, tc_coercible = True /* RWS ??? */ } : reqs.req_type_coercions ]}
+	= (reqs, expr1_type, No, ts)
+
+requirements (RecordUpdate {glob_module,glob_object={ds_index,ds_arity}} expression expressions) reqs ti ts
+	# (lhs, ts) = standardLhsConstructorType ds_index glob_module ds_arity ti ts	
+	  (rhs, ts) = standardRhsConstructorType ds_index glob_module ds_arity ti ts	
+	  (reqs, expression_type, opt_expr_ptr, ts) = requirements expression reqs ti ts
+	  (reqs, ts) = requirements_of_fields expression expressions rhs.tst_args lhs.tst_args reqs ti ts
+	  ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr lhs.tst_result.at_attribute ts.ts_expr_heap }
+	  coercion = { tc_demanded = lhs.tst_result, tc_offered = expression_type, tc_position = { cp_expression = expression }, tc_coercible = True }
+	= ({ reqs & req_attr_coercions = rhs.tst_attr_env ++ lhs.tst_attr_env ++ reqs.req_attr_coercions, req_type_coercions = [ coercion : reqs.req_type_coercions ]},
+	    rhs.tst_result, No, ts)
+where 
+	requirements_of_fields expression [] _ _ reqs ti ts
+		= (reqs, ts)
+	requirements_of_fields expression [field : fields] [dem_type : dem_types] [off_type : off_types] reqs ti ts
+		# (reqs, ts) = requirements_of_field expression field dem_type off_type reqs ti ts
+		= requirements_of_fields expression fields dem_types off_types reqs ti ts
+
+	requirements_of_field expression {bind_src=EE} dem_field_type off_field_type reqs=:{req_type_coercions} ti ts
+		# coercion = { tc_demanded = dem_field_type, tc_offered = off_field_type, tc_position = { cp_expression = expression }, tc_coercible = True }
+		= ({ reqs & req_type_coercions = [ coercion : req_type_coercions ]}, ts)
+	requirements_of_field _ {bind_src} dem_field_type _ reqs=:{req_type_coercions} ti ts
+		# (reqs, expr_type, opt_expr_ptr, ts) = requirements bind_src reqs ti ts
+		  ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr dem_field_type.at_attribute ts.ts_expr_heap }
+		  coercion = { tc_demanded = dem_field_type, tc_offered = expr_type, tc_position = { cp_expression = bind_src }, tc_coercible = True }
+		= ({ reqs & req_type_coercions = [ coercion : reqs.req_type_coercions ]}, ts)
+
+requirements (TupleSelect tuple_symbol arg_nr expr) reqs=:{req_attr_coercions} ti ts
+	# ({tst_args = [argtype:_], tst_result, tst_attr_env}, ts) = standardTupleSelectorType tuple_symbol arg_nr ti ts
+	  (reqs, e_type, opt_expr_ptr, ts) = requirements expr { reqs & req_attr_coercions = tst_attr_env ++ req_attr_coercions } ti ts
+	  req_type_coercions = [{ tc_demanded = argtype, tc_offered = e_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions ]
+	  ts_expr_heap = storeAttribute opt_expr_ptr argtype.at_attribute ts.ts_expr_heap
+	= ( { reqs & req_type_coercions = req_type_coercions }, tst_result, No, { ts & ts_expr_heap = ts_expr_heap })
+
+
+requirements (BasicExpr basic_val basic_type) reqs ti ts
+	# (type, ts) = attributedBasicType basic_type ts
+ 	= (reqs, type, No, ts)
+
+requirements (MatchExpr opt_tuple_type {glob_object={ds_arity, ds_index},glob_module} expr) reqs ti ts
+	# ({tst_result,tst_args,tst_attr_env}, ts) = standardLhsConstructorType ds_index glob_module ds_arity ti ts	
+	  (reqs, e_type, opt_expr_ptr, ts) = requirements expr reqs ti ts
+	  reqs = { reqs & req_attr_coercions =  tst_attr_env ++ reqs.req_attr_coercions,
+	  				  req_type_coercions = [{ tc_demanded = tst_result, tc_offered = e_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions ] }
+	  ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr tst_result.at_attribute ts.ts_expr_heap }
+	= case opt_tuple_type of
+		Yes {glob_object={ds_ident,ds_index,ds_arity}, glob_module}
+			# tuple_type = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident ds_arity
+			-> (reqs, { at_type = TA tuple_type tst_args, at_attribute = TA_Unique, at_annotation = AN_None }, No, ts)
+		No
+			-> (reqs, hd tst_args, No, ts)
+	
+requirements (AnyCodeExpr _ _ _) reqs ti ts
+	# (fresh_v, ts) = freshAttributedVariable ts
+	= (reqs, fresh_v, No, ts)
+requirements (ABCCodeExpr _ _) reqs ti ts
+	# (fresh_v, ts) = freshAttributedVariable ts
+	= (reqs, fresh_v, No, ts)
+
+requirements expr reqs ti ts
+	= (reqs, abort ("Error in requirements\n" ---> expr), No, ts)
+
+requirementsOfSelectors expr [selector] tc_coercible sel_expr_type sel_expr opt_expr_ptr reqs ti ts 
+	# ts_expr_heap = storeAttribute opt_expr_ptr sel_expr_type.at_attribute ts.ts_expr_heap
+	= requirementsOfSelector expr selector tc_coercible sel_expr_type sel_expr reqs ti { ts & ts_expr_heap = ts_expr_heap }
+requirementsOfSelectors expr [selector : selectors] tc_coercible sel_expr_type sel_expr opt_expr_ptr reqs ti ts 
+	# ts_expr_heap = storeAttribute opt_expr_ptr sel_expr_type.at_attribute ts.ts_expr_heap
+	  (result_type, reqs, ts) = requirementsOfSelector expr selector tc_coercible sel_expr_type sel_expr reqs ti { ts & ts_expr_heap = ts_expr_heap }
+	= requirements_of_remaining_selectors expr selectors tc_coercible result_type expr reqs ti ts
+where
+	requirements_of_remaining_selectors expr [selector] tc_coercible sel_expr_type sel_expr reqs ti ts 
+		= requirementsOfSelector expr selector tc_coercible sel_expr_type sel_expr reqs ti ts 
+	requirements_of_remaining_selectors expr [selector : selectors] tc_coercible sel_expr_type sel_expr reqs ti ts 
+		# (result_type, reqs, ts) = requirementsOfSelector expr selector tc_coercible sel_expr_type sel_expr reqs ti ts 
+		= requirements_of_remaining_selectors expr selectors tc_coercible result_type sel_expr reqs ti ts 
+		  
+requirementsOfSelector expr (RecordSelection field filed_nr) tc_coercible sel_expr_type sel_expr reqs ti ts 
+	# ({tst_args, tst_result, tst_attr_env}, ts) = standardFieldSelectorType field ti ts
+	  req_type_coercions = [{ tc_demanded = sel_expr_type, tc_offered = hd tst_args, tc_position = { cp_expression = sel_expr }, tc_coercible = tc_coercible } : 
+	  			reqs.req_type_coercions ]
+	= (tst_result, { reqs & req_type_coercions = req_type_coercions }, ts)
+requirementsOfSelector expr (ArraySelection {glob_object = {ds_ident,ds_index,ds_arity},glob_module} expr_ptr index_expr) tc_coercible sel_expr_type sel_expr reqs ti ts 
+	# {me_type} = ti.ti_common_defs.[glob_module].com_member_defs.[ds_index]
+	  ({tst_attr_env,tst_args,tst_result,tst_context}, cons_variables, ts) = freshSymbolType me_type ti.ti_common_defs ts
+	  (dem_array_type, dem_index_type) = array_and_index_type tst_args
+	  reqs ={ reqs & req_attr_coercions = tst_attr_env ++ reqs.req_attr_coercions, req_cons_variables = [ cons_variables : reqs.req_cons_variables ]}
+	  (reqs, index_type, opt_expr_ptr, ts) = requirements index_expr reqs ti ts
+      reqs = { reqs & req_type_coercions = [{ tc_demanded = dem_index_type, tc_offered = index_type, tc_position = { cp_expression = expr }, tc_coercible = True },
+      			{ tc_demanded = dem_array_type, tc_offered = sel_expr_type, tc_position = { cp_expression = sel_expr }, tc_coercible = tc_coercible } : reqs.req_type_coercions ]}
+	  ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr index_type.at_attribute ts.ts_expr_heap }
+	| isEmpty tst_context
+		= (tst_result, reqs, ts)
+		= (tst_result, { reqs & req_overloaded_calls = [expr_ptr : reqs.req_overloaded_calls ]}, { ts & ts_expr_heap =
+				ts.ts_expr_heap <:= (expr_ptr, EI_Overloaded { oc_symbol = 
+					{ symb_name = ds_ident, symb_kind = SK_OverloadedFunction {glob_module = glob_module, glob_object = ds_index}, symb_arity = ds_arity },
+						oc_context = tst_context, oc_specials = [] })})
+where
+	array_and_index_type [array_type, index_type : _ ]
+		= (array_type, index_type)
+
+makeBase vars types ts_var_heap
+	= fold2St (\ {fv_info_ptr} type var_heap -> var_heap <:= (fv_info_ptr, VI_Type type)) vars types ts_var_heap
+
+attributedBasicType (BT_String string_type) ts=:{ts_attr_store}
+	= ({ at_annotation = AN_None, at_attribute = TA_TempVar ts_attr_store, at_type = string_type}, {ts & ts_attr_store = inc ts_attr_store})
+attributedBasicType bas_type ts=:{ts_attr_store}
+	= ({ at_annotation = AN_None, at_attribute = TA_TempVar ts_attr_store, at_type = TB bas_type}, {ts & ts_attr_store = inc ts_attr_store})
+
+unify_coercions [{tc_demanded,tc_offered,tc_position}:coercions] modules subst heaps err
+	# (subst, heaps, err) = unify_coercions coercions modules subst heaps err
+	  (subst_demanded, subst) = arraySubst tc_demanded subst
+	  (subst_offered, subst) = arraySubst tc_offered subst
+	  (succ, subst, heaps) = unify subst_demanded subst_offered modules subst heaps
+	| succ
+		= (subst, heaps, err)
+		= (subst, heaps, cannotUnify subst_demanded subst_offered tc_position err)
+	
+unify_coercions [] modules subst heaps err
+	= (subst, heaps, err)
+
+InitFunEnv :: !Int -> *{! FunctionType}
+InitFunEnv nr_of_fun_defs
+	= createArray nr_of_fun_defs EmptyFunctionType
+
+//CreateInitialSymbolTypes :: ![Int] !u:{# FunDef} !{# CommonDefs } !*TypeState -> (!u:{# FunDef}, !*TypeState)
+CreateInitialSymbolTypes common_defs [] defs_and_state
+	= defs_and_state
+CreateInitialSymbolTypes common_defs [fun : funs] (fun_defs, pre_def_symbols, req_cons_variables, ts)
+	#! fd = fun_defs.[fun]
+	# (pre_def_symbols, req_cons_variables, ts) = initial_symbol_type common_defs fd (pre_def_symbols, req_cons_variables, ts)
+	= CreateInitialSymbolTypes common_defs funs (fun_defs, pre_def_symbols, req_cons_variables, ts)
+where 
+	initial_symbol_type common_defs {fun_type = Yes ft=:{st_arity,st_args,st_result,st_attr_vars,st_attr_env}, fun_lifted, fun_info = {fi_dynamics} }
+				(pre_def_symbols, req_cons_variables, ts=:{ts_type_heaps,ts_expr_heap,ts_td_infos,ts_error})
+		# (st_args, ps) = addPropagationAttributesToATypes common_defs st_args
+				{ prop_type_heaps = ts_type_heaps, prop_td_infos = ts_td_infos,
+				  prop_attr_vars = st_attr_vars, prop_attr_env = st_attr_env, prop_error = ts_error}
+		  (st_result, _, {prop_type_heaps,prop_td_infos,prop_attr_vars,prop_error,prop_attr_env}) = addPropagationAttributesToAType common_defs st_result ps
+		  ft = { ft & st_args = st_args, st_result = st_result, st_attr_vars = prop_attr_vars, st_attr_env = prop_attr_env }
+		  (th_vars, ts_expr_heap) = clear_dynamics fi_dynamics (prop_type_heaps.th_vars, ts.ts_expr_heap)
+		  (fresh_fun_type, cons_variables, ts) = freshSymbolType ft common_defs { ts & ts_type_heaps = { prop_type_heaps & th_vars = th_vars }, ts_expr_heap = ts_expr_heap,
+		  		 ts_td_infos = prop_td_infos, ts_error = prop_error }
+		  (lifted_args, ts) = fresh_non_unique_type_variables fun_lifted [] ts
+		  (ts_var_store, ts_type_heaps, ts_var_heap, ts_expr_heap, pre_def_symbols)
+		  		= fresh_dynamics fi_dynamics (ts.ts_var_store, ts.ts_type_heaps, ts.ts_var_heap, ts.ts_expr_heap, pre_def_symbols)
+		= (pre_def_symbols, [ cons_variables : req_cons_variables],
+				{ ts & ts_fun_env = { ts.ts_fun_env & [fun] = SpecifiedType ft lifted_args
+					{ fresh_fun_type & tst_arity = st_arity + fun_lifted, tst_args = lifted_args ++ fresh_fun_type.tst_args, tst_lifted = fun_lifted }},
+						ts_var_heap = ts_var_heap, ts_var_store = ts_var_store, ts_expr_heap = ts_expr_heap, ts_type_heaps = ts_type_heaps })
+	initial_symbol_type common_defs {fun_arity, fun_lifted, fun_info = {fi_dynamics}} (pre_def_symbols, req_cons_variables, ts)
+		# (st_gen, ts) = create_general_symboltype fun_arity fun_lifted ts
+		  ts_type_heaps = ts.ts_type_heaps 
+		  (th_vars, ts_expr_heap) = clear_dynamics fi_dynamics (ts_type_heaps.th_vars, ts.ts_expr_heap)
+		  (ts_var_store, ts_type_heaps, ts_var_heap, ts_expr_heap, pre_def_symbols)
+		  		= fresh_dynamics fi_dynamics (ts.ts_var_store, { ts_type_heaps & th_vars = th_vars },
+		  				ts.ts_var_heap, ts_expr_heap, pre_def_symbols)
+		= (pre_def_symbols, req_cons_variables, { ts & ts_fun_env = { ts.ts_fun_env & [fun] = UncheckedType st_gen }, ts_var_store = ts_var_store,
+					ts_expr_heap = ts_expr_heap, ts_type_heaps = ts_type_heaps, ts_var_heap = ts_var_heap})
+
+
+	create_general_symboltype :: !Int !Int !*TypeState -> (!TempSymbolType, !*TypeState)
+	create_general_symboltype nr_of_args nr_of_lifted_args ts
+		# (tst_args, ts) = fresh_attributed_type_variables nr_of_args [] ts
+		  (tst_args, ts) = fresh_attributed_type_variables nr_of_lifted_args tst_args ts
+		  (tst_result, ts) = freshAttributedVariable ts
+		= ({ tst_args = tst_args, tst_arity = nr_of_args + nr_of_lifted_args, tst_result = tst_result, tst_context = [], tst_attr_env = [], tst_lifted = 0 }, ts)
+
+	fresh_attributed_type_variables :: !Int ![AType] !*TypeState -> (![AType], !*TypeState)
+	fresh_attributed_type_variables n vars ts
+		| n == 0
+			= (vars, ts)
+			# (var, ts) = freshAttributedVariable ts
+			= fresh_attributed_type_variables (dec n) [var : vars] ts
+
+	fresh_non_unique_type_variables :: !Int ![AType] !*TypeState -> (![AType], !*TypeState)
+	fresh_non_unique_type_variables n vars ts
+		| n == 0
+			= (vars, ts)
+			# (var, ts) = freshNonUniqueVariable ts
+			= fresh_non_unique_type_variables (dec n) [var : vars] ts
+
+	fresh_dynamics dyn_ptrs state
+		= foldSt fresh_dynamic dyn_ptrs state
+
+	fresh_dynamic dyn_ptr (var_store, type_heaps, var_heap, expr_heap, predef_symbols)
+		# (dyn_info, expr_heap) = readPtr dyn_ptr expr_heap
+		= case dyn_info of
+			EI_Dynamic opt_dyn_type=:(Yes {dt_uni_vars,dt_type,dt_global_vars})
+				# (th_vars, var_store) = fresh_existential_attributed_variables dt_uni_vars (type_heaps.th_vars, var_store)
+				  (th_vars, var_store) = fresh_type_variables dt_global_vars (th_vars, var_store)
+				  (tdt_type, {copy_heaps}) = freshCopy dt_type { copy_heaps = { type_heaps & th_vars = th_vars }}
+				  (contexts, expr_ptr, type_code_symbol, (var_heap, expr_heap, type_var_heap, predef_symbols))
+				  		= determine_context_and_expr_ptr dt_global_vars (var_heap, expr_heap, copy_heaps.th_vars, predef_symbols)
+				-> (var_store, { copy_heaps & th_vars = type_var_heap }, var_heap,
+						expr_heap <:= (dyn_ptr, EI_TempDynamicType opt_dyn_type tdt_type contexts expr_ptr type_code_symbol), predef_symbols)
+			EI_Dynamic No
+				# fresh_var = TempV var_store
+				  tdt_type = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = fresh_var }
+
+				# ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeClass]
+		  		  tc_class_symb = {glob_module = pds_module, glob_object = {ds_ident = pds_ident, ds_arity = 1, ds_index = pds_def }}
+ 				  (pds, predef_symbols) = predef_symbols![PD_TypeCodeMember]
+		  		  ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember]
+				  tc_member_symb = { symb_name = pds_ident, symb_kind = SK_OverloadedFunction {glob_module = pds_module, glob_object = pds_def }, symb_arity = 0}
+		 		  (new_var_ptr, var_heap) = newPtr VI_Empty var_heap
+				  context = {tc_class = tc_class_symb, tc_types = [fresh_var], tc_var = new_var_ptr}
+		  		  (expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+				-> (inc var_store, type_heaps, var_heap,
+						expr_heap <:= (dyn_ptr, EI_TempDynamicType No tdt_type [context] expr_ptr tc_member_symb), predef_symbols)
+			EI_DynamicTypeWithVars loc_type_vars dt=:{dt_type,dt_global_vars} loc_dynamics
+				# (fresh_vars, (th_vars, var_store)) = fresh_existential_variables loc_type_vars (type_heaps.th_vars, var_store)
+				  (th_vars, var_store) = fresh_type_variables dt_global_vars (th_vars, var_store)
+				  (tdt_type, {copy_heaps}) = freshCopy dt_type { copy_heaps = { type_heaps & th_vars = th_vars }}
+				  (contexts, expr_ptr, type_code_symbol, (var_heap, expr_heap, type_var_heap, predef_symbols))
+				  		= determine_context_and_expr_ptr dt_global_vars (var_heap, expr_heap, copy_heaps.th_vars, predef_symbols)
+				-> fresh_local_dynamics loc_dynamics (var_store, { copy_heaps & th_vars = type_var_heap }, var_heap,
+						expr_heap <:= (dyn_ptr, EI_TempDynamicPattern loc_type_vars dt loc_dynamics fresh_vars tdt_type contexts expr_ptr type_code_symbol), predef_symbols)
+
+	fresh_local_dynamics loc_dynamics state
+		= foldSt fresh_dynamic loc_dynamics state
+
+	clear_dynamics dyn_ptrs heaps
+		= foldSt clear_dynamic dyn_ptrs heaps
+		
+	clear_dynamic dyn_ptr (var_heap, expr_heap)
+		# (dyn_info, expr_heap) = readPtr dyn_ptr expr_heap
+		= case dyn_info of
+			EI_Dynamic (Yes {dt_global_vars})
+				-> (clear_type_vars dt_global_vars var_heap, expr_heap)
+			EI_Dynamic No
+				-> (var_heap, expr_heap)
+			EI_DynamicTypeWithVars loc_type_vars {dt_global_vars} loc_dynamics
+				-> clear_local_dynamics loc_dynamics (clear_type_vars dt_global_vars var_heap, expr_heap)
+
+	clear_local_dynamics loc_dynamics state
+		= foldSt clear_dynamic loc_dynamics state
+		
+	clear_type_vars type_vars var_heap
+		= foldSt (\{tv_info_ptr} -> writePtr tv_info_ptr TVI_Empty) type_vars var_heap 
+		
+	fresh_existential_attributed_variables type_variables state
+		= foldSt (\{atv_variable={tv_info_ptr}} (var_heap, var_store) -> (var_heap <:= (tv_info_ptr, TVI_Type (TempQV var_store)), inc var_store))
+							type_variables state 
+	fresh_existential_variables type_variables state
+		= mapSt (\{tv_info_ptr} (var_heap, var_store) -> (var_store, (var_heap <:= (tv_info_ptr, TVI_Type (TempQV var_store)), inc var_store)))
+							type_variables state 
+	fresh_type_variables type_variables state
+		= foldSt fresh_type_variable type_variables state 
+
+	fresh_type_variable {tv_info_ptr} (var_heap, var_store)
+		# (var_info, var_heap) = readPtr tv_info_ptr var_heap
+		= case var_info of
+			TVI_Empty
+				-> (var_heap <:= (tv_info_ptr, TVI_Type (TempV var_store)), inc var_store)
+			_
+				-> (var_heap, var_store)
+	
+	determine_context_and_expr_ptr global_vars (var_heap, expr_heap, type_var_heap, predef_symbols)
+		# ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeClass]
+		  tc_class_symb = {glob_module = pds_module, glob_object = {ds_ident = pds_ident, ds_arity = 1, ds_index = pds_def }}
+		  ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember]
+		  tc_member_symb = { symb_name	= pds_ident, symb_kind = SK_TypeCode, symb_arity = 0}
+		  (contexts, (var_heap, type_var_heap)) = mapSt (build_type_context tc_class_symb) global_vars (var_heap, type_var_heap)
+		  (expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
+		= (contexts, expr_ptr, tc_member_symb, (var_heap, expr_heap, type_var_heap, predef_symbols))
+
+	build_type_context tc_class_symb {tv_info_ptr} (var_heap, type_var_heap)
+		# (TVI_Type fresh_var, type_var_heap) = readPtr tv_info_ptr type_var_heap
+		  (new_var_ptr, var_heap) = newPtr VI_Empty var_heap
+		= ({tc_class = tc_class_symb, tc_types = [fresh_var], tc_var = new_var_ptr}, (var_heap, type_var_heap))
+
+
+specification_error type err
+	= TypeError "specified type conflicts with derived type" type "" err
+
+cleanUpAndCheckFunctionTypes [] defs type_contexts coercion_env attr_partition type_var_env attr_var_env fun_defs ts
+	= (fun_defs, ts)
+cleanUpAndCheckFunctionTypes [fun : funs] defs type_contexts coercion_env attr_partition type_var_env attr_var_env fun_defs ts
+	#! fd = fun_defs.[fun]
+	# (type_var_env, attr_var_env, ts) = clean_up_and_check_function_type fd fun defs type_contexts coercion_env attr_partition type_var_env attr_var_env ts
+	= cleanUpAndCheckFunctionTypes funs defs type_contexts coercion_env attr_partition type_var_env attr_var_env fun_defs ts
+where
+	clean_up_and_check_function_type {fun_symb,fun_pos,fun_type = opt_fun_type} fun defs type_contexts coercion_env attr_partition type_var_env attr_var_env ts
+		#! env_type = ts.ts_fun_env.[fun]
+		# ts = { ts & ts_error = setErrorAdmin (newPosition fun_symb fun_pos) ts.ts_error}
+		= case env_type of
+			ExpandedType fun_type tmp_fun_type exp_fun_type
+				# (clean_fun_type, type_var_env, attr_var_env, ts_type_heaps, ts_error)
+					= cleanUpSymbolType exp_fun_type type_contexts coercion_env attr_partition type_var_env attr_var_env ts.ts_type_heaps ts.ts_error
+				| ts_error.ea_ok
+					# (ts_fun_env, attr_var_env, ts_type_heaps, ts_error)
+			  			= check_function_type fun_type tmp_fun_type clean_fun_type defs ts.ts_fun_env attr_var_env ts_type_heaps ts_error
+					-> (type_var_env, attr_var_env, { ts & ts_type_heaps = ts_type_heaps, ts_fun_env = ts_fun_env, ts_error = ts_error })
+					-> (type_var_env, attr_var_env, { ts & ts_type_heaps = ts_type_heaps, ts_error = ts_error })
+		  	UncheckedType exp_fun_type
+				# (clean_fun_type, type_var_env, attr_var_env, ts_type_heaps, ts_error)
+					= cleanUpSymbolType exp_fun_type type_contexts coercion_env attr_partition type_var_env attr_var_env ts.ts_type_heaps ts.ts_error
+				  ts_fun_env = { ts.ts_fun_env & [fun] = CheckedType clean_fun_type }
+				-> (type_var_env, attr_var_env, { ts & ts_type_heaps = ts_type_heaps, ts_fun_env = ts_fun_env, ts_error = ts_error })
+
+	check_function_type fun_type tmp_fun_type=:{tst_lifted} clean_fun_type=:{st_arity, st_args, st_vars, st_attr_vars} defs fun_env attr_var_env type_heaps error
+		# (equi, attr_var_env, type_heaps) = equivalent clean_fun_type tmp_fun_type defs attr_var_env type_heaps
+		| equi
+			# type_with_lifted_arg_types = addLiftedArgumentsToSymbolType fun_type tst_lifted st_args st_vars st_attr_vars
+			= ({ fun_env & [fun] = CheckedType type_with_lifted_arg_types}, attr_var_env, type_heaps, error)
+//					---> ("check_function_type", clean_fun_type, fun_type, type_with_lifted_arg_types)
+			= (fun_env, attr_var_env, type_heaps, specification_error clean_fun_type error)
+	where
+		add_lifted_arg_types arity_diff args1 args2
+			| arity_diff > 0
+				= take arity_diff args2 ++ args1
+				= args1
+
+addLiftedArgumentsToSymbolType st=:{st_arity,st_args,st_vars,st_attr_vars} nr_of_lifted_arguments new_args new_vars new_attrs
+	= { st & st_args = take nr_of_lifted_arguments new_args ++ st_args, st_vars = st_vars ++ drop (length st_vars) new_vars,
+			st_attr_vars = st_attr_vars ++ take (length new_attrs - length st_attr_vars) new_attrs, st_arity = st_arity + nr_of_lifted_arguments }
+
+
+::	FunctionRequirements =
+	{	fe_requirements	:: !Requirements
+	,	fe_context		:: !Optional [TypeContext]
+	,	fe_location		:: !IdentPos
+	}
+
+typeProgram ::!{! Group} !*{# FunDef} !IndexRange !CommonDefs ![Declaration] !{# DclModule} !*Heaps !*PredefinedSymbols !*File
+	-> (!Bool, !*{# FunDef}, !{! (!Index, !SymbolType)}, {! GlobalTCType}, !{# CommonDefs}, !{# {# FunType} }, !*Heaps, !*PredefinedSymbols, !*File)
+typeProgram comps fun_defs specials icl_defs imports modules {hp_var_heap, hp_expression_heap, hp_type_heaps} predef_symbols file
+	#! fun_env_size = size fun_defs
+	# ts_error = {ea_file = file, ea_loc = [], ea_ok = True }
+
+	  ti_common_defs = {{dcl_common \\ {dcl_common} <-: modules } & [cIclModIndex] = icl_defs }
+	  ti_functions	 = {dcl_functions \\ {dcl_functions} <-: modules }
+
+	  type_def_sizes =  [ size com_type_defs \\ {com_type_defs} <-: ti_common_defs ]
+	  class_def_sizes = [ size com_class_defs \\ {com_class_defs} <-: ti_common_defs ]
+	  class_instances = { {  IT_Empty \\ i <- [0 .. dec size] } \\ size <- class_def_sizes }
+	  
+	  (td_infos, hp_type_heaps, ts_error) = analTypeDefs ti_common_defs hp_type_heaps ts_error
+
+	  state = collect_imported_instances imports ti_common_defs {} ts_error class_instances hp_type_heaps.th_vars td_infos 
+	  (_, ts_error, class_instances, th_vars, td_infos) = collect_and_check_instances (size icl_defs.com_instance_defs) ti_common_defs state
+	  
+	  ts = { ts_fun_env = InitFunEnv fun_env_size, ts_var_heap = hp_var_heap, ts_expr_heap = hp_expression_heap, ts_var_store = 0, ts_attr_store = FirstAttrVar,
+	  		 ts_type_heaps = { hp_type_heaps & th_vars = th_vars }, ts_td_infos = td_infos, ts_error = ts_error }
+	  ti = { ti_common_defs = ti_common_defs, ti_functions = ti_functions }
+	  special_instances = { si_next_array_member_index = fun_env_size, si_array_instances = [], si_next_TC_member_index = 0, si_TC_instances = [] }
+	# (type_error, fun_defs, predef_symbols, special_instances, ts) = type_components 0 comps  class_instances ti (False, fun_defs, predef_symbols, special_instances, ts)
+	  (fun_defs,ts_fun_env) = update_function_types 0 comps ts.ts_fun_env fun_defs
+	  (type_error, fun_defs, predef_symbols, special_instances, {ts_fun_env,ts_error,ts_var_heap, ts_expr_heap, ts_type_heaps})
+			= type_instances specials.ir_from specials.ir_to class_instances ti (type_error, fun_defs, predef_symbols, special_instances,
+				{ ts & ts_fun_env = ts_fun_env })
+	  {si_array_instances, si_next_TC_member_index, si_TC_instances}= special_instances
+	  (array_inst_types, predef_symbols, ts_type_heaps) = convert_array_instances si_array_instances ti_common_defs predef_symbols ts_type_heaps
+	  type_code_instances = {createArray si_next_TC_member_index GTT_Function & [gtci_index] = gtci_type \\ {gtci_index, gtci_type} <- si_TC_instances}
+	= (not type_error, fun_defs, { array_inst_type \\ array_inst_type <- array_inst_types }, type_code_instances, ti_common_defs, ti_functions,
+			{hp_var_heap = ts_var_heap, hp_expression_heap = ts_expr_heap, hp_type_heaps = ts_type_heaps }, predef_symbols, ts_error.ea_file)
+where
+
+	collect_imported_instances imports common_defs dummy error class_instances type_var_heap td_infos
+		= foldSt (collect_imported_instance common_defs) imports (dummy, error, class_instances, type_var_heap, td_infos)
+
+	collect_imported_instance common_defs {dcl_ident, dcl_kind = STE_Imported STE_Instance mod_index, dcl_index } state
+		= update_instances_of_class common_defs mod_index dcl_index state
+	collect_imported_instance common_defs _ state
+		= state
+
+	collect_and_check_instances nr_of_instances common_defs state
+		= iFoldSt (update_instances_of_class common_defs cIclModIndex) 0 nr_of_instances state
+
+	update_instances_of_class common_defs mod_index ins_index (dummy, error, class_instances, type_var_heap, td_infos)
+		# {ins_class={glob_object={ds_index},glob_module},ins_type={it_types}} = common_defs.[mod_index].com_instance_defs.[ins_index]
+		  (mod_instances, class_instances) = replace class_instances glob_module dummy
+		  (instances, mod_instances) = replace mod_instances ds_index IT_Empty
+		  (error, instances) = insert it_types ins_index mod_index common_defs error instances
+		  (_, mod_instances) = replace mod_instances ds_index instances
+		  (dummy, class_instances) = replace class_instances glob_module mod_instances
+		  (error, type_var_heap, td_infos)
+					= check_types_of_instances common_defs glob_module ds_index it_types (error, type_var_heap, td_infos)
+		= (dummy, error, class_instances, type_var_heap, td_infos)
+
+	check_types_of_instances common_defs class_module class_index types state
+		# {class_arity,class_cons_vars} = common_defs.[class_module].com_class_defs.[class_index]
+		= check_instances_of_constructor_variables common_defs class_cons_vars (dec class_arity) types state
+	where
+		check_instances_of_constructor_variables common_defs cons_vars arg_nr [type : types] state
+			| cons_vars bitand (1 << arg_nr) <> 0
+				# state = check_type_of_constructor_variable common_defs type state
+				= check_instances_of_constructor_variables common_defs cons_vars (dec arg_nr) types state
+				= check_instances_of_constructor_variables common_defs cons_vars (dec arg_nr) types state
+		check_instances_of_constructor_variables common_defs cons_vars arg_nr [] state
+			= state
+
+		check_type_of_constructor_variable common_defs type=:(TA {type_index={glob_module,glob_object},type_arity} types) (error, type_var_heap, td_infos)
+			# {td_arity} = common_defs.[glob_module].com_type_defs.[glob_object]
+			  ({tdi_properties,tdi_cons_vars}, td_infos) = td_infos![glob_module].[glob_object]
+			| tdi_properties bitand cIsNonCoercible == 0
+				# ({sc_neg_vect}, type_var_heap, td_infos)
+					= signClassification glob_object glob_module [TopSignClass \\ cv <- tdi_cons_vars ] common_defs type_var_heap td_infos
+				= (check_sign type (sc_neg_vect >> type_arity) (td_arity - type_arity) error, type_var_heap, td_infos)			
+				= (checkError type " instance type should be coercible" error, type_var_heap, td_infos)
+		where
+			check_sign type neg_signs arg_nr error
+				| arg_nr == 0
+					= error
+					| neg_signs bitand 1 == 0
+						= check_sign type (neg_signs >> 1) (dec arg_nr) error
+						= checkError type " all arguments of an instance type should have a non-negative sign" error
+		check_type_of_constructor_variable common_defs type=:(arg_type --> result_type) (error, type_var_heap, td_infos)
+			= (checkError type " instance type should be coercible" error, type_var_heap, td_infos)
+		check_type_of_constructor_variable common_defs type=:(cv :@: types) (error, type_var_heap, td_infos)
+			= (checkError type " instance type should be coercible" error, type_var_heap, td_infos)
+		check_type_of_constructor_variable common_defs type state
+			= state
+			
+	insert ::  ![Type] !Index !Index !{# CommonDefs } !*ErrorAdmin !*InstanceTree -> (!*ErrorAdmin, !*InstanceTree)
+	insert ins_types new_ins_index new_ins_module modules error IT_Empty
+		=  (error, IT_Node {glob_object = new_ins_index,glob_module = new_ins_module}  IT_Empty IT_Empty)
+	insert ins_types new_ins_index new_ins_module modules error (IT_Node ins=:{glob_object,glob_module} it_less it_greater)
+		#! {ins_type={it_types}} = modules.[glob_module].com_instance_defs.[glob_object]
+		# cmp = ins_types =< it_types
+		| cmp == Smaller
+			# (error, it_less) = insert ins_types new_ins_index new_ins_module modules error it_less
+			= (error, IT_Node ins it_less it_greater)
+		| cmp == Greater
+			# (error, it_greater) = insert ins_types new_ins_index new_ins_module modules error it_greater
+			= (error, IT_Node ins it_less it_greater)
+			= (checkError ins_types " instance is overlapping" error, IT_Node ins it_less it_greater)
+
+	type_instances ir_from ir_to class_instances ti funs_and_state
+		| ir_from == ir_to
+			= funs_and_state
+			# funs_and_state = type_component [ir_from] class_instances ti funs_and_state
+			= type_instances (inc ir_from) ir_to class_instances ti funs_and_state
+
+	type_components group_index comps class_instances ti funs_and_state
+		| group_index == size comps
+			= funs_and_state
+			#! comp = comps.[group_index]	
+			# funs_and_state = type_component comp.group_members  class_instances ti funs_and_state
+			= type_components (inc group_index) comps class_instances ti funs_and_state
+
+	type_component comp class_instances ti=:{ti_common_defs} (type_error, fun_defs, predef_symbols, special_instances, ts)
+		# (fun_defs, predef_symbols, cons_variables, ts) = CreateInitialSymbolTypes ti_common_defs comp (fun_defs, predef_symbols, [], ts)
+		  (fun_reqs, (cons_variables, fun_defs, ts)) = type_functions comp ti cons_variables fun_defs ts
+		#! nr_of_type_variables = ts.ts_var_store
+		# (subst, ts_type_heaps, ts_error)
+		  		= unify_requirements_of_functions fun_reqs ti (createArray nr_of_type_variables TE) ts.ts_type_heaps ts.ts_error
+		| not ts_error.ea_ok
+			= (True, fun_defs, predef_symbols, special_instances, create_erroneous_function_types comp
+				{ ts & ts_type_heaps = ts_type_heaps, ts_error = { ts_error & ea_ok = True }, ts_var_store = 0, ts_attr_store = FirstAttrVar})
+		# {ts_attr_store,ts_var_heap,ts_var_store,ts_expr_heap,ts_td_infos} = ts
+		  (subst, nr_of_attr_vars, th_vars, ts_td_infos) = liftSubstitution subst ti_common_defs ts_attr_store ts_type_heaps.th_vars ts_td_infos
+		  coer_demanded ={{ CT_Empty \\ i <- [0 .. nr_of_attr_vars - 1] } & [AttrUni] = CT_Unique }
+		  coer_offered = {{ CT_Empty \\ i <- [0 .. nr_of_attr_vars - 1] } & [AttrMulti] = CT_NonUnique }
+		  coercion_env = build_initial_coercion_env fun_reqs {coer_demanded = coer_demanded, coer_offered = coer_offered }
+		  (over_info, (subst, ts_expr_heap)) = collect_and_expand_overloaded_calls fun_reqs [] (subst, ts_expr_heap)
+		  (ts_expr_heap, subst) = expand_types_of_cases_and_lets fun_reqs (ts_expr_heap, subst)
+		  (contexts, coercion_env, local_pattern_variables,
+		  	{ os_type_heaps, os_var_heap, os_symbol_heap, os_predef_symbols, os_special_instances, os_error })
+		  		= tryToSolveOverloading over_info ti_common_defs class_instances coercion_env
+		  			{	os_type_heaps = {ts_type_heaps & th_vars = th_vars}, os_var_heap = ts_var_heap, os_symbol_heap = ts_expr_heap,
+		  				os_predef_symbols = predef_symbols, os_error = ts_error, os_special_instances = special_instances }
+		| not os_error.ea_ok
+			= (True, fun_defs, os_predef_symbols, os_special_instances, create_erroneous_function_types comp { ts & ts_type_heaps = os_type_heaps,
+					ts_error = { os_error & ea_ok = True }, ts_var_store = 0, ts_attr_store = FirstAttrVar, 
+					ts_td_infos = ts_td_infos, ts_expr_heap = os_symbol_heap, ts_var_heap = os_var_heap })
+		# (fun_defs, coercion_env, subst, os_var_heap, os_symbol_heap, os_error)
+		  		= makeSharedReferencesNonUnique comp fun_defs coercion_env subst ti_common_defs os_var_heap os_symbol_heap os_error
+		  (cons_var_vects, subst) = determine_cons_variables cons_variables (createArray (inc (BITINDEX nr_of_type_variables)) 0, subst)
+		  (subst, {coer_offered,coer_demanded}, ts_td_infos, ts_type_heaps, ts_error)
+		  		= build_coercion_env fun_reqs subst coercion_env ti_common_defs cons_var_vects ts_td_infos os_type_heaps os_error
+		  (attr_partition, coer_demanded) = partitionateAttributes coer_offered coer_demanded
+		  (subst, ts_fun_env) = expand_function_types comp subst ts.ts_fun_env
+		  attr_var_env = createArray nr_of_attr_vars TA_None
+		  var_env = { subst & [i] = TE \\ i <- [0..dec ts_var_store]}
+		  (fun_defs, ts) = cleanUpAndCheckFunctionTypes comp ti_common_defs contexts coer_demanded attr_partition var_env attr_var_env fun_defs
+		  		{ ts & ts_error = ts_error, ts_fun_env = ts_fun_env, ts_type_heaps = ts_type_heaps,
+		  			ts_td_infos = ts_td_infos, ts_var_heap = os_var_heap, ts_expr_heap = os_symbol_heap }
+		| not ts.ts_error.ea_ok
+			= (True, fun_defs, os_predef_symbols, os_special_instances, create_erroneous_function_types comp
+					{ ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_error = { ts.ts_error & ea_ok = True } })
+		| isEmpty over_info 
+			# ts_type_heaps = ts.ts_type_heaps
+			  type_code_info = {	tci_next_index = os_special_instances.si_next_TC_member_index, tci_instances = os_special_instances.si_TC_instances,
+									tci_type_var_heap = ts_type_heaps.th_vars } 
+			  (fun_defs, ts_expr_heap, {tci_next_index,tci_instances,tci_type_var_heap}, ts_var_heap, ts_error)
+			  		= updateDynamics comp contexts local_pattern_variables fun_defs ts.ts_expr_heap type_code_info ts.ts_var_heap ts.ts_error
+			= (	type_error || not ts_error.ea_ok, 
+				fun_defs, os_predef_symbols, { os_special_instances & si_next_TC_member_index = tci_next_index, si_TC_instances = tci_instances },
+				{ ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True },
+					  ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars =  tci_type_var_heap }})
+			# ts_type_heaps = ts.ts_type_heaps
+			  type_code_info = {	tci_next_index = os_special_instances.si_next_TC_member_index, tci_instances = os_special_instances.si_TC_instances,
+									tci_type_var_heap = ts_type_heaps.th_vars } 
+			  (fun_defs, ts_expr_heap, {tci_next_index,tci_instances,tci_type_var_heap}, ts_var_heap, ts_error)
+			  		= removeOverloadedFunctions comp (map (\(co,_,pos) -> (co,pos)) over_info)
+			  			contexts local_pattern_variables fun_defs ts.ts_expr_heap type_code_info ts.ts_var_heap ts.ts_error
+			= (	type_error || not ts_error.ea_ok,
+				fun_defs, os_predef_symbols, { os_special_instances & si_next_TC_member_index = tci_next_index, si_TC_instances = tci_instances },
+				{ ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True },
+					  ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars =  tci_type_var_heap }})
+
+	unify_requirements_of_functions :: ![FunctionRequirements] !TypeInput !*{!Type} !*TypeHeaps !*ErrorAdmin -> (!*{!Type},!*TypeHeaps,!*ErrorAdmin)
+	unify_requirements_of_functions [{fe_requirements={req_type_coercions},fe_location} : reqs_list] modules subst heaps ts_error
+		# ts_error = setErrorAdmin fe_location ts_error
+		  (subst, heaps, ts_error) = unify_coercions req_type_coercions modules subst heaps ts_error
+		= unify_requirements_of_functions reqs_list modules subst heaps ts_error
+	unify_requirements_of_functions [] modules subst heaps ts_error
+		= (subst, heaps, ts_error)
+
+	build_initial_coercion_env [{fe_requirements={req_attr_coercions},fe_location} : reqs_list] coercion_env
+		= build_initial_coercion_env reqs_list (add_to_initial_coercion_env req_attr_coercions coercion_env)
+	build_initial_coercion_env [] coercion_env
+		= coercion_env
+
+	add_to_initial_coercion_env [{ac_offered,ac_demanded} : attr_coercions] coercion_env
+		= add_to_initial_coercion_env attr_coercions (newInequality ac_offered ac_demanded coercion_env)
+	add_to_initial_coercion_env [] coercion_env
+		= coercion_env
+
+	determine_cons_variables variables vect_and_subst
+		= foldSt (foldSt determine_cons_variable) variables vect_and_subst
+		
+	determine_cons_variable tv_number (bitvects, subst)
+		# (type, subst) = subst![tv_number]
+		= case type of
+			TE
+				-> (set_bit tv_number bitvects, subst)	// ---> ("determine_cons_variable1", tv_number)
+			TempV var_number
+				-> (set_bit var_number bitvects, subst)	// ---> ("determine_cons_variable2", var_number)
+			_
+				-> (bitvects, subst)
+	where
+		set_bit var_number bitvects
+			# bit_index = BITINDEX var_number
+			  (prev_vect, bitvects) = bitvects![bit_index]
+			= { bitvects & [bit_index] = prev_vect bitor (1 << BITNUMBER var_number) }
+
+	build_coercion_env [{fe_requirements={req_type_coercions},fe_location} : reqs_list] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+		# error = setErrorAdmin fe_location error
+		  (subst, coercion_env, type_signs, type_var_heap, error)
+			= add_to_coercion_env req_type_coercions subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+		= build_coercion_env reqs_list subst coercion_env common_defs cons_var_vects  type_signs type_var_heap error
+	build_coercion_env []  subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+		= (subst, coercion_env, type_signs, type_var_heap, error)
+
+	add_to_coercion_env [{tc_offered,tc_demanded,tc_coercible,tc_position} : attr_coercions] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+		# (subst, coercion_env, type_signs, type_var_heap, error)
+				= determineAttributeCoercions tc_offered tc_demanded tc_coercible tc_position subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+		= add_to_coercion_env attr_coercions subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+	add_to_coercion_env []  subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+		= (subst, coercion_env, type_signs, type_var_heap, error)
+
+	collect_and_expand_overloaded_calls [] calls subst_and_heap
+		= (calls, subst_and_heap)
+	collect_and_expand_overloaded_calls [{ fe_context=Yes context, fe_requirements={req_overloaded_calls}, fe_location}:reqs] calls (subst, expr_heap)
+		# (context, subst) = arraySubst context subst
+		= collect_and_expand_overloaded_calls reqs [(Yes context, req_overloaded_calls, fe_location) : calls]
+				(foldSt expand_type_contexts req_overloaded_calls (subst, expr_heap)) 	
+	collect_and_expand_overloaded_calls [{fe_context, fe_requirements={req_overloaded_calls}, fe_location}:reqs] calls (subst, expr_heap)
+		= collect_and_expand_overloaded_calls reqs [(fe_context, req_overloaded_calls, fe_location) : calls]
+				(foldSt expand_type_contexts req_overloaded_calls (subst, expr_heap)) 	
+
+	expand_type_contexts over_info_ptr (subst, expr_heap)
+		# (EI_Overloaded info, expr_heap) = readPtr over_info_ptr expr_heap
+		  (oc_context, subst) = arraySubst info.oc_context subst
+		= (subst, expr_heap <:= (over_info_ptr, EI_Overloaded { info & oc_context = oc_context }))
+
+	expand_types_of_cases_and_lets [] heap_and_subst
+		= heap_and_subst
+	expand_types_of_cases_and_lets [{fe_requirements={req_case_and_let_exprs}}:reqs] heap_and_subst
+		= expand_types_of_cases_and_lets reqs (foldl expand_case_or_let_type heap_and_subst req_case_and_let_exprs)
+
+	expand_case_or_let_type (expr_heap, subst) info_ptr
+		#! info = sreadPtr info_ptr expr_heap
+		= case info of
+			EI_CaseType case_type
+				# (case_type, subst) = arraySubst case_type subst
+				-> (writePtr info_ptr (EI_CaseType case_type) expr_heap, subst)
+			EI_LetType let_type
+				# (let_type, subst) = arraySubst let_type subst
+				-> (writePtr info_ptr (EI_LetType let_type) expr_heap, subst)
+
+	expand_function_types :: ![Int] !*{!Type} *{! FunctionType} -> (!*{!Type}, *{! FunctionType})
+	expand_function_types [fun : funs] subst ts_fun_env
+		#! fun_type = ts_fun_env.[fun]
+		= case fun_type of
+			UncheckedType tst
+				# (exp_tst, subst) = arraySubst tst subst
+				-> expand_function_types funs subst { ts_fun_env & [fun] = UncheckedType exp_tst}
+			SpecifiedType ft _ tst
+				#  (exp_tst, subst) = arraySubst tst subst
+				-> expand_function_types funs subst { ts_fun_env & [fun] = ExpandedType ft tst exp_tst}
+	expand_function_types [] subst ts_fun_env
+		= (subst, ts_fun_env)
+			
+
+	update_function_types :: !Index !{!Group} !*{!FunctionType} !*{#FunDef} -> (!*{#FunDef}, !*{!FunctionType})
+	update_function_types group_index comps fun_env fun_defs
+		| group_index == size comps
+			= (fun_defs, fun_env)
+			#! comp = comps.[group_index]	
+			# (fun_defs, fun_env) = update_function_types_in_component comp.group_members fun_env fun_defs
+			= update_function_types (inc group_index) comps fun_env fun_defs
+
+	where
+		update_function_types_in_component :: ![Index] !*{!FunctionType} !*{#FunDef} -> (!*{#FunDef}, !*{!FunctionType})
+		update_function_types_in_component [ fun_index : funs ] fun_env fun_defs
+			# (CheckedType checked_fun_type, fun_env) = fun_env![fun_index]
+			#! fd = fun_defs.[fun_index]
+			= case fd.fun_type of
+				No
+					-> update_function_types_in_component funs fun_env { fun_defs & [fun_index] = { fd & fun_type = Yes checked_fun_type }}
+				Yes fun_type
+					# nr_of_lifted_arguments = checked_fun_type.st_arity - fun_type.st_arity
+					| nr_of_lifted_arguments > 0
+						# fun_type = addLiftedArgumentsToSymbolType fun_type nr_of_lifted_arguments checked_fun_type.st_args checked_fun_type.st_vars checked_fun_type.st_attr_vars
+						-> update_function_types_in_component funs fun_env { fun_defs & [fun_index] = { fd & fun_type = Yes fun_type }}
+						-> update_function_types_in_component funs fun_env fun_defs
+		update_function_types_in_component [] fun_env fun_defs
+			= (fun_defs, fun_env)
+	
+	type_functions group ti cons_variables fun_defs ts
+		= mapSt (type_function ti) group (cons_variables, fun_defs, ts) // ((cons_variables, fun_defs, ts) ---> "[(") ---> ")]"
+
+	type_function ti fun_index (cons_variables, fun_defs, ts=:{ts_fun_env, ts_var_heap, ts_expr_heap, ts_error})
+		#! fd = fun_defs.[fun_index]
+		   type = ts_fun_env.[fun_index]
+		# {fun_symb,fun_arity,fun_body=TransformedBody {tb_args,tb_rhs},fun_pos, fun_info, fun_type} = fd
+		  temp_fun_type = type_of type
+		  ts_var_heap = makeBase tb_args temp_fun_type.tst_args ts_var_heap
+		  fe_location = newPosition fun_symb fun_pos
+		  ts_error = setErrorAdmin fe_location ts_error
+		  reqs = { req_overloaded_calls = [], req_type_coercions = [], req_attr_coercions = [], req_case_and_let_exprs = [], req_cons_variables = cons_variables }
+		  (rhs_reqs, rhs_type, rhs_expr_ptr, ts) = requirements tb_rhs reqs ti { ts & ts_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, ts_error = ts_error }
+		  req_type_coercions = [{tc_demanded = temp_fun_type.tst_result,tc_offered = rhs_type, tc_position = {cp_expression = tb_rhs }, tc_coercible = True} :
+		  		rhs_reqs.req_type_coercions ]
+		  ts_expr_heap = storeAttribute rhs_expr_ptr temp_fun_type.tst_result.at_attribute ts.ts_expr_heap
+		= ({fe_location = fe_location, fe_context = if (has_option fun_type) (Yes temp_fun_type.tst_context) No,
+			fe_requirements = { rhs_reqs & req_type_coercions = req_type_coercions, req_cons_variables = [] }}, (rhs_reqs.req_cons_variables, fun_defs,
+				{ ts & ts_expr_heap = ts_expr_heap }))
+					//  ---> ("type_function", fun_symb)
+	where
+		has_option (Yes _)	= True
+		has_option No 		= False
+		 
+		type_of (UncheckedType tst)		= tst
+		type_of (SpecifiedType _ _ tst) = tst
+			
+	convert_array_instances si_array_instances common_defs predef_symbols type_heaps
+		| isEmpty si_array_instances
+			= ([], predef_symbols, type_heaps)
+			# ({pds_ident,pds_module,pds_def},predef_symbols) = predef_symbols![PD_UnboxedArrayType]
+			  unboxed_array_type = TA (MakeTypeSymbIdent { glob_object = pds_def, glob_module = pds_module } pds_ident 0) []
+			  ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_ArrayClass]
+			  {class_members} = common_defs.[pds_module].com_class_defs.[pds_def]
+			  array_members = common_defs.[pds_module].com_member_defs
+			  (rev_instances, type_heaps) = foldSt (convert_array_instance class_members array_members unboxed_array_type) si_array_instances ([], type_heaps)
+			= (reverse rev_instances, predef_symbols, type_heaps)
+	where
+		convert_array_instance class_members array_members unboxed_array_type {ai_record} types_and_heaps
+			= iFoldSt (create_instance_type class_members array_members unboxed_array_type (TA ai_record [])) 0 (size class_members) types_and_heaps
+
+		create_instance_type members array_members unboxed_array_type record_type member_index (inst_types, type_heaps)
+			# {me_type,me_class_vars} = array_members.[members.[member_index].ds_index]
+			# (instance_type, _, type_heaps) = determineTypeOfMemberInstance me_type me_class_vars {it_vars = [], it_attr_vars = [], it_context = [],
+													it_types = [unboxed_array_type, record_type]} SP_None type_heaps
+			= ([(member_index,instance_type) : inst_types], type_heaps)
+	
+	create_erroneous_function_types group ts
+		= foldSt create_erroneous_function_type group ts
+		
+	create_erroneous_function_type fun ts
+		#! env_type = ts.ts_fun_env.[fun]
+		= case env_type of
+			ExpandedType fun_type tmp_fun_type exp_fun_type
+				# (fun_type, ts_type_heaps) = extendSymbolType fun_type tmp_fun_type.tst_lifted ts.ts_type_heaps
+				-> { ts & ts_type_heaps = ts_type_heaps, ts_fun_env = { ts.ts_fun_env & [fun] = CheckedType fun_type }}
+		  	UncheckedType tmp_fun_type
+		  		# (clean_fun_type, ts_type_heaps) = cleanSymbolType tmp_fun_type.tst_arity ts.ts_type_heaps
+				-> { ts & ts_type_heaps = ts_type_heaps, ts_fun_env = { ts.ts_fun_env & [fun] = CheckedType clean_fun_type }}
+			SpecifiedType fun_type _ tmp_fun_type
+				# (fun_type, ts_type_heaps) = extendSymbolType fun_type tmp_fun_type.tst_lifted ts.ts_type_heaps
+				-> { ts & ts_type_heaps = ts_type_heaps, ts_fun_env = { ts.ts_fun_env & [fun] = CheckedType fun_type }}
+			CheckedType _
+				-> ts
+
+instance <<< AttrCoercion
+where
+	(<<<) file {ac_demanded,ac_offered} = file <<< ac_demanded <<< '~' <<< ac_offered
+
+instance <<< FreeVar
+where
+	(<<<) file {fv_name} = file <<< fv_name
+
+instance <<< TypeCoercion
+where
+	(<<<) file {tc_demanded,tc_offered} = file <<< tc_demanded <<< '~' <<< tc_offered
+
+instance <<< TypeContext
+where
+	(<<<) file co = file <<< co.tc_class <<< " " <<< co.tc_types
+	
+instance <<< DefinedSymbol
+where
+	(<<<) file {ds_ident}
+		= file <<< ds_ident
+
+instance <<< FunctionType
+where
+	(<<<) file (CheckedType _)
+		= file <<< "CheckedType"
+	(<<<) file (SpecifiedType _ _ _)
+		= file <<< "SpecifiedType"
+	(<<<) file (UncheckedType _)
+		= file <<< "UncheckedType"
+	(<<<) file (ExpandedType _ _ _)
+		= file <<< "ExpandedType"
+	(<<<) file EmptyFunctionType
+		= file <<< "EmptyFunctionType"
diff --git a/frontend/typeanal.dcl b/frontend/typeanal.dcl
new file mode 100644
index 0000000..d9d891b
--- /dev/null
+++ b/frontend/typeanal.dcl
@@ -0,0 +1 @@
+definition module typeanal
diff --git a/frontend/typeanal.icl b/frontend/typeanal.icl
new file mode 100644
index 0000000..e602e72
--- /dev/null
+++ b/frontend/typeanal.icl
@@ -0,0 +1 @@
+implementation module typeanal
\ No newline at end of file
diff --git a/frontend/typeproperties.dcl b/frontend/typeproperties.dcl
new file mode 100644
index 0000000..fc7677a
--- /dev/null
+++ b/frontend/typeproperties.dcl
@@ -0,0 +1,55 @@
+definition module typeproperties
+
+import StdInt, StdClass
+
+import general
+
+::	TypeClassification
+
+EmptyTypeClassification :: TypeClassification
+
+::	SignClassification	=
+	{	sc_pos_vect	:: !BITVECT
+	,	sc_neg_vect	:: !BITVECT
+	}
+
+::	PropClassification	:== BITVECT
+
+TopSignClass	:== { sc_pos_vect = bitnot 0, sc_neg_vect = bitnot 0 }
+ArrowSignClass	:== { sc_pos_vect = 2, sc_neg_vect = 1 }
+PosSignClass	:== { sc_pos_vect = bitnot 0, sc_neg_vect = 0 }
+
+:: Sign =
+	{	pos_sign :: !Bool
+	,	neg_sign :: !Bool
+	}
+
+
+TopSign			:== { pos_sign = True,	neg_sign = True }
+BottomSign		:== { pos_sign = False,	neg_sign = False }
+PositiveSign	:== { pos_sign = True,	neg_sign = False }
+NegativeSign	:== { pos_sign = False,	neg_sign = True }
+
+signClassToSign :: !SignClassification !Int -> Sign
+
+/*
+IsPositive sign_class index :== sign_class.sc_pos_vect bitand (1 << index) <> 0
+IsNegative sign_class index :== sign_class.sc_neg_vect bitand (1 << index) <> 0
+*/
+instance <<< Sign
+
+::	TypeSign key =
+	{	ts_cons_var_signs	:: !key
+	,	ts_type_sign		:: !SignClassification
+	}
+
+::	TypeProp key =
+	{	ts_cons_var_props	:: !key
+	,	ts_type_prop		:: !PropClassification
+	}
+
+retrieveSignClassification :: ![SignClassification] !TypeClassification -> Optional (TypeSign [SignClassification])
+retrievePropClassification :: ![PropClassification] !TypeClassification -> Optional (TypeProp [PropClassification])
+
+addSignClassification :: ![SignClassification] !SignClassification !TypeClassification -> !TypeClassification
+addPropClassification :: ![PropClassification] !PropClassification !TypeClassification -> !TypeClassification
diff --git a/frontend/typeproperties.icl b/frontend/typeproperties.icl
new file mode 100644
index 0000000..267dfd8
--- /dev/null
+++ b/frontend/typeproperties.icl
@@ -0,0 +1,139 @@
+implementation module typeproperties
+
+import StdEnv
+
+import general, StdCompare
+
+::	TypeClassification = 
+	{	tc_signs	:: TypeSignTree
+	,	tc_props	:: TypePropTree
+	}
+
+::	SignClassification	=
+	{	sc_pos_vect	:: !BITVECT
+	,	sc_neg_vect	:: !BITVECT
+	}
+/*
+IsPositive sign_class index :== sign_class.sc_pos_vect bitand (1 << index) <> 0
+IsNegative sign_class index :== sign_class.sc_neg_vect bitand (1 << index) <> 0
+*/
+::	PropClassification	:== BITVECT
+
+TopSignClass	:== { sc_pos_vect = bitnot 0, sc_neg_vect = bitnot 0 }
+ArrowSignClass	:== { sc_pos_vect = 2, sc_neg_vect = 1 }
+PosSignClass	:== { sc_pos_vect = bitnot 0, sc_neg_vect = 0 }
+
+:: Sign =
+	{	pos_sign :: !Bool
+	,	neg_sign :: !Bool
+	}
+
+
+TopSign			:== { pos_sign = True,	neg_sign = True }
+BottomSign		:== { pos_sign = False,	neg_sign = False }
+PositiveSign	:== { pos_sign = True,	neg_sign = False }
+NegativeSign	:== { pos_sign = False,	neg_sign = True }
+
+::	TypeSign key =
+	{	ts_cons_var_signs	:: !key
+	,	ts_type_sign		:: !SignClassification
+	}
+
+::	TypeProp key =
+	{	ts_cons_var_props	:: !key
+	,	ts_type_prop		:: !PropClassification
+	}
+
+::	VarBind a key =
+	{	vb_number			:: !key
+	,	vb_value			:: !a
+	}
+
+::	TypeSignTree 	:== BinTree (TypeSign [SignClassification])
+::	TypePropTree 	:== BinTree (TypeProp [PropClassification])
+::	EnvTree	a 		:== BinTree (VarBind a Int)
+
+::	BinTree a = BT_Node !a !(BinTree a) !(BinTree a) | BT_Empty
+
+class key m :: (m a) -> a
+
+instance key TypeSign
+where
+	key {ts_cons_var_signs} = ts_cons_var_signs
+
+instance key TypeProp
+where
+	key {ts_cons_var_props} = ts_cons_var_props
+
+instance key (VarBind a)
+where
+	key {vb_number} = vb_number
+
+EmptyTypeClassification :: TypeClassification
+EmptyTypeClassification = { tc_signs = BT_Empty, tc_props = BT_Empty }
+
+treeInsert :: !k !(m k) !(BinTree (m k)) -> BinTree (m k) | =< k & key m
+treeInsert new_key el BT_Empty
+	= BT_Node el BT_Empty BT_Empty
+treeInsert new_key new_el tree=:(BT_Node el left right)
+	# cmp = new_key =< key el
+	| cmp == Smaller
+		= BT_Node el (treeInsert new_key new_el left) right
+		= BT_Node el left (treeInsert new_key new_el right)
+	
+treeRetrieve :: !k !(BinTree (m k)) -> !Optional (m k) | =< k & key m
+treeRetrieve search_key BT_Empty
+	= No
+treeRetrieve search_key tree=:(BT_Node el left right)
+	# cmp = search_key =< key el
+	| cmp == Equal
+		= Yes el
+	| cmp == Smaller
+		= treeRetrieve search_key left
+		= treeRetrieve search_key right
+
+signClassToSign :: !SignClassification !Int -> Sign
+signClassToSign {sc_pos_vect,sc_neg_vect} index
+	= { pos_sign = sc_pos_vect bitand (1 << index) <> 0, neg_sign = sc_neg_vect bitand (1 << index) <> 0}
+
+instance <<< Sign
+where
+	(<<<) file {pos_sign,neg_sign}
+		| pos_sign
+			| neg_sign
+				= file <<< "T"
+				= file <<< "+"
+		| neg_sign
+			= file <<< "-"
+			= file <<< "L"
+		
+instance =< SignClassification
+where
+	=< sc1 sc2
+		| sc1.sc_pos_vect == sc2.sc_pos_vect
+			| sc1.sc_neg_vect == sc2.sc_neg_vect
+				= Equal
+			| sc1.sc_neg_vect < sc2.sc_neg_vect
+				= Smaller
+				= Greater
+		| sc1.sc_pos_vect < sc2.sc_pos_vect
+			= Smaller
+			= Greater
+
+retrieveSignClassification :: ![SignClassification] !TypeClassification -> Optional (TypeSign [SignClassification])
+retrieveSignClassification cons_classes {tc_signs}
+	= treeRetrieve cons_classes tc_signs
+
+addSignClassification :: ![SignClassification] !SignClassification !TypeClassification -> !TypeClassification
+addSignClassification hio_signs sign_class tc=:{tc_signs}
+	= { tc & tc_signs = treeInsert hio_signs { ts_cons_var_signs = hio_signs, ts_type_sign = sign_class } tc_signs }
+
+retrievePropClassification :: ![PropClassification] !TypeClassification -> Optional (TypeProp [PropClassification])
+retrievePropClassification cons_classes {tc_props}
+	= treeRetrieve cons_classes tc_props
+
+addPropClassification :: ![PropClassification] !PropClassification !TypeClassification -> !TypeClassification
+addPropClassification hio_props prop_class tc=:{tc_props}
+	= { tc & tc_props = treeInsert hio_props { ts_cons_var_props = hio_props, ts_type_prop = prop_class } tc_props }
+
+
diff --git a/frontend/typesupport.dcl b/frontend/typesupport.dcl
new file mode 100644
index 0000000..703fb41
--- /dev/null
+++ b/frontend/typesupport.dcl
@@ -0,0 +1,39 @@
+definition module typesupport
+
+import checksupport, StdCompare
+
+from unitype import Coercions, CoercionTree, AttributePartition
+
+TypeError :: !String !mess !String !*ErrorAdmin -> *ErrorAdmin | <<< mess
+
+::	AttributeEnv	:== {! TypeAttribute }
+::	VarEnv 			:== {! Type }
+
+cleanSymbolType :: !Int !*TypeHeaps -> (!SymbolType, !*TypeHeaps)
+extendSymbolType :: !SymbolType !Int !*TypeHeaps -> (!SymbolType, !*TypeHeaps)
+
+cleanUpSymbolType :: !TempSymbolType ![TypeContext] !{! CoercionTree} !AttributePartition !*VarEnv !*AttributeEnv !*TypeHeaps !*ErrorAdmin
+	-> (!SymbolType, !*VarEnv, !*AttributeEnv, !*TypeHeaps, !*ErrorAdmin)
+
+expandTypeApplication :: ![ATypeVar] !TypeAttribute !Type ![AType] !TypeAttribute !*TypeHeaps -> (!Type, !*TypeHeaps)
+
+equivalent :: !SymbolType  !TempSymbolType !{# CommonDefs} !*AttributeEnv !*TypeHeaps -> (!Bool, !*AttributeEnv, !*TypeHeaps) 
+
+::	AttrCoercion =
+	{	ac_demanded	:: !Int
+	,	ac_offered	:: !Int
+	}
+
+::	TempSymbolType =
+	{	tst_args		:: ![AType]
+	,	tst_arity		:: !Int
+	,	tst_lifted		:: !Int
+	,	tst_result		:: !AType
+	,	tst_context		:: ![TypeContext]
+	,	tst_attr_env	:: ![AttrCoercion]
+	}
+
+class substitute a :: !a !u:TypeHeaps -> (!a, !u:TypeHeaps)
+
+instance substitute AType, Type, TypeContext, AttrInequality, [a] | substitute a
+instance <<< TempSymbolType
diff --git a/frontend/typesupport.icl b/frontend/typesupport.icl
new file mode 100644
index 0000000..6c9379f
--- /dev/null
+++ b/frontend/typesupport.icl
@@ -0,0 +1,755 @@
+implementation module typesupport
+
+import StdEnv, StdCompare
+import syntax, parse, check, unitype, utilities, RWSDebug
+
+::	Store	:== Int
+
+::	AttrCoercion =
+	{	ac_demanded	:: !Int
+	,	ac_offered	:: !Int
+	}
+
+::	TempSymbolType =
+	{	tst_args		:: ![AType]
+	,	tst_arity		:: !Int
+	,	tst_lifted		:: !Int
+	,	tst_result		:: !AType
+	,	tst_context		:: ![TypeContext]
+	,	tst_attr_env	:: ![AttrCoercion]
+	}
+
+class emptyValue a :: a
+
+instance emptyValue TypeAttribute
+where
+	emptyValue = TA_None
+	
+instance emptyValue Type
+where
+	emptyValue = TE
+
+
+lookUp :: !a !(Env a b) -> (!Bool, !b) | ==, toString a & emptyValue b
+lookUp elem_id [] 
+		= (False, emptyValue)
+lookUp elem_id [b : bs]
+	| elem_id == b.bind_src
+		= (True, b.bind_dst)
+		= lookUp elem_id bs
+
+simplifyTypeApplication :: !Type ![AType] -> Type
+simplifyTypeApplication (TA type_cons=:{type_arity} cons_args) type_args
+	= TA { type_cons & type_arity = type_arity + length type_args } (cons_args ++ type_args)
+simplifyTypeApplication (TV tv) type_args
+	= CV tv :@: type_args
+simplifyTypeApplication (CV tv :@: type_args1) type_args2
+	= CV tv :@: (type_args1 ++ type_args2)
+
+::	AttributeEnv	:== {! TypeAttribute }
+::	VarEnv 			:== {! Type }
+
+::	CleanUpState =
+	{	cus_var_env		:: !.VarEnv
+	,	cus_attr_env	:: !.AttributeEnv
+	,	cus_heaps		:: !.TypeHeaps
+	,	cus_var_store	:: !Int
+	,	cus_attr_store	:: !Int
+	,	cus_error		:: !.ErrorAdmin
+	}
+
+
+class clean_up a ::  !(!{! CoercionTree}, !AttributePartition) !a !*CleanUpState -> (!a, !*CleanUpState)
+
+instance clean_up AType
+where
+	clean_up coercions atype=:{at_attribute,at_type} cus
+		# (at_attribute, cus) = clean_up coercions at_attribute cus 
+		  (at_type, cus) = clean_up coercions at_type cus
+		= ({atype & at_attribute = at_attribute, at_type = at_type}, cus)
+
+attrIsUndefined TA_None = True
+attrIsUndefined _ 		= False
+
+varIsDefined TE		= False
+varIsDefined _ 		= True
+
+instance clean_up TypeAttribute
+where
+	clean_up coercions TA_Unique cus
+		= (TA_Unique, cus)
+	clean_up coercions TA_Multi cus
+		= (TA_Multi, cus)
+	clean_up (coercions, attr_part) tv=:(TA_TempVar av_number) cus=:{cus_attr_env,cus_heaps,cus_attr_store,cus_error}
+		# av_group_nr = attr_part.[av_number]
+		  coercion_tree = coercions.[av_group_nr]
+		| isNonUnique coercion_tree
+			= (TA_Multi, cus)
+		| isUnique coercion_tree
+			= (TA_Unique, cus)
+		#! attr = cus_attr_env.[av_group_nr]
+		| attrIsUndefined attr
+			# (av_info_ptr, th_attrs) = newPtr AVI_Empty cus_heaps.th_attrs
+			  new_attr_var = TA_Var { av_name = NewAttrVarId cus_attr_store, av_info_ptr = av_info_ptr }
+			= (new_attr_var, { cus & cus_attr_env = { cus_attr_env & [av_group_nr] = new_attr_var},
+					 cus_heaps = { cus_heaps & th_attrs = th_attrs }, cus_attr_store = inc cus_attr_store})
+			= (attr, cus)
+				
+instance clean_up Type
+where
+	clean_up coercions (TempV tv_number) cus=:{cus_var_env}
+		#! type = cus_var_env.[tv_number]
+		= cleanUpVariable type tv_number cus
+	clean_up coercions (TA tc types) cus
+		# (types, cus) = clean_up coercions types cus
+		= (TA tc types, cus)
+	clean_up coercions (argtype --> restype) cus
+		# (argtype, cus) = clean_up coercions argtype cus
+		  (restype, cus) = clean_up coercions restype cus
+		=  (argtype --> restype, cus)
+	clean_up coercions t=:(TB _) cus
+		=  (t, cus)
+	clean_up coercions (TempCV tempvar :@: types) cus
+		#! type = cus.cus_var_env.[tempvar]
+		# (type, cus) = cleanUpVariable type tempvar cus
+		  (types, cus) = clean_up coercions types cus
+		= (simplifyTypeApplication type types, cus)
+	clean_up coercions (TempQV qv_number) cus=:{cus_var_env,cus_error}
+		#! type = cus_var_env.[qv_number]
+		= cleanUpVariable type qv_number {cus & cus_error = existentialError cus_error}
+	clean_up coercions TE cus
+		= abort "unknown pattern in function clean_up"
+				
+instance clean_up [a] | clean_up a
+where
+	clean_up coercions l cus = mapSt (clean_up coercions) l cus
+
+cleanUpVariable TE tv_number cus=:{cus_heaps,cus_var_store,cus_var_env}
+	# (tv_info_ptr, th_vars) = newPtr TVI_Empty cus_heaps.th_vars
+	  new_var = TV { tv_name = NewVarId cus_var_store, tv_info_ptr = tv_info_ptr }
+	= (new_var, { cus & cus_var_env = { cus_var_env & [tv_number] = new_var},
+				cus_heaps = { cus_heaps & th_vars = th_vars }, cus_var_store = inc cus_var_store})
+cleanUpVariable (TLifted var) tv_number cus=:{cus_error}
+	= (TV var, { cus & cus_error = liftedError var cus_error})
+cleanUpVariable type tv_number cus
+	= (type, cus)
+
+class cleanUpClosed a :: !a !u:VarEnv -> (!Bool, !a, !u:VarEnv)
+
+instance cleanUpClosed AType
+where
+	cleanUpClosed atype=:{at_type} env
+		# (ok, at_type, env) = cleanUpClosed at_type env
+		= (ok, { atype & at_type = at_type}, env)
+
+instance cleanUpClosed Type
+where
+	cleanUpClosed (TempV tv_number) env
+		#! type = env.[tv_number]
+		= (varIsDefined type, type, env)
+	cleanUpClosed (TA tc types) env
+		# (ok, types, env) = cleanUpClosed types env
+		= (ok, TA tc types, env)
+	cleanUpClosed (argtype --> restype) env
+		# (ok, (argtype,res_type), env) = cleanUpClosed (argtype,restype) env
+		= (ok, argtype --> restype, env)
+	cleanUpClosed (TempCV tv_number :@: types) env
+		#! type = env.[tv_number]
+		| varIsDefined type
+			# (ok, types, env) = cleanUpClosed types env
+            = (ok, simplifyTypeApplication type types, env)
+			= (False, TempCV tv_number :@: types, env)
+	cleanUpClosed t env
+		= (True, t, env)
+
+instance cleanUpClosed (a,b) | cleanUpClosed a & cleanUpClosed b
+where
+	cleanUpClosed (x,y) env
+		# (ok_x, x, env) = cleanUpClosed x env
+		| ok_x
+			# (ok_y, y, env) = cleanUpClosed y env
+			= (ok_y, (x,y), env)
+		= (False, (x,y), env)
+
+instance cleanUpClosed [a] | cleanUpClosed a
+where
+	cleanUpClosed [] env
+		= (True, [], env)
+	cleanUpClosed [t:ts] env
+		# (ok, (t,ts), env) = cleanUpClosed (t,ts) env
+		= (ok, [t:ts], env)
+
+TypeError :: !String !mess !String !*ErrorAdmin -> *ErrorAdmin | <<< mess
+TypeError err_pref err_msg err_post err=:{ea_file,ea_loc}
+	| isEmpty ea_loc
+		# ea_file =  ea_file <<< "Type error: " <<< err_pref <<< ' ' <<< err_msg <<< ' ' <<< err_post <<< '\n'
+		= { err & ea_file = ea_file, ea_ok = False}
+		# ea_file =  ea_file <<< "Type error " <<< hd ea_loc <<< ": " <<< err_pref <<< ' ' <<< err_msg <<< ' ' <<< err_post <<< '\n'
+		= { err & ea_file = ea_file, ea_ok = False}
+		
+
+overloadingError class_symb err
+	= TypeError "internal overloading of class" class_symb "is unsolvable" err
+
+existentialError err
+	= TypeError "existential" "type variable" "appears in the derived type specification" err
+
+liftedError var err
+	= TypeError "type variable of type of lifted argument" var "appears in the specified type" err
+
+clean_up_type_contexts [] env error
+	= ([], env, error)
+clean_up_type_contexts [tc:tcs] env error
+	# (tcs, env, error) = clean_up_type_contexts tcs env error
+	  (ok_tc_types, tc_types, env) = cleanUpClosed tc.tc_types env
+	| ok_tc_types
+		= ([{ tc & tc_types = tc_types } : tcs], env, error)
+		= (tcs, env, overloadingError tc.tc_class.glob_object.ds_ident error)
+
+extendSymbolType :: !SymbolType !Int !*TypeHeaps -> (!SymbolType, !*TypeHeaps)
+extendSymbolType st=:{st_arity,st_args,st_vars,st_attr_vars} nr_of_extra_args type_heaps
+	| nr_of_extra_args > 0
+		# (st_args, (st_vars, st_attr_vars, type_heaps))
+			= newAttributedVariables nr_of_extra_args st_args (st_vars, st_attr_vars, type_heaps)
+		= ({ st & st_args = st_args, st_vars = st_vars, st_attr_vars = st_attr_vars, st_arity = st_arity + nr_of_extra_args }, type_heaps)
+		= (st, type_heaps)
+
+cleanSymbolType :: !Int !*TypeHeaps -> (!SymbolType, !*TypeHeaps)
+cleanSymbolType arity type_heaps
+	# (st_result, clean_state) = newAttributedVariable 0 ([], [], type_heaps)
+	  (st_args, (st_vars, st_attr_vars, type_heaps)) = newAttributedVariables arity [] clean_state
+	= ({ st_arity = arity, st_vars = st_vars , st_args = st_args, st_result = st_result, st_context = [],
+			st_attr_env = [], st_attr_vars = st_attr_vars }, type_heaps)
+
+newAttributedVariables var_number attributed_variables clean_state=:(_,_,_) /* Temporary hack */
+	| var_number == 0
+		= (attributed_variables, clean_state)
+		# (attributed_variable, clean_state) = newAttributedVariable var_number clean_state
+		= newAttributedVariables (dec var_number) [ attributed_variable : attributed_variables ] clean_state
+
+newAttributedVariable var_number (variables, attributes, type_heaps=:{th_vars,th_attrs})
+	# (tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars
+	  new_var = { tv_name = NewVarId var_number, tv_info_ptr = tv_info_ptr }
+	  (av_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs
+	  new_attr_var = { av_name = NewAttrVarId var_number, av_info_ptr = av_info_ptr }
+	= ({ at_annotation = AN_None, at_attribute = TA_Var new_attr_var, at_type = TV new_var},
+		([ new_var : variables ], [ new_attr_var : attributes ], { type_heaps & th_vars = th_vars, th_attrs = th_attrs }))
+
+cleanUpSymbolType :: !TempSymbolType ![TypeContext] !{! CoercionTree} !AttributePartition !*VarEnv !*AttributeEnv !*TypeHeaps !*ErrorAdmin
+	-> (!SymbolType, !*VarEnv, !*AttributeEnv, !*TypeHeaps, !*ErrorAdmin)
+cleanUpSymbolType tst=:{tst_arity,tst_args,tst_result,tst_context,tst_lifted} context coercions attr_part var_env attr_var_env heaps error
+	#! nr_of_temp_vars = size var_env
+	#! max_attr_nr = size attr_var_env
+	# cus = { cus_var_env = var_env, cus_attr_env = attr_var_env, cus_heaps = heaps,
+			  cus_var_store = 0, cus_attr_store = 0, cus_error = error }
+	  (lifted_args, cus=:{cus_var_env}) = clean_up (coercions,attr_part) (take tst_lifted tst_args) cus
+	  (lifted_vars, cus_var_env) = determine_type_vars nr_of_temp_vars [] cus_var_env
+	  (st_args, cus) = clean_up (coercions,attr_part) (drop tst_lifted tst_args) { cus & cus_var_env = cus_var_env }
+	  (st_result, {cus_var_env,cus_attr_env,cus_heaps,cus_error}) = clean_up (coercions,attr_part) tst_result cus
+	  (st_context, cus_var_env, error) = clean_up_type_contexts (tst_context ++ context) cus_var_env cus_error
+	  (st_vars, var_env) = determine_type_vars nr_of_temp_vars lifted_vars cus_var_env
+	  (attr_env, st_attr_vars, st_attr_env) = build_attribute_environment 0 max_attr_nr coercions cus_attr_env [] []
+	  st = {  st_arity = tst_arity, st_vars = st_vars , st_args = lifted_args ++ st_args, st_result = st_result, st_context = st_context,
+			st_attr_env = st_attr_env, st_attr_vars = st_attr_vars }
+	= (st,{ var_env & [i] = TE \\ i <- [0..nr_of_temp_vars - 1]}, { attr_env & [i] = TA_None \\ i <- [0..max_attr_nr - 1]}, cus_heaps, error)
+//			---> (tst, st)
+where
+	determine_type_var var_index (all_vars, var_env)
+		#! type = var_env.[var_index]
+		= case type of
+			TV var
+				-> ([var : all_vars], { var_env & [var_index] = TLifted var})
+			_
+				-> (all_vars, var_env)
+
+	determine_type_vars to_index all_vars var_env
+		= iFoldSt determine_type_var 0 to_index (all_vars, var_env)
+	
+	build_attribute_environment :: !Index !Index !{! CoercionTree} !*AttributeEnv ![AttributeVar] ![AttrInequality]
+		-> (!*AttributeEnv, ![AttributeVar], ![AttrInequality])
+	build_attribute_environment attr_group_index max_attr_nr coercions attr_env attr_vars inequalities
+		| attr_group_index == max_attr_nr
+			= (attr_env, attr_vars, inequalities)
+		#! attr = attr_env.[attr_group_index]
+		= case attr of
+			TA_Var attr_var
+				# (attr_env, inequalities) = build_inequalities attr_var coercions.[attr_group_index] coercions attr_env inequalities
+				-> build_attribute_environment (inc attr_group_index) max_attr_nr coercions attr_env [attr_var : attr_vars] inequalities
+			TA_None
+				-> build_attribute_environment (inc attr_group_index) max_attr_nr coercions attr_env attr_vars inequalities
+	
+	build_inequalities off_var (CT_Node dem_attr left right) coercions attr_env inequalities
+		# (attr_env, inequalities) = build_inequalities off_var left coercions attr_env inequalities
+		  (attr_env, inequalities) = build_inequalities off_var right coercions attr_env inequalities
+		#! attr = attr_env.[dem_attr]
+		= case attr of
+			TA_Var attr_var
+				| is_new_inequality attr_var off_var inequalities
+					-> (attr_env, [{ ai_demanded = attr_var, ai_offered = off_var } : inequalities]) 
+					-> (attr_env, inequalities)
+			TA_None
+				-> build_inequalities off_var coercions.[dem_attr] coercions attr_env inequalities
+	build_inequalities off_var tree coercions attr_env inequalities
+		= (attr_env, inequalities)
+
+	is_new_inequality dem_var off_var []
+		= True
+	is_new_inequality dem_var off_var [{ ai_demanded, ai_offered } : inequalities]
+		= (dem_var <> ai_demanded || off_var <> ai_offered) && is_new_inequality dem_var off_var inequalities
+	
+
+		
+/*
+	build_inequalities :: !AttributeVar !(Env Int TypeAttribute) !Int !{# Bool} !Int !Int ![AttrInequality] -> [AttrInequality]
+	build_inequalities off_var attr_var_env next_var_number dem_vars skip size inequalities
+		| next_var_number == size
+			= inequalities
+		| dem_vars.[next_var_number] && next_var_number <> skip
+			# (found, TA_Var dem_var) = lookUp next_var_number attr_var_env
+			| found
+				# inequalities = [ { ai_demanded = dem_var, ai_offered = off_var } : inequalities]
+				= build_inequalities off_var attr_var_env (inc next_var_number) dem_vars skip size inequalities
+				= build_inequalities off_var attr_var_env (inc next_var_number) dem_vars skip size inequalities
+			= build_inequalities off_var attr_var_env (inc next_var_number) dem_vars skip size inequalities
+
+clean_up_symbol_type :: !SymbolType ![TypeContext] !*ErrorAdmin -> (!SymbolType, !*ErrorAdmin)
+clean_up_symbol_type st=:{st_args,st_result,st_context} context error
+	# (st_args, var_env, attr_var_env, var_store, error) = clean_up_argument_types st_args [] [] 0 error
+	  (st_result, var_env, attr_var_env, var_store, error) = clean_up_result_type st_result var_env attr_var_env var_store error
+	  new_env = attr_var_env ++ var_env 
+	  (st_context, error) = clean_up_type_contexts (st_context ++ context) new_env error
+	= ({ st & st_vars = map (\bind=:{bind_dst = TV tv} -> tv) new_env, st_args = st_args, st_result = st_result, st_context = st_context }, error)
+
+
+clean_up_type type var_binds uq_var_binds var_store error
+	# (type, var_binds, new_uq_var_binds, var_store) = clean_up type var_binds [] var_store
+ 	  error = check_uq_vars new_uq_var_binds uq_var_binds error
+ 	| isEmpty new_uq_var_binds
+		= (type, var_binds, new_uq_var_binds ++ uq_var_binds, var_store, error)
+		= (TFA [ var \\ {bind_dst=TV var} <- new_uq_var_binds ] type, var_binds, new_uq_var_binds ++ uq_var_binds, var_store, error)
+		
+
+quantifiction_error err=:{ea_file}
+	# ea_file = ea_file <<< "Type error: Introduction of universal quantifier failed\n"
+	= { err & ea_file = ea_file}
+
+check_uq_vars [] uq_var_binds error = error
+check_uq_vars [b:bs] uq_var_binds error
+	# (found, var) = lookUp b.bind_src uq_var_binds 
+	| found 
+		= quantifiction_error error
+		= check_uq_vars bs uq_var_binds error
+
+clean_up_argument_types [] var_binds uq_var_binds var_store error
+	= ([], var_binds, uq_var_binds, var_store, error)
+clean_up_argument_types [t:ts] var_binds uq_var_binds var_store error
+	# (t, var_binds, uq_var_binds, var_store, error) = clean_up_type t var_binds uq_var_binds var_store error
+ 	  (ts, var_binds, uq_var_binds, var_store, error) = clean_up_argument_types ts var_binds uq_var_binds var_store error
+	= ([t:ts], var_binds, uq_var_binds, var_store, error)
+
+clean_up_result_type (argtype --> restype) var_binds uq_var_binds var_store error
+	# (argtype, var_binds, uq_var_binds, var_store, error) = clean_up_type argtype var_binds uq_var_binds var_store error
+	  (restype, var_binds, uq_var_binds, var_store, error) = clean_up_result_type restype var_binds uq_var_binds var_store error
+	= (argtype --> restype, var_binds, uq_var_binds, var_store, error)
+clean_up_result_type type var_binds uq_var_binds var_store error
+	# (type, var_binds, new_uq_var_binds, var_store) = clean_up type var_binds [] var_store
+ 	  error = check_uq_vars new_uq_var_binds uq_var_binds error
+	= (type, var_binds, new_uq_var_binds, var_store, error)
+
+*/
+
+	
+class substitute a :: !a !u:TypeHeaps -> (!a, !u:TypeHeaps)
+
+instance substitute AType
+where
+	substitute atype=:{at_attribute,at_type} heaps
+		# ((at_attribute,at_type), heaps)  = substitute (at_attribute,at_type) heaps
+		= ({ atype & at_attribute = at_attribute, at_type = at_type }, heaps)
+
+instance substitute TypeAttribute
+where
+	substitute (TA_Var {av_name, av_info_ptr}) heaps=:{th_attrs}
+		#! av_info = sreadPtr av_info_ptr th_attrs
+		# (AVI_Attr attr) = av_info
+		= (attr, heaps)
+	substitute TA_None heaps
+		= (TA_Multi, heaps)
+	substitute attr heaps
+		= (attr, heaps)
+
+instance substitute (a,b) | substitute a & substitute b
+where
+	substitute (x,y) heaps
+		# (x, heaps) = substitute x heaps
+		  (y, heaps) = substitute y heaps
+		= ((x,y), heaps)
+	
+instance substitute [a] | substitute a
+where
+	substitute [] heaps
+		= ([], heaps)
+	substitute [t:ts] heaps
+		# (t, heaps) = substitute t heaps
+		  (ts, heaps) = substitute ts heaps
+		= ([t:ts], heaps)
+
+
+instance substitute TypeContext
+where
+	substitute tc=:{tc_types} heaps
+		# (tc_types, heaps) = substitute tc_types heaps
+		= ({ tc & tc_types = tc_types }, heaps)
+
+substituteTypeVariable {tv_name,tv_info_ptr} heaps=:{th_vars}
+	#! tv_info = sreadPtr tv_info_ptr th_vars
+	= case tv_info of
+		TVI_Type type
+			-> (type, heaps)
+		_
+			-> abort ("Error in substitute (Type)" ---> (tv_info, tv_name))
+
+instance substitute Type
+where
+	substitute (TV tv) heaps
+		= substituteTypeVariable tv heaps
+	substitute (arg_type --> res_type)  heaps
+		# ((arg_type, res_type), heaps) = substitute (arg_type, res_type) heaps
+		= (arg_type --> res_type, heaps)
+	substitute (TA cons_id cons_args)  heaps
+		# (cons_args, heaps) = substitute cons_args heaps
+		= (TA cons_id cons_args,  heaps)
+	substitute (CV type_var :@: types)  heaps
+		# (type, heaps) = substituteTypeVariable type_var heaps
+		  (types, heaps) = substitute types heaps
+		= (simplifyTypeApplication type types, heaps)
+	substitute type heaps
+		= (type, heaps)
+
+instance substitute AttributeVar
+where
+	substitute {av_info_ptr} heaps=:{th_attrs}
+		#! av_info = sreadPtr av_info_ptr th_attrs
+		# (AVI_Attr (TA_Var attr_var)) = av_info
+		= (attr_var, heaps)
+
+instance substitute AttrInequality
+where
+	substitute {ai_demanded,ai_offered} heaps
+		# ((ai_demanded, ai_offered), heaps) = substitute (ai_demanded, ai_offered) heaps
+		= ({ai_demanded = ai_demanded, ai_offered = ai_offered}, heaps)
+
+expandTypeApplication :: ![ATypeVar] !TypeAttribute !Type ![AType] !TypeAttribute !*TypeHeaps -> (!Type, !*TypeHeaps)
+expandTypeApplication type_args form_attr type_rhs arg_types act_attr type_heaps=:{th_attrs}
+	# th_attrs = bind_attr form_attr act_attr th_attrs 
+	= substitute type_rhs (fold2St bind_type_and_attr type_args arg_types { type_heaps & th_attrs = th_attrs })
+where
+	bind_type_and_attr {atv_attribute = TA_Var {av_name,av_info_ptr}, atv_variable={tv_info_ptr}} {at_attribute,at_type} {th_vars,th_attrs}
+		= { th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type), th_attrs = th_attrs <:= (av_info_ptr, AVI_Attr at_attribute) }
+	bind_type_and_attr {atv_variable={tv_info_ptr}} {at_type} type_heaps=:{th_vars}
+		= { type_heaps & th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type) }
+
+	bind_attr (TA_Var {av_name,av_info_ptr}) attr th_attrs
+		= th_attrs <:= (av_info_ptr, AVI_Attr attr) 
+	bind_attr _ attr th_attrs
+		= th_attrs
+		
+
+VarIdTable :: {# String}
+VarIdTable =: { "a", "b", "c", "d", "e", "f", "g", "h", "i", "j" }
+
+newIdent id_name
+	:== { id_name = id_name, id_info = nilPtr }
+	
+NewVarId var_store
+	| var_store < size VarIdTable
+		= newIdent VarIdTable.[var_store]
+		= newIdent ("v" +++ toString var_store)
+ 
+AttrVarIdTable :: {# String}
+AttrVarIdTable =: { "u", "v", "w", "x", "y", "z" }
+
+NewAttrVarId attr_var_store
+	| attr_var_store < size AttrVarIdTable
+ 		= newIdent AttrVarIdTable.[attr_var_store]
+		= newIdent ("u" +++ toString attr_var_store)
+
+
+
+instance == AttributeVar
+where
+	(==) av1 av2 = av1.av_info_ptr == av2.av_info_ptr 
+
+
+/*	
+class equiv a :: !a !a !*VarEnv !*AttributeEnv  -> (!Bool, !*VarEnv, !*AttributeEnv)
+
+instance equiv AType
+where
+	equiv atype1 atype2 var_env attr_env
+		# (ok, attr_env) = equi_attrs atype1.at_attribute atype2.at_attribute attr_env
+		| ok
+			= equiv atype1.at_type atype2.at_type var_env attr_env
+			= (False, var_env, attr_env)
+	where
+		equi_attrs (TA_TempVar av_number) attr=:(TA_Var attr_var) attr_env
+			#! forw_attr = attr_env.[av_number]
+			= case forw_attr of
+				TA_None
+					-> (True, { attr_env & [av_number] = attr})
+			  	TA_Var forw_var
+			  		-> (forw_var == attr_var, attr_env)
+			  	_
+			  		-> abort "Error in equiv (AType)"
+		equi_attrs attr1 attr2 attr_env
+			= (attr1 == attr2, attr_env)
+		
+instance equiv Type
+where
+	equiv (TempV tv_number) type=:(TV var) var_env attr_env
+		#! forw_type = var_env.[tv_number]
+		= case forw_type of
+			TE
+				-> (True, { var_env & [tv_number] = type }, attr_env)
+			TV forw_var
+				-> (forw_var == var, var_env, attr_env)
+			_
+				-> abort "Error in equiv (Type)"
+	equiv (arg_type1 --> restype1) (arg_type2 --> restype2) var_env attr_env
+		= equiv (arg_type1,restype1) (arg_type2,restype2) var_env attr_env
+	equiv (TA tc1 types1) (TA tc2 types2) var_env attr_env
+		| tc1 == tc2
+			= equiv types1 types2 var_env attr_env
+			= (False, var_env, attr_env)
+	equiv (TB basic1) (TB basic2) var_env attr_env
+		= (basic1 == basic2, var_env, attr_env)
+	equiv (type1 :@: types1) (type2 :@: types2) var_env attr_env
+		= equiv (type1,types1) (type2,types2) var_env attr_env
+/*	equiv (TFA vars type1) type2 var_env attr_env
+		= equiv type1 type2 var_env attr_env
+	equiv type1 (TFA vars type2) var_env attr_env
+		= equiv type1 type2 var_env attr_env
+	equiv (TQV _) (TV _) var_env attr_env
+		= (True, var_env attr_env)
+*/
+	equiv type1 type2 var_env attr_env
+		= (False, var_env, attr_env)
+
+instance equiv (a,b) | equiv a & equiv b
+where
+	equiv (x1,y1) (x2,y2) var_env attr_env
+		# (equi_x, var_env, attr_env) =  equiv x1 x2 var_env attr_env
+		| equi_x
+			= equiv y1 y2 var_env attr_env
+			= (False, var_env, attr_env)
+
+instance equiv [a] | equiv a
+where
+	equiv [x:xs] [y:ys] var_env attr_env
+		# (equi, var_env, attr_env) = equiv x y var_env attr_env
+		| equi
+		  	= equiv xs ys var_env attr_env
+			= (False, var_env, attr_env)
+	equiv [] [] var_env attr_env
+		= (True, var_env, attr_env)
+	equiv _ _ var_env attr_env
+		= (False, var_env, attr_env)
+*/
+
+class equiv a :: !a !a !*TypeHeaps -> (!Bool, !*TypeHeaps)
+
+instance equiv AType
+where
+	equiv atype1 atype2 heaps=:{th_attrs}
+		# (ok, th_attrs) = equi_attrs atype1.at_attribute atype2.at_attribute th_attrs
+		| ok
+			= equiv atype1.at_type atype2.at_type { heaps & th_attrs = th_attrs }
+			= (False, { heaps & th_attrs = th_attrs })
+
+	where
+		equi_attrs attr=:(TA_Var {av_info_ptr}) (TA_TempVar av_number) attr_var_heap
+			#! av_info = sreadPtr av_info_ptr attr_var_heap
+			= case av_info of
+				AVI_Forward forw_var_number
+					-> (forw_var_number == av_number, attr_var_heap)
+				_
+					-> (True, writePtr av_info_ptr (AVI_Forward av_number) attr_var_heap)
+		equi_attrs attr1 attr2 attr_env
+			= (attr1 == attr2, attr_env)
+
+equivTypeVars :: !TypeVar !TempVarId !*TypeHeaps -> (!Bool, !*TypeHeaps)
+equivTypeVars {tv_info_ptr} var_number heaps=:{th_vars}
+	#! tv_info = sreadPtr tv_info_ptr th_vars
+	= case tv_info of
+		TVI_Forward forw_var_number
+			-> (forw_var_number == var_number, heaps)
+		_
+			-> (True, { heaps & th_vars = writePtr tv_info_ptr (TVI_Forward var_number) heaps.th_vars })
+	
+
+instance equiv Type
+where
+	equiv (TV tv) (TempV var_number) heaps
+		= equivTypeVars tv var_number heaps
+	equiv (arg_type1 --> restype1) (arg_type2 --> restype2) heaps
+		= equiv (arg_type1,restype1) (arg_type2,restype2) heaps
+	equiv (TA tc1 types1) (TA tc2 types2) heaps
+		| tc1 == tc2
+			= equiv types1 types2 heaps
+			= (False, heaps)
+	equiv (TB basic1) (TB basic2) heaps
+		= (basic1 == basic2, heaps)
+	equiv (CV tv :@: types1) (TempCV var_number :@: types2) heaps
+		# (equi_vars, heaps) =  equivTypeVars tv var_number heaps
+		| equi_vars
+			= equiv types1 types2 heaps
+			= (False, heaps)
+/*	equiv (TFA vars type1) type2 heaps
+		= equiv type1 type2 heaps
+	equiv type1 (TFA vars type2) heaps
+		= equiv type1 type2 heaps
+	equiv (TQV _) (TV _) heaps
+		= (True, heaps)
+*/
+	equiv type1 type2 heaps
+		= (False, heaps)
+
+instance equiv (a,b) | equiv a & equiv b
+where
+	equiv (x1,y1) (x2,y2) heaps
+		# (equi_x, heaps) =  equiv x1 x2 heaps
+		| equi_x
+			= equiv y1 y2 heaps
+			= (False, heaps)
+
+instance equiv [a] | equiv a
+where
+	equiv [x:xs] [y:ys] heaps
+		# (equi, heaps) = equiv x y heaps
+		| equi
+		  	= equiv xs ys heaps
+			= (False, heaps)
+	equiv [] [] heaps
+		= (True, heaps)
+	equiv _ _ heaps
+		= (False, heaps)
+
+equivalent :: !SymbolType  !TempSymbolType !{# CommonDefs}  !*AttributeEnv !*TypeHeaps -> (!Bool, !*AttributeEnv, !*TypeHeaps) 
+equivalent {st_args,st_result,st_context,st_attr_env} {tst_args,tst_result,tst_context,tst_attr_env,tst_lifted} defs attr_env heaps
+	#! nr_of_temp_attrs = size attr_env
+	# (ok, heaps) = equiv (drop tst_lifted st_args,st_result) (drop tst_lifted tst_args,tst_result) heaps
+	| ok
+		# (ok, heaps) = equivalent_list_of_contexts st_context tst_context defs heaps
+		| ok
+			# (ok, attr_env, attr_var_heap) = equivalent_environments st_attr_env (fill_environment tst_attr_env attr_env) heaps.th_attrs
+			= (ok, clear_environment tst_attr_env attr_env, { heaps & th_attrs = attr_var_heap })
+			= (False, attr_env, heaps)
+		= (False, attr_env, heaps)
+where
+	equivalent_list_of_contexts [] contexts defs heaps 
+		= (True, heaps)
+	equivalent_list_of_contexts [tc : tcs] contexts defs heaps 
+		# (ok, heaps) = contains_context tc contexts defs heaps
+		| ok
+			= equivalent_list_of_contexts tcs contexts defs heaps
+			= (False, heaps)
+
+	contains_context tc1 [tc2 : tcs] defs heaps
+		# (ok, heaps) = equivalent_contexts tc1 tc2 defs heaps
+		| ok
+			= (True, heaps)
+			= contains_context tc1 tcs defs heaps
+	contains_context tc1 [] defs heaps
+		= (False, heaps)
+	
+	equivalent_contexts tc {tc_class,tc_types} defs heaps
+		| tc_class == tc.tc_class
+			= equiv tc.tc_types tc_types heaps
+		# {glob_object={ds_index},glob_module} = tc_class
+		#! class_def = defs.[glob_module].com_class_defs.[ds_index]
+		# {class_context,class_args} = class_def
+		| isEmpty class_context
+			= (False, heaps)
+		# th_vars = bind_class_args class_args tc_types heaps.th_vars
+		= equivalent_superclasses class_context tc defs { heaps & th_vars = th_vars }
+	where	
+		bind_class_args [{tv_info_ptr} : vars] [type : types] type_var_heap
+			= bind_class_args vars types (writePtr tv_info_ptr (TVI_Type type) type_var_heap)
+		bind_class_args [] [] type_var_heap
+			= type_var_heap
+	
+		equivalent_superclasses [] tc defs heaps
+			= (False, heaps)
+		equivalent_superclasses [super_tc=:{tc_types} : tcs] tc defs heaps=:{th_vars}
+			# (tc_types, th_vars) = retrieve_types tc_types th_vars
+			  (ok, heaps) = equivalent_contexts { super_tc & tc_types = tc_types } tc defs { heaps & th_vars = th_vars }
+			| ok
+				= (True, heaps)
+				= equivalent_superclasses tcs tc defs heaps
+		where
+			retrieve_types [TV {tv_info_ptr} : types] type_var_heap
+				#! (tv_info, type_var_heap) = readPtr tv_info_ptr type_var_heap
+				#  (TVI_Type type) = tv_info
+				#! (types, type_var_heap) = retrieve_types types type_var_heap
+				= ([type : types], type_var_heap)
+			retrieve_types [type : types] type_var_heap
+				#! (types, type_var_heap) = retrieve_types types type_var_heap
+				= ([type : types], type_var_heap)
+			retrieve_types [] type_var_heap
+				= ([], type_var_heap)
+		
+
+	fill_environment :: ![AttrCoercion] !*{! TypeAttribute} -> *{! TypeAttribute}
+	fill_environment [] attr_env
+		= attr_env
+	fill_environment [{ac_demanded,ac_offered} : coercions ] attr_env
+		#! offered = attr_env.[ac_demanded]
+		=  fill_environment coercions { attr_env & [ac_demanded] = TA_List ac_offered offered }
+
+	clear_environment :: ![AttrCoercion] !*{! TypeAttribute} -> *{! TypeAttribute}
+	clear_environment [] attr_env
+		= attr_env
+	clear_environment [{ac_demanded,ac_offered} : coercions ] attr_env
+		= clear_environment coercions { attr_env & [ac_demanded] = TA_None }
+	
+	equivalent_environments :: ![AttrInequality] !u:{!TypeAttribute} !v:AttrVarHeap -> (!Bool, !u:{!TypeAttribute}, !v:AttrVarHeap)
+	equivalent_environments [] attr_env attr_heap
+		= (True, attr_env, attr_heap)
+	equivalent_environments [{ai_demanded,ai_offered} : coercions ] attr_env attr_heap
+		#! av_info = sreadPtr ai_demanded.av_info_ptr attr_heap
+		# (AVI_Forward demanded_var_number) = av_info
+		#! av_info = sreadPtr ai_offered.av_info_ptr attr_heap
+		# (AVI_Forward offered_var_number) = av_info
+		#! offered_of_demanded = attr_env.[demanded_var_number]
+		# (succ, attr_env) = contains_coercion offered_var_number offered_of_demanded attr_env
+		| succ
+			= equivalent_environments coercions attr_env attr_heap
+			= (False, attr_env, attr_heap)
+
+	contains_coercion :: !Int !TypeAttribute !u:{! TypeAttribute} -> (!Bool,!u:{!TypeAttribute});
+	contains_coercion offered TA_None attr_env
+		= (False, attr_env)
+	contains_coercion offered (TA_List this_offered next_offered) attr_env
+		| offered == this_offered
+			= (True, attr_env)
+		#! offered_of_offered = attr_env.[this_offered]
+		# (succ, attr_env) = contains_coercion offered offered_of_offered attr_env
+		| succ
+			= (True, attr_env)
+			= contains_coercion offered next_offered attr_env
+
+instance <<< TypeContext
+where
+	(<<<) file tc = file <<< tc.tc_class.glob_object.ds_ident <<< ' ' <<< tc.tc_types
+
+instance <<< AttrCoercion
+where
+	(<<<) file {ac_demanded,ac_offered} = file <<< ac_demanded <<< " <= " <<< ac_offered
+	
+instance <<< TempSymbolType
+where
+	(<<<) file {tst_args, tst_result, tst_context, tst_attr_env }
+		| isEmpty tst_args
+			= file <<< tst_result <<< " | " <<< tst_context <<< " [" <<< tst_attr_env <<< ']'
+			= file <<< tst_args <<< " -> " <<< tst_result <<< " | " <<< tst_context <<< " [" <<< tst_attr_env <<< ']'
+
diff --git a/frontend/unitype.dcl b/frontend/unitype.dcl
new file mode 100644
index 0000000..3769c19
--- /dev/null
+++ b/frontend/unitype.dcl
@@ -0,0 +1,48 @@
+definition module unitype
+
+import StdEnv
+import syntax, analunitypes
+
+::	CoercionPosition =
+	{	cp_expression	:: !Expression
+	}
+
+AttrUni			:== 0
+AttrMulti		:== 1
+FirstAttrVar	:== 2
+
+instance toInt TypeAttribute
+
+::	CoercionTree	= CT_Node !Int !CoercionTree !CoercionTree | CT_Empty | CT_Unique | CT_NonUnique  /* | CT_Existential !Int */
+
+::	Coercions		= { coer_demanded :: !.{! .CoercionTree}, coer_offered :: !.{! .CoercionTree }}
+
+isNonUnique 	:: !CoercionTree -> Bool
+isUnique		:: !CoercionTree -> Bool
+// isExistential	:: !CoercionTree -> Bool
+
+::	BOOLVECT :== Int
+
+BITINDEX temp_var_id :== temp_var_id >> 5
+BITNUMBER temp_var_id :== temp_var_id bitand 31
+
+determineAttributeCoercions :: !AType !AType !Bool !CoercionPosition !u:{! Type} !*Coercions !{# CommonDefs } 
+	!{# BOOLVECT } !*TypeDefInfos !*TypeHeaps !*ErrorAdmin
+		-> (!u:{! Type}, !*Coercions, !*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin) 
+
+::	AttributePartition	:== {# Int}
+
+partitionateAttributes :: !{! CoercionTree} !{! *CoercionTree} -> (!AttributePartition, !{! CoercionTree})
+
+newInequality :: !Int !Int !*Coercions -> *Coercions
+
+tryToMakeNonUnique :: !Int !*Coercions -> (!Bool, !*Coercions)
+
+tryToMakeUnique :: !Int !*Coercions -> (!Bool, !*Coercions)
+
+uniquenessError :: !CoercionPosition !String !*ErrorAdmin -> *ErrorAdmin
+
+liftSubstitution :: !*{! Type} !{# CommonDefs } !Int !*TypeVarHeap !*TypeDefInfos -> (*{! Type}, !Int, !*TypeVarHeap, !*TypeDefInfos)
+
+instance <<< CoercionPosition
+
diff --git a/frontend/unitype.icl b/frontend/unitype.icl
new file mode 100644
index 0000000..dce6a68
--- /dev/null
+++ b/frontend/unitype.icl
@@ -0,0 +1,795 @@
+implementation module unitype
+
+import StdEnv
+
+import syntax, analunitypes, type, utilities
+
+::	CoercionPosition =
+	{	cp_expression	:: !Expression
+	}
+
+AttrUni			:== 0
+AttrMulti		:== 1
+FirstAttrVar	:== 2
+
+::	CoercionTree	= CT_Node !Int !CoercionTree !CoercionTree | CT_Empty | CT_Unique | CT_NonUnique /* | CT_Existential !Int */
+
+::	Coercions		= { coer_demanded :: !.{! .CoercionTree}, coer_offered :: !.{! .CoercionTree }}
+
+::	AttributePartition :== {# Int}
+
+::	PartitioningInfo = 
+	{	pi_marks :: 		!.AttributePartition
+	,	pi_next_num ::		!Int
+	,	pi_groups ::		![[Int]]
+	,	pi_deps ::			![Int]
+	}
+
+uniquenessError :: !CoercionPosition !String !*ErrorAdmin -> *ErrorAdmin
+uniquenessError position mess err=:{ea_file,ea_loc}
+	# ea_file = ea_file <<< "Uniqueness error " <<< hd ea_loc <<< ": \"" <<<  position <<< '\"' <<< mess <<< '\n'
+	= { err & ea_file = ea_file, ea_ok = False}
+
+::	BOOLVECT :== Int
+
+BITINDEX temp_var_id :== temp_var_id >> 5
+BITNUMBER temp_var_id :== temp_var_id bitand 31
+
+isPositive :: !TempVarId !{# BOOLVECT } -> Bool
+isPositive var_id cons_vars
+	= cons_vars.[BITINDEX var_id] bitand (1 << BITNUMBER var_id) <> 0
+
+determineAttributeCoercions :: !AType !AType !Bool !CoercionPosition !u:{! Type} !*Coercions !{# CommonDefs } 
+	!{# BOOLVECT } !*TypeDefInfos !*TypeHeaps !*ErrorAdmin
+		-> (!u:{! Type}, !*Coercions, !*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin) 
+determineAttributeCoercions off_type dem_type coercible position subst coercions defs cons_vars td_infos type_heaps error
+	# (exp_off_type, es) = expandType defs cons_vars off_type (subst, { es_type_heaps = type_heaps, es_td_infos = td_infos})
+	  (exp_dem_type, (subst, {es_td_infos,es_type_heaps})) = expandType defs cons_vars dem_type es
+	  (ok, {crc_type_heaps, crc_coercions, crc_td_infos}) = coerce defs cons_vars exp_off_type exp_dem_type (if coercible PositiveSign TopSign)
+	  		 { crc_type_heaps = es_type_heaps, crc_coercions = coercions, crc_td_infos = es_td_infos}
+	| ok
+		= (subst, crc_coercions, crc_td_infos, crc_type_heaps, error)
+//					---> ("OK", off_type, exp_off_type, dem_type, exp_dem_type)
+		= (subst, crc_coercions, crc_td_infos, crc_type_heaps, uniquenessError position " invalid coercion" error)
+					---> (off_type, exp_off_type, dem_type, exp_dem_type)
+
+NotChecked :== -1	
+DummyAttrNumber :== -1
+::	AttributeGroups	:== {! [Int]}
+
+partitionateAttributes :: !{! CoercionTree} !{! *CoercionTree} -> (!AttributePartition, !{! CoercionTree})
+partitionateAttributes coer_offered coer_demanded
+	#! max_attr_nr = size coer_offered
+	# partitioning_info = { pi_marks = createArray max_attr_nr NotChecked, pi_deps = [], pi_next_num = 0, pi_groups = [] }
+	# {pi_marks,pi_groups} = partitionate_attributes FirstAttrVar max_attr_nr coer_offered partitioning_info
+	  (nr_of_groups, groups) = reverse_and_length pi_groups 0 []
+	  partition = build_partition 0 groups pi_marks
+	# demanded = { CT_Empty \\ i <- [0 .. nr_of_groups - 1] }
+	= (partition, adjust_coercions 0 groups partition coer_offered coer_demanded demanded)
+where
+	visit_attributes :: !CoercionTree !Int !Int !{! CoercionTree} !*PartitioningInfo -> *(!Int, !*PartitioningInfo)
+	visit_attributes (CT_Node attr left right) max_attr_nr min_dep coer_offered pi=:{pi_marks}
+		#! mark = pi_marks.[attr]
+		| mark == NotChecked
+			# (mark, pi) = partitionate_attribute attr max_attr_nr coer_offered pi
+			  (min_dep, pi) = visit_attributes left max_attr_nr (min min_dep mark)  coer_offered pi
+			= visit_attributes right max_attr_nr min_dep coer_offered pi
+		# (min_dep, pi) = visit_attributes left max_attr_nr (min min_dep mark) coer_offered pi
+		= visit_attributes right max_attr_nr min_dep coer_offered pi
+	visit_attributes tree max_attr_nr min_dep coer_offered pi
+		= (min_dep, pi)
+	
+	reverse_and_length :: ![a] !Int ![a] -> (!Int, ![a])
+	reverse_and_length [] length list = (length, list)
+	reverse_and_length [ x : xs ] length list = reverse_and_length xs (inc length) [x : list]
+	
+ 	partitionate_attributes :: !Int !Int !{!CoercionTree} !*PartitioningInfo -> *PartitioningInfo
+	partitionate_attributes from_index max_attr_nr coer_offered pi=:{pi_marks}
+		| from_index == max_attr_nr
+			= pi
+		| pi_marks.[from_index] == NotChecked
+			# (_, pi) = partitionate_attribute from_index max_attr_nr coer_offered pi
+			= partitionate_attributes (inc from_index) max_attr_nr coer_offered pi
+		= partitionate_attributes (inc from_index) max_attr_nr coer_offered pi
+
+	partitionate_attribute :: !Int !Int !{!CoercionTree} !*PartitioningInfo -> *(!Int, !*PartitioningInfo)
+	partitionate_attribute attr max_attr_nr coer_offered=:{ [attr] = off_attributes } pi=:{pi_next_num}
+		# (min_dep, pi) = visit_attributes off_attributes max_attr_nr max_attr_nr coer_offered (push_on_dep_stack attr pi)
+		= try_to_close_group attr pi_next_num min_dep max_attr_nr pi
+	where		
+		push_on_dep_stack attr pi=:{pi_deps,pi_marks,pi_next_num}
+			= { pi & pi_deps = [attr : pi_deps], pi_marks = { pi_marks & [attr] = pi_next_num }, pi_next_num = inc pi_next_num}
+
+		try_to_close_group attr attr_nr min_dep max_attr_nr pi=:{pi_marks, pi_deps, pi_groups}
+			| attr_nr <= min_dep
+				# (pi_deps, pi_marks, group) = close_group attr pi_deps pi_marks [] max_attr_nr
+				= (max_attr_nr, { pi & pi_deps = pi_deps, pi_marks = pi_marks, pi_groups = [group : pi_groups] })
+				= (min_dep, pi)
+		where
+			close_group attr [d:ds] marks group max_attr_nr
+				# marks = { marks & [d] = max_attr_nr }
+				| d == attr
+					= (ds, marks, [d : group])
+					= close_group attr ds marks [d : group] max_attr_nr
+
+	build_partition group_nr [] partition
+		= partition
+	build_partition group_nr [group : groups] partition
+		= build_partition (inc group_nr) groups (build_partition_of_group group_nr group partition)
+	where
+		build_partition_of_group group_nr [attr : attrs] partition
+			= build_partition_of_group group_nr attrs { partition & [attr] = group_nr }
+		build_partition_of_group group_nr [] partition
+			= partition
+
+	adjust_coercions group_index [group : groups] partition coer_offered coer_demanded demanded
+		# (combined_tree, coer_demanded) = combine_coercion_trees group_index group partition CT_Empty coer_offered coer_demanded
+		= adjust_coercions (inc group_index) groups partition coer_offered coer_demanded { demanded & [ group_index ] = combined_tree }
+	adjust_coercions group_index [] partition coer_offered coer_demanded demanded
+		= demanded
+
+	combine_coercion_trees group_index [ attr : attrs ] partition merged_tree coer_offered coer_demanded
+		| isNonUnique coer_offered.[attr]
+			= (CT_NonUnique, coer_demanded)
+/*		| isExistential coer_offered.[attr]
+			= (CT_Existential DummyAttrNumber, coer_demanded)
+*/		# (next_tree, coer_demanded) = replace coer_demanded attr CT_Empty
+		| isUnique next_tree
+			= (CT_Unique, coer_demanded)
+			# merged_tree = rebuild_tree group_index partition next_tree merged_tree
+			= combine_coercion_trees group_index attrs partition merged_tree coer_offered coer_demanded
+	combine_coercion_trees group_index [ ] partition merged_tree coer_offered coer_demanded
+		= (merged_tree, coer_demanded)
+		
+
+	rebuild_tree :: !Index !AttributePartition !*CoercionTree !*CoercionTree -> *CoercionTree
+	rebuild_tree group_index partition (CT_Node attr left right) tree
+		# tree = rebuild_tree group_index partition left tree
+		  tree = rebuild_tree group_index partition right tree
+		#! attr_nr = partition.[attr]
+		| attr_nr == group_index
+			= tree
+		# { tree } = insert partition.[attr] tree
+		= tree	
+	where
+		insert ::  !Int !*CoercionTree -> *CoercionTreeRecord
+		insert new_attr CT_Empty
+			=  { tree = CT_Node new_attr CT_Empty CT_Empty }
+		insert new_attr (CT_Node this_attr ct_less ct_greater)
+			| new_attr < this_attr
+				# { tree } = insert new_attr ct_less
+				= { tree = CT_Node this_attr tree ct_greater }
+			| new_attr > this_attr
+				# { tree } = insert new_attr ct_greater
+				= { tree = CT_Node this_attr ct_less tree }
+				= { tree = CT_Node this_attr ct_less ct_greater }
+	rebuild_tree group_index partition empty_tree tree
+		= tree
+
+::	CoercionTreeRecord = { tree :: !.CoercionTree }
+
+
+liftSubstitution :: !*{! Type} !{# CommonDefs } !Int !*TypeVarHeap !*TypeDefInfos -> (*{! Type}, !Int, !*TypeVarHeap, !*TypeDefInfos)
+liftSubstitution subst modules attr_store type_var_heap td_infos 
+	# ls = { ls_next_attr = attr_store, ls_td_infos = td_infos, ls_type_var_heap = type_var_heap}
+	= lift_substitution 0 modules subst ls
+where
+	lift_substitution var_index modules subst ls
+		| var_index < size subst
+			#! type = subst.[var_index]
+			# (type, _, _, subst, ls) = lift modules type subst ls
+			= lift_substitution (inc var_index) modules { subst & [var_index] = type } ls
+			= (subst, ls.ls_next_attr, ls.ls_type_var_heap, ls.ls_td_infos)
+
+adjustSignClass :: !SignClassification !Int -> SignClassification
+adjustSignClass {sc_pos_vect,sc_neg_vect} arity
+	= { sc_pos_vect = sc_pos_vect >> arity, sc_neg_vect = sc_neg_vect >> arity }
+
+// adjustPropClass :: !PropClassification !Int -> PropClassification
+adjustPropClass prop_class arity :== prop_class >> arity
+
+::	LiftState = 
+	{	ls_next_attr		:: !Int
+	,	ls_type_var_heap	:: !.TypeVarHeap
+	,	ls_td_infos			:: !.TypeDefInfos
+	}
+
+
+liftTempTypeVariable :: !{# CommonDefs } !TempVarId !*{! Type} !*LiftState
+	-> (!Type, !SignClassification, !PropClassification, !*{! Type}, !*LiftState)
+liftTempTypeVariable modules tv_number subst ls
+	#! type = subst.[tv_number]
+	= case type of
+		TE	-> (TempV tv_number, TopSignClass, PropClass, subst, ls)
+		_	-> lift modules type subst ls
+
+class lift a :: !{# CommonDefs } !a !*{! Type} !*LiftState
+	-> (!a, !SignClassification, !PropClassification, !*{! Type}, !*LiftState)
+
+
+instance lift Type
+where
+	lift modules (TempV tv_number) subst ls
+		= liftTempTypeVariable modules tv_number subst ls
+	lift modules (arg_type --> res_type) subst ls
+		# (arg_type, _, _, subst, ls) = lift modules arg_type subst ls
+		  (res_type, _, _, subst, ls) = lift modules res_type subst ls
+		= (arg_type --> res_type, BottomSignClass, NoPropClass, subst, ls)
+	lift modules (TA cons_id=:{type_index={glob_object,glob_module},type_arity} cons_args) subst ls
+		# (cons_args, sign_classes, prop_classes, subst, ls) = lift_list modules cons_args subst ls
+		  (type_prop, ls_type_var_heap, ls_td_infos) = typeProperties glob_object glob_module sign_classes prop_classes modules ls.ls_type_var_heap ls.ls_td_infos
+		= (TA  { cons_id & type_prop = type_prop } cons_args,
+					adjustSignClass type_prop.tsp_sign type_arity, adjustPropClass type_prop.tsp_propagation type_arity,
+			subst, { ls & ls_td_infos = ls_td_infos, ls_type_var_heap = ls_type_var_heap})
+	lift modules (TempCV temp_var :@: types) subst ls
+		# (type, sign_class, prop_class, subst, ls) = liftTempTypeVariable modules temp_var subst ls
+		  (types, _, _, subst, ls) = lift_list modules types subst ls
+		= case type of
+			TA type_cons cons_args
+				# nr_of_new_args = length types
+				-> (TA { type_cons & type_arity = type_cons.type_arity + nr_of_new_args } (cons_args ++ types),
+						adjustSignClass sign_class nr_of_new_args, adjustPropClass prop_class nr_of_new_args, subst, ls)
+			TempV tv_number
+				-> (TempCV tv_number :@: types, TopSignClass, PropClass, subst, ls)
+			cons_var :@: cv_types
+				-> (cons_var :@: (cv_types ++ types), TopSignClass, PropClass, subst, ls)
+	lift modules type subst ls
+		= (type, BottomSignClass, NoPropClass,  subst, ls)
+	
+instance lift AType
+where
+	lift modules attr_type=:{at_attribute,at_type} subst ls
+		# (at_type, sign_class, prop_class, subst, ls) = lift modules at_type subst ls
+		| type_is_non_coercible at_type
+			= ({attr_type & at_type = at_type}, sign_class, prop_class, subst, ls)
+			= ({attr_type & at_attribute = TA_TempVar ls.ls_next_attr, at_type = at_type},
+					sign_class, prop_class, subst, {ls & ls_next_attr = inc ls.ls_next_attr})
+	where
+		type_is_non_coercible (TempV _)
+			= True
+		type_is_non_coercible (TempQV _)
+			= True
+		type_is_non_coercible (_ --> _)
+			= True
+		type_is_non_coercible (_ :@: _)
+			= True
+		type_is_non_coercible _
+			= False
+
+
+lift_list :: !{#CommonDefs} ![a] !*{!Type} !*LiftState
+	-> (![a], ![SignClassification], ![PropClassification], !*{!Type}, !*LiftState) | lift a
+lift_list modules [] subst ls
+	= ([], [], [], subst, ls)
+lift_list modules [t:ts] subst ls
+	# (t, sign_class, prop_class, subst, ls) = lift modules t subst ls
+	  (ts, sign_classes, prop_classes, subst, ls) = lift_list modules ts subst ls
+	= ([t:ts], [sign_class : sign_classes], [prop_class : prop_classes], subst, ls)
+
+::	ExpansionState = 
+	{	es_type_heaps	:: !.TypeHeaps
+	,	es_td_infos		:: !.TypeDefInfos
+	}
+
+class expandType a :: !{# CommonDefs } !{# BOOLVECT } !a !*(!u:{! Type}, !*ExpansionState) -> (!a, !*(!u:{! Type}, !*ExpansionState))
+
+instance expandType AType
+where
+	expandType modules cons_vars attr_type=:{at_type, at_attribute} (subst, es=:{es_type_heaps})
+		# (at_attribute, th_attrs) = expand_attribute at_attribute es_type_heaps.th_attrs
+		  (at_type, subst_and_es) = expandType modules cons_vars at_type (subst, {es & es_type_heaps = { es_type_heaps & th_attrs = th_attrs }})
+		= ({ attr_type & at_type = at_type, at_attribute = at_attribute }, subst_and_es)
+	where
+		expand_attribute (TA_Var {av_info_ptr}) attr_var_heap
+			# (AVI_Attr attr, attr_var_heap) = readPtr av_info_ptr attr_var_heap
+			= (attr, attr_var_heap)
+		expand_attribute attr attr_var_heap
+			= (attr, attr_var_heap)
+	
+expandTempTypeVariable :: !TempVarId !*(!u:{! Type}, !*ExpansionState) -> (!Type, !*(!u:{! Type}, !*ExpansionState))
+expandTempTypeVariable tv_number (subst, es)
+	#! type = subst.[tv_number]
+	= case type of
+		TE	-> (TempV tv_number, (subst, es))
+		_	-> (type, (subst, es))
+
+instance expandType Type
+where
+	expandType modules cons_vars (TempV tv_number) es
+		= expandTempTypeVariable tv_number es
+	expandType modules cons_vars (TV {tv_info_ptr}) (subst, es=:{es_type_heaps})
+		# (TVI_Type type, th_vars) = readPtr tv_info_ptr es_type_heaps.th_vars
+		= (type, (subst, {es & es_type_heaps = { es_type_heaps & th_vars = th_vars }}))
+	expandType modules cons_vars (arg_type --> res_type) es
+		# (arg_type, es) = expandType modules cons_vars arg_type es
+		  (res_type, es) = expandType modules cons_vars res_type es
+		= (arg_type --> res_type, es)
+	expandType modules cons_vars (TA cons_id=:{type_index={glob_object,glob_module}} cons_args) es
+		# (cons_args, sign_classes, prop_classes, (subst,es=:{es_td_infos,es_type_heaps})) = expand_type_list modules cons_vars cons_args es
+		  (type_prop, th_vars, es_td_infos)
+		  			= typeProperties glob_object glob_module sign_classes prop_classes modules es_type_heaps.th_vars es_td_infos
+		= (TA { cons_id & type_prop = type_prop } cons_args,
+				(subst, { es & es_td_infos = es_td_infos, es_type_heaps = { es_type_heaps & th_vars = th_vars }}))
+	where
+		expand_type_list ::  !{#CommonDefs} !{# BOOLVECT } ![AType] !*(!u:{!Type}, !*ExpansionState)
+			-> (![AType], ![SignClassification], ![PropClassification], !*(!u:{!Type}, !*ExpansionState))
+		expand_type_list modules cons_vars [] es
+			= ([], [], [], es)
+		expand_type_list modules cons_vars [t:ts]  es
+			# (t, es) = expandType modules cons_vars t es
+			  (ts, sign_classes, prop_classes, es) = expand_type_list modules cons_vars ts es
+			= case t.at_type of 
+				TA {type_arity,type_prop} _
+					-> ([t:ts], [adjustSignClass type_prop.tsp_sign type_arity : sign_classes],
+								[adjustPropClass type_prop.tsp_propagation type_arity : prop_classes], es)
+				TempV tmp_var_id
+					| isPositive tmp_var_id cons_vars
+						-> ([t:ts], [PosSignClass : sign_classes], [PropClass : prop_classes], es)
+						-> ([t:ts], [TopSignClass : sign_classes], [NoPropClass : prop_classes], es)
+				_
+					-> ([t:ts], [TopSignClass : sign_classes], [PropClass : prop_classes], es)
+					
+	expandType modules cons_vars (TempCV temp_var :@: types) es
+		# (type, es) = expandTempTypeVariable temp_var es
+		  (types, es) = expandType modules cons_vars types es
+		= case type of
+			TA type_cons=:{type_arity} cons_args
+				# nr_of_new_args = length types
+				-> (TA { type_cons & type_arity = type_arity + nr_of_new_args } (cons_args ++ types), es)
+			TempV tv_number
+				-> (TempCV tv_number :@: types, es)
+			cons_var :@: cv_types
+				-> (cons_var :@: (cv_types ++ types), es)
+	expandType modules cons_vars type es
+		= (type, es)
+
+instance expandType [a] | expandType a
+where
+	expandType modules cons_vars l es = mapSt (expandType modules cons_vars) l es
+	
+instance toInt TypeAttribute
+where
+	 toInt TA_Unique 				= AttrUni
+	 toInt (TA_TempVar av_number)	= av_number
+//	 toInt (TA_TempExVar av_number)	= av_number
+	 toInt TA_Multi 				= AttrMulti
+	 toInt TA_None 					= AttrMulti
+
+
+instance * Bool
+where
+	(*) b1 b2 = b1 && b2 || not b1 && not b2
+
+instance * Sign
+where
+	(*) sign1 sign2
+		= {	pos_sign = sign1.pos_sign * sign2.pos_sign || sign1.neg_sign * sign2.neg_sign,
+			neg_sign = sign1.pos_sign * sign2.neg_sign || sign1.neg_sign * sign2.pos_sign }
+		
+::	CoercionState =
+	{	crc_type_heaps	:: !.TypeHeaps
+	,	crc_coercions	:: !.Coercions
+	,	crc_td_infos	:: !.TypeDefInfos
+	}
+
+
+class coerce a :: !{# CommonDefs} !{# BOOLVECT} !a !a !Sign !*CoercionState -> (!Bool, !*CoercionState)
+
+/*
+
+'coerceAttributes offered_attribute offered_attribute sign coercions' coerce offered_attribute to
+offered_attribute according to sign. Failure is indicated by returning False as a result.
+
+*/
+
+coerceAttributes TA_Unique dem_attr {neg_sign} coercions
+	| not neg_sign
+		= (True, coercions)
+coerceAttributes off_attr TA_Unique {pos_sign} coercions
+	| not pos_sign
+		= (True, coercions)
+coerceAttributes (TA_TempVar av_number) dem_attr {neg_sign} coercions=:{coer_demanded}
+	| not neg_sign && isUnique coer_demanded.[av_number]
+		= (True, coercions)
+coerceAttributes off_attr (TA_TempVar av_number) {pos_sign} coercions=:{coer_demanded}
+	| not pos_sign && isUnique coer_demanded.[av_number]
+		= (True, coercions)
+/*
+coerceAttributes off_attr TA_Multi {neg_sign} coercions
+	| not neg_sign
+		= (True, coercions)
+coerceAttributes TA_Multi dem_attr {pos_sign} coercions
+	| not pos_sign
+		= (True, coercions)
+*/
+coerceAttributes (TA_TempVar av_number1) (TA_TempVar av_number2) {pos_sign,neg_sign} coercions
+	| av_number1 == av_number2
+		= (True, coercions)
+	| pos_sign
+		| neg_sign
+			# (ok, coercions) = new_inequality av_number1 av_number2 coercions
+			| ok
+				= new_inequality av_number2 av_number1 coercions
+				= (False, coercions)
+			= new_inequality av_number1 av_number2 coercions
+	| neg_sign
+		= new_inequality av_number2 av_number1 coercions
+		= (True, coercions)
+where
+	new_inequality :: !Int !Int !*Coercions  -> (!Bool, !*Coercions)
+	new_inequality off_attr dem_attr coercions=:{coer_demanded, coer_offered}
+/*		| isExistential coer_offered.[off_attr]
+			#! off_attr_tree = coer_offered.[off_attr]
+			= coerce_to_existential_attribute off_attr_tree dem_attr coercions
+		| isExistential coer_demanded.[dem_attr]
+			#! dem_attr_tree = coer_demanded.[off_attr]
+			= coerce_to_existential_attribute dem_attr_tree off_attr coercions
+*/		| isNonUnique coer_offered.[off_attr]
+			| isUnique coer_demanded.[dem_attr]
+				= (False, coercions)
+				= (True, makeNonUnique dem_attr coercions)
+		| isUnique coer_demanded.[dem_attr]
+			= (True, makeUnique off_attr coercions)
+		| isNonUnique coer_offered.[dem_attr] || isUnique coer_demanded.[off_attr]
+			= (True, coercions)
+			= (True, newInequality off_attr dem_attr coercions)
+/*	
+	coerce_to_existential_attribute (CT_Existential exi_number) attr_number coercions
+		= coerceToExistentialAttribute exi_number attr_number coercions
+*/
+					
+coerceAttributes TA_Unique (TA_TempVar av_number) {neg_sign} coercions=:{coer_offered}
+	| isNonUnique coer_offered.[av_number]
+		= (False, coercions)
+		= (True, makeUnique av_number coercions)// ---> "*** 1 ***"
+coerceAttributes (TA_TempVar av_number) TA_Unique {pos_sign} coercions=:{coer_offered}
+	| isNonUnique coer_offered.[av_number]
+		= (False, coercions)
+		= (True, makeUnique av_number coercions)// ---> "*** 2 ***"
+coerceAttributes TA_Multi (TA_TempVar av_number) {pos_sign} coercions=:{coer_demanded}
+	| pos_sign
+		| isUnique coer_demanded.[av_number]
+			= (False, coercions)
+			= (True, makeNonUnique av_number coercions)
+		= (True, coercions)
+coerceAttributes (TA_TempVar av_number) TA_Multi {neg_sign} coercions=:{coer_demanded}
+	| neg_sign
+		| isUnique coer_demanded.[av_number]
+			= (False, coercions)
+			= (True, makeNonUnique av_number coercions)
+		= (True, coercions)
+coerceAttributes TA_Unique TA_Multi _ coercions
+	= (False, coercions)
+coerceAttributes off_attr dem_attr {pos_sign,neg_sign} coercions
+/*
+	| pos_sign || neg_sign // ---> ("coerceAttributes", off_attr, dem_attr)
+		= case off_attr of
+			TA_TempExVar eav_number
+				-> case dem_attr of
+					TA_TempVar av_number
+						-> coerceToExistentialAttribute eav_number av_number coercions
+					TA_TempExVar eav_number2
+						-> (eav_number == eav_number2, coercions)
+					_
+						-> (False, coercions)
+				
+			TA_TempVar av_number
+				-> case dem_attr of
+					TA_TempExVar eav_number
+						-> coerceToExistentialAttribute eav_number av_number coercions
+					_
+						-> (True, coercions)
+			_
+				-> case dem_attr of
+					TA_TempExVar eav_number
+						-> (False, coercions)
+					_
+						-> (True, coercions)
+*/
+		= (True, coercions)
+
+/*
+coerceToExistentialAttribute exi_attr_number attr_number coercions=:{coer_demanded, coer_offered}
+	#! dem_attr_tree = coer_demanded.[attr_number]
+	   off_attr_tree = coer_offered.[attr_number]
+	= case dem_attr_tree ---> ("coerceToExistentialAttribute", exi_attr_number, attr_number, dem_attr_tree, off_attr_tree) of
+		CT_Unique
+			-> (False, coercions)
+		CT_Existential exi_attr_number2
+			-> (exi_attr_number == exi_attr_number2, coercions)
+		_
+			-> case off_attr_tree of
+				CT_NonUnique
+					-> (False, coercions)
+				_
+					-> (True, make_attr_existential attr_number exi_attr_number coercions)
+	
+where
+	make_attr_existential :: !Int  !Int !*Coercions -> *Coercions
+	make_attr_existential attr exi_attr {coer_demanded, coer_offered}
+		# (dem_heaps_and_coercions, coer_demanded) = replace coer_demanded attr (CT_Existential exi_attr)
+		  (off_heaps_and_coercions, coer_offered) = replace coer_offered attr (CT_Existential exi_attr)
+		= make_existential off_heaps_and_coercions exi_attr (
+			make_existential dem_heaps_and_coercions exi_attr {coer_offered = coer_offered, coer_demanded = coer_demanded})
+
+	make_existential (CT_Node this_attr ct_less ct_greater) exi_attr coercions
+		# coercions = make_attr_existential this_attr exi_attr coercions
+		  coercions = make_existential ct_less exi_attr coercions
+		  coercions = make_existential ct_greater exi_attr coercions
+		= coercions
+	make_existential tree exi_attr coercions
+		= coercions
+*/
+newInequality :: !Int !Int !*Coercions -> *Coercions 
+newInequality off_attr dem_attr coercions=:{coer_demanded, coer_offered}
+	# (dem_coercions, coer_demanded) = replace coer_demanded off_attr CT_Empty
+	  (succ, dem_coercions) = insert dem_attr dem_coercions
+	  coer_demanded = { coer_demanded & [off_attr] = dem_coercions }
+	| succ
+		# (off_coercions, coer_offered) = replace coer_offered dem_attr CT_Empty
+	  	  (succ, off_coercions) = insert off_attr off_coercions
+	 	  coer_offered = { coer_offered & [dem_attr] = off_coercions }
+		= {coer_demanded = coer_demanded, coer_offered = coer_offered}
+		= {coer_demanded = coer_demanded, coer_offered = coer_offered}
+where
+
+	insert ::  !Int !*CoercionTree -> (!Bool, !*CoercionTree)
+	insert new_attr CT_Empty
+		=  (True, CT_Node new_attr CT_Empty CT_Empty)
+	insert new_attr (CT_Node this_attr ct_less ct_greater)
+		| new_attr < this_attr
+			# (succ, ct_less) = insert new_attr ct_less
+			= (succ, CT_Node this_attr ct_less ct_greater)
+		| new_attr > this_attr
+			# (succ, ct_greater) = insert new_attr ct_greater
+			= (succ, CT_Node this_attr ct_less ct_greater)
+			= (False, CT_Node this_attr ct_less ct_greater)
+	
+isNonUnique :: !CoercionTree -> Bool
+isNonUnique CT_NonUnique	= True
+isNonUnique _ 				= False
+
+isUnique  :: !CoercionTree -> Bool
+isUnique CT_Unique			= True
+isUnique _					= False
+
+/*
+isExistential  :: !CoercionTree -> Bool
+isExistential (CT_Existential exi_number)	= True
+isExistential attr_tree						= False
+*/
+		
+makeUnique :: !Int !*Coercions -> *Coercions
+makeUnique attr {coer_demanded, coer_offered}
+	# (off_coercions, coer_offered) = replace coer_offered attr CT_Empty
+	  coer_demanded = { coer_demanded & [attr] = CT_Unique }
+	= make_unique off_coercions {coer_offered = coer_offered, coer_demanded = coer_demanded}// ---> ("makeUnique :", attr)
+where
+	make_unique (CT_Node this_attr ct_less ct_greater) coercions
+		# coercions = makeUnique this_attr coercions
+		  coercions = make_unique ct_less coercions
+		  coercions = make_unique ct_greater coercions
+		= coercions
+	make_unique tree coercions
+		= coercions
+
+tryToMakeUnique :: !Int !*Coercions -> (!Bool, !*Coercions)
+tryToMakeUnique attr coercions=:{coer_offered}
+	| isNonUnique coer_offered.[attr] // || isExistential coer_offered.[attr]
+		= (False, coercions)
+		= (True, makeUnique attr coercions)
+
+makeNonUnique :: !Int !*Coercions -> *Coercions
+makeNonUnique attr {coer_demanded, coer_offered}
+	# (dem_coercions, coer_demanded) = replace coer_demanded attr CT_Empty
+	  coer_offered = { coer_offered & [attr] = CT_NonUnique }
+	= make_non_unique dem_coercions {coer_offered = coer_offered, coer_demanded = coer_demanded}
+where
+	make_non_unique (CT_Node this_attr ct_less ct_greater) coercions
+		# coercions = makeNonUnique this_attr coercions
+		  coercions = make_non_unique ct_less coercions
+		  coercions = make_non_unique ct_greater coercions
+		= coercions
+	make_non_unique tree coercions
+		= coercions
+
+tryToMakeNonUnique :: !Int !*Coercions -> (!Bool, !*Coercions)
+tryToMakeNonUnique attr coercions=:{coer_demanded}
+	| isUnique coer_demanded.[attr] // || isExistential coer_demanded.[attr]
+		= (False, coercions)
+		= (True, makeNonUnique attr coercions)
+//				---> ("tryToMakeNonUnique", attr)
+
+instance coerce AType
+where
+	coerce defs cons_vars at1=:{at_attribute=attr1,at_type=type1} at2=:{at_attribute=attr2,at_type=type2} sign cs=:{crc_coercions}
+		# sign = adjust_sign sign type1 cons_vars
+		  (succ, crc_coercions) = coerceAttributes attr1 attr2 sign crc_coercions
+		| succ
+			# (succ, cs) = coerce defs cons_vars type1 type2 sign { cs & crc_coercions = crc_coercions }
+			| succ
+				# (succ1, crc_coercions) = add_propagation_inequalities attr1 type1 cs.crc_coercions
+				  (succ2, crc_coercions) = add_propagation_inequalities attr2 type2 crc_coercions
+				= (succ1 && succ2, { cs & crc_coercions = crc_coercions })
+				= (False, cs)
+			= (False, { cs & crc_coercions = crc_coercions })
+				// ---> ("coerceAttributes", attr1, attr2, sign)
+
+	where		
+
+		adjust_sign :: !Sign !Type {# BOOLVECT} -> Sign
+		adjust_sign sign (TempV _) cons_vars
+			= TopSign
+		adjust_sign sign (TempQV _) cons_vars
+			= TopSign
+		adjust_sign sign (_ --> _) cons_vars
+			= TopSign
+		adjust_sign sign (TempCV tmp_var_id :@: _) cons_vars
+			| isPositive tmp_var_id cons_vars
+				= sign
+				= TopSign
+		adjust_sign sign (_ :@: _) cons_vars
+			= TopSign
+		adjust_sign sign (TA {type_name, type_prop={tsp_coercible}} _) cons_vars
+			| tsp_coercible
+				= sign
+				= TopSign
+//					---> ("adjust_sign to top", type_name)
+		adjust_sign sign _ cons_vars
+			= sign
+
+		add_propagation_inequalities attr (TA {type_prop={tsp_propagation}} cons_args) coercions
+			= add_inequalities tsp_propagation attr cons_args coercions
+		where
+			add_inequalities prop_class attr _ coercions
+				= (True, coercions)
+
+			add_inequalities prop_class attr [] coercions
+				= (True, coercions)
+			add_inequalities prop_class attr [{at_attribute} : args] coercions
+				| (prop_class bitand 1) == 0 //  || is_existential_attribute at_attribute coercions
+					= add_inequalities (prop_class >> 1) attr args coercions
+				# (succ, coercions) = coerceAttributes attr at_attribute PositiveSign coercions
+				| succ
+					= add_inequalities (prop_class >> 1) attr args coercions
+					= (False, coercions)
+							---> ("add_propagation_inequalities", attr, at_attribute)
+/*
+			is_existential_attribute (TA_TempExVar eav_number) coercions
+				= True
+			is_existential_attribute (TA_TempVar eav_number) {coer_offered}
+				= isExistential coer_offered.[eav_number]
+			is_existential_attribute _ {coer_offered}
+				= False
+*/ 
+		add_propagation_inequalities attr type coercions
+			= (True, coercions)
+	
+coercionsOfTypeList defs cons_vars [t1 : ts1] [t2 : ts2] sign_class type_index sign cs
+	# arg_sign = sign * signClassToSign sign_class type_index
+	  (ok, cs) = coerce defs cons_vars t1 t2 arg_sign cs
+	| ok
+		= coercionsOfTypeList defs cons_vars ts1 ts2 sign_class (inc type_index) sign cs
+		= (False, cs)
+coercionsOfTypeList defs cons_vars [] [] _ _ _ cs
+	= (True, cs)
+
+isSynonymType (SynType _)
+	= True
+isSynonymType type_rhs
+	= False
+	
+tryToExpandTypeSyn defs cons_vars cons_id=:{type_index={glob_object,glob_module}} type_args type_heaps td_infos
+	# {td_rhs,td_args} = defs.[glob_module].com_type_defs.[glob_object]
+	| isSynonymType td_rhs
+		# (SynType {at_type}) = td_rhs
+		  type_heaps = fold2St bind_type_and_attr td_args type_args type_heaps
+		  (expanded_type, (_, {es_type_heaps, es_td_infos}))
+		  		= expandType defs cons_vars at_type ({}, { es_type_heaps = type_heaps, es_td_infos = td_infos })
+		= (True, expanded_type, es_type_heaps, es_td_infos)
+		= (False, TA cons_id type_args, type_heaps, td_infos)
+where
+	bind_type_and_attr {atv_attribute = TA_Var {av_info_ptr}, atv_variable={tv_info_ptr}} {at_attribute,at_type} {th_vars,th_attrs}
+		= { th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type), th_attrs = th_attrs <:= (av_info_ptr, AVI_Attr at_attribute) }
+	bind_type_and_attr {atv_variable={tv_info_ptr}} {at_type} type_heaps=:{th_vars}
+		= { type_heaps & th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type) }
+	
+	
+instance coerce Type
+where
+	coerce defs cons_vars (TA dem_cons dem_args) (TA off_cons off_args) sign cs=:{crc_type_heaps, crc_td_infos}
+		| dem_cons == off_cons
+			= coercionsOfTypeList defs cons_vars dem_args off_args dem_cons.type_prop.tsp_sign 0 sign cs
+			# (_, dem_type, crc_type_heaps, crc_td_infos) = tryToExpandTypeSyn defs cons_vars dem_cons dem_args crc_type_heaps crc_td_infos
+			  (_, off_type, crc_type_heaps, crc_td_infos) = tryToExpandTypeSyn defs cons_vars off_cons off_args crc_type_heaps crc_td_infos
+			= coerce defs cons_vars dem_type off_type sign { cs & crc_type_heaps = crc_type_heaps, crc_td_infos = crc_td_infos }
+	coerce defs cons_vars (TA dem_cons dem_args) off_type sign cs=:{crc_type_heaps, crc_td_infos}
+		# (succ, dem_type, crc_type_heaps, crc_td_infos) = tryToExpandTypeSyn defs cons_vars dem_cons dem_args crc_type_heaps crc_td_infos
+		| succ
+			= coerce defs cons_vars dem_type off_type sign { cs & crc_type_heaps = crc_type_heaps, crc_td_infos = crc_td_infos }
+			= (True, { cs & crc_type_heaps = crc_type_heaps, crc_td_infos = crc_td_infos })
+	coerce defs cons_vars dem_type (TA off_cons off_args) sign cs=:{crc_type_heaps, crc_td_infos}
+		# (succ, off_type, crc_type_heaps, crc_td_infos) = tryToExpandTypeSyn defs cons_vars off_cons off_args crc_type_heaps crc_td_infos
+		| succ
+			= coerce defs cons_vars dem_type off_type sign { cs & crc_type_heaps = crc_type_heaps, crc_td_infos = crc_td_infos }
+			= (True, { cs & crc_type_heaps = crc_type_heaps, crc_td_infos = crc_td_infos })
+	coerce defs cons_vars (arg_type1 --> res_type1) (arg_type2 --> res_type2) sign cs
+		# (ok, cs) = coerce defs cons_vars arg_type1 arg_type2 (NegativeSign * sign) cs
+		| ok
+			= coerce defs cons_vars res_type1 res_type2 sign cs
+			= (False, cs)
+	coerce defs cons_vars (cons_var :@: types1) (_ :@: types2) sign cs
+		= coercions_of_type_list defs cons_vars (determine_sign_of_arg_types cons_var cons_vars) types1 types2 cs
+	where
+		determine_sign_of_arg_types (TempCV tmp_var_id) cons_vars
+			| isPositive tmp_var_id cons_vars
+				= PositiveSign
+				= TopSign
+		determine_sign_of_arg_types _ cons_vars
+				= TopSign
+			
+		coercions_of_type_list :: !{# CommonDefs} !{# BOOLVECT} !Sign ![a] ![a] !*CoercionState -> (!Bool,!*CoercionState) | coerce a
+		coercions_of_type_list defs cons_vars sign [t1 : ts1] [t2 : ts2] cs
+			# (ok, cs) = coerce defs cons_vars t1 t2 sign cs
+			| ok
+				= coercions_of_type_list defs cons_vars sign ts1 ts2 cs
+				= (False, cs)
+		coercions_of_type_list defs cons_vars sign [] [] cs
+			= (True, cs)
+	coerce defs cons_vars _ _ sign cs
+		= (True, cs)
+
+AttrRestricted :== 0
+
+instance <<< CoercionTree
+where
+	(<<<) file (CT_Node attr left right) = file <<< left <<< ' ' <<< attr <<< ' ' <<< right
+	(<<<) file CT_Unique = file <<< "CT_Unique"
+	(<<<) file CT_NonUnique = file <<< "CT_NonUnique"
+//	(<<<) file (CT_Existential int) = file <<< "CT_Existential:" <<< int
+	(<<<) file CT_Empty = file <<< "##"
+
+instance <<< CoercionPosition
+where
+	(<<<) file {cp_expression} = show_expression file cp_expression
+
+	where
+		show_expression file (Var {var_name})
+			= file <<< var_name
+		show_expression file (FreeVar {fv_name})
+			= file <<< fv_name
+		show_expression file (App {app_symb={symb_name}})
+			= file <<< symb_name
+		show_expression file (fun @ fun_args)
+			= show_expression file fun
+		show_expression file (Case {case_ident})
+			= case case_ident of
+				Yes {id_name}
+					# (line, pos) = get_line_and_col "_c" id_name
+					-> file <<< "case [" <<< line <<< ',' <<< pos <<< ']'
+				No
+					-> file <<< "(case ... )"
+		show_expression file (Selection _ expr selectors)
+			= file <<< "selection"
+		show_expression file (Update expr1 selectors expr2)
+			= file <<< "update"
+		show_expression file (TupleSelect {ds_arity} elem_nr expr)
+			= file <<< "argument" <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple"
+		show_expression file (BasicExpr bv _)
+			= file <<< bv
+		show_expression file (MatchExpr _ _ expr)
+			= file <<< "match expression"
+		show_expression file _
+			= file
+
+		
+		get_line_and_col prefix ident
+			# ident = ident % (0, size prefix - 1)
+			  del_pos = find_delimiter '_' 0 ident
+			= (toInt (ident % (0, del_pos - 1)), toInt (ident % (del_pos + 1, size ident - 1)))
+		where
+			find_delimiter del_char del_pos ident
+				| del_char == ident.[del_pos]
+					= del_pos
+					= find_delimiter del_char (inc del_pos) ident
+			
diff --git a/frontend/utilities.dcl b/frontend/utilities.dcl
new file mode 100644
index 0000000..434e7c7
--- /dev/null
+++ b/frontend/utilities.dcl
@@ -0,0 +1,92 @@
+definition module utilities
+
+from StdString import String
+from StdEnv import Eq, not, Ord, IncDec
+import StdMisc, general
+/*
+	For Strings
+*/
+
+stringToCharList	:: !String -> [Char]
+charListToString	:: ![Char] -> String
+revCharListToString	:: !Int ![Char] -> String
+
+isUpperCaseName :: ! String -> Bool
+isLowerCaseName :: ! String -> Bool
+isFunnyIdName 	:: ! String -> Bool
+isSpecialChar	:: ! Char	-> Bool
+
+/*
+	For Lists
+*/
+
+mapSt :: !(.a -> (.st -> (.c,.st))) ![.a] !.st -> (![.c],!.st)
+
+app2St :: !(!.(.a -> .(.st -> (.c,.st))),!.(.e -> .(.st -> (.f,.st)))) !(.a,.e) !.st -> (!(.c,.f),!.st)
+
+mapAppendSt :: !(.a -> .(.b -> (.c,.b))) ![.a] !u:[.c] !.b -> !(!u:[.c],!.b)
+
+strictMap :: !(.a -> .b) ![.a] -> [.b]
+
+strictMapAppend :: !(.a -> .b) ![.a] !u:[.b] -> v:[.b], [u <= v]
+
+mapAppend :: !(.a -> .b) ![.a] !u:[.b] -> u:[.b]
+
+//zip2Append :: [.a] [.b] u:[w:(.a,.b)] -> v:[x:(.a,.b)], [w <= x, u <= v]
+
+eqMerge :: ![a] ![a] -> [a] | Eq a
+
+// foldl2 :: !(.c -> .(.a -> .(.b -> .c))) !.c ![.a] ![.b] -> .c
+foldl2 op r l1 l2
+	:== foldl2 r l1 l2
+where
+	foldl2 r [x : xs] [y : ys]
+		= foldl2 (op r x y) xs ys
+	foldl2 r [] []
+		= r
+//foldr2 :: !(.a -> .(.b -> .(.c -> .c))) !.c ![.a] ![.b] -> .c
+
+foldr2 op r l1 l2
+	:== foldr2 r l1 l2
+where
+	foldr2 r [x : xs] [y : ys]
+		= op x y (foldr2 r xs ys)	
+	foldr2 r [] []
+		= r
+
+fold2St op l1 l2 st
+	:== fold_st2 l1 l2 st
+where
+	fold_st2 [x : xs] [y : ys] st
+		= op x y (fold_st2 xs ys st)	
+	fold_st2 [] [] st
+		= st
+	fold_st2 [] ys st
+		= abort ("fold_st2: second argument list contains more elements" ---> ys)
+	fold_st2 xs [] st
+		= abort ("fold_st2: first argument list contains more elements" ---> xs)
+
+// foldSt :: !(.a -> .(.st -> .st)) ![.a] !.st -> .st
+foldSt op l st :== fold_st l st
+	where
+		fold_st [] st		= st
+		fold_st [a:x] st	= fold_st x (op a st)
+
+iFoldSt op fr to st :== i_fold_st fr to st
+	where
+		i_fold_st fr to st
+			| fr >= to
+				= st
+				= i_fold_st (inc fr) to (op fr st)
+
+iterateSt op st :== iterate_st op st
+	where
+		iterate_st op st
+			# (continue, st) = op (False, st)
+			| continue
+				= iterate_st op st
+				= st
+
+revAppend	:: ![a] ![a] -> [a]	//	Reverse the list using the second argument as accumulator.
+revMap :: !(.a -> .b) ![.a] !u:[.b] -> u:[.b]
+
diff --git a/frontend/utilities.icl b/frontend/utilities.icl
new file mode 100644
index 0000000..51e11ce
--- /dev/null
+++ b/frontend/utilities.icl
@@ -0,0 +1,200 @@
+implementation module utilities
+
+import	StdEnv, general
+    
+
+/*
+		Utility routines.
+*/
+StringToCharList`	:: !String !Int !Int -> [Char]
+StringToCharList` string 0 index
+		= 	[]
+StringToCharList` string length index
+		= [string.[index] : StringToCharList` string (dec length) (inc index)]
+		
+stringToCharList	:: !String ->	[Char]
+stringToCharList string = StringToCharList` string (size string) 0
+
+charListToString	:: ![Char] -> String
+charListToString [hd:tl] = toString hd +++ charListToString tl 
+charListToString []      = ""
+
+revCharListToString	:: !Int ![Char] -> String
+revCharListToString max_index l
+	# string = createArray (max_index + 1) '\0'
+	= fill_string max_index l string
+where
+	fill_string :: !Int ![Char] !*String -> *String
+	fill_string n [ char : rest] string
+		= fill_string (n - 1) rest { string & [n] = char }
+	fill_string (-1) [] string
+		= string
+		  
+/*
+revCharListToString [hd:tl] = revCharListToString tl +++ toString hd 
+revCharListToString []      = ""
+*/
+
+isUpperCaseName :: ! String -> Bool
+isUpperCaseName id
+	= ('A' <= c  &&  c <= 'Z') || c == '_' 
+   	  where
+   	  c =: id.[0]
+
+isLowerCaseName :: ! String -> Bool
+isLowerCaseName id
+	= 'a' <= c  &&  c <= 'z' 
+   	  where
+   	  c =: id.[0]
+
+isFunnyIdName :: ! String -> Bool
+isFunnyIdName id
+	= isSpecialChar id.[0]
+
+isSpecialChar	:: !Char -> Bool
+isSpecialChar '~'	= True
+isSpecialChar '@'	= True
+isSpecialChar '#'	= True
+isSpecialChar '$'	= True
+isSpecialChar '%'	= True
+isSpecialChar '^'	= True
+isSpecialChar '?'	= True
+isSpecialChar '!'	= True
+isSpecialChar '+'	= True
+isSpecialChar '-'	= True
+isSpecialChar '*'	= True
+isSpecialChar '<'	= True
+isSpecialChar '>'	= True
+isSpecialChar '\\'	= True
+isSpecialChar '/'	= True
+isSpecialChar '|'	= True
+isSpecialChar '&'	= True
+isSpecialChar '='	= True
+isSpecialChar ':'	= True
+isSpecialChar '.'	= True
+isSpecialChar c	= False
+
+strictMap :: !(.a -> .b) ![.a] -> [.b]
+strictMap f [x : xs]
+		#!	head = f x
+			tail = strictMap f xs
+		=	[head : tail]
+strictMap f xs
+		= []
+
+strictMapAppend :: !(.a -> .b) ![.a] !u:[.b] -> v:[.b], [u <= v]
+strictMapAppend f [x : xs] tail
+	#! x = f x
+	   xs = strictMapAppend f xs tail
+	= [x : xs]
+strictMapAppend f [] tail
+	= tail
+
+mapAppend :: !(.a -> .b) ![.a] !u:[.b] -> u:[.b]
+mapAppend f [x : xs] tail
+	#  x = f x
+	   xs = mapAppend f xs tail
+	= [x : xs]
+mapAppend f [] tail
+	= tail
+
+
+mapAppendSt :: !(.a -> .(.b -> (.c,.b))) ![.a] !u:[.c] !.b -> !(!u:[.c],!.b)
+mapAppendSt f [x : xs] tail s 
+	# (x, s) = f x s
+	  (xs, s) = mapAppendSt f xs tail s
+	= ([x : xs], s)
+mapAppendSt f [] tail s
+	= (tail, s)
+
+mapSt :: !(.a -> (.st -> (.c,.st))) ![.a] !.st -> (![.c],!.st)
+mapSt f [x : xs] s
+ 	# (x, s) = f x s
+	  (xs, s) = mapSt f xs s
+	= ([x : xs], s)
+mapSt f [] s
+ 	= ([], s)
+
+app2St :: !(!.(.a -> .(.st -> (.c,.st))),!.(.e -> .(.st -> (.f,.st)))) !(.a,.e) !.st -> (!(.c,.f),!.st)
+app2St (f,g) (x,y) s
+ 	# (x, s) = f x s
+	  (y, s) = g y s
+	= ((x,y), s)
+
+
+// foldl2 :: !(.c -> .(.a -> .(.b -> .c))) !.c ![.a] ![.b] -> .c
+foldl2 op r l1 l2
+	:== foldl2 r l1 l2
+where
+	foldl2 r [x : xs] [y : ys]
+		= foldl2 (op r x y) xs ys
+	foldl2 r [] []
+		= r
+//foldr2 :: !(.a -> .(.b -> .(.c -> .c))) !.c ![.a] ![.b] -> .c
+
+foldr2 op r l1 l2
+	:== foldr2 r l1 l2
+where
+	foldr2 r [x : xs] [y : ys]
+		= op x y (foldr2 r xs ys)	
+	foldr2 r [] []
+		= r
+
+fold2St op l1 l2 st
+	:== fold_st2 l1 l2 st
+where
+	fold_st2 [x : xs] [y : ys] st
+		= op x y (fold_st2 xs ys st)	
+	fold_st2 [] [] st
+		= st
+	fold_st2 [] ys st
+		= abort ("fold_st2: second argument list contains more elements" ---> ys)
+	fold_st2 xs [] st
+		= abort ("fold_st2: first argument list contains more elements" ---> xs)
+
+// foldSt :: !(.a -> .(.st -> .st)) ![.a] !.st -> .st
+foldSt op r l :== fold_st r l
+	where
+		fold_st [] st		= st
+		fold_st [a:x] st	= fold_st x (op a st)
+
+iFoldSt op fr to st :== i_fold_st fr to st
+	where
+		i_fold_st fr to st
+			| fr >= to
+				= st
+				= i_fold_st (inc fr) to (op fr st)
+
+iterateSt op st :== iterate_st op st
+	where
+		iterate_st op st
+			# (continue, st) = op (False, st)
+			| continue
+				= iterate_st op st
+				= st
+
+eqMerge :: ![a] ![a] -> [a] | Eq a
+eqMerge [a : x] y
+	| isMember a y
+		= eqMerge x y
+		= [a : eqMerge x y]
+eqMerge x y
+		= y
+
+revAppend	:: ![a] ![a] -> [a]	//	Reverse the list using the second argument as accumulator.
+revAppend [] acc = acc
+revAppend [x : xs] acc = revAppend xs [x : acc]
+
+revMap :: !(.a -> .b) ![.a] !u:[.b] -> u:[.b]
+revMap f [] acc = acc
+revMap f [x : xs] acc = revMap f xs [f x : acc]
+
+
+
+/*		
+zip2Append :: [.a] [.b] u:[w:(.a,.b)] -> v:[x:(.a,.b)], [w <= x, u <= v]
+zip2Append [] [] tail
+	= tail
+zip2Append [x : xs] [y : ys] tail
+	= [(x,y) : zip2Append xs ys tail]
+*/