Task

Explicitly implement   long multiplication.

This is one possible approach to arbitrary-precision integer algebra.



For output, display the result of    264 * 264.

Optionally, verify your result against builtin arbitrary precision support.

The decimal representation of    264    is:

18,446,744,073,709,551,616

The output of    264 * 264    is    2128,    and is:

340,282,366,920,938,463,463,374,607,431,768,211,456



( ------------- 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