plparser.pas

简单编译器的源代码,是大学课程设计内容,附简单测试用例

                        Emit1(Subtract2);
                      Pop(1)
                  end
                else TypeError(Typex);
            end
      end;

    { BasicExpression ::= SimpleExpression # RelationOperator SimpleExpression #
      RelationOperator ::= "<" | "=" | ">" }
    procedure BasicExpression(Var Typex:VariableType; Stop: Symbols);
      var
          Operator: SymbolType;  Type2: VariableType;
      begin
          SimpleExpression(Typex,RelationSymbols+Stop);
          while Symbol in RelationSymbols do
            begin
                Operator := Symbol;
                Expect(Symbol,RelationSymbols+ExpressionSymbols+Stop);
                SimpleExpression(Type2,RelationSymbols+Stop);
                CheckTypes(Typex,Type2);
                if Operator = Less1 then Emit1(Less2)
                else
                  if Operator = Equal1 then Emit1(Equal2)
                  else
                    Emit1(Greater2);
                Typex:=Boolean2;
            end;
      end;

    { Expression ::= BasicExpression # AndOrOperator BasicExpression #
      AndOrOperator ::= “&” | “|” }
    procedure Expression { var Typex: VariableType; Stop: Symbols } ;
      var
          Operator: SymbolType;  Type2: VariableType;
      begin
          BasicExpression(Typex, AndOrSymbols + Stop);
          while Symbol in AndOrSymbols do
            begin
                Operator := Symbol;
                Expect(Symbol,AndOrSymbols+ExpressionSymbols+Stop);
                BasicExpression(Type2,AndOrSymbols+Stop);
                CheckTypes(Typex,Boolean2);
                CheckTypes(Type2,Boolean2);
                if Operator = And1 then Emit1(And2)
                else Emit1(Or2);
            end;
      end;

    { ProcedureStatement ::= "call" ProcedureName  }
    procedure ProcedureStatement(Stop: Symbols);
      var
          Proc: Pointer;  
      begin
          Expect(Call1,[Name1]+Stop);
          Find(Argument,Proc);
          Expect(Name1,Stop);
          Emit3(Call2, BlockLevel - Proc^.ProcLevel, Proc^.ProcLabel);
          Push(3);
          Pop(3)
      end;
    { ExpressionTable ::= Expression # "," ExpressionTable # }
    procedure ExpressionTable(var num:integer; Stop:Symbols);
      var
          Typex: VariableType;
      begin
          Expression(Typex,[Comma1]+ExpressionSymbols+Stop);
          num:=num+1;
          ExprTypeTable[num]:=Typex;
          while Symbol = Comma1 do
            begin
                Expect(Comma1,ExpressionSymbols+Stop);
                ExpressionTable(num,Stop);
            end;
      end;

    { AssignmentStatement ::= VariableAccessTable “:=” ExpressionTable }
    procedure VariableAccessTable(Var num:integer; Stop:Symbols); forward;
    procedure AssignmentStatement(Stop: Symbols);
      var
          err:boolean;  Length1,Length2,i: integer;
          Typex:VariableType;
      begin
          VariableAccessTable(Length1, [Becomes1] + ExpressionSymbols + Stop);
          Expect(Becomes1, ExpressionSymbols + Stop);
          Length2:=0;
          ExpressionTable(Length2, Stop);
          if Length1 <> Length2 then TypeError(Typex)
          else
            begin
                err:=false; 
                for i:=1 to Length1 do
                  if VarAccTypeTable[i] <> ExprTypeTable[i] then
                    begin
                        err:=true;
                        VarAccTypeTable[i]:=CommonType2;
                        ExprTypeTable[i]:=CommonType2;
                    end;
                if err then Error(Type3)
                else Emit2(Assign2, Length1);
            end;
          Pop(1 + Length1)
      end;

    { WarningCommand ::= Expression "->" StatementPart }
    procedure StatementPart(Stop: Symbols); forward;
    procedure WarningCommand(Label2:integer; Stop:Symbols);
      var
          Typex:VariableType; Label1:integer;
      begin
          Expression(Typex,[Arrow1]+StatementSymbols+Stop);
          if (Typex = Boolean2) then
            begin
                NewLabel(Label1);
                Expect(Arrow1,StatementSymbols+Stop);
                Emit2(Arrow2,Label1);
                StatementPart(Stop);
                Emit2(Bar2,Label2);
                Emit2(DefAddr2,Label1);
            end
          else TypeError(Typex);
      end;

    { WarningCommandTable ::= WarningCommand # "[]" WarningCommand # }
    procedure WarningCommandTable(Label2:integer; Stop:Symbols);
      begin
          WarningCommand(Label2,[Bracket1]+Stop);
          while Symbol = Bracket1 do
            begin
                Expect(Bracket1,ExpressionSymbols+Stop);
                WarningCommand(Label2,[Bracket1]+Stop);
            end
      end;

    { IfStatement::= “if” WarningCommandTable “fi” }
    procedure Statement(Stop: Symbols); forward;

    procedure IfStatement(Stop: Symbols);
      var
          Label2:integer;
      begin
          NewLabel(Label2);
          Expect(If1,ExpressionSymbols+Stop);
          WarningCommandTable(Label2,[Fi1] + Stop);
          Expect(Fi1,Stop);
          Emit2(Fi2, LineNo);
          Emit2(DefAddr2,Label2);
          Pop(1);
      end;

    { DoStatement ::= "do" WarningCommandTabel "od" }
    procedure DoStatement(Stop:Symbols);
      var
          Label2:integer;
      begin
          NewLabel(Label2);
          Emit2(DefAddr2,Label2);
          Expect(Do1,ExpressionSymbols+[Od1]+Stop);
          WarningCommandTable(Label2,[Od1]+Stop);
          Expect(Od1,Stop);
      end;

    { VariableAccessTable ::= VariableAccess # "," VariableAccess # }
    procedure VariableAccessTable(Var num:integer; Stop:Symbols);
      var
          Typex:VariableType;
      begin
          num:=0;
          VariableAccess(Typex,[Comma1]+Stop);
          num:=num+1;
          VarAccTypeTable[num]:=Typex;
          while Symbol = Comma1 do
            begin
                Expect(Comma1,[Name1]+Stop);
                VariableAccess(Typex,[Comma1]+Stop);
                num:=num+1;
                VarAccTypeTable[num]:=Typex;
            end;
      end;

    { ReadStatement ::= "read" VariableAccessTable }
    procedure ReadStatement(Stop:Symbols);
      var
          num,i:integer; err:boolean;
      begin
          Expect(Read1,[Name1]+Stop);
          VariableAccessTable(num,Stop);
          err:=false;
          for i:=1 to num do
            if VarAccTypeTable[i] <> Integer2 then
              begin
                  err:=true;
                  VarAccTypeTable[i]:=CommonType2;
              end;
          if not err then Emit2(Read2,num)
          else Error(Type3);
      end;

    { WriteStatement ::="write" ExpressionTable }
    procedure WriteStatement(Stop: Symbols);
      var 
          num,i:integer;  err:boolean;
      begin
          Expect(Write1,ExpressionSymbols+Stop);
          num:=0;
          ExpressionTable(num,Stop);
          err:=false;  
          for i:=1 to num do
            if ExprTypeTable[i] <> Integer2 then
              begin
                  err:=true;
                  ExprTypeTable[i]:=CommonType2;
              end;
            if not err then Emit2(Write2,num)
            else Error(Type3);
      end;

    { Statement ::= EmptyStatement | ReadStatement | WriteStatement | AssignmentStatement | 
                    ProcedureStatement | IfStatement | DoStatement  }
    { EmptyStatement ::= "skip" }
    procedure Statement { Stop: Symbols };
      var
          Object0: Pointer;
      begin
          if Symbol = Skip1 then Expect(Skip1,Stop)
          else 
            if Symbol = Read1 then ReadStatement(Stop)
            else
              if Symbol = Write1 then WriteStatement(Stop)
              else
                if Symbol = Name1 then 
                  begin
                      Find(Argument, Object0);
                      if Object0^.Kind in Variables then
                             AssignmentStatement(Stop)
                      else 
                        if Object0^.Kind = Procedur then
                               ProcedureStatement(Stop)
                        else
                          begin
                              KindError(Object0);
                              Expect(Name1, Stop)
                          end
                  end
                else
                  if Symbol = If1 then  IfStatement(Stop)
                  else
                    if Symbol = Do1 then  DoStatement(Stop)
                    else
                      if Symbol = Call1 then ProcedureStatement(Stop)
                      else
                        SyntaxCheck(Stop)
      end;

    { DefinitionPart ::= # Definition ";" #}
    { Definition ::= ConstantDefinition | VariableDefinition | ProcDefinition }
    procedure DefinitionPart(Var VarLength:integer; Stop:Symbols);
      var
          obj:Pointer;
      begin
          While Symbol in DefinitionSymbols do
            begin
                if Symbol = Const1 then
                  ConstantDefinition(DefinitionSymbols+Stop);
                if Symbol in TypeSymbols then
                  VariableDefinition(obj,VarLength,DefinitionSymbols+Stop);
                if Symbol = Proc1 then
                  ProcedureDefinition(DefinitionSymbols +  Stop);
                Expect(Semicolon1,[Semicolon1]+DefinitionSymbols+Stop);
            end;
      end;

    { StatementPart ::= # Statement ";" # }
    procedure StatementPart(Stop: Symbols);
      begin
          while Symbol in StatementSymbols do
            begin
                Statement([Semicolon1]+Stop);
                Expect(Semicolon1,StatementSymbols+Stop);
            end;
      end;


    { PartProgram ::= "begin" DefinitionPart StatementPart "end" }
    procedure PartProgram(BeginLabel,VarLabel:integer; Stop:Symbols);
               {BeginLabel,VarLabel:integer;Stop:Symbols}
      var
          VarLength: integer;
      begin
          NewBlock;
          Expect(Begin1,[ Semicolon1, End1 ]+definitionSymbols+StatementSymbols+Stop );
          DefinitionPart(VarLength,StatementSymbols+[Semicolon1,End1]+Stop);
          Emit3(DefArg2,VarLabel,Block[BlockLevel].CurLen);
          Emit2(DefAddr2,BeginLabel);
          StatementPart([End1]+Stop);
          Expect(End1,Stop);
          EndBlock;
      end;

    { Program ::= PartProgram “.” }
    procedure Programx(Stop: Symbols);
      var
          VarLabel, BeginLabel: integer;
      begin
          NewLabel(VarLabel);
          NewLabel(BeginLabel);
          Emit3(Prog2, VarLabel, BeginLabel);
          PartProgram(BeginLabel, VarLabel, [Period1] + Stop);
          Emit1(EndProg2);
          Expect(Period1, Stop)
      end;

    { Pass2 : THE PL PARSER }
  begin
      Initialize;
      NextSymbol;
      StandardBlock;
      Programx([EndText1])
  end;

end.