add pattern match test using =: in expressions,

add constructors PE_Matches and IsConstructor in module syntax


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

18 files changed, 556 insertions, 145 deletions

diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl
index 0a16d03..83fc6f2 100644
--- a/frontend/checkFunctionBodies.icl
+++ b/frontend/checkFunctionBodies.icl
@@ -878,7 +878,45 @@ checkExpression free_vars (PE_TypeSignature array_kind expr) e_input e_state e_i
 
 	# expr = TypeSignature strict_array_type expr
 */
-
+checkExpression free_vars (PE_Matches case_ident expr pattern position) e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
+	# (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
+	  {es_fun_defs,es_var_heap,es_expr_heap} = e_state
+	  ps = {ps_var_heap = es_var_heap,ps_fun_defs = es_fun_defs}
+	  (pattern, (_/*var_env*/, _/*array_patterns*/), {ps_fun_defs,ps_var_heap}, e_info, cs)
+		= 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
+				  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))
+		  true_expr = BasicExpr (BVB True)
+		  (guarded_expr, pattern_scheme, _/*pattern_variables*/, defaul, es_var_heap, es_expr_heap, _/*dynamics_in_patterns*/, cs)
+			= transform_pattern pattern NoPattern NoPattern [] fail_expr true_expr case_ident.id_name position ps_var_heap es_expr_heap [] cs
+		  (case_expr, es_var_heap, es_expr_heap)
+		 	= build_and_share_case guarded_expr defaul expr case_ident cCaseExplicit es_var_heap es_expr_heap
+		  e_state & es_fun_defs=ps_fun_defs, es_var_heap = es_var_heap, es_expr_heap = es_expr_heap
+		= (case_expr, free_vars, e_state, e_info, cs)
+where
+	is_single_constructor_pattern (AP_Algebraic cons_symbol _ args No)
+		| 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 ||
+			  pd_cons_index==PD_UnboxedTailStrictConsSymbol || pd_cons_index==PD_UnboxedTailStrictNilSymbol ||
+			  pd_cons_index==PD_OverloadedConsSymbol || pd_cons_index==PD_OverloadedNilSymbol
+				= False
+				= all_wild_card_args args
+			= all_wild_card_args args
+	is_single_constructor_pattern _
+		= False
+
+	all_wild_card_args [AP_WildCard No : args]
+		= all_wild_card_args args
+	all_wild_card_args [_:_]
+		= False
+	all_wild_card_args []
+		= True
 checkExpression free_vars expr e_input e_state e_info cs
 	= abort "checkExpression (checkFunctionBodies.icl)" // <<- expr
 
diff --git a/frontend/classify.icl b/frontend/classify.icl
index 0d04014..db6c189 100644
--- a/frontend/classify.icl
+++ b/frontend/classify.icl
@@ -442,8 +442,6 @@ instance consumerRequirements Expression where
 		= consumerRequirements case_expr common_defs ai
 	consumerRequirements (BasicExpr _) _ ai
 		= (CPassive, False, ai)
-	consumerRequirements (MatchExpr _ expr) common_defs ai
-		= consumerRequirements expr common_defs ai
 	consumerRequirements (Selection _ expr selectors) common_defs ai
 		# (cc, _, ai) = consumerRequirements expr common_defs ai
 		  ai = aiUnifyClassifications CActive cc ai
@@ -460,6 +458,10 @@ instance consumerRequirements Expression where
 		= (CPassive, False, ai)
 	consumerRequirements (TupleSelect tuple_symbol arg_nr expr) common_defs ai
 		= consumerRequirements expr common_defs ai
+	consumerRequirements (MatchExpr _ expr) common_defs ai
+		= consumerRequirements expr common_defs ai
+	consumerRequirements (IsConstructor expr _ _ _ _ _) common_defs ai
+		= consumerRequirements expr common_defs ai
 	consumerRequirements (AnyCodeExpr _ _ _) _ ai=:{ai_cur_ref_counts}
 		#! s							= size ai_cur_ref_counts
 		   twos_array					= n_twos_counts s
@@ -1427,8 +1429,6 @@ count_locals (Case {case_expr,case_guards,case_default}) n
 	= count_case_locals case_guards (count_locals case_expr (count_optional_locals case_default n))
 count_locals (BasicExpr _) n
 	= n
-count_locals (MatchExpr _ expr) n
-	= count_locals expr n
 count_locals (Selection _ expr selectors) n
 	= count_selector_locals selectors (count_locals expr n)
 count_locals (Update expr1 selectors expr2) n
@@ -1440,6 +1440,10 @@ count_locals (RecordUpdate _ expr exprs) n
 	= foldSt count_bind_locals exprs (count_locals expr n)
 count_locals (TupleSelect _ _ expr) n
 	= count_locals expr n
+count_locals (MatchExpr _ expr) n
+	= count_locals expr n
+count_locals (IsConstructor expr _ _ _ _ _) n
+	= count_locals expr n
 count_locals (AnyCodeExpr _ _ _) n
 	= n
 count_locals (ABCCodeExpr _ _) n
@@ -1749,6 +1753,8 @@ instance producerRequirements Expression where
 		= (False,prs)
 	producerRequirements (MatchExpr _ expr) prs
 		= producerRequirements expr prs
+	producerRequirements (IsConstructor expr _ _ _ _ _) prs
+		= producerRequirements expr prs
 	producerRequirements (DynamicExpr _) prs
 		= (False,prs)
 	producerRequirements (TypeCodeExpression _) prs
diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl
index d91decb..3b82ebb 100644
--- a/frontend/comparedefimp.icl
+++ b/frontend/comparedefimp.icl
@@ -1126,6 +1126,10 @@ instance e_corresponds Expression where
 				 (MatchExpr icl_cons_symbol icl_src_expr)
 		=	e_corresponds dcl_cons_symbol icl_cons_symbol
 		o`	e_corresponds dcl_src_expr icl_src_expr
+	e_corresponds (IsConstructor dcl_src_expr dcl_cons_symbol _ _ _ _)
+				 (IsConstructor icl_src_expr icl_cons_symbol _ _ _ _)
+		=	e_corresponds dcl_cons_symbol icl_cons_symbol
+		o`	e_corresponds dcl_src_expr icl_src_expr
 	e_corresponds (FreeVar dcl) (FreeVar icl)
 		= e_corresponds dcl icl
 	e_corresponds (DynamicExpr dcl) (DynamicExpr icl)
diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl
index 9bfe503..801e1ac 100644
--- a/frontend/convertDynamics.icl
+++ b/frontend/convertDynamics.icl
@@ -3,7 +3,6 @@ implementation module convertDynamics
 import syntax
 
 from type_io_common import PredefinedModuleName
-
 // Optional
 extended_unify_and_coerce no yes :== no;	// change also _unify and _coerce in StdDynamic
 
@@ -286,13 +285,16 @@ instance convertDynamics Expression where
 		= (TupleSelect definedSymbol int expression, ci)
 	convertDynamics _ be=:(BasicExpr _) ci
 		= (be, ci)
+	convertDynamics cinp (MatchExpr symb expression) ci
+		# (expression, ci) = convertDynamics cinp expression ci
+		= (MatchExpr symb expression, ci)
+	convertDynamics cinp (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) ci
+		# (expr, ci) = convertDynamics cinp expr ci
+		= (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position, ci)
 	convertDynamics _ code_expr=:(AnyCodeExpr _ _ _) ci
 		= (code_expr, ci)
 	convertDynamics _ code_expr=:(ABCCodeExpr _ _) ci
 		= (code_expr, ci)
-	convertDynamics cinp (MatchExpr symb expression) ci
-		# (expression, ci) = convertDynamics cinp expression ci
-		= (MatchExpr symb expression, ci)
 	convertDynamics cinp (DynamicExpr dyno) ci
 		= convertDynamic cinp dyno ci
 	convertDynamics cinp EE ci
@@ -324,7 +326,7 @@ instance convertDynamics Case where
 			_
 				# (case_guards, ci) = convertDynamics cinp case_guards ci
 				# kees & case_guards=case_guards
-				->	(kees, ci)
+				-> (kees, ci)
 
 instance convertDynamics CasePatterns where
 	convertDynamics cinp (BasicPatterns type alts) ci
diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl
index 610407a..9b40ba0 100644
--- a/frontend/convertcases.icl
+++ b/frontend/convertcases.icl
@@ -4,13 +4,11 @@ import syntax, compare_types, utilities, expand_types, general
 from checksupport import ::Component(..),::ComponentMembers(..)
 
 // exactZip fails when its arguments are of unequal length
-exactZip` :: ![.a] ![.b] -> [(.a,.b)]
-exactZip` [] []
-	=	[]
-exactZip` [x:xs][y:ys]
+exactZip :: ![.a] ![.b] -> [(.a,.b)]
+exactZip [x:xs][y:ys]
 	=	[(x,y) : exactZip xs ys]
-exactZip
-	:==	exactZip`
+exactZip [] []
+	=	[]
 
 getIdent :: (Optional Ident) Int -> Ident
 getIdent (Yes ident) fun_nr
@@ -238,8 +236,6 @@ where
 		= weightedRefCountOfCase rci case_expr case_info {rs & rcs_expr_heap = rcs_expr_heap}
 	weightedRefCount rci expr=:(BasicExpr _) rs
 		= rs
-	weightedRefCount rci (MatchExpr constructor expr) rs
-		= weightedRefCount rci expr rs
 	weightedRefCount rci (Selection opt_tuple expr selections) rs
 		= weightedRefCount rci (expr, selections) rs
 	weightedRefCount rci (Update expr1 selections expr2) rs
@@ -248,6 +244,10 @@ where
 		= weightedRefCount rci (expr, exprs) rs
 	weightedRefCount rci (TupleSelect tuple_symbol arg_nr expr) rs
 		= weightedRefCount rci expr rs
+	weightedRefCount rci (MatchExpr constructor expr) rs
+		= weightedRefCount rci expr rs
+	weightedRefCount rci (IsConstructor expr _ _ _ _ _) rs
+		= weightedRefCount rci expr rs
 	weightedRefCount rci (AnyCodeExpr _ _ _) rs
 		= rs
 	weightedRefCount rci (ABCCodeExpr _ _) rs
@@ -308,10 +308,8 @@ weightedRefCountOfCase rci=:{rci_depth} this_case=:{case_expr, case_guards, case
 				check_symbol {cii_main_dcl_module_n, cii_common_defs} {glob_module, glob_object={ds_index}} collected_imports var_heap
 					| glob_module <> cii_main_dcl_module_n
 						# {cons_type_ptr} = cii_common_defs.[glob_module].com_cons_defs.[ds_index]
-						  (collected_imports, var_heap) = checkImportedSymbol (SK_Constructor {glob_module = glob_module, glob_object = ds_index})
-								cons_type_ptr (collected_imports, var_heap)
-						= (collected_imports, var_heap)
-					// otherwise
+						= checkImportedSymbol (SK_Constructor {glob_module = glob_module, glob_object = ds_index})
+												cons_type_ptr (collected_imports, var_heap)
 						= (collected_imports, var_heap)
 
 	 	weighted_ref_count_of_decons_expr rci (OverloadedListPatterns _ decons_exp _) rs
@@ -380,6 +378,7 @@ checkImportOfDclFunction {cii_main_dcl_module_n, cii_dcl_functions} mod_index fu
 		= { rs & rcs_imports = rcs_imports, rcs_var_heap = rcs_var_heap }
 	// otherwise
 		= rs
+
 checkRecordSelector {cii_main_dcl_module_n, cii_common_defs} {glob_module, glob_object={ds_index}} rs=:{rcs_imports,rcs_var_heap}
 	| glob_module <> cii_main_dcl_module_n
 		# {com_selector_defs,com_cons_defs,com_type_defs} = cii_common_defs.[glob_module]
@@ -495,9 +494,6 @@ where
 		= (fun_expr @ exprs, ds)
 	distributeLets di expr=:(BasicExpr _) ds
 		= (expr, ds)
-	distributeLets di (MatchExpr constructor expr) ds
-		# (expr, ds) = distributeLets di expr ds
-		= (MatchExpr constructor expr, ds)
 	distributeLets di (Selection opt_tuple expr selectors) ds
 		# (expr, ds) = distributeLets di expr ds
 		# (selectors, ds) = distributeLets di selectors ds
@@ -528,7 +524,7 @@ where
 		// otherwise
 		    = case let_expr of
 		    	Let inner_let=:{let_info_ptr=inner_let_info_ptr}
-		    		# (EI_LetType strict_inner_types, ds_expr_heap) = readPtr inner_let_info_ptr ds.ds_expr_heap
+					# (EI_LetType strict_inner_types, ds_expr_heap) = readPtr inner_let_info_ptr ds.ds_expr_heap
 					# (inner_let_info_ptr, ds_expr_heap)
 						=	newPtr (EI_LetType ((take nr_of_strict_lets let_type)++strict_inner_types)) ds_expr_heap
 					-> (Let { inner_let & let_strict_binds = let_strict_binds++inner_let.let_strict_binds,
@@ -558,6 +554,12 @@ where
 				= distributeLetsInLetExpression di fv_info_ptr lei { ds & ds_var_heap = ds_var_heap }
 				= { ds & ds_var_heap = ds_var_heap }
 
+	distributeLets di (MatchExpr constructor expr) ds
+		# (expr, ds) = distributeLets di expr ds
+		= (MatchExpr constructor expr, ds)
+	distributeLets di (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) ds
+		# (expr, ds) = distributeLets di expr ds
+		= (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position, ds)
 	distributeLets _ expr=:(TypeCodeExpression _) ds
 		= (expr, ds)
 	distributeLets _ (AnyCodeExpr in_params out_params code_expr) ds=:{ds_var_heap}
@@ -589,11 +591,10 @@ where
 		  		rcc_default_variables = ref_counts_in_default,
 		  		rcc_pattern_variables = ref_counts_in_patterns }) = case_old_info
 		  new_depth = di_depth + 1
-		  new_di
-		  	=	{	di
-		  		&	di_depth = new_depth
-		  		,	di_explicit_case_depth = if case_explicit new_depth di_explicit_case_depth
-		  		}
+		  new_di =	{	di
+					&	di_depth = new_depth
+					,	di_explicit_case_depth = if case_explicit new_depth di_explicit_case_depth
+					}
 		  (local_lets, ds_var_heap) = mark_local_let_vars new_depth tot_ref_counts ds_var_heap
 										  	// -*-> ("ref_counts", case_expr, tot_ref_counts, ref_counts_in_patterns)
 		  	with
@@ -1075,17 +1076,11 @@ nextAlts si=:{si_next_alt=Yes next_alt, si_force_next_alt} kees=:{case_info_ptr,
 		=	findSplitCases {si & si_force_next_alt=jumps} case_default ss
 	| jumps && not (hasOption case_default)
 		// update the info for this case
-		# ss_expr_heap
-			=	ss.ss_expr_heap <:= (case_info_ptr,
-	  	  			EI_CaseTypeAndSplits type {splits & sic_next_alt = Yes next_alt})
+		# ss_expr_heap = ss.ss_expr_heap <:= (case_info_ptr, EI_CaseTypeAndSplits type {splits & sic_next_alt = Yes next_alt})
 		// update the info for the outer case
-		# (EI_CaseTypeAndSplits type splits, ss_expr_heap)
-			=	readPtr next_alt.na_case ss_expr_heap
-		  split
-		  	=	{sc_alt_nr = next_alt.na_alt_nr, sc_call = No}
-	  	  ss_expr_heap
-	  	  	=	ss_expr_heap <:= (next_alt.na_case,
-	  	  			EI_CaseTypeAndSplits type {splits & sic_splits = [split : splits.sic_splits]})
+		# (EI_CaseTypeAndSplits type splits, ss_expr_heap) = readPtr next_alt.na_case ss_expr_heap
+		  split = {sc_alt_nr = next_alt.na_alt_nr, sc_call = No}
+	  	  ss_expr_heap = ss_expr_heap <:= (next_alt.na_case, EI_CaseTypeAndSplits type {splits & sic_splits = [split : splits.sic_splits]})
 		=	{ss & ss_expr_heap = ss_expr_heap}
 		=	ss
 	where
@@ -1111,10 +1106,7 @@ newFunctionWithType :: !(Optional Ident) !FunctionBody ![FreeVar] !SymbolType !I
 newFunctionWithType opt_id fun_bodies local_vars fun_type group_index (cs_next_fun_nr, cs_new_functions, cs_fun_heap)
 	# (fun_def_ptr, cs_fun_heap) = newPtr FI_Empty cs_fun_heap
 	  fun_id = getIdent opt_id cs_next_fun_nr
-
-	  arity
-	  	=	fun_type.st_arity
-
+	  arity = fun_type.st_arity
 	  fun_def = 
 			{	fun_ident		= fun_id
 			,	fun_arity		= arity
@@ -1367,25 +1359,20 @@ instance split SplitCase where
 			=	splitIt sc_alt_nr kees
 		# (case_type1, case_type2)
 			=	splitIt sc_alt_nr case_type
-
 		# case_type_and_splits2
 			=	EI_CaseTypeAndSplits case_type2 {sic_splits = [], sic_next_alt = No, sic_case_kind = CaseKindUnknown}
 		# (case_info_ptr2, cs_expr_heap)
 			=	newPtr case_type_and_splits2 cs_expr_heap
-		# kees2
-			=	{kees2 & case_info_ptr = case_info_ptr2}
 
+		# kees2 = {kees2 & case_info_ptr = case_info_ptr2}
 		# (call, cs)
 			=	convertNonRootCase ci kees2 {cs & cs_expr_heap = cs_expr_heap}
-		# kees1
-			=	{kees1 & case_default = Yes call}
-
+		# kees1 = {kees1 & case_default = Yes call}
 		# (EI_CaseTypeAndSplits _ splits1, cs_expr_heap)
 			=	readPtr kees.case_info_ptr cs.cs_expr_heap
 		# case_type_and_splits1
 			=	EI_CaseTypeAndSplits case_type1 {splits1 & sic_splits = [{split & sc_call = Yes call} : splits1.sic_splits]}
-		# cs_expr_heap
-	  	  	=	cs_expr_heap <:= (kees.case_info_ptr, case_type_and_splits1)
+		# cs_expr_heap = cs_expr_heap <:= (kees.case_info_ptr, case_type_and_splits1)
 		=	(kees1, case_type1, {cs & cs_expr_heap = cs_expr_heap})
 
 class splitIt a :: CaseAltNr a -> (a, a)
@@ -1482,8 +1469,6 @@ convertRootCasesCasePatterns ci (BasicPatterns bt patterns) _ cs
 		=	convertRootCases ci patterns cs
 	=	(BasicPatterns bt patterns, cs)
 convertRootCasesCasePatterns ci (AlgebraicPatterns gi patterns) arg_types cs
-	| length patterns <> length arg_types
-		=	abort ("convertRootCasesCasePatterns error number of cases " +++ toString (length patterns) +++ " <> " +++ toString (length arg_types)) <<- arg_types
 	# (patterns, cs)
 		=	convertRootCasesAlgebraicPatterns ci (exactZip patterns arg_types) cs
 	=	(AlgebraicPatterns gi patterns, cs)
@@ -1519,7 +1504,7 @@ instance convertRootCases BasicPattern where
 			=	convertRootCases ci bp_expr cs
 		=	({pattern & bp_expr=bp_expr}, cs)
 
-class convertCases a :: !ConvertInfo !a  !*ConvertState -> (!a, !*ConvertState)
+class convertCases a :: !ConvertInfo !a !*ConvertState -> (!a, !*ConvertState)
 
 instance convertCases [a] | convertCases a
 where
@@ -1566,9 +1551,6 @@ where
 	convertCases ci (Let lad) cs
 		# (lad, cs) = convertCases ci lad cs
 		= (Let lad, cs)
-	convertCases ci (MatchExpr constructor expr) cs
-		# (expr, cs) = convertCases ci expr cs
-		= (MatchExpr constructor expr, cs)
 	convertCases ci (Selection is_unique expr selectors) cs
 		# (expr, cs) = convertCases ci expr cs
 		  (selectors, cs) = convertCases ci selectors cs
@@ -1592,6 +1574,68 @@ where
 		  				{ss_var_heap=cs.cs_var_heap,ss_expr_heap = cs.cs_expr_heap}
 		  cs = {cs & cs_var_heap=ss_var_heap, cs_expr_heap = ss_expr_heap}
 		= convertNonRootCase ci case_expr cs
+	convertCases ci (MatchExpr constructor expr) cs
+		# (expr, cs) = convertCases ci expr cs
+		= (MatchExpr constructor expr, cs)
+	convertCases ci=:{ci_common_defs} is_cons_expr=:(IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) cs
+		# (expr, cs=:{cs_var_heap,cs_expr_heap}) = convertCases ci expr cs
+
+		  (new_info_ptr, cs_var_heap) = newPtr VI_LocalVar cs_var_heap
+		  var_id = {id_name = "_x", id_info = nilPtr}
+		  case_var = Var {var_ident = var_id, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr}
+		  case_free_var = {	fv_def_level = NotALevel, fv_ident = var_id, fv_info_ptr = new_info_ptr, fv_count = 0}
+
+		  fail_expr = BasicExpr (BVB False)
+		  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]
+		  (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}
+		  cs & cs_var_heap=cs_var_heap, cs_expr_heap=cs_expr_heap
+
+		  bool_type = {at_attribute = TA_None, at_type = TB BT_Bool}
+
+		  algebraic_type = new_vars_in_algebraic_type ci_common_defs.[cons_symbol.glob_module].com_cons_defs.[cons_symbol.glob_object.ds_index].cons_type.st_result
+
+		  (fun_ident,cs) = new_case_function (Yes case_ident) bool_type case_expr [(case_free_var,algebraic_type)] [] ci.ci_group_index cs
+		= (App {app_symb=fun_ident, app_args=[expr], app_info_ptr=nilPtr}, cs)
+	where
+		make_free_vars :: !Int !*VarHeap -> (![FreeVar],!*VarHeap)
+		make_free_vars n_args var_heap
+			| n_args>0
+				# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
+				  (free_vars,var_heap) = make_free_vars (n_args-1) var_heap
+				= ([{fv_ident = {id_name = "_x", id_info = nilPtr}, fv_info_ptr = new_info_ptr, fv_def_level = NotALevel, fv_count = 0} : free_vars], var_heap)
+				= ([],var_heap)
+
+		new_vars_in_algebraic_type {at_attribute,at_type=TV tv}
+			| no_attribute_var at_attribute
+				= {at_attribute=at_attribute, at_type=TV {tv & tv_info_ptr=nilPtr}}
+				= {at_attribute=new_vars_in_attribute_var at_attribute, at_type=TV {tv & tv_info_ptr=nilPtr}}
+		new_vars_in_algebraic_type {at_attribute,at_type=TA type_symbol type_args}
+			# type_args = new_vars_in_algebraic_type_args type_args
+			| no_attribute_var at_attribute
+				= {at_attribute=at_attribute, at_type=TA type_symbol type_args}
+				= {at_attribute=new_vars_in_attribute_var at_attribute, at_type=TA type_symbol type_args}
+
+		no_attribute_var TA_Unique = True
+		no_attribute_var TA_None = True
+		no_attribute_var TA_Multi = True
+		no_attribute_var TA_Anonymous = True
+		no_attribute_var TA_MultiOfPropagatingConsVar = True
+		no_attribute_var _ = False
+
+		new_vars_in_attribute_var (TA_Var attr_var)
+			= TA_Anonymous
+		new_vars_in_attribute_var (TA_RootVar attr_var)
+			= TA_Anonymous
+
+		new_vars_in_algebraic_type_args [type_arg:type_args]
+			= [new_vars_in_algebraic_type type_arg:new_vars_in_algebraic_type_args type_args]
+		new_vars_in_algebraic_type_args []
+			= []
 	convertCases ci (FailExpr ident) cs
 		# (failExpr, cs)
 			=	convertNonRootFail ci ident cs
@@ -1617,7 +1661,7 @@ convertNonRootFail ci=:{ci_group_index, ci_common_defs} ident cs
 			,	at_type = TV {tv_ident = { id_name = "a", id_info = nilPtr }, tv_info_ptr = nilPtr}
 			}
 	# (fun_ident, cs)
-	  	=	new_case_function (Yes ident) result_type (FailExpr ident) [] [] ci_group_index ci_common_defs cs
+	  	=	new_case_function (Yes ident) result_type (FailExpr ident) [] [] ci_group_index cs
 	= (App { app_symb = fun_ident, app_args = [], app_info_ptr = nilPtr }, cs)
 
 convertNonRootCase ci=:{ci_bound_vars, ci_group_index, ci_common_defs} kees=:{ case_expr, case_ident, case_info_ptr} cs
@@ -1700,12 +1744,14 @@ where
 	case_is_degenerate _
 		=	(False, undef)
 
+	copy_case_expr :: [(FreeVar,AType)] Expression *VarHeap -> ([Expression],[(FreeVar,AType)],[FreeVar],Expression,[VarInfo],*VarHeap)
 	copy_case_expr bound_vars guards_and_default var_heap
 	    # (old_fv_info_ptr_values,var_heap) = store_VI_BoundVar_in_bound_vars_and_save_old_values bound_vars [] var_heap
 		  (expr, {cp_free_vars, cp_var_heap, cp_local_vars}) = copy guards_and_default { cp_free_vars = [], cp_var_heap = var_heap, cp_local_vars = [] }
 		  (bound_vars, free_typed_vars, var_heap) = retrieve_variables cp_free_vars cp_var_heap
 		= (bound_vars, free_typed_vars, cp_local_vars, expr, old_fv_info_ptr_values,var_heap)
 	
+	copy_case_expr_and_use_new_var :: [(FreeVar,AType)] BoundVar VarInfoPtr Expression *VarHeap -> (Bool,[Expression],[(FreeVar,AType)],[FreeVar],Expression,[VarInfo],*VarHeap)
 	copy_case_expr_and_use_new_var bound_vars {var_ident,var_info_ptr} new_info_ptr guards_and_default var_heap
 	    # (old_fv_info_ptr_values,var_heap) = store_VI_BoundVar_in_bound_vars_and_save_old_values bound_vars [] var_heap
 		# (var_info, var_heap) = readPtr var_info_ptr var_heap
@@ -1738,7 +1784,7 @@ where
 
 new_case_function_and_restore_old_fv_info_ptr_values opt_id result_type rhs free_vars local_vars
 	bound_vars old_fv_info_ptr_values group_index common_defs cs
-	# (fun_ident,cs) = new_case_function opt_id result_type rhs free_vars local_vars group_index common_defs cs
+	# (fun_ident,cs) = new_case_function opt_id result_type rhs free_vars local_vars group_index cs
 	# cs_var_heap=restore_old_fv_info_ptr_values old_fv_info_ptr_values bound_vars cs.cs_var_heap
 	= (fun_ident,{ cs & cs_var_heap = cs_var_heap});
 
@@ -1748,12 +1794,12 @@ restore_old_fv_info_ptr_values [old_fv_info_ptr_value:old_fv_info_ptr_values] [(
 restore_old_fv_info_ptr_values [] bound_vars var_heap
 	= var_heap
 
-new_case_function opt_id result_type rhs free_vars local_vars group_index common_defs cs=:{cs_expr_heap}
+new_case_function opt_id result_type rhs free_vars local_vars group_index cs=:{cs_expr_heap}
 	# body = TransformedBody {tb_args=[var \\ (var, _) <- free_vars], tb_rhs=rhs}
 	  (_,type)
 		=	removeAnnotations
 			{	st_vars			= []
-			,	st_args			= [ type \\ (_, type) <- free_vars]
+			,	st_args			= [type \\ (_, type) <- free_vars]
 			,	st_args_strictness=NotStrict
 			,	st_arity		= length free_vars
 			,	st_result		= result_type
@@ -1761,8 +1807,6 @@ new_case_function opt_id result_type rhs free_vars local_vars group_index common
 			,	st_attr_vars	= []
 			,	st_attr_env		= []
 			}
-//	  (body, cs)
-//	  	=	convertCasesInBody body (Yes type) group_index common_defs cs
 	# (fun_ident,  (cs_next_fun_nr, cs_new_functions, cs_fun_heap))
 			= newFunctionWithType opt_id body local_vars type group_index
 					(cs.cs_next_fun_nr, cs.cs_new_functions, cs.cs_fun_heap)
@@ -1832,9 +1876,6 @@ where
 		= (Conditional cond, cp_info)
 	copy expr=:(BasicExpr _) cp_info
 		= (expr, cp_info)
-	copy (MatchExpr constructor expr) cp_info
-		# (expr, cp_info) = copy expr cp_info
-		= (MatchExpr constructor expr, cp_info)
 	copy (Selection is_unique expr selectors) cp_info
 		# (expr, cp_info) = copy expr cp_info
 		  (selectors, cp_info) = copy selectors cp_info
@@ -1851,6 +1892,12 @@ where
 	copy (TupleSelect tuple_symbol arg_nr expr) cp_info
 		# (expr, cp_info) = copy expr cp_info
 		= (TupleSelect tuple_symbol arg_nr expr, cp_info)
+	copy (MatchExpr constructor expr) cp_info
+		# (expr, cp_info) = copy expr cp_info
+		= (MatchExpr constructor expr, cp_info)
+	copy (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) cp_info
+		# (expr, cp_info) = copy expr cp_info
+		= ((IsConstructor expr cons_symbol cons_arity global_type_index case_ident position), cp_info)
 	copy fail=:(FailExpr _) cp_info
 		= (fail, cp_info)
 	copy EE cp_info
@@ -1962,7 +2009,6 @@ where
 
 (-*->) infixl
 (-*->) a b :== a // ---> b
-//import RWSDebug
 (->>) infixl
 (->>) a b :== a // ---> b
 (<<-) infixl
diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl
index 9f07158..d405ccd 100644
--- a/frontend/explicitimports.icl
+++ b/frontend/explicitimports.icl
@@ -661,20 +661,23 @@ instance check_completeness Expression where
 		= ccs
 	check_completeness (ABCCodeExpr _ _) _ ccs
 		= ccs
+	check_completeness (Update expr1 selections expr2) cci ccs
+		= ( (check_completeness expr1 cci)
+		  o (check_completeness selections cci)
+		  o (check_completeness expr2) cci
+		  ) ccs
 	check_completeness (MatchExpr {glob_module,glob_object={ds_ident,ds_index}} expression) cci ccs
 		= check_completeness expression cci
 		  (check_whether_ident_is_imported ds_ident glob_module ds_index STE_Constructor cci ccs)
+	check_completeness (IsConstructor expr {glob_module,glob_object={ds_ident,ds_index}} _ _ _ _) cci ccs
+		= check_completeness expr cci
+		  (check_whether_ident_is_imported ds_ident glob_module ds_index STE_Constructor cci ccs)
 	check_completeness (FreeVar _) _ ccs
 		= ccs
 	check_completeness (DynamicExpr dynamicExpr) cci ccs
 		= check_completeness dynamicExpr cci ccs
 	check_completeness EE _ ccs
 		= ccs
-	check_completeness (Update expr1 selections expr2) cci ccs
-		= ( (check_completeness expr1 cci)
-		  o (check_completeness selections cci)
-		  o (check_completeness expr2) cci
-		  ) ccs
 	check_completeness expr _ _
 		= abort "explicitimports:check_completeness (Expression) does not match" //<<- expr
 
diff --git a/frontend/generics1.icl b/frontend/generics1.icl
index 5730220..9292e0a 100644
--- a/frontend/generics1.icl
+++ b/frontend/generics1.icl
@@ -1272,7 +1272,7 @@ where
 		#! gencase = {gencase & gc_kind = kind}
 
 		#! type_index = index_OBJECT_CONS_FIELD_type gencase.gc_type gs.gs_predefs
-		| type_index>=0		
+		| type_index>=0
 			# ({gc_body = GCB_FunIndex fun_index}) = gencase
 			  gen_info_ptr = gen_def.gen_info_ptr
 
@@ -3820,7 +3820,6 @@ where
 curryGenericArgType :: !SymbolType !String !*TypeHeaps 
 	-> (!SymbolType, !*TypeHeaps)
 curryGenericArgType  st=:{st_args, st_result, st_attr_env, st_attr_vars} attr_var_name th=:{th_attrs}
-		
 	#! (atype, attr_env, attr_vars, attr_store, th_attrs) 
 		= buildCurriedType st_args st_result TA_Multi st_attr_env st_attr_vars attr_var_name 1 th_attrs
 
@@ -4414,7 +4413,10 @@ foldExpr f expr=:(Conditional {if_cond,if_then,if_else}) st
 	# st = foldExpr f if_then st	
 	# st = foldOptional (foldExpr f) if_else st	
 	= st
-foldExpr f expr=:(MatchExpr _ expr1) st 
+foldExpr f expr=:(MatchExpr _ expr1) st
+	# st = f expr st
+	= foldExpr f expr1 st
+foldExpr f expr=:(IsConstructor expr1 _ _ _ _ _) st 
 	# st = f expr st
 	= foldExpr f expr1 st
 foldExpr f expr=:(DynamicExpr {dyn_expr}) st 
@@ -4543,7 +4545,7 @@ zipWith f _ _ = abort "zipWith: lists of different length\n"
 zipWithSt f l1 l2 st
 	:== zipWithSt l1 l2 st
 where
-	zipWithSt [] [] st 
+	zipWithSt [] [] st
 		= ([], st)
 	zipWithSt [x:xs] [y:ys] st
 		# (z, st) = f x y st
diff --git a/frontend/overloading.icl b/frontend/overloading.icl
index ed3e286..03419a1 100644
--- a/frontend/overloading.icl
+++ b/frontend/overloading.icl
@@ -1515,15 +1515,18 @@ where
 		  (EI_TypeOfDynamic type_code, ui_symbol_heap) = readPtr dyn_info_ptr ui.ui_symbol_heap
 		  ui = { ui & ui_symbol_heap = ui_symbol_heap }
 		= (DynamicExpr { dyn & dyn_expr = dyn_expr, dyn_type_code = type_code }, ui)
+	updateExpression group_index (TupleSelect symbol argn_nr expr) ui
+		# (expr, ui) = updateExpression group_index expr ui
+		= (TupleSelect symbol argn_nr expr, ui)
 	updateExpression group_index (MatchExpr cons_symbol=:{glob_object={ds_arity}} expr) ui
 		| ds_arity <> -2
 			# (expr, ui) = updateExpression group_index expr ui
 			= (MatchExpr cons_symbol expr, ui)
 			// newtype constructor
 			= updateExpression group_index expr ui
-	updateExpression group_index (TupleSelect symbol argn_nr expr) ui
+	updateExpression group_index (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) ui
 		# (expr, ui) = updateExpression group_index expr ui
-		= (TupleSelect symbol argn_nr expr, ui)
+		= (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position, ui)
 	updateExpression group_index (TypeSignature _ expr) ui
 		= updateExpression group_index expr ui
 	updateExpression group_index expr=:(Var {var_info_ptr}) ui
diff --git a/frontend/parse.icl b/frontend/parse.icl
index b34ef74..721a66a 100644
--- a/frontend/parse.icl
+++ b/frontend/parse.icl
@@ -2734,6 +2734,15 @@ wantExpression pState
 		_
 			->	wantExpressionT token pState
 
+wantPatternWithoutDefinitions :: !ParseState -> (!ParsedExpr, !ParseState)
+wantPatternWithoutDefinitions pState
+	# (token, pState) = nextToken FunctionContext pState
+	= case token of
+		CharListToken charList // To produce a better error message
+			->	charListError charList pState
+		_
+			->	wantPatternWithoutDefinitionsT token pState
+
 charListError charList pState
 	= (PE_Empty,  parseError "Expression" No ("List brackets, [ and ], around charlist '"+charList+"'") pState)
 
@@ -2801,6 +2810,14 @@ where
 			= (combineExpressions expr exprs, pState)
 			= (PE_Empty,  parseError "LHS expression" (Yes token) "<expression>" pState)
 
+wantPatternWithoutDefinitionsT  :: !Token !ParseState -> (!ParsedExpr, !ParseState)
+wantPatternWithoutDefinitionsT token pState
+	# (succ, expr, pState) = trySimplePatternWithoutDefinitionsT token pState
+	| succ
+		# (exprs, pState) = parseList trySimplePatternWithoutDefinitions pState
+		= (combineExpressions expr exprs, pState)
+		= (PE_Empty,  parseError "pattern" (Yes token) "<pattern>" pState)
+
 combineExpressions expr []
 	= expr
 combineExpressions expr exprs
@@ -2816,6 +2833,11 @@ trySimplePattern pState
 	# (token, pState) = nextToken FunctionContext pState
 	= trySimplePatternT token pState
 
+trySimplePatternWithoutDefinitions :: !ParseState -> (!Bool, !ParsedExpr, !ParseState)
+trySimplePatternWithoutDefinitions pState
+	# (token, pState) = nextToken FunctionContext pState
+	= trySimplePatternWithoutDefinitionsT token pState
+
 tryExtendedSimpleExpression :: !ParseState -> (!Bool, !ParsedExpr, !ParseState)
 tryExtendedSimpleExpression pState
 	# (token, pState) = nextToken FunctionContext pState
@@ -2832,30 +2854,75 @@ where
 	extend_expr_with_selectors :: !ParsedExpr !ParseState -> (!ParsedExpr, !ParseState)
 	extend_expr_with_selectors exp pState 
    		# (token, pState) = nextToken FunctionContext pState
-		| token == DotToken
-			# (token, pState) = nextToken FunctionContext pState
-			  (selectors, pState) = wantSelectors token pState
-			= (PE_Selection ParsedNormalSelector exp selectors, pState)
-		| token == ExclamationToken
-			# (token, pState) = nextToken FunctionContext pState
+		= case token of
+			DotToken
+				# (token, pState) = nextToken FunctionContext pState
+				  (selectors, token, pState) = wantSelectors token pState
+				  exp = PE_Selection ParsedNormalSelector exp selectors
+				-> case token of
+					DefinesColonToken
+						-> parse_matches_expression exp pState
+					_
+						-> (exp, tokenBack pState)
+			ExclamationToken
+				# (token, pState) = nextToken FunctionContext pState
 // JVG added for strict lists:
-			| token==SquareCloseToken
-				= (exp, tokenBack (tokenBack pState))
+				| token==SquareCloseToken
+					-> (exp, tokenBack (tokenBack pState))
 //			
-			#  (selectors, pState) = wantSelectors token pState
-			= (PE_Selection (ParsedUniqueSelector False) exp selectors, pState)
-		| otherwise
-			= (exp, tokenBack pState)
+				# (selectors, token, pState) = wantSelectors token pState
+				  exp = PE_Selection (ParsedUniqueSelector False) exp selectors
+				-> case token of
+					DefinesColonToken
+						-> parse_matches_expression exp pState
+					_
+						-> (exp, tokenBack pState)
+			DefinesColonToken
+				-> parse_matches_expression exp pState
+			_
+				-> (exp, tokenBack pState)
 
-wantSelectors :: Token *ParseState -> *(![ParsedSelection], !*ParseState)
+	parse_matches_expression exp pState
+		# (token, pState) = nextToken FunctionContext pState
+		= case token of
+			IdentToken name
+				| not (isLowerCaseName name)
+					# (id, pState) = stringToIdent name IC_Expression pState
+					  (pattern_args,pState) = parse_wild_cards pState
+					  pattern = if (isEmpty pattern_args) (PE_Ident id) (PE_List [PE_Ident id:pattern_args])
+					-> matches_expression exp pattern pState
+			// to do: qualified ident
+			_
+				# (succ, pattern, pState) = trySimplePatternWithoutDefinitionsT token pState
+				| succ
+					-> matches_expression exp pattern pState
+					# pState = parseError "pattern" (Yes token) "<pattern>" pState
+					-> matches_expression exp PE_Empty pState
+
+	parse_wild_cards pState
+	 	# (token, pState) = nextToken FunctionContext pState
+	 	= case token of
+	 		WildCardToken
+				# (pattern_args,pState) = parse_wild_cards pState
+	 			-> ([PE_WildCard:pattern_args],pState)
+	 		_
+	 			-> ([],tokenBack pState);
+
+	matches_expression exp pattern pState
+		# (case_ident, pState) = internalIdent "_c" pState
+		  (fname,linenr,pState) = getFileAndLineNr pState
+		  position = LinePos fname linenr
+		= (PE_Matches case_ident exp pattern position, pState)
+
+wantSelectors :: Token *ParseState -> *(![ParsedSelection], !Token, !*ParseState)
 wantSelectors token pState
 	# (selector, pState) = want_selector token pState
 	  (token, pState) = nextToken FunctionContext pState
 	| token == DotToken
 		# (token, pState) = nextToken FunctionContext pState
-		  (selectors, pState) = wantSelectors token pState
-		= (selector ++ selectors, pState)
-		= (selector, tokenBack pState)
+		  (selectors, token, pState) = wantSelectors token pState
+		= (selector ++ selectors, token, pState)
+		= (selector, token, pState)
 where
 	want_selector :: !Token !*ParseState -> *(![ParsedSelection], !*ParseState)
 	want_selector SquareOpenToken pState
@@ -2960,6 +3027,57 @@ trySimplePatternT WildCardToken pState
 trySimplePatternT token pState
 	= (False, PE_Empty, tokenBack pState)
 
+trySimplePatternWithoutDefinitionsT :: !Token !ParseState -> (!Bool, !ParsedExpr, !ParseState)
+trySimplePatternWithoutDefinitionsT (IdentToken name) pState
+	| not (isLowerCaseName name)
+		# (id, pState) = stringToIdent name IC_Expression pState
+		= (True, PE_Ident id, pState)
+trySimplePatternWithoutDefinitionsT SquareOpenToken pState
+	# (list_expr, pState) = wantListPatternWithoutDefinitions pState
+	= (True, list_expr, pState)
+trySimplePatternWithoutDefinitionsT OpenToken pState
+	# (args=:[exp:exps], pState) = want_pattern_list pState
+	  pState = wantToken FunctionContext "pattern list" CloseToken pState
+	| isEmpty exps
+		= case exp of
+			PE_Ident id
+				-> (True, PE_List [exp], pState)
+			_
+				-> (True, exp, pState)
+		= (True, PE_Tuple args, pState)
+where
+	want_pattern_list pState
+		# (expr, pState) = wantPatternWithoutDefinitions pState
+		  (token, pState) = nextToken FunctionContext pState
+		| token == CommaToken
+			# (exprs, pState) = want_pattern_list pState
+			= ([expr : exprs], pState)
+			= ([expr], tokenBack pState)
+trySimplePatternWithoutDefinitionsT CurlyOpenToken pState
+	# (rec_or_aray_exp, pState) = wantRecordPatternWithoutDefinitions pState 
+	= (True, rec_or_aray_exp, pState)
+trySimplePatternWithoutDefinitionsT (IntToken int_string) pState
+	# (ok,int) = string_to_int int_string
+	| ok
+		= (True, PE_Basic (BVInt int), pState)
+		= (True, PE_Basic (BVI int_string), pState)
+trySimplePatternWithoutDefinitionsT (StringToken string) pState
+	= (True, PE_Basic (BVS string), pState)
+trySimplePatternWithoutDefinitionsT (BoolToken bool) pState
+	= (True, PE_Basic (BVB bool), pState)
+trySimplePatternWithoutDefinitionsT (CharToken char) pState
+	= (True, PE_Basic (BVC char), pState)
+trySimplePatternWithoutDefinitionsT (RealToken real) pState
+	= (True, PE_Basic (BVR real), pState)
+trySimplePatternWithoutDefinitionsT (QualifiedIdentToken module_name ident_name) pState
+	| not (isLowerCaseName ident_name)
+		# (module_id, pState) = stringToQualifiedModuleIdent module_name ident_name IC_Expression pState
+		= (True, PE_QualifiedIdent module_id ident_name, pState)
+trySimplePatternWithoutDefinitionsT WildCardToken pState
+	= (True, PE_WildCard, pState)
+trySimplePatternWithoutDefinitionsT token pState
+	= (False, PE_Empty, tokenBack pState)
+
 trySimpleExpressionT :: !Token !ParseState -> (!Bool, !ParsedExpr, !ParseState)
 trySimpleExpressionT (IdentToken name) pState
 	# (id, pState) = stringToIdent name IC_Expression pState
@@ -3081,27 +3199,109 @@ where
 trySimpleNonLhsExpressionT token pState
 	= (False, PE_Empty, tokenBack pState)
 
+wantListPatternWithoutDefinitions :: !ParseState -> (ParsedExpr, !ParseState)
+wantListPatternWithoutDefinitions pState
+	# pState=appScanState setNoNewOffsideForSeqLetBit pState
+	# (token, pState) = nextToken FunctionContext pState
+	# pState=appScanState clearNoNewOffsideForSeqLetBit pState	
+	# (head_strictness,token,pState) = want_head_strictness token pState
+	| token==ExclamationToken && (head_strictness<>HeadOverloaded && head_strictness<>HeadUnboxedAndTailStrict)
+		# (token, pState) = nextToken FunctionContext pState
+		| token==SquareCloseToken
+			= (makeTailStrictNilExpression head_strictness cIsAPattern,pState)
+			= (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState)
+	| token==SquareCloseToken
+		| head_strictness==HeadUnboxedAndTailStrict
+			= (makeTailStrictNilExpression HeadUnboxed cIsAPattern,pState)
+		| head_strictness==HeadStrict
+			# (tail_strict,pState) = is_tail_strict_list_or_nil pState
+			| tail_strict
+				= (makeTailStrictNilExpression HeadLazy cIsAPattern,pState)
+				= (makeNilExpression head_strictness cIsAPattern,pState)
+			= (makeNilExpression head_strictness cIsAPattern,pState)
+	| head_strictness==HeadUnboxedAndTailStrict
+		= (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState)
+	| head_strictness==HeadLazy && (case token of (IdentToken "!!") -> True; _ -> False)
+		# (next_token,pState) = nextToken FunctionContext pState
+		| next_token==SquareCloseToken
+			= (makeTailStrictNilExpression HeadStrict cIsAPattern,pState)
+			= want_LGraphExpr token [] head_strictness (tokenBack pState)
+		= want_LGraphExpr token [] head_strictness pState
+	where
+		want_LGraphExpr token acc head_strictness pState
+			= case token of
+				CharListToken chars
+					->	want_list (add_chars (fromString chars) acc) pState
+				_	#	(exp, pState) = wantPatternWithoutDefinitionsT token pState
+					->	want_list [exp: acc] pState
+		where
+			want_list acc pState
+				# (token, pState) = nextToken FunctionContext pState
+				= case token of
+					SquareCloseToken
+						#	nil_expr = makeNilExpression head_strictness cIsAPattern
+						->	(gen_pattern_cons_nodes acc nil_expr head_strictness,pState)
+					ExclamationToken
+						| head_strictness<>HeadOverloaded
+							# (token, pState) = nextToken FunctionContext pState
+							| token==SquareCloseToken
+								# nil_expr = makeTailStrictNilExpression head_strictness cIsAPattern
+								->	(gen_pattern_tail_strict_cons_nodes acc nil_expr head_strictness,pState)
+								-> (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState)
+					CommaToken
+						#	(token, pState)	= nextToken FunctionContext pState
+						->	want_LGraphExpr token acc head_strictness pState
+					ColonToken
+						# (exp, pState)		= wantPatternWithoutDefinitions pState
+						# (token,pState)	= nextToken FunctionContext pState
+						| token==SquareCloseToken
+							-> (gen_pattern_cons_nodes acc exp head_strictness,pState)
+						| token==ExclamationToken && head_strictness<>HeadOverloaded
+							# pState = wantToken FunctionContext "list" SquareCloseToken pState
+							-> (gen_pattern_tail_strict_cons_nodes acc exp head_strictness,pState)
+						| token==ColonToken // to allow [1:2:[]] etc.
+							-> want_list [exp:acc] (tokenBack pState)
+							# pState = parseError "list" (Yes token) "] or :" pState
+							-> (gen_pattern_cons_nodes acc exp head_strictness,pState)
+					DotDotToken
+						->	(PE_Empty, parseError "want list expression" No "No dot dot expression in a pattern" pState)
+					DoubleBackSlashToken
+						->	(PE_Empty, parseError "want list expression" No "No \\\\ expression in a pattern" pState)
+					_
+						#	nil_expr = makeNilExpression head_strictness cIsAPattern
+							pState	= parseError "list" (Yes token) "list element separator" pState
+						->	(gen_pattern_cons_nodes acc nil_expr head_strictness,pState)
+
+gen_pattern_cons_nodes [] exp head_strictness
+	= exp
+gen_pattern_cons_nodes l exp head_strictness
+	= gen_pattern_cons_nodes l exp
+where
+	cons_ident_exp = makeConsIdentExpression head_strictness cIsAPattern
+	
+	gen_pattern_cons_nodes [e:r] exp
+		= gen_pattern_cons_nodes r (PE_List [cons_ident_exp,e,exp])
+	gen_pattern_cons_nodes [] exp
+		= exp
+
+gen_pattern_tail_strict_cons_nodes [] exp head_strictness
+	= exp
+gen_pattern_tail_strict_cons_nodes r exp head_strictness
+	= gen_pattern_tail_strict_cons_nodes r exp
+where
+	tail_strict_cons_ident_exp = makeTailStrictConsIdentExpression head_strictness cIsAPattern
+	
+	gen_pattern_tail_strict_cons_nodes [e:r] exp
+		= gen_pattern_tail_strict_cons_nodes r (PE_List [tail_strict_cons_ident_exp,e,exp])
+	gen_pattern_tail_strict_cons_nodes [] exp
+		= exp
+
 wantListExp :: !Bool !ParseState -> (ParsedExpr, !ParseState)
 wantListExp is_pattern pState
 	# pState=appScanState setNoNewOffsideForSeqLetBit pState
 	# (token, pState) = nextToken FunctionContext pState
 	# pState=appScanState clearNoNewOffsideForSeqLetBit pState	
 	# (head_strictness,token,pState) = want_head_strictness token pState
-		with
-			want_head_strictness :: Token *ParseState -> *(!Int,!Token,!*ParseState)
-			want_head_strictness ExclamationToken pState
-				# (token,pState) = nextToken FunctionContext pState
-				= (HeadStrict,token,pState)
-			want_head_strictness (SeqLetToken strict) pState
-				# (token,pState) = nextToken FunctionContext pState
-				| strict
-					= (HeadUnboxedAndTailStrict,token,pState);
-					= (HeadUnboxed,token,pState)
-			want_head_strictness BarToken pState
-				# (token,pState) = nextToken FunctionContext pState
-				= (HeadOverloaded,token,pState)
-			want_head_strictness token pState
-				= (HeadLazy,token,pState)
 	| token==ExclamationToken && (head_strictness<>HeadOverloaded && head_strictness<>HeadUnboxedAndTailStrict)
 		# (token, pState) = nextToken FunctionContext pState
 		| token==SquareCloseToken
@@ -3129,13 +3329,6 @@ wantListExp is_pattern pState
 			= case token of
 				CharListToken chars
 					->	want_list (add_chars (fromString chars) acc) pState
-					with
-						add_chars [] 			acc	= acc
-						add_chars ['\\',c1,c2,c3:r] acc
-							| c1>='0' && c1<='7'
-								= add_chars r [PE_Basic (BVC (toString ['\'','\\',c1,c2,c3,'\''])): acc]
-						add_chars ['\\',c:r] acc = add_chars r [PE_Basic (BVC (toString ['\'','\\',c,'\''])): acc]
-						add_chars [c:r] 		acc	= add_chars r [PE_Basic (BVC (toString ['\'',c,'\''])): acc]
 				_	#	(exp, pState) = (if is_pattern (wantPatternT token) (wantExpressionT token)) pState
 					->	want_list [exp: acc] pState
 		where
@@ -3273,7 +3466,7 @@ wantListExp is_pattern pState
 					= gen_cons_nodes r (PE_List [cons_ident_exp,e,exp])
 				gen_cons_nodes [] exp
 					= exp
-	
+
 			gen_tail_strict_cons_nodes [] exp
 				= exp
 			gen_tail_strict_cons_nodes r exp
@@ -3286,6 +3479,28 @@ wantListExp is_pattern pState
 				gen_tail_strict_cons_nodes [] exp
 					= exp
 
+want_head_strictness :: Token *ParseState -> *(!Int,!Token,!*ParseState)
+want_head_strictness ExclamationToken pState
+	# (token,pState) = nextToken FunctionContext pState
+	= (HeadStrict,token,pState)
+want_head_strictness (SeqLetToken strict) pState
+	# (token,pState) = nextToken FunctionContext pState
+	| strict
+		= (HeadUnboxedAndTailStrict,token,pState);
+		= (HeadUnboxed,token,pState)
+want_head_strictness BarToken pState
+	# (token,pState) = nextToken FunctionContext pState
+	= (HeadOverloaded,token,pState)
+want_head_strictness token pState
+	= (HeadLazy,token,pState)
+
+add_chars [] 			acc	= acc
+add_chars ['\\',c1,c2,c3:r] acc
+	| c1>='0' && c1<='7'
+		= add_chars r [PE_Basic (BVC (toString ['\'','\\',c1,c2,c3,'\''])): acc]
+add_chars ['\\',c:r] acc = add_chars r [PE_Basic (BVC (toString ['\'','\\',c,'\''])): acc]
+add_chars [c:r] 		acc	= add_chars r [PE_Basic (BVC (toString ['\'',c,'\''])): acc]
+
 makeNilExpression :: Int Bool -> ParsedExpr
 makeNilExpression head_strictness is_pattern
 	# pre_def_nil_index= if (head_strictness==HeadLazy)
@@ -3644,8 +3859,7 @@ where
 
 	want_update :: Token ParseState -> (NestedUpdate, ParseState)
 	want_update token pState
-		# (selectors, pState) = wantSelectors token pState
-		  (token, pState) = nextToken FunctionContext pState
+		# (selectors, token, pState) = wantSelectors token pState
 		| token == EqualToken
 			# (expr, pState) = wantExpression pState
 			= ({nu_selectors = selectors, nu_update_expr = expr}, pState)
@@ -3892,6 +4106,53 @@ where
 		  (token, pState)	= nextToken FunctionContext pState
 		= want_update type expr token pState
 
+wantRecordPatternWithoutDefinitions :: !ParseState -> (ParsedExpr, !ParseState)
+wantRecordPatternWithoutDefinitions pState
+	# (token, pState) = nextToken FunctionContext pState
+	| token == CurlyCloseToken
+		= (PE_Empty, parseError "record pattern" No "Array denotation not" pState)
+		= want_record_pattern_without_definitions token pState
+where
+	want_record_pattern_without_definitions (IdentToken name) pState
+		| isUpperCaseName name
+			# pState = wantToken FunctionContext "record pattern" BarToken pState
+			  (type_id, pState) = stringToIdent name IC_Type pState
+			  (token, pState) = nextToken FunctionContext pState
+			  (fields, pState) = want_field_assignments_without_definitions token pState
+			= (PE_Record PE_Empty (RecordNameIdent type_id) fields, wantToken FunctionContext "record pattern" CurlyCloseToken pState)
+	want_record_pattern_without_definitions (QualifiedIdentToken module_name record_name) pState
+		| isUpperCaseName record_name
+			# pState = wantToken FunctionContext "record pattern" BarToken pState
+			  (module_id, pState) = stringToQualifiedModuleIdent module_name record_name IC_Type pState
+			  (token, pState) = nextToken FunctionContext pState
+			  (fields, pState) = want_field_assignments_without_definitions token pState
+			= (PE_Record PE_Empty (RecordNameQualifiedIdent module_id record_name) fields, wantToken FunctionContext "record pattern" CurlyCloseToken pState) 
+	want_record_pattern_without_definitions token pState
+		# (fields, pState) = want_field_assignments_without_definitions token pState
+		= (PE_Record PE_Empty NoRecordName fields, wantToken FunctionContext "record pattern" CurlyCloseToken pState) 
+
+	want_field_assignments_without_definitions token=:(IdentToken field_name) pState
+		| isLowerCaseName field_name
+			# (field_id, pState) = stringToIdent field_name IC_Selector pState
+			= want_more_field_assignments_without_definitions (FieldName field_id) pState
+	want_field_assignments_without_definitions token=:(QualifiedIdentToken module_name field_name) pState
+		| isLowerCaseName field_name
+			# (module_id, pState) = stringToIdent module_name (IC_Module NoQualifiedIdents) pState
+			= want_more_field_assignments_without_definitions (QualifiedFieldName module_id field_name) pState
+	want_field_assignments_without_definitions token pState
+		= ([], parseError "record field assignments" (Yes token) "field name" pState)
+
+	want_more_field_assignments_without_definitions field_name_or_qualified_field_name pState
+		# pState = wantToken FunctionContext "record pattern" EqualToken pState
+		# (field_expr, pState) = wantPattern pState
+		  field = {bind_src = field_expr, bind_dst = field_name_or_qualified_field_name}
+		#  (token, pState) = nextToken FunctionContext pState
+		| token == CommaToken
+			# (token, pState) = nextToken FunctionContext pState
+			  (fields, pState) = want_field_assignments_without_definitions token pState 
+			= ([field : fields], pState)
+			= ([field ], tokenBack pState)
+
 want_update :: !OptionalRecordName !ParsedExpr !Token !ParseState -> (!ParsedExpr, !ParseState)
 want_update type expr token pState
 	# (expr, pState) = want_update_without_curly_close type expr token pState
diff --git a/frontend/partition.icl b/frontend/partition.icl
index 25f2ef3..f10ccc3 100644
--- a/frontend/partition.icl
+++ b/frontend/partition.icl
@@ -207,7 +207,6 @@ where
 	, pi_collect``			:: !.CollectState
 	}
 
-//:: Marks	:== {# Int}
 :: Marks	:== {# Mark}
 :: Mark		= { m_fun :: !Int, m_mark :: !Int}
 
@@ -426,6 +425,8 @@ where
 		= fc_state
 	find_calls fc_info (MatchExpr _ expr) fc_state
 		= find_calls fc_info expr fc_state
+	find_calls fc_info (IsConstructor expr _ _ _ _ _) fc_state
+		= find_calls fc_info expr fc_state
 	find_calls fc_info EE fc_state
 		= fc_state
 	find_calls fc_info (NoBind _) fc_state
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index 1e38490..c384ca8 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -35,7 +35,7 @@ exprToExprWithLocalDefs expr
 		,	ewl_locals = LocalParsedDefs []
 		,	ewl_position= NoPos
 		}
-					
+
 prefixAndPositionToIdent :: !String !LineAndColumn !*CollectAdmin -> (!Ident, !*CollectAdmin)
 prefixAndPositionToIdent prefix {lc_line, lc_column} ca=:{ca_hash_table}
 	# ({boxed_ident=ident}, ca_hash_table) = putIdentInHashTable (prefix +++ ";" +++ toString lc_line +++ ";" +++ toString lc_column) IC_Expression ca_hash_table
@@ -159,6 +159,9 @@ where
 		= collectFunctions (transformSequence sequence) icl_module ca
 	collectFunctions (PE_ArrayDenot array_kind exprs) icl_module ca
 		= collectFunctions (transformArrayDenot array_kind exprs) icl_module ca
+	collectFunctions (PE_Matches case_ident expr pattern position) icl_module ca
+		# (expr, ca) = collectFunctions expr icl_module ca
+		= (PE_Matches case_ident expr pattern position, ca)
 	collectFunctions (PE_Dynamic exprs opt_dyn_type) icl_module ca
 		# (exprs, ca) = collectFunctions exprs icl_module ca
 		= (PE_Dynamic exprs opt_dyn_type, ca)
@@ -1099,13 +1102,13 @@ scanModule mod=:{mod_ident,mod_type,mod_defs = pdefs} cached_modules support_gen
 	  								def_macro_indices = macro_range }}
 	  
 	  hash_table = set_hte_mark 0 ca_hash_table
-	  	  
+
 	  fun_defs = fun_defs++reverse ca_rev_fun_defs
 	  fun_range = {ir_from=0,ir_to=n_global_functions}
 
 	= (reorganise_icl_ok && pea_ok && import_dcl_ok && import_dcls_ok, mod, fun_range, fun_defs, optional_dcl_mod, modules, dcl_module_n,hash_table, err_file, files)
 where
-	scan_main_dcl_module :: Ident ModuleKind (ModTimeFunction *Files) *Files *CollectAdmin -> (!Bool,!Optional (Module (CollectedDefinitions (ScannedInstanceAndMembersR FunDef))),!Int,![ScannedModule],![Ident],!*Files,!*CollectAdmin)
+	scan_main_dcl_module :: Ident ModuleKind (ModTimeFunction *Files) *Files *CollectAdmin -> (!Bool,!Optional ScannedModule,!Int,![ScannedModule],![Ident],!*Files,!*CollectAdmin)
 	scan_main_dcl_module mod_ident MK_Main _ files ca
 		= (True, No,NoIndex,[MakeEmptyModule mod_ident MK_NoMainDcl], cached_modules,files, ca)
 	scan_main_dcl_module mod_ident MK_None _ files ca
diff --git a/frontend/refmark.icl b/frontend/refmark.icl
index ba4f0b4..0680d7c 100644
--- a/frontend/refmark.icl
+++ b/frontend/refmark.icl
@@ -341,6 +341,8 @@ where
 		= refMark free_vars arg_nr No expr rms 
 	refMark free_vars sel _ (MatchExpr _ expr) rms 
 		= refMark free_vars sel No expr rms 
+	refMark free_vars sel _ (IsConstructor expr _ _ _ _ _) rms 
+		= refMark free_vars sel No expr rms 
 	refMark free_vars sel _ EE rms 
 		= rms 
 	refMark _ _ _ _ rms 
@@ -700,7 +702,6 @@ seqCombineRefCount (RC_Used sec_ref) (RC_Used prim_ref)
 		make_primary_selections_non_unique []
 			= []
 
-
 emptyOccurrence type_info =
 		{	occ_ref_count		= RC_Unused
 		,	occ_previous		= []
@@ -729,7 +730,6 @@ where
 		= make_shared_vars_non_unique variables fun_body coercion_env rms_var_heap expr_heap (setErrorAdmin position error)
 	  var_heap = empty_occurrences variables var_heap
 	= (coercion_env, subst, type_def_infos, var_heap, expr_heap, error)
-	
 	where
 		clear_occurrences vars subst type_def_infos var_heap expr_heap
 			= foldSt initial_occurrence vars (subst, type_def_infos, var_heap, expr_heap)
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 6b15767..1c76796 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -252,8 +252,8 @@ cIsAFunction	:== True
 cIsNotAFunction :== False
 
 ::	ParsedDefinition 
-	=	PD_Function  Position Ident Bool [ParsedExpr] Rhs FunKind
-	|	PD_NodeDef  Position ParsedExpr Rhs
+	=	PD_Function Position Ident Bool [ParsedExpr] Rhs FunKind
+	|	PD_NodeDef Position ParsedExpr Rhs
 	|	PD_Type ParsedTypeDef
 	|	PD_TypeSpec Position Ident Priority (Optional SymbolType) FunSpecials
 	|	PD_Class ClassDef [ParsedDefinition]
@@ -1214,6 +1214,7 @@ instance toString 	KindInfo
 				| PE_ArrayCompr !ArrayKind !ParsedExpr ![Qualifier]
 				| PE_Sequ Sequence
 				| PE_WildCard
+				| PE_Matches !Ident /*expr*/!ParsedExpr /*pattern*/!ParsedExpr !Position
 
 				| PE_QualifiedIdent !Ident !String
 
@@ -1302,6 +1303,7 @@ cIsNotStrict	:== False
 				| ABCCodeExpr ![String] !Bool
 
 				| MatchExpr !(Global DefinedSymbol) !Expression
+				| IsConstructor !Expression !(Global DefinedSymbol) /*arity*/!Int !GlobalIndex !Ident !Position
 				| FreeVar FreeVar 
 				| Constant !SymbIdent !Int !Priority		/* auxiliary clause used during checking */
 				| ClassVariable !VarInfoPtr					/* auxiliary clause used during overloading */
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index 2df6046..1f7c5c6 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -385,7 +385,9 @@ where
 	(<<<) file (Update expr1 selections expr2) =  file <<< '{' <<< expr1  <<< " & " <<<  selections <<< " = " <<< expr2 <<< '}'
 	(<<<) file (RecordUpdate cons_symbol expression expressions) = file <<< '{' <<< cons_symbol <<< ' ' <<< expression <<< " & " <<< expressions <<< '}'
 	(<<<) file (TupleSelect field field_nr expr) = file <<< expr <<<'.' <<< field_nr
-	(<<<) file (MatchExpr cons expr) = file <<< cons <<< " =: " <<< expr
+	(<<<) file (MatchExpr cons expr) = file <<< cons <<< " (M)=: " <<< expr
+	(<<<) file (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position)
+		= file <<< expr <<< " (I)=: " <<< cons_symbol
 	(<<<) file EE = file <<< "** E **"
 	(<<<) file (NoBind _) = file <<< "** NB **"
 	(<<<) file (DynamicExpr {dyn_expr,dyn_type_code})     = file <<< "dynamic " <<< dyn_expr <<< " :: " <<< dyn_type_code 
@@ -868,12 +870,14 @@ where
 			= file <<< "argument " <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple"
 		show_expression file (BasicExpr bv)
 			= file <<< bv
+		show_expression file (RecordUpdate _ _ _)
+			= file <<< "update of record"
 		show_expression file (MatchExpr _ expr)
 			= file <<< "match expression"
+		show_expression file (IsConstructor _ _ _ _ _ _)
+			= file <<< "is constructor expression"
 		show_expression file (Let _)
 			= file <<< "(let ... ) or #"
-		show_expression file (RecordUpdate _ _ _)
-			= file <<< "update of record"
 		show_expression file _
 			= file
 		
diff --git a/frontend/trans.icl b/frontend/trans.icl
index 6370bff..771c516 100644
--- a/frontend/trans.icl
+++ b/frontend/trans.icl
@@ -283,6 +283,9 @@ where
 	transform (MatchExpr a1 expr) ro ti
 		# (expr,ti) = transform expr ro ti
 		= (MatchExpr a1 expr,ti)
+	transform (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) ro ti
+		# (expr,ti) = transform expr ro ti
+		= (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position, ti)
 	transform (DynamicExpr dynamic_expr) ro ti
 		# (dynamic_expr, ti) = transform dynamic_expr ro ti
 		= (DynamicExpr dynamic_expr, ti)
@@ -1240,7 +1243,6 @@ where
 			= index1 =< index2
 		compare_constructor_arguments 	(PR_Class app1 lifted_vars_with_types1 t1) 
 										(PR_Class app2 lifted_vars_with_types2 t2) 
-//			= app1.app_args =< app2.app_args
 			# cmp = smallerOrEqual t1 t2
 			| cmp<>Equal
 				= cmp
@@ -1869,7 +1871,6 @@ get_producer_type {symb_kind=SK_Constructor {glob_module, glob_object}} ro fun_d
 	# (_,cons_type) = removeAnnotations cons_type	// necessary???
 	= (cons_type, fun_defs, fun_heap)
 
-//@ determine_args
 determine_args
 	:: ![Bool] ![ConsClass] !Index !{!Producer} ![Optional SymbolType] ![FreeVar] !ReadOnlyTI !*DetermineArgsState
 	-> *DetermineArgsState
@@ -3819,6 +3820,8 @@ where
 			VI_AccVar _ _			-> writeVarInfo var_info_ptr VI_Empty var_heap
 			VI_ExpressionOrBody _ _	_ _
 				-> writeVarInfo var_info_ptr VI_Empty var_heap
+			VI_Body _ _ _
+				-> writeVarInfo var_info_ptr VI_Empty var_heap
 
 instance clearVariables Expression
 where
@@ -3848,6 +3851,8 @@ where
 		= clearVariables expr fvi
 	clearVariables (MatchExpr _ expr) fvi
 		= clearVariables expr fvi
+	clearVariables (IsConstructor expr _ _ _ _ _) fvi
+		= clearVariables expr fvi
 	clearVariables EE fvi
 		= fvi
 	clearVariables _ fvi
@@ -3987,6 +3992,8 @@ where
 		= freeVariables expr fvi
 	freeVariables (MatchExpr _ expr) fvi
 		= freeVariables expr fvi
+	freeVariables (IsConstructor expr _ _ _ _ _) fvi
+		= freeVariables expr fvi
 	freeVariables EE fvi
 		= fvi
 	freeVariables _ fvi
@@ -4325,6 +4332,9 @@ where
 	copy (MatchExpr cons_ident expr) ci cs
 		# (expr, cs) = copy expr ci cs
 		= (MatchExpr cons_ident expr, cs)
+	copy (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) ci cs
+		# (expr, cs) = copy expr ci cs
+		= (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position, cs)
 	copy (DynamicExpr expr) ci cs
 		# (expr, cs) = copy expr ci cs
 		= (DynamicExpr expr, cs)
diff --git a/frontend/transform.icl b/frontend/transform.icl
index 53e1a3f..c076ecc 100644
--- a/frontend/transform.icl
+++ b/frontend/transform.icl
@@ -86,6 +86,9 @@ where
 	lift (DynamicExpr expr) ls
 		# (expr, ls) = lift expr ls
 		= (DynamicExpr expr, ls)
+	lift (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) ls
+		# (expr, ls) = lift expr ls
+		= (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position, ls)
 	lift (TypeSignature type_function expr) ls
 		# (expr, ls) = lift expr ls
 		= (TypeSignature type_function expr, ls)
@@ -402,6 +405,9 @@ where
 	unfold (MatchExpr cons_ident expr) us
 		# (expr, us) = unfold expr us
 		= (MatchExpr cons_ident expr, us)
+	unfold (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) us
+		# (expr, us) = unfold expr us
+		= (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position, us)
 	unfold (DynamicExpr expr) us
 		# (expr, us) = unfold expr us
 		= (DynamicExpr expr, us)
@@ -541,7 +547,7 @@ where
 
 instance unfold Case
 where
-	unfold kees=:{ case_expr,case_guards,case_default,case_info_ptr} us
+	unfold kees=:{case_expr,case_guards,case_default,case_info_ptr} us
 		# (old_case_info, us_symbol_heap) = readPtr case_info_ptr us.us_symbol_heap
 		  new_case_info = old_case_info
 		  (new_info_ptr, us_symbol_heap) = newPtr new_case_info us_symbol_heap
@@ -1140,6 +1146,8 @@ where
 		= has_no_curried_macro_Expression expr
 	has_no_curried_macro_Expression (MatchExpr cons_ident expr)
 		= has_no_curried_macro_Expression expr
+	has_no_curried_macro_Expression (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position)
+		= has_no_curried_macro_Expression expr
 	has_no_curried_macro_Expression (TypeSignature _ expr)
 		= has_no_curried_macro_Expression expr
 	has_no_curried_macro_Expression expr
@@ -1513,6 +1521,9 @@ where
 	expand (MatchExpr cons_ident expr) ei
 		# (expr, ei) = expand expr ei
 		= (MatchExpr cons_ident expr, ei)
+	expand (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) ei
+		# (expr, ei) = expand expr ei
+		= (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position, ei)
 	expand (DynamicExpr dyn) ei
 		# (dyn, ei) = expand dyn ei
 		= (DynamicExpr dyn, ei)
@@ -1664,7 +1675,8 @@ where
 
 determineVariablesAndRefCounts :: ![FreeVar] !Expression !*CollectState -> (!Expression , ![FreeVar], ![FreeVar], ![DynamicPtr], !*CollectState)
 determineVariablesAndRefCounts free_vars expr cos=:{cos_var_heap}
-	# (expr, local_vars, dynamics, cos) = collectVariables expr [] [] { cos & cos_var_heap = clearCount free_vars cIsAGlobalVar cos_var_heap }
+	# cos = {cos & cos_var_heap = clearCount free_vars cIsAGlobalVar cos_var_heap}
+	  (expr, local_vars, dynamics, cos) = collectVariables expr [] [] cos
 	  (free_vars, cos_var_heap) = retrieveRefCounts free_vars cos.cos_var_heap
 	  (local_vars, cos_var_heap) = retrieveRefCounts local_vars cos_var_heap
 	= (expr, free_vars, local_vars, dynamics, { cos & cos_var_heap = cos_var_heap })
@@ -1986,9 +1998,12 @@ where
 	collectVariables (MatchExpr cons_ident expr) free_vars dynamics cos
 		# (expr, free_vars, dynamics, cos) = collectVariables expr free_vars dynamics cos
 		= (MatchExpr cons_ident expr, free_vars, dynamics, cos)
+	collectVariables (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position) free_vars dynamics cos
+		# (expr, free_vars, dynamics, cos) = collectVariables expr free_vars dynamics cos
+		= (IsConstructor expr cons_symbol cons_arity global_type_index case_ident position, free_vars, dynamics, cos)
 	collectVariables (DynamicExpr dynamic_expr) free_vars dynamics cos
 		# (dynamic_expr, free_vars, dynamics, cos) = collectVariables dynamic_expr free_vars dynamics cos
-		= (DynamicExpr dynamic_expr, free_vars, dynamics, cos);
+		= (DynamicExpr dynamic_expr, free_vars, dynamics, cos)
 	collectVariables (TypeSignature type_function expr) free_vars dynamics cos
 		# (expr, free_vars, dynamics, cos) = collectVariables expr free_vars dynamics cos
 		= (TypeSignature type_function expr, free_vars, dynamics, cos);
@@ -2066,7 +2081,8 @@ where
 instance collectVariables AlgebraicPattern
 where
 	collectVariables pattern=:{ap_vars,ap_expr} free_vars dynamics cos
-		# (ap_expr, free_vars, dynamics, cos) = collectVariables ap_expr free_vars dynamics { cos & cos_var_heap = clearCount ap_vars cIsALocalVar cos.cos_var_heap}
+		# cos = {cos & cos_var_heap = clearCount ap_vars cIsALocalVar cos.cos_var_heap}
+		  (ap_expr, free_vars, dynamics, cos) = collectVariables ap_expr free_vars dynamics cos
 		  (ap_vars, cos_var_heap) = retrieveRefCounts ap_vars cos.cos_var_heap
 		= ({ pattern & ap_expr = ap_expr, ap_vars = ap_vars }, free_vars, dynamics, { cos & cos_var_heap = cos_var_heap })
 	
diff --git a/frontend/type.icl b/frontend/type.icl
index d7462f1..eab10c7 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -1834,6 +1834,18 @@ where
 				= ({ at_type = TA tuple_type tst_args, at_attribute = TA_Unique }, No, (reqs, ts))
 				= ( hd tst_args, No, (reqs, ts))
 
+	requirements ti (IsConstructor expr {glob_object={ds_arity,ds_index,ds_ident},glob_module} _ _ _ _) (reqs,ts)
+		# cp = CP_Expression expr
+		  ({tst_result,tst_args,tst_attr_env}, ts) = standardLhsConstructorType cp ds_index glob_module ti ts
+		  (e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr (reqs,ts)
+		  reqs = { reqs & req_attr_coercions =  tst_attr_env ++ reqs.req_attr_coercions,
+		  				  req_type_coercions = [{ tc_demanded = tst_result, tc_offered = e_type, tc_position = cp, tc_coercible = True } : reqs.req_type_coercions ] }
+		  ts_attr_store = ts.ts_attr_store
+		  bool_type = { at_attribute = TA_TempVar ts_attr_store, at_type = basicBoolType.box}
+		  ts & ts_attr_store = inc ts_attr_store,
+		  	   ts_expr_heap = storeAttribute opt_expr_ptr tst_result.at_attribute ts.ts_expr_heap
+		= (bool_type, No, (reqs, ts))
+
 	requirements _ (AnyCodeExpr _ _ _) (reqs, ts)
 		# (fresh_v, ts) = freshAttributedVariable ts
 		= (fresh_v, No, (reqs, ts))
@@ -2268,7 +2280,6 @@ typeProgram :: !{! Group} !Int !*{# FunDef} !IndexRange  !(Optional Bool) !Commo
 	-> (!Bool, !*{# FunDef}, !ArrayAndListInstances, !{# CommonDefs}, !{# {# FunType} }, !*TypeDefInfos,!*Heaps,!*PredefinedSymbols,!*File,!*File)
 typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_defs imports icl_qualified_imports dcl_modules used_module_numbers
 	td_infos heaps=:{hp_var_heap, hp_expression_heap, hp_type_heaps,hp_generic_heap} predef_symbols file out
-
 	#! fun_env_size = size fun_defs
 
 	# ts_error = {ea_file = file, ea_loc = [], ea_ok = True }
diff --git a/frontend/unitype.icl b/frontend/unitype.icl
index db6d77d..0de10bf 100644
--- a/frontend/unitype.icl
+++ b/frontend/unitype.icl
@@ -671,7 +671,6 @@ newInequality off_attr dem_attr coercions=:{coer_demanded, coer_offered}
 		= {coer_demanded = coer_demanded, coer_offered = coer_offered}
 		= {coer_demanded = coer_demanded, coer_offered = coer_offered}
 where
-
 	insert ::  !Int !*CoercionTree -> (!Bool, !*CoercionTree)
 	insert new_attr CT_Empty
 		=  (True, CT_Node new_attr CT_Empty CT_Empty)
@@ -730,9 +729,7 @@ makeNonUnique attr {coer_demanded, coer_offered}
 	# (dem_coercions, coer_demanded) = replace coer_demanded attr CT_Empty
 	  coer_offered = { coer_offered & [attr] = CT_NonUnique }
 	= make_non_unique dem_coercions {coer_offered = coer_offered, coer_demanded = coer_demanded}
-//		---> ("makeNonUnique", attr)
 where
-	// JVG added type:
 	make_non_unique :: !CoercionTree !*Coercions -> *Coercions;
 	make_non_unique (CT_Node this_attr ct_less ct_greater) coercions
 		# coercions = makeNonUnique this_attr coercions
@@ -930,7 +927,7 @@ coerceTypes sign defs cons_vars tpos _ _  cs
 coercions_of_arg_types sign defs cons_vars tpos [t1 : ts1] [t2 : ts2] sign_class arg_number cs
 	# arg_sign = sign * signClassToSign sign_class arg_number
 	  (succ, cs) = coerce arg_sign defs cons_vars [arg_number : tpos] t1 t2 cs
-	| Success succ 
+	| Success succ
 		= coercions_of_arg_types sign defs cons_vars tpos ts1 ts2 sign_class (inc arg_number) cs
 		= (succ, cs)
 coercions_of_arg_types sign defs cons_vars tpos [] [] _ _ cs
@@ -1038,8 +1035,6 @@ where
 		= find_var_position_in_expression expr
 	find_var_position_in_expression (TupleSelect _ _ expr)
 		= find_var_position_in_expression expr
-	find_var_position_in_expression (MatchExpr _ expr)
-		= find_var_position_in_expression expr
 	find_var_position_in_expression (Update expr1 selections expr2)
 		# (found,pos) = find_var_position_in_expression expr1
 		| found
@@ -1061,6 +1056,10 @@ where
 			= find_var_position_in_updated_fields updated_fields
 		find_var_position_in_updated_fields []
 			= (False,NoPos)
+	find_var_position_in_expression (MatchExpr _ expr)
+		= find_var_position_in_expression expr
+	find_var_position_in_expression (IsConstructor expr _ _ _ _ _)
+		= find_var_position_in_expression expr
 	find_var_position_in_expression (Let {let_strict_binds,let_lazy_binds,let_expr})
 		# (found,pos) = find_var_position_in_let_binds let_strict_binds
 		| found