synth: get rid of execution and elaboration.

1 files changed, 185 insertions, 13 deletions

diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 8352707e2..b9ce77fed 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -23,15 +23,19 @@ with Mutils; use Mutils;
 with Netlists; use Netlists;
 with Netlists.Builders; use Netlists.Builders;
 with Vhdl.Errors; use Vhdl.Errors;
+with Vhdl.Utils; use Vhdl.Utils;
 with Synth.Types; use Synth.Types;
 with Synth.Values; use Synth.Values;
 with Synth.Environment; use Synth.Environment;
-with Simul.Environments; use Simul.Environments;
+with Synth.Expr; use Synth.Expr;
 with Simul.Annotations; use Simul.Annotations;
 
 package body Synth.Decls is
+   procedure Synth_Anonymous_Subtype_Indication
+     (Syn_Inst : Synth_Instance_Acc; Atype : Node);
+
    procedure Create_Var_Wire
-     (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Iir_Value_Literal_Acc)
+     (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Value_Acc)
    is
       Val : constant Value_Acc := Get_Value (Syn_Inst, Decl);
       Value : Net;
@@ -45,7 +49,7 @@ package body Synth.Decls is
             W := Get_Width (Syn_Inst, Get_Type (Decl));
             Name := New_Sname (Syn_Inst.Name, Get_Identifier (Decl));
             if Init /= null then
-               Ival := Get_Net (Create_Value_Lit (Init, Get_Type (Decl)));
+               Ival := Get_Net (Init, Get_Type (Decl));
                pragma Assert (Get_Width (Ival) = W);
                Value := Build_Isignal (Build_Context, Name, Ival);
             else
@@ -88,18 +92,182 @@ package body Synth.Decls is
       end case;
    end Synth_Type_Definition;
 
+   function Synth_Range_Constraint
+     (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Value_Acc is
+   begin
+      case Get_Kind (Rng) is
+         when Iir_Kind_Range_Expression =>
+            --  FIXME: check range.
+            return Synth_Range_Expression (Syn_Inst, Rng);
+         when others =>
+            Error_Kind ("synth_range_constraint", Rng);
+      end case;
+   end Synth_Range_Constraint;
+
+   procedure Synth_Subtype_Indication
+     (Syn_Inst : Synth_Instance_Acc; Atype : Node) is
+   begin
+      case Get_Kind (Atype) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            --  LRM93 12.3.1.3
+            --  The elaboration of an index constraint consists of the
+            --  declaration of each of the discrete ranges in the index
+            --  constraint in some order that is not defined by the language.
+            Synth_Anonymous_Subtype_Indication
+              (Syn_Inst, Get_Element_Subtype (Atype));
+            declare
+               St_Indexes : constant Iir_Flist :=
+                 Get_Index_Subtype_List (Atype);
+               St_El : Iir;
+               Bnds : Value_Bound_Array_Acc;
+            begin
+               --  FIXME: partially constrained arrays, subtype in indexes...
+               Bnds := Create_Value_Bound_Array
+                 (Iir_Index32 (Get_Nbr_Elements (St_Indexes)));
+               for I in Flist_First .. Flist_Last (St_Indexes) loop
+                  St_El := Get_Index_Type (St_Indexes, I);
+                  Bnds.D (Iir_Index32 (I + 1)) :=
+                    Synth_Bounds_From_Range (Syn_Inst, St_El);
+               end loop;
+               Create_Object (Syn_Inst, Atype,
+                              Create_Value_Bounds (Bnds));
+            end;
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            declare
+               Val : Value_Acc;
+            begin
+               Val := Synth_Range_Constraint
+                 (Syn_Inst, Get_Range_Constraint (Atype));
+               Create_Object (Syn_Inst, Atype, Unshare (Val, Instance_Pool));
+            end;
+         when Iir_Kind_Enumeration_Subtype_Definition =>
+            null;
+         when others =>
+            Error_Kind ("synth_subtype_indication", Atype);
+      end case;
+   end Synth_Subtype_Indication;
+
+   procedure Synth_Anonymous_Subtype_Indication
+     (Syn_Inst : Synth_Instance_Acc; Atype : Node) is
+   begin
+      if Atype = Null_Node
+        or else Get_Type_Declarator (Atype) /= Null_Node
+      then
+         return;
+      end if;
+      Synth_Subtype_Indication (Syn_Inst, Atype);
+   end Synth_Anonymous_Subtype_Indication;
+
+   procedure Synth_Declaration_Type
+     (Syn_Inst : Synth_Instance_Acc; Decl : Node)
+   is
+      Ind : constant Node := Get_Subtype_Indication (Decl);
+      Atype : Node;
+   begin
+      if Ind = Null_Node then
+         --  No subtype indication; use the same type.
+         return;
+      end if;
+      Atype := Ind;
+      loop
+         case Get_Kind (Atype) is
+            when Iir_Kinds_Denoting_Name =>
+               Atype := Get_Named_Entity (Atype);
+            when Iir_Kind_Subtype_Declaration
+              | Iir_Kind_Type_Declaration =>
+               return;
+            when Iir_Kind_Array_Subtype_Definition
+              | Iir_Kind_Integer_Subtype_Definition
+              | Iir_Kind_Floating_Subtype_Definition
+              | Iir_Kind_Physical_Subtype_Definition
+              | Iir_Kind_Enumeration_Subtype_Definition =>
+               Synth_Subtype_Indication (Syn_Inst, Atype);
+               return;
+            when others =>
+               Error_Kind ("synth_declaration_type", Atype);
+         end case;
+      end loop;
+   end Synth_Declaration_Type;
+
+   procedure Synth_Constant_Declaration
+     (Syn_Inst : Synth_Instance_Acc; Decl : Node)
+   is
+      Deferred_Decl : constant Node := Get_Deferred_Declaration (Decl);
+      First_Decl : Node;
+      Val : Value_Acc;
+   begin
+      if Deferred_Decl = Null_Node
+        or else Get_Deferred_Declaration_Flag (Decl)
+      then
+         --  Create the object (except for full declaration of a
+         --  deferred constant).
+         Synth_Declaration_Type (Syn_Inst, Decl);
+         Create_Object (Syn_Inst, Decl, null);
+      end if;
+      --  Initialize the value (except for a deferred declaration).
+      if Deferred_Decl = Null_Node then
+         First_Decl := Decl;
+      elsif not Get_Deferred_Declaration_Flag (Decl) then
+         First_Decl := Deferred_Decl;
+      else
+         First_Decl := Null_Node;
+      end if;
+      if First_Decl /= Null_Node then
+         Val := Synth_Expression_With_Type
+           (Syn_Inst, Get_Default_Value (Decl), Get_Type (Decl));
+         Syn_Inst.Objects (Get_Info (First_Decl).Slot) := Val;
+      end if;
+   end Synth_Constant_Declaration;
+
+   procedure Synth_Attribute_Specification
+     (Syn_Inst : Synth_Instance_Acc; Decl : Node)
+   is
+      Value : Iir_Attribute_Value;
+      Val : Value_Acc;
+   begin
+      Value := Get_Attribute_Value_Spec_Chain (Decl);
+      while Value /= Null_Iir loop
+         --  2. The expression is evaluated to determine the value
+         --     of the attribute.
+         --     It is an error if the value of the expression does not
+         --     belong to the subtype of the attribute; if the
+         --     attribute is of an array type, then an implicit
+         --     subtype conversion is first performed on the value,
+         --     unless the attribute's subtype indication denotes an
+         --     unconstrained array type.
+         Val := Synth_Expression_With_Type
+           (Syn_Inst, Get_Expression (Decl), Get_Type (Value));
+         --  Check_Constraints (Instance, Val, Attr_Type, Decl);
+
+         --  3. A new instance of the designated attribute is created
+         --     and associated with each of the affected items.
+         --
+         --  4. Each new attribute instance is assigned the value of
+         --     the expression.
+         Create_Object (Syn_Inst, Value, Val);
+         --  Unshare (Val, Instance_Pool);
+
+         Value := Get_Spec_Chain (Value);
+      end loop;
+   end Synth_Attribute_Specification;
+
+
    procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node) is
    begin
       case Get_Kind (Decl) is
          when Iir_Kind_Variable_Declaration =>
+            Synth_Declaration_Type (Syn_Inst, Decl);
             declare
                Def : constant Iir := Get_Default_Value (Decl);
-               Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
-               Init : Iir_Value_Literal_Acc;
+               --  Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+               Init : Value_Acc;
             begin
                Make_Object (Syn_Inst, Wire_Variable, Decl);
                if Is_Valid (Def) then
-                  Init := Syn_Inst.Sim.Objects (Slot);
+                  --  TODO.
+                  raise Internal_Error;
                else
                   Init := null;
                end if;
@@ -110,16 +278,19 @@ package body Synth.Decls is
             Make_Object (Syn_Inst, Wire_Variable, Decl);
             Create_Var_Wire (Syn_Inst, Decl, null);
          when Iir_Kind_Constant_Declaration =>
-            null;
+            Synth_Constant_Declaration (Syn_Inst, Decl);
          when Iir_Kind_Signal_Declaration =>
+            Synth_Declaration_Type (Syn_Inst, Decl);
             declare
                Def : constant Iir := Get_Default_Value (Decl);
-               Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
-               Init : Iir_Value_Literal_Acc;
+               --  Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+               Init : Value_Acc;
             begin
                Make_Object (Syn_Inst, Wire_Signal, Decl);
                if Is_Valid (Def) then
-                  Init := Syn_Inst.Sim.Objects (Slot + 1);
+                  --  TODO.
+                  raise Internal_Error;
+                  --  Init := Syn_Inst.Sim.Objects (Slot + 1);
                else
                   Init := null;
                end if;
@@ -133,15 +304,16 @@ package body Synth.Decls is
            | Iir_Kind_Function_Body =>
             null;
          when Iir_Kind_Attribute_Declaration =>
+            --  Nothing to do: the type is a type_mark, not a subtype
+            --  indication.
             null;
          when Iir_Kind_Attribute_Specification =>
-            null;
+            Synth_Attribute_Specification (Syn_Inst, Decl);
          when Iir_Kind_Type_Declaration
            | Iir_Kind_Anonymous_Type_Declaration =>
             Synth_Type_Definition (Syn_Inst, Get_Type_Definition (Decl));
          when  Iir_Kind_Subtype_Declaration =>
-            --  TODO
-            null;
+            Synth_Declaration_Type (Syn_Inst, Decl);
          when Iir_Kind_Component_Declaration =>
             null;
          when Iir_Kind_File_Declaration =>