view kernel.rhope @ 75:0083b2f7b3c7

Partially working implementation of List. Modified build scripts to allow use of other compilers. Fixed some bugs involving method implementations on different types returning different numbers of outputs. Added Fold to the 'builtins' in the comipler.
author Mike Pavone <pavone@retrodev.com>
date Tue, 06 Jul 2010 07:52:59 -0400
parents a844c623c7df
children 4d5ea487f810
line wrap: on
line source

Import string.rhope
Import list.rhope
Import functional.rhope

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)]
	_internal_worker_alloc[size(Int16,Naked):out(Worker)]
	_internal_worker_setinput[worker(Worker,Boxed,Mutable),num(Int16,Naked),val:worker]
	_internal_worker_getinput[worker(Worker),num(Int16,Naked):out]
	_internal_worker_hasinput[worker(Worker),num(Int16,Naked):out(Int32,Naked)]
}

Blueprint Worker
{
	Index(Int32,Naked)
	Size(Int16,Naked)
	Count(Int16,Naked)
}

Get Input@Worker[worker(Worker),bindex(Int32):val,not populated]
{
	index <- [bindex]Trunc Int16
	,not populated <- If[_internal_worker_hasinput[worker,index]]
	{
		val <- _internal_worker_getinput[worker,index]
	}
}

_Copy Params[source(Worker),dest(Worker),cur(Int16):out(Worker)]
{
	If[[cur]<[[source]Size >>]]
	{
		[source]Get Input[cur]
		{
			next <- _internal_worker_setinput[dest, cur, ~]
		}{
			next <- Val[dest]
		}
		out <- _Copy Params[source, next, [cur]+[1i16]]
	}{
		out <- dest
	}
}

Set Input@Worker[worker(Worker),bindex(Int32),val:out(Worker)]
{
	index <- [bindex]Trunc Int16
	If[[index] < [[worker]Size >>]]
	{
		set <- _internal_worker_setinput[worker, index, val]
	}{
		set <- _internal_worker_setinput[
			_Copy Params[worker, 
				[ _internal_worker_alloc[[index]+[1i16]] ]Index <<[[worker]Index >>]
				, 0i16]
			, index, val]
	}
	out <- [set]Count <<[ [[set]Count >>]+[1i16] ]
}

=@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]
		}
	}
}

Length@Array[arr:out]
{
	out <- [arr]Length >>
}

Call@Array[arr(Array),index(Int32):out]
{
	out <- [arr]Index[index]
}

And[left,right:out]
{
	,out <- If[left]
	{
		out,out <- If[right]
	}
}

Or[left,right:out]
{
	out <- If[left] {}
	{
		out <- right
	}
}