137 lines
3.9 KiB
Text
137 lines
3.9 KiB
Text
( ------------- preamble to task, some i/o related words ------------- )
|
|
|
|
[ [] swap witheach
|
|
[ char 0 -
|
|
swap join ] ] is $->long ( $ --> L )
|
|
|
|
[ number$ $->long ] is long ( n --> L )
|
|
|
|
[ reverse behead
|
|
swap witheach
|
|
[ swap 10 * + ] ] is long->num ( L --> n )
|
|
|
|
[ reverse
|
|
witheach echo ] is echolong ( L --> )
|
|
|
|
( ------------------------- task starts here ------------------------- )
|
|
|
|
[ [ table
|
|
[ 0 1 2 3 4 5 6 7 8 9 ]
|
|
[ 1 2 3 4 5 6 7 8 9 10 ]
|
|
[ 2 3 4 5 6 7 8 9 10 11 ]
|
|
[ 3 4 5 6 7 8 9 10 11 12 ]
|
|
[ 4 5 6 7 8 9 10 11 12 13 ]
|
|
[ 5 6 7 8 9 10 11 12 13 14 ]
|
|
[ 6 7 8 9 10 11 12 13 14 15 ]
|
|
[ 7 8 9 10 11 12 13 14 15 16 ]
|
|
[ 8 9 10 11 12 13 14 15 16 17 ]
|
|
[ 9 10 11 12 13 14 15 16 17 18 ] ]
|
|
swap peek 10 /mod ] is add ( n n --> n n )
|
|
|
|
[ dip add add dip [ add nip ] swap ] is addc ( n n c --> n c )
|
|
|
|
[ over size
|
|
over size -
|
|
dup dip
|
|
[ 0 < if swap ]
|
|
abs times
|
|
[ 0 join ] ] is zeropad ( L L --> L L )
|
|
|
|
[ zeropad ( when adding two numbers of different lengths )
|
|
0 temp put ( leading zeroes are added to make the lengths )
|
|
[] unrot witheach ( equal. This is implicit when the calculation )
|
|
[ dip behead ( done by hand, and performed by zeropad here. )
|
|
temp take
|
|
addc
|
|
temp put
|
|
rot swap join swap ]
|
|
drop
|
|
temp take dup 0 !=
|
|
iff join else drop ] is longadd ( L L --> L )
|
|
|
|
[ [ table
|
|
[ 0 0 0 0 0 0 0 0 0 0 ]
|
|
[ 0 1 2 3 4 5 6 7 8 9 ]
|
|
[ 0 2 4 6 8 10 12 14 16 18 ]
|
|
[ 0 3 6 9 12 15 18 21 24 27 ]
|
|
[ 0 4 8 12 16 20 24 28 32 36 ]
|
|
[ 0 5 10 15 20 25 30 35 40 45 ]
|
|
[ 0 6 12 18 24 30 36 42 48 54 ]
|
|
[ 0 7 14 21 28 35 42 49 56 63 ]
|
|
[ 0 8 16 24 32 40 48 56 64 72 ]
|
|
[ 0 9 18 27 36 45 54 63 72 81 ] ]
|
|
swap peek 10 /mod ] is mult ( n n --> n n )
|
|
|
|
[ dip mult add dip [ add nip ] swap ] is multc ( n n c --> n c )
|
|
|
|
[ dup 0 = iff
|
|
[ 2drop 0 long ] done
|
|
0 temp put
|
|
[] unrot swap witheach
|
|
[ over temp take
|
|
multc
|
|
temp put
|
|
swap dip join ]
|
|
drop
|
|
temp take dup 0 !=
|
|
iff join else drop ] is shortmult ( L n --> L )
|
|
|
|
[ dup 0 long != iff
|
|
[ 0 swap join ] ] is timesten ( L --> L )
|
|
|
|
[ dup 0 long = iff
|
|
[ 2drop 0 long ] done
|
|
0 long unrot
|
|
witheach
|
|
[ dip dup shortmult
|
|
rot longadd swap
|
|
timesten ]
|
|
drop ] is longmult ( L L --> L )
|
|
|
|
( ------------------------ additional to task ------------------------ )
|
|
|
|
[ stack ] is linelength ( --> s )
|
|
|
|
[ linelength share times
|
|
[ char - emit ]
|
|
cr ] is separator ( --> )
|
|
|
|
[ linelength share
|
|
over size - times sp
|
|
echolong cr ] is showlong ( L --> )
|
|
|
|
[ over size
|
|
over size + linelength put
|
|
over showlong
|
|
dup showlong
|
|
separator
|
|
dup 0 long = iff
|
|
[ 2drop 0 long ] done
|
|
0 long unrot
|
|
witheach
|
|
[ dip dup shortmult
|
|
dup showlong
|
|
rot longadd swap
|
|
timesten ]
|
|
drop
|
|
separator
|
|
showlong
|
|
separator
|
|
linelength release ] is workings ( L L --> )
|
|
|
|
( --------------------------- demonstration -------------------------- )
|
|
|
|
say "Using long multiplication: "
|
|
2 64 ** long dup longmult dup echolong cr
|
|
|
|
say "Using built-in arithmetic: "
|
|
2 128 ** dup echo cr cr
|
|
|
|
swap long->num = iff
|
|
say "10/10, Gold star!"
|
|
else
|
|
say "0/10, See me after class."
|
|
|
|
cr cr
|
|
say "(Show your workings.)" cr cr
|
|
2 64 ** long dup workings cr
|