--  This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only
--  on the specifications.  This file is part of GHDL.
--  Copyright (C) 2015-2021 Tristan Gingold
--
--  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 2 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 <gnu.org/licenses>.

--  This is a template file.  To avoid errors and duplication, the python
--  script build.py generate most of the bodies.

package body std_logic_1164 is

  type table_1d is array (std_ulogic) of std_ulogic;
  type table_2d is array (std_ulogic, std_ulogic) of std_ulogic;

  constant resolution : table_2d :=
  --  UX01ZWLH-
    ("UUUUUUUUU",   --  U
     "UXXXXXXXX",   --  X
     "UX0X0000X",   --  0
     "UXX11111X",   --  1
     "UX01ZWLHX",   --  Z
     "UX01WWWWX",   --  W
     "UX01LWLWX",   --  L
     "UX01HWWHX",   --  H
     "UXXXXXXXX"    --  -
     );

  function resolved (s : std_ulogic_vector) return std_ulogic
  is
    variable res : std_ulogic := 'Z';
  begin
    for I in s'range loop
      res := resolution (res, s (I));
    end loop;
    return res;
  end resolved;

  @TAB

  @LOG

  --  Conversion functions.
  --  The result range (for vectors) is S'Length - 1 downto 0.
  --  XMAP is return for values not in '0', '1', 'L', 'H'.
  function to_bit (s : std_ulogic; xmap : bit := '0') return bit is
  begin
    case s is
      when '0' | 'L' =>
        return '0';
      when '1' | 'H' =>
        return '1';
      when others =>
        return xmap;
    end case;
  end to_bit;

  type bit_to_std_table is array (bit) of std_ulogic;
  constant bit_to_std : bit_to_std_table := "01";

  @CONV

  function to_stdulogic (b : bit) return std_ulogic is
  begin
    return bit_to_std (b);
  end to_stdulogic;

  --  Normalization.
  type table_std_x01 is array (std_ulogic) of X01;
  constant std_to_x01 : table_std_x01 := ('U' | 'X' | 'Z' | 'W' | '-' => 'X',
                                          '0' | 'L'                   => '0',
                                          '1' | 'H'                   => '1');

  type table_bit_x01 is array (bit) of X01;
  constant bit_to_x01 : table_bit_x01 := ('0' => '0',
                                          '1' => '1');


  type table_std_x01z is array (std_ulogic) of X01Z;
  constant std_to_x01z : table_std_x01z := ('U' | 'X' | 'W' | '-' => 'X',
                                            '0' | 'L'             => '0',
                                            '1' | 'H'             => '1',
                                            'Z'                   => 'Z');

  type table_std_ux01 is array (std_ulogic) of UX01;
  constant std_to_ux01 : table_std_ux01 := ('U'                   => 'U',
                                            'X' | 'Z' | 'W' | '-' => 'X',
                                            '0' | 'L'             => '0',
                                            '1' | 'H'             => '1');

  @NORM

  function rising_edge (signal s : std_ulogic) return boolean is
  begin
    return s'event
      and to_x01 (s'last_value) = '0'
      and to_x01 (s) = '1';
  end rising_edge;

  function falling_edge (signal s : std_ulogic) return boolean is
  begin
    return s'event
      and to_x01 (s'last_value) = '1'
      and to_x01 (s) = '0';
  end falling_edge;

  type std_x_array is array (std_ulogic) of boolean;
  constant std_x : std_x_array := ('U' | 'X' | 'Z' | 'W' | '-' => true,
                                   '0' | '1' | 'L' | 'H' => false);

  @ISX
  @BEG V08

  function to_ostring (value : std_ulogic_vector) return string
  is
    alias avalue : std_ulogic_vector(value'length downto 1) is value;
    constant len : natural := (value'length + 2) / 3;
    variable padded : std_ulogic_vector (len * 3 downto 1);
    variable pad : std_ulogic;
    variable res : string (len downto 1);
    variable c : character;
    subtype res_type is string (1 to len);
  begin
    pad := 'Z' when value (value'left) = 'Z' else '0';
    padded (avalue'range) := to_x01z (value);
    padded (padded'left downto avalue'left + 1) := (others => pad);
    for i in res'range loop
      case padded(i * 3 downto i * 3 - 2) is
        when "000" =>  c := '0';
        when "001" =>  c := '1';
        when "010" =>  c := '2';
        when "011" =>  c := '3';
        when "100" =>  c := '4';
        when "101" =>  c := '5';
        when "110" =>  c := '6';
        when "111" =>  c := '7';
        when "ZZZ" =>  c := 'Z';
        when others => c := 'X';
      end case;
      res (i) := c;
    end loop;
    return res_type (res);
  end to_ostring;

  function to_hstring (value : std_ulogic_vector) return string
  is
    alias avalue : std_ulogic_vector(value'length downto 1) is value;
    constant len : natural := (value'length + 3) / 4;
    variable padded : std_ulogic_vector (len * 4 downto 1);
    variable pad : std_ulogic;
    variable res : string (len downto 1);
    variable c : character;
    subtype res_type is string (1 to len);
  begin
    pad := 'Z' when value (value'left) = 'Z' else '0';
    padded (avalue'range) := to_x01z (value);
    padded (padded'left downto avalue'left + 1) := (others => pad);
    for i in res'range loop
      case padded(i * 4 downto i * 4 - 3) is
        when "0000" =>  c := '0';
        when "0001" =>  c := '1';
        when "0010" =>  c := '2';
        when "0011" =>  c := '3';
        when "0100" =>  c := '4';
        when "0101" =>  c := '5';
        when "0110" =>  c := '6';
        when "0111" =>  c := '7';
        when "1000" =>  c := '8';
        when "1001" =>  c := '9';
        when "1010" =>  c := 'A';
        when "1011" =>  c := 'B';
        when "1100" =>  c := 'C';
        when "1101" =>  c := 'D';
        when "1110" =>  c := 'E';
        when "1111" =>  c := 'F';
        when "ZZZZ" =>  c := 'Z';
        when others => c := 'X';
      end case;
      res (i) := c;
    end loop;
    return res_type (res);
  end to_hstring;

  type sl_to_char_array is array (std_ulogic) of character;
  constant sl_to_char : sl_to_char_array := "UX01ZWLH-";

  procedure write (l : inout line; value : std_ulogic;
                   justified : side := right; field : width := 0) is
  begin
    write (l, sl_to_char (value), justified, field);
  end write;

  procedure write (l : inout line; value : std_ulogic_vector;
                   justified : side := right; field : width := 0) is
  begin
    write (l, to_string (value), justified, field);
  end write;

  procedure owrite (l : inout line; value : std_ulogic_vector;
                    justified : side := right; field : width := 0) is
  begin
    write (l, to_ostring (value), justified, field);
  end owrite;

  procedure hwrite (l : inout line; value : std_ulogic_vector;
                    justified : side := right; field : width := 0) is
  begin
    write (l, to_hstring (value), justified, field);
  end hwrite;

  constant nbsp : character := character'val (160);

  procedure trim (l : inout line; left : natural)
  is
    variable nl : line;
  begin
    if l'ascending then
      nl := new string(left to l'right);
      nl.all := l(left to l'right);
    else
      nl := new string(left downto l'right);
      nl.all := l(left downto l'right);
    end if;
    deallocate(l);
    l := nl;
  end trim;

  procedure read (l: inout line; value: out std_ulogic; good: out boolean)
  is
    variable p : positive;
    variable dir : integer;
  begin
    good := false;
    value := 'U';
    if l = null or l'length = 0 then
      --  Return now for empty line.
      return;
    end if;

    if l'ascending then
      dir := 1;
    else
      dir := -1;
    end if;
    p := l'left;
    loop
      case l(p) is
        when ' ' | NBSP | HT =>
          --  Skip blanks.
          null;
        when 'U' => value := 'U'; exit;
        when 'X' => value := 'X'; exit;
        when '0' => value := '0'; exit;
        when '1' => value := '1'; exit;
        when 'Z' => value := 'Z'; exit;
        when 'W' => value := 'W'; exit;
        when 'L' => value := 'L'; exit;
        when 'H' => value := 'H'; exit;
        when '-' => value := '-'; exit;
        when others =>
          trim (l, p);
          return;
      end case;
      if p = l'right then
        --  End of string.
        deallocate(l);
        l := new string'("");
        return;
      end if;
      p := p + dir;
    end loop;

    good := true;
    trim (l, p + dir);
  end read;

  procedure read (l : inout line; value : out std_ulogic)
  is
    variable good : boolean;
  begin
    read (l, value, good);
    assert good report "std_logic_1164.read(std_ulogic) cannot read value"
      severity error;
  end read;

  procedure read (l : inout line;
                  value : out std_ulogic_vector; good : out boolean)
  is
    variable p : positive;
    variable i : natural;
    variable dir : integer;
    alias av : std_ulogic_vector(1 to value'length) is value;
    variable allow_underscore : boolean;
    variable c : character;
    variable d : std_ulogic;
  begin
    good := value'length = 0;
    value := (value'range => 'U');
    if l = null or l'length = 0 then
      --  Return now for empty line.
      return;
    end if;

    if l'ascending then
      dir := 1;
    else
      dir := -1;
    end if;
    p := l'left;

    --  Skip blanks.
    p := l'left;
    loop
      case l(p) is
        when ' ' | NBSP | HT =>
          null;
        when others =>
          exit;
      end case;
      if p = l'right then
        --  End of string.
        deallocate(l);
        l := new string'("");
        return;
      end if;
      p := p + dir;
    end loop;

    if value'length = 0 then
      --  Nothing to read.
      trim (l, p);
      return;
    end if;

    --  Extract value
    i := 1;
    allow_underscore := False;
    good := false;
    loop
      c := l(p);
      case c is
        when 'U' => d := 'U';
        when 'X' => d := 'X';
        when '0' => d := '0';
        when '1' => d := '1';
        when 'Z' => d := 'Z';
        when 'W' => d := 'W';
        when 'L' => d := 'L';
        when 'H' => d := 'H';
        when '-' => d := '-';
        when others =>
          if c = '_' and allow_underscore then
            allow_underscore := false;
          else
            --  Invalid character, double or leading '_'.
            trim (l, p);
            value := (value'range => 'U');
            return;
          end if;
      end case;
      if c /= '_' then
        av (i) := d;
        allow_underscore := true;
        if i = av'right then
          --  Done.
          good := true;
          trim (l, p + dir);
          return;
        end if;
        i := i + 1;
      end if;
      if p = l'right then
        --  End of string.
        trim (l, p + dir);
        deallocate(l);
        l := new string'("");
        value := (value'range => 'U');
        return;
      end if;
      p := p + dir;
    end loop;
  end read;

  procedure read (l : inout line; value : out std_ulogic_vector)
  is
    variable good : boolean;
  begin
    read (l, value, good);
    assert good
      report "std_logic_1164.read(std_ulogic_vector) cannot read value"
      severity error;
  end read;

  procedure hread (l : inout line;
                   value : out std_ulogic_vector; good : out boolean)
  is
    variable p : positive;
    variable i : natural;
    variable dir : integer;
    constant ndigits : natural := (value'length + 3) / 4;
    variable v : std_ulogic_vector(1 to ndigits * 4);
    variable allow_underscore : boolean;
    variable c : character;
    variable d : std_ulogic_vector (3 downto 0);
  begin
    good := value'length = 0;
    value := (value'range => 'U');
    if l = null or l'length = 0 then
      --  Return now for empty line.
      return;
    end if;

    if l'ascending then
      dir := 1;
    else
      dir := -1;
    end if;
    p := l'left;

    --  Skip blanks.
    p := l'left;
    loop
      case l(p) is
        when ' ' | NBSP | HT =>
          null;
        when others =>
          exit;
      end case;
      if p = l'right then
        --  End of string.
        deallocate(l);
        l := new string'("");
        return;
      end if;
      p := p + dir;
    end loop;

    if value'length = 0 then
      --  Nothing to read.
      trim (l, p);
      return;
    end if;

    --  Extract value
    i := 0;
    allow_underscore := False;
    good := false;
    loop
      c := l(p);
      case c is
        when '0'       => d := "0000";
        when '1'       => d := "0001";
        when '2'       => d := "0010";
        when '3'       => d := "0011";
        when '4'       => d := "0100";
        when '5'       => d := "0101";
        when '6'       => d := "0110";
        when '7'       => d := "0111";
        when '8'       => d := "1000";
        when '9'       => d := "1001";
        when 'A' | 'a' => d := "1010";
        when 'B' | 'b' => d := "1011";
        when 'C' | 'c' => d := "1100";
        when 'D' | 'd' => d := "1101";
        when 'E' | 'e' => d := "1110";
        when 'F' | 'f' => d := "1111";
        when 'Z'       => d := "ZZZZ";
        when 'X'       => d := "XXXX";
        when others =>
          if c = '_' and allow_underscore then
            allow_underscore := false;
          else
            --  Invalid character, double or leading '_'.
            trim (l, p);
            return;
          end if;
      end case;
      if c /= '_' then
        allow_underscore := true;
        v (i * 4 + 1 to i * 4 + 4) := d;
        i := i + 1;
        if i = ndigits then
          --  Done.
          if or (v(1 to ndigits * 4 - value'length)) /= '1' then
            --  No truncated digit is a '1'.
            value := v (ndigits * 4 - value'length + 1 to v'right);
            good := true;
          end if;
          trim (l, p + dir);
          return;
        end if;
      end if;
      if p = l'right then
        --  End of string.
        trim (l, p + dir);
        deallocate(l);
        l := new string'("");
        return;
      end if;
      p := p + dir;
    end loop;
  end hread;

  procedure hread (l : inout line; value : out std_ulogic_vector)
  is
    variable good : boolean;
  begin
    hread (l, value, good);
    assert good
      report "std_logic_1164.hread(std_ulogic_vector) cannot read value"
      severity error;
  end hread;

  procedure oread (l : inout line;
                   value : out std_ulogic_vector; good : out boolean)
  is
    variable p : positive;
    variable i : natural;
    variable dir : integer;
    constant ndigits : natural := (value'length + 2) / 3;
    variable v : std_ulogic_vector(1 to ndigits * 3);
    variable allow_underscore : boolean;
    variable c : character;
    variable d : std_ulogic_vector (2 downto 0);
  begin
    good := value'length = 0;
    value := (value'range => 'U');
    if l = null or l'length = 0 then
      --  Return now for empty line.
      return;
    end if;

    if l'ascending then
      dir := 1;
    else
      dir := -1;
    end if;
    p := l'left;

    --  Skip blanks.
    p := l'left;
    loop
      case l(p) is
        when ' ' | NBSP | HT =>
          null;
        when others =>
          exit;
      end case;
      if p = l'right then
        --  End of string.
        deallocate(l);
        l := new string'("");
        return;
      end if;
      p := p + dir;
    end loop;

    if value'length = 0 then
      --  Nothing to read.
      trim (l, p);
      return;
    end if;

    --  Extract value
    i := 0;
    allow_underscore := False;
    good := false;
    loop
      c := l(p);
      case c is
        when '0'       => d := "000";
        when '1'       => d := "001";
        when '2'       => d := "010";
        when '3'       => d := "011";
        when '4'       => d := "100";
        when '5'       => d := "101";
        when '6'       => d := "110";
        when '7'       => d := "111";
        when 'Z'       => d := "ZZZ";
        when 'X'       => d := "XXX";
        when others =>
          if c = '_' and allow_underscore then
            allow_underscore := false;
          else
            --  Invalid character, double or leading '_'.
            trim (l, p);
            return;
          end if;
      end case;
      if c /= '_' then
        allow_underscore := true;
        v (i * 3 + 1 to i * 3 + 3) := d;
        i := i + 1;
        if i = ndigits then
          --  Done.
          if or (v(1 to ndigits * 3 - value'length)) /= '1' then
            --  No truncated digit is a '1'.
            value := v (ndigits * 3 - value'length + 1 to v'right);
            good := true;
          end if;
          trim (l, p + dir);
          return;
        end if;
      end if;
      if p = l'right then
        --  End of string.
        trim (l, p + dir);
        deallocate(l);
        l := new string'("");
        return;
      end if;
      p := p + dir;
    end loop;
  end oread;

  procedure oread (l : inout line; value : out std_ulogic_vector)
  is
    variable good : boolean;
  begin
    oread (l, value, good);
    assert good
      report "std_logic_1164.oread(std_ulogic_vector) cannot read value"
      severity error;
  end oread;

  @END V08
end std_logic_1164;