From 1abd7e0a8e028feaba2a97cbba5666113bb85114 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sat, 18 Apr 2020 09:25:09 +0200
Subject: vhdl-prints: handle evaluated expression for qualified_expression.

---
 src/vhdl/vhdl-prints.adb | 35 +++++++++++++++++++----------------
 src/vhdl/vhdl-utils.adb  | 28 ++++++++++++++++++++++++++++
 src/vhdl/vhdl-utils.ads  |  5 +++++
 3 files changed, 52 insertions(+), 16 deletions(-)

(limited to 'src')

diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb
index 22bfa05cd..f1d2d7a79 100644
--- a/src/vhdl/vhdl-prints.adb
+++ b/src/vhdl/vhdl-prints.adb
@@ -4442,6 +4442,24 @@ package body Vhdl.Prints is
       end case;
    end Disp_Vhdl;
 
+   procedure Print_Qualified_Expression (Ctxt : in out Ctxt_Class; Expr: Iir)
+   is
+      Qexpr : constant Iir := Strip_Literal_Origin (Get_Expression (Expr));
+      Has_Paren : constant Boolean :=
+        Get_Kind (Qexpr) = Iir_Kind_Parenthesis_Expression
+        or else Get_Kind (Qexpr) = Iir_Kind_Aggregate;
+   begin
+      Print (Ctxt, Get_Type_Mark (Expr));
+      Disp_Token (Ctxt, Tok_Tick);
+      if not Has_Paren then
+         Disp_Token (Ctxt, Tok_Left_Paren);
+      end if;
+      Print (Ctxt, Qexpr);
+      if not Has_Paren then
+         Disp_Token (Ctxt, Tok_Right_Paren);
+      end if;
+   end Print_Qualified_Expression;
+
    procedure Print (Ctxt : in out Ctxt_Class; Expr: Iir)
    is
       Orig : Iir;
@@ -4571,22 +4589,7 @@ package body Vhdl.Prints is
             Print (Ctxt, Get_Expression (Expr));
             Disp_Token (Ctxt, Tok_Right_Paren);
          when Iir_Kind_Qualified_Expression =>
-            declare
-               Qexpr : constant Iir := Get_Expression (Expr);
-               Has_Paren : constant Boolean :=
-                 Get_Kind (Qexpr) = Iir_Kind_Parenthesis_Expression
-                 or else Get_Kind (Qexpr) = Iir_Kind_Aggregate;
-            begin
-               Print (Ctxt, Get_Type_Mark (Expr));
-               Disp_Token (Ctxt, Tok_Tick);
-               if not Has_Paren then
-                  Disp_Token (Ctxt, Tok_Left_Paren);
-               end if;
-               Print (Ctxt, Qexpr);
-               if not Has_Paren then
-                  Disp_Token (Ctxt, Tok_Right_Paren);
-               end if;
-            end;
+            Print_Qualified_Expression (Ctxt, Expr);
          when Iir_Kind_Allocator_By_Expression =>
             Disp_Token (Ctxt, Tok_New);
             Print (Ctxt, Get_Expression (Expr));
diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb
index 40b4f7947..461f301f4 100644
--- a/src/vhdl/vhdl-utils.adb
+++ b/src/vhdl/vhdl-utils.adb
@@ -34,6 +34,34 @@ package body Vhdl.Utils is
       return Get_Kind (N) = Iir_Kind_Overflow_Literal;
    end Is_Overflow_Literal;
 
+   function Strip_Literal_Origin (N : Iir) return Iir
+   is
+      Orig : Iir;
+   begin
+      if N = Null_Iir then
+         return N;
+      end if;
+      case Get_Kind (N) is
+         when Iir_Kind_String_Literal8
+           |  Iir_Kind_Integer_Literal
+           |  Iir_Kind_Floating_Point_Literal
+           |  Iir_Kind_Physical_Int_Literal
+           |  Iir_Kind_Physical_Fp_Literal
+           |  Iir_Kind_Simple_Aggregate
+           |  Iir_Kind_Overflow_Literal
+           |  Iir_Kind_Enumeration_Literal
+           |  Iir_Kind_Aggregate =>
+            Orig := Get_Literal_Origin (N);
+            if Orig /= Null_Iir then
+               return Orig;
+            else
+               return N;
+            end if;
+         when others =>
+            return N;
+      end case;
+   end Strip_Literal_Origin;
+
    function List_To_Flist (L : Iir_List) return Iir_Flist
    is
       Len : constant Natural := Get_Nbr_Elements (L);
diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads
index 4ca9d83e3..e7de3a76c 100644
--- a/src/vhdl/vhdl-utils.ads
+++ b/src/vhdl/vhdl-utils.ads
@@ -32,6 +32,11 @@ package Vhdl.Utils is
    function Is_Overflow_Literal (N : Iir) return Boolean;
    pragma Inline (Is_Overflow_Literal);
 
+   --  If N is a literal and has a literal origin, return the literal origin.
+   --  Otherwise return N.
+   --  In other words, return the node as it was.
+   function Strip_Literal_Origin (N : Iir) return Iir;
+
    --  Find LIT in the list of identifiers or characters LIST.
    --  Return the literal (whose name is LIT) or null_iir if not found.
    function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir;
-- 
cgit v1.2.3