From ce315116b6b9360659511eb23f7dfb231921327e Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Thu, 30 May 2019 14:36:33 +0200
Subject: vhdl: add code formatter (WIP)
---
src/ghdldrv/ghdlprint.adb | 13 ++-
src/vhdl/vhdl-formatters.adb | 255 +++++++++++++++++++++++++++++++++++++++++++
src/vhdl/vhdl-formatters.ads | 24 ++++
3 files changed, 291 insertions(+), 1 deletion(-)
create mode 100644 src/vhdl/vhdl-formatters.adb
create mode 100644 src/vhdl/vhdl-formatters.ads
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index 6d1d8d5e5..d7293a778 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -38,6 +38,7 @@ with Vhdl.Sem_Lib; use Vhdl.Sem_Lib;
with Ghdlmain; use Ghdlmain;
with Ghdllocal; use Ghdllocal;
with Vhdl.Prints;
+with Vhdl.Formatters;
with Vhdl.Elocations;
package body Ghdlprint is
@@ -959,6 +960,7 @@ package body Ghdlprint is
-- Command Reprint.
type Command_Reprint is new Command_Lib with record
Flag_Sem : Boolean := True;
+ Flag_Format : Boolean := False;
end record;
function Decode_Command (Cmd : Command_Reprint; Name : String)
return Boolean;
@@ -993,6 +995,9 @@ package body Ghdlprint is
if Option = "--no-sem" then
Cmd.Flag_Sem := False;
Res := Option_Ok;
+ elsif Option = "--format" then
+ Cmd.Flag_Format := True;
+ Res := Option_Ok;
else
Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
end if;
@@ -1045,7 +1050,9 @@ package body Ghdlprint is
Next_Unit := Get_Chain (Unit);
if Errorout.Nbr_Errors = 0 then
- Vhdl.Prints.Disp_Vhdl (Unit);
+ if not Cmd.Flag_Format then
+ Vhdl.Prints.Disp_Vhdl (Unit);
+ end if;
if Cmd.Flag_Sem then
Set_Chain (Unit, Null_Iir);
Libraries.Add_Design_Unit_Into_Library (Unit);
@@ -1058,6 +1065,10 @@ package body Ghdlprint is
if Errorout.Nbr_Errors > 0 then
raise Errorout.Compilation_Error;
end if;
+
+ if Cmd.Flag_Format then
+ Vhdl.Formatters.Format (Design_File);
+ end if;
end loop;
end Perform_Action;
diff --git a/src/vhdl/vhdl-formatters.adb b/src/vhdl/vhdl-formatters.adb
new file mode 100644
index 000000000..bbb18d95d
--- /dev/null
+++ b/src/vhdl/vhdl-formatters.adb
@@ -0,0 +1,255 @@
+-- VHDL code formatter.
+-- Copyright (C) 2019 Tristan Gingold
+--
+-- GHDL 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, or (at your option) any later
+-- version.
+--
+-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+with Types; use Types;
+with Files_Map;
+with Simple_IO;
+with Vhdl.Tokens; use Vhdl.Tokens;
+with Vhdl.Scanner; use Vhdl.Scanner;
+with Vhdl.Prints; use Vhdl.Prints;
+
+package body Vhdl.Formatters is
+ package Format_Disp_Ctxt is
+ type Format_Ctxt is new Disp_Ctxt with record
+ Vnum : Natural;
+ Hnum : Natural;
+ Prev_Tok : Token_Type;
+ Sfe : Source_File_Entry;
+ Source : File_Buffer_Acc;
+ end record;
+
+ procedure Init (Ctxt : out Format_Ctxt; Sfe : Source_File_Entry);
+ procedure Start_Hbox (Ctxt : in out Format_Ctxt);
+ procedure Close_Hbox (Ctxt : in out Format_Ctxt);
+ procedure Start_Vbox (Ctxt : in out Format_Ctxt);
+ procedure Close_Vbox (Ctxt : in out Format_Ctxt);
+ procedure Disp_Token (Ctxt : in out Format_Ctxt; Tok : Token_Type);
+ procedure Start_Lit (Ctxt : in out Format_Ctxt; Tok : Token_Type);
+ procedure Disp_Char (Ctxt : in out Format_Ctxt; C : Character);
+ procedure Close_Lit (Ctxt : in out Format_Ctxt);
+ private
+ procedure Disp_Newline (Ctxt : in out Format_Ctxt);
+ procedure Disp_Indent (Ctxt : in out Format_Ctxt);
+ procedure Put (Ctxt : in out Format_Ctxt; C : Character);
+ procedure Sync (Ctxt : in out Format_Ctxt; Tok : Token_Type);
+ end Format_Disp_Ctxt;
+
+ package body Format_Disp_Ctxt is
+ procedure Init (Ctxt : out Format_Ctxt; Sfe : Source_File_Entry) is
+ begin
+ Ctxt := (Vnum => 0,
+ Hnum => 0,
+ Prev_Tok => Tok_Newline,
+ Sfe => Sfe,
+ Source => Files_Map.Get_File_Source (Sfe));
+ end Init;
+
+ procedure Put (Ctxt : in out Format_Ctxt; C : Character)
+ is
+ pragma Unreferenced (Ctxt);
+ begin
+ Simple_IO.Put (C);
+ end Put;
+
+ procedure Start_Hbox (Ctxt : in out Format_Ctxt) is
+ begin
+ Ctxt.Hnum := Ctxt.Hnum + 1;
+ end Start_Hbox;
+
+ procedure Disp_Newline (Ctxt : in out Format_Ctxt) is
+ begin
+ Put (Ctxt, ASCII.LF);
+ Ctxt.Prev_Tok := Tok_Newline;
+ end Disp_Newline;
+
+ procedure Close_Hbox (Ctxt : in out Format_Ctxt) is
+ begin
+ Ctxt.Hnum := Ctxt.Hnum - 1;
+ if Ctxt.Hnum = 0 then
+ Disp_Newline (Ctxt);
+ end if;
+ end Close_Hbox;
+
+ procedure Start_Vbox (Ctxt : in out Format_Ctxt) is
+ begin
+ pragma Assert (Ctxt.Hnum = 0);
+ Ctxt.Vnum := Ctxt.Vnum + 1;
+ end Start_Vbox;
+
+ procedure Close_Vbox (Ctxt : in out Format_Ctxt) is
+ begin
+ Ctxt.Vnum := Ctxt.Vnum - 1;
+ end Close_Vbox;
+
+ procedure Disp_Indent (Ctxt : in out Format_Ctxt) is
+ begin
+ for I in 1 .. Ctxt.Vnum loop
+ Put (Ctxt, ' ');
+ Put (Ctxt, ' ');
+ end loop;
+ end Disp_Indent;
+
+ procedure Disp_Space (Ctxt : in out Format_Ctxt; Tok : Token_Type)
+ is
+ Prev_Tok : constant Token_Type := Ctxt.Prev_Tok;
+ begin
+ if Prev_Tok = Tok_Newline
+ and then Ctxt.Hnum = 1
+ then
+ Disp_Indent (Ctxt);
+ elsif Need_Space (Tok, Prev_Tok) then
+ Put (Ctxt, ' ');
+ end if;
+ Ctxt.Prev_Tok := Tok;
+ end Disp_Space;
+
+ procedure Disp_Token (Ctxt : in out Format_Ctxt; Tok : Token_Type) is
+ begin
+ Sync (Ctxt, Tok);
+ Disp_Space (Ctxt, Tok);
+ Disp_Str (Ctxt, Image (Tok));
+ end Disp_Token;
+
+ procedure Start_Lit (Ctxt : in out Format_Ctxt; Tok : Token_Type) is
+ begin
+ Sync (Ctxt, Tok);
+ Disp_Space (Ctxt, Tok);
+ end Start_Lit;
+
+ procedure Disp_Char (Ctxt : in out Format_Ctxt; C : Character) is
+ begin
+ Put (Ctxt, C);
+ end Disp_Char;
+
+ procedure Close_Lit (Ctxt : in out Format_Ctxt) is
+ begin
+ null;
+ end Close_Lit;
+
+ procedure Sync (Ctxt : in out Format_Ctxt; Tok : Token_Type) is
+ begin
+ -- The easy case.
+ loop
+ case Current_Token is
+ when Tok_Eof =>
+ raise Internal_Error;
+ when Tok_Newline =>
+ -- Ignored
+ Scan;
+ -- But empty lines are kept.
+ while Current_Token = Tok_Newline loop
+ Disp_Newline (Ctxt);
+ Scan;
+ end loop;
+ when Tok_Line_Comment
+ | Tok_Block_Comment =>
+ -- Display the comment as it is.
+ declare
+ P : Source_Ptr;
+ begin
+ -- Re-indent the comment unless this is an end-of-line
+ -- comment or a comment at line 0.
+ if Ctxt.Prev_Tok = Tok_Newline then
+ -- Compute the offset. Not trivial for block
+ -- comment as this is a multi-line token and
+ -- Get_Token_Offset is not valid in that case.
+ declare
+ Off : Natural;
+ Line_Pos : Source_Ptr;
+ Line : Positive;
+ begin
+ if Current_Token = Tok_Block_Comment then
+ Files_Map.File_Pos_To_Coord
+ (Ctxt.Sfe, Get_Token_Position,
+ Line_Pos, Line, Off);
+ else
+ Off := Get_Token_Offset;
+ end if;
+ if Off /= 0 then
+ Disp_Indent (Ctxt);
+ end if;
+ end;
+ end if;
+
+ P := Get_Token_Position;
+ for I in 1 .. Get_Token_Length loop
+ Disp_Char (Ctxt, Ctxt.Source (P));
+ P := P + 1;
+ end loop;
+ end;
+ Scan;
+ while Current_Token = Tok_Newline loop
+ Disp_Newline (Ctxt);
+ Scan;
+ end loop;
+ when others =>
+ if Current_Token = Tok_Integer_Letter
+ and then Tok = Tok_Bit_String
+ then
+ Scan;
+ end if;
+
+ -- There are a couple of exceptions due to attributes or
+ -- PSL.
+ if Tok = Tok_Identifier
+ and then (Current_Token = Tok_Range
+ or else Current_Token = Tok_Subtype)
+ then
+ null;
+ elsif (Tok = Tok_Psl_Default
+ or else Tok = Tok_Psl_Clock)
+ and then Current_Token = Tok_Identifier
+ then
+ null;
+ elsif Tok /= Current_Token then
+ declare
+ use Simple_IO;
+ begin
+ Put_Line_Err ("error: token mismatch. ");
+ Put_Err (" need to print: ");
+ Put_Err (Image (Tok));
+ Put_Err (", but read ");
+ Put_Err (Image (Current_Token));
+ Put_Err (" from file.");
+ New_Line_Err;
+ end;
+ raise Internal_Error;
+ end if;
+ Scan;
+ return;
+ end case;
+ end loop;
+ end Sync;
+ end Format_Disp_Ctxt;
+
+ procedure Format (F : Iir_Design_File)
+ is
+ use Format_Disp_Ctxt;
+ Sfe : constant Source_File_Entry := Get_Design_File_Source (F);
+ Ctxt : Format_Ctxt;
+ begin
+ Scanner.Flag_Comment := True;
+ Scanner.Flag_Newline := True;
+
+ Set_File (Sfe);
+ Scan;
+
+ Init (Ctxt, Sfe);
+ Prints.Disp_Vhdl (Ctxt, F);
+ end Format;
+end Vhdl.Formatters;
diff --git a/src/vhdl/vhdl-formatters.ads b/src/vhdl/vhdl-formatters.ads
new file mode 100644
index 000000000..0bc9e4726
--- /dev/null
+++ b/src/vhdl/vhdl-formatters.ads
@@ -0,0 +1,24 @@
+-- VHDL code formatter.
+-- Copyright (C) 2019 Tristan Gingold
+--
+-- GHDL 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, or (at your option) any later
+-- version.
+--
+-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+package Vhdl.Formatters is
+ -- Format/pretty print the file F.
+ procedure Format (F : Iir_Design_File);
+end Vhdl.Formatters;
--
cgit v1.2.3