cncodeformater.pas

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

end;

{
  New Grammer:
  QualID -> '(' Designator [AS TypeId]')'
         -> [UnitId '.'] Ident
         -> '(' pointervar + expr ')'

  for typecast, e.g. "(x as Ty)" or just bracketed, as in (x).y();

  Old Grammer:
  QualId -> [UnitId '.'] Ident 
}
procedure TCnExpressionFormater.FormatQualID(PreSpaceCount: Byte);

  procedure FormatIdentWithBracket(PreSpaceCount: Byte);
  var
    I, BracketCount: Integer;
  begin
    BracketCount := 0;
    while Scaner.Token = tokLB do
    begin
      Match(tokLB);
      Inc(BracketCount);
    end;

    FormatIdent(PreSpaceCount, True);

    for I := 1 to BracketCount do
      Match(tokRB);
  end;

begin
  if(Scaner.Token = tokLB) then
  begin
    Match(tokLB, PreSpaceCount);
    FormatDesignator;

    if(Scaner.Token = tokKeywordAs) then
    begin
      Match(tokKeywordAs, 1, 1);
      FormatIdentWithBracket(0);
    end;
    Match(tokRB);    
  end
  else
  begin
    FormatIdentWithBracket(PreSpaceCount);
    // 暂时不处理 UnitId 的情形
  end;
end;

{
  SetConstructor -> '[' [SetElement/','...] ']'
  SetElement -> Expression ['..' Expression]
}
procedure TCnExpressionFormater.FormatSetConstructor(PreSpaceCount: Byte);

  procedure FormatSetElement;
  begin
    FormatExpression;

    if Scaner.Token = tokRange then
    begin
      Match(tokRange);
      FormatExpression;
    end;
  end;
  
begin
  Match(tokSLB);

  if Scaner.Token <> tokSRB then
  begin
    FormatSetElement;
  end;

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

  Match(tokSRB);
end;

{ SimpleExpression -> ['+' | '-'] Term [AddOp Term]... }
procedure TCnExpressionFormater.FormatSimpleExpression(
  PreSpaceCount: Byte);
begin
  if Scaner.Token in [tokPlus, tokMinus] then
  begin
    Match(Scaner.Token, PreSpaceCount);
    FormatTerm;
  end
  else
    FormatTerm(PreSpaceCount);

  while Scaner.Token in AddOpTokens do
  begin
    MatchOperator(Scaner.Token);
    FormatTerm;
  end;
end;

{ Term -> Factor [MulOp Factor]... }
procedure TCnExpressionFormater.FormatTerm(PreSpaceCount: Byte);
begin
  FormatFactor(PreSpaceCount);

  while Scaner.Token in (MulOPTokens + ShiftOpTokens) do
  begin
    MatchOperator(Scaner.Token);
    FormatFactor;
  end;
end;

// 泛型支持
procedure TCnExpressionFormater.FormatFormalTypeParamList(
  PreSpaceCount: Byte);
begin
  FormatTypeParams(PreSpaceCount); // 两者等同，直接调用
end;

{TypeParamDecl -> TypeParamList [ ':' ConstraintList ]}
procedure TCnExpressionFormater.FormatTypeParamDecl(PreSpaceCount: Byte);
begin
  FormatTypeParamList(PreSpaceCount);
  if Scaner.Token = tokColon then // ConstraintList
  begin
    Match(tokColon);
    FormatIdentList(PreSpaceCount, True);
  end;
end;

{ TypeParamDeclList -> TypeParamDecl/';'... }
procedure TCnExpressionFormater.FormatTypeParamDeclList(
  PreSpaceCount: Byte);
begin
  FormatTypeParamDecl(PreSpaceCount);
  while Scaner.Token = tokSemicolon do
  begin
    Match(tokSemicolon);
    FormatTypeParamDecl(PreSpaceCount);
  end;
end;

{TypeParamList -> ( [ CAttrs ] [ '+' | '-' [ CAttrs ] ] Ident )/','...}
procedure TCnExpressionFormater.FormatTypeParamList(PreSpaceCount: Byte);
begin
  FormatIdent(PreSpaceCount);
  while Scaner.Token = tokComma do // 暂不处理 CAttr
  begin
    Match(tokComma);
    FormatIdent(PreSpaceCount);
  end;
end;

{ TypeParams -> '<' TypeParamDeclList '>' }
procedure TCnExpressionFormater.FormatTypeParams(PreSpaceCount: Byte);
begin
  Match(tokLess);
  FormatTypeParamDeclList(PreSpaceCount);
  Match(tokGreat);
end;

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

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

  if Scaner.Token = tokLess then
    FormatTypeParams;
end;

procedure TCnExpressionFormater.FormatTypeParamIdentList(
  PreSpaceCount: Byte);
begin
  FormatTypeParamIdent(PreSpaceCount);

  while Scaner.Token = tokComma do
  begin
    Match(tokComma);
    FormatTypeParamIdent;
  end;
end;

{ TCnStatementFormater }

{ CaseLabel -> ConstExpr ['..' ConstExpr] }
procedure TCnStatementFormater.FormatCaseLabel(PreSpaceCount: Byte);
begin
  FormatConstExpr(PreSpaceCount);

  if Scaner.Token = tokRange then
  begin
    Match(tokRange);
    FormatConstExpr;
  end;
end;

{ CaseSelector -> CaseLabel/','... ':' Statement }
procedure TCnStatementFormater.FormatCaseSelector(PreSpaceCount: Byte);
begin
  FormatCaseLabel(PreSpaceCount);

  while Scaner.Token = tokComma do
  begin
    Match(tokComma);
    FormatCaseLabel; 
  end;

  Match(tokColon);
  // TODO: 此处控制每个 caselabel 后是否换行，但如不换，碰上 begin end 就乱了
  Writeln;
  if Scaner.Token <> tokSemicolon then
    FormatStatement(Tab(PreSpaceCount, False))
  else // 是空语句就手工写缩进
    CodeGen.Write('', Tab(PreSpaceCount));
end;

{ CaseStmt -> CASE Expression OF CaseSelector/';'... [ELSE StmtList] [';'] END }
procedure TCnStatementFormater.FormatCaseStmt(PreSpaceCount: Byte);
var
  HasElse: Boolean;
begin
  Match(tokKeywordCase, PreSpaceCount);
  FormatExpression;
  Match(tokKeywordOf);
  Writeln;
  FormatCaseSelector(Tab(PreSpaceCount));

  while Scaner.Token in [tokSemicolon, tokKeywordEnd] do
  begin
    if Scaner.Token = tokSemicolon then
      Match(tokSemicolon);

    Writeln;
    if Scaner.Token in [tokKeywordElse, tokKeywordEnd] then
      Break;   
    FormatCaseSelector(Tab(PreSpaceCount));
  end;

  HasElse := False;
  if Scaner.Token = tokKeywordElse then
  begin
    HasElse := True;
    if FLastToken = tokKeywordEnd then
      Writeln;
    // else 前可不需要空一行
    Match(tokKeywordElse, PreSpaceCount, 1);
    Writeln;
    // FormatStatement(Tab(PreSpaceCount, False)); 
    // 此处修改成匹配多个语句
    FormatStmtList(Tab(PreSpaceCount, False));
  end;

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

  if HasElse then
    Writeln;
  Match(tokKeywordEnd, PreSpaceCount);
end;

procedure TCnStatementFormater.FormatCode(PreSpaceCount: Byte);
begin
  FormatStmtList(PreSpaceCount);
end;

{ CompoundStmt -> BEGIN StmtList END
               -> ASM ... END
}
procedure TCnStatementFormater.FormatCompoundStmt(PreSpaceCount: Byte);
begin
  case Scaner.Token of
    tokKeywordBegin:
      begin
        Match(tokKeywordBegin, PreSpaceCount);
        Writeln;
        FormatStmtList(Tab(PreSpaceCount, False));
        Writeln;
        Match(tokKeywordEnd, PreSpaceCount);
      end;

    tokKeywordAsm:
      begin
        FormatAsmBlock(PreSpaceCount);
      end;
  else
    ErrorTokens([tokKeywordBegin, tokKeywordAsm]);
  end;
end;

{ ForStmt -> FOR QualId ':=' Expression (TO | DOWNTO) Expression DO Statement }
{ ForStmt -> FOR QualId in Expression DO Statement }

procedure TCnStatementFormater.FormatForStmt(PreSpaceCount: Byte);
begin
  Match(tokKeywordFor, PreSpaceCount);
  FormatQualId;

  case Scaner.Token of
    tokAssign:
      begin
        Match(tokAssign);
        FormatExpression;

        if Scaner.Token in [tokKeywordTo, tokKeywordDownTo] then
          Match(Scaner.Token)
        else
          ErrorFmt(SSymbolExpected, ['to/downto', TokenToString(Scaner.Token)]);

        FormatExpression;
      end;

    tokKeywordIn:
      begin
        Match(tokKeywordIn, 1, 1);
        FormatExpression;
        { DONE: surport "for .. in .. do .." statment parser }
      end;

  else
    ErrorExpected(':= or in');
  end;

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

{ IfStmt -> IF Expression THEN Statement [ELSE Statement] }
procedure TCnStatementFormater.FormatIfStmt(PreSpaceCount: Byte; IgnorePreSpace: Boolean);
begin
  if IgnorePreSpace then
    Match(tokKeywordIF)
  else
    Match(tokKeywordIF, PreSpaceCount);

  { TODO: Apply more if stmt rule }
  FormatExpression;
  Match(tokKeywordThen);
  Writeln;
  FormatStatement(Tab(PreSpaceCount));

  if Scaner.Token = tokKeywordElse then
  begin
    Writeln;
    Match(tokKeywordElse, PreSpaceCount);
    if Scaner.Token = tokKeywordIf then // 处理 else if
    begin
      FormatIfStmt(PreSpaceCount, True);
      FormatStatement(Tab(PreSpaceCount));
    end
    else
    begin
      Writeln;
      FormatStatement(Tab(PreSpaceCount));
    end;
  end;
end;

{ RepeatStmt -> REPEAT StmtList UNTIL Expression }
procedure TCnStatementFormater.FormatRepeatStmt(PreSpaceCount: Byte);
begin
  Match(tokKeywordRepeat, PreSpaceCount, 1);
  Writeln;
  FormatStmtList(Tab(PreSpaceCount));
  Writeln;
  
  if Scaner.Token = tokLB then // 处理后面的空格
    Match(tokKeywordUntil, PreSpaceCount, 1)
  else
    Match(tokKeywordUntil, PreSpaceCount);
    
  FormatExpression;
end;

{
  SimpleStatement -> Designator ['(' ExprList ')']
                  -> Designator ':=' Expression
                  -> INHERITED
                  -> GOTO LabelId
                  -> '(' SimpleStatement ')'

  argh this doesn't take brackets into account
  as far as I can tell, typecasts like "(lcFoo as TComponent)" is a designator

  so is "Pointer(lcFoo)" so that you can do
  " Pointer(lcFoo) := Pointer(lcFoo) + 1;

  Niether does it take into account using property on returned object, e.g.
  qry.fieldbyname('line').AsInteger := 1;

  These can be chained indefinitely, as in
  foo.GetBar(1).Stuff['fish'].MyFudgeFactor.Default(2).Name := 'Jiim';

  补充：
  1. Designator 如果是以 ( 开头，比如 (a)^ := 1; 的情况，
     则难以和 '(' SimpleStatement ')' 区分。而且 Designator 自身也可能是括号嵌套
     现在的处理方法是，先关闭输出，按 Designator 处理（FormatDesignator内部加了
     括号嵌套的处理机制），扫描处理完毕后看后续的符号以决定是 Designator 还是
     Simplestatement，然后再次回到起点打开输出继续处理。
}
procedure TCnStatementFormater.FormatSimpleStatement(PreSpaceCount: Byte);
var
  Bookmark: TScannerBookmark;
  OldLastToken: TPascalToken;
  IsDesignator, OldInternalRaiseException: Boolean;