79 lines
2.5 KiB
Text
79 lines
2.5 KiB
Text
[ -1 1 clamp 1+ ]'[ swap peek do ] is sif ( n --> )
|
|
|
|
[ $ "" swap witheach
|
|
[ sif [ char - char 0 char + ]
|
|
swap join ] ] is t->$ ( t --> )
|
|
|
|
[ [] swap witheach
|
|
[ char - - sif [ 1 -1 0 ]
|
|
swap join ] ] is $->t ( $ --> t )
|
|
|
|
[ 0 swap reverse witheach [ swap 3 * + ] ] is t->n ( $ --> t )
|
|
|
|
[ [] swap
|
|
[ 3 /mod [ table 0 1 [ 1+ -1 ] ] do
|
|
swap dip join dup 0 = until ]
|
|
drop ] is n->t ( n --> t )
|
|
|
|
[ -1 peek ] is tsign ( t --> n )
|
|
|
|
[ ' [ 0 ] = ] is tzero ( t --> b )
|
|
|
|
[ tsign -1 = ] is tneg ( t --> b )
|
|
|
|
[ tsign 1 = ] is tpos ( t --> b )
|
|
|
|
[ [] swap witheach [ negate join ] ] is -t ( t --> t )
|
|
|
|
[ 0 over size times
|
|
[ 1 - 2dup peek if conclude ]
|
|
1+ dup if split drop ] is tnorm ( t --> t )
|
|
|
|
[ [] 0 2swap
|
|
over size over size - dup 0 <
|
|
if [ dip swap negate ]
|
|
0 swap of join temp put
|
|
witheach
|
|
[ temp share i^ peek
|
|
+ + 3 +
|
|
[ table
|
|
[ 0 -1 ] [ 1 -1 ] [ -1 0 ]
|
|
[ 0 0 ] [ 1 0 ] [ -1 1 ]
|
|
[ 0 1 ] ] do
|
|
dip join ]
|
|
join tnorm
|
|
temp release ] is t+ ( t t --> t )
|
|
|
|
[ -t t+ ] is t- ( t t --> t )
|
|
|
|
[ t- tneg ] is t< ( t t --> b )
|
|
|
|
[ t- tpos ] is t> ( t t --> b )
|
|
|
|
[ behead swap witheach
|
|
[ 2dup t> if swap
|
|
drop ] ] is tmin ( [ --> t )
|
|
|
|
[ behead swap witheach
|
|
[ 2dup t< if swap
|
|
drop ] ] is tmax ( [ --> t )
|
|
|
|
[ dup t+ ] is twice ( t --> t )
|
|
|
|
[ 0 swap join ] is thrice ( t --> t )
|
|
|
|
[ ' [ 0 ] swap witheach
|
|
[ dip over
|
|
sif [ t- drop t+ ]
|
|
dip thrice ]
|
|
nip ] is t* ( t t --> t )
|
|
|
|
say "a: " $ "+-0++0+" dup echo$ say " = " $->t t->n echo cr
|
|
say "b: " -436 dup echo say " = " n->t t->$ echo$ cr
|
|
say "c: " $ "+-++-" dup echo$ say " = " $->t t->n echo cr
|
|
say "a*(b-c): = "
|
|
$ "+-0++0+" $->t
|
|
-436 n->t
|
|
$ "+-++-" $->t
|
|
t- t*
|
|
dup t->$ echo$ say " = " t->n echo cr
|