diff options
Diffstat (limited to 'src/edif/dump_edif.adb')
-rw-r--r-- | src/edif/dump_edif.adb | 182 |
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; |