base_scanner.pas

来自「Delphi脚本控件」· PAS 代码 · 共 1,577 行 · 第 1/3 页

  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanIdentifierEx(ExtraChars: TCharSet);
begin
  Token.Position := P;

  repeat
    case LA(1) of
      'A'..'Z', 'a'..'z', '0'..'9', '_':
      begin
        Inc(P);
        Inc(PosNumber);
      end;
      else
      begin
        if LA(1) in ExtraChars then
        begin
          Inc(P);
          Inc(PosNumber);
        end
        else
          break;
      end;
    end;
  until false;

  Token.TokenClass := tcId;

  Token.Text := Copy(Buff, Token.Position, P - Token.Position + 1);

  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanChars(CSet: TCharSet);
var
  S: String;
begin
  Token.Position := P;

  S := c;
  while LA(1) in CSet do
    S := S + GetNextChar;
  Token.TokenClass := tcId;
  Token.Text := S;

  SetScannerState(scanProg);
end;

function GetVal(const StrVal: String): Variant;
var
  I, J, K: Integer;
  ch: Char;
  S: String;
begin
  I := Length(StrVal);
  ch := StrVal[I];
  case ch of
    'B', 'b':
    begin
      J := 0;
      K := 1;
      Dec(I);
      repeat
        ch := StrVal[I];

        if not (ch in ['0'..'1']) then
          raise TPaxScriptFailure.Create(errSyntaxError);

        if ch = '1' then
          Inc(J, K);

        K := K * 2;
        Dec(I);
      until I = 0;
      result := J;
    end;
    'D', 'd':
    begin
      result :=  SysUtils.StrToInt(Copy(StrVal, 1, I - 1));
    end;
    'H', 'h':
    begin
      S := '$' + Copy(StrVal, 1, I - 1);
      result := StrToInt(S);
    end;
    else
    begin
      S := Copy(StrVal, 1, 2);
      if (S = '0x') or (S = '0X') then
      begin
        S := '$' + Copy(StrVal, 3, Length(StrVal) - 2);
        result := StrToInt(S);
      end
      else if (S = '0b') or (S = '0B') then
      begin
        S := Copy(StrVal, 3, Length(StrVal) - 2);
        I := Length(S);
        J := 0;
        K := 1;
        repeat
          ch := S[I];

          if not (ch in ['0'..'1']) then
           raise TPaxScriptFailure.Create(errSyntaxError);

          if ch = '1' then
            Inc(J, K);
          K := K * 2;
          Dec(I);
        until I = 0;
        result := J;
      end
      else
        result := SysUtils.StrToFloat(StrVal);
    end;
  end;
end;

procedure TPAXScanner.ScanDigits;
var
  S: String;
  I64: Int64;
{$IFNDEF VARIANTS}
  D: Double;
{$ENDIF}
begin
  S := c;

  if c = '0' then
  begin
    case LA(1) of
      'x','X':
      begin
        GetNextChar;
        c := '$';
        ScanHexDigits;
        Exit;
      end;
      'b','B':
      begin
        GetNextChar;
        S := '';
        while LA(1) in ['0'..'1'] do
          S := S + GetNextChar;
        Token.TokenClass := tcIntegerConst;
        Token.Text := '0b' + S;
        Token.Value := StringToBinary(S);
        Exit;
      end;
      else
      begin
        while LA(1) in ['0'..'9', 'A'..'F'] do
          S := S + GetNextChar;
        Token.TokenClass := tcIntegerConst;
        if LA(1) in ['b','B','d','D','h','H'] then
        begin
          S := S + GetNextChar;
          Token.Value := GetVal(S);
          Exit;
        end;
      end;
    end;
  end;

  while LA(1) in ['0'..'9'] do
    S := S + GetNextChar;
  Token.TokenClass := tcIntegerConst;

  if ((LA(1) = '.') and (LA(2) <> '.')) or (LA(1) in ['e', 'E']) then
  begin
    S := S + GetNextChar;
    if LA(1) = '-' then
      S := S + GetNextChar;
    while LA(1) in ['0'..'9', 'e', 'E'] do
    begin
      S := S + GetNextChar;
      Token.TokenClass := tcFloatConst;
    end;
  end;

  if S[Length(S)] = '.' then
  begin
    Delete(S, Length(S), 1);
    Dec(P);
  end;

  Token.Text := S;

  if Token.TokenClass = tcIntegerConst then
  begin
    I64 := StrToInt64(S);

    if Abs(I64) > MaxInt then
    begin
{$IFDEF VARIANTS}
      Token.Value := i64;  //
{$ELSE}
      D := I64;
      Token.Value := D;
{$ENDIF}
    end
    else
      Token.Value := integer(I64);
  end
  else
  begin
    Token.Value := StrToFloat(StringReplace(S, '.', DecimalSeparator, []));
  end;

  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanHexDigits;
var
  S: String;
  I64: Int64;
  D: Double;
begin
  S := c;
  while LA(1) in ['0'..'9', 'A'..'F', 'a'..'f'] do
    S := S + GetNextChar;

  Token.TokenClass := tcIntegerConst;
  Token.Text := S;

  I64 := StrToInt64(S);
  if I64 > MaxInt then
  begin
    D := I64;
    Token.Value := D;
  end
  else
    Token.Value := StrToInt(S);
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanWhiteSpace;
begin
  if c in [#10,#13] then
  begin
    IncLineNumber;
    PosNumber := -1;

    if c = #13 then
      GetNextChar;
    Token.ID := LineNumber;
    Token.TokenClass := tcSeparator;
  end;
end;

procedure TPAXScanner.ScanEOF;
begin
  if ScannerStack.Count > 0 then
  begin
    ScannerStack.Pop(Self);
    Exit;
  end;

  Token.Text := 'EOF';
  Token.TokenClass := tcSeparator;
  Token.ID := SP_EOF;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanPlus;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := OP_PLUS;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanMinus;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := OP_MINUS;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanMult;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := OP_MULT;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanDiv;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := OP_DIV;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanGT;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := OP_GT;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanLT;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := OP_LT;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanEQ;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := OP_EQ;

  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanMod;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := OP_MOD;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanLeftRoundBracket;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_ROUND_BRACKET_L;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanRightRoundBracket;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_ROUND_BRACKET_R;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanLeftBracket;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_BRACKET_L;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanRightBracket;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_BRACKET_R;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanLeftBrace;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_BRACE_L;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanRightBrace;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_BRACE_R;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanColon;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_COLON;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanSemiColon;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_SEMICOLON;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanComma;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_COMMA;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanBackslash;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_BACKSLASH;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.ScanPoint;
begin
  Token.Text := c;
  Token.TokenClass := tcSpecial;
  Token.ID := SP_POINT;
  SetScannerState(scanProg);
end;

function TPAXScanner.GetRegExpr: String;
begin
  result := '';
  while not ((LA(1) = '/') and (LA(0) <> '\')) do
  begin
    GetNextChar;
    if c = #255 then Exit;
    result := result + c;
  end;
  SetScannerState(scanProg);
end;

procedure TPAXScanner.SetScannerState(Value: TScannerState);
begin
  fScannerState := Value;
end;

procedure TPAXScanner.ScanFormatString;
var
  P1, P2: Integer;
  StrFormat, VarName: String;
begin
//  "%" [index ":"] ["-"] [width] ["." prec] type
  GetNextChar;
  P1 := P;
  if LA(1) in ['0'..'9'] then // Index
  begin
    while (LA(1) in ['0'..'9']) do
      GetNextChar;
    if LA(1) <> ':' then
      raise TPAXScriptFailure.Create(':' + errExpected);
    GetNextChar;
  end;
  if LA(1) = '-' then
    GetNextChar;
  if LA(1) in ['0'..'9'] then // width
    while (LA(1) in ['0'..'9']) do
      GetNextChar;
  if LA(1) = '.' then
    GetNextChar;
  if LA(1) in ['0'..'9'] then // prec
    while (LA(1) in ['0'..'9']) do
      GetNextChar;
  GetNextChar; // type

  P2 := P;

  StrFormat := Copy(Buff, P1, P2 - P1 + 1);
  Token.Text := Token.Text + StrFormat;

  if LA(1) <> '=' then
    raise TPAXScriptFailure.Create('=' + errExpected);
  GetNextChar;

  if not (LA(1) in ['a'..'z','A'..'Z','_']) then
    raise TPAXScriptFailure.Create(errIdentifierExpected);
  VarName := GetNextChar;
  while (LA(1) in ['a'..'z','A'..'Z','_','0'..'9']) do
    VarName := VarName + GetNextChar;

  VarNameList.Add(VarName);
end;

procedure TPAXScanner.ScanHtmlString(const Ch: String);
var
  K1, K2: Integer;
  Backslash: Boolean;
begin
  Backslash := TPAXParser(Parser).Backslash;
  K1 := 0;
  K2 := 0;
  with Token do
  begin
    TokenClass := tcHtmlStringConst;
    Text := Ch;
    repeat
      c := GetNextChar;

      case c of
        #0,#13,#10:
        begin
          Text := Text + c;
          if c = #13 then
          begin
            c := GetNextChar;
            Text := Text + c;
          end;

          IncLineNumber;
          PosNumber := -1;

          with TPAXBaseScripter(Scripter).Code do
            Add(OP_SEPARATOR, ModuleID, LineNumber, 0);
        end;
        '\':
        if (K1 mod 2 = 0) and (K2 mod 2 = 0) then
        begin

          if not Backslash then
          Text := Text + c
          else

          case LA(1) of
          '%': ScanFormatString;
          'b':
          begin
            GetNextChar;
            Text := Text + #$08;