cncodeformater.pas

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

end;

function TCnAbstractCodeFormater.Tab(PreSpaceCount: Byte;
  CareBeginBlock: Boolean): Byte;
begin
  if CareBeginBlock then
  begin
    { TODO: customize Begin..End Block style }
    if Scaner.Token <> tokKeywordBegin then // 处理了连续俩 begin 而需要缩进的情况
      Result := PreSpaceCount + CnPascalCodeForRule.TabSpaceCount
    else
      Result := PreSpaceCount;
  end
  else
  begin
    Result := PreSpaceCount + CnPascalCodeForRule.TabSpaceCount;
  end;
end;

procedure TCnAbstractCodeFormater.WriteLine;
begin
  if (Scaner.BlankLinesBefore = 0) and (Scaner.BlankLinesAfter = 0) then
  begin
    FCodeGen.Writeln;
    FCodeGen.Writeln;
  end
  else // 有 Comment，已经输出了，但 Comment 后的空行未输出，并且前后各有换行
  begin
    if Scaner.BlankLinesBefore = 0 then
    begin
      // 注释块和上一行在一起，照常输出俩空行
      FCodeGen.Writeln;
      FCodeGen.Writeln;
    end
    else if (Scaner.BlankLinesBefore > 1) and (Scaner.BlankLinesAfter = 1) then
    begin
      // 注释块空上不空下，那就让下面挨着下，不需要额外输出空行了
      ;
    end
    else if (Scaner.BlankLinesBefore > 1) and (Scaner.BlankLinesAfter > 1) then
    begin
      // 注释块上下都空，那下面保留一空行
      FCodeGen.Writeln;
      FCodeGen.Writeln;
    end
    else if (Scaner.BlankLinesBefore = 1) and (Scaner.BlankLinesAfter = 1) then
    begin
      // 上下都不空，采取靠上策略
      FCodeGen.Writeln;
      FCodeGen.Writeln;
    end
    else if (Scaner.BlankLinesBefore = 1) and (Scaner.BlankLinesAfter > 1) then
    begin
      // 上空下不空，那就靠上
      FCodeGen.Writeln;
      FCodeGen.Writeln;
    end;  
  end;
  FLastToken := tokBlank; // prevent 'Symbol'#13#10#13#10' Symbol'
end;

procedure TCnAbstractCodeFormater.Writeln;
begin
  if (Scaner.BlankLinesBefore = 0) and (Scaner.BlankLinesAfter = 0) then
  begin
    FCodeGen.Writeln;
  end
  else // 有 Comment，已经输出了，但 Comment 后的空行未输出，并且前后各有换行
  begin
    if Scaner.BlankLinesBefore = 0 then
    begin
      // 注释块和上一行在一起，照常输出空行
      FCodeGen.Writeln;
    end
    else if (Scaner.BlankLinesBefore > 1) and (Scaner.BlankLinesAfter = 1) then
    begin
      // 注释块空上不空下，那就让下面挨着下，不需要额外输出空行了
      ;
    end
    else if (Scaner.BlankLinesBefore > 1) and (Scaner.BlankLinesAfter > 1) then
    begin
      // 注释块上下都空，那下面保留一空行
      FCodeGen.Writeln;
      FCodeGen.Writeln;
    end
    else if (Scaner.BlankLinesBefore = 1) and (Scaner.BlankLinesAfter = 1) then
    begin
      // 上下都不空，采取靠上策略
      FCodeGen.Writeln;
    end;
  end;
  FLastToken := tokBlank; // prevent 'Symbol'#13#10' Symbol'
end;

procedure TCnAbstractCodeFormater.WriteToken(Token: TPascalToken;
  BeforeSpaceCount, AfterSpaceCount: Byte; IgnorePreSpace: Boolean;
  SemicolonIsLineStart: Boolean);
begin
  // 两个标识符之间以空格分离
  if ( (FLastToken in IdentTokens) and (Token in IdentTokens + [tokAtSign]) ) then
    CodeGen.Write(' ')
  else if (FLastToken in RightBracket) and (Token in [tokKeywordThen, tokKeywordDo, tokKeywordOf]) then
    CodeGen.Write(' ')
  else if (Token in LeftBracket) and (FLastToken in [tokKeywordIf, tokKeywordWhile,
    tokKeywordFor, tokKeywordWith, tokKeywordCase]) then
    CodeGen.Write(' ');
    // 强行分离括号与关键字

  //标点符号的设置
  case Token of
    tokComma:     CodeGen.Write(Scaner.TokenString, 0, 1);
    tokColon:
      begin
        if IgnorePreSpace then
          CodeGen.Write(Scaner.TokenString)
        else
          CodeGen.Write(Scaner.TokenString, 0, 1);
      end;
    tokSemiColon:
      begin
        if IgnorePreSpace then
          CodeGen.Write(Scaner.TokenString)
        else if SemicolonIsLineStart then
          CodeGen.Write(Scaner.TokenString, BeforeSpaceCount, 1)
        else
          CodeGen.Write(Scaner.TokenString, 0, 1);
      end;
    tokAssign:    CodeGen.Write(Scaner.TokenString, 1, 1);
  else

    if (Token in KeywordTokens) then
    begin
      if (Token <> tokKeywordEnd) and (Token <> tokKeywordString) then
      begin
          CodeGen.Write(
            FormatString(Scaner.TokenString, CnPascalCodeForRule.KeywordStyle),
            BeforeSpaceCount, AfterSpaceCount);
      end
      else
      begin
        CodeGen.Write(
          FormatString(Scaner.TokenString, CnPascalCodeForRule.KeywordStyle),
          BeforeSpaceCount, AfterSpaceCount);
      end;
    end
    else
      CodeGen.Write(Scaner.TokenString, BeforeSpaceCount, AfterSpaceCount);
  end;

  FLastToken := Token;
end;

procedure TCnAbstractCodeFormater.CheckHeadComments;
var
  I: Integer;
begin
  if FCodeGen <> nil then
    for I := 1 to Scaner.BlankLinesAfter do
      FCodeGen.Writeln;
end;

{ TCnExpressionFormater }

procedure TCnExpressionFormater.FormatCode;
begin
  FormatExpression;
end;

{ ConstExpr -> <constant-expression> }
procedure TCnExpressionFormater.FormatConstExpr(PreSpaceCount: Byte);
begin
  FormatExpression(PreSpaceCount);
end;

{ 新加的用于 type 中的 ConstExpr -> <constant-expression> ，
  其中后者不允许出现 = 以及泛型 <> 运算符}
procedure TCnExpressionFormater.FormatConstExprInType(PreSpaceCount: Byte);
begin
  FormatSimpleExpression(PreSpaceCount);

  while Scaner.Token in (RelOpTokens - [tokEqual, tokLess, tokGreat])  do
  begin
    MatchOperator(Scaner.Token);
    FormatSimpleExpression;
  end;
end;

{
  Designator -> QualId ['.' Ident | '[' ExprList ']' | '^']...

  注：虽然有 Designator -> '(' Designator ')' 的情况，但已经包含在 QualId 的处理中了。
}
procedure TCnExpressionFormater.FormatDesignator(PreSpaceCount: Byte);
begin
  if Scaner.Token = tokAtSign then // 如果是 @ Designator 的形式则再次递归
  begin
    Match(tokAtSign, PreSpaceCount);
    FormatDesignator;
    Exit;
  end;

  FormatQualID(PreSpaceCount);
  while Scaner.Token in [tokDot, tokLB, tokSLB, tokHat, tokPlus, tokMinus] do
  begin
    case Scaner.Token of
      tokDot:
        begin
          Match(tokDot);
          FormatIdent;
        end;

      tokLB, tokSLB: // [ ]
        begin
          { DONE: deal with index visit }
          Match(Scaner.Token);
          FormatExprList;
          Match(Scaner.Token);
        end;

      tokHat: // ^
        begin
          { DONE: deal with pointer derefrence }
          Match(tokHat);
        end;

      tokPlus, tokMinus:
        begin
          MatchOperator(Scaner.Token);
          FormatExpression;
        end;
    end; // case
  end; // while
end;

{ DesignatorList -> Designator/','... }
procedure TCnExpressionFormater.FormatDesignatorList(PreSpaceCount: Byte);
begin
  FormatDesignator;

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

{ Expression -> SimpleExpression [RelOp SimpleExpression]... }
procedure TCnExpressionFormater.FormatExpression(PreSpaceCount: Byte);
begin
  FormatSimpleExpression(PreSpaceCount);

  while Scaner.Token in RelOpTokens + [tokHat, tokSLB, tokDot] do
  begin
    if Scaner.Token in RelOpTokens then
    begin
      MatchOperator(Scaner.Token);
      FormatSimpleExpression;
    end;

    // 这几处额外的内容，不知道有啥副作用

    // pchar(ch)^
    if Scaner.Token = tokHat then
      Match(tokHat)
    else if Scaner.Token = tokSLB then  // PString(PStr)^[1]
    begin
      Match(tokSLB);
      FormatExprList;
      Match(tokSRB);
    end
    else if Scaner.Token = tokDot then // typecase
    begin
      Match(tokDot);
      FormatExpression;
    end;
  end;
end;

{ ExprList -> Expression/','... }
procedure TCnExpressionFormater.FormatExprList(PreSpaceCount: Byte);
begin
  FormatExpression;

  if Scaner.Token = tokAssign then // 匹配 OLE 调用的情形
  begin
    Match(tokAssign);
    FormatExpression;
  end;

  while Scaner.Token = tokComma do
  begin
    Match(tokComma, 0, 1);

    if Scaner.Token in ([tokAtSign, tokLB] + ExprTokens + KeywordTokens +
      DirectiveTokens + ComplexTokens) then // 有关键字做变量名的情况也得考虑到
    begin
      FormatExpression;

      if Scaner.Token = tokAssign then // 匹配 OLE 调用的情形
      begin
        Match(tokAssign);
        FormatExpression;
      end;
    end;
  end;
end;

{
  Factor -> Designator ['(' ExprList ')']
         -> '@' Designator
         -> Number
         -> String
         -> NIL
         -> '(' Expression ')'
         -> NOT Factor
         -> SetConstructor
         -> TypeId '(' Expression ')'
         -> INHERITED Expression

  这里同样有无法直接区分 '(' Expression ')' 和带括号的 Designator
  例子就是(str1+str2)[1] 等诸如此类的表达式，先姑且判断一下后续的方括号
}
procedure TCnExpressionFormater.FormatFactor(PreSpaceCount: Byte);
begin
  case Scaner.Token of
    tokSymbol, tokAtSign,
    tokKeyword_BEGIN..tokKeywordIn,  // 此三行表示部分关键字也可做 Factor
    tokKeywordInitialization..tokKeywordNil,
    tokKeywordObject..tokKeyword_END,
    tokDirective_BEGIN..tokDirective_END,
    tokComplex_BEGIN..tokComplex_END:
      begin
        FormatDesignator(PreSpaceCount);

        if Scaner.Token = tokLB then
        begin
          { TODO: deal with function call node }
          Match(tokLB);
          FormatExprList;
          Match(tokRB);
        end;
      end;

    tokKeywordInherited:
      begin
        Match(tokKeywordInherited);
        FormatExpression;
      end;

    tokChar, tokWString, tokString, tokInteger, tokFloat, tokTrue, tokFalse:
      begin
        case Scaner.Token of
          tokInteger, tokFloat:
            WriteToken(Scaner.Token, PreSpaceCount);
          tokTrue, tokFalse:
            CodeGen.Write(UpperFirst(Scaner.TokenString), PreSpaceCount);
            // CodeGen.Write(FormatString(Scaner.TokenString, CnCodeForRule.KeywordStyle), PreSpaceCount);
          tokChar, tokString:
            CodeGen.Write(Scaner.TokenString, PreSpaceCount); //QuotedStr
          tokWString:
            CodeGen.Write(Scaner.TokenString, PreSpaceCount);
        end;

        FLastToken := Scaner.Token;
        Scaner.NextToken;
      end;

    tokKeywordNOT:
      begin
        if Scaner.ForwardToken in [tokLB] then // 无奈之举，避免少个空格
          Match(tokKeywordNot, 0, 1)
        else
          Match(tokKeywordNot);
        FormatFactor;
      end;

    tokLB: // (  需要判断是带括号嵌套的 Designator 还是 Expression.
      begin
        // 暂且修改了 Expression 内部，使其支持^和[]了。
        Match(tokLB, PreSpaceCount);
        FormatExpression;
        Match(tokRB);
      end;

    tokSLB: // [
      begin
        FormatSetConstructor(PreSpaceCount);
      end;
  else
    { Doesn't do anything to implemenation rule: '' Designator }
  end;
end;

procedure TCnExpressionFormater.FormatIdent(PreSpaceCount: Byte;
  const CanHaveUnitQual: Boolean);
begin
  if Scaner.Token in ([tokSymbol] + KeywordTokens + ComplexTokens + DirectiveTokens) then
    Match(Scaner.Token, PreSpaceCount); // 标识符中允许使用部分关键字

  while CanHaveUnitQual and (Scaner.Token = tokDot) do
  begin
    Match(tokDot);
    if Scaner.Token in ([tokSymbol] + KeywordTokens + ComplexTokens + DirectiveTokens) then
      Match(Scaner.Token); // 也继续允许使用部分关键字
  end;
end;

{ IdentList -> Ident/','... }
procedure TCnExpressionFormater.FormatIdentList(PreSpaceCount: Byte;
  const CanHaveUnitQual: Boolean);
begin
  FormatIdent(PreSpaceCount, CanHaveUnitQual);

  while Scaner.Token = tokComma do
  begin
    Match(tokComma);
    FormatIdent(0, CanHaveUnitQual);
  end;