add extendable algebraic data types (merged from iTask branch)

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

22 files changed, 445 insertions, 160 deletions

diff --git a/backend/Windows/Clean System Files/backend_library b/backend/Windows/Clean System Files/backend_library
index 9e7fbc5..04493a1 100644
--- a/backend/Windows/Clean System Files/backend_library
+++ b/backend/Windows/Clean System Files/backend_library
@@ -85,6 +85,7 @@ BETypes
 BENoTypes
 BEFlatType
 BEAlgebraicType
+BEExtendableAlgebraicType
 BERecordType
 BEAbsType
 BEConstructors
diff --git a/backend/backend.dcl b/backend/backend.dcl
index cfc7b1b..d9f959f 100644
--- a/backend/backend.dcl
+++ b/backend/backend.dcl
@@ -205,6 +205,8 @@ BEFlatType :: !BESymbolP !BEAttribution !BETypeVarListP !BackEnd -> (!BEFlatType
 // BEFlatTypeP BEFlatType (BESymbolP symbol,BEAttribution attribution,BETypeVarListP arguments);
 BEAlgebraicType :: !BEFlatTypeP !BEConstructorListP !BackEnd -> BackEnd;
 // void BEAlgebraicType (BEFlatTypeP lhs,BEConstructorListP constructors);
+BEExtendableAlgebraicType :: !BEFlatTypeP !BEConstructorListP !BackEnd -> BackEnd;
+// void BEExtendableAlgebraicType (BEFlatTypeP lhs,BEConstructorListP constructors);
 BERecordType :: !Int !BEFlatTypeP !BETypeNodeP !Int !BEFieldListP !BackEnd -> BackEnd;
 // void BERecordType (int moduleIndex,BEFlatTypeP lhs,BETypeNodeP constructorType,int is_boxed_record,BEFieldListP fields);
 BEAbsType :: !BEFlatTypeP !BackEnd -> BackEnd;
diff --git a/backend/backend.icl b/backend/backend.icl
index ef0fe09..6161bcb 100644
--- a/backend/backend.icl
+++ b/backend/backend.icl
@@ -550,6 +550,12 @@ BEAlgebraicType a0 a1 a2 = code {
 }
 // void BEAlgebraicType (BEFlatTypeP lhs,BEConstructorListP constructors);
 
+BEExtendableAlgebraicType :: !BEFlatTypeP !BEConstructorListP !BackEnd -> BackEnd;
+BEExtendableAlgebraicType a0 a1 a2 = code {
+	ccall BEExtendableAlgebraicType "pp:V:p"
+}
+// void BEExtendableAlgebraicType (BEFlatTypeP lhs,BEConstructorListP constructors);
+
 BERecordType :: !Int !BEFlatTypeP !BETypeNodeP !Int !BEFieldListP !BackEnd -> BackEnd;
 BERecordType a0 a1 a2 a3 a4 a5 = code {
 	ccall BERecordType "IppIp:V:p"
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl
index 6ea31f1..aea02aa 100644
--- a/backend/backendconvert.icl
+++ b/backend/backendconvert.icl
@@ -819,11 +819,9 @@ convertTypeVar typeVar
 
 defineType :: ModuleIndex {#ConsDef} {#SelectorDef} Index CheckedTypeDef *BackEndState -> *BackEndState
 defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args, td_rhs=AlgType constructorSymbols} be
-	# (flatType, be)
-		=	convertTypeLhs moduleIndex typeIndex td_attribute td_args be
-	# (constructors, be)
-		=	convertConstructors typeIndex td_ident.id_name moduleIndex constructors constructorSymbols be
-	=	appBackEnd (BEAlgebraicType flatType constructors) be
+	# (flatType, be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args be
+	# (constructors, be) = convertConstructors typeIndex td_ident.id_name moduleIndex constructors constructorSymbols be
+	= appBackEnd (BEAlgebraicType flatType constructors) be
 defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args, td_rhs=RecordType {rt_constructor, rt_fields, rt_is_boxed_record}, td_fun_index} be
 	# constructorIndex = rt_constructor.ds_index
 	  constructorDef = constructors.[constructorIndex]
@@ -854,6 +852,14 @@ defineType moduleIndex _ _ typeIndex {td_attribute, td_args, td_rhs=AbstractType
  	=	beAbsType (convertTypeLhs moduleIndex typeIndex td_attribute td_args) be
 defineType moduleIndex _ _ typeIndex {td_attribute, td_args, td_rhs=AbstractSynType _ _} be
  	=	beAbsType (convertTypeLhs moduleIndex typeIndex td_attribute td_args) be
+defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args, td_rhs=ExtendableAlgType constructorSymbols} be
+	# (flatType, be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args be
+	# (constructors, be) = convertConstructors typeIndex td_ident.id_name moduleIndex constructors constructorSymbols be
+	= appBackEnd (BEExtendableAlgebraicType flatType constructors) be
+defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args, td_rhs=AlgConses constructorSymbols _} be
+	# (flatType, be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args be
+	# (constructors, be) = convertConstructors typeIndex td_ident.id_name moduleIndex constructors constructorSymbols be
+	= appBackEnd (BEExtendableAlgebraicType flatType constructors) be
 defineType _ _ _ _ _ be
 	=	be
 
diff --git a/frontend/analtypes.icl b/frontend/analtypes.icl
index 639db53..b7de966 100644
--- a/frontend/analtypes.icl
+++ b/frontend/analtypes.icl
@@ -619,9 +619,9 @@ where
 			  (kinds_in_group, (as_kind_heap, as_td_infos))	= mapSt determine_kinds group (as.as_kind_heap, as.as_td_infos)
 			  as_kind_heap = unify_var_binds conds.con_var_binds as_kind_heap
 			  (normalized_top_vars, (kind_var_store, as_kind_heap)) = normalize_top_vars conds.con_top_var_binds 0 as_kind_heap
-			  (as_kind_heap, as_td_infos)
-			  	= update_type_def_infos modules type_properties normalized_top_vars group kinds_in_group kind_var_store as_kind_heap as_td_infos
-			  as & as_kind_heap = as_kind_heap, as_td_infos = as_td_infos
+			  (as_kind_heap, as_td_infos, as_error)
+				= update_type_def_infos modules type_properties normalized_top_vars group kinds_in_group kind_var_store as_kind_heap as_td_infos as.as_error
+			  as & as_kind_heap = as_kind_heap, as_td_infos = as_td_infos, as_error = as_error
 			= foldSt (check_dcl_properties modules dcl_types dcl_mod_index type_properties) group as
 
 	init_type_def_infos modules gi=:{gi_module,gi_index} (is_abstract_type, type_def_infos, as_type_var_heap, kind_heap)
@@ -633,6 +633,12 @@ where
 			AbstractSynType properties _
 				# type_def_infos = init_abstract_type_def properties td_args gi_module gi_index type_def_infos
 				-> (True, type_def_infos, as_type_var_heap, kind_heap)
+			ExtendableAlgType _
+				# (tdi_kinds, (as_type_var_heap, kind_heap)) = newKindConstVariables td_args (as_type_var_heap, kind_heap)
+				-> (is_abstract_type, {type_def_infos & [gi_module].[gi_index].tdi_kinds = tdi_kinds}, as_type_var_heap, kind_heap)				
+			AlgConses _ _
+				# (tdi_kinds, (as_type_var_heap, kind_heap)) = newKindConstVariables td_args (as_type_var_heap, kind_heap)
+				-> (is_abstract_type, {type_def_infos & [gi_module].[gi_index].tdi_kinds = tdi_kinds}, as_type_var_heap, kind_heap)				
 			_
 				# (tdi_kinds, (as_type_var_heap, kind_heap)) = newKindVariables td_args (as_type_var_heap, kind_heap)
 				-> (is_abstract_type, {type_def_infos & [gi_module].[gi_index].tdi_kinds = tdi_kinds}, as_type_var_heap, kind_heap)
@@ -652,6 +658,14 @@ where
 			# (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)))
 
+	newKindConstVariables td_args (type_var_heap, as_kind_heap)
+		= mapSt new_kind_const td_args (type_var_heap, as_kind_heap)
+	where
+		new_kind_const :: ATypeVar *(*TypeVarHeap,*KindHeap) -> (!TypeKind,!(!*TypeVarHeap,!*KindHeap));
+		new_kind_const {atv_variable={tv_info_ptr}} (type_var_heap, kind_heap)
+			# (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap
+			= (KindVar kind_info_ptr, (writePtr tv_info_ptr (TVI_TypeKind kind_info_ptr) type_var_heap, kind_heap))
+
 	anal_type_def modules gi=:{gi_module,gi_index} (group_properties, conds, as=:{as_error})
 		# {com_type_defs,com_cons_defs} = modules.[gi_module]
 		  {td_ident,td_pos,td_args,td_rhs} = com_type_defs.[gi_index]
@@ -669,6 +683,12 @@ where
 			= (cv_props, (conds, {as & as_kind_heap = uki_kind_heap, as_error = uki_error}))
 		anal_rhs_of_type_def modules com_cons_defs (NewType cons) conds_as
 			= analTypesOfConstructor modules com_cons_defs cons conds_as
+		anal_rhs_of_type_def modules com_cons_defs (ExtendableAlgType conses) conds_as
+			# (cons_properties, (conds,as)) = analTypesOfConstructors modules com_cons_defs conses conds_as
+			= ((cons_properties bitand (bitnot cIsHyperStrict)) /*bitor cIsNonCoercible*/, (conds,as))
+		anal_rhs_of_type_def modules com_cons_defs (AlgConses conses _) conds_as
+			# (cons_properties, (conds,as)) = analTypesOfConstructors modules com_cons_defs conses conds_as
+			= ((cons_properties bitand (bitnot cIsHyperStrict)) /*bitor cIsNonCoercible*/, (conds,as))
 
 	determine_kinds {gi_module,gi_index} (kind_heap, td_infos)
 		# (td_info=:{tdi_kinds}, td_infos) = td_infos![gi_module,gi_index]
@@ -721,17 +741,24 @@ where
 			# (kind_info, kind_heap) = readPtr kind_info_ptr kind_heap
 			= normalize_var kind_info_ptr kind_info (kind_store, kind_heap)
 
-	update_type_def_infos modules type_properties top_vars group updated_kinds_of_group kind_store kind_heap td_infos
-		# (_,as_kind_heap,as_td_infos) = fold2St (update_type_def_info modules (type_properties bitor cIsAnalysed) top_vars) group updated_kinds_of_group (kind_store, kind_heap, td_infos)
-		= (as_kind_heap,as_td_infos)
+	update_type_def_infos modules type_properties top_vars group updated_kinds_of_group kind_store kind_heap td_infos error
+		# (_,as_kind_heap,as_td_infos,error)
+			= fold2St (update_type_def_info modules (type_properties bitor cIsAnalysed) top_vars) group updated_kinds_of_group (kind_store,kind_heap,td_infos,error)
+		= (as_kind_heap,as_td_infos,error)
 	where
 		update_type_def_info modules type_properties top_vars {gi_module,gi_index} updated_kinds
-				(kind_store,kind_heap,td_infos)
+				(kind_store,kind_heap,td_infos,error)
 			# (td_info=:{tdi_kinds}, td_infos) = td_infos![gi_module].[gi_index]
 			# (group_vars, cons_vars, kind_store, kind_heap) = determine_type_def_info tdi_kinds updated_kinds top_vars kind_store kind_heap
 			# td_info & tdi_properties = type_properties, tdi_kinds = updated_kinds, tdi_group_vars = group_vars, tdi_cons_vars = cons_vars
 			#! td_infos & [gi_module,gi_index] = td_info
-			= (kind_store, kind_heap, td_infos)
+			| type_properties bitand cIsNonCoercible<>0
+				# type_def = modules.[gi_module].com_type_defs.[gi_index]
+				| not (isUniqueAttr type_def.td_attribute) && is_ExtendableAlgType_or_AlgConses type_def.td_rhs
+					# error = checkErrorWithPosition type_def.td_ident type_def.td_pos "a non unique extendable algebraic data type must be coercible" error
+					= (kind_store, kind_heap, td_infos, error)
+					= (kind_store, kind_heap, td_infos, error)
+				= (kind_store, kind_heap, td_infos, error)
 
 		determine_type_def_info [KindVar kind_info_ptr : kind_vars] [kind : kinds] top_vars kind_store kind_heap
 			# (kind_info, kind_heap) = readPtr kind_info_ptr kind_heap
@@ -752,6 +779,10 @@ where
 		is_a_top_var var_number []
 			= False
 
+		is_ExtendableAlgType_or_AlgConses (ExtendableAlgType _) = True 
+		is_ExtendableAlgType_or_AlgConses (AlgConses _ _) = True
+		is_ExtendableAlgType_or_AlgConses _ = False
+
 	check_dcl_properties modules dcl_types dcl_mod_index properties {gi_module, gi_index} as
 		| gi_module == dcl_mod_index && gi_index < size dcl_types
 			# {td_ident, td_rhs, td_args, td_pos} = dcl_types.[gi_index]
@@ -1166,6 +1197,10 @@ isUniqueTypeRhs common_defs mod_index (RecordType {rt_constructor={ds_index}}) s
 	= constructor_is_unique mod_index ds_index common_defs state
 isUniqueTypeRhs common_defs mod_index (NewType {ds_index}) state
 	= constructor_is_unique mod_index ds_index common_defs state
+isUniqueTypeRhs common_defs mod_index (ExtendableAlgType constructors) state
+	= has_unique_constructor constructors common_defs mod_index state
+isUniqueTypeRhs common_defs mod_index (AlgConses constructors _) state
+	= has_unique_constructor constructors common_defs mod_index state
 isUniqueTypeRhs common_defs mod_index _ state
 	= (False, state)
 
diff --git a/frontend/analunitypes.icl b/frontend/analunitypes.icl
index ee086b5..0758414 100644
--- a/frontend/analunitypes.icl
+++ b/frontend/analunitypes.icl
@@ -196,6 +196,10 @@ where
 		| properties bitand cIsNonCoercible == 0
 			= (PostiveSignClass, scs)
 			= (TopSignClass, scs)
+	sign_class_of_type_def module_index (ExtendableAlgType conses) group_nr ci scs
+		= (TopSignClass, scs)
+	sign_class_of_type_def module_index (AlgConses conses _) group_nr ci scs
+		= (TopSignClass, scs)
 
 	sign_class_of_type_conses module_index [{ds_index}:conses] group_nr ci cumm_sign_class scs
 		#! cons_def = ci.[module_index].com_cons_defs.[ds_index]
@@ -473,6 +477,10 @@ where
 		= (PropClass, pcs)
 	prop_class_of_type_def _ (AbstractSynType properties _) _ _ pcs
 		= (PropClass, pcs)
+	prop_class_of_type_def module_index (ExtendableAlgType conses) group_nr ci pcs
+		= (PropClass, pcs)
+	prop_class_of_type_def module_index (AlgConses conses _) group_nr ci pcs
+		= (PropClass, pcs)
 
 	prop_class_of_type_conses module_index [{ds_index}:conses] group_nr ci cumm_prop_class pcs
 		#! cons_def = ci.[module_index].com_cons_defs.[ds_index]
diff --git a/frontend/check.icl b/frontend/check.icl
index 6ebb935..52fafe3 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -951,6 +951,8 @@ collectCommonDefinitions {def_types,def_constructors,def_selectors,def_classes,d
 	  sizes = { sizes & [cGenericCaseDefs] = size }
 	= (sizes, defs)
 where
+	type_def_to_dcl {td_rhs=UncheckedAlgConses type_ext_ident _, td_ident, td_pos} (decl_index, decls)
+		= (inc decl_index, [Declaration {decl_ident = type_ext_ident, decl_pos = td_pos, decl_kind = STE_TypeExtension, decl_index = decl_index} : decls])
 	type_def_to_dcl {td_ident, td_pos} (decl_index, decls)
 		= (inc decl_index, [Declaration {decl_ident = td_ident, decl_pos = td_pos, decl_kind = STE_Type, decl_index = decl_index} : decls])
 
@@ -1187,6 +1189,20 @@ renumber_icl_definitions_as_dcl_definitions (Yes icl_to_dcl_index_table) icl_siz
 							= { td & td_rhs = NewType {cons & ds_index=icl_to_dcl_index_table.[cConstructorDefs,cons.ds_index]} }
 						renumber_type_def td
 							= td
+				renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_TypeExtension, decl_index}) cdefs
+					# (type_def,cdefs) = cdefs!com_type_defs.[decl_index]
+					# type_def = renumber_type_extension_def type_def
+					# cdefs={cdefs & com_type_defs.[decl_index]=type_def}
+					= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cTypeDefs,decl_index]},cdefs)
+					where
+						renumber_type_extension_def td=:{td_rhs = UncheckedAlgConses type_ext_ident conses}
+							# conses = [{cons & ds_index=icl_to_dcl_index_table.[cConstructorDefs,cons.ds_index]} \\ cons <- conses]
+							= {td & td_rhs = UncheckedAlgConses type_ext_ident conses}
+						renumber_type_extension_def td=:{td_rhs = AlgConses conses type_ext_ident}
+							# conses = [{cons & ds_index=icl_to_dcl_index_table.[cConstructorDefs,cons.ds_index]} \\ cons <- conses]
+							= {td & td_rhs = AlgConses conses type_ext_ident}
+						renumber_type_extension_def td
+							= td
 				renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Constructor, decl_index}) cdefs
 					= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cConstructorDefs,decl_index]},cdefs)
 				renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Field _, decl_index}) cdefs
@@ -1407,6 +1423,18 @@ where
 		# (cop_td_indexes, cop_cd_indexes, cop_gd_indexes) = copied_defs
 		# copied_defs = (cop_td_indexes, cop_cd_indexes, [decl_index:cop_gd_indexes])
 		= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, [generic_def:new_generic_defs], copied_defs, conversion_table, icl_sizes, icl_decl_symbols, cs)	
+	add_dcl_definition {com_type_defs,com_cons_defs} dcl=:(Declaration {decl_kind = STE_TypeExtension, decl_index})
+			(new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, (cop_td_indexes, cop_cd_indexes, cop_gd_indexes), conversion_table, icl_sizes, icl_decl_symbols, cs)
+		# type_def = com_type_defs.[decl_index]
+		  (new_type_defs,new_cons_defs,new_selector_defs,conversion_table,icl_sizes,icl_decl_symbols,cs) = add_type_def type_def new_type_defs new_cons_defs new_selector_defs conversion_table icl_sizes icl_decl_symbols cs
+		  cop_td_indexes = [decl_index : cop_td_indexes]
+		= (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, (cop_td_indexes, cop_cd_indexes, cop_gd_indexes), conversion_table, icl_sizes, icl_decl_symbols, cs)
+	where
+		add_type_def td=:{td_pos, td_rhs = UncheckedAlgConses type_ext_ident conses} new_type_defs new_cons_defs new_selector_defs conversion_table icl_sizes icl_decl_symbols cs		
+			# (conses,(new_cons_defs,conversion_table,icl_sizes,icl_decl_symbols,cs)) = copy_and_redirect_cons_symbols com_cons_defs td_pos conses (new_cons_defs,conversion_table,icl_sizes,icl_decl_symbols,cs)
+			= ([{ td & td_rhs = UncheckedAlgConses type_ext_ident conses} : new_type_defs],new_cons_defs,new_selector_defs,conversion_table,icl_sizes,icl_decl_symbols,cs)
+		add_type_def td new_type_defs new_cons_defs new_selector_defs conversion_table icl_sizes icl_decl_symbols cs
+			= ([td : new_type_defs],new_cons_defs,new_selector_defs,conversion_table,icl_sizes,icl_decl_symbols,cs) 
 	add_dcl_definition _ _ result = result
 
 	copy_and_redirect_cons_symbols com_cons_defs td_pos [cons:conses] (new_cons_defs,conversion_table,icl_sizes,icl_decl_symbols,cs)
diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl
index 83fc6f2..91f1af8 100644
--- a/frontend/checkFunctionBodies.icl
+++ b/frontend/checkFunctionBodies.icl
@@ -260,15 +260,14 @@ where
 							  let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos },
 						pattern_position, var_store, expr_heap, opt_dynamics, cs)
 
-	transform_pattern_into_cases (AP_Algebraic cons_symbol type_index args opt_var) fun_arg result_expr pattern_position
+	transform_pattern_into_cases (AP_Algebraic cons_symbol global_type_index args opt_var) fun_arg result_expr pattern_position
 									var_store expr_heap opt_dynamics cs
 		# (var_args, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
 				= convertSubPatterns args result_expr pattern_position var_store expr_heap opt_dynamics cs
-		  type_symbol = {glob_module = cons_symbol.glob_module, glob_object = type_index}
 	  	  (act_var, result_expr, expr_heap) = transform_pattern_variable fun_arg opt_var result_expr expr_heap
 		  (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
 		# alg_patterns = [{ ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = pattern_position }]
-		# (case_guards,expr_heap,cs) = make_case_guards cons_symbol type_symbol alg_patterns expr_heap cs
+		# (case_guards,expr_heap,cs) = make_case_guards cons_symbol global_type_index alg_patterns expr_heap cs
 		= (Case { case_expr = act_var, case_guards = case_guards, case_default = No, case_ident = No,
 				case_explicit = cCaseNotExplicit,
 				case_info_ptr = case_expr_ptr, case_default_pos = NoPos },
@@ -286,7 +285,7 @@ where
 									var_store expr_heap opt_dynamics cs
 		# (var_arg, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
 				= convertSubPattern arg result_expr pattern_position var_store expr_heap opt_dynamics cs
-		  type_symbol = {glob_module = cons_symbol.glob_module, glob_object = type_index}
+		  type_symbol = {gi_module = cons_symbol.glob_module, gi_index = type_index}
 	  	  (act_var, result_expr, expr_heap) = transform_pattern_variable fun_arg opt_var result_expr expr_heap
 		  (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
 		# alg_patterns = [{ ap_symbol = cons_symbol, ap_vars = [var_arg], ap_expr = result_expr, ap_position = pattern_position }]
@@ -886,8 +885,8 @@ checkExpression free_vars (PE_Matches case_ident expr pattern position) e_input=
 		= checkPattern pattern No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], []) ps e_info cs
 	| is_single_constructor_pattern pattern
 		= case pattern of
-			AP_Algebraic cons_symbol type_index args _
-				# is_cons_expr = IsConstructor expr cons_symbol (length args) {gi_module=cons_symbol.glob_module,gi_index=type_index} case_ident position
+			AP_Algebraic cons_symbol global_type_index args _
+				# is_cons_expr = IsConstructor expr cons_symbol (length args) global_type_index case_ident position
 				  e_state & es_fun_defs=ps_fun_defs, es_var_heap = ps_var_heap, es_expr_heap = es_expr_heap
 				-> (is_cons_expr, free_vars, e_state, e_info, cs)
 		# fail_expr = Yes (No,BasicExpr (BVB False))
@@ -923,15 +922,14 @@ checkExpression free_vars expr e_input e_state e_info cs
 transform_pattern :: !AuxiliaryPattern !CasePatterns !CasePatterns !(Env Ident VarInfoPtr) !(Optional (!Optional FreeVar, !Expression)) !Expression
 		!String !Position !*VarHeap !*ExpressionHeap !Dynamics !*CheckState
 	-> (!CasePatterns, !CasePatterns, !Env Ident VarInfoPtr, !Optional (!Optional FreeVar,!Expression), !*VarHeap, !*ExpressionHeap, ![DynamicPtr], !*CheckState)
-transform_pattern (AP_Algebraic cons_symbol type_index args opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ pos var_store expr_heap opt_dynamics cs
+transform_pattern (AP_Algebraic cons_symbol global_type_index args opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ pos var_store expr_heap opt_dynamics cs
 	# (var_args, result_expr, _, var_store, expr_heap, opt_dynamics, cs) = convertSubPatterns args result_expr pos var_store expr_heap opt_dynamics cs
-	  type_symbol = { glob_module = cons_symbol.glob_module, glob_object = type_index}
 	  pattern_variables = cons_optional opt_var pattern_variables
 	# pattern = { ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = pos}
 	| cons_symbol.glob_module==cPredefinedModuleIndex
 		# pd_cons_index=cons_symbol.glob_object.ds_index+FirstConstructorPredefinedSymbolIndex
 		| pd_cons_index==PD_UnboxedConsSymbol || pd_cons_index==PD_UnboxedNilSymbol
-			# (unboxed_list,decons_expr,expr_heap,cs) = make_unboxed_list type_symbol expr_heap cs
+			# (unboxed_list,decons_expr,expr_heap,cs) = make_unboxed_list global_type_index expr_heap cs
 			= case pattern_scheme of
 				OverloadedListPatterns (UnboxedList _ _ _ _) _ _
 					# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
@@ -946,7 +944,7 @@ transform_pattern (AP_Algebraic cons_symbol type_index args opt_var) patterns pa
 					-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,illegal_combination_of_patterns_error cons_symbol cs)
 
 		| pd_cons_index==PD_UnboxedTailStrictConsSymbol || pd_cons_index==PD_UnboxedTailStrictNilSymbol
-			# (unboxed_tail_strict_list,decons_expr,expr_heap,cs) = make_unboxed_tail_strict_list type_symbol expr_heap cs
+			# (unboxed_tail_strict_list,decons_expr,expr_heap,cs) = make_unboxed_tail_strict_list global_type_index expr_heap cs
 			= case pattern_scheme of
 				OverloadedListPatterns (UnboxedTailStrictList _ _ _ _) _ _
 					# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
@@ -963,22 +961,22 @@ transform_pattern (AP_Algebraic cons_symbol type_index args opt_var) patterns pa
 		| pd_cons_index==PD_OverloadedConsSymbol || pd_cons_index==PD_OverloadedNilSymbol
 			= case pattern_scheme of
 				OverloadedListPatterns (OverloadedList _ _ _ _) _ _
-					# (overloaded_list,decons_expr,expr_heap,cs) = make_overloaded_list type_symbol expr_heap cs
+					# (overloaded_list,decons_expr,expr_heap,cs) = make_overloaded_list global_type_index expr_heap cs
 					# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
 					-> (OverloadedListPatterns overloaded_list decons_expr [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 				OverloadedListPatterns (UnboxedList _ _ _ _) _ _
-					# (unboxed_list,decons_expr,expr_heap,cs) = make_unboxed_list type_symbol expr_heap cs
+					# (unboxed_list,decons_expr,expr_heap,cs) = make_unboxed_list global_type_index expr_heap cs
 					# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
 					# (pattern,cs) = replace_overloaded_symbol_in_pattern pattern PD_UnboxedConsSymbol PD_UnboxedNilSymbol cs
 					-> (OverloadedListPatterns unboxed_list decons_expr [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 				OverloadedListPatterns (UnboxedTailStrictList _ _ _ _) _ _
-					# (unboxed_tail_strict_list,decons_expr,expr_heap,cs) = make_unboxed_tail_strict_list type_symbol expr_heap cs
+					# (unboxed_tail_strict_list,decons_expr,expr_heap,cs) = make_unboxed_tail_strict_list global_type_index expr_heap cs
 					# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
 					# (pattern,cs) = replace_overloaded_symbol_in_pattern pattern PD_UnboxedTailStrictConsSymbol PD_UnboxedTailStrictNilSymbol cs
 					-> (OverloadedListPatterns unboxed_tail_strict_list decons_expr [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 				AlgebraicPatterns alg_type _
-					| alg_type.glob_module==cPredefinedModuleIndex
-						# index=alg_type.glob_object+FirstTypePredefinedSymbolIndex
+					| alg_type.gi_module==cPredefinedModuleIndex
+						# index=alg_type.gi_index+FirstTypePredefinedSymbolIndex
 						| index==PD_ListType
 							# alg_patterns = alg_patterns_of_AlgebraicPatterns_or_NoPattern patterns
 							# (pattern,cs) = replace_overloaded_symbol_in_pattern pattern PD_ConsSymbol PD_NilSymbol cs
@@ -998,50 +996,50 @@ transform_pattern (AP_Algebraic cons_symbol type_index args opt_var) patterns pa
 							-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,illegal_combination_of_patterns_error cons_symbol cs)
 						-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,illegal_combination_of_patterns_error cons_symbol cs)
 				NoPattern
-					# (overloaded_list,decons_expr,expr_heap,cs) = make_overloaded_list type_symbol expr_heap cs
+					# (overloaded_list,decons_expr,expr_heap,cs) = make_overloaded_list global_type_index expr_heap cs
 					-> (OverloadedListPatterns overloaded_list decons_expr [pattern], OverloadedListPatterns overloaded_list decons_expr [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 				_
 					-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,illegal_combination_of_patterns_error cons_symbol cs)
 			= case pattern_scheme of
 				AlgebraicPatterns alg_type _
-					| type_symbol == alg_type
+					| global_type_index == alg_type
 						# alg_patterns = alg_patterns_of_AlgebraicPatterns_or_NoPattern patterns
-						-> (AlgebraicPatterns type_symbol [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+						-> (AlgebraicPatterns global_type_index [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 						-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,
 									{ cs & cs_error = checkError cons_symbol.glob_object.ds_ident "incompatible types of patterns" cs.cs_error })
 				OverloadedListPatterns (OverloadedList _ _ _ _) _ _
-					| type_symbol.glob_module==cPredefinedModuleIndex
-						# index=type_symbol.glob_object+FirstTypePredefinedSymbolIndex
+					| global_type_index.gi_module==cPredefinedModuleIndex
+						# index=global_type_index.gi_index+FirstTypePredefinedSymbolIndex
 						| index==PD_ListType
 							# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
 							# (alg_patterns,cs) = replace_overloaded_symbols_in_patterns alg_patterns PD_ConsSymbol PD_NilSymbol cs
-							-> (AlgebraicPatterns type_symbol [pattern:alg_patterns], AlgebraicPatterns type_symbol [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+							-> (AlgebraicPatterns global_type_index [pattern:alg_patterns], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 						| index==PD_StrictListType
 							# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
 							# (alg_patterns,cs) = replace_overloaded_symbols_in_patterns alg_patterns PD_StrictConsSymbol PD_StrictNilSymbol cs
-							-> (AlgebraicPatterns type_symbol [pattern:alg_patterns], AlgebraicPatterns type_symbol [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+							-> (AlgebraicPatterns global_type_index [pattern:alg_patterns], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 						| index==PD_TailStrictListType
 							# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
 							# (alg_patterns,cs) = replace_overloaded_symbols_in_patterns alg_patterns PD_TailStrictConsSymbol PD_TailStrictNilSymbol cs
-							-> (AlgebraicPatterns type_symbol [pattern:alg_patterns], AlgebraicPatterns type_symbol [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+							-> (AlgebraicPatterns global_type_index [pattern:alg_patterns], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 						| index==PD_StrictTailStrictListType
 							# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
 							# (alg_patterns,cs) = replace_overloaded_symbols_in_patterns alg_patterns PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol cs
-							-> (AlgebraicPatterns type_symbol [pattern:alg_patterns], AlgebraicPatterns type_symbol [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+							-> (AlgebraicPatterns global_type_index [pattern:alg_patterns], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 							-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,illegal_combination_of_patterns_error cons_symbol cs)
 				NoPattern
-					-> (AlgebraicPatterns type_symbol [pattern], AlgebraicPatterns type_symbol [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+					-> (AlgebraicPatterns global_type_index [pattern], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 				_
 					-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,illegal_combination_of_patterns_error cons_symbol cs)
 		= case pattern_scheme of
 			AlgebraicPatterns alg_type _
-				| type_symbol == alg_type
+				| global_type_index == alg_type
 					# alg_patterns = alg_patterns_of_AlgebraicPatterns_or_NoPattern patterns
-					-> (AlgebraicPatterns type_symbol [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+					-> (AlgebraicPatterns global_type_index [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 					# cs & cs_error = checkError cons_symbol.glob_object.ds_ident "incompatible types of patterns" cs.cs_error
 					-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 			NoPattern
-				-> (AlgebraicPatterns type_symbol [pattern], AlgebraicPatterns type_symbol [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
+				-> (AlgebraicPatterns global_type_index [pattern], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
 			_
 				-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics,illegal_combination_of_patterns_error cons_symbol cs)
 	where
@@ -1075,7 +1073,6 @@ transform_pattern (AP_Algebraic cons_symbol type_index args opt_var) patterns pa
 					# glob_object = {glob_object & ds_index=pds_def,ds_ident=pds_ident}
 					= ({pattern & ap_symbol.glob_object=glob_object},cs)
 					= abort "replace_overloaded_symbol_in_pattern"
-
 transform_pattern (AP_Basic basic_val opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ pos var_store expr_heap opt_dynamics cs
 	# pattern = { bp_value = basic_val, bp_expr = result_expr, bp_position = pos}
 	  pattern_variables = cons_optional opt_var pattern_variables
@@ -1138,7 +1135,7 @@ where
 	insert_as_default expr _ = expr // checkWarning "pattern won't match"
 transform_pattern (AP_NewType cons_symbol type_index arg opt_var) patterns pattern_scheme pattern_variables defaul result_expr _ pos var_store expr_heap opt_dynamics cs
 	# (var_arg, result_expr, _, var_store, expr_heap, opt_dynamics, cs) = convertSubPattern arg result_expr pos var_store expr_heap opt_dynamics cs
-	  type_symbol = {glob_module = cons_symbol.glob_module, glob_object = type_index}
+	  type_symbol = {gi_module = cons_symbol.glob_module, gi_index = type_index}
 	  pattern_variables = cons_optional opt_var pattern_variables
 	# pattern = { ap_symbol = cons_symbol, ap_vars = [var_arg], ap_expr = result_expr, ap_position = pos}
 	= case pattern_scheme of
@@ -1643,7 +1640,8 @@ checkPattern (PE_Tuple tuple_args) opt_var p_input accus ps e_info cs
 	# (patterns, arity, accus, ps, e_info, cs) = check_tuple_patterns tuple_args p_input accus ps e_info cs
 	  (tuple_symbol, cs) = getPredefinedGlobalSymbol (GetTupleConsIndex arity) PD_PredefinedModule STE_Constructor arity cs
 	# ({cons_type_index}, e_info) = 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, accus, ps, e_info, cs)
+	# global_type_index = {gi_module = cPredefinedModuleIndex, gi_index = cons_type_index} 
+	= (AP_Algebraic tuple_symbol global_type_index patterns opt_var, accus, ps, e_info, cs)
 where
 	check_tuple_patterns [] p_input accus ps e_info cs
 		= ([], 0, accus, ps, e_info, cs)
@@ -1658,7 +1656,8 @@ checkPattern (PE_Record record opt_type fields) opt_var p_input=:{pi_mod_index,
 		Yes (record_symbol, type_index, new_fields)
 			# (patterns, (var_env, array_patterns, ps, e_info, cs)) = mapSt (check_field_pattern p_input) new_fields (var_env, array_patterns, ps, e_info, cs)
 			  (patterns, ps_var_heap) = bind_opt_record_variable opt_var pi_is_node_pattern patterns new_fields ps.ps_var_heap
-			-> (AP_Algebraic record_symbol type_index patterns opt_var, (var_env, array_patterns), {ps & ps_var_heap = ps_var_heap}, e_info, cs)
+			  global_type_index = {gi_module = record_symbol.glob_module, gi_index = type_index}
+			-> (AP_Algebraic record_symbol global_type_index patterns opt_var, (var_env, array_patterns), {ps & ps_var_heap = ps_var_heap}, e_info, cs)
 		No
 			-> (AP_Empty, accus, ps, e_info, cs)
 where
@@ -1802,16 +1801,33 @@ checkPatternConstructor mod_index is_expr_list {ste_index, ste_kind} cons_ident
 			= determine_pattern_symbol mod_index ste_index ste_kind cons_ident.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_ident cons_index cons_arity, glob_module = cons_module }
-	| cons_number <> -2
+	| cons_number > -2
+		# global_type_index = {gi_module = cons_module, gi_index = cons_type_index}
 		| 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_ident "constructor arguments are missing" cs_error })
+			= (AP_Constant (APK_Constructor global_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
+			| cons_arity == 0
+				= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, {cs & cs_error = cs_error})
+				# cs & cs_error = checkError cons_ident "constructor arguments are missing" cs_error
+				= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, cs)
+	| cons_number == -2
 		| is_expr_list
 			= (AP_Constant (APK_NewTypeConstructor cons_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
 			# cs & cs_error = checkError cons_ident "constructor argument is missing" cs_error
 			= (AP_NewType cons_symbol cons_type_index AP_Empty opt_var, ps, e_info, cs)
+	// cons_number == -3
+		# (type_rhs,e_info)
+			= case ste_kind of
+				STE_Constructor
+					-> e_info!ef_type_defs.[cons_type_index].td_rhs
+				_
+					-> e_info!ef_modules.[cons_module].dcl_common.com_type_defs.[cons_type_index].td_rhs
+		# (AlgConses _ global_type_index) = type_rhs
+		| is_expr_list
+			= (AP_Constant (APK_Constructor global_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
+			| cons_arity == 0
+				= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, {cs & cs_error = cs_error})
+				# cs & cs_error = checkError cons_ident "constructor arguments are missing" cs_error
+				= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, cs)
 where
 	determine_pattern_symbol mod_index id_index STE_Constructor id_name cons_defs modules error
 		# ({cons_type={st_arity},cons_priority,cons_type_index,cons_number}, cons_defs) = cons_defs![id_index]
@@ -1843,16 +1859,33 @@ checkQualifiedPatternConstructor ste_kind ste_index decl_ident module_name ident
 			= determine_pattern_symbol mod_index ste_index ste_kind module_name ident_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 decl_ident cons_index cons_arity, glob_module = cons_module }
-	| cons_number <> -2
+	| cons_number > -2
+		# global_type_index = {gi_module = cons_module, gi_index = cons_type_index}
 	   	| 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 ident_name "constructor arguments are missing" cs_error })
+			= (AP_Constant (APK_Constructor global_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
+			| cons_arity == 0
+				= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, {cs & cs_error = cs_error})
+				# cs & cs_error = checkError ident_name "constructor arguments are missing" cs_error
+				= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, cs)
+	| cons_number == -2
 	   	| is_expr_list
 			= (AP_Constant (APK_NewTypeConstructor cons_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
 			# cs & cs_error = checkError ident_name "constructor argument is missing" cs_error
 			= (AP_NewType cons_symbol cons_type_index AP_Empty opt_var, ps, e_info, cs)
+	// cons_number == -3
+		# (type_rhs,e_info)
+			= case ste_kind of
+				STE_Constructor
+					-> e_info!ef_type_defs.[cons_type_index].td_rhs
+				_
+					-> e_info!ef_modules.[cons_module].dcl_common.com_type_defs.[cons_type_index].td_rhs
+		# (AlgConses _ global_type_index) = type_rhs
+	   	| is_expr_list
+			= (AP_Constant (APK_Constructor global_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
+			| cons_arity == 0
+				= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, {cs & cs_error = cs_error})
+				# cs & cs_error = checkError ident_name "constructor arguments are missing" cs_error
+				= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, cs)
 where
 	determine_pattern_symbol mod_index id_index STE_Constructor module_name ident_name cons_defs modules error
 		# ({cons_type={st_arity},cons_priority,cons_type_index,cons_number}, cons_defs) = cons_defs![id_index]
@@ -1933,16 +1966,15 @@ convertSubPattern (AP_Variable name var_info (Yes {bind_src,bind_dst})) result_e
 convertSubPattern (AP_Variable name var_info No) result_expr pattern_position var_store expr_heap opt_dynamics cs
 	= ({ fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr, pattern_position, 
 		var_store, expr_heap, opt_dynamics, cs)
-convertSubPattern (AP_Algebraic cons_symbol type_index args opt_var) result_expr pattern_position
+convertSubPattern (AP_Algebraic cons_symbol global_type_index args opt_var) result_expr pattern_position
 					var_store expr_heap opt_dynamics cs
 	# (var_args, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
 			= convertSubPatterns args result_expr pattern_position var_store expr_heap opt_dynamics cs
-	  type_symbol = { glob_module = cons_symbol.glob_module, glob_object = type_index }
 	  ({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
 	# alg_patterns = [{ ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = pattern_position }]
-	# (case_guards,expr_heap,cs) = make_case_guards cons_symbol type_symbol alg_patterns expr_heap cs
+	# (case_guards,expr_heap,cs) = make_case_guards cons_symbol global_type_index alg_patterns expr_heap cs
 	= ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 },
 		Case { case_expr = Var { var_ident = 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,
@@ -1965,7 +1997,7 @@ convertSubPattern (AP_NewType cons_symbol type_index arg opt_var) result_expr pa
 					var_store expr_heap opt_dynamics cs
 	# (var_arg, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
 			= convertSubPattern arg result_expr pattern_position var_store expr_heap opt_dynamics cs
-	  type_symbol = { glob_module = cons_symbol.glob_module, glob_object = type_index }
+	  type_symbol = { gi_module = cons_symbol.glob_module, gi_index = type_index }
 	  ({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
@@ -2022,7 +2054,7 @@ transfromPatternIntoBind mod_index def_level (AP_Variable name var_info (Yes {bi
 transfromPatternIntoBind mod_index def_level (AP_Variable name var_info No) src_expr position var_store expr_heap e_info cs
 	# bind = {lb_src = src_expr, lb_dst = { fv_ident = name, fv_info_ptr = var_info, fv_def_level = def_level, fv_count = 0 }, lb_position = position }
 	= ([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)
+transfromPatternIntoBind mod_index def_level (AP_Algebraic cons_symbol=:{glob_module,glob_object=ds_cons=:{ds_arity, ds_index, ds_ident}} global_type_index args opt_var)
 		src_expr position 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 position var_store expr_heap
 	| ds_arity == 0
@@ -2031,7 +2063,7 @@ transfromPatternIntoBind mod_index def_level (AP_Algebraic cons_symbol=:{glob_mo
 	| is_tuple
 		# (tuple_var, tuple_bind, var_store, expr_heap) = bind_match_expr src_expr opt_var_bind position def_level var_store expr_heap
 		= transform_sub_patterns mod_index def_level args ds_cons 0 tuple_var tuple_bind position 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
+		# ({td_rhs}, ef_type_defs, ef_modules) = get_type_def mod_index global_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}
@@ -2069,7 +2101,7 @@ transfromPatternIntoStrictBind :: !Index !Level !AuxiliaryPattern !Expression !P
 transfromPatternIntoStrictBind mod_index def_level (AP_Variable name var_info _) src_expr position var_store expr_heap e_info cs
 	# bind = {lb_src = src_expr, lb_dst = { fv_ident = name, fv_info_ptr = var_info, fv_def_level = def_level, fv_count = 0 }, lb_position = position }
 	= ([],[bind], var_store, expr_heap, e_info, cs)
-transfromPatternIntoStrictBind 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)
+transfromPatternIntoStrictBind mod_index def_level (AP_Algebraic cons_symbol=:{glob_module,glob_object=ds_cons=:{ds_arity, ds_index, ds_ident}} global_type_index args opt_var)
 		src_expr position var_store expr_heap e_info=:{ef_type_defs,ef_modules} cs
 	# (src_expr, src_bind, var_store, expr_heap) = bind_opt_var_or_create_new_var opt_var src_expr position def_level var_store expr_heap
 	| ds_arity == 0
@@ -2078,7 +2110,7 @@ transfromPatternIntoStrictBind mod_index def_level (AP_Algebraic cons_symbol=:{g
 	| is_tuple
 		# (lazy_binds,var_store,expr_heap,e_info,cs) = transform_sub_patterns mod_index def_level args ds_cons 0 src_expr [] position var_store expr_heap e_info cs
 		= (lazy_binds,src_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
+		# ({td_rhs}, ef_type_defs, ef_modules) = get_type_def mod_index global_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}
@@ -2108,12 +2140,12 @@ transfromPatternIntoStrictBind mod_index def_level (AP_WildCard _) src_expr _ va
 transfromPatternIntoStrictBind _ _ 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})
 
-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]
+get_type_def mod_index global_type_index=:{gi_module,gi_index} ef_type_defs ef_modules
+	| mod_index == gi_module
+		# (type_def, ef_type_defs) = ef_type_defs![gi_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)
+		# ({dcl_common},  ef_modules) = ef_modules![gi_module]
+		= (dcl_common.com_type_defs.[gi_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
@@ -2237,7 +2269,8 @@ where
 		| cons_def.cons_type.st_arity == length app_args+length extra_args
 			# (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_ident cons_index cons_def.cons_type.st_arity, glob_module = glob_module }
-			= (AP_Algebraic cons_symbol cons_def.cons_type_index (patterns++extra_args) opt_var, ums)
+			  global_type_index = {gi_module = glob_module, gi_index = cons_def.cons_type_index}
+			= (AP_Algebraic cons_symbol global_type_index (patterns++extra_args) opt_var, ums)
 			= (AP_Empty, { ums & ums_cons_defs = ums_cons_defs, ums_modules = ums_modules,
 					ums_error = checkError cons_def.cons_ident "incorrect number of arguments" ums_error })
 	where
diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl
index 1a290a8..4a439d7 100644
--- a/frontend/checksupport.icl
+++ b/frontend/checksupport.icl
@@ -21,6 +21,7 @@ where
 	toInt STE_DclFunction			= cFunctionDefs
 	toInt (STE_FunctionOrMacro _)	= cMacroDefs
 	toInt (STE_DclMacroOrLocalMacroFunction _)= cMacroDefs
+	toInt STE_TypeExtension			= cTypeDefs
 	toInt _							= NoIndex
 
 instance Erroradmin ErrorAdmin
diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl
index e4e46f0..6bb24d9 100644
--- a/frontend/checktypes.icl
+++ b/frontend/checktypes.icl
@@ -133,7 +133,7 @@ retrieveTypeDefinition type_ptr mod_index symbol_table used_types
 		with
 			retrieve_type_definition (STE_UsedQualifiedType uqt_mod_index uqt_index orig_kind)
 				| uqt_mod_index==mod_index && uqt_index==ste_index
-					= (ste_index, mod_index, symbol_table, used_types) 
+					= (ste_index, mod_index, symbol_table, used_types)
 					= retrieve_type_definition orig_kind
 			retrieve_type_definition (STE_Imported STE_Type ste_mod_index)
 				= (ste_index, ste_mod_index, symbol_table <:= (type_ptr, { entry & ste_kind = STE_UsedType ste_mod_index this_kind }), used_types)
@@ -376,9 +376,9 @@ where
 		# type_lhs = { at_attribute = cti_lhs_attribute,
 				  	   at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_ident td_arity)
 									[{at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]}
-		  ts_ti_cs = bind_types_of_constructors cti 0 [ atv_variable \\ {atv_variable} <- td_args] attr_vars type_lhs conses ts_ti_cs
+		  ts_ti_cs = bind_types_of_constructors cti 0 (atype_vars_to_type_vars td_args) attr_vars type_lhs conses ts_ti_cs
 		= (td_rhs, ts_ti_cs)
-	check_rhs_of_TypeDef {td_ident,td_arity,td_args,td_rhs = td_rhs=:RecordType {rt_constructor=rec_cons=:{ds_index,ds_arity}, rt_fields}}
+	check_rhs_of_TypeDef {td_ident,td_arity,td_args,td_rhs = td_rhs=:RecordType {rt_constructor={ds_index,ds_arity}, rt_fields}}
 			attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} (ts,ti,cs)
 		# type_lhs = {	at_attribute = cti_lhs_attribute,
 						at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_ident td_arity)
@@ -386,7 +386,7 @@ where
 		  cs = if (ds_arity>32)
 				{ cs & cs_error = checkError ("Record has too many fields ("+++toString ds_arity+++",") "32 are allowed)" cs.cs_error }
 				cs;
-		  (ts, ti, cs) = bind_types_of_constructor cti 0 [ atv_variable \\ {atv_variable} <- td_args] attr_vars type_lhs rec_cons (ts,ti,cs)
+		  (ts, ti, cs) = bind_types_of_constructor cti 0 (atype_vars_to_type_vars td_args) attr_vars type_lhs ds_index (ts,ti,cs)
 		# (rec_cons_def, ts) = 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, ti_var_heap, cs_error) = check_selectors 0 rt_fields cti_type_index st_args st_result st_vars st_attr_vars cons_exi_vars
@@ -429,33 +429,69 @@ where
 		# type_lhs = { at_attribute = cti_lhs_attribute,
 				  	   at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_ident td_arity)
 									[{at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]}
-		  ts_ti_cs = bind_types_of_constructor cti -2 [ atv_variable \\ {atv_variable} <- td_args] attr_vars type_lhs cons ts_ti_cs
+		  ts_ti_cs = bind_types_of_constructor cti -2 (atype_vars_to_type_vars td_args) attr_vars type_lhs cons.ds_index ts_ti_cs
 		= (td_rhs, ts_ti_cs)
 	check_rhs_of_TypeDef {td_rhs = AbstractSynType properties type} _ cti ts_ti_cs
 		# (type, type_attr, ts_ti_cs) = bindTypes cti type ts_ti_cs
 		= (AbstractSynType properties type, ts_ti_cs)
+	check_rhs_of_TypeDef {td_ident,td_arity,td_args,td_rhs = td_rhs=:ExtendableAlgType conses} attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} class_defs_ts_ti_cs
+		# type_lhs = { at_attribute = cti_lhs_attribute,
+				  	   at_type = TA (MakeTypeSymbIdent {glob_object = cti_type_index, glob_module = cti_module_index} td_ident td_arity)
+									[{at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]}
+		  class_defs_ts_ti_cs = bind_types_of_constructors cti 0 (atype_vars_to_type_vars td_args) attr_vars type_lhs conses class_defs_ts_ti_cs
+		= (td_rhs, class_defs_ts_ti_cs)
+	check_rhs_of_TypeDef {td_ident,td_arity,td_args,td_rhs = td_rhs=:UncheckedAlgConses type_ext_ident conses} attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} ts_ti_cs
+		# (ts,ti,cs) = ts_ti_cs
+		  (type_index, type_module, cs_symbol_table, ti_used_types) = retrieveTypeDefinition td_ident.id_info cti_module_index cs.cs_symbol_table ti.ti_used_types
+		  ti & ti_used_types = ti_used_types
+		  cs & cs_symbol_table = cs_symbol_table
+		| type_index <> NotFound
+		 	# ts_ti_cs = (ts,ti,cs)
+			// to do check if ExtendableAlgType
+			# type_lhs = { at_attribute = cti_lhs_attribute,
+					  	   at_type = TA (MakeTypeSymbIdent { glob_object = type_index, glob_module = type_module } td_ident td_arity)
+										[{at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]}
+			  ts_ti_cs = bind_types_of_added_constructors cti (atype_vars_to_type_vars td_args) attr_vars type_lhs conses ts_ti_cs
+			= (AlgConses conses {gi_module=type_module,gi_index=type_index}, ts_ti_cs)
+			# cs & cs_error = checkError td_ident "undefined" cs.cs_error
+			= (td_rhs, (ts,ti,cs))
 	check_rhs_of_TypeDef {td_rhs} _ _ ts_ti_cs
 		= (td_rhs, ts_ti_cs)
 
+	atype_vars_to_type_vars atype_vars
+		= [atv_variable \\ {atv_variable} <- atype_vars]
+
 	bind_types_of_constructors :: !CurrentTypeInfo !Index ![TypeVar] ![AttributeVar] !AType ![DefinedSymbol] !(!*TypeSymbols,!*TypeInfo,!*CheckState)
 							-> (!*TypeSymbols, !*TypeInfo, !*CheckState)
 	bind_types_of_constructors cti cons_index free_vars free_attrs type_lhs [cons=:{ds_arity,ds_ident,ds_index}:conses] (ts,ti,cs)
 		# (ts,cs) = if (ds_arity>32)
 						(constructor_has_too_many_arguments ds_index ds_ident ds_arity ts cs)
 						(ts,cs);
-		# ts_ti_cs = bind_types_of_constructor cti cons_index free_vars free_attrs type_lhs cons (ts,ti,cs)
+		# ts_ti_cs = bind_types_of_constructor cti cons_index free_vars free_attrs type_lhs ds_index (ts,ti,cs)
 		= bind_types_of_constructors cti (inc cons_index) free_vars free_attrs type_lhs conses ts_ti_cs
 	bind_types_of_constructors _ _ _ _ _ [] ts_ti_cs
 		= ts_ti_cs
 
+	bind_types_of_added_constructors :: !CurrentTypeInfo ![TypeVar] ![AttributeVar] !AType ![DefinedSymbol]
+								!(!*TypeSymbols,!*TypeInfo,!*CheckState)
+							->   (!*TypeSymbols,!*TypeInfo,!*CheckState)
+	bind_types_of_added_constructors cti free_vars free_attrs type_lhs [{ds_arity,ds_ident,ds_index}:conses] (ts,ti,cs)
+		# (ts,cs) = if (ds_arity>32)
+						(constructor_has_too_many_arguments ds_index ds_ident ds_arity ts cs)
+						(ts,cs);
+		# class_defs_ts_ti_cs = bind_types_of_constructor cti -3 free_vars free_attrs type_lhs ds_index (ts,ti,cs)
+		= bind_types_of_added_constructors cti free_vars free_attrs type_lhs conses class_defs_ts_ti_cs
+	bind_types_of_added_constructors _ _ _ _ [] class_defs_ts_ti_cs
+		= class_defs_ts_ti_cs
+
 	constructor_has_too_many_arguments ds_index ds_ident ds_arity ts cs
 		# (cons_pos,ts2) = ts!ts_cons_defs.[ds_index].cons_pos
 		= (ts2, {cs & cs_error = checkErrorWithPosition ds_ident cons_pos ("Constructor has too many arguments ("+++toString ds_arity+++", 32 are allowed)") cs.cs_error})
 
-	bind_types_of_constructor :: !CurrentTypeInfo !Index ![TypeVar] ![AttributeVar] !AType !DefinedSymbol !(!*TypeSymbols,!*TypeInfo,!*CheckState)
+	bind_types_of_constructor :: !CurrentTypeInfo !Index ![TypeVar] ![AttributeVar] !AType !Index !(!*TypeSymbols,!*TypeInfo,!*CheckState)
 								-> (!*TypeSymbols, !*TypeInfo, !*CheckState)
-	bind_types_of_constructor cti=:{cti_lhs_attribute} cons_index free_vars free_attrs type_lhs {ds_index} (ts, ti=:{ti_type_heaps}, cs)
-		# (cons_def, ts) = ts!ts_cons_defs.[ds_index]
+	bind_types_of_constructor cti=:{cti_lhs_attribute} cons_number free_vars free_attrs type_lhs cons_index (ts, ti=:{ti_type_heaps}, cs)
+		# (cons_def, ts) = ts!ts_cons_defs.[cons_index]
 		# (exi_vars, (ti_type_heaps, cs))
 		  		= addExistentionalTypeVariablesToSymbolTable cti_lhs_attribute cons_def.cons_exi_vars ti_type_heaps cs
 		  (st_args, st_attr_env, (ts, ti, cs))
@@ -464,9 +500,9 @@ where
 		  attr_vars = add_universal_attr_vars st_args free_attrs
 		  cons_type = {cons_def.cons_type & st_vars = free_vars, st_args = st_args, st_result = type_lhs, st_attr_vars = attr_vars, st_attr_env = st_attr_env}
 		  (new_type_ptr, ti_var_heap) = newPtr VI_Empty ti.ti_var_heap
-		  cons_def = { cons_def & cons_type = cons_type, cons_number = cons_index, cons_type_index = cti.cti_type_index, cons_exi_vars = exi_vars,
+		  cons_def = { cons_def & cons_type = cons_type, cons_number = cons_number, cons_type_index = cti.cti_type_index, cons_exi_vars = exi_vars,
 		  						  cons_type_ptr = new_type_ptr }
-		= ({ts & ts_cons_defs.[ds_index] = cons_def}, { ti & ti_var_heap = ti_var_heap }, { cs & cs_symbol_table=symbol_table})
+		= ({ts & ts_cons_defs.[cons_index] = cons_def}, { ti & ti_var_heap = ti_var_heap }, { cs & cs_symbol_table=symbol_table})
 	where
 		bind_types_of_cons :: ![AType] !CurrentTypeInfo ![TypeVar] ![AttrInequality] !(!*TypeSymbols, !*TypeInfo, !*CheckState)
 									  -> (![AType], ![AttrInequality],!(!*TypeSymbols, !*TypeInfo, !*CheckState))
diff --git a/frontend/classify.icl b/frontend/classify.icl
index 86e8f68..5279695 100644
--- a/frontend/classify.icl
+++ b/frontend/classify.icl
@@ -685,11 +685,13 @@ instance consumerRequirements Case where
 										  		_ -> False
 
 		inspect_patterns :: !{#CommonDefs} !Bool !CasePatterns ![(Int,Bool)] -> (!Bool,!Bool)
-		inspect_patterns common_defs has_default (AlgebraicPatterns {glob_object,glob_module} _) constructors_and_unsafe_bits
-			# type_def						= common_defs.[glob_module].com_type_defs.[glob_object]
+		inspect_patterns common_defs has_default (AlgebraicPatterns {gi_index,gi_module} algebraic_patterns) constructors_and_unsafe_bits
+			# type_def						= common_defs.[gi_module].com_type_defs.[gi_index]
 			  defined_symbols				= case type_def.td_rhs of
 													AlgType defined_symbols		-> defined_symbols
 													RecordType {rt_constructor}	-> [rt_constructor]
+													ExtendableAlgType defined_symbols -> defined_symbols
+													AlgConses defined_symbols _	-> defined_symbols
 			  all_constructors				= [ ds_index \\ {ds_index}<-defined_symbols ]
 			  all_sorted_constructors		= if (is_sorted all_constructors)
 			  										all_constructors
@@ -699,15 +701,17 @@ instance consumerRequirements Case where
 			= (appearance_loop [0,1] constructors_and_unsafe_bits, not (multimatch_loop has_default constructors_and_unsafe_bits))
 		inspect_patterns common_defs has_default (OverloadedListPatterns overloaded_list _ _) constructors_and_unsafe_bits
 			# type_def = case overloaded_list of
-							UnboxedList {glob_module,glob_object} _ _ _
-								-> common_defs.[glob_module].com_type_defs.[glob_object]
-							UnboxedTailStrictList {glob_object,glob_module} _ _ _
-								-> common_defs.[glob_module].com_type_defs.[glob_object]
-							OverloadedList {glob_object,glob_module} _ _ _
-								-> common_defs.[glob_module].com_type_defs.[glob_object]
+							UnboxedList {gi_index,gi_module} _ _ _
+								-> common_defs.[gi_module].com_type_defs.[gi_index]
+							UnboxedTailStrictList {gi_index,gi_module} _ _ _
+								-> common_defs.[gi_module].com_type_defs.[gi_index]
+							OverloadedList {gi_index,gi_module} _ _ _
+								-> common_defs.[gi_module].com_type_defs.[gi_index]
 			  defined_symbols = case type_def.td_rhs of
 									AlgType defined_symbols		-> defined_symbols
 									RecordType {rt_constructor}	-> [rt_constructor]
+									ExtendableAlgType defined_symbols -> defined_symbols
+									AlgConses defined_symbols _	-> defined_symbols
 			  all_constructors = [ ds_index \\ {ds_index}<-defined_symbols ]
 			  all_sorted_constructors = if (is_sorted all_constructors) all_constructors (sortBy (<) all_constructors)
 			= (appearance_loop all_sorted_constructors constructors_and_unsafe_bits, not (multimatch_loop has_default constructors_and_unsafe_bits))
diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl
index 3b82ebb..c408bc8 100644
--- a/frontend/comparedefimp.icl
+++ b/frontend/comparedefimp.icl
@@ -72,6 +72,14 @@ where
 	compare_rhs_of_types (AbstractSynType _ dclType) (SynType iclType) dcl_cons_defs icl_cons_defs comp_st
 		# (ok, comp_st) = compare dclType iclType comp_st
 		= (ok, icl_cons_defs, comp_st)
+	compare_rhs_of_types (ExtendableAlgType []) (ExtendableAlgType []) dcl_cons_defs icl_cons_defs comp_st
+		= (True, icl_cons_defs, comp_st)
+	compare_rhs_of_types (ExtendableAlgType dclConstructors) (ExtendableAlgType iclConstructors) dcl_cons_defs icl_cons_defs comp_st
+		= compare_constructor_lists dclConstructors iclConstructors dcl_cons_defs icl_cons_defs comp_st
+	compare_rhs_of_types (AlgConses dclConstructors dcl_type_index) (AlgConses iclConstructors icl_type_index) dcl_cons_defs icl_cons_defs comp_st
+		| dcl_type_index==icl_type_index
+			= compare_constructor_lists dclConstructors iclConstructors dcl_cons_defs icl_cons_defs comp_st
+			= (False, icl_cons_defs, comp_st)
 	compare_rhs_of_types dcl_type icl_type dcl_cons_defs icl_cons_defs comp_st
 		= (False, icl_cons_defs, comp_st)
 
@@ -85,7 +93,7 @@ where
 					= compare_constructor_lists dcl_conses icl_conses dcl_cons_defs icl_cons_defs comp_st
 				= (False, icl_cons_defs, comp_st)	
 			= (False, icl_cons_defs, comp_st)
-	compare_constructor_lists [dcl_cons : dcl_conses] [] dcl_cons_defs icl_cons_defs comp_st
+	compare_constructor_lists _ _ dcl_cons_defs icl_cons_defs comp_st
 		= (False, icl_cons_defs, comp_st)	
 
 	compare_constructors do_compare_result_types cons_index dcl_cons_defs icl_cons_defs comp_st
@@ -962,6 +970,8 @@ instance t_corresponds TypeRhs where
 		=	t_corresponds dclType iclType
 	t_corresponds (NewType dclConstructor) (NewType iclConstructor)
 		=	t_corresponds dclConstructor iclConstructor
+	t_corresponds (ExtendableAlgType dclConstructors) (ExtendableAlgType iclConstructors)
+		=	t_corresponds dclConstructors iclConstructors
 
 // sanity check ...
 	t_corresponds UnknownType _
diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl
index 801e1ac..2780825 100644
--- a/frontend/convertDynamics.icl
+++ b/frontend/convertDynamics.icl
@@ -20,7 +20,7 @@ import type_io;
 
 :: DynamicRepresentation =
 	!{	dr_type_ident		:: SymbIdent
-	,	dr_dynamic_type		:: Global Index
+	,	dr_dynamic_type		:: GlobalIndex
 	,	dr_dynamic_symbol	:: Global DefinedSymbol
 	,	dr_type_code_constructor_symb_ident :: SymbIdent
 	}
@@ -740,7 +740,7 @@ create_dynamic_and_selector_idents common_defs predefined_symbols
 	
 		# dynamic_defined_symbol
 			= {glob_module = pds_module1, glob_object = rt_constructor}
-		# dynamic_type = {glob_module = pds_module1, glob_object = pds_def1}
+		# dynamic_type = {gi_module = pds_module1, gi_index = pds_def1}
 
 		# dynamic_temp_symb_ident
 			= { SymbIdent |
diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl
index aff1e38..cb0120e 100644
--- a/frontend/convertcases.icl
+++ b/frontend/convertcases.icl
@@ -1590,7 +1590,7 @@ where
 		  true_expr = BasicExpr (BVB True)
 		  (var_args,cs_var_heap) = make_free_vars cons_arity cs_var_heap
 		  pattern = {ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = true_expr, ap_position = position}
-		  patterns = AlgebraicPatterns {glob_module=global_type_index.gi_module,glob_object=global_type_index.gi_index} [pattern]
+		  patterns = AlgebraicPatterns global_type_index [pattern]
 		  (case_expr_ptr, cs_expr_heap) = newPtr EI_Empty cs_expr_heap
 		  case_expr = Case {case_expr = case_var, case_guards = patterns, case_default = Yes fail_expr, case_ident = No,
 							case_explicit = False, case_info_ptr = case_expr_ptr, case_default_pos = NoPos}
diff --git a/frontend/generics1.icl b/frontend/generics1.icl
index 9292e0a..0bde0b2 100644
--- a/frontend/generics1.icl
+++ b/frontend/generics1.icl
@@ -401,7 +401,7 @@ where
 					| can_generate_bimap_to_or_from
 						#! (tdi_kinds,td_infos) = td_infos![glob_module,glob_object].tdi_kinds			
 						#! (args, st) = convert_args args (modules, td_infos, heaps, error)
-						-> (GTSAppConsSimpleType type_index (KindArrow tdi_kinds) args, st)
+						-> (GTSAppConsSimpleType {gi_module=type_index.glob_module,gi_index=type_index.glob_object} (KindArrow tdi_kinds) args, st)
 						-> 	convert_type_app_to_GTSAppCons glob_module glob_object args modules td_infos heaps error
 			_
 				-> 	convert_type_app_to_GTSAppCons glob_module glob_object args modules td_infos heaps error
@@ -976,7 +976,7 @@ where
 	build_expr_for_conses is_record type_def_mod type_def_index cons_def_syms arg_expr heaps error
 		# (case_alts, heaps, error)
 			= build_exprs_for_conses is_record 0 (length cons_def_syms) type_def_mod cons_def_syms  heaps error
-		# case_patterns = AlgebraicPatterns {glob_module = type_def_mod, glob_object = type_def_index} case_alts
+		# case_patterns = AlgebraicPatterns {gi_module = type_def_mod, gi_index = type_def_index} case_alts
 		# (case_expr, heaps) = buildCaseExpr arg_expr case_patterns heaps
 		= (case_expr, heaps, error)
 
@@ -1049,7 +1049,7 @@ buildConversionFrom	::
 		 FunsAndGroups,!*Heaps,!*ErrorAdmin)
 buildConversionFrom
 		type_def_mod 
-		type_def=:{td_rhs, td_ident, td_index, td_pos} 
+		type_def=:{td_rhs, td_ident, td_pos} 
 		main_module_index predefs funs_and_groups heaps error
 	# (body_expr, arg_var, heaps, error) = 
 		build_expr_for_type_rhs type_def_mod td_rhs heaps error
@@ -1148,7 +1148,7 @@ where
 	build_case_unit body_expr heaps
 		# unit_pat = buildPredefConsPattern PD_ConsUNIT [] body_expr predefs
 		# {pds_module, pds_def} = predefs.[PD_TypeUNIT]
-		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [unit_pat]
+		# case_patterns = AlgebraicPatterns {gi_module = pds_module, gi_index = pds_def} [unit_pat]
 		= build_case_expr case_patterns heaps
 
 build_pair x y predefs heaps
@@ -1172,32 +1172,32 @@ build_field var_expr predefs heaps
 build_case_pair var1 var2 body_expr predefs heaps
 	# pair_pat = buildPredefConsPattern PD_ConsPAIR [var1, var2] body_expr predefs	
 	# {pds_module, pds_def} = predefs.[PD_TypePAIR]
-	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pair_pat]	
+	# case_patterns = AlgebraicPatterns {gi_module = pds_module, gi_index = pds_def} [pair_pat]
 	= build_case_expr case_patterns heaps
 
 build_case_either left_var left_expr right_var right_expr predefs heaps
 	# left_pat = buildPredefConsPattern PD_ConsLEFT [left_var] left_expr predefs
 	# right_pat = buildPredefConsPattern PD_ConsRIGHT [right_var] right_expr predefs
 	# {pds_module, pds_def} = predefs.[PD_TypeEITHER]
-	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [left_pat, right_pat]
+	# case_patterns = AlgebraicPatterns {gi_module = pds_module, gi_index = pds_def} [left_pat, right_pat]
 	= build_case_expr case_patterns heaps
 
 build_case_object var body_expr predefs heaps
 	# pat = buildPredefConsPattern PD_ConsOBJECT [var] body_expr predefs	
 	# {pds_module, pds_def} = predefs.[PD_TypeOBJECT]
-	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
+	# case_patterns = AlgebraicPatterns {gi_module = pds_module, gi_index = pds_def} [pat]
 	= build_case_expr case_patterns heaps
 
 build_case_cons var body_expr predefs heaps
 	# pat = buildPredefConsPattern PD_ConsCONS [var] body_expr predefs	
 	# {pds_module, pds_def} = predefs.[PD_TypeCONS]
-	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
+	# case_patterns = AlgebraicPatterns {gi_module = pds_module, gi_index = pds_def} [pat]
 	= build_case_expr case_patterns heaps 
 
 build_case_field var body_expr predefs heaps
 	# pat = buildPredefConsPattern PD_ConsFIELD [var] body_expr predefs	
 	# {pds_module, pds_def} = predefs.[PD_TypeFIELD]
-	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
+	# case_patterns = AlgebraicPatterns {gi_module = pds_module, gi_index = pds_def} [pat]
 	= build_case_expr case_patterns heaps 
 
 // case with a variable as the selector expression
@@ -2769,13 +2769,13 @@ where
 	build_generic_app kind arg_exprs gen_index gen_ident heaps
 		= buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident kind arg_exprs heaps 
 
-	bimap_to_simple_type :: !(Global Index) !TypeKind ![GenTypeStruct] !Expression !*(!FunsAndGroups,!*{#CommonDefs},!*Heaps,!*ErrorAdmin)
-																  -> *(!Expression,!*(!FunsAndGroups,!*{#CommonDefs},!*Heaps,!*ErrorAdmin))
-	bimap_to_simple_type global_type_def_index=:{glob_module} (KindArrow kinds) arg_types arg (funs_and_groups,modules,heaps,error)
+	bimap_to_simple_type :: !GlobalIndex !TypeKind ![GenTypeStruct] !Expression !*(!FunsAndGroups,!*{#CommonDefs},!*Heaps,!*ErrorAdmin)
+															   -> *(!Expression,!*(!FunsAndGroups,!*{#CommonDefs},!*Heaps,!*ErrorAdmin))
+	bimap_to_simple_type global_type_def_index=:{gi_module} (KindArrow kinds) arg_types arg (funs_and_groups,modules,heaps,error)
 		# (alts,constructors_arg_types,modules,heaps)
 			= determine_constructors_arg_types global_type_def_index arg_types modules heaps
 		# (alg_patterns,funs_and_groups,modules,heaps,error)
-			= build_to_alg_patterns alts constructors_arg_types glob_module funs_and_groups modules heaps error
+			= build_to_alg_patterns alts constructors_arg_types gi_module funs_and_groups modules heaps error
 		= build_bimap_case global_type_def_index arg alg_patterns funs_and_groups modules heaps error
 	where
 		build_to_alg_patterns [cons_ds=:{ds_ident,ds_index,ds_arity}:alts] [constructor_arg_types:constructors_arg_types] type_module_n funs_and_groups modules heaps error
@@ -2804,13 +2804,13 @@ where
 		specialize_to_with_args [] [] st
 			= ([],st)
 
-	bimap_from_simple_type :: !(Global Index) !TypeKind ![GenTypeStruct] !Expression !*(!FunsAndGroups,!*{#CommonDefs},!*Heaps,!*ErrorAdmin)
-																	-> *(!Expression,!*(!FunsAndGroups,!*{#CommonDefs},!*Heaps,!*ErrorAdmin))
-	bimap_from_simple_type global_type_def_index=:{glob_module} (KindArrow kinds) arg_types arg (funs_and_groups,modules,heaps,error)
+	bimap_from_simple_type :: !GlobalIndex !TypeKind ![GenTypeStruct] !Expression !*(!FunsAndGroups,!*{#CommonDefs},!*Heaps,!*ErrorAdmin)
+																 -> *(!Expression,!*(!FunsAndGroups,!*{#CommonDefs},!*Heaps,!*ErrorAdmin))
+	bimap_from_simple_type global_type_def_index=:{gi_module} (KindArrow kinds) arg_types arg (funs_and_groups,modules,heaps,error)
 		# (alts,constructors_arg_types,modules,heaps)
 			= determine_constructors_arg_types global_type_def_index arg_types modules heaps
 		# (alg_patterns,funs_and_groups,modules,heaps,error)
-			= build_from_alg_patterns alts constructors_arg_types glob_module funs_and_groups modules heaps error
+			= build_from_alg_patterns alts constructors_arg_types gi_module funs_and_groups modules heaps error
 		= build_bimap_case global_type_def_index arg alg_patterns funs_and_groups modules heaps error
 	where
 		build_from_alg_patterns [cons_ds=:{ds_ident,ds_index,ds_arity}:alts] [constructor_arg_types:constructors_arg_types] type_module_n funs_and_groups modules heaps error
@@ -2839,16 +2839,16 @@ where
 		specialize_from_with_args [] [] st
 			= ([],st)
 
-	determine_constructors_arg_types :: !(Global Index) ![GenTypeStruct] !*Modules !*Heaps
-								 -> (![DefinedSymbol],![[GenTypeStruct]],!*Modules,!*Heaps)
-	determine_constructors_arg_types {glob_module,glob_object} arg_types modules heaps
-		# ({td_args,td_rhs=AlgType alts},modules) = modules![glob_module].com_type_defs.[glob_object]
+	determine_constructors_arg_types :: !GlobalIndex ![GenTypeStruct] !*Modules !*Heaps
+							  -> (![DefinedSymbol],![[GenTypeStruct]],!*Modules,!*Heaps)
+	determine_constructors_arg_types {gi_module,gi_index} arg_types modules heaps
+		# ({td_args,td_rhs=AlgType alts},modules) = modules![gi_module].com_type_defs.[gi_index]
 
 		# {hp_type_heaps} = heaps
 		# th_vars = number_type_arguments td_args 0 hp_type_heaps.th_vars
 		# arg_types_a = {!arg_type\\arg_type<-arg_types}
 		# (constructors_arg_types,modules,th_vars)
-			= compute_constructors_arg_types alts glob_module arg_types_a modules th_vars
+			= compute_constructors_arg_types alts gi_module arg_types_a modules th_vars
 		# th_vars = remove_type_argument_numbers td_args th_vars
 		# heaps = {heaps & hp_type_heaps={hp_type_heaps & th_vars=th_vars}}
 		= (alts,constructors_arg_types,modules,heaps)
@@ -2876,8 +2876,8 @@ where
 		compute_constructor_arg_types [] arg_types_a th_vars
 			= ([],th_vars)
 
-	build_bimap_case :: !(Global Index) !.Expression ![AlgebraicPattern] !FunsAndGroups !*Modules !*Heaps !*ErrorAdmin
-													   -> (!Expression,!(!FunsAndGroups,!*Modules,!*Heaps,!*ErrorAdmin))
+	build_bimap_case :: !GlobalIndex !.Expression ![AlgebraicPattern] !FunsAndGroups !*Modules !*Heaps !*ErrorAdmin
+													-> (!Expression,!(!FunsAndGroups,!*Modules,!*Heaps,!*ErrorAdmin))
 	build_bimap_case global_type_def_index arg alg_patterns funs_and_groups modules heaps error
 		# case_patterns = AlgebraicPatterns global_type_def_index alg_patterns
 		# (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
@@ -3834,8 +3834,7 @@ curryGenericArgType  st=:{st_args, st_result, st_attr_env, st_attr_vars} attr_va
 	= (curried_st, {th & th_attrs = th_attrs})	
 		//---> ("curryGenericArgType", st, curried_st)
 
-curryGenericArgType1 :: !SymbolType !String !*TypeHeaps 
-	-> (!SymbolType, !*TypeHeaps)
+curryGenericArgType1 :: !SymbolType !String !*TypeHeaps -> (!SymbolType, !*TypeHeaps)
 curryGenericArgType1  st=:{st_args, st_result, st_attr_env, st_attr_vars} attr_var_name th=:{th_attrs}
 	# (atype, attr_vars, av_num, th_attrs) = curry st_args st_result 1 th_attrs
 	# curried_st = {st & st_args = [], st_arity = 0, st_result = atype, st_attr_vars = attr_vars}
diff --git a/frontend/hashtable.dcl b/frontend/hashtable.dcl
index 088d5ae..326d724 100644
--- a/frontend/hashtable.dcl
+++ b/frontend/hashtable.dcl
@@ -25,6 +25,7 @@ set_hte_mark :: !Int !*HashTable -> *HashTable
 				| IC_InstanceMember ![Type]
 				| IC_Generic
 				| IC_GenericCase !Type
+				| IC_TypeExtension !{#Char}/*module name*/
 				| IC_Unknown
 
 ::	QualifiedIdents	= QualifiedIdents !Ident !IdentClass !QualifiedIdents
diff --git a/frontend/hashtable.icl b/frontend/hashtable.icl
index eb011b1..b5e8552 100644
--- a/frontend/hashtable.icl
+++ b/frontend/hashtable.icl
@@ -23,6 +23,7 @@ import predef, syntax, compare_types, compare_constructor
 				| IC_InstanceMember ![Type]
 				| IC_Generic
 				| IC_GenericCase !Type
+				| IC_TypeExtension !{#Char}/*module name*/
 				| IC_Unknown
 
 ::	QualifiedIdents	= QualifiedIdents !Ident !IdentClass !QualifiedIdents
@@ -46,6 +47,8 @@ where
 		= type1 =< type2
 	(=<) (IC_Field typ_id1) (IC_Field typ_id2)
 		= typ_id1 =< typ_id2
+	(=<) (IC_TypeExtension module_name1) (IC_TypeExtension module_name2)
+		= module_name1=<module_name2
 	(=<) ic1 ic2
 		| equal_constructor ic1 ic2
 			= Equal
diff --git a/frontend/mergecases.icl b/frontend/mergecases.icl
index fee3c4c..40f2579 100644
--- a/frontend/mergecases.icl
+++ b/frontend/mergecases.icl
@@ -298,8 +298,8 @@ where
 		# (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 guards=:(AlgebraicPatterns type1 patterns1) (OverloadedListPatterns type2 decons_expr2 patterns2) var_heap symbol_heap error
-		| type1.glob_module==cPredefinedModuleIndex && isOverloaded type2
-			# index=type1.glob_object+FirstTypePredefinedSymbolIndex
+		| type1.gi_module==cPredefinedModuleIndex && isOverloaded type2
+			# index=type1.gi_index+FirstTypePredefinedSymbolIndex
 			| index==PD_ListType
 				# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_ConsSymbol PD_NilSymbol
 				= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
@@ -314,8 +314,8 @@ where
 				= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
 				= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
 	merge_guards guards=:(OverloadedListPatterns type1 decons_expr1 patterns1) (AlgebraicPatterns type2 patterns2) var_heap symbol_heap error
-		| type2.glob_module==cPredefinedModuleIndex && isOverloaded type1
-			# index=type2.glob_object+FirstTypePredefinedSymbolIndex
+		| type2.gi_module==cPredefinedModuleIndex && isOverloaded type1
+			# index=type2.gi_index+FirstTypePredefinedSymbolIndex
 			| index==PD_ListType
 				# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_ConsSymbol PD_NilSymbol
 				= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
diff --git a/frontend/parse.icl b/frontend/parse.icl
index 721a66a..c97e7c3 100644
--- a/frontend/parse.icl
+++ b/frontend/parse.icl
@@ -1806,8 +1806,8 @@ where
   					-> want_record_type_rhs name True exi_vars pState
 	 		  		->	(PD_Type td, parseError "Record type" No ("after ! in definition of record type "+name+" { ") pState)
 			_
-				# (condefs, pState)	= want_constructor_list exi_vars token pState
-				# td = {td & td_rhs = ConsList condefs}
+				# (condefs, extendable_algebraic_type, pState) = want_constructor_list exi_vars token pState
+				# td & td_rhs = if extendable_algebraic_type (ExtendableConses condefs) (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)
@@ -1851,6 +1851,20 @@ where
 			= (PD_Type td, pState)
 			= (PD_Type td, parseError "abstract type" No ("type attribute "+toString td_attribute+" for abstract type "+name+" is not") (tokenBack pState))
 
+	want_type_rhs BarToken parseContext td=:{td_ident,td_attribute} annot pState
+		# name					= td_ident.id_name
+		  pState				= verify_annot_attr annot td_attribute name pState
+		  (exi_vars, pState)	= optionalExistentialQuantifiedVariables pState
+		  (token, pState)		= nextToken GeneralContext pState // should be TypeContext
+		  (condefs, pState)		= want_more_constructors exi_vars token pState
+		  (file_name, pState) = getFilename pState
+		  module_name = file_name % (0,size file_name-4)
+		  (type_ext_ident, pState) = stringToIdent name (IC_TypeExtension module_name) pState
+		  td & td_rhs			= MoreConses type_ext_ident 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 token parseContext td=:{td_attribute} annot pState
 		| isIclContext parseContext
 			= (PD_Erroneous, parseError "type RHS" (Yes token) "type definition" pState)
@@ -1879,14 +1893,27 @@ where
 			= (TA_None, cAllBitsClear)
 			= (attr, cIsNonCoercible)
 
-	want_constructor_list :: ![ATypeVar] !Token !ParseState -> (.[ParsedConstructor],ParseState)
+	want_constructor_list :: ![ATypeVar] !Token !ParseState -> (![ParsedConstructor],!Bool,!ParseState)
+	want_constructor_list exi_vars DotDotToken pState
+		= ([], True, pState)
 	want_constructor_list exi_vars token pState
 		# (cons,pState) = want_constructor exi_vars token pState
 		  (token, pState) = nextToken TypeContext pState
 		| token == BarToken
 			# (exi_vars, pState) = optionalExistentialQuantifiedVariables pState
 			  (token, pState) = nextToken GeneralContext pState
-			  (cons_list, pState) = want_constructor_list exi_vars token pState
+			  (cons_list, extendable_algebraic_type, pState) = want_constructor_list exi_vars token pState
+			= ([cons : cons_list], extendable_algebraic_type, pState)
+			= ([cons], False, tokenBack pState)
+
+	want_more_constructors :: ![ATypeVar] !Token !ParseState -> (![ParsedConstructor],!ParseState)
+	want_more_constructors exi_vars token pState
+		# (cons,pState) = want_constructor exi_vars token pState
+		  (token, pState) = nextToken TypeContext pState
+		| token == BarToken
+			# (exi_vars, pState) = optionalExistentialQuantifiedVariables pState
+			  (token, pState) = nextToken GeneralContext pState
+			  (cons_list, pState) = want_more_constructors exi_vars token pState
 			= ([cons : cons_list], pState)
 			= ([cons], tokenBack pState)
 
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index c384ca8..c34395f 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -1318,6 +1318,20 @@ reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = AbstractTypeSpec p
 	  type_def = { type_def & td_rhs = AbstractSynType properties type }
 	  c_defs = { c_defs & def_types = [type_def : c_defs.def_types] }
 	= (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca)
+reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = ExtendableConses cons_defs} : defs] def_counts=:{cons_count,type_count} ca
+	# (cons_symbs, cons_count) = determine_symbols_of_conses cons_defs cons_count
+	  def_counts & cons_count=cons_count, type_count=type_count+1
+	  (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca) = reorganiseDefinitions icl_module defs def_counts ca
+	  type_def & td_rhs = ExtendableAlgType cons_symbs
+	  c_defs & def_types = [type_def : c_defs.def_types], def_constructors = mapAppend ParsedConstructorToConsDef cons_defs c_defs.def_constructors
+	= (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca)  
+reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = MoreConses type_ext_ident cons_defs} : defs] def_counts=:{cons_count,type_count} ca
+	# (cons_symbs, cons_count) = determine_symbols_of_conses cons_defs cons_count
+	  def_counts & cons_count=cons_count, type_count=type_count+1
+	  (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca) = reorganiseDefinitions icl_module defs def_counts ca
+	  type_def & td_rhs = UncheckedAlgConses type_ext_ident cons_symbs
+	  c_defs & def_types = [type_def : c_defs.def_types], def_constructors = mapAppend ParsedConstructorToConsDef cons_defs c_defs.def_constructors
+	= (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca)  
 reorganiseDefinitions icl_module [PD_Class class_def=:{class_ident,class_arity,class_args} members : defs] def_counts=:{mem_count} ca
 	# type_context = { tc_class = TCClass {glob_module = NoIndex, glob_object = {ds_ident = class_ident, ds_arity = class_arity, ds_index = NoIndex }},
 					   tc_types = [ TV tv \\ tv <- class_args ], tc_var = nilPtr}
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 37d020a..ab17380 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -74,6 +74,7 @@ instance == FunctionOrMacroIndex
 				| STE_UsedQualifiedType !ModuleN !Index !STE_Kind
 				| STE_BelongingSymbolExported
 				| STE_BelongingSymbolForExportedSymbol
+				| STE_TypeExtension
 
 ::	ModuleN:==Int;
 
@@ -185,6 +186,8 @@ instance == FunctionOrMacroIndex
 					| NewTypeCons !ParsedConstructor
 					| EmptyRhs !BITVECT
 					| AbstractTypeSpec !BITVECT !AType
+					| ExtendableConses ![ParsedConstructor]
+					| MoreConses !Ident ![ParsedConstructor]
 
 ::	CollectedDefinitions instance_kind =
 	{	def_types 			:: ![TypeDef TypeRhs]
@@ -523,6 +526,9 @@ cIsImportedObject :== False
 			| NewType !DefinedSymbol
 			| AbstractType !BITVECT
 			| AbstractSynType !BITVECT !AType
+			| ExtendableAlgType ![DefinedSymbol]
+			| AlgConses ![DefinedSymbol] !GlobalIndex
+			| UncheckedAlgConses !Ident ![DefinedSymbol]
 			| UnknownType
 
 ::	ParsedTypeDef	:== TypeDef RhsDefsOfType
@@ -578,7 +584,7 @@ NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex}
  	| GTSE
 	| GTSAppConsBimapKindConst					// for optimizing bimaps
 	| GTSAppBimap TypeKind [GenTypeStruct]		// for optimizing bimaps
-	| GTSAppConsSimpleType !(Global Index) !TypeKind ![GenTypeStruct]	// for optimizing bimaps
+	| GTSAppConsSimpleType !GlobalIndex !TypeKind ![GenTypeStruct]	// for optimizing bimaps
 
 :: GenericTypeRep = 
 	{ gtr_type :: GenTypeStruct		// generic structure type
@@ -699,7 +705,7 @@ pIsSafe			:== True
 ::	OptionalVariable :== Optional (Bind Ident VarInfoPtr)
 
 :: 	AuxiliaryPattern
-		= AP_Algebraic !(Global DefinedSymbol) !Index [AuxiliaryPattern] OptionalVariable
+		= AP_Algebraic !(Global DefinedSymbol) !GlobalIndex ![AuxiliaryPattern] !OptionalVariable
 		| AP_Variable !Ident !VarInfoPtr OptionalVariable
 		| AP_Basic !BasicValue OptionalVariable
 		| AP_NewType !(Global DefinedSymbol) !Index AuxiliaryPattern OptionalVariable
@@ -708,7 +714,7 @@ pIsSafe			:== True
 		| AP_WildCard !OptionalVariable
 		| AP_Empty
 
-:: AP_Kind = APK_Constructor !Index | APK_NewTypeConstructor !Index | APK_Macro !Bool // is_dcl_macro
+:: AP_Kind = APK_Constructor !GlobalIndex | APK_NewTypeConstructor !Index | APK_Macro !Bool // is_dcl_macro
 
 ::	VI_TypeInfo	= VITI_Empty
 				| VITI_Coercion		CoercionPosition
@@ -930,7 +936,7 @@ cNotVarNumber :== -1
 	{	cons_ident			:: !Ident
 	,	cons_type			:: !SymbolType
 	,	cons_priority		:: !Priority
-	,	cons_number			:: !Index // -2 for newtype constructor
+	,	cons_number			:: !Index // -2 for newtype constructor, -3 for added constructor
 	,	cons_type_index		:: !Index
 	,	cons_exi_vars		:: ![ATypeVar]
 	,	cons_type_ptr		:: !VarInfoPtr
@@ -1362,16 +1368,16 @@ cIsNotStrict	:== False
 	,	dyn_type_code	:: !TypeCodeExpression		/* filled after type checking */
 	}	
 
-::	CasePatterns= AlgebraicPatterns !(Global Index) ![AlgebraicPattern]
+::	CasePatterns= AlgebraicPatterns !GlobalIndex ![AlgebraicPattern]
 				| BasicPatterns !BasicType [BasicPattern]
-				| NewTypePatterns !(Global Index) ![AlgebraicPattern]
+				| NewTypePatterns !GlobalIndex ![AlgebraicPattern]
 				| DynamicPatterns [DynamicPattern]						/* auxiliary */
 				| OverloadedListPatterns !OverloadedListType !Expression ![AlgebraicPattern]
 				| NoPattern											/* auxiliary */
 
-::	OverloadedListType	= UnboxedList !(Global Index) !Index !Index !Index // list_type_symbol StdStrictLists module index, decons_u index, nil_u index
-						| UnboxedTailStrictList !(Global Index) !Index !Index !Index // list_type_symbol StdStrictLists module index, decons_uts index, nil_uts index
-						| OverloadedList !(Global Index) !Index !Index !Index // list_type_symbol StdStrictLists module index, decons index, nil index
+::	OverloadedListType	= UnboxedList !GlobalIndex !Index !Index !Index // list_type_symbol StdStrictLists module index, decons_u index, nil_u index
+						| UnboxedTailStrictList !GlobalIndex !Index !Index !Index // list_type_symbol StdStrictLists module index, decons_uts index, nil_uts index
+						| OverloadedList !GlobalIndex !Index !Index !Index // list_type_symbol StdStrictLists module index, decons index, nil index
 
 instance == OverloadedListType
 
diff --git a/frontend/type.icl b/frontend/type.icl
index eab10c7..596d063 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -760,40 +760,98 @@ fresh_environment inequalities attr_env attr_heap
 		is_new_ineqality dem_attr_var off_attr_var []
 			= True
 
-freshAlgebraicType :: !(Global Int) ![AlgebraicPattern] !{#CommonDefs} !*TypeState -> (![[AType]],!AType,![AttrCoercion],!TypeRhs,!*TypeState)
-freshAlgebraicType {glob_module,glob_object} patterns common_defs ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_exis_variables}
-	# {td_rhs,td_args,td_attrs,td_ident,td_attribute} = common_defs.[glob_module].com_type_defs.[glob_object]
+freshAlgebraicType :: !GlobalIndex ![AlgebraicPattern] !{#CommonDefs} !*TypeState -> (![[AType]],!AType,![AttrCoercion],!TypeRhs,!*TypeState)
+freshAlgebraicType {gi_module,gi_index} patterns common_defs ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_exis_variables}
+	# {td_rhs,td_args,td_attrs}		= common_defs.[gi_module].com_type_defs.[gi_index]
 	# (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)
 	  ts_type_heaps					= { ts_type_heaps & th_vars = th_vars, th_attrs = th_attrs }
-	  (cons_types, alg_type, attr_env, ts_var_store, ts_attr_store, ts_type_heaps, ts_exis_variables)
-	  		= fresh_symbol_types patterns common_defs.[glob_module].com_cons_defs ts_var_store ts_attr_store ts_type_heaps ts_exis_variables
+	  (cons_types, alg_type, attr_env, constructor_contexts, ts_var_store, ts_attr_store, ts_type_heaps, ts_exis_variables)
+	  		= fresh_symbol_types patterns common_defs td_attrs td_args ts_var_store ts_attr_store ts_type_heaps ts_exis_variables
 	= (cons_types, alg_type, attr_env, td_rhs,
 			{ ts & ts_var_store = ts_var_store, ts_attr_store = ts_attr_store, ts_type_heaps = ts_type_heaps, ts_exis_variables = ts_exis_variables })
 where
-	fresh_symbol_types [{ap_symbol={glob_object},ap_expr}] cons_defs var_store attr_store type_heaps all_exis_variables
-		# {cons_type = ct=:{st_args,st_attr_env,st_result}, cons_exi_vars} = cons_defs.[glob_object.ds_index]
-		  (exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
-	  	  (attr_env, th_attrs) 		= fresh_environment st_attr_env [] type_heaps.th_attrs
-	  	  (result_type, type_heaps)	= freshCopy st_result { type_heaps & th_attrs = th_attrs }
-	  	  (fresh_args, type_heaps)	= freshCopy st_args type_heaps
-	  	  all_exis_variables		= add_exis_variables ap_expr exis_variables all_exis_variables
-		= ([fresh_args], result_type, attr_env, var_store, attr_store, type_heaps, all_exis_variables)
-	fresh_symbol_types [{ap_symbol={glob_object},ap_expr} : patterns] cons_defs var_store attr_store type_heaps all_exis_variables
-		# (cons_types, result_type, attr_env, var_store, attr_store, type_heaps, all_exis_variables)
-				= fresh_symbol_types patterns cons_defs var_store attr_store type_heaps all_exis_variables
-		  {cons_type = ct=:{st_args,st_attr_env}, cons_exi_vars} = cons_defs.[glob_object.ds_index]
-		  (exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
-		  (attr_env, th_attrs) 		= fresh_environment st_attr_env attr_env type_heaps.th_attrs
-	  	  (fresh_args, type_heaps) 	= freshCopy st_args { type_heaps & th_attrs = th_attrs }
-	  	  all_exis_variables		= add_exis_variables ap_expr exis_variables all_exis_variables
-		= ([fresh_args : cons_types], result_type, attr_env, var_store, attr_store, type_heaps, all_exis_variables)
+	fresh_symbol_types [{ap_symbol={glob_object,glob_module},ap_expr}] common_defs td_attrs td_args var_store attr_store type_heaps all_exis_variables
+		# {cons_type = {st_args,st_attr_env,st_result,st_context}, cons_exi_vars, cons_number, cons_type_index} = common_defs.[glob_module].com_cons_defs.[glob_object.ds_index]
+		| cons_number <> -3
+			# (exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
+		  	  (attr_env, th_attrs) 		= fresh_environment st_attr_env [] type_heaps.th_attrs
+		  	  (result_type, type_heaps)	= freshCopy st_result { type_heaps & th_attrs = th_attrs }
+		  	  (fresh_args, type_heaps)	= freshCopy st_args type_heaps
+		  	  all_exis_variables		= add_exis_variables ap_expr exis_variables all_exis_variables
+			| isEmpty st_context
+				= ([fresh_args], result_type, attr_env, [], var_store, attr_store, type_heaps, all_exis_variables)
+				# (context, type_heaps) = freshTypeContexts_no_fresh_context_vars st_context type_heaps // fresh_context_vars are created later
+				= ([fresh_args], result_type, attr_env, [(glob_object,context)], var_store, attr_store, type_heaps, all_exis_variables)
+			# extension_type = common_defs.[glob_module].com_type_defs.[cons_type_index]
+			  th_vars = copy_type_variables extension_type.td_args td_args type_heaps.th_vars
+			  th_attrs = copy_attributes extension_type.td_attrs td_attrs type_heaps.th_attrs
+			  type_heaps & th_vars = th_vars, th_attrs = th_attrs
+			# (exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
+		  	  (attr_env, th_attrs) 		= fresh_environment st_attr_env [] type_heaps.th_attrs
+		  	  (result_type, type_heaps)	= freshCopy st_result { type_heaps & th_attrs = th_attrs }
+		  	  (fresh_args, type_heaps)	= freshCopy st_args type_heaps
+		  	  all_exis_variables		= add_exis_variables ap_expr exis_variables all_exis_variables
+			| isEmpty st_context
+				= ([fresh_args], result_type, attr_env, [], var_store, attr_store, type_heaps, all_exis_variables)
+				# (context, type_heaps) = freshTypeContexts_no_fresh_context_vars st_context type_heaps // fresh_context_vars are created later
+				= ([fresh_args], result_type, attr_env, [(glob_object,context)], var_store, attr_store, type_heaps, all_exis_variables)
+	fresh_symbol_types [{ap_symbol={glob_object,glob_module},ap_expr} : patterns] common_defs td_attrs td_args var_store attr_store type_heaps all_exis_variables
+		# (cons_types, result_type, attr_env, constructor_contexts, var_store, attr_store, type_heaps, all_exis_variables)
+				= fresh_symbol_types patterns common_defs td_attrs td_args var_store attr_store type_heaps all_exis_variables
+		# {cons_type = {st_args,st_attr_env,st_context}, cons_exi_vars,cons_number, cons_type_index} = common_defs.[glob_module].com_cons_defs.[glob_object.ds_index]
+		| cons_number <> -3
+			# (exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
+			  (attr_env, th_attrs) 		= fresh_environment st_attr_env attr_env type_heaps.th_attrs
+		  	  (fresh_args, type_heaps) 	= freshCopy st_args { type_heaps & th_attrs = th_attrs }
+		  	  all_exis_variables		= add_exis_variables ap_expr exis_variables all_exis_variables
+			| isEmpty st_context
+				= ([fresh_args : cons_types], result_type, attr_env, constructor_contexts, var_store, attr_store, type_heaps, all_exis_variables)
+			  	# (context, type_heaps) = freshTypeContexts_no_fresh_context_vars st_context type_heaps // fresh_context_vars are created later
+				= ([fresh_args : cons_types], result_type, attr_env, [(glob_object,context):constructor_contexts], var_store, attr_store, type_heaps, all_exis_variables)
+			# extension_type = common_defs.[glob_module].com_type_defs.[cons_type_index]
+			  th_vars = copy_type_variables extension_type.td_args td_args type_heaps.th_vars
+			  th_attrs = copy_attributes extension_type.td_attrs td_attrs type_heaps.th_attrs
+			  type_heaps & th_vars = th_vars, th_attrs = th_attrs
+			# (exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
+			  (attr_env, th_attrs) 		= fresh_environment st_attr_env attr_env type_heaps.th_attrs
+		  	  (fresh_args, type_heaps) 	= freshCopy st_args { type_heaps & th_attrs = th_attrs }
+		  	  all_exis_variables		= add_exis_variables ap_expr exis_variables all_exis_variables
+			| isEmpty st_context
+				= ([fresh_args : cons_types], result_type, attr_env, constructor_contexts, var_store, attr_store, type_heaps, all_exis_variables)
+			  	# (context, type_heaps) = freshTypeContexts_no_fresh_context_vars st_context type_heaps // fresh_context_vars are created later
+				= ([fresh_args : cons_types], result_type, attr_env, [(glob_object,context):constructor_contexts], var_store, attr_store, type_heaps, all_exis_variables)
 
 	add_exis_variables expr [] exis_variables
 		= exis_variables
 	add_exis_variables expr new_exis_variables exis_variables
 		= [(CP_Expression expr, new_exis_variables) : exis_variables]
 
+	copy_type_variables [dest_type_var:dest_type_vars] [source_type_var:source_type_vars] th_vars
+		# (tv_info/*TVI_Type (TempV type_var_number)*/,th_vars) = readPtr source_type_var.atv_variable.tv_info_ptr th_vars
+		# th_vars = writePtr dest_type_var.atv_variable.tv_info_ptr tv_info th_vars
+		= copy_type_variables dest_type_vars source_type_vars th_vars
+	copy_type_variables [] [] th_vars
+		= th_vars
+
+	copy_attributes [dest_attr:dest_attrs] [source_attr:source_attrs] th_attrs
+		# (av_info/*AVI_Attr (TA_TempVar attr_number)*/,th_attrs) = readPtr source_attr.av_info_ptr th_attrs
+		# th_attrs = writePtr dest_attr.av_info_ptr av_info th_attrs
+		= copy_attributes dest_attrs source_attrs th_attrs
+	copy_attributes [] [] th_attrs
+		= th_attrs
+
+create_fresh_context_vars [(cons_symbol,contexts):constructor_contexts] var_heap
+	# (constructor_contexts,var_heap) = create_fresh_context_vars constructor_contexts var_heap
+	# (contexts,var_heap) = mapSt fresh_type_context_var contexts var_heap
+	= ([(cons_symbol,contexts):constructor_contexts],var_heap);
+where
+	fresh_type_context_var tc var_heap
+		# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+		= ({tc & tc_var = new_info_ptr}, var_heap)
+create_fresh_context_vars [] var_heap
+	= ([],var_heap)
+
 fresh_overloaded_list_type [{ap_symbol}:patterns] pd_cons_symbol pd_nil_symbol decons_u_index nil_u_index stdStrictLists_index pos functions common_defs ts
 	| ap_symbol.glob_module==cPredefinedModuleIndex
 		| ap_symbol.glob_object.ds_index==pd_cons_symbol-FirstConstructorPredefinedSymbolIndex
@@ -991,6 +1049,13 @@ where
 			= ({ tc & tc_types = tc_types, tc_var = new_info_ptr }, (type_heaps, var_heap))
 			= ({ tc & tc_types = tc_types}, (type_heaps, var_heap))
 
+freshTypeContexts_no_fresh_context_vars tcs type_heaps
+	= mapSt fresh_type_context tcs type_heaps
+where
+	fresh_type_context tc=:{tc_types} type_heaps
+		# (tc_types, type_heaps) = fresh_context_types tc_types type_heaps
+		= ({tc & tc_types = tc_types}, type_heaps)
+
 fresh_context_types tc_types type_heaps
 	= mapSt fresh_context_type tc_types type_heaps
 where
@@ -1543,13 +1608,13 @@ where
 			= ({ 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 })
 		
-		update_case_variable (Var {var_ident,var_info_ptr,var_expr_ptr}) (RecordType {rt_constructor={ds_index}}) [cons_type] {glob_module} var_heap
+		update_case_variable (Var {var_ident,var_info_ptr}) (RecordType {rt_constructor={ds_index}}) [cons_type] {gi_module} var_heap
 			# (var_info, var_heap) = readPtr var_info_ptr var_heap
 			= case var_info of
 				VI_Type type type_info
-					-> var_heap <:= (var_info_ptr, VI_Type type (VITI_PatternType cons_type glob_module ds_index type_info))
+					-> var_heap <:= (var_info_ptr, VI_Type type (VITI_PatternType cons_type gi_module ds_index type_info))
 				VI_FAType vars type type_info
-					-> var_heap <:= (var_info_ptr, VI_FAType vars type (VITI_PatternType cons_type glob_module ds_index type_info))
+					-> var_heap <:= (var_info_ptr, VI_FAType vars type (VITI_PatternType cons_type gi_module ds_index type_info))
 			  	_
 					-> abort "update_case_variable" // ---> (var_ident <<- var_info))
 		update_case_variable expr td_rhs cons_types alg_type var_heap