Babylonian Multiplication

with Ada.Text_IO;
procedure Mult is

   generic
      Width : Positive;
   package Ints is
      Overflow : exception;

      type Bit is new Natural range 0 .. 1;
      type Bit_Index is new Natural range 0 .. Width - 1;
      type Int is array (Bit_Index) of Bit;
      --  LSB is at 0.
      Zero : constant Int := (others => 0);
      One  : constant Int := (0 => 1, others => 0);

      function "+" (Left, Right : Int) return Int;
      function "*" (Left, Right : Int) return Int;

      function To_Natural (X : Int) return Natural;
      function To_Int (X : Natural) return Int;
   end;

   package body Ints is

      function "+" (Left, Right : Int) return Int is
         type Bit_And_Carry is record
            B, C : Bit;
            --  Result bit and new carry.
         end record;

         Bit_Adder : array (Bit, Bit, Bit) of Bit_And_Carry
           := (0 => (0 => (0 => (0,0),
                           1 => (1,0)),
                     1 => (0 => (1,0),
                           1 => (0,1))),
               1 => (0 => (0 => (1,0),
                           1 => (0,1)),
                     1 => (0 => (0,1),
                           1 => (1,1))));
         Carry : Bit := 0;
         X     : Int;
      begin
         for Pos in Bit_Index loop
            declare
               Result : Bit_And_Carry
                 := Bit_Adder (Carry, Left (Pos), Right (Pos));
            begin
               X (Pos) := Result.B;
               Carry := Result.C;
            end;
         end loop;
         if Carry /= 0 then
            raise Overflow;
         else
            return X;
         end if;
      end "+";

      procedure Double (X : in out Int) is
      begin
         X := X + X;
      end Double;

      function "*" (Left, Right : Int) return Int is
         Pos_Value : Int := Left;
         --  Multiple of Left coressponding to the current bit position in
         --  Left.
         X         : Int := Zero;
         -- Temporary result.
         MSB_Set   : Boolean := False;
         --  Most significant bit in Pos_Value is set, no more set
         --  bits in Right allowed.
      begin
         for Pos in Bit_Index loop
            if Right (Pos) /= 0 then
               if MSB_Set then
                  raise Overflow;
               end if;
               X := X + Pos_Value;
            end if;
            if Pos_Value (Bit_Index'Last) = 1 then
               MSB_Set := True;
            else
               Double (Pos_Value);
            end if;
         end loop;
         return X;
      end "*";

      function To_Natural (X : Int) return Natural is
         Position_Value : Natural := 1;
         Result         : Natural := 0;
      begin
         for Pos in Bit_Index loop
            if X (Pos) /= 0 then
               Result := Result + Position_Value;
            end if;
            if Pos /= Bit_Index'Last then
               Position_Value := Position_Value * 2;
            end if;
         end loop;
         return Result;
      end To_Natural;

      function To_Int (X : Natural) return Int is
         Y              : Natural := X;
         Position_Value : Int := One;
         Result         : Int := Zero;
      begin
         for Pos in Bit_Index loop
            if Y mod 2 /= 0 then
               Result := Result + Position_Value;
            end if;
            if Pos /= Bit_Index'Last then
               Double (Position_Value);
               Y := Y / 2;
            end if;
         end loop;
         return Result;
      end To_Int;
   end Ints;

   package I is new Ints (8);
   use I;

begin
   Ada.Text_IO.Put_Line (Natural'Image
                         (To_Natural (To_Int (0) * To_Int (0))));
   Ada.Text_IO.Put_Line (Natural'Image
                         (To_Natural (To_Int (0) * To_Int (1))));
   Ada.Text_IO.Put_Line (Natural'Image
                         (To_Natural (To_Int (1) * To_Int (0))));
   Ada.Text_IO.Put_Line (Natural'Image
                         (To_Natural (To_Int (1) * To_Int (1))));
   Ada.Text_IO.Put_Line (Natural'Image
                         (To_Natural (To_Int (21) * To_Int (11))));
   Ada.Text_IO.Put_Line (Natural'Image
                         (To_Natural (To_Int (51) * To_Int (5))));
   Ada.Text_IO.Put_Line (Natural'Image
                         (To_Natural (To_Int (21) * To_Int (13))));
end Mult;

(Note that this is neither fully tested nor very efficient, but you'll
get the idea.  Extending it to 32 bits is trivial except for the
To_Natural and To_Int functions.)