mwsimplepaspar.pas

MWDELPAR（解析Pascal语法）

        NextToken;
      end
  else
    begin
      SynError(InvalidDirectiveCalling);
    end;
  end;
end;

procedure TmwSimplePasPar.RecordVariant;
begin
  ConstantExpression;
  while (TokenID = ptComma) do begin
    NextToken;
    ConstantExpression;
  end;
  Expected(ptColon);
  Expected(ptRoundOpen);
  if TokenID = ptIdentifier then
  begin
    FieldList;
  end;
  Expected(ptRoundClose);
end;

procedure TmwSimplePasPar.VariantSection;
begin
  Expected(ptCase);
  TagField;
  Expected(ptOf);
  RecordVariant;
  while TokenID = ptSemiColon do
  begin
    SEMICOLON;
    case TokenID of
      ptElse, ptEnd: ;
    else
      RecordVariant;
    end;
  end;
end;

procedure TmwSimplePasPar.TagField;
begin
  TagFieldName;
  case fLexer.TokenID of
    ptColon:
      begin
        NextToken;
        TagFieldTypeName;
      end;
  end;
end;

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

procedure TmwSimplePasPar.TagFieldTypeName;
begin
  QualifiedIdentifier;
end;

procedure TmwSimplePasPar.FieldDeclaration;
begin
  IdentifierList;
  Expected(ptColon);
  TypeKind;
end;

procedure TmwSimplePasPar.FieldList;
begin
  while TokenID = ptIdentifier do
  begin
    FieldDeclaration;
    SEMICOLON;
  end;
  if TokenID = ptCase then
  begin
    VariantSection;
  end;
  SEMICOLON;
end;

procedure TmwSimplePasPar.RecordType;
begin
  Expected(ptRecord);
  FieldList;
  Expected(ptEnd);
end;

procedure TmwSimplePasPar.FileType;
begin
  Expected(ptFile);
  if TokenID = ptOf then
  begin
    NextToken;
    TypeId;
  end;
end;

procedure TmwSimplePasPar.SetType;
begin
  Expected(ptSet);
  Expected(ptOf);
  OrdinalType;
end;

procedure TmwSimplePasPar.ArrayType;
begin
  Expected(ptArray);
  if TokenID = ptSquareOpen then
  begin
    NextToken;
    OrdinalType;
    while TokenID = ptComma do
    begin
      NextToken;
      OrdinalType;
    end;
    Expected(ptSquareClose);
  end;
  Expected(ptOf);
  TypeKind;
end;

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

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

procedure TmwSimplePasPar.RealIdentifier;
begin
  case ExID of
    ptReal48:
      begin
        NextToken;
      end;
    ptReal:
      begin
        NextToken;
      end;
    ptSingle:
      begin
        NextToken;
      end;
    ptDouble:
      begin
        NextToken;
      end;
    ptExtended:
      begin
        NextToken;
      end;
    ptCurrency:
      begin
        NextToken;
      end;
    ptComp:
      begin
        NextToken;
      end;
  else
    begin
      SynError(InvalidRealIdentifier);
    end;
  end;
end;

procedure TmwSimplePasPar.RealType;
begin
  case TokenID of
    ptMinus:
      begin
        NextToken;
      end;
    ptPlus:
      begin
        NextToken;
      end;
  end;
  case TokenId of
    ptFloat:
      begin
        NextToken;
      end;
  else
    begin
      VariableReference;
    end;
  end;
end;

procedure TmwSimplePasPar.OrdinalIdentifier;
begin
  case ExID of
    ptBoolean:
      begin
        NextToken;
      end;
    ptByte:
      begin
        NextToken;
      end;
    ptBytebool:
      begin
        NextToken;
      end;
    ptCardinal:
      begin
        NextToken;
      end;
    ptChar:
      begin
        NextToken;
      end;
    ptDWord:
      begin
        NextToken;
      end;
    ptInt64:
      begin
        NextToken;
      end;
    ptInteger:
      begin
        NextToken;
      end;
    ptLongBool:
      begin
        NextToken;
      end;
    ptLongInt:
      begin
        NextToken;
      end;
    ptLongWord:
      begin
        NextToken;
      end;
    ptPChar:
      begin
        NextToken;
      end;
    ptShortInt:
      begin
        NextToken;
      end;
    ptSmallInt:
      begin
        NextToken;
      end;
    ptWideChar:
      begin
        NextToken;
      end;
    ptWord:
      begin
        NextToken;
      end;
    ptWordbool:
      begin
        NextToken;
      end;
  else
    begin
      SynError(InvalidOrdinalIdentifier);
    end;
  end;
end;

procedure TmwSimplePasPar.OrdinalType;
begin
  case TokenID of
    ptIdentifier:
      begin
        Lexer.InitAhead;
        case Lexer.AheadTokenID of
          ptPoint:
            begin
              Expression;
            end;
        else
          begin
            TypeID;
          end;
        end;
      end;
    ptRoundOpen:
      begin
        EnumeratedType;
      end;
    ptSquareOpen:
      begin
        NextToken;
        SubrangeType;
        Expected(ptSquareClose);
      end;
  else
    begin
      Expression;
    end;
  end;
  if TokenID = ptDotDot then
  begin
    NextToken;
    ConstantExpression;
  end;
end;

procedure TmwSimplePasPar.VariableReference;
begin
  case TokenID of
    ptAddressOp:
      begin
        NextToken;
        variable;
      end;
    ptDoubleAddressOp:
      begin
        NextToken;
        variable;
      end;
    ptPointerSymbol:
      begin
        NextToken;
        case TokenID of
          ptRoundClose, ptSquareClose: ;
        else
          begin
            variable;
          end;
        end;
      end;
  else variable;
  end;
end;

procedure TmwSimplePasPar.Variable; (* Attention: could also came from proc_call !! *)
begin
  case TokenID of
    ptInherited:
      begin
        NextToken;
        QualifiedIdentifier;
      end;
    ptPoint:
      begin
        VariableTwo;
      end;
    ptPointerSymbol:
      begin
        VariableTwo;
      end;
    ptRoundOpen:
      begin
        VariableTwo;
      end;
    ptSquareOpen:
      begin
        VariableTwo;
      end;
  else QualifiedIdentifier;
  end;
  VariableTwo;
  case TokenID of
    ptAs:
      begin
        NextToken;
        QualifiedIdentifier;
      end;
  end;
end;

procedure TmwSimplePasPar.VariableTwo;
begin
  case TokenID of
    ptPoint:
      begin
        NextToken;
        case TokenID of
          ptAddressOp, ptDoubleAddressOp, ptIdentifier:
            begin
              VariableReference;
            end;
          ptPointerSymbol, ptRoundOpen, ptSquareOpen:
            begin
              VariableTwo;
            end;
        end;
      end;
    ptPointerSymbol:
      begin
        NextToken;
        case TokenID of
          ptAddressOp, ptDoubleAddressOp, ptIdentifier:
            begin
              VariableReference;
            end;
          ptPoint, ptPointerSymbol, ptRoundOpen, ptSquareOpen:
            begin
              VariableTwo;
            end;
        end;
      end;
    ptRoundOpen:
      begin
        NextToken;
        fInRound := True;
        case TokenID of
          ptRoundClose:
            begin
              NextToken;
            end;
        else
          begin
            case TokenID of
              ptAddressOp, ptDoubleAddressOp:
                begin
                  VariableReference;
                end;
              ptPoint, ptPointerSymbol, ptRoundOpen, ptSquareOpen:
                begin
                  VariableTwo;
                end;
            end;
            fInRound := True;
            ExpressionList;
            fInRound := True;
            Expected(ptRoundClose);
            fInRound := False;
          end;
        end;
        case TokenID of
          ptAddressOp, ptDoubleAddressOp:
            begin
              VariableReference;
            end;
          ptPoint, ptPointerSymbol, ptRoundOpen, ptSquareOpen:
            begin
              VariableTwo;
            end;
        end;
      end;
    ptSquareOpen:
      begin
        Lexer.InitAhead;
        while Lexer.AheadTokenID <> ptSemiColon do
        begin
          case Lexer.AheadTokenID of
            ptBegin, ptClass, ptConst, ptEnd, ptDotDot, ptNull, ptThreadVar, ptType,
              ptVar: break;
          else
            Lexer.AheadNext;
          end;
        end;
        case Lexer.AheadTokenID of
          ptDotDot:
            begin
              SubrangeType;
            end;
        else
          begin
            NextToken;
            case TokenID of
              ptSquareClose:
                begin
                  NextToken;
                end;
            else
              begin
                case TokenID of
                  ptAddressOp, ptDoubleAddressOp:
                    begin
                      VariableReference;
                    end;
                  ptPoint, ptPointerSymbol, ptRoundOpen, ptSquareOpen:
                    begin
                      VariableTwo;
                    end;
                end;
                ExpressionList;
                Expected(ptSquareClose);
              end;
            end;
            case TokenID of
              ptAddressOp, ptDoubleAddressOp:
                begin
                  VariableReference;
                end;
              ptPoint, ptPointerSymbol, ptRoundOpen, ptSquareOpen:
                begin
                  VariableTwo;
                end;
            end;

          end;
        end;
      end
  end;
end;

procedure TmwSimplePasPar.InterfaceType;
begin
  case TokenID of
    ptInterface:
      begin
        NextToken;
      end;
    ptDispInterface:
      begin
        NextToken;
      end
  else
    begin
      SynError(InvalidInterfaceType);
    end;
  end;
  case TokenID of
    ptEnd:
      begin
        NextToken; { Direct descendant without new members }
      end;
    ptRoundOpen:
      begin
        InterfaceHeritage;
        case TokenID of
          ptEnd:
            begin
              NextToken; { No new members }
            end;
          ptSemiColon: ; { No new members }
        else
          begin
            if TokenID = ptSquareOpen then
            begin
              InterfaceGUID;
            end;
            InterfaceMemberList;
            Expected(ptEnd);
          end;
        end;
      end;
  else
    begin
      if TokenID = ptSquareOpen then
      begin
        InterfaceGUID;
      end;
      InterfaceMemberList; { Direct descendant }
      Expected(ptEnd);
    end;
  end;
end;

procedure TmwSimplePasPar.InterfaceMemberList;
begin
  while TokenID in [ptFunction, ptProcedure, ptProperty] do
  begin
    ClassMethodOrProperty;
  end;
end;

procedure TmwSimplePasPar.ClassType;
begin
  Expected(ptClass);
  case TokenID of
    ptEnd:
      begin
        NextToken; { Direct descendant of TObject without new members }
      end;
    ptRoundOpen:
      begin
        ClassHeritage;
        case TokenID of
          ptEnd:
            begin
              NextToken; { No new members }
            end;
          ptSemiColon: ; { No new members }
        else
          begin
            ClassMemberList;
            Expected(ptEnd);
          end;
        end;
      end;
  else
    begin
      ClassMemberList; { Direct descendant of TObject }
      Expected(ptEnd);
    end;
  end;
end;

procedure TmwSimplePasPar.ClassHeritage;
begin
  Expected(ptRoundOpen);
  QualifiedIdentifierList;
  Expected(ptRoundClose);
end;

procedure TmwSimplePasPar.ClassVisibility;
begin
  while ExID in [ptAutomated, ptPrivate, pt