--  This -*- vhdl -*- file is part of GHDL.
--  IEEE 1076.3 compliant numeric std package body.
--  The implementation is based only on the specifications.
--  Copyright (C) 2015 Tristan Gingold
--
--  GHDL 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 2, or (at your option) any later
--  version.
--
--  GHDL 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 GCC; see the file COPYING2.  If not see
--  <http://www.gnu.org/licenses/>.

package body NUMERIC_STD is
  constant NO_WARNING : Boolean := False;

  constant null_unsigned : unsigned (0 downto 1) := (others => '0');
  constant null_signed   :   signed (0 downto 1) := (others => '0');

  subtype nat1 is natural range 0 to 1;

  type nat1_to_sl_type is array (nat1) of std_ulogic;
  constant nat1_to_01 : nat1_to_sl_type := (0 => '0', 1 => '1');

  subtype sl_01 is std_ulogic range '0' to '1';
  subtype sl_x01 is std_ulogic range 'X' to '1';

  type carry_array is array (sl_01, sl_01, sl_01) of sl_01;
  constant compute_carry : carry_array :=
    ('0' => ('0' => ('0' => '0', '1' => '0'),
             '1' => ('0' => '0', '1' => '1')),
     '1' => ('0' => ('0' => '0', '1' => '1'),
             '1' => ('0' => '1', '1' => '1')));
  constant compute_sum : carry_array :=
    ('0' => ('0' => ('0' => '0', '1' => '1'),
             '1' => ('0' => '1', '1' => '0')),
     '1' => ('0' => ('0' => '1', '1' => '0'),
             '1' => ('0' => '0', '1' => '1')));

  type sl_to_x01_array is array (std_ulogic) of sl_x01;
  constant sl_to_x01 : sl_to_x01_array :=
    ('0' | 'L' => '0', '1' | 'H' => '1', others => 'X');

  type compare_type is (compare_unknown,
                        compare_lt,
                        compare_eq,
                        compare_gt);

  --  Match.
  --  '-' matches with everything.
  --  '0'/'L' matches, '1'/'H' matches.
  type match_table_type is array (std_ulogic, std_ulogic) of boolean;
  constant match_table: match_table_type :=
    ('0' | 'L' => ('0' | 'L' | '-' => true, others => false),
     '1' | 'H' => ('1' | 'H' | '-' => true, others => false),
     '-' => (others => true),
     others => ('-' => true, others => false));

  function MAX (L, R : natural) return natural is
  begin
    if L > R then
      return L;
    else
      return R;
    end if;
  end MAX;

  function TO_INTEGER (ARG : UNSIGNED) return NATURAL
  is
    variable argn : UNSIGNED (ARG'Length -1 downto 0);
    variable res : natural := 0;
  begin
    if argn'length = 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_INTEGER: null array detected, returning 0"
        severity warning;
      return 0;
    end if;
    argn := TO_01 (ARG, 'X');
    if argn (0) = 'X' then
      assert NO_WARNING
        report
          "NUMERIC_STD.TO_INTEGER: non logical value detected, returning 0"
        severity warning;
      return 0;
    end if;

    for i in argn'range loop
      res := res + res;
      if argn (i) = '1' then
        res := res + 1;
      end if;
    end loop;

    return res;
  end TO_INTEGER;

  function TO_INTEGER (ARG :   SIGNED) return INTEGER
  is
    variable argn : SIGNED (ARG'Length -1 downto 0);
    variable res : integer := 0;
    variable b : STD_ULOGIC;
  begin
    if argn'length = 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_INTEGER: null array detected, returning 0"
        severity warning;
      return 0;
    end if;
    argn := TO_01 (ARG, 'X');
    if argn (0) = 'X' then
      assert NO_WARNING
        report
          "NUMERIC_STD.TO_INTEGER: non logical value detected, returning 0"
        severity warning;
      return 0;
    end if;
    if argn (argn'left) = '1' then
      --  Negative value
      b := '0';
    else
      b := '1';
    end if;

    for i in argn'range loop
      res := res + res;
      if argn (i) = b then
        res := res + 1;
      end if;
    end loop;

    if b = '0' then
      --  Avoid overflow.
      res := -res - 1;
    end if;

    return res;
  end TO_INTEGER;

  function TO_01 (S : SIGNED;   XMAP : STD_LOGIC := '0') return SIGNED
  is
    subtype res_type is SIGNED (S'Length - 1 downto 0);
    variable res : res_type;
    alias snorm: res_type is S;
  begin
    if S'length = 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_01: null array detected"
        severity warning;
      return null_signed;
    else
      for i in res_type'range loop
        case snorm (i) is
          when '0' | 'L' => res (i) := '0';
          when '1' | 'H' => res (i) := '1';
          when others =>
            assert NO_WARNING
              report "NUMERIC_STD.TO_01: non logical value detected"
              severity warning;
            res := (others => XMAP);
            exit;
        end case;
      end loop;
    end if;
    return res;
  end TO_01;

  function TO_01 (S : UNSIGNED; XMAP : STD_LOGIC := '0') return UNSIGNED
  is
    subtype res_type is UNSIGNED (S'Length - 1 downto 0);
    variable res : res_type;
    alias snorm: res_type is S;
  begin
    if S'length = 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_01: null array detected"
        severity warning;
      return null_unsigned;
    else
      for i in res_type'range loop
        case snorm (i) is
          when '0' | 'L' => res (i) := '0';
          when '1' | 'H' => res (i) := '1';
          when others =>
            assert NO_WARNING
              report "NUMERIC_STD.TO_01: non logical value detected"
              severity warning;
            res := (others => XMAP);
            exit;
        end case;
      end loop;
    end if;
    return res;
  end TO_01;

  function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED
  is
    variable res : UNSIGNED (SIZE - 1 downto 0);
    variable a : natural := arg;
    variable d : nat1;
  begin
    if size = 0 then
      return null_unsigned;
    end if;
    for i in res'reverse_range loop
      d := a rem 2;
      res (i) := nat1_to_01 (d);
      a := a / 2;
    end loop;
    if a /= 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_UNSIGNED: vector is truncated"
        severity warning;
    end if;
    return res;
  end TO_UNSIGNED;

  function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED
  is
    variable res : SIGNED (SIZE - 1 downto 0);
    variable v : integer := arg;
    variable b0, b1 : std_ulogic;
    variable d : nat1;
  begin
    if size = 0 then
      return null_signed;
    end if;
    if arg < 0 then
      --  Use one complement to avoid overflow:
      --   -v = (not v) + 1
      --   not v = -v - 1
      --   not v = -(v + 1)
      v := -(arg + 1);
      b0 := '1';
      b1 := '0';
    else
      v := arg;
      b0 := '0';
      b1 := '1';
    end if;

    for i in res'reverse_range loop
      d := v rem 2;
      v := v / 2;
      if d = 0 then
        res (i) := b0;
      else
        res (i) := b1;
      end if;
    end loop;
    if v /= 0 or res (res'left) /= b0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_SIGNED: vector is truncated"
        severity warning;
    end if;
    return res;
  end TO_SIGNED;

  function std_match (l, r : std_ulogic) return boolean is
  begin
    return match_table (l, r);
  end std_match;

  @MATCH

  @ARITH

  @LOG
end NUMERIC_STD;