make local build_ functions global

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

1 files changed, 88 insertions, 73 deletions

diff --git a/frontend/generics1.icl b/frontend/generics1.icl
index 5591d62..4f06d09 100644
--- a/frontend/generics1.icl
+++ b/frontend/generics1.icl
@@ -874,18 +874,13 @@ where
 		#! (arg_exprs, heaps) = build_fields (SwitchGenericInfo True False && is_record) var_exprs heaps
 			with
 				build_fields False var_exprs heaps = (var_exprs, heaps)
-				build_fields True var_exprs heaps = mapSt build_field var_exprs heaps
-				build_field var_expr heaps = buildPredefConsApp PD_ConsFIELD [var_expr] predefs heaps 
+				build_fields True var_exprs heaps = mapSdSt build_field var_exprs predefs heaps
 
 		#! (expr, heaps) = build_prod arg_exprs predefs heaps
-		#! (expr, heaps) = SwitchGenericInfo (build_cons expr heaps) (expr, heaps)
-			with 
-				build_cons expr heaps = buildPredefConsApp PD_ConsCONS [expr] predefs heaps						
+		#! (expr, heaps) = SwitchGenericInfo (build_cons expr predefs heaps) (expr, heaps)
 		#! (expr, heaps) = build_sum i n expr predefs heaps
 				
-		#! (expr, heaps) = SwitchGenericInfo (build_object expr heaps) (expr, heaps)
-			with 
-				build_object expr heaps = buildPredefConsApp PD_ConsOBJECT [expr] predefs heaps						
+		#! (expr, heaps) = SwitchGenericInfo (build_object expr predefs heaps) (expr, heaps)
 						
 		#! alg_pattern = {
 			ap_symbol = {glob_module = type_def_mod, glob_object = cons_def_sym},
@@ -902,13 +897,10 @@ where
 		| n == 1 	= (expr, heaps)
 		| i < (n/2) 
 			# (expr, heaps) = build_sum i (n/2) expr predefs heaps
-			= build_left expr heaps
+			= build_left expr predefs heaps
 		| otherwise
 			# (expr, heaps) = build_sum (i - (n/2)) (n - (n/2)) expr predefs heaps
-			= build_right expr heaps
-	where
-		build_left x heaps = buildPredefConsApp PD_ConsLEFT [x] predefs heaps
-		build_right x heaps = buildPredefConsApp PD_ConsRIGHT [x] predefs heaps
+			= build_right expr predefs heaps
 				
 	build_prod :: ![Expression] !PredefinedSymbols !*Heaps -> (!Expression, !*Heaps)
 	build_prod [] predefs heaps = build_unit heaps
@@ -919,9 +911,7 @@ where
 		# (lexprs, rexprs) = splitAt ((length exprs)/2) exprs  
 		# (lexpr, heaps) = build_prod lexprs predefs heaps
 		# (rexpr, heaps) = build_prod rexprs predefs heaps
-		= build_pair lexpr rexpr heaps
-	where
-		build_pair x y heaps = buildPredefConsApp PD_ConsPAIR [x, y] predefs heaps
+		= build_pair lexpr rexpr predefs heaps
 			
 buildConversionFrom	::	
 		!Index				// type def module
@@ -962,13 +952,13 @@ where
 	build_expr_for_type_rhs type_def_mod (AlgType def_symbols) heaps error
 		#! (expr, var, heaps, error) = build_sum False type_def_mod def_symbols heaps error
 		#! (expr, var, heaps) = SwitchGenericInfo 
-			(build_case_object var expr heaps)
+			(build_case_object var expr predefs heaps)
 			(expr, var, heaps)
 		= (expr, var, heaps, error)
 	build_expr_for_type_rhs type_def_mod (RecordType {rt_constructor}) heaps error				
 		# (expr, var, heaps, error) = build_sum True type_def_mod [rt_constructor] heaps	error
 		#! (expr, var, heaps) = SwitchGenericInfo 
-			(build_case_object var expr heaps)
+			(build_case_object var expr predefs heaps)
 			(expr, var, heaps)
 		= (expr, var, heaps, error)
 		
@@ -996,7 +986,7 @@ where
 		#! (cons_app_expr, cons_arg_vars, heaps) = build_cons_app type_def_mod def_symbol heaps
 		#! (prod_expr, var, heaps) = build_prod is_record cons_app_expr cons_arg_vars heaps 
 		#! (alt_expr, var, heaps) = SwitchGenericInfo 
-			(build_case_cons var prod_expr heaps)
+			(build_case_cons var prod_expr predefs heaps)
 			(prod_expr, var, heaps)
 		= (alt_expr, var, heaps, error)
 	build_sum is_record type_def_mod def_symbols heaps error
@@ -1006,7 +996,7 @@ where
 		#! (right_expr, right_var, heaps, error) 
 			= build_sum is_record type_def_mod right_def_syms heaps error	
 		#! (case_expr, var, heaps) = 
-			build_case_either left_var left_expr right_var right_expr heaps
+			build_case_either left_var left_expr right_var right_expr predefs heaps
 		= (case_expr, var, heaps, error)
 	
 	// build expression for products
@@ -1024,15 +1014,15 @@ where
 	build_prod is_record expr [cons_arg_var] heaps
 	
 		#! (arg_expr, var, heaps) = SwitchGenericInfo 
-			(case is_record of True -> build_case_field cons_arg_var expr heaps; False -> (expr, cons_arg_var, heaps))
+			(case is_record of True -> build_case_field cons_arg_var expr predefs heaps; False -> (expr, cons_arg_var, heaps))
 			(expr, cons_arg_var, heaps)
 		
 		= (arg_expr, var, heaps)	
 	build_prod is_record expr cons_arg_vars heaps
 		#! (left_vars, right_vars) = splitAt ((length cons_arg_vars) /2) cons_arg_vars		 
 		#! (expr, left_var, heaps) = build_prod is_record expr left_vars heaps
-		#! (expr, right_var, heaps) = build_prod is_record expr right_vars heaps		
-		#! (case_expr, var, heaps) = build_case_pair left_var right_var expr heaps		
+		#! (expr, right_var, heaps) = build_prod is_record expr right_vars heaps
+		#! (case_expr, var, heaps) = build_case_pair left_var right_var expr predefs heaps
 		= (case_expr, var, heaps) 
 	
 	// build constructor application expression
@@ -1044,53 +1034,66 @@ where
 		#! (expr, heaps) = buildConsApp cons_mod def_symbol var_exprs heaps
 	 	= (expr, vars, heaps)
 
-	// build case expressions for PAIR, EITHER and UNIT
 	build_case_unit body_expr heaps
 		# unit_pat = buildPredefConsPattern PD_ConsUNIT [] body_expr predefs
 		# {pds_module, pds_def} = predefs.[PD_TypeUNIT]
 		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [unit_pat]
 		= build_case_expr case_patterns heaps
-		
-	build_case_pair var1 var2 body_expr heaps
-		# pair_pat = buildPredefConsPattern PD_ConsPAIR [var1, var2] body_expr predefs	
-		# {pds_module, pds_def} = predefs.[PD_TypePAIR]
-		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pair_pat]	
-		= build_case_expr case_patterns heaps
-	
-	build_case_either left_var left_expr right_var right_expr heaps
-		# left_pat = buildPredefConsPattern PD_ConsLEFT [left_var] left_expr predefs
-		# right_pat = buildPredefConsPattern PD_ConsRIGHT [right_var] right_expr predefs
-		# {pds_module, pds_def} = predefs.[PD_TypeEITHER]
-		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [left_pat, right_pat]
-		= build_case_expr case_patterns heaps
 
-	// CONS case
-	build_case_cons var body_expr heaps
-		# pat = buildPredefConsPattern PD_ConsCONS [var] body_expr predefs	
-		# {pds_module, pds_def} = predefs.[PD_TypeCONS]
-		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
-		= build_case_expr case_patterns heaps 
-	
-	// FIELD case
-	build_case_field var body_expr heaps
-		# pat = buildPredefConsPattern PD_ConsFIELD [var] body_expr predefs	
-		# {pds_module, pds_def} = predefs.[PD_TypeFIELD]
-		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
-		= build_case_expr case_patterns heaps 
-	
-	// OBJECT case
-	build_case_object var body_expr heaps
-		# pat = buildPredefConsPattern PD_ConsOBJECT [var] body_expr predefs	
-		# {pds_module, pds_def} = predefs.[PD_TypeOBJECT]
-		# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
-		= build_case_expr case_patterns heaps 
-		
-	// case with a variable as the selector expression
-	build_case_expr case_patterns heaps
-		# (var_expr, var, heaps) = buildVarExpr "c" heaps
-		# (case_expr, heaps) = buildCaseExpr var_expr case_patterns heaps
-		= (case_expr, var, heaps)
-		
+build_pair x y predefs heaps
+	= buildPredefConsApp PD_ConsPAIR [x, y] predefs heaps
+
+build_left x predefs heaps
+	= buildPredefConsApp PD_ConsLEFT [x] predefs heaps
+
+build_right x predefs heaps
+	= buildPredefConsApp PD_ConsRIGHT [x] predefs heaps
+
+build_object expr predefs heaps
+	= buildPredefConsApp PD_ConsOBJECT [expr] predefs heaps						
+
+build_cons expr predefs heaps
+	= buildPredefConsApp PD_ConsCONS [expr] predefs heaps
+
+build_field var_expr predefs heaps
+	= buildPredefConsApp PD_ConsFIELD [var_expr] predefs heaps 
+
+build_case_pair var1 var2 body_expr predefs heaps
+	# pair_pat = buildPredefConsPattern PD_ConsPAIR [var1, var2] body_expr predefs	
+	# {pds_module, pds_def} = predefs.[PD_TypePAIR]
+	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pair_pat]	
+	= build_case_expr case_patterns heaps
+
+build_case_either left_var left_expr right_var right_expr predefs heaps
+	# left_pat = buildPredefConsPattern PD_ConsLEFT [left_var] left_expr predefs
+	# right_pat = buildPredefConsPattern PD_ConsRIGHT [right_var] right_expr predefs
+	# {pds_module, pds_def} = predefs.[PD_TypeEITHER]
+	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [left_pat, right_pat]
+	= build_case_expr case_patterns heaps
+
+build_case_object var body_expr predefs heaps
+	# pat = buildPredefConsPattern PD_ConsOBJECT [var] body_expr predefs	
+	# {pds_module, pds_def} = predefs.[PD_TypeOBJECT]
+	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
+	= build_case_expr case_patterns heaps
+
+build_case_cons var body_expr predefs heaps
+	# pat = buildPredefConsPattern PD_ConsCONS [var] body_expr predefs	
+	# {pds_module, pds_def} = predefs.[PD_TypeCONS]
+	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
+	= build_case_expr case_patterns heaps 
+
+build_case_field var body_expr predefs heaps
+	# pat = buildPredefConsPattern PD_ConsFIELD [var] body_expr predefs	
+	# {pds_module, pds_def} = predefs.[PD_TypeFIELD]
+	# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
+	= build_case_expr case_patterns heaps 
+
+// case with a variable as the selector expression
+build_case_expr case_patterns heaps
+	# (var_expr, var, heaps) = buildVarExpr "c" heaps
+	# (case_expr, heaps) = buildCaseExpr var_expr case_patterns heaps
+	= (case_expr, var, heaps)
 
 //****************************************************************************************
 // build kind indexed classes 
@@ -1558,7 +1561,7 @@ where
 			= update_dcl_function fun_index gencase fun_type dcl_functions heaps
 
 		#! (fun_info, fun_defs, td_infos, modules, heaps, error) 
-				= update_icl_function_if_needed 
+				= update_icl_function_if_needed
 						module_index 
 						fun_index gencase fun_type 
 						fun_info fun_defs td_infos modules heaps error
@@ -3546,11 +3549,23 @@ zipWith f [] [] = []
 zipWith f [x:xs] [y:ys] = [f x y : zipWith f xs ys]
 zipWith f _ _ = abort "zipWith: lists of different length\n"
 
-zipWithSt f [] [] st 
-	= ([], st)
-zipWithSt f [x:xs] [y:ys] st
-	# (z, st) = f x y st
-	# (zs, st) = zipWithSt f xs ys st
-	= ([z:zs], st) 
-zipWithSt f _ _ st = abort "zipWithSt: lists of different length\n"
-	
\ No newline at end of file
+zipWithSt f l1 l2 st
+	:== zipWithSt l1 l2 st
+where
+	zipWithSt [] [] st 
+		= ([], st)
+	zipWithSt [x:xs] [y:ys] st
+		# (z, st) = f x y st
+		# (zs, st) = zipWithSt xs ys st
+		= ([z:zs], st) 
+
+mapSdSt f l sd s :== map_sd_st l s
+where
+	map_sd_st [x : xs] s
+	 	# (x, s) = f x sd s
+		  (xs, s) = map_sd_st xs s
+		#! s = s
+		= ([x : xs], s)
+	map_sd_st [] s
+		#! s = s
+	 	= ([], s)