added code for OverloadedListPatterns

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

2 files changed, 198 insertions, 114 deletions

diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl
index 3737a75..a292687 100644
--- a/frontend/convertcases.icl
+++ b/frontend/convertcases.icl
@@ -243,7 +243,9 @@ weightedRefCountOfCase rci=:{rci_depth} this_case=:{case_expr, case_guards, case
 			rs=:{ rcs_var_heap, rcs_expr_heap, rcs_imports }
 	# (local_vars, vars_and_heaps) = weighted_ref_count_in_case_patterns {rci & rci_depth=rci_depth+1} case_guards rcs_imports rcs_var_heap rcs_expr_heap
 	  (default_vars, (all_vars, rcs_imports, var_heap, expr_heap)) = weighted_ref_count_in_default {rci & rci_depth=rci_depth+1} case_default vars_and_heaps
-	  rs = weightedRefCount rci case_expr { rs & rcs_var_heap = var_heap, rcs_expr_heap = expr_heap, rcs_imports = rcs_imports }
+	  rs = { rs & rcs_var_heap = var_heap, rcs_expr_heap = expr_heap, rcs_imports = rcs_imports }
+	  rs = weighted_ref_count_of_decons_expr rci case_guards rs
+	  rs = weightedRefCount rci case_expr rs
 	  (rcs_free_vars, rcs_var_heap) = foldSt (addPatternVariable rci_depth) all_vars (rs.rcs_free_vars, rs.rcs_var_heap)
 	  rcs_expr_heap = rs.rcs_expr_heap <:= (case_info_ptr, EI_CaseTypeAndRefCounts case_type 
 	  		{ rcc_all_variables = all_vars, rcc_default_variables = default_vars, rcc_pattern_variables = local_vars })
@@ -257,28 +259,34 @@ weightedRefCountOfCase rci=:{rci_depth} this_case=:{case_expr, case_guards, case
 
 		weighted_ref_count_in_case_patterns rci (AlgebraicPatterns type patterns) collected_imports var_heap expr_heap
 			= mapSt (weighted_ref_count_in_algebraic_pattern rci) patterns ([], collected_imports, var_heap, expr_heap)
-		where
-			weighted_ref_count_in_algebraic_pattern rci=:{rci_imported} {ap_expr,ap_symbol} wrcs_state
-				# (free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
-					= weightedRefCountInPatternExpr rci ap_expr wrcs_state
-				  (collected_imports, var_heap)
-					=	check_symbol rci_imported ap_symbol collected_imports var_heap
-				=	(free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
-				where
-					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
-							= (collected_imports, var_heap)
-
 		weighted_ref_count_in_case_patterns rci (BasicPatterns type patterns) collected_imports var_heap expr_heap
 			= mapSt (\{bp_expr} -> weightedRefCountInPatternExpr rci bp_expr) patterns ([], collected_imports, var_heap, expr_heap)
+		weighted_ref_count_in_case_patterns rci (OverloadedListPatterns type _ patterns) collected_imports var_heap expr_heap
+			= mapSt (weighted_ref_count_in_algebraic_pattern rci) patterns ([], collected_imports, var_heap, expr_heap)
 		weighted_ref_count_in_case_patterns rci (DynamicPatterns patterns) collected_imports var_heap expr_heap
 			= mapSt (\{dp_rhs} -> weightedRefCountInPatternExpr rci dp_rhs) patterns ([], collected_imports, var_heap, expr_heap)
 
+		weighted_ref_count_in_algebraic_pattern rci=:{rci_imported} {ap_expr,ap_symbol} wrcs_state
+			# (free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
+				= weightedRefCountInPatternExpr rci ap_expr wrcs_state
+			  (collected_imports, var_heap)
+				=	check_symbol rci_imported ap_symbol collected_imports var_heap
+			=	(free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
+			where
+				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
+						= (collected_imports, var_heap)
+
+	 	weighted_ref_count_of_decons_expr rci (OverloadedListPatterns _ decons_exp _) rs
+	 		= weightedRefCount rci decons_exp rs;
+	 	weighted_ref_count_of_decons_expr rci case_guards rs
+	 		= rs;
+
 weightedRefCountOfCase rci=:{rci_depth} this_case=:{case_expr, case_guards, case_default, case_info_ptr} (EI_CaseTypeAndRefCounts case_type {rcc_all_variables})
 			rs=:{ rcs_var_heap, rcs_expr_heap, rcs_imports }
 	# rs = weightedRefCount rci case_expr rs
@@ -537,12 +545,6 @@ where
 		distribute_lets_in_patterns depth ref_counts (AlgebraicPatterns conses patterns) ds
 			# (patterns, ds) = mapSt (distribute_lets_in_alg_pattern depth) (exactZip ref_counts patterns) ds
 			= (AlgebraicPatterns conses patterns, ds)
-		where
-			distribute_lets_in_alg_pattern depth (ref_counts,pattern) ds=:{ds_var_heap}
-				# (ap_vars, ds_var_heap) = mapSt refresh_variable pattern.ap_vars ds_var_heap
-				  ds = {ds & ds_var_heap = ds_var_heap}
-				  (ap_expr, ds) = distribute_lets_in_pattern_expr depth ref_counts pattern.ap_expr ds
-				= ({ pattern & ap_vars = ap_vars, ap_expr = ap_expr }, ds) 
 		distribute_lets_in_patterns depth ref_counts (BasicPatterns type patterns) ds
 			# (patterns, ds) = mapSt (distribute_lets_in_basic_pattern depth) (exactZip ref_counts patterns) ds
 			= (BasicPatterns type patterns, ds)
@@ -550,6 +552,15 @@ where
 			distribute_lets_in_basic_pattern depth (ref_counts,pattern) ds
 				# (bp_expr, ds) = distribute_lets_in_pattern_expr depth ref_counts pattern.bp_expr ds
 				= ({ pattern & bp_expr = bp_expr }, ds)
+		distribute_lets_in_patterns depth ref_counts (OverloadedListPatterns conses decons_expr patterns) heaps
+			# (patterns, heaps) = mapSt (distribute_lets_in_alg_pattern depth) (exactZip ref_counts patterns) heaps
+			= (OverloadedListPatterns conses decons_expr patterns, heaps)
+
+		distribute_lets_in_alg_pattern depth (ref_counts,pattern) ds=:{ds_var_heap}
+			# (ap_vars, ds_var_heap) = mapSt refresh_variable pattern.ap_vars ds_var_heap
+			  ds = {ds & ds_var_heap = ds_var_heap}
+			  (ap_expr, ds) = distribute_lets_in_pattern_expr depth ref_counts pattern.ap_expr ds
+			= ({ pattern & ap_vars = ap_vars, ap_expr = ap_expr }, ds) 
 
 		distribute_lets_in_default depth ref_counts_in_default (Yes expr) ds
 			# (expr, ds) = distribute_lets_in_pattern_expr depth ref_counts_in_default expr ds
@@ -751,29 +762,7 @@ where
 	,	cs_expr_heap		:: !.ExpressionHeap
 	,	cs_next_fun_nr		:: !Index
 	}
-/*
-class caseFree a :: !a -> Bool
-
-instance caseFree [a] | caseFree a where
-	caseFree l
-		=	and (map caseFree l)
-
-instance caseFree (Optional a) | caseFree a where
-	caseFree No
-		=	True
-	caseFree (Yes a)
-		=	caseFree a
-
-instance caseFree BasicPattern where
-	caseFree {bp_expr}
-		=	caseFree bp_expr
-
-instance caseFree Expression where
-	caseFree (Case _)
-		=	False
-	caseFree _
-		=	True
-*/
+
 markLocalLetVar :: LetBind *VarHeap -> *VarHeap
 markLocalLetVar {lb_dst={fv_info_ptr}} varHeap
 	=	varHeap <:= (fv_info_ptr, VI_LocalLetVar)
@@ -889,18 +878,16 @@ instance convertRootCases Expression where
 								VI_LocalLetVar
 									->	convertCases ci caseExpr cs // -*-> "convertRootCases, no guards"
 								_
-	//								| True <<- ("convertRootCases",varInfo)
+//									| True <<- ("convertRootCases",varInfo)
 							  		# (case_expr, cs)	= convertCases ci case_expr cs
 									# (case_guards, cs) = convertRootCasesCasePatterns ci case_guards case_type.ct_cons_types cs
 							  		# (case_default, cs)= convertRootCases ci case_default cs
 									-> (Case {kees & case_expr=case_expr, case_guards=case_guards, case_default=case_default}, cs)
-	
 						// otherwise
 							-> convertNonRootCase ci kees cs
 					expr
 //						->	convertCases ci caseExpr cs // -*-> "convertRootCases, no guards"
 						-> convertNonRootCase ci kees cs
-
 	where
 		isTruePattern [{bp_value=BVB True}:_]
 			= True
@@ -912,7 +899,7 @@ instance convertRootCases Expression where
 			# (guard, cs) = convert_guard guard ci cs
 //			# (EI_CaseTypeAndRefCounts case_type _, cs_expr_heap) = readPtr case_info_ptr cs.cs_expr_heap
 //			# {cs &cs_expr_heap=cs_expr_heap}
-			# (then_part, cs) = convertRootCases {ci & ci_case_level = CaseLevelAfterGuardRoot} bp_expr cs
+			# (then_part, cs) = convertRootCases {ci & ci_case_level=CaseLevelAfterGuardRoot} bp_expr cs			
 			# (opt_else_part, cs) = convert_to_else_part ci sign_of_then_part alts case_default cs
 			= (build_conditional sign_of_then_part guard then_part opt_else_part, cs)
 		where
@@ -952,18 +939,22 @@ convertRootCasesCasePatterns ci (AlgebraicPatterns gi patterns) arg_types cs
 	# (patterns, cs)
 		=	convertRootCasesAlgebraicPatterns ci (exactZip patterns arg_types) cs
 	=	(AlgebraicPatterns gi patterns, cs)
-	where
-		convertRootCasesAlgebraicPatterns :: ConvertInfo [(AlgebraicPattern, [AType])] *ConvertState -> ([AlgebraicPattern], *ConvertState)
-		convertRootCasesAlgebraicPatterns ci l cs
-			=	mapSt (convertRootCasesAlgebraicPattern ci) l cs 
-
-		convertRootCasesAlgebraicPattern :: ConvertInfo (AlgebraicPattern, [AType]) *ConvertState -> (AlgebraicPattern, *ConvertState)
-		convertRootCasesAlgebraicPattern ci (pattern=:{ap_expr, ap_vars}, arg_types) cs
-			# ci
-				=	{ci & ci_bound_vars= exactZip ap_vars arg_types ++ ci.ci_bound_vars}
-			# (ap_expr, cs)
-				=	convertRootCases ci ap_expr cs
-			=	({pattern & ap_expr=ap_expr}, cs)
+convertRootCasesCasePatterns ci (OverloadedListPatterns type decons_expr patterns) arg_types cs
+	# (patterns, cs)
+		=	convertRootCasesAlgebraicPatterns ci (exactZip patterns arg_types) cs
+	=	(OverloadedListPatterns type decons_expr patterns, cs)
+
+convertRootCasesAlgebraicPatterns :: ConvertInfo [(AlgebraicPattern, [AType])] *ConvertState -> ([AlgebraicPattern], *ConvertState)
+convertRootCasesAlgebraicPatterns ci l cs
+	=	mapSt (convertRootCasesAlgebraicPattern ci) l cs 
+where
+	convertRootCasesAlgebraicPattern :: ConvertInfo (AlgebraicPattern, [AType]) *ConvertState -> (AlgebraicPattern, *ConvertState)
+	convertRootCasesAlgebraicPattern ci (pattern=:{ap_expr, ap_vars}, arg_types) cs
+		# ci
+			=	{ci & ci_bound_vars= exactZip ap_vars arg_types ++ ci.ci_bound_vars}
+		# (ap_expr, cs)
+			=	convertRootCases ci ap_expr cs
+		=	({pattern & ap_expr=ap_expr}, cs)
 
 instance convertRootCases (Optional a) | convertRootCases a where
 	convertRootCases ci (Yes expr) cs
@@ -1172,6 +1163,8 @@ splitGuards (AlgebraicPatterns index patterns)
 	=	[AlgebraicPatterns index [pattern] \\ pattern <- patterns]
 splitGuards (BasicPatterns basicType patterns)
 	=	[BasicPatterns basicType [pattern] \\ pattern <- patterns]
+splitGuards (OverloadedListPatterns type decons_expr patterns)
+	=	[OverloadedListPatterns type decons_expr [pattern] \\ pattern <- patterns]
 
 makeCase :: Expression CasePatterns -> Expression
 makeCase expr guard
@@ -1330,6 +1323,10 @@ where
 	copy (BasicPatterns type patterns) cp_info
 		# (patterns, cp_info) = copy patterns cp_info
 		= (BasicPatterns type patterns, cp_info) 
+	copy (OverloadedListPatterns type decons_expr patterns) cp_info
+		# (patterns, cp_info) = copy patterns cp_info
+		# (decons_expr, cp_info) = copy decons_expr cp_info
+		= (OverloadedListPatterns type decons_expr patterns, cp_info) 
 
 instance copy AlgebraicPattern
 where
@@ -1338,7 +1335,6 @@ where
 		# (ap_expr, cp_info) = copy ap_expr { cp_info & cp_local_vars = cp_local_vars, cp_var_heap = cp_var_heap}
 		= ({ pattern & ap_expr = ap_expr }, cp_info) 
 	where
-
 		bind_pattern_var pattern_var=:{fv_info_ptr} (local_vars, var_heap)
 			= ([pattern_var : local_vars], var_heap <:= (fv_info_ptr, VI_LocalVar))
 
@@ -1668,6 +1664,3 @@ mergeCases (case_expr=:(Case first_case=:{case_default, case_default_pos}), case
 				var_heap, symbol_heap, error)
 mergeCases expr_and_pos _ var_heap symbol_heap error
 	= (expr_and_pos, var_heap, symbol_heap, /* checkWarning "" " alternative will never match" */ error)
-
-
-
diff --git a/frontend/mergecases.icl b/frontend/mergecases.icl
index e147145..b74b2f1 100644
--- a/frontend/mergecases.icl
+++ b/frontend/mergecases.icl
@@ -78,6 +78,17 @@ where
 
 						No
 							-> (No, var_heap, symbol_heap)
+				OverloadedListPatterns type decons_expr [overloaded_list_pattern]
+					# (split_result, var_heap, symbol_heap) = split_case split_var_info_ptr overloaded_list_pattern.ap_expr var_heap symbol_heap
+					-> case split_result of
+						Yes split_case
+							# (cees,symbol_heap) = push_expression_into_guards_and_default
+													( \ guard_expr -> { this_case & case_guards = OverloadedListPatterns type decons_expr [{ overloaded_list_pattern & ap_expr = guard_expr }] } )
+														split_case symbol_heap
+							-> (Yes cees, var_heap, symbol_heap)
+
+						No
+							-> (No, var_heap, symbol_heap) 
 				DynamicPatterns [dynamic_pattern]
 					# (split_result, var_heap, symbol_heap) = split_case split_var_info_ptr dynamic_pattern.dp_rhs var_heap symbol_heap
 					-> case split_result of
@@ -121,14 +132,7 @@ where
 		= var_heap <:= (fv_info_ptr, VI_Alias var)
 	set_alias _ var_heap
 		= var_heap
-/*
-	push_expression_into_guards expr_fun (AlgebraicPatterns type patterns) 
-		= AlgebraicPatterns type (map (\algpattern -> { algpattern & ap_expr = expr_fun algpattern.ap_expr }) patterns)
-	push_expression_into_guards expr_fun (BasicPatterns type patterns) 
-		= BasicPatterns type (map (\baspattern -> { baspattern & bp_expr = expr_fun baspattern.bp_expr }) patterns)
-	push_expression_into_guards expr_fun (DynamicPatterns patterns) 
-		= DynamicPatterns (map (\dynpattern -> { dynpattern & dp_rhs = expr_fun dynpattern.dp_rhs }) patterns)
-*/
+
 	push_expression_into_guards_and_default expr_fun split_case symbol_heap
 		= push_expression_into_guards_and_default split_case symbol_heap
 	where
@@ -144,6 +148,9 @@ where
 		push_expression_into_guards split_case=:{case_guards=BasicPatterns type patterns} symbol_heap
 			# (new_patterns,symbol_heap) = push_expression_into_patterns patterns symbol_heap
 			= ({split_case & case_guards=BasicPatterns type new_patterns},symbol_heap)
+		push_expression_into_guards split_case=:{case_guards=OverloadedListPatterns type decons_expr patterns} symbol_heap
+			# (new_patterns,symbol_heap) = push_expression_into_patterns patterns symbol_heap
+			= ({split_case & case_guards=OverloadedListPatterns type decons_expr new_patterns},symbol_heap)
 		push_expression_into_guards split_case=:{case_guards=DynamicPatterns patterns} symbol_heap
 			# (new_patterns,symbol_heap) = push_expression_into_patterns patterns symbol_heap
 			= ({split_case & case_guards=DynamicPatterns new_patterns},symbol_heap)
@@ -192,13 +199,6 @@ where
 	push_let_expression_into_guards lad (AlgebraicPatterns type patterns) var_heap expr_heap
 		# (patterns, var_heap, expr_heap) = push_let_expression_into_algebraic_pattern lad patterns var_heap expr_heap
 		= (AlgebraicPatterns type patterns, var_heap, expr_heap)
-	where
-		push_let_expression_into_algebraic_pattern lad [pattern=:{ap_expr}] var_heap expr_heap
-			= ([{ pattern & ap_expr = Let { lad & let_expr = ap_expr}}], var_heap, expr_heap)
-		push_let_expression_into_algebraic_pattern lad [pattern=:{ap_expr}:patterns] var_heap expr_heap
-			# (ap_expr, var_heap, expr_heap) = rebuild_let_expression lad ap_expr var_heap expr_heap
-			  (patterns, var_heap, expr_heap) = push_let_expression_into_algebraic_pattern lad patterns var_heap expr_heap
-			= ([{pattern & ap_expr = ap_expr} : patterns], var_heap, expr_heap)
 	push_let_expression_into_guards lad (BasicPatterns type patterns) var_heap expr_heap 
 		# (patterns, var_heap, expr_heap) = push_let_expression_into_basic_pattern lad patterns var_heap expr_heap
 		= (BasicPatterns type patterns, var_heap, expr_heap)
@@ -209,6 +209,9 @@ where
 			# (bp_expr, var_heap, expr_heap) = rebuild_let_expression lad bp_expr var_heap expr_heap
 			  (patterns, var_heap, expr_heap) = push_let_expression_into_basic_pattern lad patterns var_heap expr_heap
 			= ([{pattern & bp_expr = bp_expr} : patterns], var_heap, expr_heap)
+	push_let_expression_into_guards lad (OverloadedListPatterns type decons_expr patterns) var_heap expr_heap
+		# (patterns, var_heap, expr_heap) = push_let_expression_into_algebraic_pattern lad patterns var_heap expr_heap
+		= (OverloadedListPatterns type decons_expr patterns, var_heap, expr_heap)
 	push_let_expression_into_guards lad (DynamicPatterns patterns) var_heap expr_heap
 		# (patterns, var_heap, expr_heap) = push_let_expression_into_dynamic_pattern lad patterns var_heap expr_heap
 		= (DynamicPatterns patterns, var_heap, expr_heap)
@@ -220,27 +223,104 @@ where
 			  (patterns, var_heap, expr_heap) = push_let_expression_into_dynamic_pattern lad patterns var_heap expr_heap
 			= ([{pattern & dp_rhs = dp_rhs} : patterns], var_heap, expr_heap)
 
+	push_let_expression_into_algebraic_pattern lad [pattern=:{ap_expr}] var_heap expr_heap
+		= ([{ pattern & ap_expr = Let { lad & let_expr = ap_expr}}], var_heap, expr_heap)
+	push_let_expression_into_algebraic_pattern lad [pattern=:{ap_expr}:patterns] var_heap expr_heap
+		# (ap_expr, var_heap, expr_heap) = rebuild_let_expression lad ap_expr var_heap expr_heap
+		  (patterns, var_heap, expr_heap) = push_let_expression_into_algebraic_pattern lad patterns var_heap expr_heap
+		= ([{pattern & ap_expr = ap_expr} : patterns], var_heap, expr_heap)
+
 	merge_guards guards=:(AlgebraicPatterns type1 patterns1) (AlgebraicPatterns type2 patterns2) var_heap symbol_heap error
 		| type1 == type2
-			# (merged_patterns, var_heap, symbol_heap, error) = merge_algebraic_patterns patterns1 patterns2 var_heap symbol_heap error
-			= (AlgebraicPatterns type1 merged_patterns, var_heap, symbol_heap, error) 
-			= (guards, var_heap, symbol_heap, checkError "" "incompatible patterns in case" error)
+			= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
+			= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
 	merge_guards guards=:(BasicPatterns basic_type1 patterns1) (BasicPatterns basic_type2 patterns2) var_heap symbol_heap error
 		| basic_type1 == basic_type2
 			# (merged_patterns, var_heap, symbol_heap, error) = merge_basic_patterns patterns1 patterns2 var_heap symbol_heap error
 			= (BasicPatterns basic_type1 merged_patterns, var_heap, symbol_heap, error) 
-			= (guards, var_heap, symbol_heap, checkError "" "incompatible patterns in case" error)
+			= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
+	merge_guards guards=:(OverloadedListPatterns type1 decons_expr1 patterns1) (OverloadedListPatterns type2 decons_expr2 patterns2) var_heap symbol_heap error
+		| type1 == type2
+			= merge_overloaded_list_patterns type1 decons_expr1 patterns1 patterns2 var_heap symbol_heap error
+		= case (type1,type2) of
+			(OverloadedList _ _ _ _,UnboxedList type_symbol stdStrictLists_index decons_index nil_index)
+				# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_UnboxedConsSymbol PD_UnboxedNilSymbol
+				-> merge_overloaded_list_patterns type2 decons_expr2 patterns1 patterns2 var_heap symbol_heap error
+			(OverloadedList _ _ _ _,UnboxedTailStrictList type_symbol stdStrictLists_index decons_index nil_index)
+				# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_UnboxedTailStrictConsSymbol PD_UnboxedTailStrictNilSymbol
+				-> merge_overloaded_list_patterns type2 decons_expr2 patterns1 patterns2 var_heap symbol_heap error
+			(UnboxedList type_symbol stdStrictLists_index decons_index nil_index,OverloadedList _ _ _ _)
+				# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_UnboxedConsSymbol PD_UnboxedNilSymbol
+				-> merge_overloaded_list_patterns type1 decons_expr1 patterns1 patterns2 var_heap symbol_heap error
+			(UnboxedTailStrictList type_symbol stdStrictLists_index decons_index nil_index,OverloadedList _ _ _ _)
+				# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_UnboxedTailStrictConsSymbol PD_UnboxedTailStrictNilSymbol
+				-> merge_overloaded_list_patterns type1 decons_expr1 patterns1 patterns2 var_heap symbol_heap error
+			_
+				-> (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
 	merge_guards guards=:(DynamicPatterns  patterns1) (DynamicPatterns  patterns2) var_heap symbol_heap error
 		# (merged_patterns, var_heap, symbol_heap, error) = merge_dynamic_patterns patterns1 patterns2 var_heap symbol_heap error
 		= (DynamicPatterns merged_patterns, var_heap, symbol_heap, error) 
+	merge_guards guards=:(AlgebraicPatterns type1 patterns1) (OverloadedListPatterns type2 decons_expr2 patterns2) var_heap symbol_heap error
+		| type1.glob_module==cPredefinedModuleIndex
+			# index=type1.glob_object+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
+			| index==PD_StrictListType
+				# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_StrictConsSymbol PD_StrictNilSymbol
+				= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
+			| index==PD_TailStrictListType
+				# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_TailStrictConsSymbol PD_TailStrictNilSymbol
+				= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
+			| index==PD_StrictTailStrictListType
+				# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol
+				= 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
+			# index=type2.glob_object+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
+			| index==PD_StrictListType
+				# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_StrictConsSymbol PD_StrictNilSymbol
+				= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
+			| index==PD_TailStrictListType
+				# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_TailStrictConsSymbol PD_TailStrictNilSymbol
+				= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
+			| index==PD_StrictTailStrictListType
+				# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol
+				= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
+				= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
 	merge_guards patterns1 patterns2 var_heap symbol_heap error
-		= (patterns1, var_heap, symbol_heap, checkError "" "incompatible patterns in case" error)
+		= (patterns1, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
 		
-	merge_algebraic_patterns patterns [alg_pattern : alg_patterns] var_heap symbol_heap error
-		# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns alg_pattern patterns var_heap symbol_heap error
-		= merge_algebraic_patterns patterns alg_patterns var_heap symbol_heap error
-	merge_algebraic_patterns patterns [] var_heap symbol_heap error
+	merge_algebraic_patterns type patterns1 patterns2 var_heap symbol_heap error
+		# (merged_patterns, var_heap, symbol_heap, error) = merge_algebraic_or_overloaded_list_patterns patterns1 patterns2 var_heap symbol_heap error
+		= (AlgebraicPatterns type merged_patterns, var_heap, symbol_heap, error) 
+
+	merge_overloaded_list_patterns type decons_expr patterns1 patterns2 var_heap symbol_heap error
+		# (merged_patterns, var_heap, symbol_heap, error) = merge_algebraic_or_overloaded_list_patterns patterns1 patterns2 var_heap symbol_heap error
+		= (OverloadedListPatterns type decons_expr merged_patterns, var_heap, symbol_heap, error) 
+
+	merge_algebraic_or_overloaded_list_patterns patterns [] var_heap symbol_heap error
 		= (patterns, var_heap, symbol_heap, error)
+	merge_algebraic_or_overloaded_list_patterns patterns [alg_pattern : alg_patterns] var_heap symbol_heap error
+		# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns alg_pattern patterns var_heap symbol_heap error
+		= merge_algebraic_or_overloaded_list_patterns patterns alg_patterns var_heap symbol_heap error
+	where
+		merge_algebraic_pattern_with_patterns new_pattern [pattern=:{ap_symbol,ap_vars,ap_expr} : patterns] var_heap symbol_heap error
+			| new_pattern.ap_symbol == ap_symbol
+				| isEmpty new_pattern.ap_vars
+					# ((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_pattern.ap_expr, NoPos)] var_heap symbol_heap error
+					= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
+					# (new_expr, var_heap, symbol_heap) = replace_variables new_pattern.ap_vars new_pattern.ap_expr ap_vars var_heap symbol_heap
+					  ((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_expr, NoPos)] var_heap symbol_heap error
+					= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
+				# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns new_pattern patterns var_heap symbol_heap error		
+				= ([ pattern : patterns ], var_heap, symbol_heap, error)
+		merge_algebraic_pattern_with_patterns new_pattern [] var_heap symbol_heap error
+			= ([new_pattern], var_heap, symbol_heap, error)
 	
 	merge_basic_patterns patterns [alg_pattern : alg_patterns] var_heap symbol_heap error
 		# (patterns, var_heap, symbol_heap, error) = merge_basic_pattern_with_patterns alg_pattern patterns var_heap symbol_heap error
@@ -248,35 +328,21 @@ where
 	merge_basic_patterns patterns [] var_heap symbol_heap error
 		= (patterns, var_heap, symbol_heap, error)
 	
-	merge_dynamic_patterns patterns1 patterns2 var_heap symbol_heap error
-		= (patterns1 ++ patterns2, var_heap, symbol_heap, error)
-
-	merge_algebraic_pattern_with_patterns new_pattern [pattern=:{ap_symbol,ap_vars,ap_expr} : patterns] var_heap symbol_heap error
-		| new_pattern.ap_symbol == ap_symbol
-			| isEmpty new_pattern.ap_vars
-				# ((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_pattern.ap_expr, NoPos)] var_heap symbol_heap error
-				= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
-				# (new_expr, var_heap, symbol_heap) = replace_variables new_pattern.ap_vars new_pattern.ap_expr ap_vars var_heap symbol_heap
-				  ((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_expr, NoPos)] var_heap symbol_heap error
-				= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
-			# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns new_pattern patterns var_heap symbol_heap error		
-			= ([ pattern : patterns ], var_heap, symbol_heap, error)
+	replace_variables vars expr ap_vars var_heap symbol_heap
+		# var_heap = build_aliases vars ap_vars var_heap
+		# us = { us_var_heap = var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No,us_cleanup_info=[], us_local_macro_functions = No }
+		  ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n= -1, ui_conversion_table=No }
+		  (expr, us) = unfold expr ui us
+		= (expr, us.us_var_heap, us.us_symbol_heap)
 	where
-		replace_variables vars expr ap_vars var_heap symbol_heap
-			# var_heap = build_aliases vars ap_vars var_heap
-			# us = { us_var_heap = var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No,us_cleanup_info=[], us_local_macro_functions = No }
-			  ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n= -1, ui_conversion_table=No }
-			  (expr, us) = unfold expr ui us
-			= (expr, us.us_var_heap, us.us_symbol_heap)
-
 		build_aliases [var1 : vars1] [ {fv_name,fv_info_ptr} : vars2 ] var_heap
 			= build_aliases vars1 vars2 (writePtr var1.fv_info_ptr (VI_Variable fv_name fv_info_ptr) var_heap)
 		build_aliases [] [] var_heap
 			= var_heap
 
-	merge_algebraic_pattern_with_patterns new_pattern [] var_heap symbol_heap error
-		= ([new_pattern], var_heap, symbol_heap, error)
-	
+	merge_dynamic_patterns patterns1 patterns2 var_heap symbol_heap error
+		= (patterns1 ++ patterns2, var_heap, symbol_heap, error)
+
 	merge_basic_pattern_with_patterns new_pattern [pattern=:{bp_value,bp_expr} : patterns]  var_heap symbol_heap error
 		| new_pattern.bp_value == bp_value
 			# ((bp_expr, _), var_heap, symbol_heap, error) = mergeCases (bp_expr, NoPos) [(new_pattern.bp_expr, NoPos)] var_heap symbol_heap error
@@ -286,6 +352,31 @@ where
 	merge_basic_pattern_with_patterns new_pattern [] var_heap symbol_heap error
 		= ([new_pattern], var_heap, symbol_heap, error)
 	
+	replace_overloaded_symbols_in_patterns [] pd_cons_symbol pd_nil_symbol
+		= []
+	replace_overloaded_symbols_in_patterns [pattern=:{ap_symbol={glob_module,glob_object}}:patterns] pd_cons_symbol pd_nil_symbol
+		# pattern = replace_overloaded_symbol_in_pattern pattern pd_cons_symbol pd_nil_symbol
+		# patterns = replace_overloaded_symbols_in_patterns patterns pd_cons_symbol pd_nil_symbol
+		= [pattern:patterns]
+	where
+		replace_overloaded_symbol_in_pattern pattern=:{ap_symbol={glob_module,glob_object}} pd_cons_symbol pd_nil_symbol
+			| glob_module==cPredefinedModuleIndex
+				# index=glob_object.ds_index+FirstConstructorPredefinedSymbolIndex
+				| index==PD_OverloadedConsSymbol
+					# new_cons_index=pd_cons_symbol-FirstConstructorPredefinedSymbolIndex
+					# new_cons_ident=cons_and_nil_idents.[new_cons_index]
+					# glob_object = {glob_object & ds_index=new_cons_index,ds_ident=new_cons_ident}
+					= {pattern & ap_symbol.glob_object=glob_object}
+				| index==PD_OverloadedNilSymbol
+					# new_nil_index=pd_nil_symbol-FirstConstructorPredefinedSymbolIndex
+					# new_nil_ident=cons_and_nil_idents.[new_nil_index]
+					# glob_object = {glob_object & ds_index=new_nil_index,ds_ident=new_nil_ident}
+					= {pattern & ap_symbol.glob_object=glob_object}
+					= abort "replace_overloaded_symbol_in_pattern"
+
+	incompatible_patterns_in_case_error error
+		= checkError "" "incompatible patterns in case" error
+
 mergeCases (case_expr=:(Case first_case=:{case_default, case_default_pos}), case_pos) [expr : exprs] var_heap symbol_heap error
 	= case case_default of
 		Yes default_expr