bugfixes

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

6 files changed, 136 insertions, 117 deletions

diff --git a/frontend/checksupport.dcl b/frontend/checksupport.dcl
index 1824265..374c72c 100644
--- a/frontend/checksupport.dcl
+++ b/frontend/checksupport.dcl
@@ -109,6 +109,7 @@ newPosition :: !Ident  !Position -> IdentPos
 
 checkError :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
 checkWarning :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
+checkErrorWithIdentPos :: !IdentPos !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 
 class envLookUp a :: !a !(Env Ident .b) -> (!Bool,.b)
 
@@ -128,9 +129,7 @@ addLocalFunctionDefsToSymbolTable :: Level Index .Index u:(a FunDef) *SymbolTabl
 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;
diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl
index f9ede20..e5d8292 100644
--- a/frontend/checksupport.icl
+++ b/frontend/checksupport.icl
@@ -155,6 +155,12 @@ checkWarning id mess error=:{ea_file,ea_loc=[]}
 checkWarning id mess error=:{ea_file,ea_loc}
 	= { error & ea_file = ea_file <<< "Check Warning " <<< hd ea_loc <<< ":\"" <<< id  <<< "\" " <<< mess <<< '\n' }
 
+checkErrorWithIdentPos :: !IdentPos !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
+checkErrorWithIdentPos ident_pos mess error_admin
+	# error_admin = pushErrorAdmin ident_pos error_admin
+	  error_admin = checkError ident_pos.ip_ident mess error_admin
+	= popErrorAdmin error_admin
+
 class envLookUp a :: !a !(Env Ident .b) -> (!Bool,.b)
 
 instance envLookUp TypeVar
@@ -241,11 +247,11 @@ addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] ![.Declaration] !*
 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
+	add_imports_to_symbol_table is_dcl_mod [{dcl_ident,dcl_pos,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 (addImportedSymbol dcl_ident dcl_pos 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)
@@ -253,12 +259,12 @@ where
 		= cs
 
 addLocalSymbolsToSymbolTable :: ![.Declaration] Int !*CheckState -> .CheckState;
-addLocalSymbolsToSymbolTable [{dcl_ident,dcl_kind,dcl_index} : symbols] mod_index cs
+addLocalSymbolsToSymbolTable [{dcl_ident,dcl_pos,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 symbols mod_index (addImportedSymbol dcl_ident dcl_pos dcl_kind dcl_index mod_index cs)
 addLocalSymbolsToSymbolTable [] mod_index cs
 	= cs
 
@@ -284,29 +290,29 @@ addFieldToSelectorDefinition {id_info} glob_field_index cs=:{cs_symbol_table}
 		_
 			-> { 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}
+addImportedSymbol :: !Ident !Position !STE_Kind !.Int !.Int !*CheckState -> .CheckState;
+addImportedSymbol ident pos 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 }
+	= add_imported_symbol entry ident pos def_kind def_index def_mod { cs & cs_symbol_table = cs_symbol_table }
 where	
-	add_imported_symbol entry=:{ste_kind = STE_Empty} {id_name,id_info} def_kind def_index def_mod cs=:{cs_symbol_table}
+	add_imported_symbol entry=:{ste_kind = STE_Empty} {id_name,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
+	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}
-	
+	add_imported_symbol	entry ident pos def_kind def_index def_mod cs=:{cs_error}
+		= { cs & cs_error = checkErrorWithIdentPos (newPosition ident pos) " 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}
+	add_global_definition {dcl_ident=ident=:{id_info},dcl_pos,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 }
@@ -315,7 +321,7 @@ where
 					-> addFieldToSelectorDefinition selector_id	{ glob_module = NoIndex, glob_object = dcl_index } cs
 				_
 					-> cs
-			= { cs & cs_error = checkError ident "(global definition) already defined" cs.cs_error}
+			= { cs & cs_error = checkErrorWithIdentPos (newPosition ident dcl_pos) "(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
diff --git a/frontend/comparedefimp.dcl b/frontend/comparedefimp.dcl
index b9a582f..242bf34 100644
--- a/frontend/comparedefimp.dcl
+++ b/frontend/comparedefimp.dcl
@@ -5,5 +5,5 @@ import syntax, checksupport
 // compare definition and implementation module
 
 compareDefImp :: !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin 
-				-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin);
+				-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
 
diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl
index b95b213..47a12d7 100644
--- a/frontend/comparedefimp.icl
+++ b/frontend/comparedefimp.icl
@@ -67,7 +67,9 @@ import RWSDebug
 				::	!Int
 		}
 
-class t_corresponds a :: a a -> *TypesCorrespondMonad
+:: OptionalCorrespondenceNumber = CorrespondenceNumber !Int | Bound | Unbound
+
+class t_corresponds a :: !a !a -> *TypesCorrespondMonad
 	// whether two types correspond
 class e_corresponds a :: !a !a -> ExpressionsCorrespondMonad
 	// check for correspondence of expressions
@@ -75,13 +77,13 @@ class e_corresponds a :: !a !a -> ExpressionsCorrespondMonad
 class getIdentPos a :: a -> IdentPos
 
 class CorrespondenceNumber a where
-	toCorrespondenceNumber :: .a -> Optional Int
+	toCorrespondenceNumber :: .a -> OptionalCorrespondenceNumber
 	fromCorrespondenceNumber :: Int -> .a
 
 initial_hwn hwn_heap = { hwn_heap = hwn_heap, hwn_number = 0 }
 
 compareDefImp :: !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin 
-				-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin);
+				-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
 compareDefImp dcl_modules icl_module heaps error_admin
 	# (main_dcl_module, dcl_modules) = dcl_modules![cIclModIndex]
 	= case main_dcl_module.dcl_conversions of
@@ -114,18 +116,20 @@ compareDefImp dcl_modules icl_module heaps error_admin
 			  (icl_com_selector_defs, tc_state, error_admin)
 					= compareWithConversions conversion_table.[cSelectorDefs]
 						dcl_common.com_selector_defs icl_com_selector_defs tc_state error_admin
-			  (icl_com_member_defs, tc_state, error_admin)
-					= compareWithConversions conversion_table.[cMemberDefs]
-						dcl_common.com_member_defs icl_com_member_defs tc_state error_admin
 			  (icl_com_class_defs, tc_state, error_admin)
 					= compareWithConversions conversion_table.[cClassDefs]
 						dcl_common.com_class_defs icl_com_class_defs tc_state error_admin
+			  (icl_com_member_defs, tc_state, error_admin)
+					= compareWithConversions conversion_table.[cMemberDefs]
+						dcl_common.com_member_defs icl_com_member_defs tc_state error_admin
 			  (icl_com_instance_defs, tc_state, error_admin)
 					= compareWithConversions conversion_table.[cInstanceDefs]
 						dcl_common.com_instance_defs icl_com_instance_defs tc_state error_admin
+/* XXX macro comparision doesn't work yet
 			  (icl_functions, hp_var_heap, hp_expression_heap, tc_state, error_admin)
 					= compareMacrosWithConversion conversion_table.[cMacroDefs] dcl_macros
 								 				 icl_functions hp_var_heap hp_expression_heap tc_state error_admin
+*/
 			  (icl_functions, tc_state, error_admin)
 			  		= compareFunctionTypesWithConversions conversion_table.[cFunctionDefs]
 			  			dcl_functions icl_functions tc_state error_admin
@@ -139,7 +143,7 @@ compareDefImp dcl_modules icl_module heaps error_admin
 			  		= { hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap,
 			  			hp_type_heaps = { th_vars = tc_type_vars.hwn_heap, th_attrs = tc_attr_vars.hwn_heap}}
 			-> ( tc_dcl_modules, { icl_module & icl_common = icl_common, icl_functions = icl_functions },
-				heaps, error_admin )
+					heaps, error_admin )
   where
 	copy original
 		#! size = size original
@@ -156,6 +160,9 @@ compareDefImp dcl_modules icl_module heaps error_admin
 compareWithConversions conversions dclDefs iclDefs tc_state error_admin 
 	= iFoldSt (compareWithConversion conversions dclDefs) 0 (size conversions) (iclDefs, tc_state, error_admin)
 
+compareWithConversion :: !w:(a x:Int) !.(b c) !Int !(!u:(d c), !*TypesCorrespondState, !*ErrorAdmin)
+						-> (!v:(d c), !.TypesCorrespondState, !.ErrorAdmin)
+						| Array .b & getIdentPos , select_u , t_corresponds , uselect_u c & Array .d & Array .a, [u <= v, w <= x];
 compareWithConversion conversions dclDefs dclIndex (iclDefs, tc_state, error_admin)
 	# (iclDef, iclDefs) = iclDefs![conversions.[dclIndex]]
 	  (corresponds, tc_state) = t_corresponds dclDefs.[dclIndex] iclDef tc_state
@@ -167,6 +174,9 @@ compareFunctionTypesWithConversions conversions	dcl_fun_types icl_functions tc_s
 	= iFoldSt (compareTwoFunctionTypes conversions dcl_fun_types) 0 (size conversions)
 				(icl_functions, tc_state, error_admin)
 
+compareTwoFunctionTypes :: !w:(a x:Int) !.(b FunType) !.Int !(!u:(c FunDef),!*TypesCorrespondState,!*ErrorAdmin)
+						-> (!v:(c FunDef),!.TypesCorrespondState,!.ErrorAdmin)
+						| Array .b & Array .c & Array .a, [u <= v, w <= x];
 compareTwoFunctionTypes conversions	dcl_fun_types dclIndex (icl_functions, tc_state, error_admin)
 	# (fun_def=:{fun_type}, icl_functions) = icl_functions![conversions.[dclIndex]]
 	= case fun_type of
@@ -175,19 +185,22 @@ compareTwoFunctionTypes conversions	dcl_fun_types dclIndex (icl_functions, tc_st
 			# dcl_symbol_type = dcl_fun_types.[dclIndex].ft_type
 			  tc_state = init_attr_vars (dcl_symbol_type.st_attr_vars++icl_symbol_type.st_attr_vars)
 			  							tc_state
-			  tc_type_vars = init_type_vars (dcl_symbol_type.st_vars++icl_symbol_type.st_vars)
-										tc_state.tc_type_vars
+			  tc_state = init_type_vars (dcl_symbol_type.st_vars++icl_symbol_type.st_vars) tc_state
 			  (corresponds, tc_state)
-					= t_corresponds dcl_symbol_type icl_symbol_type { tc_state & tc_type_vars = tc_type_vars }
+					= t_corresponds dcl_symbol_type icl_symbol_type tc_state
 			| corresponds
 				-> (icl_functions, tc_state, error_admin)
 			-> generate_error error_message fun_def icl_functions tc_state error_admin
 
-init_type_vars type_vars tc_type_vars=:{hwn_heap}
-	# hwn_heap = foldSt init_type_var type_vars hwn_heap
-	= { tc_type_vars & hwn_heap = hwn_heap }
-init_type_var {tv_info_ptr} heap
-	= writePtr tv_info_ptr TVI_Empty heap
+init_type_vars type_vars tc_state=:{tc_type_vars}
+	# tc_type_vars = init_type_vars` type_vars tc_type_vars
+	= { tc_state & tc_type_vars = tc_type_vars }
+  where
+	init_type_vars` type_vars tc_type_vars=:{hwn_heap}
+		# hwn_heap = foldSt init_type_var type_vars hwn_heap
+		= { tc_type_vars & hwn_heap = hwn_heap }
+	init_type_var {tv_info_ptr} heap
+		= writePtr tv_info_ptr TVI_Empty heap
 	
 generate_error message iclDef iclDefs tc_state error_admin
 	# ident_pos = getIdentPos iclDef
@@ -209,6 +222,7 @@ compareMacrosWithConversion conversions macro_range icl_functions var_heap expr_
 compareMacroWithConversion conversions ir_from dclIndex ec_state
 	= compareTwoMacroFuns dclIndex conversions.[dclIndex-ir_from] ec_state
 
+compareTwoMacroFuns :: !.Int !.Int !*ExpressionsCorrespondState -> .ExpressionsCorrespondState;
 compareTwoMacroFuns dclIndex iclIndex
 					ec_state=:{ec_correspondences, ec_icl_functions, ec_error_admin}
 	# (dcl_function, ec_icl_functions) = ec_icl_functions![dclIndex]
@@ -223,62 +237,57 @@ compareTwoMacroFuns dclIndex iclIndex
 
 instance getIdentPos (TypeDef a) where
 	getIdentPos {td_name, td_pos}
-		= makeIdentPos td_name td_pos
+		= newPosition td_name td_pos
 
 instance getIdentPos ConsDef where
 	getIdentPos {cons_symb, cons_pos}
-		= makeIdentPos cons_symb cons_pos
+		= newPosition cons_symb cons_pos
 
 instance getIdentPos SelectorDef where
 	getIdentPos {sd_symb, sd_pos}
-		= makeIdentPos sd_symb sd_pos
+		= newPosition sd_symb sd_pos
 
 instance getIdentPos ClassDef where
 	getIdentPos {class_name, class_pos}
-		= makeIdentPos class_name class_pos
+		= newPosition class_name class_pos
 
 instance getIdentPos MemberDef where
 	getIdentPos {me_symb, me_pos}
-		= makeIdentPos me_symb me_pos
+		= newPosition me_symb me_pos
 
 instance getIdentPos ClassInstance where
 	getIdentPos {ins_ident, ins_pos}
-		= makeIdentPos ins_ident ins_pos
+		= newPosition ins_ident ins_pos
 
 instance getIdentPos FunDef where
 	getIdentPos {fun_symb, fun_pos}
-		= makeIdentPos fun_symb fun_pos
-
-makeIdentPos ident (FunPos  fileName lineNr _)
-	= { ip_ident=ident, ip_line=lineNr, ip_file=fileName}
-makeIdentPos ident (LinePos  fileName lineNr)
-	= { ip_ident=ident, ip_line=lineNr, ip_file=fileName}
-makeIdentPos ident NoPos
-	= { ip_ident=ident, ip_line=0, ip_file=""}
-	
+		= newPosition fun_symb fun_pos
+
 instance CorrespondenceNumber VarInfo where
 	toCorrespondenceNumber (VI_CorrespondenceNumber number)
-		=	Yes number
-	toCorrespondenceNumber _
-		=	No
-
+		=	CorrespondenceNumber number
+	toCorrespondenceNumber VI_Empty
+		=	Unbound
+		
 	fromCorrespondenceNumber number
 		=	VI_CorrespondenceNumber number
 
 instance CorrespondenceNumber TypeVarInfo where
 	toCorrespondenceNumber (TVI_CorrespondenceNumber number)
-		=	Yes number
-	toCorrespondenceNumber _
-		=	No
+		=	CorrespondenceNumber number
+	toCorrespondenceNumber TVI_Empty
+		=	Unbound
+	toCorrespondenceNumber (TVI_AType _)
+		=	Bound
 
 	fromCorrespondenceNumber number
 		=	TVI_CorrespondenceNumber number
 
 instance CorrespondenceNumber AttrVarInfo where
 	toCorrespondenceNumber (AVI_CorrespondenceNumber number)
-		=	Yes number
-	toCorrespondenceNumber _
-		=	No
+		=	CorrespondenceNumber number
+	toCorrespondenceNumber AVI_Empty
+		=	Unbound
 
 	fromCorrespondenceNumber number
 		=	AVI_CorrespondenceNumber number
@@ -295,9 +304,9 @@ tryToUnifyVars ptr1 ptr2 heapWithNumber
 	#! info1 = sreadPtr ptr1 heapWithNumber.hwn_heap
 	   info2 = sreadPtr ptr2 heapWithNumber.hwn_heap
 	=	case (toCorrespondenceNumber info1, toCorrespondenceNumber info2) of
-			(Yes number1, Yes number2)
+			(CorrespondenceNumber number1, CorrespondenceNumber number2)
 				->	(number1==number2, heapWithNumber)
-			(No, No)
+			(Unbound, Unbound)
  				->	(True, assignCorrespondenceNumber ptr1 ptr2 heapWithNumber)
 			_	->	(False, heapWithNumber)
 
@@ -348,12 +357,14 @@ instance t_corresponds (TypeDef TypeRhs) where
 				= undef <<- "t_corresponds (TypeDef): iclDef.td_arity <> length iclDef.td_args"
 		// ... sanity check
 			# tc_state = { tc_state & tc_visited_syn_types.[dclDef.td_index] = True }
-			  tc_state = init_atv_variables dclDef.td_args iclDef.td_args tc_state
+			  tc_state = init_attr_vars dclDef.td_attrs tc_state 
+			  tc_state = init_attr_vars iclDef.td_attrs tc_state 
+			  tc_state = init_atype_vars dclDef.td_args tc_state
+			  tc_state = init_atype_vars iclDef.td_args tc_state
 			  (corresponds, tc_state) = t_corresponds dclDef.td_args iclDef.td_args tc_state
 			| not corresponds
 				= (corresponds, tc_state)
-			# tc_state = init_attr_vars (dclDef.td_attrs++iclDef.td_attrs) tc_state
-			  icl_root_has_anonymous_attr = root_has_anonymous_attr iclDef.td_attribute iclDef.td_rhs
+			# icl_root_has_anonymous_attr = root_has_anonymous_attr iclDef.td_attribute iclDef.td_rhs
 			| icl_root_has_anonymous_attr<>root_has_anonymous_attr dclDef.td_attribute dclDef.td_rhs
 			  && isnt_abstract dclDef.td_rhs
 				= (False, tc_state)
@@ -378,15 +389,6 @@ instance t_corresponds (TypeDef TypeRhs) where
 		isnt_abstract (AbstractType _) = False
 		isnt_abstract _ = True
 		
-init_atv_variables [dcl_type_var:dcl_type_vars] [icl_type_var:icl_type_vars]
-					tc_state=:{tc_type_vars}
-	# tc_type_vars
-			= assignCorrespondenceNumber dcl_type_var.atv_variable.tv_info_ptr
-										icl_type_var.atv_variable.tv_info_ptr tc_type_vars
-	= init_atv_variables dcl_type_vars icl_type_vars { tc_state & tc_type_vars = tc_type_vars }
-init_atv_variables _ _ tc_state
-	= tc_state
-			
 instance t_corresponds TypeContext where
 	t_corresponds dclDef iclDef
 		=	t_corresponds dclDef.tc_class iclDef.tc_class
@@ -434,6 +436,12 @@ instance t_corresponds AType where
 				# ({dcl_common}, tc_state) = tc_state!tc_dcl_modules.[glob_module]
 				  type_def = dcl_common.com_type_defs.[glob_object]
 				= case type_def.td_rhs of
+					SynType {at_type=TV type_var, at_attribute}
+						// a "projection" type. attributes are treated in a special way
+						# arg_pos = get_arg_pos type_var type_def.td_args 0
+						  dcl_arg = dclArgs!!arg_pos
+						  coerced_dcl_arg = { dcl_arg & at_attribute = determine_type_attribute type_def.td_attribute }
+						-> t_corresponds coerced_dcl_arg icl_atype tc_state
 					SynType atype
 						# tc_state = { tc_state & tc_type_vars
 						  							= bind_type_vars type_def.td_args dclArgs tc_state.tc_type_vars }
@@ -441,7 +449,7 @@ instance t_corresponds AType where
 						  tc_state = opt_set_visited_bit is_defined_in_main_dcl glob_object True tc_state
 						  atype = { atype & at_attribute = determine_type_attribute type_def.td_attribute }
 						  (corresponds, tc_state) = t_corresponds atype icl_atype tc_state
-						# tc_state = opt_set_visited_bit is_defined_in_main_dcl glob_object False tc_state
+						  tc_state = opt_set_visited_bit is_defined_in_main_dcl glob_object False tc_state
 						-> (corresponds, tc_state) 
 					AbstractType _
 						#! icl_type_def = tc_state.tc_icl_type_defs.[tc_state.tc_type_conversions.[glob_object]]
@@ -450,22 +458,32 @@ instance t_corresponds AType where
 						  tc_state = init_attr_vars icl_type_def.td_attrs tc_state
 						-> case icl_type_def.td_rhs of
 							SynType atype
-								# atype = { atype & at_attribute = determine_type_attribute type_def.td_attribute } // XXX auch bei abstract types
+								# atype = { atype & at_attribute = determine_type_attribute type_def.td_attribute }
 								-> t_corresponds atype icl_atype tc_state
 							_	-> (False, tc_state)
 					_	-> (False, tc_state)
 			  where
+
 				bind_type_vars formal_args actual_args tc_type_vars
-					# (ok, hwn_heap) = bind_type_vars` formal_args actual_args tc_type_vars.hwn_heap
+					# hwn_heap = bind_type_vars` formal_args actual_args tc_type_vars.hwn_heap
 					= { tc_type_vars & hwn_heap = hwn_heap }
 			
 				bind_type_vars` [{atv_variable}:formal_args] [actual_arg:actual_args] type_var_heap
+					# (actual_arg, type_var_heap) = possibly_dereference actual_arg type_var_heap
 					= bind_type_vars` formal_args actual_args
 							(writePtr atv_variable.tv_info_ptr (TVI_AType actual_arg) type_var_heap)
-				bind_type_vars` [] [] type_var_heap
-					= (True, type_var_heap)
+							//	--->("binding", atv_variable.tv_name,"to",actual_arg)
 				bind_type_vars` _ _ type_var_heap
-					= (False, type_var_heap)
+					= type_var_heap
+				
+				possibly_dereference atype=:{at_type=TV {tv_info_ptr}} type_var_heap
+					#! dereferenced = sreadPtr tv_info_ptr type_var_heap
+					= case dereferenced of
+						TVI_AType atype2
+							-> (atype2, type_var_heap)
+						_	-> (atype, type_var_heap)
+				possibly_dereference atype type_var_heap
+					= (atype, type_var_heap)
 			
 				opt_set_visited_bit True glob_object bit tc_state
 					= { tc_state & tc_visited_syn_types.[glob_object] = bit }
@@ -474,6 +492,10 @@ instance t_corresponds AType where
 
 				determine_type_attribute TA_Unique	= TA_Unique
 				determine_type_attribute _			= TA_Multi
+				
+				get_arg_pos x [h:t] count
+					| x==h.atv_variable	= count
+										= get_arg_pos x t (inc count)
 
 instance t_corresponds TypeAttribute where
 	t_corresponds TA_Unique TA_Unique
@@ -482,7 +504,9 @@ instance t_corresponds TypeAttribute where
 		=	return True
 	t_corresponds (TA_Var dclDef) (TA_Var iclDef)
 		=	t_corresponds dclDef iclDef
-	t_corresponds _ TA_Anonymous // XXX comment
+	t_corresponds (TA_RootVar dclDef) (TA_RootVar iclDef)
+		=	t_corresponds dclDef iclDef
+	t_corresponds _ TA_Anonymous
 		=	return True
 	t_corresponds TA_None icl
 		= case icl of
@@ -575,20 +599,24 @@ instance t_corresponds FieldSymbol where
 
 instance t_corresponds ConsDef where
 	t_corresponds dclDef iclDef
-		=	exi_vars_correspond dclDef.cons_exi_vars iclDef.cons_exi_vars
+		=	do (init_atype_vars (dclDef.cons_exi_vars++iclDef.cons_exi_vars))
 		&&&	t_corresponds dclDef.cons_type iclDef.cons_type
 		&&& equal dclDef.cons_symb iclDef.cons_symb
 		&&& equal dclDef.cons_priority iclDef.cons_priority
 
 instance t_corresponds SelectorDef where
 	t_corresponds dclDef iclDef
-		=	exi_vars_correspond dclDef.sd_exi_vars iclDef.sd_exi_vars
+		=	do (init_atype_vars (dclDef.sd_exi_vars++iclDef.sd_exi_vars))
 		&&&	t_corresponds dclDef.sd_type iclDef.sd_type
 		&&& equal dclDef.sd_field_nr iclDef.sd_field_nr
 
-exi_vars_correspond dcl_exi_vars icl_exi_vars tc_state
-	# tc_state = init_atv_variables dcl_exi_vars icl_exi_vars tc_state
-	= t_corresponds dcl_exi_vars icl_exi_vars tc_state
+init_atype_vars atype_vars
+					tc_state=:{tc_type_vars}
+	# type_heap = foldSt init_type_var atype_vars tc_type_vars.hwn_heap
+	  tc_type_vars = { tc_type_vars & hwn_heap = type_heap }
+	= { tc_state & tc_type_vars = tc_type_vars }
+  where
+	init_type_var {atv_variable} type_heap = writePtr atv_variable.tv_info_ptr TVI_Empty type_heap
 
 instance t_corresponds SymbolType where
 	t_corresponds dclDef iclDef
@@ -604,14 +632,17 @@ instance t_corresponds AttrInequality where
 
 instance t_corresponds ClassDef where
 	t_corresponds dclDef iclDef
-		=	equal dclDef.class_name iclDef.class_name
+		=	do (init_type_vars (dclDef.class_args++iclDef.class_args))
+		&&&	equal dclDef.class_name iclDef.class_name
 		&&&	t_corresponds dclDef.class_args iclDef.class_args
 		&&&	t_corresponds dclDef.class_context iclDef.class_context
 		&&&	t_corresponds dclDef.class_members iclDef.class_members
 
 instance t_corresponds MemberDef where
 	t_corresponds dclDef iclDef
-		=	equal dclDef.me_symb iclDef.me_symb
+		=	do (init_type_vars (dclDef.me_type.st_vars++iclDef.me_type.st_vars))
+		&&&	do (init_attr_vars (dclDef.me_type.st_attr_vars++iclDef.me_type.st_attr_vars))
+		&&& equal dclDef.me_symb iclDef.me_symb
 		&&&	equal dclDef.me_offset iclDef.me_offset
 		&&&	equal dclDef.me_priority iclDef.me_priority
 		&&&	t_corresponds dclDef.me_type iclDef.me_type
@@ -623,10 +654,10 @@ instance t_corresponds ClassInstance where
 		t_corresponds` dclDef iclDef tc_state
 			# tc_state
 					= init_attr_vars (dclDef.it_attr_vars++iclDef.it_attr_vars) tc_state
-			  tc_type_vars
-			  		= init_type_vars (dclDef.it_vars++iclDef.it_vars) tc_state.tc_type_vars
+			  tc_state
+			  		= init_type_vars (dclDef.it_vars++iclDef.it_vars) tc_state
 			  (corresponds, tc_state)
-			  		=  t_corresponds dclDef.it_types iclDef.it_types { tc_state & tc_type_vars = tc_type_vars }
+			  		=  t_corresponds dclDef.it_types iclDef.it_types tc_state
 			| not corresponds
 				= (corresponds, tc_state)
 			=  t_corresponds dclDef.it_context iclDef.it_context tc_state
@@ -672,7 +703,7 @@ instance e_corresponds FunDef where
 	  where
 		fromBody (TransformedBody {tb_args, tb_rhs}) = (tb_args, [tb_rhs])
 		fromBody (CheckedBody {cb_args, cb_rhs}) = (cb_args, cb_rhs)
-
+		
 instance e_corresponds TransformedBody where
 	e_corresponds dclDef iclDef
 		=	e_corresponds dclDef.tb_args iclDef.tb_args
@@ -940,6 +971,8 @@ implies a b 		:== not a || b
 (o`) infixr 0
 (o`) f g :== \state -> g (f state)
 
+do f = \state -> (True, f state)
+
 // XXX should be a macro (but this crashes the 1.3.2 compiler)
 (&&&) infixr
 (&&&) m1 m2
diff --git a/frontend/main.icl b/frontend/main.icl
index d907e1c..a5251ce 100644
--- a/frontend/main.icl
+++ b/frontend/main.icl
@@ -21,15 +21,6 @@ Start world
 
 
 CommandLoop proj ms=:{ms_io}
-	# answer = "c t5\n"
-	  (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}
-		= ms
-
-/*
-CommandLoop proj ms=:{ms_io}
 	# (answer, ms_io)		= freadline (ms_io <<< "> ")
 	  (command, argument)	= SplitAtLayoutChar (dropWhile isSpace (fromString answer))
 	| command == []
@@ -38,7 +29,6 @@ CommandLoop proj ms=:{ms_io}
 		| ready
 			= ms
 			= CommandLoop proj ms
-*/
 
 ::	MainStateDefs funs funtypes types conses classes instances members selectors =
 	{	msd_funs		:: !funs
diff --git a/frontend/trans.icl b/frontend/trans.icl
index c9e2caf..c9cc4ab 100644
--- a/frontend/trans.icl
+++ b/frontend/trans.icl
@@ -1485,11 +1485,11 @@ createBindingsForUnifiedTypes type_1 type_2 all_type_vars type_var_heap
 				-> bind_and_unify_types root_1 root_2 type_var_heap
 	bind_and_unify_types (TV tv_1) type type_var_heap
 		| not (is_non_variable_type type)
-			= abort "compiler error in trans.icl: assertion failed (1)"
+			= abort "compiler error in trans.icl: assertion failed (1) XXX"
 		= bind_variable_to_type tv_1 type type_var_heap 
 	bind_and_unify_types type (TV tv_1) type_var_heap
 		| not (is_non_variable_type type)
-			= abort "compiler error in trans.icl: assertion failed (2)"
+			= abort "compiler error in trans.icl: assertion failed (2) XXX"
 		= bind_variable_to_type tv_1 type type_var_heap
 	bind_and_unify_types (TA _ arg_types1) (TA _ arg_types2) type_var_heap
 		= bind_and_unify_atype_lists arg_types1 arg_types2 type_var_heap
@@ -1499,8 +1499,12 @@ createBindingsForUnifiedTypes type_1 type_2 all_type_vars type_var_heap
 		= type_var_heap
 	bind_and_unify_types ((CV l1) :@: r1) ((CV l2) :@: r2) type_var_heap
 		= bind_and_unify_atype_lists r1 r2 (bind_and_unify_types (TV l1) (TV l2) type_var_heap)
-//	bind_and_unify_types x y _
-//		= abort ("bind_and_unify_types"--->(x,y))
+	bind_and_unify_types (TA type_symb r1) ((CV l2) :@: r2) type_var_heap
+		= bind_and_unify_atype_lists r1 r2 (bind_and_unify_types (TA type_symb []) (TV l2) type_var_heap)
+	bind_and_unify_types ((CV l1) :@: r1) (TA type_symb r2) type_var_heap
+		= bind_and_unify_atype_lists r1 r2 (bind_and_unify_types (TV l1) (TA type_symb []) type_var_heap)
+	bind_and_unify_types x y _
+		= abort ("bind_and_unify_types"--->(x,y))
 
 	bind_and_unify_atype_lists [] [] type_var_heap
 		= type_var_heap
@@ -1608,8 +1612,6 @@ transformFunctionApplication fun_def instances cc=:{cc_size, cc_args, cc_linear_
 	  	| containsProducer cc_size producers
 	  		# (is_new, fun_def_ptr, instances, ti_fun_heap) = tryToFindInstance producers instances ti.ti_fun_heap
 	  		| is_new
-//				| app_symb.symb_name.id_name=="_compr0" && (False--->(("TFA:",App app)--->instances))
-//					= undef
 	  			# (fun_index, fun_arity, ti) = generateFunction fun_def cc producers fun_def_ptr ro
 	  					(update_instance_info app_symb.symb_kind instances { ti & ti_fun_heap = ti_fun_heap, ti_trace = False })
 	  			  app_symb = { app_symb & symb_kind = SK_GeneratedFunction fun_def_ptr fun_index, symb_arity = length new_args}
@@ -1720,7 +1722,7 @@ where
 			= determineProducer is_applied_to_macro_fun linear_bit 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 :: !Bool !Bool !App !ExprInfo ![Expression] !Index !*{! Producer} !*TransformInfo -> (!*{! Producer}, ![Expression], !*TransformInfo)
 // XXX check for linear_bit also in case of a constructor ?
 determineProducer _ _ app=:{app_symb = symb=:{symb_kind = SK_Constructor _}, app_args} (EI_ClassTypes types) new_args prod_index producers ti
@@ -1732,7 +1734,6 @@ where
 		# (var_info, var_heap) = readVarInfo var_info_ptr var_heap
 		  (VI_Forward var) = var_info
 		= (Var var, writeVarInfo var_info_ptr VI_Empty (writeVarInfo var.var_info_ptr VI_Empty var_heap))
-// XXX /*
 determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{symb_kind = SK_Function { glob_module, glob_object }}, app_args} _
 				  new_args prod_index producers ti
 	| glob_module <> cIclModIndex
@@ -1758,16 +1759,6 @@ determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{ sy
 			Expanding _	-> (producers, [App app : new_args ], ti)
 			_			-> ({ producers & [prod_index] = PR_GeneratedFunction symb fun_index (length app_args)}, app_args ++ new_args, ti)
 	= (producers, [App app : new_args ], ti)
-/* MW..
-	| linear_bit
-		# (FI_Function {gf_fun_def}, ti_fun_heap) = readPtr fun_ptr ti_fun_heap
-		  ti = { ti & ti_fun_heap=ti_fun_heap }
-		= case gf_fun_def.fun_body of
-			Expanding	-> (producers, [App app : new_args ], ti)
-// ..MW
-			_			-> ({ producers & [prod_index] = PR_GeneratedFunction symb fun_index (length app_args)}, app_args ++ new_args, ti)
-	= (producers, [App app : new_args ], ti)
-*/
 // XXX 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)
 // XXX */