view kernel.rhope @ 71:c40c3d399133

Add Int32@String and Get Char. Fix stack bug
author Mike Pavone <pavone@retrodev.com>
date Fri, 18 Jun 2010 15:07:09 -0400
parents d0ce696786cc
children a844c623c7df
line wrap: on
line source


Val[in:out]
{
	out <- in
}

Blueprint Boolean
{
	Val(Int32,Naked)
}

/*
Blueprint Blueprint
{
	Val(Blueprint,Naked)
}*/

Blueprint Int64
{
	Num(Int64,Naked)
}

If@Int64[num:yes,no]
{
	yes,no <- If[[num]!=[0i64]]
}

Blueprint Int32
{
	Num(Int32,Naked)
}

If@Int32[num:yes,no]
{
	yes,no <- If[[num]!=[0i32]]
}

Foreign C:libc
{
	write[filedes(Int32,Naked),buf(Array,Raw Pointer),nbyte(Int64,Naked):written(Int32,Naked)]
	read[filedes(Int32,Naked),buf(Array,Raw Pointer,Mutable),nbyte(Int64,Naked):read(Int64,Naked),buf]
}

_Print Int32[n,buf:out]
{
	If[[n] < [10i32]]
	{
		byte <- [[n]Trunc Int8] + [48i8]
		out <- [buf]Append[byte]
	}{
		next <- [n]/[10i32]
		
		byte <- [[[n]-[[next]*[10i32]]]Trunc Int8] + [48i8]
		out <- [_Print Int32[next, buf]]Append[byte]
	}
}

Print@Int32[n:out]
{
	If[[n] < [0i32]]
	{
		val <- [0i32]-[n]
		buf <- [Array[]]Append[45i8]
	}{
		val <- Val[n]
		buf <- Array[]
	}
	fbuf <- [_Print Int32[val, buf]]Append[10i8]
	out <- write[1i32, fbuf, Int64[[fbuf]Length >>]]
}

Blueprint Int16
{
	Num(Int16,Naked)
}

If@Int16[num:yes,no]
{
	yes,no <- If[[num]!=[0i16]]
}

Blueprint Int8
{
	Num(Int8,Naked)
}

If@Int8[num:yes,no]
{
	yes,no <- If[[num]!=[0i8]]
}

Blueprint UInt64
{
	Num(UInt64,Naked)
}

If@UInt64[num:yes,no]
{
	yes,no <- If[[num]!=[0u64]]
}

Blueprint UInt32
{
	Num(UInt32,Naked)
}

If@UInt32[num:yes,no]
{
	yes,no <- If[[num]!=[0u32]]
}

Blueprint UInt16
{
	Num(UInt16,Naked)
}

If@UInt16[num:yes,no]
{
	yes,no <- If[[num]!=[0u16]]
}

Blueprint UInt8
{
	Num(UInt8,Naked)
}

If@UInt8[num:yes,no]
{
	yes,no <- If[[num]!=[0u8]]
}


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)]
}

=@Blueprint[left,right:out]
{
	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 >>]
				[array]First
				{
					copied <- _Copy to Boxed[farray, boxed, ~]
				}{
					//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]
		}
	}
}