cncodeformater.pas

CnCodeFormater Readme Author: passos Email: [e-mail]@21cn.com Last Update:20

  procedure FormatDesignatorAndOthers(PreSpaceCount: Byte);
  begin
    FormatDesignator(PreSpaceCount);

    while Scaner.Token in [tokAssign, tokLB, tokLess] do
    begin
      case Scaner.Token of
        tokAssign:
          begin
            Match(tokAssign);
            FormatExpression;
          end;

        tokLB:
          begin
            { DONE: deal with function call, save to symboltable }
            Match(tokLB);
            FormatExprList;
            Match(tokRB);

            if Scaner.Token = tokHat then
              Match(tokHat);

            if Scaner.Token = tokDot then
            begin
              Match(tokDot);
              FormatSimpleStatement;
            end;
          end;
        tokLess:
          begin
            FormatTypeParams;
          end;
      end;
    end;
  end;
begin
  case Scaner.Token of
    tokSymbol, tokAtSign,
    tokDirective_BEGIN..tokDirective_END, // 允许语句以部分关键字开头
    tokComplex_BEGIN..tokComplex_END:
      begin
        FormatDesignatorAndOthers(PreSpaceCount);
      end;

    tokKeywordInherited:
      begin
        {
          inherited can be:
          inherited;
          inherited Foo;
          inherited Foo(bar);
          inherited FooProp := bar;
          inherited FooProp[Bar] := Fish;
          bar :=  inherited FooProp[Bar];
        }
        Match(Scaner.Token, PreSpaceCount);

        if CanBeSymbol(Scaner.Token) then
          FormatSimpleStatement;
      end;

    tokKeywordGoto:
      begin
        Match(Scaner.Token, PreSpaceCount);
        { DONE: FormatLabel }
        FormatLabel;
      end;

    tokLB: // 括号开头的未必是 (SimpleStatement)，还可能是 (a)^ := 1 这种 Designator
      begin
        // found in D9 surpport: if ... then (...)

        // can delete the LB & RB, code optimize ??
        // 先当做 Designator 来看，处理完毕看后续有无 := ( 来判断是否结束
        // 如果是结束了，则 Designator 的处理是对的，否则按 Simplestatement 来。

        Scaner.SaveBookmark(Bookmark);
        OldLastToken := FLastToken;
        OldInternalRaiseException := FInternalRaiseException;
        FInternalRaiseException := True;
        // 需要 Exception 来判断后续内容

        try
          CodeGen.LockOutput;

          try
            FormatDesignator(PreSpaceCount);
            // 假设 Designator 处理完毕，判断后续是啥

            IsDesignator := Scaner.Token in [tokAssign, tokLB, tokSemicolon];
            // 目前只想到这几个。Semicolon 是怕 Designator 已经作为语句处理完了
          except
            IsDesignator := False;
            // 如果后面碰到了 := 等情形，FormatDesignator 会出错，
            // 说明本句是带括号嵌套的 Simplestatement
          end;
        finally
          Scaner.LoadBookmark(Bookmark);
          FLastToken := OldLastToken;
          CodeGen.UnLockOutput;
          FInternalRaiseException := OldInternalRaiseException;
        end;

        if not IsDesignator then
        begin
          //Match(tokLB);  优化不用的括号
          Scaner.NextToken;

          FormatSimpleStatement(PreSpaceCount);

          if Scaner.Token = tokRB then
            Scaner.NextToken
          else
            ErrorToken(tokRB);

          //Match(tokRB);
          end
        else
        begin
          FormatDesignatorAndOthers(PreSpaceCount);
        end;
      end;
  else
    Error('Identifier or Goto or Inherited expected.');
  end;
end;

procedure TCnStatementFormater.FormatLabel(PreSpaceCount: Byte);
begin
  if Scaner.Token = tokInteger then
    Match(tokInteger, PreSpaceCount)
  else
    Match(tokSymbol, PreSpaceCount);
end;

{ Statement -> [LabelId ':']/.. [SimpleStatement | StructStmt] }
procedure TCnStatementFormater.FormatStatement(PreSpaceCount: Byte);
begin
  while Scaner.ForwardToken() = tokColon do
  begin
    Writeln;
    FormatLabel;
    Match(tokColon);

    Writeln;
  end;

  // 允许语句以部分关键字开头，比如变量名等
  if Scaner.Token in SimpStmtTokens + DirectiveTokens + ComplexTokens then
    FormatSimpleStatement(PreSpaceCount)
  else if Scaner.Token in StructStmtTokens then
  begin
    FormatStructStmt(PreSpaceCount);
  end;
  { Do not raise error here, Statement maybe empty }
end;

{ StmtList -> Statement/';'... }
procedure TCnStatementFormater.FormatStmtList(PreSpaceCount: Byte);
begin
  // 处理空语句单独分行的问题
  while Scaner.Token = tokSemicolon do
  begin
    Match(tokSemicolon, PreSpaceCount, 0, False, True);
    if Scaner.Token <> tokKeywordEnd then
      Writeln;
  end;
  
  FormatStatement(PreSpaceCount);

  while Scaner.Token = tokSemicolon do
  begin
    Match(tokSemicolon);

    // 处理空语句单独分行的问题
    while Scaner.Token = tokSemicolon do
    begin
      Writeln;
      Match(tokSemicolon, PreSpaceCount, 0, False, True);
    end;

    if Scaner.Token in StmtTokens + DirectiveTokens + ComplexTokens
      + [tokInteger] then // 部分关键字能做语句开头，Label 可能以数字开头
    begin
      { DONE: 建立语句列表 }
      Writeln;
      FormatStatement(PreSpaceCount);
    end;
  end;
end;

{
  StructStmt -> CompoundStmt
             -> ConditionalStmt
             -> LoopStmt
             -> WithStmt
             -> TryStmt
}
procedure TCnStatementFormater.FormatStructStmt(PreSpaceCount: Byte);
begin
  case Scaner.Token of
    tokKeywordBegin,
    tokKeywordAsm:    FormatCompoundStmt(PreSpaceCount);
    tokKeywordIf:     FormatIfStmt(PreSpaceCount);
    tokKeywordCase:   FormatCaseStmt(PreSpaceCount);
    tokKeywordRepeat: FormatRepeatStmt(PreSpaceCount);
    tokKeywordWhile:  FormatWhileStmt(PreSpaceCount);
    tokKeywordFor:    FormatForStmt(PreSpaceCount);
    tokKeywordWith:   FormatWithStmt(PreSpaceCount);
    tokKeywordTry:    FormatTryStmt(PreSpaceCount);
    tokKeywordRaise:  FormatRaiseStmt(PreSpaceCount);
  else
    ErrorFmt(SSymbolExpected, ['Statement', TokenToString(Scaner.Token)]);
  end;
end;

{
  TryEnd -> FINALLY StmtList END
         -> EXCEPT [ StmtList | (ExceptionHandler/;... [ELSE Statement]) ] [';'] END
}
procedure TCnStatementFormater.FormatTryEnd(PreSpaceCount: Byte);
begin
  case Scaner.Token of
    tokKeywordFinally:
      begin
        Match(Scaner.Token, PreSpaceCount);
        Writeln;
        FormatStmtList(Tab(PreSpaceCount));
        Writeln;
        Match(tokKeywordEnd, PreSpaceCount);
      end;

    tokKeywordExcept:
      begin
        Match(Scaner.Token, PreSpaceCount);

        if Scaner.Token <> tokKeywordOn then
        begin
          Writeln;
          FormatStmtList(Tab(PreSpaceCount))
        end
        else
        begin
          while Scaner.Token = tokKeywordOn do
          begin
            Writeln;
            FormatExceptionHandler(Tab(PreSpaceCount));
          end;

          if Scaner.Token = tokKeywordElse then
          begin
            Writeln;
            Match(tokKeywordElse, PreSpaceCount, 1);
            Writeln;
            FormatStmtList(Tab(PreSpaceCount, False));
          end;

          if Scaner.Token = tokSemicolon then
            Match(tokSemicolon);
        end;

        Writeln;
        Match(tokKeywordEnd, PreSpaceCount);
      end;
  else
    ErrorFmt(SSymbolExpected, ['except/finally']);
  end;
end;

{
  ExceptionHandler -> ON [ident :] Type do Statement
}
procedure TCnStatementFormater.FormatExceptionHandler(PreSpaceCount: Byte);
var
  OnlySemicolon: Boolean;
begin
  Match(tokKeywordOn, PreSpaceCount);
  Match(tokSymbol);
  if Scaner.Token = tokColon then
  begin
    Match(tokColon);
    Match(tokSymbol);
  end;
  Match(tokKeywordDo);
  Writeln;

  OnlySemicolon := Scaner.Token = tokSemicolon;
  FormatStatement(Tab(PreSpaceCount));
  
  if Scaner.Token = tokSemicolon then
  begin
    if OnlySemicolon then
      Match(tokSemicolon, Tab(PreSpaceCount), 0, False, True)
    else
      Match(tokSemicolon);
  end;
end;

{ TryStmt -> TRY StmtList TryEnd }
procedure TCnStatementFormater.FormatTryStmt(PreSpaceCount: Byte);
begin
  Match(tokKeywordTry, PreSpaceCount);
  Writeln;
  FormatStmtList(Tab(PreSpaceCount));
  Writeln;
  FormatTryEnd(PreSpaceCount);
end;

{ WhileStmt -> WHILE Expression DO Statement }
procedure TCnStatementFormater.FormatWhileStmt(PreSpaceCount: Byte);
begin
  Match(tokKeywordWhile, PreSpaceCount);
  FormatExpression;
  Match(tokKeywordDo);
  Writeln;
  FormatStatement(Tab(PreSpaceCount));
end;

{ WithStmt -> WITH IdentList DO Statement }
procedure TCnStatementFormater.FormatWithStmt(PreSpaceCount: Byte);
begin
  Match(tokKeywordWith, PreSpaceCount);
  // FormatDesignatorList; // Grammer error.

  FormatExpression;
  while Scaner.Token = tokComma do
  begin
    MatchOperator(tokComma);
    FormatExpression;
  end;

  Match(tokKeywordDo);
  Writeln;
  FormatStatement(Tab(PreSpaceCount));
end;

{ RaiseStmt -> RAISE [ Expression | Expression AT Expression ] }
procedure TCnStatementFormater.FormatRaiseStmt(PreSpaceCount: Byte);
begin
  Match(tokKeywordRaise, PreSpaceCount);

  if not (Scaner.Token in [tokSemicolon, tokKeywordEnd, tokKeywordElse]) then
    FormatExpression;

  if Scaner.TokenSymbolIs('AT') then
  begin
    Match(Scaner.Token, 1, 1);
    FormatExpression;
  end;
end;

{ AsmBlock -> AsmStmtList 按自定义规矩格式化}
procedure TCnStatementFormater.FormatAsmBlock(PreSpaceCount: Byte);
var
  NewLine, AfterKeyword, IsLabel, HasAtSign: Boolean;
  T: TPascalToken;
  Bookmark: TScannerBookmark;
  OldLastToken: TPascalToken;
  LabelLen, InstrucLen: Integer;
  ALabel: string;
  OldKeywordStyle: TKeywordStyle;
begin
  Match(tokKeywordAsm, PreSpaceCount);
  Writeln;
  Scaner.ASMMode := True;
  OldKeywordStyle := CnPascalCodeForRule.KeywordStyle;
  CnPascalCodeForRule.KeywordStyle := ksUpperCaseKeyword; // 临时替换

  try
    NewLine := True;
    AfterKeyword := False;
    InstrucLen := 0;
    IsLabel := False;

    while (Scaner.Token <> tokKeywordEnd) or
      ((Scaner.Token = tokKeywordEnd) and (FLastToken = tokAtSign)) do
    begin
      T := Scaner.Token;
      Scaner.SaveBookmark(Bookmark);
      OldLastToken := FLastToken;
      CodeGen.LockOutput;

      if NewLine then // 行首，要检测label
      begin
        LabelLen := 0;
        ALabel := '';
        HasAtSign := False;
        AfterKeyword := False;
        InstrucLen := Length(Scaner.TokenString); // 记住可能是的汇编指令关键字的长度

        while Scaner.Token in [tokAtSign, tokSymbol, tokInteger] + KeywordTokens +
          DirectiveTokens + ComplexTokens do
        begin
          if Scaner.Token = tokAtSign then
          begin
            HasAtSign := True;
            ALabel := ALabel + '@';
            Inc(LabelLen);
            Scaner.NextToken;
          end
          else if Scaner.Token in [tokSymbol, tokInteger] + KeywordTokens +
            DirectiveTokens + ComplexTokens then // 关键字可以做 label 名
          begin
            ALabel := ALabel + Scaner.TokenString;
            Inc(LabelLen, Length(Scaner.TokenString));

            Scaner.NextToken;
          end;
        end;
        // 跳过了一个可能是 label 的，首以 @ 开头的才是 label
        IsLabel := HasAtSign and (Scaner.Token = tokColon);
        if IsLabel then
        begin
          Inc(LabelLen);
          ALabel := ALabel + ':';
        end;