with Text_Io; with Token_Package; with Compilation_Unit; separate (Find_Unit) procedure Build_Ada_Compilation_Unit (Next_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is --============================================================== -- This procedure starts the parsing of compilation units in = -- motion by invoking Get_Compilation_Unit. Any syntax errors = -- will be trapped here with an error message going out to the = -- user. = -- = -- written by Gary Russell = -- Reviewed by Brad Balford and Johan Margono = -- May 1985 at EVB Software Engineering = --============================================================== Line_Number : Text_Io.Positive_Count; -- This will be the variable used if there is a syntax error -- raised by token package or by Build_Ada_Compilation_Unit package Line_Number_Io is new Text_Io.Integer_Io (Num => Text_Io.Positive_Count); -- Line_Number_IO is instantiated in case there is an error -- message needed when an exception is trapped function "=" (Left : in Token_Package.Token_Value; Right : in Token_Package.Token_Value) return Boolean renames Token_Package."="; -- We are renaming an implicit "=" token package operator so that -- we can compare a token_value literal with the value returned by -- the operation "Value_Of" in token package. This is necessary -- because section 8.3(18) of the Ada Reference manual says that -- the implicit "=" must be made directly visible. We decided that -- a renames would be preferable to a "use_clause" because all -- operations and objects from Token_Package (except "=") must -- still be qualified. function "=" (Left : in Token_Package.Token_Class; Right : in Token_Package.Token_Class) return Boolean renames Token_Package."="; -- We are renaming an implicit "=" token package operator so that -- we can compare a token_value literal with the value returned by -- the operation "Class_Of" in token package. This is necessary -- because section 8.3(18) of the Ada Reference manual says that -- the implicit "=" must be made directly visible. We decided that -- a renames would be preferable to a "use_clause" because all -- operations and objects from Token_Package (except "=") must -- still be qualified. procedure Get_Next_Significant_Token (Significant_Token : out Token_Package.Token; Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Peek_Next_Significant_Token (Significant_Token : out Token_Package.Token); procedure Add_On_Insignificant_Tokens (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); -- This procedure adds on all comments, new lines, and blank -- lines. -- The following subprogram declarations are derived from the -- grammer which can be found in the analysis & clarifications. -- A recursive descent approach has been taken as much as possible -- to parse the Ada source code into compilation units. procedure Get_Compilation_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Generic_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Package_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Task_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Subprogram (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Generic_Parm_Declaration (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Subprogram_Spec_Tail (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Left_Right_Paren (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Inside_Left_Right_Paren (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Generic_Unit_Spec (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Procedure_Or_Instantiation (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Procedure_Spec_Or_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Procedure_Body_Or_Stub (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Task_Tail (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Task_Spec (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure End_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Task_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Declaration (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Package_Or_Renames (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Subprogram_Or_Renames (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Statement (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Accept_Tail (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Package_Unit_Tail (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Package_Spec_Or_Instantiation (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Package_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure End_Package_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Package_Spec (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Block_Statement (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Named_Block (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Unnamed_Block (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Begin_Statement (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Peek_Left_Right_Paren; procedure Function_Or_Instantiation (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Function_Spec_Or_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Function_Body_Or_Stub (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); procedure Function_End_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit); -- Now we will declare all the procedure body stubs procedure Get_Compilation_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Generic_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Package_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Task_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Subprogram (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Generic_Parm_Declaration (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Subprogram_Spec_Tail (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Left_Right_Paren (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Inside_Left_Right_Paren (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Generic_Unit_Spec (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Procedure_Or_Instantiation (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Procedure_Spec_Or_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Procedure_Body_Or_Stub (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Task_Tail (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Task_Spec (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure End_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Task_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Declaration (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Package_Or_Renames (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Subprogram_Or_Renames (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Statement (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Accept_Tail (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Package_Unit_Tail (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Package_Spec_Or_Instantiation (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Package_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure End_Package_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Package_Spec (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Block_Statement (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Named_Block (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Unnamed_Block (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Begin_Statement (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Peek_Left_Right_Paren is separate; procedure Function_Or_Instantiation (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Function_Spec_Or_Body (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Function_Body_Or_Stub (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; procedure Function_End_Unit (Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; -- The following procedure is used throughout the state -- machine to get the next significant token (all tokens -- except blank lines, comments, and new lines). procedure Get_Next_Significant_Token (Significant_Token : out Token_Package.Token; Current_Unit : in out Compilation_Unit.Ada_Compilation_Unit) is separate; -- The following procedure is used throughout the state -- machine to peek ahead at the next significant token (all -- tokens except blank lines, comments, and new lines). procedure Peek_Next_Significant_Token (Significant_Token : out Token_Package.Token) is separate; procedure Add_On_Insignificant_Tokens (Current_Unit : in out Compilation_Unit. Ada_Compilation_Unit) is separate; begin -- Build_Ada_Compilation_Unit -- Invoke the procedure to start the parsing Get_Compilation_Unit (Current_Unit => Next_Unit); exception when Token_Package.Token_Too_Long | Token_Package.Lexical_Error => -- Get the line number where the error occurred Line_Number := Text_Io.Line (File => Text_Io.Current_Input); -- Print out the error message needed Text_Io.Put_Line ("************ Syntax or semantic error in input " & "compilation unit"); Text_Io.Put_Line ("************ Is the compilation unit syntactically " & "correct Ada ?"); Text_Io.Put ("************ Error was discovered on the following " & "Line : "); Line_Number_Io.Put (Item => Line_Number); Text_Io.New_Line (Spacing => 1); raise Build_Syntax_Error; when Token_Package.Error_Reading_File => -- Get the line number where the error occurred Line_Number := Text_Io.Line (File => Text_Io.Current_Input); -- Print out the necessary messages Text_Io.Put_Line ("************ Error reading input program unit file. "); Text_Io.Put_Line ("************ Is there a problem with the device ? "); Text_Io.Put ("************ Error was discovered on the following " & "Line : "); Line_Number_Io.Put (Item => Line_Number); Text_Io.New_Line (Spacing => 1); raise Build_Syntax_Error; when Build_Syntax_Error => -- Get the line number where the error occurred Line_Number := Text_Io.Line (File => Text_Io.Current_Input); -- Print out the error message needed Text_Io.Put_Line ("************ Syntax or semantic error in input " & "compilation unit"); Text_Io.Put_Line ("************ Is the compilation unit syntactically " & "correct Ada ?"); Text_Io.Put ("************ Error was discovered on the following " & "Line : "); Line_Number_Io.Put (Item => Line_Number); Text_Io.New_Line (Spacing => 1); raise; end Build_Ada_Compilation_Unit;