37 lines
808 B
Text
37 lines
808 B
Text
[ dup dip /mod
|
|
over iff
|
|
[ - dip 1+ ]
|
|
else drop ] is /mod+ ( n n --> n n )
|
|
|
|
[ over 0 = iff
|
|
[ 2drop $ "0" ]
|
|
done
|
|
temp put
|
|
$ "" swap
|
|
[ temp share /mod+
|
|
digit
|
|
rot join swap
|
|
dup 0 = until ]
|
|
drop
|
|
temp release ] is ->negabase$ ( n n --> $ )
|
|
|
|
[ over $ "0" = iff
|
|
[ 2drop 0 ]
|
|
done
|
|
temp put
|
|
0 swap
|
|
witheach
|
|
[ dip
|
|
[ temp share * ]
|
|
char->n + ]
|
|
temp release ] is negabase$-> ( $ n --> n )
|
|
|
|
10 dup echo say " -> "
|
|
-2 ->negabase$ dup echo$ say " -> "
|
|
-2 negabase$-> echo cr
|
|
146 dup echo say " -> "
|
|
-3 ->negabase$ dup echo$ say " -> "
|
|
-3 negabase$-> echo cr
|
|
15 dup echo say " -> "
|
|
-10 ->negabase$ dup echo$ say " -> "
|
|
-10 negabase$-> echo cr
|