yufa.pas

编译原理实验 完整的

  begin{ProcFuncDefPart}
    if sy in firsts
    then begin
           repeat
             case sy of
               procsy:ProcDefinition([procsy],follows+[semicolon]);
               funcsy:FuncDefinition([funcsy],follows+[semicolon])
             end;
             ChePutGet(semicolon)
           until not (sy in[procsy,funcsy]);
           CheckFollow(follows,ord(semicolon))
         end
  end{ProcFuncDefPart};

  procedure StatPart(firsts,follows:symset);
    procedure expression(firsts,follows:symset);
    forward;
    procedure SelectorList(firsts,follows:symset);
    begin
      CheckFirst(firsts,follows,68);
      if sy in firsts
      then begin
             repeat
               case sy of
                 lbracket:
                   begin
                     PutGet(lbracket);
                     expression(exprbegsys,follows+[comma,rbracket]);
                     while sy=comma do
                       begin
                         PutSy(rbracket);
                         PutGet(lbracket);
                         expression(exprbegsys,follows+[comma,rbracket])
                       end;
                       ChePutGet(rbracket)
                   end;
                   period:
                   begin
                     PutGet(period);
                     ChePutGet(ident)
                   end
               end{of case};
             until not(sy in[lbracket,period]);
             CheckFollow(follows,87)
           end
    end{SelectorList};
    procedure ActualParamList(firsts,follows:symset);
      var comcols:symset;
    begin
      CheckFirst(firsts,follows,65);
      if sy in firsts
      then begin
             expression(exprbegsys,follows+[comma,rparent]);
             while sy=comma do
              begin
                PutGet(sy);
                expression(exprbegsys,follows+[comma,rparent])
              end;
              CheckFollow(follows,ord(rparent))
           end
    end{ActualPatamList};
    procedure factor(firsts,follows:symset);
    begin
      CheckFirst(firsts,follows,63);
      if sy in firsts
      then begin
             case sy of
               intconst,charconst,strconst:PutGet(sy);
               ident:
                 begin
                   PutGet(sy);
                   if sy in[lbracket,period,lparent]
                   then case sy of
                        lbracket,period:SelectorList([lbracket,period],follows);
                        lparent:
                          begin
                            ChePutGet(lparent);
                            ActualParamList(exprbegsys,follows+[rparent]);
                            ChePutGet(rparent)
                          end
                        end
                 end{ident};
               lparent:
                 begin
                   PutGet(lparent);
                   expression(exprbegsys,follows+[rparent]);
                   ChePutGet(rparent)
                 end;
               notop:
                 begin PutGet(notop);  factor(facbegsys,follows) end
             end{case};
             CheckFollow(follows,88)
           end
    end{factor};

    procedure term(firsts,follows:symset);
    begin
      CheckFirst(firsts,follows,64);
      if sy in firsts
      then begin
             factor(facbegsys,follows+mulops);
             while sy in mulops do
                begin PutGet(sy); factor(facbegsys,follows+mulops) end;
             CheckFollow(follows,89)
           end
    end{term};
    procedure SimExpression(firsts,follows:symset);
    begin
      CheckFirst(firsts,follows,65);
      if sy in firsts
      then begin
           if sy in signs then PutGet(sy);
               term(termbegsys,follows+addops);
               while sy in addops do
                  begin PutGet(sy); term(termbegsys,follows+addops) end;
                  CheckFollow(follows,90)
           end;
    end;

    procedure expression{(firsts,follows:symset)};
    begin
        CheckFirst(firsts,follows,65);
        if sy in firsts
        then begin
               SimExpression(simexprbegsys,follows+relops);
               if sy in relops
               then begin
                      PutGet(sy);
                      SimExpression(simexprbegsys,follows+relops)
                    end;
               CheckFollow(follows,91)
             end
    end;
    procedure statement(firsts,follows:symset);
    forward;
    procedure AssignProcStatement(firsts,follows:symset);
    begin
      CheckFirst(firsts,follows,65);
      if sy in firsts
      then begin
             save;
             GetSy;
             if sy in [lbracket,period,becomes]
             then
               begin
                 PutSave;
                 if sy in[lbracket,period]
                 then SelectorList([lbracket,period],follows+[becomes]);
                 ChePutGet(becomes);
                 expression(exprbegsys,follows)
               end
             else
               begin
                 PutSy(call);
                 PutSave;
                 if sy=lparent
                 then begin
                        ChePutGet(lparent);
                        ActualParamList(exprbegsys,follows+[rparent]);
                        ChePutGet(rparent)
                      end
               end;
               CheckFollow(follows,92)
           end
    end{AssignProcStatement};

    procedure CompoundStatement(firsts,follows:symset);
    begin
      CheckFirst(firsts,follows,ord(beginsy));
      if sy in firsts
      then begin
             PutGet(beginsy);
             statement(statbegsys+[semicolon,endsy],
                       follows   +[semicolon,endsy]);
             while sy in [semicolon]+statbegsys do
             begin
               if sy=semicolon
               then PutGet(semicolon)
               else SyntaxError(ord(semicolon));
               statement(statbegsys+[semicolon,endsy],
                         follows   +[semicolon,endsy]);
             end;
             ChePutGet(endsy);
             CheckFollow(follows,92)
           end
    end;

    procedure IfStatement(firsts,follows:symset);
    begin
      CheckFirst(firsts,follows,ord(ifsy));
      if sy in firsts
      then begin
             PutGet(ifsy);
             expression(exprbegsys,follows+[thensy]);
             ChePutGet(thensy);
             statement(statbegsys+[elsesy,semicolon,endsy],
                       follows   +[elsesy,semicolon,endsy]);
             if sy=elsesy
             then begin
                     PutGet(elsesy);
                     statement(statbegsys+[elsesy,semicolon,endsy],
                               follows   +[elsesy,semicolon,endsy]);
                  end;
             CheckFollow(follows,92)
           end
    end{IfStatement};
    procedure WhileStatement(firsts,follows:symset);
    begin
      CheckFirst(firsts,follows,ord(whilesy));
      if sy in firsts
      then begin
             ChePutGet(ifsy);
             expression(exprbegsys,follows+[dosy]);
             ChePutGet(dosy);
             statement(statbegsys+[elsesy,semicolon,endsy],
                       follows   +[elsesy,semicolon,endsy]);
             CheckFollow(follows,92)
           end
    end{WhileStatement};
    procedure ForStatement(firsts,follows:symset);
    begin
      CheckFirst(firsts,follows,ord(forsy));
      if sy in firsts
      then begin
             ChePutGet(forsy);
             ChePutGet(ident);
             ChePutGet(becomes);
             expression(exprbegsys,follows+[tosy,downtosy]);
             if sy=tosy then PutGet(tosy) else ChePutGet(downtosy);
             expression(exprbegsys,follows+[dosy]);
             ChePutGet(elsesy);
             statement(statbegsys+[semicolon,endsy],
                       follows   +[semicolon,endsy]);
             CheckFollow(follows,92)
           end
    end{ForStatement};

    procedure statement{(firsts,follows:symset)};
    begin
      CheckFirst(firsts,follows,62);
      if sy in firsts
      then begin
              case sy of
                ident    :AssignProcStatement ([ident  ],follows);
                beginsy  :CompoundStatement   ([beginsy],follows);
                ifsy     :IfStatement         ([ifsy   ],follows);
                whilesy  :WhileStatement      ([whilesy],follows);
                forsy    :ForStatement        ([forsy  ],follows);
                endsy,semicolon,elsesy
                         :PutSy(empty)
              end{case};
              CheckFollow(follows,92)
           end
    end{segment};
  begin
    CompoundStatement(firsts,follows)
  end{StatPart};

  begin{block}
    CheckFirst(firsts,follows,66);
    if sy in firsts
    then begin
            if(BlockClass<>programsy) and (sy=lparent)
            then begin
                    ChePutGet(lparent);
                    FormalParamList([varsy,ident],follows+[rparent]);
                    ChePutGet(rparent)
                 end;
            if BlockClass=funcsy
            then begin
                    ChePutGet(colon);  ChePutGet(ident)
                 end;
            ChePutGet(semicolon);
            repeat
              ConstDefPart   ([constsy],follows+defbegsys+[beginsy]);
              TypeDefPart    ([typesy], follows+defbegsys+[beginsy]);
              VarDefPart     ([varsy]  ,follows+defbegsys+[beginsy]);
              ProcFuncDefPart([procsy,funcsy],follows+defbegsys+[beginsy]);
              if sy in defbegsys then SyntaxError(ord(beginsy))
            until not(sy in defbegsys);
            StatPart([beginsy],follows+[period,semicolon]);
            CheckFollow(follows,93)
    end
  end{block};

  procedure programx(firsts,follows:symset);
  begin
    CheckFirst(firsts,follows,ord(programsy));
    if sy in firsts
    then begin
          ChePutGet(programsy);
          ChePutGet(ident);
          block([semicolon],follows+[period],programsy);
          ChePutGet(period);
          CheckFollow(follows,94)
        end
  end;

begin{SyntaxAnalysis}
  SyPos.LineNumber:=0;
  GetSy;
  programx([programsy],[eofile]);
end{SyntaxAnalysis};