Rework errors handling, to have a more generic framework.

2 files changed, 61 insertions, 4 deletions

diff --git a/src/vhdl/vhdl-errors.adb b/src/vhdl/vhdl-errors.adb
index 6fcdacf67..ad57a735c 100644
--- a/src/vhdl/vhdl-errors.adb
+++ b/src/vhdl/vhdl-errors.adb
@@ -999,4 +999,60 @@ package body Vhdl.Errors is
       end case;
    end Get_Mode_Name;
 
+   function "+" (V : Iir) return Earg_Type is
+   begin
+      return Make_Earg_Vhdl_Node (Uns32 (V));
+   end "+";
+
+   function "+" (V : Vhdl.Tokens.Token_Type) return Earg_Type is
+   begin
+      return Make_Earg_Vhdl_Token (Vhdl.Tokens.Token_Type'Pos (V));
+   end "+";
+
+   procedure Vhdl_Node_Handler
+     (Format : Character; Err : Error_Record; Val : Uns32)
+   is
+      N : constant Iir := Iir (Val);
+   begin
+      case Format is
+         when 'i' =>
+            Output_Identifier (Get_Identifier (N));
+         when 'l' =>
+            Output_Location (Err, Get_Location (N));
+         when 'n' =>
+            Output_Message (Disp_Node (N));
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Vhdl_Node_Handler;
+
+   procedure Vhdl_Token_Handler
+     (Format : Character; Err : Error_Record; Val : Uns32)
+   is
+      pragma Unreferenced (Err);
+      use Vhdl.Tokens;
+      Tok : constant Token_Type := Token_Type'Val (Val);
+   begin
+      case Format is
+         when 't' =>
+            case Tok is
+               when Tok_Identifier =>
+                  Output_Message ("an identifier");
+               when Tok_Eof =>
+                  Output_Message ("end of file");
+               when others =>
+                  Output_Message ("'");
+                  Output_Message (Image (Tok));
+                  Output_Message ("'");
+            end case;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Vhdl_Token_Handler;
+
+   procedure Initialize is
+   begin
+      Register_Earg_Handler (Earg_Vhdl_Node, Vhdl_Node_Handler'Access);
+      Register_Earg_Handler (Earg_Vhdl_Token, Vhdl_Token_Handler'Access);
+   end Initialize;
 end Vhdl.Errors;
diff --git a/src/vhdl/vhdl-errors.ads b/src/vhdl/vhdl-errors.ads
index 97d38e7d6..98b8f1c9e 100644
--- a/src/vhdl/vhdl-errors.ads
+++ b/src/vhdl/vhdl-errors.ads
@@ -21,16 +21,17 @@ with Vhdl.Nodes; use Vhdl.Nodes;
 with Vhdl.Tokens;
 
 package Vhdl.Errors is
+   --  Register handlers so that errors can be handled.
+   procedure Initialize;
+
    --  This kind can't be handled.
    procedure Error_Kind (Msg: String; N : Iir);
    procedure Error_Kind (Msg: String; Def : Iir_Predefined_Functions);
    pragma No_Return (Error_Kind);
 
    --  Conversions
-   function "+" (V : Iir) return Earg_Type
-     renames Errorout.Make_Earg_Vhdl_Node;
-   function "+" (V : Vhdl.Tokens.Token_Type) return Earg_Type
-     renames Errorout.Make_Earg_Vhdl_Token;
+   function "+" (V : Iir) return Earg_Type;
+   function "+" (V : Vhdl.Tokens.Token_Type) return Earg_Type;
 
    --  Convert location.
    function "+" (L : Iir) return Location_Type;