mwsimplepaspar.pas

MWDELPAR（解析Pascal语法）

  end;
  if TokenID = ptSemiColon then SEMICOLON;
  ObjectMethodDirective;
end;

procedure TmwSimplePasPar.ObjectConstructorHeading;
begin
  Expected(ptConstructor);
  ConstructorName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;
  end;
  if TokenID = ptSemiColon then SEMICOLON;
  ObjectMethodDirective;
end;

procedure TmwSimplePasPar.ObjectDestructorHeading;
begin
  Expected(ptDestructor);
  DestructorName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;
  end;
  if TokenID = ptSemiColon then SEMICOLON;
  ObjectMethodDirective;
end;

procedure TmwSimplePasPar.ObjectMethodDirective;
begin
  while ExID in [ptAbstract, ptCdecl, ptDynamic, ptExport, ptExternal, ptFar,
    ptMessage, ptNear, ptPascal, ptRegister, ptSafeCall, ptStdCall, ptVirtual] do
  begin
    ProceduralDirective;
    if TokenID = ptSemiColon then SEMICOLON;
  end;
end;

procedure TmwSimplePasPar.Directive16Bit;
begin
  case ExID of
    ptNear:
      begin
        NextToken;
      end;
    ptFar:
      begin
        NextToken;
      end;
    ptExport:
      begin
        NextToken;
      end;
  else
    begin
      SynError(InvalidDirective16Bit);
    end;
  end;
end;

procedure TmwSimplePasPar.DirectiveBinding;
begin
  case ExID of
    ptVirtual:
      begin
        NextToken;
      end;
    ptDynamic:
      begin
        NextToken;
      end;
    ptMessage:
      begin
        NextToken;
        ConstantExpression;
      end;
    ptOverride:
      begin
        NextToken;
      end;
    ptOverload:
      begin
        NextToken;
      end;
    ptReintroduce:
      begin
        NextToken;
      end;
  else
    begin
      SynError(InvalidDirectiveBinding);
    end;
  end;
end;

procedure TmwSimplePasPar.ReturnType;
begin
  case TokenID of
    ptString:
      begin
        StringType;
      end;
  else
    begin
      TypeID;
    end;
  end;
end;

procedure TmwSimplePasPar.FormalParameterList;
begin
  Expected(ptRoundOpen);
  FormalParameterSection;
  while TokenID = ptSemiColon do
  begin
    SEMICOLON;
    FormalParameterSection;
  end;
  Expected(ptRoundClose);
end;

procedure TmwSimplePasPar.FormalParameterSection;
begin
  case TokenID of
    ptConst:
      begin
        ConstParameter;
      end;
    ptIdentifier:
      begin
        ParameterFormal;
      end;
    ptIn:
      begin
        NextToken;
        ParameterFormal;
      end;
    ptOut:
      begin
        OutParameter;
      end;
    ptVar:
      begin
        VarParameter;
      end;
  end;
end;

procedure TmwSimplePasPar.ConstParameter;
begin
  Expected(ptConst);
  ParameterNameList;
  case TokenID of
    ptColon:
      begin
        NextToken;
        NewFormalParameterType;
        if TokenID = ptEqual then
        begin
          NextToken;
          TypedConstant;
        end;
      end
  end;
end;

procedure TmwSimplePasPar.VarParameter;
begin
  Expected(ptVar);
  ParameterNameList;
  case TokenID of
    ptColon:
      begin
        NextToken;
        NewFormalParameterType;
      end
  end;
end;

procedure TmwSimplePasPar.OutParameter;
begin
  Expected(ptOut);
  ParameterNameList;
  case TokenID of
    ptColon:
      begin
        NextToken;
        NewFormalParameterType;
      end
  end;
end;

procedure TmwSimplePasPar.ParameterFormal;
begin
  case TokenID of
    ptIdentifier:
      begin
        ParameterNameList;
        Expected(ptColon);
        NewFormalParameterType;
        if TokenID = ptEqual then
        begin
          NextToken;
          TypedConstant;
        end;
      end;
  else
    begin
      SynError(InvalidParameter);
    end;
  end;
end;

procedure TmwSimplePasPar.ParameterNameList;
begin
  ParameterName;
  while TokenID = ptComma do
  begin
    NextToken;
    ParameterName;
  end;
end;

procedure TmwSimplePasPar.ParameterName;
begin
  Expected(ptIdentifier);
end;

procedure TmwSimplePasPar.NewFormalParameterType;
begin
  case TokenID of
    ptArray:
      begin
        NextToken;
        Expected(ptOf);
        case TokenID of
          ptConst: (*new in ObjectPascal80*)
            begin
              NextToken;
            end;
        else
          begin
            OldFormalParameterType;
          end;
        end;
      end;
  else
    begin
      OldFormalParameterType;
    end;
  end;
end;

procedure TmwSimplePasPar.OldFormalParameterType;
begin
  case TokenID of
    ptString:
      begin
        NextToken;
      end;
  else
    begin
      TypeID;
    end;
  end;
end;

procedure TmwSimplePasPar.FunctionMethodDeclaration;
begin
  Expected(ptFunction);
  Lexer.InitAhead;
  if Lexer.AheadTokenID = ptPoint then
  begin
    ObjectNameOfMethod;
    Expected(ptPoint);
  end;
  FunctionProcedureName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;
  end;
  case TokenID of
    ptSemiColon:
      begin
        FunctionProcedureBlock;
      end;
  else
    begin
      Expected(ptColon);
      ReturnType;
      FunctionProcedureBlock;
    end;
  end;
end;

procedure TmwSimplePasPar.ProcedureMethodDeclaration;
begin
  case TokenID of
    ptConstructor:
      begin
        NextToken;
      end;
    ptDestructor:
      begin
        NextToken;
      end;
    ptProcedure:
      begin
        NextToken;
      end;
  else
    begin
      SynError(InvalidProcedureMethodDeclaration);
    end;
  end;
  Lexer.InitAhead;
  if Lexer.AheadTokenID = ptPoint then
  begin
    ObjectNameOfMethod;
    Expected(ptPoint);
  end;
  FunctionProcedureName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;
  end;
  FunctionProcedureBlock;
end;

procedure TmwSimplePasPar.FunctionProcedureName;
begin
  Expected(ptIdentifier);
end;

procedure TmwSimplePasPar.ObjectNameOfMethod;
begin
  Expected(ptIdentifier);
end;

procedure TmwSimplePasPar.FunctionProcedureBlock;
var
  NoExternal: Boolean;
begin
  NoExternal := True;
  if TokenID = ptSemiColon then SEMICOLON;
  case ExID of
    ptForward:
      begin
        NextToken;
        SEMICOLON;
      end;
  else
    while ExID in [ptAbstract, ptCdecl, ptDynamic, ptExport, ptExternal, ptFar,
      ptMessage, ptNear, ptOverload, ptOverride, ptPascal, ptRegister,
      ptReintroduce, ptSafeCall, ptStdCall, ptVirtual] do
    begin
      case ExId of
        ptExternal:
          begin
            ProceduralDirective;
            if TokenID = ptSemiColon then SEMICOLON;
            NoExternal := False;
          end;
      else
        begin
          ProceduralDirective;
          if TokenID = ptSemiColon then SEMICOLON;
        end;
      end;
    end;
    if NoExternal then
    begin
      if ExId = ptAssembler then
      begin
        NextToken;
        SEMICOLON;
      end;
      case TokenID of
        ptAsm:
          begin
            AsmStatement;
          end;
      else
        begin
          Block;
        end;
      end;
      SEMICOLON;
    end;
  end;
end;

procedure TmwSimplePasPar.ExternalDirective;
begin
  ExpectedEx(ptExternal);
  case TokenID of
    ptSemiColon:
      begin
        SEMICOLON;
      end;
  else
    begin
      SimpleExpression;
      ExternalDirectiveTwo;
    end;
  end;
end;

procedure TmwSimplePasPar.ExternalDirectiveTwo;
begin
  case fLexer.ExID of
    ptIndex:
      begin
        NextToken;
      end;
    ptName:
      begin
        NextToken;
        SimpleExpression;
      end;
    ptSemiColon:
      begin
        SEMICOLON;
        ExternalDirectiveThree;
      end;
  end
end;

procedure TmwSimplePasPar.ExternalDirectiveThree;
begin
  case TokenID of
    ptMinus:
      begin
        NextToken;
      end;
  end;
  case TokenID of
    ptIdentifier, ptIntegerConst:
      begin
        NextToken;
      end;
  end;
end;

procedure TmwSimplePasPar.ForStatement;
begin
  Expected(ptFor);
  QualifiedIdentifier;
  Expected(ptAssign);
  Expression;
  case TokenID of
    ptTo:
      begin
        NextToken;
      end;
    ptDownTo:
      begin
        NextToken;
      end;
  else
    begin
      SynError(InvalidForStatement);
    end;
  end;
  Expression;
  Expected(ptDo);
  Statement;
end;

procedure TmwSimplePasPar.WhileStatement;
begin
  Expected(ptWhile);
  Expression;
  Expected(ptDo);
  Statement;
end;

procedure TmwSimplePasPar.RepeatStatement;
begin
  Expected(ptRepeat);
  StatementList;
  Expected(ptUntil);
  Expression;
end;

procedure TmwSimplePasPar.CaseStatement;
begin
  Expected(ptCase);
  Expression;
  Expected(ptOf);
  CaseSelector;
  while TokenID = ptSemiColon do
  begin
    SEMICOLON;
    case TokenID of
      ptElse, ptEnd: ;
    else
      CaseSelector;
    end;
  end;
  if TokenID = ptElse then
  begin
    NextToken;
    StatementList;
    SEMICOLON;
  end;
  Expected(ptEnd);
end;

procedure TmwSimplePasPar.CaseSelector;
begin
  CaseLabel;
  while TokenID = ptComma do
  begin
    NextToken;
    CaseLabel;
  end;
  Expected(ptColon);
  case TokenID of
    ptSemiColon: ;
  else
    Statement;
  end;
end;

procedure TmwSimplePasPar.CaseLabel;
begin
  ConstantExpression;
  if TokenID = ptDotDot then
  begin
    NextToken;
    ConstantExpression;
  end;
end;

procedure TmwSimplePasPar.IfStatement;
begin
  Expected(ptIf);
  Expression;
  Expected(ptThen);
  Statement;
  if TokenID = ptElse then
  begin
    NextToken;
    Statement;
  end;
end;

procedure TmwSimplePasPar.ExceptBlock;
begin
  case ExID of
    ptOn:
      begin
        ExceptionHandlerList;
        ExceptionBlockElseBranch
      end;
  else
    begin
      StatementList;
    end;
  end;
end;

procedure TmwSimplePasPar.ExceptionHandlerList;
begin
  while fLexer.ExID = ptOn do
  begin
    ExceptionHandler;
    SEMICOLON;
  end;
end;

procedure TmwSimplePasPar.ExceptionHandler;
begin
  ExpectedEx(ptOn);
  ExceptionIdentifier;
  Expected(ptDo);
  Statement;
end;

procedure TmwSimplePasPar.ExceptionBlockElseBranch;
begin
  case TokenID of
    ptElse:
      begin
        NextToken;
        StatementList;
      end;
  end;
end;

procedure TmwSimplePasPar.ExceptionIdentifier;
begin
  Lexer.InitAhead;
  case Lexer.AheadTokenID of
    ptPoint:
      begin
        ExceptionClassTypeIdentifier;
      end;
  else
    begin
      ExceptionVariable;
      case Lexer.TokenID of
        ptColon:
          begin
            NextToken;
            ExceptionClassTypeIdentifier;
          end;
      end;
    end;
  end;
end;

procedure TmwSimplePasPar.ExceptionClassTypeIdentifier;
begin
  QualifiedIdentifier;
end;