--    GMPAda, binding to the Ada Language for the GNU MultiPrecision library.
--    Copyright (C) 2007-2010 Nicolas Boulenguez <nicolas.boulenguez@free.fr>
--
--    This program is free software: you can redistribute it and/or modify
--    it under the terms of the GNU General Public License as published by
--    the Free Software Foundation, either version 3 of the License, or
--    (at your option) any later version.
--
--    This program is distributed in the hope that it will be useful,
--    but WITHOUT ANY WARRANTY; without even the implied warranty of
--    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--    GNU General Public License for more details.
--
--    You should have received a copy of the GNU General Public License
--    along with this program.  If not, see <http://www.gnu.org/licenses/>.

with Ada.IO_Exceptions;
with GNU_Multiple_Precision.Aux; use GNU_Multiple_Precision.Aux;

package body GNU_Multiple_Precision.Generic_Text_IO is

   procedure Skip_Blanks_And_Separators (File : in File_Type);

   procedure Skip_Blanks_And_Separators (File : in File_Type)
   is
      Item        : Maybe_Character;
      End_Of_Line : Boolean;
   begin
      loop
         Look_Ahead (File, Item, End_Of_Line);
         if End_Of_Line then
            Skip_Line (File);
            if End_Of_Page (File) then
               Skip_Page (File);
            end if;
         elsif Is_Blank (To_Character (Item, Unused_Character)) then
            Get (File, Item);
         else
            exit;
         end if;
      end loop;
   end Skip_Blanks_And_Separators;

   procedure Get
     (File  : in     File_Type;
      Item  : in out Big_Integer;
      Width : in     Field       := 0)
   is
      Actual_Width : Field;
      Count : Field := 0;
      EOL   : Boolean;
      Next  : Character;
      procedure Consume;
      procedure Consume is
         Ignored : Maybe_Character;
         Temp    : Maybe_Character;
      begin
         pragma Assert (Count < Actual_Width
                        and not End_Of_Line (File));
         Get (File, Ignored);
         pragma Unreferenced (Ignored);
         Count := Count + 1;
         Look_Ahead (File, Temp, EOL);
         if Count < Actual_Width and not EOL then
            Next := To_Character (Temp, Unused_Character);
         else
            Next := Unused_Character;
         end if;
      end Consume;
      package Scan is new Generic_Scan (Next, Consume);
      Temp : Maybe_Character;
   begin
      if Width /= 0 then
         Actual_Width := Width;
      else
         Skip_Blanks_And_Separators (File);
         Actual_Width := Max_IO_Length;
      end if;
      Look_Ahead (File, Temp, EOL);
      if not EOL then
         Next := To_Character (Temp, Unused_Character);
      else
         Next := Unused_Character;
      end if;
      Scan.Get_Mpz_T (Item.Value, Actual_Width);
      if Count < Integer (Actual_Width) and not End_Of_Line (File) then
         raise Ada.IO_Exceptions.Data_Error;
      end if;
   end Get;

   procedure Get
     (Item  : in out Big_Integer;
      Width : in     Field       := 0)
   is
   begin
      Get (Current_Input, Item, Width);
   end Get;

   procedure Get
     (From : in     Maybe_String;
      Item : in out Big_Integer;
      Last :    out Positive)
   is
      Next : Character;          --  = From (Last - 1) in normal cases
      procedure Consume;
      procedure Consume is
      begin
         if Last <= From'Last then
            Next := To_Character (From (Last), Unused_Character);
         else
            pragma Assert (Last = From'Last + 1);
            Next := Unused_Character;
         end if;
         Last := Last + 1;
      end Consume;
      package Scan is new Generic_Scan (Next, Consume);
   begin
      Last := From'First;
      Consume;
      Scan.Get_Mpz_T (Item.Value, From'Length);
      Last := Last - 2;
   end Get;

   procedure Put
     (File  : in File_Type;
      Item  : in Big_Integer;
      Width : in Field       := Default_Width;
      Base  : in Number_Base := Default_Base)
   is
      procedure Put_Character (C : in Character);
      procedure Put_Character (C : in Character)
      is
      begin
         Put (File, To_Maybe_Character (C));
      end Put_Character;
   begin
      Put (Put_Character'Access, Item.Value, Width, Base);
   end Put;

   procedure Put
     (Item  : in Big_Integer;
      Width : in Field       := Default_Width;
      Base  : in Number_Base := Default_Base)
   is
   begin
      Put (Current_Output, Item, Width, Base);
   end Put;

   procedure Put
     (To   :    out Maybe_String;
      Item : in     Big_Integer;
      Base : in     Number_Base := Default_Base)
   is
      Next : Positive := To'First;
      procedure Put_Character (C : in Character);
      procedure Put_Character (C : in Character)
      is
      begin
         if Next > To'Last then
            raise Ada.IO_Exceptions.Layout_Error;
         end if;
         To (Next) := To_Maybe_Character (C);
         Next := Next + 1;
      end Put_Character;
   begin
      Put (Put_Character'Access, Item.Value, To'Length, Base);
   end Put;

   procedure Put
     (File  : in File_Type;
      Item  : in Big_Rational;
      Width : in Field       := Default_Width;
      Base  : in Number_Base := Default_Base)
   is
      procedure Put_Character (C : in Character);
      procedure Put_Character (C : in Character)
      is
      begin
         Put (File, To_Maybe_Character (C));
      end Put_Character;
   begin
      Put (Put_Character'Access, Item.Value, Width, Base);
   end Put;

   procedure Put
     (Item  : in Big_Rational;
      Width : in Field       := Default_Width;
      Base  : in Number_Base := Default_Base)
   is
   begin
      Put (Current_Output, Item, Width, Base);
   end Put;

   procedure Put
     (To   :    out Maybe_String;
      Item : in     Big_Rational;
      Base : in     Number_Base := Default_Base)
   is
      Next : Positive := To'First;
      procedure Put_Character (C : in Character);
      procedure Put_Character (C : in Character)
      is
      begin
         if Next > To'Last then
            raise Ada.IO_Exceptions.Layout_Error;
         end if;
         To (Next) := To_Maybe_Character (C);
         Next := Next + 1;
      end Put_Character;
   begin
      Put (Put_Character'Access, Item.Value, To'Length, Base);
   end Put;

   procedure Get (File  : in     File_Type;
                  Item  : in out Big_Float;
                  Width : in     Field     := 0)
   is
      Actual_Width : Field;
      Count : Field := 0;
      EOL   : Boolean;
      Temp  : Maybe_Character;
      Next  : Character;
      procedure Consume;
      procedure Consume is
      begin
         pragma Assert (Count < Actual_Width
                        and not End_Of_Line (File));
         Get (File, Temp);
         Count := Count + 1;
         Look_Ahead (File, Temp, EOL);
         if Count < Actual_Width and not EOL then
            Next := To_Character (Temp, Unused_Character);
         else
            Next := Unused_Character;
         end if;
      end Consume;
      package Scan is new Generic_Scan (Next, Consume);
   begin
      if Width /= 0 then
         Actual_Width := Width;
      else
         Skip_Blanks_And_Separators (File);
         Actual_Width := Max_IO_Length;
      end if;
      Look_Ahead (File, Temp, EOL);
      if not EOL then
         Next := To_Character (Temp, Unused_Character);
      else
         Next := Unused_Character;
      end if;
      Scan.Get_Mpf_T (Item.Value, Actual_Width);
      if Count < Integer (Actual_Width) and not End_Of_Line (File) then
         raise Ada.IO_Exceptions.Data_Error;
      end if;
   end Get;

   procedure Get
     (Item  : in out Big_Float;
      Width : in     Field     := 0)
   is
   begin
      Get (Current_Input, Item, Width);
   end Get;

   procedure Get
     (From : in     Maybe_String;
      Item : in out Big_Float;
      Last :    out Positive)
   is
      Next : Character;          --  = From (Last - 1) in normal cases
      procedure Consume;
      procedure Consume is
      begin
         if Last <= From'Last then
            Next := To_Character (From (Last), Unused_Character);
         else
            pragma Assert (Last = From'Last + 1);
            Next := Unused_Character;
         end if;
         Last := Last + 1;
      end Consume;
      package Scan is new Generic_Scan (Next, Consume);
   begin
      Last := From'First;
      Consume;
      Scan.Get_Mpf_T (Item.Value, From'Length);
      Last := Last - 2;
   end Get;

   procedure Put
     (File  : in File_Type;
      Item  : in Big_Float;
      Fore  : in     Field := Default_Fore;
      Aft   : in     Field := Default_Aft;
      Exp   : in     Field := Default_Exp)
   is
      procedure Put_Character (C : in Character);
      procedure Put_Character (C : in Character)
      is
      begin
         Put (File, To_Maybe_Character (C));
      end Put_Character;
   begin
      Put (Put_Character'Access, Item.Value, Fore, Aft, Exp);
   end Put;

   procedure Put
     (Item  : in Big_Float;
      Fore  : in Field       := Default_Fore;
      Aft   : in Field       := Default_Aft;
      Exp   : in Field       := Default_Exp)
   is
   begin
      Put (Current_Output, Item, Fore, Aft, Exp);
   end Put;

   procedure Put
     (To   :    out Maybe_String;
      Item : in     Big_Float;
      Aft  : in     Field        := Default_Aft;
      Exp  : in     Field        := Default_Exp)
   is
      Next : Positive := To'First;
      procedure Put_Character (C : in Character);
      procedure Put_Character (C : in Character)
      is
      begin
         if Next > To'Last then
            raise Ada.IO_Exceptions.Layout_Error;
         end if;
         To (Next) := To_Maybe_Character (C);
         Next := Next + 1;
      end Put_Character;
   begin
      Put (Put_Character'Access, Item.Value, 0, Aft, Exp);
      To := (Next .. To'Last => To_Maybe_Character (' '))
        & To (To'First .. Next - 1);
   end Put;

end GNU_Multiple_Precision.Generic_Text_IO;
