Mercurial > repos > rhope

changeset 96:5a08705f7610

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Semi-broken cleanup of Array implementation
author Mike Pavone <pavone@retrodev.com>
date Mon, 02 Aug 2010 05:12:19 -0400
parents f4fd8962c385
children fa437d23bb24
files cbackend.rhope cbackend_c.rhope kernel.rhope list.rhope runtime/array.c runtime/array.h runtime/builtin.h testc_c.rhope
diffstat 8 files changed, 92 insertions(+), 252 deletions(-) [+]
line wrap: on
line diff
--- a/cbackend.rhope	Mon Aug 02 01:55:56 2010 -0400
+++ b/cbackend.rhope	Mon Aug 02 05:12:19 2010 -0400
@@ -249,7 +249,7 @@
 		{
 			out <- ""	
 		}{
-			[("Array","Worker")]Find[[ctype]Name >>]
+			[("Array","Boxed Array","Worker")]Find[[ctype]Name >>]
 			{ oend <- "\nMObject(" }
 			{ oend <- "\nObject(" } 
 			out <- [Fold["_Type Def C Type", "OBegin", [ctype]Fields >>]]Append[ [[oend]Append[Escape Rhope Name[[ctype]Name >>]]]Append[")"] ]
@@ -271,7 +271,7 @@
 
 Type Init@C Type[ctype,id,method reg,field reg:out]
 {
-	[("Array","Worker")]Find[[ctype]Name >>]
+	[("Array","Boxed Array", "Worker")]Find[[ctype]Name >>]
 	{ size <- "-1" }
 	{ 
 		[("Int64","Int32","Int16","Int8")]Find[[ctype]Name >>]
@@ -321,7 +321,7 @@
 C Type Registry[:out]
 {
 	out <- [[[Build["C Type Registry"]]Lookup << [
-			[[[[[[[[[[[[[[[[[[Dictionary[]
+			[[[[[[[[[[[[[[[[[[[Dictionary[]
 			]Set["UInt8", "TYPE_UINT8"]			//1
 			]Set["UInt16", "TYPE_UINT16"]		//2
 			]Set["UInt32", "TYPE_UINT32"]		//3
@@ -336,10 +336,11 @@
 			]Set["Real Number", "TYPE_FLOAT64"]	//12
 			]Set["Blueprint", "TYPE_BLUEPRINT"]	//13
 			]Set["Array", "TYPE_ARRAY"]			//14
-			]Set["Worker", "TYPE_WORKER"]		//15
-			]Set["Method Missing Exception", "TYPE_METHODMISSINGEXCEPTION"]	//16
-			]Set["Field Missing Exception", "TYPE_FIELDMISSINGEXCEPTION"]	//17
-			]Set["Wrong Type Exception", "TYPE_WRONGTYPEEXCEPTION"]]		//18
+			]Set["Boxed Array", "TYPE_BOXEDARRAY"]//15
+			]Set["Worker", "TYPE_WORKER"]		//16
+			]Set["Method Missing Exception", "TYPE_METHODMISSINGEXCEPTION"]	//17
+			]Set["Field Missing Exception", "TYPE_FIELDMISSINGEXCEPTION"]	//18
+			]Set["Wrong Type Exception", "TYPE_WRONGTYPEEXCEPTION"]]		//19
 		]Definitions << [Dictionary[]]
 		]Next ID <<[0]
 }
--- a/cbackend_c.rhope	Mon Aug 02 01:55:56 2010 -0400
+++ b/cbackend_c.rhope	Mon Aug 02 05:12:19 2010 -0400
@@ -236,7 +236,7 @@
 		{
 			out <- ""	
 		}{
-			[("Array","Worker")]Find[=[[ctype]Name >>,?]]
+			[("Array","Boxed Array","Worker")]Find[=[[ctype]Name >>,?]]
 			{ oend <- "\nMObject(" }
 			{ oend <- "\nObject(" } 
 			out <- [Fold[_Type Def C Type[?], "OBegin", [ctype]Fields >>]]Append[ [[oend]Append[Escape Rhope Name[[ctype]Name >>]]]Append[")"] ]
@@ -258,7 +258,7 @@
 
 Type Init@C Type[ctype,id,method reg,field reg:out]
 {
-	[("Array","Worker")]Find[=[[ctype]Name >>, ?]]
+	[("Array","Boxed Array", "Worker")]Find[=[[ctype]Name >>, ?]]
 	{ size <- "-1" }
 	{ 
 		[("Int64","Int32","Int16","Int8")]Find[=[[ctype]Name >>, ?]]
@@ -308,7 +308,7 @@
 C Type Registry[:out]
 {
 	out <- [[[Build[C Type Registry()]]Lookup << [
-			[[[[[[[[[[[[[[[[[[Dictionary[]
+			[[[[[[[[[[[[[[[[[[[Dictionary[]
 			]Set["UInt8", "TYPE_UINT8"]			//1
 			]Set["UInt16", "TYPE_UINT16"]		//2
 			]Set["UInt32", "TYPE_UINT32"]		//3
@@ -323,10 +323,11 @@
 			]Set["Real Number", "TYPE_FLOAT64"]	//12
 			]Set["Blueprint", "TYPE_BLUEPRINT"]	//13
 			]Set["Array", "TYPE_ARRAY"]			//14
-			]Set["Worker", "TYPE_WORKER"]		//15
-			]Set["Method Missing Exception", "TYPE_METHODMISSINGEXCEPTION"]	//16
-			]Set["Field Missing Exception", "TYPE_FIELDMISSINGEXCEPTION"]	//17
-			]Set["Wrong Type Exception", "TYPE_WRONGTYPEEXCEPTION"]]		//18
+			]Set["Boxed Array", "TYPE_BOXEDARRAY"]//15
+			]Set["Worker", "TYPE_WORKER"]		//16
+			]Set["Method Missing Exception", "TYPE_METHODMISSINGEXCEPTION"]	//17
+			]Set["Field Missing Exception", "TYPE_FIELDMISSINGEXCEPTION"]	//18
+			]Set["Wrong Type Exception", "TYPE_WRONGTYPEEXCEPTION"]]		//19
 		]Definitions << [Dictionary[]]
 		]Next ID <<[0]
 }
--- a/kernel.rhope	Mon Aug 02 01:55:56 2010 -0400
+++ b/kernel.rhope	Mon Aug 02 05:12:19 2010 -0400
@@ -1,3 +1,4 @@
+Import array.rhope
 Import string.rhope
 Import list.rhope
 Import functional.rhope
@@ -188,22 +189,8 @@
 	out <- [a]-[[[a]/[b]]*[b]]
 }
 
-
-Blueprint Array
-{
-	Eltype(Blueprint)
-	Length(Int32,Naked)
-	Storage(Int32,Naked)
-}
-
 Foreign C:runtime
 {
-	_internal_array_copyout[array(Array), index(Int32,Naked), dest(Any Type,Boxed,Mutable):dest]
-	_internal_array_copyin[array(Array,Boxed,Mutable), index(Int32,Naked), val:array]
-	_internal_array_getboxed[array(Array), index(Int32,Naked):out]
-	_internal_array_setboxed[array(Array,Boxed,Mutable), index(Int32,Naked), val:array]
-	_internal_array_allocboxed[size(Int32,Naked):out(Array)]
-	_internal_array_allocnaked[size(Int32,Naked),type(Blueprint):out(Array)]
 	_internal_blueprint_eq[left(Blueprint),right(Blueprint):out(Int32,Naked)]
 	_internal_worker_alloc[size(Int16,Naked):out(Worker)]
 	_internal_worker_setinput[worker(Worker,Boxed,Mutable),num(Int16,Naked),val:worker]
@@ -264,206 +251,6 @@
 	out <- [_internal_blueprint_eq[left,right]]!=[0]
 }
 
-Array[:out(Array)]
-{
-	out <- [[_internal_array_allocboxed[0]
-	]Length <<[0]
-	]Storage <<[0]
-}
-
-First@Array[array:out(Int32),empty]
-{
-	,empty <- If[[array]Length >>]
-	{ out <- 0 }
-}
-
-Next@Array[array,current:out(Int32),empty]
-{
-	next <- [current]+[1]
-	,empty <- If[[next] < [[array]Length >>]]
-	{
-		out <- Val[next]
-	}
-}
-
-Last@Array[array:out(Int32),empty]
-{
-	,empty <- If[[array]Length >>]
-	{ out <-  [[array]Length >>] - [1] }
-}
-
-Append@Array[array,newval:out(Array)]
-{
-	out <- [array]Set[[array]Length >>, newval]
-}
-
-Index@Array[array,index(Int32):out,notfound]
-{
-	,notfound <- If[[index] >= [0]]
-	{
-		,notfound <- If[[index] < [[array]Length >>]]
-		{
-			eltype <- [array]Eltype >>
-			If[[eltype] = [Any Type()]]
-			{
-				out <- _internal_array_getboxed[array, index]
-			}{
-				out <- _internal_array_copyout[array, index, Build[eltype]]
-			}
-		}
-	}	
-}
-
-_Copy to Boxed[source,dest,current:out]
-{
-	ndest <- _internal_array_setboxed[dest, current, [source]Index[current]]
-	
-	[source]Next[current]
-	{
-		out <- _Copy to Boxed[source, ndest, ~]
-	}{
-		out <- Val[ndest]
-	}
-}
-
-_Copy Naked[source,dest,current:out]
-{
-	ndest <- _internal_array_copyin[dest, current, [source]Index[current]]
-	
-	[source]Next[current]
-	{
-		out <- _Copy Naked[source, ndest, ~]
-	}{
-		out <- Val[ndest]
-	}
-}
-
-Set@Array[array,index(Int32),val:out(Array)]
-{
-	If[[index] < [[array]Storage >>]]
-	{
-		If[[index] > [[array]Length >>]]
-		{
-			farray <- [[array]Set[[index]-[1], val]]Length <<[ [index]+[1] ]
-		}{
-			If[[index] = [[array]Length >>]]
-			{
-				farray <- [array]Length <<[ [index]+[1] ]
-			}{
-				farray <- Val[array]
-			}
-		}
-		eltype <- [array]Eltype >>
-		If[[eltype] = [Any Type()]]
-		{
-			out <- _internal_array_setboxed[farray, index, val]
-		}{
-			If[[Blueprint Of[val]] = [eltype]]
-			{
-				out <- _internal_array_copyin[farray, index, val]
-			}{
-				boxed <- _internal_array_allocboxed[[farray]Storage >>]
-				[farray]First
-				{
-					copied <- [_Copy to Boxed[farray, boxed, ~]]Length <<[ [farray]Length >> ]
-				}{
-					Print["Uh oh, no First on Naked Array!"]
-					//I don't think this case should happen normally
-					copied <- Val[boxed]
-				}
-				out <- _internal_array_setboxed[copied, index, val]
-			}
-		}
-	}{
-		If[[array]Length >>]
-		{
-			If[[index] < [4]]
-			{
-				new storage <- [index]+[index]
-			}{
-				new storage <- [index]+[[index]RShift[1]]
-			}
-			 
-			do boxed <- If[[[array]Eltype >>] = [Any Type()]]
-			{
-				copied <- _Copy to Boxed[array, _internal_array_allocboxed[new storage], 0]
-			}{	
-				bp <- Blueprint Of[val]
-				If[[[array]Eltype >>] = [bp]]
-				{
-					copied <- _Copy Naked[array, _internal_array_allocnaked[new storage, bp], 0]
-				}{
-					copied <- _Copy to Boxed[array, _internal_array_allocboxed[new storage], 0]
-				}
-			}
-			out <- [[copied]Length <<[[array]Length >>]]Set[index,val]
-		}{
-			len <- [index]+[1]
-			out <- [_internal_array_allocnaked[len, Blueprint Of[val]]
-			]Set[index,val]
-		}
-	}
-}
-
-Length@Array[arr:out]
-{
-	out <- [arr]Length >>
-}
-
-Call@Array[arr(Array),index(Int32):out]
-{
-	out <- [arr]Index[index]
-}
-
-_Copy Part Naked[source,dest,srcindex,destindex:out]
-{
-	ndest <- _internal_array_copyin[dest, destindex, [source]Index[srcindex]]
-	
-	[source]Next[srcindex]
-	{
-		out <- _Copy Part Naked[source, ndest, ~, [destindex]+[1]]
-	}{
-		out <- Val[ndest]
-	}
-}
-
-_Copy Part Boxed[source,dest,srcindex,destindex:out]
-{
-	ndest <- _internal_array_setboxed[dest, destindex, [source]Index[srcindex]]
-	
-	[source]Next[srcindex]
-	{
-		out <- _Copy Part Boxed[source, ndest, ~, [destindex]+[1]]
-	}{
-		out <- Val[ndest]
-	}
-}
-
-Slice@Array[arr,slicepoint(Int32):left,right]
-{
-	If[[slicepoint]<[[arr]Length]]
-	{
-		If[[slicepoint]>[0i32]]
-		{
-			eltype <- [arr]Eltype >>
-			If[[eltype] = [Any Type()]]
-			{
-				_Copy Part Boxed[arr, _internal_array_allocboxed[[[arr]Length]-[slicepoint]], slicepoint, 0]
-			}{
-				_Copy Part Naked[arr, _internal_array_allocnaked[[[arr]Length]-[slicepoint], eltype], slicepoint, 0]
-			}
-			left <- [arr]Length <<[slicepoint]
-		}{
-			right <- arr
-			left <- Array[]
-		}
-	}{
-		left <- arr
-		right <- Array[]
-	}
-	
-}
-
 And[left,right:out]
 {
 	,out <- If[left]
--- a/list.rhope	Mon Aug 02 01:55:56 2010 -0400
+++ b/list.rhope	Mon Aug 02 05:12:19 2010 -0400
@@ -13,14 +13,14 @@
 {
 	If[[index] < [0]]
 	{
-		rev index <- [[[list]Buffer >>]Length >>]+[index]
+		rev index <- [[[list]Buffer >>]Length]+[index]
 		invalid index <- If[[rev index] < [0]] {}
 		{
 			out,invalid index <- [list]Set[rev index, value]
 		}
 			
 	}{
-		len <- [[list]Buffer >>]Length >>
+		len <- [[list]Buffer >>]Length
 		If[[index] > [len]]
 		{
 			makeleft <- Yes
@@ -48,7 +48,7 @@
 
 _Right Set@List Leaf[list,index,val:out,didn't set]
 {
-	len <- [[list]Buffer >>]Length >>
+	len <- [[list]Buffer >>]Length
 	do it <- If[[index] < [len]] {}
 	{
 		,didn't set <- If[[index]=[len]]
@@ -64,12 +64,12 @@
 
 Length@List Leaf[list:out]
 {
-	out <- [[list]Buffer >>]Length >>
+	out <- [[list]Buffer >>]Length
 }
 
 Last@List Leaf[list:out,none]
 {
-	len <- [[list]Buffer >>]Length >>
+	len <- [[list]Buffer >>]Length
 	,none <-If[len]
 	{
 		out <- [len]-[1]
@@ -158,7 +158,7 @@
 			If[[index]<[[list]Right Offset >>]]
 			{
 				off index <- [index]-[[list]Offset >>]
-				bsize <- [[list]Buffer >>]Length >>
+				bsize <- [[list]Buffer >>]Length
 				If[[off index]>[bsize]]
 				{
 					If[[[list]Right >>]Length]
@@ -232,7 +232,7 @@
 {
 	[[list]Right >>]Last 
 	{ out <- [~]+[[list]Right Offset >>] }
-	{ out <- [[[[list]Buffer >>]Length >>]-[1]]+[[list]Offset >>] }
+	{ out <- [[[[list]Buffer >>]Length]-[1]]+[[list]Offset >>] }
 }
 
 Append@List[list,val:out]
@@ -263,7 +263,7 @@
 		If[[index] < [[list]Right Offset >>]]
 		{
 			pos next <- [index]+[1]
-			If[[pos next] < [[[[list]Buffer >>]Length >>]+[[list]Offset >>]]]
+			If[[pos next] < [[[[list]Buffer >>]Length]+[[list]Offset >>]]]
 			{
 				next <- Val[pos next]
 			}{
--- a/runtime/array.c	Mon Aug 02 01:55:56 2010 -0400
+++ b/runtime/array.c	Mon Aug 02 05:12:19 2010 -0400
@@ -18,7 +18,7 @@
 object * _internal_array_getboxed(object * array, int32_t index)
 {
 	object * ret;
-	object ** intarr = (object **)(((char *) array) + sizeof(t_Array));
+	object ** intarr = (object **)(((char *) array) + sizeof(t_BoxedSP_Array));
 	ret = add_ref(intarr[index]);
 	release_ref(array);
 	return ret;
@@ -26,16 +26,33 @@
 
 void _internal_array_setboxed(object *array, int32_t index, object * val)
 {
-	object ** intarr = (object **)(((char *) array) + sizeof(t_Array));
+	object ** intarr = (object **)(((char *) array) + sizeof(t_BoxedSP_Array));
 	intarr[index] = val;
 }
 
 object *_internal_array_allocboxed(int32_t size)
 {
-	t_Array * ret = (t_Array *)new_multisize(TYPE_ARRAY, sizeof(nt_Array)+sizeof(object *)*size);
+	t_BoxedSP_Array * ret = (t_BoxedSP_Array *)new_multisize(TYPE_BOXEDARRAY, sizeof(nt_BoxedSP_Array)+sizeof(object *)*size);
 	ret->payload.Length = 0;
 	ret->payload.Storage = size;
-	ret->payload.Eltype = (t_Blueprint *)make_Blueprint(0);
+	
+	return (object *)ret;
+}
+
+object *_internal_array_allocboxedcopy(object * osource, int32_t size)
+{
+	int32_t tocopy,idx;
+	object **srcarr, **destarr;
+	t_BoxedSP_Array * source = (t_BoxedSP_Array *)osource;
+	t_BoxedSP_Array * ret = (t_BoxedSP_Array *)new_multisize(TYPE_BOXEDARRAY, sizeof(nt_BoxedSP_Array)+sizeof(object *)*size);
+	ret->payload.Length = 0;
+	ret->payload.Storage = size;
+	tocopy = size < source->payload.Length ? size : source->payload.Length;
+	srcarr = (object **)(source+1);
+	destarr = (object **)(ret+1);
+	for(idx = 0; idx < tocopy; ++idx)
+		destarr[idx] = srcarr[idx];
+	release_ref(osource);
 	
 	return (object *)ret;
 }
@@ -45,6 +62,7 @@
 	t_Array * ret;
 	t_Blueprint * bp = (t_Blueprint *)type;
 	if (bp->bp->size < 0) {
+		release_ref(type);
 		return _internal_array_allocboxed(size);
 	}	
 	ret = (t_Array *)new_multisize(TYPE_ARRAY, sizeof(nt_Array)+bp->bp->size*size);
@@ -52,6 +70,37 @@
 	ret->payload.Storage = size;
 	ret->payload.Eltype = bp;
 	
-	return ret;
+	return (object *)ret;
 }
 
+object * _internal_array_allocnakedcopy(object * osource, int32_t size)
+{
+	int32_t tocopy,idx;
+	object *cur;
+	t_Array * ret, *source = (t_Array *)osource;
+	t_Blueprint * bp = source->payload.Eltype;
+	
+	ret = (t_Array *)new_multisize(TYPE_ARRAY, sizeof(nt_Array)+bp->bp->size*size);
+	ret->payload.Length = 0;
+	ret->payload.Storage = size;
+	add_ref((object *)bp);
+	ret->payload.Eltype = bp;
+	tocopy = size < source->payload.Length ? size : source->payload.Length;
+
+	memcpy(ret+1, source+1, tocopy*bp->bp->size);
+	//Lower type IDs don't have any reference params so we can safely skip this for those
+	if(bp->bp->type_id >= TYPE_ARRAY)
+	{
+		//Ugly hack
+		cur = ((char *)(ret+1))-sizeof(object) ;
+		for(idx=0; idx < tocopy; ++idx)
+		{
+			bp->bp->copy((object *)cur);
+			cur += bp->bp->size;
+		}
+	}
+	release_ref(osource);
+	
+	return (object *)ret;
+}
+
--- a/runtime/array.h	Mon Aug 02 01:55:56 2010 -0400
+++ b/runtime/array.h	Mon Aug 02 05:12:19 2010 -0400
@@ -5,12 +5,14 @@
 #include "func.h"
 #include "builtin.h"	
 
-void _internal_array_copyout(object * array, int32_t index, object * dest);
-void _internal_array_copyin(object * array, int32_t index, object * val);
-object * _internal_array_getboxed(object * array, int32_t index);
-void _internal_array_setboxed(object *, int32_t index, object * val);
-object *_internal_array_allocboxed(int32_t size);
+void _internal_array_copyout(object * array, int32_t index, object * dest);
+void _internal_array_copyin(object * array, int32_t index, object * val);
+object * _internal_array_getboxed(object * array, int32_t index);
+void _internal_array_setboxed(object *, int32_t index, object * val);
+object *_internal_array_allocboxed(int32_t size);
+object *_internal_array_allocboxedcopy(object * osource, int32_t size);
 object * _internal_array_allocnaked(int32_t size , object * type);
+object * _internal_array_allocnakedcopy(object * osource, int32_t size);
 
 
-#endif //_ARRAY_H_
+#endif //_ARRAY_H_
--- a/runtime/builtin.h	Mon Aug 02 01:55:56 2010 -0400
+++ b/runtime/builtin.h	Mon Aug 02 05:12:19 2010 -0400
@@ -19,7 +19,8 @@
 	TYPE_FLOAT32,
 	TYPE_FLOAT64,
 	TYPE_BLUEPRINT,
-	TYPE_ARRAY,
+	TYPE_ARRAY,
+	TYPE_BOXEDARRAY,
 	TYPE_WORKER,
 	TYPE_METHODMISSINGEXCEPTION,
 	TYPE_FIELDMISSINGEXCEPTION,
--- a/testc_c.rhope	Mon Aug 02 01:55:56 2010 -0400
+++ b/testc_c.rhope	Mon Aug 02 05:12:19 2010 -0400
@@ -78,11 +78,10 @@
 	]Call["Fib", [()]Append[Constant["const_30"]]]
 	]Move[Result[0], "out"]
 
-	Print[
-		[[[prog]Store Function[func]
+	text <- [[[prog]Store Function[func]
 		]Store Function[main]
 		]Text
-	]
-		
+	Print[[text]Length]
+	{ Print[text] }
 }