path: root/src/synth/synth-expr.adb

--  Expressions synthesis.
--  Copyright (C) 2017 Tristan Gingold
--
--  This file is part of GHDL.
--
--  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, write to the Free Software
--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
--  MA 02110-1301, USA.

with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Std_Names;
with Vhdl.Ieee.Std_Logic_1164;
with Vhdl.Std_Package;
with Vhdl.Errors; use Vhdl.Errors;
with Simul.Execution;
with Simul.Annotations; use Simul.Annotations;
with Grt.Types; use Grt.Types;

with Synth.Errors; use Synth.Errors;
with Synth.Context; use Synth.Context;
with Synth.Types; use Synth.Types;

with Netlists; use Netlists;
with Netlists.Gates; use Netlists.Gates;
with Netlists.Builders; use Netlists.Builders;

package body Synth.Expr is
   function Is_Const (Val : Value_Acc) return Boolean is
   begin
      return Val.Kind = Value_Lit;
   end Is_Const;

   function Get_Width (Val : Value_Acc) return Uns32 is
   begin
      case Val.Kind is
         when Value_Lit =>
            if Is_Bit_Type (Val.Lit_Type) then
               return 1;
            else
               raise Internal_Error;
            end if;
         when Value_Wire
           | Value_Net =>
            return Get_Width (Get_Net (Val));
         when others =>
            raise Internal_Error; --  TODO
      end case;
   end Get_Width;

   function Is_Logic (Val : Value_Acc) return Boolean is
   begin
      if Val.Kind = Value_Lit then
         case Val.Lit.Kind is
            when Iir_Value_B1 =>
               return True;
            when Iir_Value_E8 =>
               return Is_Bit_Type (Val.Lit_Type);
            when others =>
               return False;
         end case;
      else
         return False;
      end if;
   end Is_Logic;

   procedure To_Logic (Lit : Iir_Value_Literal_Acc;
                       Val : out Uns32;
                       Zx  : out Uns32) is
   begin
      case Lit.Kind is
         when Iir_Value_B1 =>
            Zx := 0;
            Val := Ghdl_B1'Pos (Lit.B1);
         when Iir_Value_E8 =>
            --  Std_logic.
            case Lit.E8 is
               when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos
                 |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos =>
                  Val := 0;
                  Zx := 0;
               when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos
                 |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos =>
                  Val := 1;
                  Zx := 0;
               when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos
                 |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos
                 |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos =>
                  Val := 1;
                  Zx := 1;
               when Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos
                 |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos =>
                  Val := 0;
                  Zx := 1;
               when others =>
                  --  Only 9 values.
                  raise Internal_Error;
            end case;
         when others =>
            raise Internal_Error;
      end case;
   end To_Logic;

   function Bit_Extract (Val : Value_Acc; Off : Uns32) return Value_Acc is
   begin
      case Val.Kind is
         when Value_Lit =>
            declare
               Lit : constant Iir_Value_Literal_Acc := Val.Lit;
            begin
               pragma Assert (Lit.Kind = Iir_Value_Array);
               pragma Assert (Lit.Bounds.Nbr_Dims = 1);
               pragma Assert (Lit.Bounds.D (1).Length >= Iir_Index32 (Off));
               return Create_Value_Lit
                 (Lit.Val_Array.V (Lit.Val_Array.Len - Iir_Index32 (Off)),
                  Get_Element_Subtype (Val.Lit_Type));
            end;
         when Value_Net
           | Value_Wire =>
            return Create_Value_Net
              (Build_Extract_Bit (Build_Context, Get_Net (Val), Off),
               No_Range);
         when others =>
            raise Internal_Error;
      end case;
   end Bit_Extract;

   function Vec_Extract (Val : Value_Acc; Off : Uns32; Rng : Value_Range_Acc)
                        return Value_Acc is
   begin
      case Val.Kind is
         when Value_Lit =>
            --  TODO.
            raise Internal_Error;
         when Value_Net
           | Value_Wire =>
            return Create_Value_Net
              (Build_Slice (Build_Context, Get_Net (Val), Off, Rng.Len),
               Rng);
         when others =>
            raise Internal_Error;
      end case;
   end Vec_Extract;

   function Synth_Uresize (Val : Value_Acc; W : Width) return Net
   is
      N : constant Net := Get_Net (Val);
      Wn : constant Width := Get_Width (N);
   begin
      if Wn > W then
         return Build_Trunc (Build_Context, Id_Utrunc, N, W);
      elsif Wn < W then
         return Build_Extend (Build_Context, Id_Uextend, N, W);
      else
         return N;
      end if;
   end Synth_Uresize;

   procedure Fill_Array_Aggregate
     (Syn_Inst : Synth_Instance_Acc;
      Aggr : Iir;
      Res : Value_Acc;
      Dim : Iir_Index32;
      Orig : Iir_Index32;
      Stride : Iir_Index32)
   is
      Bound : constant Iir_Value_Literal_Acc := Res.Bounds.D (Dim);
      Value : Iir;
      Assoc : Iir;
      Pos : Iir_Index32;

      procedure Set_Elem (Pos : Iir_Index32)
      is
         Val : Value_Acc;
      begin
         if Dim = Res.Bounds.Nbr_Dims then
            Val := Synth_Expression_With_Type
              (Syn_Inst, Value, Get_Element_Subtype (Get_Type (Aggr)));
            Res.Arr.V (Orig + Stride * Pos) := Val;
         else
            Error_Msg_Synth (+Assoc, "multi-dim aggregate not handled");
         end if;
      end Set_Elem;
   begin
      Assoc := Get_Association_Choices_Chain (Aggr);
      Pos := 0;
      while Is_Valid (Assoc) loop
         Value := Get_Associated_Expr (Assoc);
         loop
            case Get_Kind (Assoc) is
               when Iir_Kind_Choice_By_None =>
                  if Pos >= Bound.Length then
                     Error_Msg_Synth (+Assoc, "element out of array bound");
                  else
                     Set_Elem (Pos);
                  end if;
                  Pos := Pos + 1;
               when Iir_Kind_Choice_By_Others =>
                  while Pos < Bound.Length loop
                     Set_Elem (Pos);
                     Pos := Pos + 1;
                  end loop;
               when others =>
                  Error_Msg_Synth
                    (+Assoc, "unhandled association form");
            end case;
            Assoc := Get_Chain (Assoc);
            exit when Is_Null (Assoc);
            exit when not Get_Same_Alternative_Flag (Assoc);
         end loop;
      end loop;
   end Fill_Array_Aggregate;

   type Net_Array is array (Iir_Index32 range <>) of Net;
   type Net_Array_Acc is access Net_Array;
   procedure Free_Net_Array is new Ada.Unchecked_Deallocation
     (Net_Array, Net_Array_Acc);

   --  Convert the one-dimension VAL to a net by concatenating.
   function Vectorize_Array (Val : Value_Acc) return Value_Acc
   is
      Arr : Net_Array_Acc;
      Len : Iir_Index32;
      Idx, New_Idx : Iir_Index32;
      Res : Value_Acc;
   begin
      --  Dynamically allocate ARR to handle large arrays.
      Arr := new Net_Array (1 .. Val.Arr.Len);

      --  Gather consecutive constant values.
      Idx := 1;
      Len := 0;
      while Idx <= Val.Arr.Len loop
         declare
            W_Zx, B_Zx : Uns32;
            W_Va, B_Va : Uns32;
            Off : Natural;
            E : Net;
         begin
            W_Zx := 0;
            W_Va := 0;
            Off := 0;
            while Idx <= Val.Arr.Len
              and then Off < 32
              and then Is_Logic (Val.Arr.V (Idx))
            loop
               To_Logic (Val.Arr.V (Idx).Lit, B_Va, B_Zx);
               W_Zx := W_Zx or Shift_Left (B_Zx, Off);
               W_Va := W_Va or Shift_Left (B_Va, Off);
               Off := Off + 1;
               Idx := Idx + 1;
            end loop;
            if Off = 0 then
               E := Get_Net (Val.Arr.V (Idx));
               Idx := Idx + 1;
            else
               if W_Zx = 0 then
                  E := Build_Const_UB32
                    (Build_Context, W_Va, Uns32 (Off));
               else
                  E := Build_Const_UL32
                    (Build_Context, W_Va, W_Zx, Uns32 (Off));
               end if;
            end if;
            Len := Len + 1;
            Arr (Len) := E;
         end;
      end loop;

      while Len > 1 loop
         Idx := 1;
         New_Idx := 0;
         while Idx <= Len loop
            --  Gather at most 4 nets.
            New_Idx := New_Idx + 1;

            if Idx = Len then
               Arr (New_Idx) := Arr (Idx);
               Idx := Idx + 1;
            elsif Idx + 1 = Len then
               Arr (New_Idx) := Build_Concat2
                 (Build_Context, Arr (Idx), Arr (Idx + 1));
               Idx := Idx + 2;
            elsif Idx + 2 = Len then
               Arr (New_Idx) := Build_Concat3
                 (Build_Context, Arr (Idx), Arr (Idx + 1), Arr (Idx + 2));
               Idx := Idx + 3;
            else
               Arr (New_Idx) := Build_Concat4
                 (Build_Context,
                  Arr (Idx), Arr (Idx + 1), Arr (Idx + 2), Arr (Idx + 3));
               Idx := Idx + 4;
            end if;
         end loop;
         Len := New_Idx;
      end loop;

      Res := Create_Value_Net (Arr (1), Bounds_To_Range (Val.Bounds.D (1)));

      Free_Net_Array (Arr);

      return Res;
   end Vectorize_Array;

   function Synth_Aggregate (Syn_Inst : Synth_Instance_Acc;
                             Aggr : Iir;
                             Aggr_Type : Iir) return Value_Acc is
   begin
      case Get_Kind (Aggr_Type) is
         when Iir_Kind_Array_Type_Definition
           | Iir_Kind_Array_Subtype_Definition =>
            declare
               Bnd : Iir_Value_Literal_Acc;
               Res : Value_Acc;
            begin
               --  Create bounds.
               Bnd := Simul.Execution.Create_Array_Bounds_From_Type
                 (Syn_Inst.Sim, Aggr_Type, False);
               --  Allocate result
               Res := Create_Array_Value (Bnd.Bounds);
               Create_Array_Data (Res);
               Fill_Array_Aggregate
                 (Syn_Inst, Aggr, Res,
                  1, 1, Res.Arr.Len / Res.Bounds.D (1).Length);
               if Is_Vector_Type (Aggr_Type) then
                  --  Vectorize
                  Res := Vectorize_Array (Res);
               end if;
               return Res;
            end;
         when Iir_Kind_Record_Type_Definition
           | Iir_Kind_Record_Subtype_Definition =>
            raise Internal_Error;
         when others =>
            Error_Kind ("synth_aggregate", Aggr_Type);
      end case;
   end Synth_Aggregate;

   function Synth_Bit_Eq_Const (Cst : Value_Acc; Expr : Value_Acc; Loc : Iir)
                               return Value_Acc
   is
      pragma Unreferenced (Loc);
      Val : Uns32;
      Xz : Uns32;
   begin
      To_Logic (Cst.Lit, Val, Xz);
      if Xz /= 0 then
         return Create_Value_Net
           (Build_Const_UL32 (Build_Context, 0, 1, 1), No_Range);
      elsif Val = 1 then
         return Expr;
      else
         pragma Assert (Val = 0);
         return Create_Value_Net
           (Build_Monadic (Build_Context, Id_Not, Get_Net (Expr)), No_Range);
      end if;
   end Synth_Bit_Eq_Const;

   function Extract_Range (Val : Value_Acc) return Value_Range_Acc is
   begin
      case Val.Kind is
         when Value_Net =>
            return Val.N_Range;
         when Value_Wire =>
            return Val.W_Range;
         when others =>
            raise Internal_Error;
      end case;
   end Extract_Range;

   --  Create the result range of an operator.  According to the ieee standard,
   --  the range is LEN-1 downto 0.
   function Create_Res_Range (Prev : Value_Acc; N : Net)
                             return Value_Range_Acc
   is
      Res : Value_Range_Acc;
      Wd : Width;
   begin
      case Prev.Kind is
         when Value_Net
           | Value_Wire =>
            Res := Extract_Range (Prev);
         when Value_Lit =>
            Res := No_Range;
         when others =>
            raise Internal_Error;
      end case;

      if Res /= No_Range
        and then Res.Dir = Iir_Downto
        and then Res.Right = 0
      then
         --  Normalized range
         return Res;
      end if;

      Wd := Get_Width (N);
      return Create_Range_Value ((Iir_Downto, Wd, Int32 (Wd - 1), 0));
   end Create_Res_Range;

   function Synth_Dyadic_Operation (Def : Iir_Predefined_Functions;
                                    Left : Value_Acc;
                                    Right : Value_Acc;
                                    Loc : Iir) return Value_Acc
   is
      function Synth_Bit_Dyadic (Id : Dyadic_Module_Id) return Value_Acc is
      begin
         return Create_Value_Net
           (Build_Dyadic (Build_Context, Id, Get_Net (Left), Get_Net (Right)),
           No_Range);
      end Synth_Bit_Dyadic;

      --  function Synth_Vec_Dyadic (Id : Dyadic_Module_Id) return Value_Acc
      --  is
      --     L : constant Net := Get_Net (Left);
      --  begin
      --     return Create_Value_Net
      --       (Build_Dyadic (Build_Context, Id, L, Get_Net (Right)),
      --        Create_Res_Range (Left, L));
      --  end Synth_Vec_Dyadic;
   begin
      case Def is
         when Iir_Predefined_Error =>
            return null;

         when Iir_Predefined_Bit_And
           | Iir_Predefined_Boolean_And
           | Iir_Predefined_Ieee_1164_Scalar_And =>
            return Synth_Bit_Dyadic (Id_And);
         when Iir_Predefined_Bit_Xor
           | Iir_Predefined_Ieee_1164_Scalar_Xor =>
            return Synth_Bit_Dyadic (Id_Xor);
         when Iir_Predefined_Bit_Or
           | Iir_Predefined_Ieee_1164_Scalar_Or =>
            return Synth_Bit_Dyadic (Id_Or);

         when Iir_Predefined_Bit_Nor
           | Iir_Predefined_Ieee_1164_Scalar_Nor =>
            return Synth_Bit_Dyadic (Id_Nor);
         when Iir_Predefined_Bit_Nand
           | Iir_Predefined_Ieee_1164_Scalar_Nand =>
            return Synth_Bit_Dyadic (Id_Nand);
         when Iir_Predefined_Bit_Xnor
           | Iir_Predefined_Ieee_1164_Scalar_Xnor =>
            return Synth_Bit_Dyadic (Id_Xnor);

         when Iir_Predefined_Enum_Equality =>
            if Get_Width (Left) = 1 then
               if Is_Const (Left) then
                  return Synth_Bit_Eq_Const (Left, Right, Loc);
               elsif Is_Const (Right) then
                  return Synth_Bit_Eq_Const (Right, Left, Loc);
               end if;
            end if;
            --  TODO
            Error_Msg_Synth (+Loc, "unsupported enum equality");
            raise Internal_Error;
         when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat =>
            --  "+" (Unsigned, Natural)
            declare
               L : constant Net := Get_Net (Left);
            begin
               return Create_Value_Net
                 (Build_Dyadic (Build_Context, Id_Add,
                                L,
                                Synth_Uresize (Right, Get_Width (Left))),
                  Create_Res_Range (Left, L));
            end;
         when Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Nat =>
            --  "=" (Unsigned, Natural)
            return Create_Value_Net
              (Build_Compare (Build_Context, Id_Eq,
                              Get_Net (Left),
                              Synth_Uresize (Right, Get_Width (Left))),
               No_Range);
         when others =>
            Error_Msg_Synth
              (+Loc,
               "unhandled dyadic: " & Iir_Predefined_Functions'Image (Def));
            raise Internal_Error;
      end case;
   end Synth_Dyadic_Operation;

   function Synth_Monadic_Operation (Def : Iir_Predefined_Functions;
                                     Operand : Value_Acc;
                                     Loc : Iir) return Value_Acc
   is
      function Synth_Bit_Monadic (Id : Monadic_Module_Id) return Value_Acc is
      begin
         return Create_Value_Net
           (Build_Monadic (Build_Context, Id, Get_Net (Operand)),
            No_Range);
      end Synth_Bit_Monadic;
   begin
      case Def is
         when Iir_Predefined_Error =>
            return null;
         when Iir_Predefined_Ieee_1164_Scalar_Not =>
            return Synth_Bit_Monadic (Id_Not);
         when others =>
            Error_Msg_Synth
              (+Loc,
               "unhandled monadic: " & Iir_Predefined_Functions'Image (Def));
            raise Internal_Error;
      end case;
   end Synth_Monadic_Operation;

   function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Iir)
                       return Value_Acc is
   begin
      case Get_Kind (Name) is
         when Iir_Kind_Simple_Name =>
            return Synth_Name (Syn_Inst, Get_Named_Entity (Name));
         when Iir_Kind_Interface_Signal_Declaration
           | Iir_Kind_Variable_Declaration
           | Iir_Kind_Signal_Declaration =>
            return Get_Value (Syn_Inst, Name);
         when Iir_Kind_Constant_Declaration =>
            return Create_Value_Lit(
               Syn_Inst.Sim.Objects(Get_Info(Name).Slot),
               Get_Type(Name));
         when others =>
            Error_Kind ("synth_name", Name);
      end case;
   end Synth_Name;

   function In_Range (Rng : Value_Range_Acc; V : Int32) return Boolean is
   begin
      case Rng.Dir is
         when Iir_To =>
            return V >= Rng.Left and then V <= Rng.Right;
         when Iir_Downto =>
            return V <= Rng.Left and then V >= Rng.Right;
      end case;
   end In_Range;

   function Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Iir)
                               return Value_Acc
   is
      Pfx : constant Value_Acc :=
        Synth_Expression (Syn_Inst, Get_Prefix (Name));
      Indexes : constant Iir_Flist := Get_Index_List (Name);
      Idx_Val : constant Value_Acc :=
        Synth_Expression (Syn_Inst, Get_Nth_Element (Indexes, 0));
      Rng : Value_Range_Acc;
      Idx : Int32;
   begin
      if Get_Nbr_Elements (Indexes) /= 1 then
         Error_Msg_Synth (+Name, "multi-dim arrays not supported");
         return null;
      end if;

      if Idx_Val.Kind /= Value_Lit
        or else Idx_Val.Lit.Kind /= Iir_Value_I64
      then
         Error_Msg_Synth (+Name, "non constant integer index not supported");
         return null;
      end if;

      Rng := Extract_Range (Pfx);
      Idx := Int32 (Idx_Val.Lit.I64);
      if not In_Range (Rng, Idx) then
         Error_Msg_Synth (+Name, "index not within bounds");
         return null;
      end if;

      --  The offset is from the LSB (bit 0).  Bit 0 is the rightmost one.
      case Rng.Dir is
         when Iir_To =>
            return Bit_Extract (Pfx, Uns32 (Rng.Right - Idx));
         when Iir_Downto =>
            return Bit_Extract (Pfx, Uns32 (Idx - Rng.Right));
      end case;
   end Synth_Indexed_Name;

   function Synth_Slice_Name (Syn_Inst : Synth_Instance_Acc; Name : Iir)
                              return Value_Acc
   is
      Pfx : constant Value_Acc :=
        Synth_Expression (Syn_Inst, Get_Prefix (Name));
      Expr : constant Iir := Get_Suffix (Name);
      Res_Rng : Value_Range_Acc;
      Left, Right : Value_Acc;
      Dir : Iir_Direction;
      Rng : Value_Range_Acc;
   begin
      case Get_Kind (Expr) is
         when Iir_Kind_Range_Expression =>
            Left := Synth_Expression (Syn_Inst, Get_Left_Limit (Expr));
            Right := Synth_Expression (Syn_Inst, Get_Right_Limit (Expr));
            Dir := Get_Direction (Expr);
         when others =>
            Error_Msg_Synth (+Expr, "only range supported for slices");
      end case;

      if Left.Kind /= Value_Lit
        or else Left.Lit.Kind /= Iir_Value_I64
      then
         Error_Msg_Synth (+Name, "non constant integer left not supported");
         return null;
      end if;

      if Right.Kind /= Value_Lit
        or else Right.Lit.Kind /= Iir_Value_I64
      then
         Error_Msg_Synth (+Name, "non constant integer right not supported");
         return null;
      end if;

      Rng := Extract_Range (Pfx);
      if Rng.Dir /= Dir then
         Error_Msg_Synth (+Name, "direction mismatch in slice");
         return null;
      end if;

      if not In_Range (Rng, Int32 (Left.Lit.I64))
        or else not In_Range (Rng, Int32 (Right.Lit.I64))
      then
         Error_Msg_Synth (+Name, "index not within bounds");
         return null;
      end if;

      case Rng.Dir is
         when Iir_To =>
            Res_Rng := Create_Range_Value
              (Value_Range'(Dir => Iir_To,
                            Len => Width (Right.Lit.I64 - Left.Lit.I64 + 1),
                            Left => Int32 (Left.Lit.I64),
                            Right => Int32 (Right.Lit.I64)));
            return Vec_Extract
              (Pfx, Uns32 (Rng.Right - Res_Rng.Right), Res_Rng);
         when Iir_Downto =>
            Res_Rng := Create_Range_Value
              (Value_Range'(Dir => Iir_Downto,
                            Len => Width (Left.Lit.I64 - Right.Lit.I64 + 1),
                            Left => Int32 (Left.Lit.I64),
                            Right => Int32 (Right.Lit.I64)));
            return Vec_Extract
              (Pfx, Uns32 (Res_Rng.Right - Rng.Right), Res_Rng);
      end case;
   end Synth_Slice_Name;

   --  Match: clk_signal_name'event
   --  and return clk_signal_name.
   function Extract_Event_Expr_Prefix (Expr : Iir) return Iir is
   begin
      if Get_Kind (Expr) = Iir_Kind_Event_Attribute then
         return Get_Prefix (Expr);
      else
         return Null_Iir;
      end if;
   end Extract_Event_Expr_Prefix;

   function Is_Same_Node (Left, Right : Iir) return Boolean is
   begin
      if Get_Kind (Left) /= Get_Kind (Right) then
         return False;
      end if;
      case Get_Kind (Left) is
         when Iir_Kind_Simple_Name =>
            return Get_Named_Entity (Left) = Get_Named_Entity (Right);
         when others =>
            Error_Kind ("is_same_node", Left);
      end case;
   end Is_Same_Node;

   --  Match: clk_signal_name = '1' | clk_signal_name = '0'
   function Extract_Clock_Level
     (Syn_Inst : Synth_Instance_Acc; Expr : Iir; Prefix : Iir) return Net
   is
      Clk : Net;
      Imp : Iir;
      Left, Right : Iir;
      Lit : Iir;
      Posedge : Boolean;
   begin
      Clk := Get_Net (Synth_Name (Syn_Inst, Prefix));
      if Get_Kind (Expr) /= Iir_Kind_Equality_Operator then
         Error_Msg_Synth (+Expr, "ill-formed clock-level, '=' expected");
         return Build_Edge (Build_Context, Clk);
      end if;
      Imp := Get_Implementation (Expr);
      if Get_Implicit_Definition (Imp) /= Iir_Predefined_Enum_Equality then
         Error_Msg_Synth (+Expr, "ill-formed clock-level, '=' expected");
         return Build_Edge (Build_Context, Clk);
      end if;
      Left := Get_Left (Expr);
      Right := Get_Right (Expr);
      if Get_Kind (Right) /= Iir_Kind_Character_Literal then
         Error_Msg_Synth
           (+Expr, "ill-formed clock-level, '0' or '1' expected");
         return Build_Edge (Build_Context, Clk);
      end if;
      Lit := Get_Named_Entity (Right);
      if Lit = Vhdl.Std_Package.Bit_0
        or else Lit = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_0
      then
         Posedge := False;
      elsif Lit = Vhdl.Std_Package.Bit_1
        or else Lit = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_1
      then
         Posedge := True;
      else
         Error_Msg_Synth
           (+Lit, "ill-formed clock-level, '0' or '1' expected");
         Posedge := True;
      end if;
      if not Is_Same_Node (Prefix, Left) then
         Error_Msg_Synth
           (+Left, "clock signal name doesn't match");
      end if;
      if not Posedge then
         Clk := Build_Monadic (Build_Context, Id_Not, Clk);
      end if;
      return Build_Edge (Build_Context, Clk);
   end Extract_Clock_Level;

   function Synth_Clock_Edge (Syn_Inst : Synth_Instance_Acc; Expr : Iir)
                             return Value_Acc
   is
      pragma Assert (Get_Kind (Expr) = Iir_Kind_And_Operator);
      Left : constant Iir := Get_Left (Expr);
      Right : constant Iir := Get_Right (Expr);
      Prefix : Iir;
   begin
      --  Try with left.
      Prefix := Extract_Event_Expr_Prefix (Left);
      if Is_Valid (Prefix) then
         return Create_Value_Net
           (Extract_Clock_Level (Syn_Inst, Right, Prefix), No_Range);
      end if;

      --  Try with right.
      Prefix := Extract_Event_Expr_Prefix (Right);
      if Is_Valid (Prefix) then
         return Create_Value_Net
           (Extract_Clock_Level (Syn_Inst, Left, Prefix), No_Range);
      end if;

      return null;
   end Synth_Clock_Edge;

   function Synth_Type_Conversion (Syn_Inst : Synth_Instance_Acc; Conv : Iir)
                                  return Value_Acc
   is
      Expr : constant Iir := Get_Expression (Conv);
      Val : Value_Acc;
   begin
      Val := Synth_Expression (Syn_Inst, Expr);
      if Is_Vector_Type (Get_Type (Conv)) then
         return Val;
      else
         Error_Msg_Synth (+Conv, "unhandled type conversion");
         return Val;
      end if;
   end Synth_Type_Conversion;

   function Synth_Assoc_In (Syn_Inst : Synth_Instance_Acc;
                            Assoc : Iir) return Value_Acc is
   begin
      if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then
         return Synth_Expression (Syn_Inst, Get_Actual (Assoc));
      else
         Error_Kind ("synth_assoc_in", Assoc);
      end if;
   end Synth_Assoc_In;

   procedure Error_Unknown_Operator (Imp : Iir; Loc : Iir) is
   begin
      if Get_Kind (Get_Parent (Imp)) = Iir_Kind_Package_Declaration
        and then (Get_Identifier
                    (Get_Library
                       (Get_Design_File (Get_Design_Unit (Get_Parent (Imp)))))
                    = Std_Names.Name_Ieee)
      then
         Error_Msg_Synth (+Loc, "unhandled predefined IEEE operator %i", +Imp);
         Error_Msg_Synth (+Imp, " declared here");
      else
         Error_Msg_Synth (+Loc, "user defined operator %i not handled", +Imp);
      end if;
   end Error_Unknown_Operator;

   function Synth_Expression_With_Type
     (Syn_Inst : Synth_Instance_Acc; Expr : Iir; Expr_Type : Iir)
     return Value_Acc is
   begin
      case Get_Kind (Expr) is
         when Iir_Kinds_Dyadic_Operator =>
            declare
               Imp : constant Iir := Get_Implementation (Expr);
               Def : constant Iir_Predefined_Functions :=
                 Get_Implicit_Definition (Imp);
               Left : Value_Acc;
               Right : Value_Acc;
            begin
               --  Match clock-edge
               if Def = Iir_Predefined_Boolean_And then
                  Left := Synth_Clock_Edge (Syn_Inst, Expr);
                  if Left /= null then
                     return Left;
                  end if;
               end if;

               Left := Synth_Expression (Syn_Inst, Get_Left (Expr));
               Right := Synth_Expression (Syn_Inst, Get_Right (Expr));
               if Def in Iir_Predefined_Implicit
                 or else Def in Iir_Predefined_IEEE_Explicit
               then
                  return Synth_Dyadic_Operation (Def, Left, Right, Expr);
               else
                  Error_Unknown_Operator (Imp, Expr);
                  return Left;
               end if;
            end;
         when Iir_Kinds_Monadic_Operator =>
            declare
               Imp : constant Iir := Get_Implementation (Expr);
               Def : constant Iir_Predefined_Functions :=
                 Get_Implicit_Definition (Imp);
               Operand : Value_Acc;
            begin
               Operand := Synth_Expression (Syn_Inst, Get_Operand (Expr));
               if Def in Iir_Predefined_Implicit
                 or else Def in Iir_Predefined_IEEE_Explicit
               then
                  return Synth_Monadic_Operation (Def, Operand, Expr);
               else
                  Error_Unknown_Operator (Imp, Expr);
                  return Operand;
               end if;
            end;
         when Iir_Kind_Simple_Name =>
            return Synth_Name (Syn_Inst, Expr);
         when Iir_Kind_Indexed_Name =>
            return Synth_Indexed_Name (Syn_Inst, Expr);
         when Iir_Kind_Slice_Name =>
            return Synth_Slice_Name (Syn_Inst, Expr);
         when Iir_Kind_Character_Literal
           | Iir_Kind_Integer_Literal
           | Iir_Kind_String_Literal8
           | Iir_Kind_Enumeration_Literal =>
            return Create_Value_Lit
              (Simul.Execution.Execute_Expression (Syn_Inst.Sim, Expr),
               Get_Base_Type (Get_Type (Expr)));
         when Iir_Kind_Type_Conversion =>
            return Synth_Type_Conversion (Syn_Inst, Expr);
         when Iir_Kind_Qualified_Expression =>
            return Synth_Expression_With_Type
              (Syn_Inst, Get_Expression (Expr), Get_Type (Expr));
         when Iir_Kind_Function_Call =>
            declare
               Imp : constant Iir := Get_Implementation (Expr);
               Clk : Net;
               Edge : Net;
            begin
               if Imp = Vhdl.Ieee.Std_Logic_1164.Rising_Edge then
                  Clk := Get_Net
                    (Synth_Assoc_In
                       (Syn_Inst, Get_Parameter_Association_Chain (Expr)));
                  Edge := Build_Edge (Build_Context, Clk);
                  return Create_Value_Net (Edge, No_Range);
               elsif Imp = Vhdl.Ieee.Std_Logic_1164.Falling_Edge then
                  Clk := Get_Net
                    (Synth_Assoc_In
                       (Syn_Inst, Get_Parameter_Association_Chain (Expr)));
                  Clk := Build_Monadic (Build_Context, Id_Not, Clk);
                  Edge := Build_Edge (Build_Context, Clk);
                  return Create_Value_Net (Edge, No_Range);
               end if;
               Error_Msg_Synth
                 (+Expr, "user function call to %i is not handled", +Imp);
            end;
         when Iir_Kind_Aggregate =>
            return Synth_Aggregate (Syn_Inst, Expr, Expr_Type);
         when others =>
            Error_Kind ("synth_expression", Expr);
      end case;
      raise Fatal_Error;
      return null;
   end Synth_Expression_With_Type;

   function Synth_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Iir)
                             return Value_Acc is
   begin
      return Synth_Expression_With_Type (Syn_Inst, Expr, Get_Type (Expr));
   end Synth_Expression;

end Synth.Expr;