mwsimplepaspar.pas

MWDELPAR（解析Pascal语法）

    ptLibrary:
      begin
        LibraryFile;
      end;
    ptPackage:
      begin
        PackageFile;
      end;
    ptProgram:
      begin
        ProgramFile;
      end;
    ptUnit:
      begin
        UnitFile;
      end;
  else
    begin
      IncludeFile;
    end;
  end;
end;

procedure TmwSimplePasPar.LibraryFile;
begin
  Expected(ptLibrary);
  Expected(ptIdentifier);
  SEMICOLON;
  ProgramBlock;
  Expected(ptPoint);
end;

procedure TmwSimplePasPar.PackageFile;
begin
  ExpectedEx(ptPackage);
  Expected(ptIdentifier);
  SEMICOLON;
  case ExID of
    ptRequires:
      begin
        RequiresClause;
      end;
  end;
  case ExID of
    ptContains:
      begin
        ContainsClause;
      end;
  end;
  Expected(ptEnd);
  Expected(ptPoint);
end;

procedure TmwSimplePasPar.ProgramFile;
begin
  Expected(ptProgram);
  Expected(ptIdentifier);
  if TokenID = ptRoundOpen then
  begin
    NextToken;
    IdentifierList;
    Expected(ptRoundClose);
  end;
  SEMICOLON;
  ProgramBlock;
  Expected(ptPoint);
end;

procedure TmwSimplePasPar.UnitFile;
begin
  Expected(ptUnit);
  Expected(ptIdentifier);
  SEMICOLON;
  InterfaceSection;
  ImplementationSection;
  InitializationSection;
  Expected(ptPoint);
end;

procedure TmwSimplePasPar.ProgramBlock;
begin
  if TokenID = ptUses then
  begin
    MainUsesClause;
  end;
  Block;
end;

procedure TmwSimplePasPar.MainUsesClause;
begin
  Expected(ptUses);
  MainUsedUnitStatement;
  while TokenID = ptComma do
  begin
    NextToken;
    MainUsedUnitStatement;
  end;
  SEMICOLON;
end;

procedure TmwSimplePasPar.MainUsedUnitStatement;
begin
  MainUsedUnitName;
  if Lexer.TokenID = ptIn then
  begin
    NextToken;
    MainUsedUnitExpression;
  end;
end;

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

procedure TmwSimplePasPar.MainUsedUnitExpression;
begin
  ConstantExpression;
end;

procedure TmwSimplePasPar.UsesClause;
begin
  Expected(ptUses);
  UsedUnitsList;
  SEMICOLON;
end;

procedure TmwSimplePasPar.UsedUnitsList;
begin
  UsedUnitName;
  while TokenID = ptComma do begin
    NextToken;
    UsedUnitName;
  end;
end;

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

procedure TmwSimplePasPar.Block;
begin
  while TokenID in [ptClass, ptConst, ptConstructor, ptDestructor, ptExports,
    ptFunction, ptLabel, ptProcedure, ptResourceString, ptThreadVar, ptType,
    ptVar] do
  begin
    DeclarationSection;
  end;
  case TokenID of
    ptAsm:
      begin
        AsmStatement;
      end;
  else
    begin
      CompoundStatement;
    end;
  end;
end;

procedure TmwSimplePasPar.DeclarationSection;
begin
  case TokenID of
    ptClass:
      begin
        ProcedureDeclarationSection;
      end;
    ptConst:
      begin
        ConstSection;
      end;
    ptConstructor:
      begin
        ProcedureDeclarationSection;
      end;
    ptDestructor:
      begin
        ProcedureDeclarationSection;
      end;
    ptExports:
      begin
        ExportsClause;
      end;
    ptFunction:
      begin
        ProcedureDeclarationSection;
      end;
    ptLabel:
      begin
        LabelDeclarationSection;
      end;
    ptProcedure:
      begin
        ProcedureDeclarationSection;
      end;
    ptResourceString:
      begin
        ConstSection;
      end;
    ptType:
      begin
        TypeSection;
      end;
    ptThreadVar:
      begin
        VarSection;
      end;
    ptVar:
      begin
        VarSection;
      end;
  else
    begin
      SynError(InvalidDeclarationSection);
    end;
  end;
end;

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

procedure TmwSimplePasPar.InterfaceHeritage;
begin
  Expected(ptRoundOpen);
  IdentifierList;
  Expected(ptRoundClose);
end;

procedure TmwSimplePasPar.InterfaceGUID;
begin
  Expected(ptSquareOpen);
  CharString;
  Expected(ptSquareClose);
end;

procedure TmwSimplePasPar.AccessSpecifier;
begin
  case ExID of
    ptRead:
      begin
        NextToken;
        ReadAccessIdentifier;
      end;
    ptWrite:
      begin
        NextToken;
        WriteAccessIdentifier;
      end;
    ptReadOnly:
      begin
        NextToken;
      end;
    ptWriteOnly:
      begin
        NextToken;
      end;
  else
    begin
      SynError(InvalidAccessSpecifier);
    end;
  end;
end;

procedure TmwSimplePasPar.ReadAccessIdentifier;
begin
  QualifiedIdentifier;
end;

procedure TmwSimplePasPar.WriteAccessIdentifier;
begin
  QualifiedIdentifier;
end;

procedure TmwSimplePasPar.StorageSpecifier;
begin
  case ExID of
    ptStored:
      begin
        StorageStored;
      end;
    ptDefault:
      begin
        StorageDefault;
      end;
    ptNoDefault:
      begin
        StorageNoDefault;
      end
  else
    begin
      SynError(InvalidStorageSpecifier);
    end;
  end;
end;

procedure TmwSimplePasPar.StorageDefault;
begin
  ExpectedEx(ptDefault);
  if TokenID <> ptSemiColon then
  begin
    StorageExpression;
  end;
end;

procedure TmwSimplePasPar.StorageNoDefault;
begin
  ExpectedEx(ptNoDefault);
end;

procedure TmwSimplePasPar.StorageStored;
begin
  ExpectedEx(ptStored);
  case TokenID of
    ptIdentifier:
      begin
        StorageIdentifier;
      end;
  else
    if TokenID <> ptSemiColon then
    begin
      StorageExpression;
    end;
  end;
end;

procedure TmwSimplePasPar.StorageExpression;
begin
  ConstantExpression;
end;

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

procedure TmwSimplePasPar.PropertyParameterList;
begin
  Expected(ptSquareOpen);
  if TokenID = ptConst then
  begin
    PropertyParameterConst;
  end;
  IdentifierList;
  Expected(ptColon);
  TypeId;
  while TokenID = ptSemiColon do
  begin
    SEMICOLON;
    IdentifierList;
    Expected(ptColon);
    TypeId;
  end;
  Expected(ptSquareClose);
end;

procedure TmwSimplePasPar.PropertyParameterConst;
begin
  Expected(ptConst);
end;

procedure TmwSimplePasPar.PropertySpecifiers;
begin
  if ExID = ptIndex then
  begin
    NextToken;
    ConstantExpression;
  end;
  while ExID in [ptRead, ptReadOnly, ptWrite, ptWriteOnly] do
  begin
    AccessSpecifier;
  end;
  if ExID = ptDispId then
  begin
    NextToken;
    ConstantExpression;
  end;
  if TokenID = ptSemiColon then
  begin
    SEMICOLON;
  end;
  while ExID in [ptDefault, ptNoDefault, ptStored] do
  begin
    StorageSpecifier;
    if TokenID = ptSemiColon then
    begin
      SEMICOLON;
    end;
  end;
  if ExID = ptImplements then
  begin
    NextToken;
    QualifiedIdentifierList;
    SEMICOLON;
  end;
end;

procedure TmwSimplePasPar.PropertyInterface;
begin
  if TokenID = ptSquareOpen then
  begin
    PropertyParameterList;
  end;
  Expected(ptColon);
  TypeID;
end;

procedure TmwSimplePasPar.ClassMethodHeading;
begin
  case TokenID of
    ptConstructor:
      begin
        ConstructorHeading;
      end;
    ptDestructor:
      begin
        DestructorHeading;
      end;
    ptFunction:
      begin
        Lexer.InitAhead;
        Lexer.AheadNext;
        case Lexer.AheadTokenID of
          PtPoint:
            begin
              ClassMethodResolution;
            end;
        else
          begin
            ClassFunctionHeading;
          end;
        end;
      end;
    ptProcedure:
      begin
        Lexer.InitAhead;
        Lexer.AheadNext;
        case Lexer.AheadTokenID of
          PtPoint:
            begin
              ClassMethodResolution;
            end;
        else
          begin
            ClassProcedureHeading;
          end;
        end;
      end;
  else SynError(InvalidClassMethodHeading);
  end;
end;

procedure TmwSimplePasPar.ClassFunctionHeading;
begin
  Expected(ptFunction);
  FunctionMethodName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;
  end;
  Expected(ptColon);
  ReturnType;
  SEMICOLON;
  if ExID = ptDispId then
  begin
    NextToken;
    ConstantExpression;
    SEMICOLON;
  end;
  ClassMethodDirective;
end;

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

procedure TmwSimplePasPar.ClassProcedureHeading;
begin
  Expected(ptProcedure);
  ProcedureMethodName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;
  end;
  SEMICOLON;
  if ExID = ptDispId then
  begin
    NextToken;
    ConstantExpression;
    SEMICOLON;
  end;
  ClassMethodDirective;
end;

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

procedure TmwSimplePasPar.ClassMethodResolution;
begin
  case TokenID of
    ptFunction:
      begin
        NextToken;
      end;
    ptProcedure:
      begin
        NextToken;
      end;
  end;
  ResolutionInterfaceName;
  Expected(ptPoint);
  Expected(ptIdentifier);
  Expected(ptEqual);
  Expected(ptIdentifier);
  SEMICOLON;
end;

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

procedure TmwSimplePasPar.ConstructorHeading;
begin
  Expected(ptConstructor);
  ConstructorName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;
  end;
  SEMICOLON;
  ClassMethodDirective;
end;

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

procedure TmwSimplePasPar.DestructorHeading;
begin
  Expected(ptDestructor);
  DestructorName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;
  end;
  SEMICOLON;
  ClassMethodDirective;
end;

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

procedure TmwSimplePasPar.ClassMethodDirective;
begin
  while ExId in [ptAbstract, ptCdecl, ptDynamic, ptMessage, ptOverride,
    ptOverload, ptPascal, ptRegister, ptReintroduce, ptSafeCall, ptStdCall,
    ptVirtual] do
  begin
    ProceduralDirective;
    SEMICOLON;
  end;
end;

procedure TmwSimplePasPar.ObjectMethodHeading;
begin
  case TokenID of
    ptConstructor:
      begin
        ObjectConstructorHeading;
      end;
    ptDestructor:
      begin
        ObjectDestructorHeading;
      end;
    ptFunction:
      begin
        ObjectFunctionHeading;
      end;
    ptProcedure:
      begin
        ObjectProcedureHeading;
      end;
  else
    begin
      SynError(InvalidMethodHeading);
    end;
  end;
end;

procedure TmwSimplePasPar.ObjectFunctionHeading;
begin
  Expected(ptFunction);
  FunctionMethodName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;
  end;
  Expected(ptColon);
  ReturnType;
  if TokenID = ptSemiColon then SEMICOLON;
  ObjectMethodDirective;
end;

procedure TmwSimplePasPar.ObjectProcedureHeading;
begin
  Expected(ptProcedure);
  ProcedureMethodName;
  if TokenID = ptRoundOpen then
  begin
    FormalParameterList;