1 files changed, 182 insertions, 0 deletions
diff --git a/src/edif/dump_edif.adb b/src/edif/dump_edif.adb
new file mode 100644
index 000000000..129787364
--- /dev/null
+++ b/src/edif/dump_edif.adb
@@ -0,0 +1,182 @@
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Command_Line; use Ada.Command_Line;
+with Types; use Types;
+with Name_Table;
+with Std_Names;
+with Files_Map;
+with Str_Table;
+with Errorout;
+with Errorout.Console;
+with Edif.Tokens; use Edif.Tokens;
+with Edif.Scans; use Edif.Scans;
+with Edif.Nodes; use Edif.Nodes;
+with Edif.Parse; use Edif.Parse;
+with Edif.Disp_Edif;
+
+procedure Dump_Edif is
+   procedure Usage is
+   begin
+      Put_Line ("usage: " & Command_Name & " [--scan|--raw] FILE");
+   end Usage;
+
+   procedure Error_Msg_Option (Msg : String) is
+   begin
+      Put_Line (Standard_Error, Msg);
+      raise Fatal_Error;
+   end Error_Msg_Option;
+
+   N : Natural;
+
+   type Cmd_Type is (Cmd_None, Cmd_Scan, Cmd_Raw);
+   Cmd : Cmd_Type;
+
+   Id : Name_Id;
+   Dir_Id : Name_Id;
+   Sfe : Source_File_Entry;
+begin
+   Set_Exit_Status (Failure);
+
+   Errorout.Console.Install_Handler;
+   Errorout.Console.Set_Program_Name (Command_Name);
+   Std_Names.Std_Names_Initialize;
+   Files_Map.Initialize;
+
+   --  Decode options.
+   Cmd := Cmd_None;
+   N := 1;
+   while N <= Argument_Count loop
+      declare
+         Opt : constant String := Argument (N);
+      begin
+         exit when Opt (1) /= '-' and Opt (1) /= '+';
+
+         if Opt = "--scan" then
+            Cmd := Cmd_Scan;
+         elsif Opt = "--raw" then
+            Cmd := Cmd_Raw;
+         else
+            Usage;
+            return;
+         end if;
+      end;
+      N := N + 1;
+   end loop;
+
+   --  Stop now if no arguments.
+   if N > Argument_Count then
+      Usage;
+      return;
+   end if;
+
+   --  Parse files on the command line.
+   while N <= Argument_Count loop
+      --  Load the file.
+      Id := Name_Table.Get_Identifier (Argument (N));
+      Dir_Id := Null_Identifier;
+      Files_Map.Normalize_Pathname (Dir_Id, Id);
+      Sfe := Files_Map.Read_Source_File (Dir_Id, Id);
+      if Sfe = No_Source_File_Entry then
+         Error_Msg_Option ("cannot open " & Argument (N));
+      end if;
+
+      --  Parse file.
+      Set_File (Sfe);
+
+      case Cmd is
+         when Cmd_Scan =>
+            declare
+               Indent : Natural;
+               Need_Nl : Boolean;
+               Need_Sp : Boolean;
+
+               procedure Maybe_Nl is
+               begin
+                  if Need_Nl then
+                     New_Line;
+                     Put ((1 .. 2 * Indent => ' '));
+                     Need_Nl := False;
+                     Need_Sp := False;
+                  elsif Need_Sp then
+                     Put (' ');
+                     Need_Sp := False;
+                  end if;
+               end Maybe_Nl;
+            begin
+               Indent := 0;
+               Need_Nl := False;
+               Need_Sp := False;
+               loop
+                  Scan;
+
+                  case Current_Token is
+                     when Tok_Keyword =>
+                        New_Line;
+                        Put ((1 .. 2 * Indent => ' '));
+                        Need_Nl := False;
+                        Put ('(');
+                        Put (Name_Table.Image (Current_Identifier));
+                        Need_Sp := True;
+                        Indent := Indent + 1;
+                     when Tok_Right_Paren =>
+                        Put (')');
+                        Need_Nl := True;
+                        Indent := Indent - 1;
+                     when Tok_Symbol =>
+                        Maybe_Nl;
+                        Put (Name_Table.Image (Current_Identifier));
+                        Need_Sp := True;
+                     when Tok_String =>
+                        Maybe_Nl;
+                        Put ('"');
+                        Put (Str_Table.String_String8
+                               (Current_String, Nat32 (Current_String_Len)));
+                        Put ('"');
+                        Need_Sp := True;
+                     when Tok_Number =>
+                        Maybe_Nl;
+                        declare
+                           S : constant String := Int32'Image (Current_Number);
+                           F : Natural;
+                        begin
+                           if S (1) = ' ' then
+                              F := 2;
+                           else
+                              F := 1;
+                           end if;
+                           Put (S (F .. S'Last));
+                        end;
+                        Need_Sp := True;
+                     when Tok_Eof =>
+                        exit;
+                  end case;
+               end loop;
+            end;
+         when Cmd_Raw =>
+            declare
+               T : Node;
+            begin
+               T := Parse_File_Simple;
+               if Errorout.Nbr_Errors > 0 then
+                  raise Fatal_Error;
+               end if;
+               Edif.Disp_Edif.Disp_Node (T);
+            end;
+         when Cmd_None =>
+            declare
+               T : Node;
+            begin
+               T := Parse_Edif200;
+               if Errorout.Nbr_Errors > 0 then
+                  raise Fatal_Error;
+               end if;
+               Edif.Disp_Edif.Disp_Node (T);
+            end;
+      end case;
+
+      N := N + 1;
+   end loop;
+   Set_Exit_Status (Success);
+exception
+   when Fatal_Error =>
+      null;
+end Dump_Edif;