197 lines
5.1 KiB
Text
197 lines
5.1 KiB
Text
|
{
|
|||
|
/*
|
|||
|
* Integer Operations
|
|||
|
*/
|
|||
|
let int-sign = λx:ℤ~machine.Int64 ↦ bit-and (bit-shr x 63) 1;
|
|||
|
let int-neg = λx:ℤ~machine.Int64 ↦ i+ (bit-neg x) 1;
|
|||
|
let int-abs = λx:ℤ~machine.Int64 ↦ if( int-sign x ) { int-neg x; } else { x; };
|
|||
|
let int-lt = λ{ a:ℤ~machine.Int64; b:ℤ~machine.Int64; } ↦ int-sign (i- a b);
|
|||
|
let int-gt = λ{ a:ℤ~machine.Int64; b:ℤ~machine.Int64; } ↦ int-sign (i- b a);
|
|||
|
let int-eq = λ{ a:ℤ~machine.Int64; b:ℤ~machine.Int64; } ↦ if (i- a b) { 0; } else { 1; };
|
|||
|
let int-lte = λ{ a:ℤ~machine.Int64; b:ℤ~machine.Int64; } ↦ bit-or (int-lt a b) (int-eq a b);
|
|||
|
let int-gte = λ{ a:ℤ~machine.Int64; b:ℤ~machine.Int64; } ↦ bit-or (int-gt a b) (int-eq a b);
|
|||
|
let int-min = λ{ a:ℤ~machine.Int64; b:ℤ~machine.Int64; } ↦ if( int-lt a b ) { a; } else { b; };
|
|||
|
let int-max = λ{ a:ℤ~machine.Int64; b:ℤ~machine.Int64; } ↦ if( int-gt a b ) { a; } else { b; };
|
|||
|
|
|||
|
/* Euclidean Algorithm to calculate greatest common divisor
|
|||
|
*/
|
|||
|
let gcd = λ{
|
|||
|
a : ℤ ~ machine.Int64;
|
|||
|
b : ℤ ~ machine.Int64;
|
|||
|
} ↦ {
|
|||
|
while( b ) {
|
|||
|
let tmp = i% a b;
|
|||
|
! a b;
|
|||
|
! b tmp;
|
|||
|
}
|
|||
|
a;
|
|||
|
};
|
|||
|
|
|||
|
/* least common multiple
|
|||
|
*/
|
|||
|
let lcm = λ{
|
|||
|
a : ℤ ~ machine.Int64;
|
|||
|
b : ℤ ~ machine.Int64;
|
|||
|
} ↦ i* (int-abs a) (i/ (int-abs b) (gcd a b));
|
|||
|
|
|||
|
|
|||
|
/* Implementation of Rational Numbers
|
|||
|
*/
|
|||
|
let ratio-scale = λ{
|
|||
|
{p:ℕ; q:ℕ;} : ℚ ~ <Ratio ℕ~machine.UInt64> ;
|
|||
|
n : ℕ ~ machine.UInt64 ;
|
|||
|
} ↦ {
|
|||
|
i* q n;
|
|||
|
i* p n;
|
|||
|
};
|
|||
|
|
|||
|
let ratio-normalize = λ{
|
|||
|
p: ℤ~machine.Int64;
|
|||
|
q: ℤ~machine.Int64;
|
|||
|
} : ℚ ~ <Ratio ℤ~machine.Int64>
|
|||
|
↦ {
|
|||
|
let s = gcd p q;
|
|||
|
i/ q s;
|
|||
|
i/ p s;
|
|||
|
};
|
|||
|
|
|||
|
let ratio-add = λ{
|
|||
|
{ap:ℕ; aq:ℕ;}: ℚ ~ <Ratio ℕ ~ ℤ_2^64 ~ machine.UInt64> ;
|
|||
|
{bp:ℕ; bq:ℕ;}: ℚ ~ <Ratio ℕ ~ ℤ_2^64 ~ machine.UInt64> ;
|
|||
|
} ↦ {
|
|||
|
let l = lcm aq bq;
|
|||
|
let as = i/ l aq;
|
|||
|
let bs = i/ l bq;
|
|||
|
|
|||
|
i* aq as;
|
|||
|
i+ (i* ap as) (i* bp bs);
|
|||
|
};
|
|||
|
|
|||
|
let ratio-mul = λ{
|
|||
|
{ap:ℤ; aq:ℤ;}: ℚ ~ <Ratio ℤ ~ ℤ_2^64 ~ machine.Int64> ;
|
|||
|
{bp:ℤ; bq:ℤ;}: ℚ ~ <Ratio ℤ ~ ℤ_2^64 ~ machine.Int64> ;
|
|||
|
} ↦ ratio-normalize (i* ap bp) (i* aq bq);
|
|||
|
|
|||
|
let morph-int-to-float =
|
|||
|
λx: ℤ ~ machine.Int64 ~ machine.Word
|
|||
|
↦ {
|
|||
|
/* todo */
|
|||
|
0;
|
|||
|
};
|
|||
|
|
|||
|
let morph-ratio-to-float =
|
|||
|
λ{
|
|||
|
p : ℤ~machine.Int64;
|
|||
|
q : ℤ~machine.Int64;
|
|||
|
} : ℚ~<Ratio ℤ~machine.Int64>
|
|||
|
↦ f/ (morph-int-to-float p) (morph-int-to-float q);
|
|||
|
|
|||
|
|
|||
|
|
|||
|
/* string output
|
|||
|
*/
|
|||
|
let print-nullterm =
|
|||
|
λ{} : < Seq Char ~Ascii ~ machine.Word >
|
|||
|
~ < NullTerminatedArray machine.Word >
|
|||
|
↦ {
|
|||
|
while(dup) { emit; }
|
|||
|
drop;
|
|||
|
};
|
|||
|
|
|||
|
print-nullterm 'H' 'a' 'l' 'l' 'o' ' ' 'W' 'e' 'l' 't' '!' '\n' '\0';
|
|||
|
|
|||
|
/* integer formatting
|
|||
|
*/
|
|||
|
let fmt-uint-radix = λ{
|
|||
|
radix : ℕ ~ ℤ_2^64 ~ machine.UInt64;
|
|||
|
x : ℕ ~ ℤ_2^64 ~ machine.UInt64;
|
|||
|
} ↦ {
|
|||
|
if( x ) {
|
|||
|
while( x ) {
|
|||
|
let digit = (i% x radix);
|
|||
|
|
|||
|
if( int-lt digit 10 ) {
|
|||
|
i+ '0' digit;
|
|||
|
} else {
|
|||
|
i+ (i- 'a' 10) digit;
|
|||
|
};
|
|||
|
! x (i/ x radix);
|
|||
|
}
|
|||
|
} else {
|
|||
|
'0';
|
|||
|
};
|
|||
|
};
|
|||
|
|
|||
|
let fmt-int-radix = λ{
|
|||
|
radix: ℕ ~ ℤ_2^64 ~ machine.UInt64;
|
|||
|
x : ℤ ~ machine.Int64;
|
|||
|
} ↦ {
|
|||
|
fmt-uint-radix radix (int-abs x);
|
|||
|
if( int-sign x ) { '-'; };
|
|||
|
};
|
|||
|
|
|||
|
let fmt-uint = λx:ℕ ↦ fmt-uint-radix 10 x;
|
|||
|
let fmt-int = λx:ℤ ↦ fmt-int-radix 10 x;
|
|||
|
|
|||
|
/* ratio formatting
|
|||
|
*/
|
|||
|
let fmt-ratio = λ{ p:ℤ; q:ℤ; } : ℚ~<Ratio ℤ~machine.Int64> ↦ {
|
|||
|
fmt-int q;':';fmt-int p;
|
|||
|
};
|
|||
|
|
|||
|
|
|||
|
|
|||
|
|
|||
|
/* test ratio
|
|||
|
*/
|
|||
|
print-nullterm
|
|||
|
(fmt-ratio { 4; int-neg 3; })
|
|||
|
' ''*'' '
|
|||
|
(fmt-ratio { 7; 4; })
|
|||
|
' ''='' '
|
|||
|
(fmt-ratio (ratio-mul { 4; int-neg 3; } { 7; 4; }))
|
|||
|
'\n''\0';
|
|||
|
|
|||
|
|
|||
|
/* Vec3i
|
|||
|
*/
|
|||
|
let vec3i-add = λ{
|
|||
|
{ ax:ℤ_2^64; ay:ℤ_2^64; az:ℤ_2^64; } : <Vec3 ℤ_2^64~machine.Int64>;
|
|||
|
{ bx:ℤ_2^64; by:ℤ_2^64; bz:ℤ_2^64; } : <Vec3 ℤ_2^64~machine.Int64>;
|
|||
|
} ↦ {
|
|||
|
i+ az bz;
|
|||
|
i+ ay by;
|
|||
|
i+ ax bx;
|
|||
|
};
|
|||
|
|
|||
|
let fmt-vec3i =
|
|||
|
λ{ x:ℤ_2^64; y:ℤ_2^64; z:ℤ_2^64; } : <Vec3 ℤ_2^64~machine.Int64>
|
|||
|
↦ {
|
|||
|
'}';
|
|||
|
fmt-int z; '='; 'z'; ' '; ';';
|
|||
|
fmt-int y; '='; 'y'; ' '; ';';
|
|||
|
fmt-int x; '='; 'x'; '{';
|
|||
|
};
|
|||
|
|
|||
|
|
|||
|
|
|||
|
/* Colors
|
|||
|
*/
|
|||
|
let red-u8rgb
|
|||
|
: <Fn <> Color ~ RGB ~ <Vec3 ℝ_0,1 ~ ℤ_256 ~ machine.UInt64>>
|
|||
|
= λ{} ↦ { 0; 0; 255; };
|
|||
|
|
|||
|
let green-u8rgb = λ{} ↦ { 0; 255; 0; };
|
|||
|
let blue-u8rgb = λ{} ↦ { 255; 0; 0; };
|
|||
|
let yellow-u8rgb = λ{} ↦ { 0; 220; 220; };
|
|||
|
|
|||
|
print-nullterm
|
|||
|
(fmt-vec3i green-u8rgb)
|
|||
|
' ''+'' '
|
|||
|
(fmt-vec3i blue-u8rgb)
|
|||
|
' ''='' '
|
|||
|
(fmt-vec3i (vec3i-add green-u8rgb blue-u8rgb))
|
|||
|
'\n''\0';
|
|||
|
}
|
|||
|
|