replace uniqueCopy with copyCoercions

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

6 files changed, 75 insertions, 13 deletions

diff --git a/frontend/_aconcat.dcl b/frontend/_aconcat.dcl
index f95aab7..316f284 100644
--- a/frontend/_aconcat.dcl
+++ b/frontend/_aconcat.dcl
@@ -2,6 +2,7 @@ definition module _aconcat
 
 import StdArray,StdInt,StdEnum,StdList
 
+
 arrayConcat a1 a2
 	:==r2
 where
@@ -36,7 +37,7 @@ where
 	r2={r1 & [sr-i]=e \\ i<-[1..s2] & e<-l}
 	r1={r0 & [i]=a.[i] \\ i<-[0..s1-1]}
 /*2.0
-	r0=_createArray sr	// 2.0
+	r0=_createArray sr
 0.2*/
 //1.3
 	r0=_createArrayc sr
@@ -60,8 +61,30 @@ where
 			= copy_elements a1 {a2 & [i]=e} (i+1)
 			= (a2,a1)
 
-arrayCopy a s
+arrayCopy a
 	:== arrayCopyBegin a1 s
 	where
 		(s, a1)
 			=	usize a
+
+arrayAndElementsCopy place_holder copy_element_function array
+/*2.0
+	:== copy place_holder array1 (_createArray n) 0 n
+0.2*/
+//1.3
+	:== copy place_holder array1 (_createArrayc n) 0 n
+//3.1
+	where
+		(n, array1)
+			=	usize array
+		copy place_holder array array_copy i n
+			| i == n
+				=	(array_copy, array)
+			// otherwise
+				# (element, array)
+					=	replace array i place_holder
+				# (copy_element, element)
+					=	copy_element_function element
+				# (place_holder, array)
+					=	replace array i element
+				=	copy place_holder array {array_copy & [i] = copy_element} (i+1) n
diff --git a/frontend/_aconcat.icl b/frontend/_aconcat.icl
index cf6abc1..8259980 100644
--- a/frontend/_aconcat.icl
+++ b/frontend/_aconcat.icl
@@ -36,7 +36,7 @@ where
 	r2={r1 & [sr-i]=e \\ i<-[1..s2] & e<-l}
 	r1={r0 & [i]=a.[i] \\ i<-[0..s1-1]}
 /*2.0
-	r0=_createArray sr	// 2.0
+	r0=_createArray sr
 0.2*/
 //1.3
 	r0=_createArrayc sr
@@ -59,8 +59,31 @@ where
 			# (e,a1) = a1![i]
 			= copy_elements a1 {a2 & [i]=e} (i+1)
 			= (a2,a1)
-arrayCopy a s
+
+arrayCopy a
 	:== arrayCopyBegin a1 s
 	where
 		(s, a1)
 			=	usize a
+
+arrayAndElementsCopy place_holder copy_element_function array
+/*2.0
+	:== copy place_holder array1 (_createArray n) 0 n
+0.2*/
+//1.3
+	:== copy place_holder array1 (_createArrayc n) 0 n
+//3.1
+	where
+		(n, array1)
+			=	usize array
+		copy place_holder array array_copy i n
+			| i == n
+				=	(array_copy, array)
+			// otherwise
+				# (element, array)
+					=	replace array i place_holder
+				# (copy_element, element)
+					=	copy_element_function element
+				# (place_holder, array)
+					=	replace array i element
+				=	copy place_holder array {array_copy & [i] = copy_element} (i+1) n
diff --git a/frontend/type.icl b/frontend/type.icl
index 9c281dc..f48142c 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -2225,7 +2225,7 @@ where
 					# (error=:{ea_file})
 							= errorHeading "Uniqueness error" error
 					  (coercion_env, copy_coercion_env)
-					  		= uniqueCopy coercion_env
+					  		= copyCoercions coercion_env
 					  format
 					  		= { form_properties = cMarkAttribute,
 					  			form_attr_position = Yes (reverse positions, copy_coercion_env) }			
@@ -2488,13 +2488,6 @@ where
 			CheckedType _
 				-> ts
 
-uniqueCopy :: !*a -> (!*a, !*a)
-uniqueCopy x =
-	code
-	{	.inline uniqueCopy
-			push_a 0
-		.end
-	}
 is_rare_name {id_name}
 	= id_name.[0]=='_'
 
diff --git a/frontend/unitype.dcl b/frontend/unitype.dcl
index 5b7e0ff..4b2dee4 100644
--- a/frontend/unitype.dcl
+++ b/frontend/unitype.dcl
@@ -67,3 +67,5 @@ class expandType a :: !{# CommonDefs } !{# BOOLVECT } !a !*(!u:{! Type}, !*Expan
 instance expandType AType
 
 checkExistentionalAttributeVars :: [TempAttrId] !AttributePartition !*{! CoercionTree} -> (!Bool,!*{! CoercionTree})
+
+copyCoercions :: *Coercions -> (*Coercions, *Coercions)
diff --git a/frontend/unitype.icl b/frontend/unitype.icl
index 72f239c..ca83155 100644
--- a/frontend/unitype.icl
+++ b/frontend/unitype.icl
@@ -928,3 +928,25 @@ where
 		= ok_coercions
 	check_demanded_attribute_vars av_group_nr _ partition (ok, coercions)
 		= (False, coercions)
+
+copyCoercions :: *Coercions -> (*Coercions, *Coercions)
+copyCoercions coercions=:{coer_demanded, coer_offered}
+	# (coer_demanded_copy, coer_demanded) = copy_coercion_trees coer_demanded
+	# (coer_offered_copy, coer_offered) = copy_coercion_trees coer_offered
+	= ({coercions & coer_demanded = coer_demanded, coer_offered = coer_offered}, {coercions & coer_demanded = coer_demanded_copy, coer_offered = coer_offered_copy})
+where
+	copy_coercion_trees trees
+		= arrayAndElementsCopy CT_Empty copy_coercion_tree trees
+
+	copy_coercion_tree (CT_Node attr left right)
+		# (copy_left, left) = copy_coercion_tree left
+		# (copy_right, right) = copy_coercion_tree right
+		= (CT_Node attr copy_left copy_right, CT_Node attr left right)
+	copy_coercion_tree tree=:CT_Empty
+		= (CT_Empty, tree)
+	copy_coercion_tree tree=:CT_Unique
+		= (CT_Unique, tree)
+	copy_coercion_tree tree=:CT_NonUnique
+		= (CT_NonUnique, tree)
+	copy_coercion_tree tree=:CT_Existential
+		= (CT_Existential, tree)
diff --git a/frontend/utilities.icl b/frontend/utilities.icl
index 36cf15b..22e0b70 100644
--- a/frontend/utilities.icl
+++ b/frontend/utilities.icl
@@ -4,7 +4,6 @@ implementation module utilities
 import	StdEnv, general
 
 from _aconcat import arrayConcat
-    
 
 /*
 		Utility routines.