update of dictionary types

Peter's bug removed


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

7 files changed, 131 insertions, 101 deletions

diff --git a/frontend/overloading.dcl b/frontend/overloading.dcl
index e74304f..509dd8f 100644
--- a/frontend/overloading.dcl
+++ b/frontend/overloading.dcl
@@ -34,9 +34,10 @@ import syntax, check, typesupport
 	}
 
 ::	LocalTypePatternVariable
+::	DictionaryTypes :== [(Index, [ExprInfoPtr])]
 
 tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos, Index)] !{# CommonDefs } !ClassInstanceInfo !*Coercions !*OverloadingState
-	-> (![TypeContext], !*Coercions, ![LocalTypePatternVariable], !*OverloadingState)
+	-> (![TypeContext], !*Coercions, ![LocalTypePatternVariable], DictionaryTypes, !*OverloadingState)
 
 ::	TypeCodeInfo =
 	{	tci_next_index			:: !Index
diff --git a/frontend/overloading.icl b/frontend/overloading.icl
index 687edce..78e6657 100644
--- a/frontend/overloading.icl
+++ b/frontend/overloading.icl
@@ -521,20 +521,22 @@ where
 	try_specialized_instances type_contexts_types [] type_var_heap
 		= (ObjectNotFound, type_var_heap)
 
+::	DictionaryTypes :== [(Index, [ExprInfoPtr])]
+
 tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos, Index)] !{# CommonDefs } !ClassInstanceInfo !*Coercions !*OverloadingState
-	-> (![TypeContext], !*Coercions, ![LocalTypePatternVariable], !*OverloadingState)
+	-> (![TypeContext], !*Coercions, ![LocalTypePatternVariable], DictionaryTypes, !*OverloadingState)
 tryToSolveOverloading ocs defs instance_info coercion_env os
 	# (reduced_contexts, contexts, coercion_env, type_pattern_vars, os) = foldSt (reduce_contexts defs instance_info) ocs ([], [], coercion_env, [], os)
 	| os.os_error.ea_ok
 		# (contexts, os_var_heap) = foldSt add_spec_contexts ocs (contexts, os.os_var_heap)
 		  (contexts, os_type_heaps) = remove_sub_classes contexts os.os_type_heaps
-		  { hp_var_heap, hp_expression_heap, hp_type_heaps} = foldSt (convert_dictionaries defs contexts) reduced_contexts
-		  					{ hp_var_heap = os_var_heap, hp_expression_heap = os.os_symbol_heap, hp_type_heaps = os_type_heaps}
-		= (contexts, coercion_env, type_pattern_vars, { os & os_type_heaps = hp_type_heaps, os_symbol_heap = hp_expression_heap, os_var_heap = hp_var_heap })
-		= ([], coercion_env, type_pattern_vars, os)
+		  ({ hp_var_heap, hp_expression_heap, hp_type_heaps}, dict_types) = foldSt (convert_dictionaries defs contexts) reduced_contexts
+		  					({ hp_var_heap = os_var_heap, hp_expression_heap = os.os_symbol_heap, hp_type_heaps = os_type_heaps}, [])
+		= (contexts, coercion_env, type_pattern_vars, dict_types, { os & os_type_heaps = hp_type_heaps, os_symbol_heap = hp_expression_heap, os_var_heap = hp_var_heap} )
+		= ([], coercion_env, type_pattern_vars, [], os)
 where
 	reduce_contexts defs instance_info (opt_spec_contexts, expr_ptrs, pos, index) rc_state
-		= foldSt (reduce_contexts_of_application defs instance_info) expr_ptrs rc_state
+		= foldSt (reduce_contexts_of_application index defs instance_info) expr_ptrs rc_state
 
 	add_spec_contexts (Yes spec_context, expr_ptrs, pos, index) contexts_and_var_heap
 		= foldSt add_spec_context spec_context contexts_and_var_heap
@@ -547,10 +549,10 @@ where
 	add_spec_contexts (No, expr_ptrs, pos, index) contexts_and_var_heap
 		= contexts_and_var_heap
 
-	reduce_contexts_of_application :: !{# CommonDefs } !ClassInstanceInfo  !ExprInfoPtr
-				([(SymbIdent, ExprInfoPtr,[ClassApplication])], ![TypeContext], !*Coercions, ![LocalTypePatternVariable], !*OverloadingState)
-					 -> ([(SymbIdent, ExprInfoPtr,[ClassApplication])], ![TypeContext], !*Coercions, ![LocalTypePatternVariable], !*OverloadingState)
-	reduce_contexts_of_application  defs instance_info over_info_ptr (reduced_calls, new_contexts, coercion_env, type_pattern_vars,
+	reduce_contexts_of_application :: !Index !{# CommonDefs } !ClassInstanceInfo  !ExprInfoPtr
+				([(SymbIdent, Index, ExprInfoPtr,[ClassApplication])], ![TypeContext], !*Coercions, ![LocalTypePatternVariable], !*OverloadingState)
+					 -> ([(SymbIdent, Index, ExprInfoPtr,[ClassApplication])], ![TypeContext], !*Coercions, ![LocalTypePatternVariable], !*OverloadingState)
+	reduce_contexts_of_application fun_index defs instance_info over_info_ptr (reduced_calls, new_contexts, coercion_env, type_pattern_vars,
 			os=:{os_symbol_heap,os_type_heaps,os_var_heap,os_special_instances,os_error,os_predef_symbols})
 		# (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
@@ -563,7 +565,7 @@ where
 								(os_var_heap, os_type_heaps), coercion_env, os_predef_symbols, os_error)
 					= reduceContexts oc_context defs instance_info new_contexts os_special_instances type_pattern_vars
 							(os_var_heap, os_type_heaps) coercion_env os_predef_symbols os_error
-			= ([ (oc_symbol, over_info_ptr, class_applications) : reduced_calls ], new_contexts, coercion_env, type_pattern_vars, 
+			= ([ (oc_symbol, fun_index, over_info_ptr, class_applications) : reduced_calls ], new_contexts, coercion_env, type_pattern_vars, 
 					{ os & os_type_heaps = os_type_heaps, os_symbol_heap = os_symbol_heap, os_var_heap = os_var_heap,
 						   os_special_instances = os_special_instances, os_error = os_error, os_predef_symbols = os_predef_symbols })
 
@@ -588,9 +590,19 @@ where
 			= context
 			= [tc : context]
 
-	convert_dictionaries :: !{# CommonDefs } ![TypeContext] !(!SymbIdent,!ExprInfoPtr,![ClassApplication]) !*Heaps -> *Heaps
-	convert_dictionaries defs contexts (oc_symbol, over_info_ptr, class_applications) heaps
-		= convertOverloadedCall defs contexts oc_symbol over_info_ptr class_applications heaps
+	convert_dictionaries :: !{# CommonDefs } ![TypeContext] !(!SymbIdent,!Index,!ExprInfoPtr,![ClassApplication]) !(!*Heaps,!DictionaryTypes) -> (!*Heaps,!DictionaryTypes)
+	convert_dictionaries defs contexts (oc_symbol, index, over_info_ptr, class_applications) (heaps, dict_types)
+		# (heaps, ptrs) = convertOverloadedCall defs contexts oc_symbol over_info_ptr class_applications (heaps, [])
+		| isEmpty ptrs
+			= (heaps, dict_types)
+			= (heaps, add_to_dict_types index ptrs dict_types)
+	
+	add_to_dict_types index ptrs []
+		= [(index, ptrs)]
+	add_to_dict_types new_index new_ptrs dt=:[(index, ptrs) : dict_types]
+		| new_index == index
+			= [(index, new_ptrs ++ ptrs) : dict_types]
+			= [(new_index, new_ptrs) : dt]
 	
 selectFromDictionary  dict_mod dict_index member_index defs
 	# (RecordType {rt_fields}) = defs.[dict_mod].com_type_defs.[dict_index].td_rhs
@@ -602,30 +614,30 @@ getDictionaryTypeAndConstructor {glob_module, glob_object = {ds_ident,ds_index}}
 	  (RecordType {rt_constructor}) = defs.[glob_module].com_type_defs.[class_dictionary.ds_index].td_rhs
 	= (class_dictionary, rt_constructor)
 
-convertOverloadedCall :: !{#CommonDefs} ![TypeContext] !SymbIdent !ExprInfoPtr ![ClassApplication] !*Heaps -> *Heaps
-convertOverloadedCall defs contexts {symb_name,symb_kind = SK_OverloadedFunction {glob_module,glob_object}, symb_arity} expr_ptr [class_appl:class_appls] heaps
+convertOverloadedCall :: !{#CommonDefs} ![TypeContext] !SymbIdent !ExprInfoPtr ![ClassApplication] !(!*Heaps, ![ExprInfoPtr]) -> (!*Heaps, ![ExprInfoPtr])
+convertOverloadedCall defs contexts {symb_name,symb_kind = SK_OverloadedFunction {glob_module,glob_object}, symb_arity} expr_ptr [class_appl:class_appls] heaps_and_ptrs
 	# mem_def = defs.[glob_module].com_member_defs.[glob_object]
-	  (class_exprs, heaps) = convertClassApplsToExpressions defs contexts class_appls heaps
-	  (inst_expr, heaps) = adjust_member_application defs contexts  mem_def symb_arity class_appl class_exprs heaps
-	= { heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_ptr, inst_expr)}
+	  (class_exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts class_appls heaps_and_ptrs
+	  (inst_expr, (heaps, ptrs)) = adjust_member_application defs contexts  mem_def symb_arity class_appl class_exprs heaps_and_ptrs
+	= ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_ptr, inst_expr)}, ptrs)
 where
-	adjust_member_application defs contexts {me_symb,me_offset,me_class} symb_arity (CA_Instance red_contexts) class_exprs heaps
+	adjust_member_application defs contexts {me_symb,me_offset,me_class} symb_arity (CA_Instance red_contexts) class_exprs heaps_and_ptrs
 		# ({glob_module,glob_object}, red_contexts) = find_instance_of_member me_class me_offset red_contexts
-		  (exprs, heaps) = convertClassApplsToExpressions defs contexts red_contexts heaps
+		  (exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts red_contexts heaps_and_ptrs
 		  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,
-			 heaps)
-	adjust_member_application  defs contexts  {me_symb,me_offset,me_class={glob_module,glob_object}} symb_arity (CA_Context tc) class_exprs heaps=:{hp_type_heaps}
+			 heaps_and_ptrs)
+	adjust_member_application  defs contexts  {me_symb,me_offset,me_class={glob_module,glob_object}} symb_arity (CA_Context tc) class_exprs (heaps=:{hp_type_heaps}, ptrs)
 		# (class_context, address, hp_type_heaps) = determineContextAddress contexts defs tc hp_type_heaps
 		  {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]) class_context.tc_var class_exprs,
-				{ heaps & hp_type_heaps = hp_type_heaps } )
-	adjust_member_application defs contexts  _ _ (CA_GlobalTypeCode {tci_index,tci_contexts}) _ heaps
-		# (exprs, heaps) = convertClassApplsToExpressions defs contexts tci_contexts heaps
-		= (EI_TypeCode (TCE_Constructor tci_index (map expressionToTypeCodeExpression exprs)), heaps)
-	adjust_member_application defs contexts _ _ (CA_LocalTypeCode new_var_ptr) _  heaps
-		= (EI_TypeCode (TCE_Var new_var_ptr), heaps)
+				({ heaps & hp_type_heaps = hp_type_heaps }, ptrs))
+	adjust_member_application defs contexts  _ _ (CA_GlobalTypeCode {tci_index,tci_contexts}) _ heaps_and_ptrs
+		# (exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts tci_contexts heaps_and_ptrs
+		= (EI_TypeCode (TCE_Constructor tci_index (map expressionToTypeCodeExpression exprs)), heaps_and_ptrs)
+	adjust_member_application defs contexts _ _ (CA_LocalTypeCode new_var_ptr) _  heaps_and_ptrs
+		= (EI_TypeCode (TCE_Var new_var_ptr), heaps_and_ptrs)
 	
 	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
@@ -636,13 +648,12 @@ where
 			= 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"
-convertOverloadedCall defs contexts {symb_name,symb_kind = SK_TypeCode} expr_info_ptr class_appls heaps
-	# (class_expressions, heaps) = convertClassApplsToExpressions defs contexts class_appls heaps
-//	= abort ("convertOverloadedCall" +++ toString  symb_name) // class_expressions
-	= { heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_info_ptr, EI_TypeCodes (map expressionToTypeCodeExpression class_expressions))}
-convertOverloadedCall defs contexts {symb_name} expr_info_ptr appls heaps
-	# (class_expressions, heaps) = convertClassApplsToExpressions defs contexts appls heaps
-	= { heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_info_ptr, EI_Context class_expressions)}
+convertOverloadedCall defs contexts {symb_name,symb_kind = SK_TypeCode} expr_info_ptr class_appls heaps_and_ptrs
+	# (class_expressions, (heaps, ptrs)) = convertClassApplsToExpressions defs contexts class_appls heaps_and_ptrs
+	= ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_info_ptr, EI_TypeCodes (map expressionToTypeCodeExpression class_expressions))}, ptrs)
+convertOverloadedCall defs contexts {symb_name} expr_info_ptr appls heaps_and_ptrs
+	# (class_expressions, (heaps, ptrs)) = convertClassApplsToExpressions defs contexts appls heaps_and_ptrs
+	= ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_info_ptr, EI_Context class_expressions)}, ptrs)
 
 
 expressionToTypeCodeExpression (TypeCodeExpression texpr) 			= texpr
@@ -665,42 +676,42 @@ where
 	toString (CA_LocalTypeCode _)	= abort "CA_LocalTypeCode"
 	toString (CA_GlobalTypeCode _) 	= abort "CA_GlobalTypeCode"
 
-convertClassApplsToExpressions defs contexts cl_appls heaps
-	= mapSt (convert_class_appl_to_expression defs contexts) cl_appls heaps
+convertClassApplsToExpressions defs contexts cl_appls heaps_and_ptrs
+	= mapSt (convert_class_appl_to_expression defs contexts) cl_appls heaps_and_ptrs
 where
-	convert_class_appl_to_expression defs contexts (CA_Instance rcs) heaps
-		= convert_reduced_contexts_to_expression defs contexts rcs heaps
-	convert_class_appl_to_expression defs contexts (CA_Context tc) heaps=:{hp_type_heaps}
+	convert_class_appl_to_expression defs contexts (CA_Instance rcs) heaps_and_ptrs
+		= convert_reduced_contexts_to_expression defs contexts rcs heaps_and_ptrs
+	convert_class_appl_to_expression defs contexts (CA_Context tc) (heaps=:{hp_type_heaps}, ptrs)
 		# (class_context, context_address, hp_type_heaps) = determineContextAddress contexts defs tc hp_type_heaps
 		| isEmpty context_address
-			= (ClassVariable class_context.tc_var, { heaps & hp_type_heaps = hp_type_heaps })
-			= (Selection No (ClassVariable class_context.tc_var) (generateClassSelection context_address []), { heaps & hp_type_heaps = hp_type_heaps })
-	convert_class_appl_to_expression defs contexts (CA_LocalTypeCode new_var_ptr) heaps
-		= (TypeCodeExpression (TCE_Var new_var_ptr), heaps)
-	convert_class_appl_to_expression defs contexts (CA_GlobalTypeCode {tci_index,tci_contexts}) heaps
-		# (exprs, heaps) = convertClassApplsToExpressions defs contexts tci_contexts heaps
-		= (TypeCodeExpression (TCE_Constructor tci_index (map expressionToTypeCodeExpression exprs)), heaps)
-
-	convert_reduced_contexts_to_expression defs contexts {rcs_class_context,rcs_constraints_contexts} heaps
-		# (rcs_exprs, heaps) = mapSt (convert_reduced_contexts_to_expression defs contexts) rcs_constraints_contexts heaps
-		= convert_reduced_context_to_expression defs contexts rcs_class_context rcs_exprs heaps
+			= (ClassVariable class_context.tc_var, ({ heaps & hp_type_heaps = hp_type_heaps }, ptrs))
+			= (Selection No (ClassVariable class_context.tc_var) (generateClassSelection context_address []), ({ heaps & hp_type_heaps = hp_type_heaps }, ptrs))
+	convert_class_appl_to_expression defs contexts (CA_LocalTypeCode new_var_ptr) heaps_and_ptrs
+		= (TypeCodeExpression (TCE_Var new_var_ptr), heaps_and_ptrs)
+	convert_class_appl_to_expression defs contexts (CA_GlobalTypeCode {tci_index,tci_contexts}) heaps_and_ptrs
+		# (exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts tci_contexts heaps_and_ptrs
+		= (TypeCodeExpression (TCE_Constructor tci_index (map expressionToTypeCodeExpression exprs)), heaps_and_ptrs)
+
+	convert_reduced_contexts_to_expression defs contexts {rcs_class_context,rcs_constraints_contexts} heaps_and_ptrs
+		# (rcs_exprs, heaps_and_ptrs) = mapSt (convert_reduced_contexts_to_expression defs contexts) rcs_constraints_contexts heaps_and_ptrs
+		= convert_reduced_context_to_expression defs contexts rcs_class_context rcs_exprs heaps_and_ptrs
 	where	
-		convert_reduced_context_to_expression defs contexts {rc_class, rc_inst_module, rc_inst_members, rc_red_contexts, rc_types} dictionary_args heaps
-			# (expressions, heaps) = convertClassApplsToExpressions defs contexts rc_red_contexts heaps
+		convert_reduced_context_to_expression defs contexts {rc_class, rc_inst_module, rc_inst_members, rc_red_contexts, rc_types} dictionary_args heaps_and_ptrs
+			# (expressions, (heaps, class_ptrs)) = convertClassApplsToExpressions defs contexts rc_red_contexts heaps_and_ptrs
 			  context_size = length expressions
 			| size rc_inst_members > 1 && context_size > 0
 				# (let_binds, let_types, rev_dicts, hp_var_heap, hp_expression_heap)
 						= foldSt (bind_shared_dictionary (size rc_inst_members)) expressions ([], [], [], heaps.hp_var_heap, heaps.hp_expression_heap)
 				  dictionary_args = build_class_members (size rc_inst_members) rc_inst_members rc_inst_module (reverse rev_dicts) context_size dictionary_args
-				  (dict_expr, hp_expression_heap) = build_dictionary rc_class rc_types dictionary_args defs hp_expression_heap
+				  (dict_expr, hp_expression_heap, class_ptrs) = build_dictionary rc_class rc_types dictionary_args defs hp_expression_heap class_ptrs
 				| isEmpty let_binds
-					= (dict_expr, { heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap })
+					= (dict_expr, ({ heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap }, class_ptrs))
 					# (let_info_ptr, hp_expression_heap) = newPtr (EI_LetType let_types) hp_expression_heap
 					= (Let { let_strict_binds = [], let_lazy_binds = let_binds, let_expr = dict_expr, let_info_ptr = let_info_ptr },
-						{ heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap })
+						({ heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap }, [let_info_ptr : class_ptrs]))
 				# dictionary_args = build_class_members (size rc_inst_members) rc_inst_members rc_inst_module expressions context_size dictionary_args
-				  (dict_expr, hp_expression_heap) = build_dictionary rc_class rc_types dictionary_args defs heaps.hp_expression_heap
-				= (dict_expr, { heaps & hp_expression_heap = hp_expression_heap })
+				  (dict_expr, hp_expression_heap, class_ptrs) = build_dictionary rc_class rc_types dictionary_args defs heaps.hp_expression_heap class_ptrs
+				= (dict_expr, ({ heaps & hp_expression_heap = hp_expression_heap }, class_ptrs))
 
 		build_class_members mem_offset ins_members mod_index class_arguments arity dictionary_args
 			| mem_offset == 0
@@ -715,7 +726,7 @@ where
 									app_info_ptr = nilPtr }
 				= build_class_members mem_offset ins_members mod_index class_arguments arity [ mem_expr : dictionary_args ]
 		
-		build_dictionary class_symbol instance_types dictionary_args defs expr_heap
+		build_dictionary class_symbol instance_types dictionary_args defs expr_heap ptrs
 			# (dict_type, dict_cons) = getDictionaryTypeAndConstructor class_symbol defs
 			  record_symbol = { symb_name = dict_cons.ds_ident,		  
 			  					symb_kind = SK_Constructor {glob_module = class_symbol.glob_module, glob_object = dict_cons.ds_index},
@@ -724,7 +735,7 @@ where
 			  class_type = TA dict_type_symbol [ AttributedType type \\ type <- instance_types ]
 			  (app_info_ptr, expr_heap) = newPtr (EI_DictionaryType class_type) expr_heap
 			  rc_record = App { app_symb = record_symbol, app_args = dictionary_args, app_info_ptr = app_info_ptr }
-			= (rc_record, expr_heap)
+			= (rc_record, expr_heap, [app_info_ptr : ptrs])
 
 		bind_shared_dictionary nr_of_members dict=:(Let {let_expr=App {app_symb={symb_name}, app_info_ptr}}) (binds, types, rev_dicts, var_heap, expr_heap)
 			# (EI_DictionaryType class_type, expr_heap) = readPtr app_info_ptr expr_heap
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 4ce566e..283669d 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -4,6 +4,8 @@ import StdEnv
 
 import scanner, general, typeproperties, Heap
 
+PA_BUG on off :== on
+
 ::	Ident =
 	{ 	id_name		:: !String
 	,	id_info 	:: !SymbolPtr
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index ef5834a..643fbd3 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -6,6 +6,8 @@ import RWSDebug
 
 import scanner, general, Heap, typeproperties, utilities
 
+PA_BUG on off :== on
+
 ::	Ident =
 	{ 	id_name		:: !String
 	,	id_info 	:: !SymbolPtr
@@ -1157,8 +1159,6 @@ where
 		= "u" + toString tav_number + ": "
 	toString (TA_Var avar)
 		= toString avar + ": "
-	toString TA_TempExVar
-		= "(E)"
 	toString (TA_RootVar avar)
 		= toString avar + ": "
 	toString (TA_Anonymous)
@@ -1169,6 +1169,8 @@ where
 		= "o "
 	toString (TA_List _ _)
 		= "??? "
+	toString TA_TempExVar
+		= PA_BUG "(E)" (abort "toString TA_TempExVar")
 
 instance <<< Annotation
 where
diff --git a/frontend/type.icl b/frontend/type.icl
index 4f56fa9..001c608 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -357,8 +357,7 @@ freshCopyOfTypeAttribute (TA_Var avar) attr_var_heap
 /* Should be removed !!!!!!!!!! */
 
 freshCopyOfTypeAttribute (TA_RootVar avar) attr_var_heap
-//	= freshCopyOfAttributeVar avar attr_var_heap
-	= (TA_TempExVar, attr_var_heap)
+	= PA_BUG (TA_TempExVar, 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
@@ -1324,42 +1323,51 @@ specification_error type err
 	  format = { form_properties = cAttributed, form_attr_position = No}
 	= { err & ea_file = err.ea_file <<< " specified type conflicts with derived type " <:: (format, type) <<< '\n' }
 
-cleanUpAndCheckFunctionTypes [] _ start_index defs type_contexts coercion_env attr_partition type_var_env attr_var_env (fun_defs, ts)
+
+cleanUpAndCheckFunctionTypes [] _ _ start_index defs type_contexts coercion_env attr_partition type_var_env attr_var_env (fun_defs, ts)
 	= (fun_defs, ts)
-cleanUpAndCheckFunctionTypes [fun : funs] [ {fe_requirements = {req_case_and_let_exprs}} : reqs] start_index defs type_contexts coercion_env
+cleanUpAndCheckFunctionTypes [fun : funs] [ {fe_requirements = {req_case_and_let_exprs}} : reqs] dict_types start_index defs type_contexts coercion_env
 				attr_partition type_var_env attr_var_env (fun_defs, ts)
 	# (fd, fun_defs) = fun_defs![fun]
-	# (type_var_env, attr_var_env, ts) = clean_up_and_check_function_type fd fun (start_index == fun) defs type_contexts
-				req_case_and_let_exprs coercion_env attr_partition type_var_env attr_var_env ts
-	= cleanUpAndCheckFunctionTypes funs reqs start_index defs type_contexts coercion_env attr_partition type_var_env attr_var_env (fun_defs, ts)
+	  dict_ptrs = get_dict_ptrs fun dict_types
+	  (type_var_env, attr_var_env, ts) = clean_up_and_check_function_type fd fun (start_index == fun) defs type_contexts
+													(dict_ptrs ++ req_case_and_let_exprs) coercion_env attr_partition type_var_env attr_var_env ts
+	= cleanUpAndCheckFunctionTypes funs reqs dict_types start_index 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 is_start_rule defs type_contexts case_and_let_exprs
+	get_dict_ptrs fun_index []
+		= []
+	get_dict_ptrs fun_index [(index, ptrs) : dict_types]
+		| fun_index == index
+			= ptrs
+			= get_dict_ptrs fun_index dict_types
+		
+	clean_up_and_check_function_type {fun_symb,fun_pos,fun_type = opt_fun_type} fun is_start_rule defs type_contexts type_ptrs
 					coercion_env attr_partition type_var_env attr_var_env ts
 		# (env_type, ts) = 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_var_heap, ts_expr_heap, ts_error)
-					= cleanUpSymbolType is_start_rule cSpecifiedType exp_fun_type type_contexts case_and_let_exprs coercion_env 
+					= cleanUpSymbolType is_start_rule cSpecifiedType exp_fun_type type_contexts type_ptrs coercion_env 
 										attr_partition type_var_env attr_var_env ts.ts_type_heaps ts.ts_var_heap ts.ts_expr_heap ts.ts_error
 				| ts_error.ea_ok
 					# (ts_fun_env, attr_var_env, ts_type_heaps, ts_expr_heap, ts_error)
-			  			= check_function_type fun_type tmp_fun_type clean_fun_type case_and_let_exprs defs ts.ts_fun_env attr_var_env ts_type_heaps ts_expr_heap ts_error
+			  			= check_function_type fun_type tmp_fun_type clean_fun_type type_ptrs defs ts.ts_fun_env attr_var_env ts_type_heaps ts_expr_heap ts_error
 					-> (type_var_env, attr_var_env, { ts & ts_type_heaps = ts_type_heaps, ts_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, ts_fun_env = ts_fun_env, ts_error = ts_error })
 					-> (type_var_env, attr_var_env, { ts & ts_type_heaps = ts_type_heaps, ts_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, ts_error = ts_error })
 		  	UncheckedType exp_fun_type
 				# (clean_fun_type, type_var_env, attr_var_env, ts_type_heaps, ts_var_heap, ts_expr_heap, ts_error)
-					= cleanUpSymbolType is_start_rule cDerivedType exp_fun_type type_contexts case_and_let_exprs coercion_env
+					= cleanUpSymbolType is_start_rule cDerivedType exp_fun_type type_contexts type_ptrs coercion_env
 										attr_partition type_var_env attr_var_env ts.ts_type_heaps ts.ts_var_heap ts.ts_expr_heap 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_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, 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, st_context} case_and_let_exprs
+	check_function_type fun_type tmp_fun_type=:{tst_lifted} clean_fun_type=:{st_arity, st_args, st_vars, st_attr_vars, st_context} type_ptrs
 				defs fun_env attr_var_env type_heaps expr_heap error
 		# (equi, attr_var_env, type_heaps) = equivalent clean_fun_type tmp_fun_type (length fun_type.st_context) defs attr_var_env type_heaps
 		| equi
 			# type_with_lifted_arg_types = addLiftedArgumentsToSymbolType fun_type tst_lifted st_args st_vars st_attr_vars st_context
-			  (type_heaps, expr_heap) = updateExpressionTypes clean_fun_type type_with_lifted_arg_types case_and_let_exprs type_heaps expr_heap
+			  (type_heaps, expr_heap) = updateExpressionTypes clean_fun_type type_with_lifted_arg_types type_ptrs type_heaps expr_heap
 			= ({ fun_env & [fun] = CheckedType type_with_lifted_arg_types}, attr_var_env, type_heaps, expr_heap, error)
 //					---> ("check_function_type", clean_fun_type, fun_type, type_with_lifted_arg_types)
 			= (fun_env, attr_var_env, type_heaps, expr_heap, specification_error clean_fun_type error)
@@ -1529,8 +1537,7 @@ where
 		  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,
+		  (contexts, coercion_env, local_pattern_variables, dict_types,
 		  	{ 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,
@@ -1547,7 +1554,7 @@ where
 		  (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 fun_reqs start_index ti_common_defs contexts coer_demanded attr_partition var_env attr_var_env
+		  (fun_defs, ts) = cleanUpAndCheckFunctionTypes comp fun_reqs dict_types start_index 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
@@ -1628,32 +1635,32 @@ where
 	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, fe_index}:reqs] calls (subst, expr_heap)
-		# (context, subst) = arraySubst context subst 
+	collect_and_expand_overloaded_calls [{ fe_context=Yes context, fe_requirements={req_overloaded_calls,req_case_and_let_exprs}, fe_location, fe_index}:reqs] calls (subst, expr_heap)
+		# (context, subst) = arraySubst context subst
+		  subst_expr_heap = expand_case_or_let_types req_case_and_let_exprs (subst, expr_heap)
 		= collect_and_expand_overloaded_calls reqs [(Yes context, req_overloaded_calls, fe_location, fe_index) : 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, fe_index}:reqs] calls (subst, expr_heap)
+				(foldSt expand_type_contexts req_overloaded_calls subst_expr_heap) 	
+	collect_and_expand_overloaded_calls [{fe_context, fe_requirements={req_overloaded_calls,req_case_and_let_exprs}, fe_location, fe_index}:reqs] calls subst_expr_heap
+		# subst_expr_heap = expand_case_or_let_types req_case_and_let_exprs subst_expr_heap
 		= collect_and_expand_overloaded_calls reqs [(fe_context, req_overloaded_calls, fe_location, fe_index) : calls]
-				(foldSt expand_type_contexts req_overloaded_calls (subst, expr_heap)) 
+				(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 })) //---> 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_types info_ptrs subst_expr_heap
+		= foldSt expand_case_or_let_type info_ptrs subst_expr_heap
 
-	expand_case_or_let_type (expr_heap, subst) info_ptr
+	expand_case_or_let_type info_ptr (subst, expr_heap)
 		= case (readPtr info_ptr expr_heap) of
 			(EI_CaseType case_type, expr_heap)
 				# (case_type, subst) = arraySubst case_type subst
-				-> (expr_heap <:= (info_ptr, EI_CaseType case_type), subst)
+				-> (subst, expr_heap <:= (info_ptr, EI_CaseType case_type))
 			(EI_LetType let_type, expr_heap)
 				# (let_type, subst) = arraySubst let_type subst
-				-> (expr_heap <:= (info_ptr, EI_LetType let_type), subst)
+				-> (subst, expr_heap <:= (info_ptr, EI_LetType let_type))
 
 	expand_function_types :: ![Int] !*{!Type} *{! FunctionType} -> (!*{!Type}, *{! FunctionType})
 	expand_function_types [fun : funs] subst ts_fun_env
diff --git a/frontend/typesupport.icl b/frontend/typesupport.icl
index 8d096e8..4bec518 100644
--- a/frontend/typesupport.icl
+++ b/frontend/typesupport.icl
@@ -66,8 +66,6 @@ attrIsUndefined _ 		= False
 
 instance clean_up TypeAttribute
 where
-	clean_up cui TA_TempExVar cus
-		= (TA_Multi, cus)
 	clean_up cui TA_Unique cus
 		= (TA_Unique, cus)
 	clean_up cui TA_Multi cus
@@ -88,6 +86,8 @@ where
 						 cus_heaps = { cus_heaps & th_attrs = th_attrs }, cus_attr_store = inc cus_attr_store})
 				= (attr, cus)
 			= (TA_Multi, cus)
+	clean_up cui TA_TempExVar cus
+		= PA_BUG (TA_Multi, cus) (abort "clean_up cui (TA_TempExVar)")
 			
 instance clean_up Type
 where
@@ -386,6 +386,10 @@ where
 			EI_LetType let_type
 				# (let_type, cus) = clean_up cui let_type cus
 				-> (expr_heap <:= (expr_ptr, EI_LetType let_type), cus)
+			EI_DictionaryType dict_type
+				# (dict_type, cus) = clean_up cui dict_type cus
+				-> (expr_heap <:= (expr_ptr, EI_DictionaryType dict_type), cus)
+
 
  	check_type_of_start_rule is_start_rule {st_context,st_arity,st_args} cus_error
  		| is_start_rule
@@ -422,12 +426,12 @@ where
 */ 
 
 updateExpressionTypes :: !SymbolType !SymbolType ![ExprInfoPtr] !*TypeHeaps !*ExpressionHeap -> (!*TypeHeaps, !*ExpressionHeap)
-updateExpressionTypes {st_args,st_vars,st_result,st_attr_vars} st_copy case_and_let_exprs heaps=:{th_vars,th_attrs} expr_heap
+updateExpressionTypes {st_args,st_vars,st_result,st_attr_vars} st_copy type_ptrs heaps=:{th_vars,th_attrs} expr_heap
 	# th_vars = foldSt (\{tv_info_ptr} var_heap -> var_heap <:= (tv_info_ptr, TVI_Empty)) st_vars th_vars
 	  th_attrs = foldSt (\{av_info_ptr} attr_heap -> attr_heap <:= (av_info_ptr, AVI_Empty)) st_attr_vars th_attrs
 	  th_vars = bindInstances st_args st_copy.st_args th_vars
 	  th_vars = bindInstances st_result st_copy.st_result th_vars
-	= foldSt update_expression_type case_and_let_exprs ({heaps & th_vars = th_vars, th_attrs = th_attrs}, expr_heap)
+	= foldSt update_expression_type type_ptrs ({heaps & th_vars = th_vars, th_attrs = th_attrs}, expr_heap)
 where
 	update_expression_type expr_ptr (type_heaps, expr_heap)
 		# (info, expr_heap) = readPtr expr_ptr expr_heap
@@ -438,6 +442,9 @@ where
 			EI_LetType let_type
 				# (let_type, type_heaps) = substitute let_type type_heaps
 				-> (type_heaps, expr_heap <:= (expr_ptr, EI_LetType let_type))
+			EI_DictionaryType dict_type
+				# (dict_type, type_heaps) = substitute dict_type type_heaps
+				-> (type_heaps, expr_heap <:= (expr_ptr, EI_DictionaryType dict_type))
 
 
 class bindInstances a :: !a !a !*TypeVarHeap -> *TypeVarHeap
@@ -877,14 +884,14 @@ where
 			= file <<< '*' 
 		show_attribute TA_Multi coercions file 
 			= file 
-		show_attribute TA_TempExVar coercions file 
-			= file <<< "(E)" 
 		show_attribute (TA_TempVar av_number) coercions file 
 			| isUniqueAttribute av_number coercions
 				= file <<< '*' 
 			| isNonUniqueAttribute av_number coercions
 				= file 
 				= file <<< '.' <<< "[[" <<< av_number <<< "]]"
+		show_attribute TA_TempExVar coercions file 
+			= PA_BUG (file <<< "(E)") (abort "show_attribute TA_TempExVar")
 
 instance <:: Type
 where
diff --git a/frontend/unitype.icl b/frontend/unitype.icl
index add10e3..c2031ed 100644
--- a/frontend/unitype.icl
+++ b/frontend/unitype.icl
@@ -402,7 +402,7 @@ where
 	 toInt (TA_TempVar av_number)	= av_number
 	 toInt TA_Multi 				= AttrMulti
 	 toInt TA_None 					= AttrMulti
-	 toInt TA_TempExVar 			= AttrExi
+	 toInt TA_TempExVar 			= PA_BUG AttrExi (abort "toInt TA_TempExVar")
 
 
 ::	CoercionState =
@@ -423,9 +423,9 @@ offered_attribute according to sign. Failure is indicated by returning False as
 /* Just Temporary */
 
 coerceAttributes TA_TempExVar dem_attr _ coercions
-	= (True, coercions)
+	= PA_BUG (True, coercions) (abort "coerceAttributes TA_TempExVar")
 coerceAttributes _ TA_TempExVar _ coercions
-	= (True, coercions)
+	= PA_BUG (True, coercions) (abort "coerceAttributes TA_TempExVar")
 /* ... remove this !!!! */
 
 coerceAttributes TA_Unique dem_attr {neg_sign} coercions