Return to multprec_natural_numbers_io.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers

Import the second public release of PHCpack.

OKed by Jan Verschelde.

with text_io,integer_io;                 use text_io,integer_io;
with Characters_and_Numbers;             use Characters_and_Numbers;

package body Multprec_Natural_Numbers_io is

-- IMPORTANT NOTICE :
--   The choice of base is assumed to be decimal.

-- CONSTANTS :

  expo : constant natural := Multprec_Natural_Numbers.Exponent;
  maxl : constant natural := 200;

-- DATA STRUCTURE :

  type Array_of_Strings is array ( natural range <> ) of String(1..expo);

-- BASIC PRIMITIVES FOR INPUT/OUTPUT :

  function Convert ( s : Array_of_Strings ) return Array_of_Naturals is

    res : Array_of_Naturals(s'range) := (s'range => 0);

  begin
    for i in reverse s'range loop
      res(res'last-i) := Convert(s(i));
    end loop;
    return res;
  end Convert;

  function Size ( len : natural ) return natural is

  -- DESCRIPTION :
  --   Given the number of characters read, the size of the natural number
  --   will be determined.

    res : natural := len/expo;

  begin
    if expo*res = len
     then return res-1;
     else return res;
    end if;
  end Size;

  function Create ( l : in natural; s : in String ) return Array_of_Strings is

  -- DESCRIPTION :
  --   Partitions the string in blocks, according to the base.

    res : Array_of_Strings(0..l);
    ind : natural := l;
    cnt : natural := 0;

  begin
    for i in res'range loop
      res(i) := (res(i)'range => ' ');
    end loop;
    for i in reverse s'range loop
      cnt := cnt + 1;
      if cnt <= expo
       then res(ind)(expo-cnt+1) := s(i);
       else ind := ind-1;
            cnt := 1;
            res(ind)(expo-cnt+1) := s(i);
      end if;
    end loop;
    return res;
  end Create;

  procedure Write_Block ( file : in file_type; n : in natural ) is

  -- DESCRIPTION :
  --   This procedure writes the leading zeros.

    nbz,acc : natural := 0;

  begin
    if n = 0
     then for i in 1..expo loop
            put(file,"0");
          end loop;
     else acc := 10;
          for i in 1..(expo-1) loop
            if n < acc
             then nbz := expo-i;
             else acc := acc*10;
            end if;
            exit when (nbz /= 0);
          end loop;
          for i in 1..nbz loop
            put(file,"0");
          end loop;
          put(file,n,1);
    end if;
  end Write_Block;

  procedure Write_Zero_Block ( file : in file_type ) is
  begin
    for i in 1..expo loop
      put(file,"0");
    end loop;
  end Write_Zero_Block;

-- INPUT ROUTINES :

  procedure get ( file : in file_type;
                  lc : in out character; n : in out Natural_Number ) is

    s : String(1..maxl);
    cvn : natural := Convert(lc);
    cnt : natural := 0;

  begin
    while cvn < 10 loop
      cnt := cnt+1;
      s(cnt) := lc;
      exit when End_of_Line(file) or (cnt = s'last);
     -- Skip_Spaces(file,lc);
      Skip_Underscores(file,lc);
      cvn := Convert(lc);
    end loop;
    declare
      sz : constant natural := Size(cnt);
      sn : Array_of_Strings(0..sz) := Create(sz,s(1..cnt));
      an : Array_of_Naturals(0..sz) := Convert(sn);
    begin
      Clear(n);
      n := Create(an);
    end;
  end get;

  procedure get ( lc : in out character; n : in out Natural_Number ) is
  begin
    get(Standard_Input,lc,n);
  end get;

  procedure get ( n : in out Natural_Number ) is
  begin
    get(Standard_Input,n);
  end get;

  procedure get ( file : in file_type; n : in out Natural_Number ) is

    c : character;

  begin
    Skip_Spaces(file,c);
    get(file,c,n);
  end get;

-- OUTPUT ROUTINES :

  procedure put ( n : in Natural_Number ) is
  begin
    put(Standard_Output,n);
  end put;

  procedure put ( file : in file_type; n : in Natural_Number ) is

  -- NOTE : the blocks can be separated by underscores.
  --   In principal, other symbols could be used, however, only underscores
  --   are skipped when processing a natural number.
  
    first : boolean := true;    -- first nonzero, leading block still to write
    coeff : natural;

  begin
    if Empty(n)
     then put(file,"0");
     else for i in reverse 0..Size(n) loop
            coeff := Coefficient(n,i);
            if coeff /= 0
             then if first
                   then put(file,coeff,1); first := false;
                   else Write_Block(file,coeff);
                  end if;
             elsif not first
                 then Write_Zero_Block(file);
              -- else skip leading zeros
            end if;
           -- if (not first and (i>0))   -- leading block written and not at end
           --  then put(file,"_");       -- so, write a separator symbol
           -- end if;
          end loop;
          if first 
           then put(file,"0");         -- there was no nonzero block, so n=0.
          end if;
    end if;
  end put;

  procedure put ( n : in Array_of_Naturals ) is
  begin
    put(Standard_Output,n);
  end put;

  procedure put ( file : in file_type; n : in Array_of_Naturals ) is
  begin
    for i in reverse n'range loop
      if n(i) = 0
       then Write_Zero_Block(file);
       else Write_Block(file,n(i));
      end if;
     -- if i > 0
     --  then put(file,"_");
     -- end if;
    end loop;
  end put;

  procedure put ( n : in Natural_Number; dp : in natural ) is
  begin
    put(Standard_Output,n,dp);
  end put;

  procedure put ( file : in file_type;
                  n : in Natural_Number; dp : in natural ) is
  begin
    for i in 1..(dp-Decimal_Places(n)) loop
      put(file," ");
    end loop;
    put(file,n);
  end put;

end Multprec_Natural_Numbers_io;