base_scanner.pas

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

////////////////////////////////////////////////////////////////////////////
// PAXScript Interpreter
// Author: Alexander Baranovsky ([e-mail])
// ========================================================================
// Copyright (c) Alexander Baranovsky, 2003-2005. All rights reserved.
// Code Version: 3.0
// ========================================================================
// Unit: BASE_SCANNER.pas
// ========================================================================
////////////////////////////////////////////////////////////////////////////

{$I PaxScript.def}
unit BASE_SCANNER;

interface

uses
  Classes,
  SysUtils,
//  QStrings,
  BASE_CONSTS,
  BASE_SYS;
type
  TScannerState = (scanText, scanProg);
  TPAXScanner = class;

  TDefRec = class
  public
    Word: Integer;
    What: String;
    Vis: boolean;
  end;

  TDefStack = class
  private
    fItems: TList;
    function GetItem(I: Integer): TDefRec;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function Count: Integer;
    procedure Push(Word: Integer; What: String; Vis: Boolean);
    procedure Pop;
    property Items[I: Integer]: TDefRec read GetItem; default;
  end;

  TScannerRec = class
  public
    LineNumber, PosNumber: Integer;
    c: Char;
    P: Integer;
    Buff: String;
  end;

  TScannerStack = class
  private
    fItems: TList;
    function GetItem(I: Integer): TScannerRec;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function Count: Integer;
    procedure Push(Scanner: TPaxScanner);
    procedure Pop(Scanner: TPaxScanner);
    property Items[I: Integer]: TScannerRec read GetItem; default;
  end;

  TPAXScanner = class
  private
    Scripter: Pointer;
    fScannerState: TScannerState;
    Parser: Pointer;
    procedure SetSourceCode(const Value: String);
    function GetSourceCode: String;
    procedure SetScannerState(Value: TScannerState);
  public
    LineNumber, PosNumber: Integer;
    Token, BuffToken: TPAXToken;
    c: Char;
    P: Integer;
    Buff: String;
    VarNameList: TStringList;
    DefStack: TDefStack;
    ScannerStack: TScannerStack;
    LookForward: Boolean;

    constructor Create(Parser: Pointer);
    destructor Destroy; override;

    procedure SetScripter(AScripter: Pointer);
    procedure Reset;
    function EndOfTagExpected: Boolean;
    function GetText(P1, P2: Integer): String;
    function GetNextChar: Char;
    function LA(N: Integer ): Char;
    procedure ReadToken; virtual;
    function NextToken: TPAXToken;
    function Next2Token: TPAXToken;

    procedure ScanIdentifier;
    procedure ScanIdentifierEx(ExtraChars: TCharSet);
    procedure ScanChars(CSet: TCharSet);
    procedure ScanString(ch: Char);
    procedure ScanHtmlString(const Ch: String);
    procedure ScanFormatString;
    procedure ScanDigits;
    procedure ScanHexDigits;
    procedure ScanWhiteSpace;
    procedure ScanEOF;
    procedure ScanPlus;
    procedure ScanMinus;
    procedure ScanMult;
    procedure ScanDiv;
    procedure ScanMod;
    procedure ScanGT;
    procedure ScanLT;
    procedure ScanEQ;
    procedure ScanLeftRoundBracket;
    procedure ScanRightRoundBracket;
    procedure ScanLeftBracket;
    procedure ScanRightBracket;
    procedure ScanLeftBrace;
    procedure ScanRightBrace;
    procedure ScanColon;
    procedure ScanSemiColon;
    procedure ScanComma;
    procedure ScanPoint;
    procedure ScanBackslash;
    function GetRegExpr: String;
    procedure ScanCondDir(Start1: Char;
                          Start2: TCharSet);
    function IsEOF: Boolean;
    procedure IncLineNumber;

    property SourceCode: String read GetSourceCode write SetSourceCode;
    property ScannerState: TScannerState read fScannerState write SetScannerState;
  end;

implementation

uses
  BASE_SCRIPTER, BASE_PARSER;

const
  _IFDEF = 1;
  _IFNDEF = 2;
  _ELSE = 3;
  _ENDIF = 4;

constructor TDefStack.Create;
begin
  fItems := TList.Create;
end;

destructor TDefStack.Destroy;
begin
  Clear;
  fItems.Free;
  inherited;
end;

procedure TDefStack.Clear;
begin
  while Count > 0 do
    Pop;
end;

function TDefStack.Count: Integer;
begin
  result := fItems.Count;
end;

function TDefStack.GetItem(I: Integer): TDefRec;
begin
  result := TDefRec(fItems[I - 1]);
end;

procedure TDefStack.Push(Word: Integer; What: String; Vis: Boolean);
var
  R: TDefRec;
begin
  R := TDefRec.Create;
  R.Word := Word;
  R.What := What;
  R.Vis := Vis;
  fItems.Add(R);
end;

procedure TDefStack.Pop;
var
  R: TDefRec;
begin
  R := fItems[Count - 1];
  fItems.Delete(Count - 1);
  R.Free;
end;

constructor TScannerStack.Create;
begin
  fItems := TList.Create;
end;

destructor TScannerStack.Destroy;
begin
  Clear;
  fItems.Free;
  inherited;
end;

procedure TScannerStack.Clear;
begin
  while Count > 0 do
    Pop(nil);
end;

function TScannerStack.GetItem(I: Integer): TScannerRec;
begin
  result := TScannerRec(fItems[I - 1]);
end;

function TScannerStack.Count: Integer;
begin
  result := fItems.Count;
end;

procedure TScannerStack.Push(Scanner: TPaxScanner);
var
  R: TScannerRec;
begin
  R := TScannerRec.Create;

  R.LineNumber := Scanner.LineNumber;
  R.PosNumber := Scanner.PosNumber;
  R.c := Scanner.c;
  R.P := Scanner.P;
  R.Buff := Scanner.Buff;

  fItems.Add(R);
end;

procedure TScannerStack.Pop(Scanner: TPaxScanner);
var
  R: TScannerRec;
begin
  R := fItems[Count - 1];
  fItems.Delete(Count - 1);

  if Scanner <> nil then
  begin
    Scanner.LineNumber := R.LineNumber;
    Scanner.PosNumber := R.PosNumber;
    Scanner.c := R.c;
    Scanner.P := R.P;
    Scanner.Buff := R.Buff;
  end;

  R.Free;
end;

constructor TPAXScanner.Create(Parser: Pointer);
begin
  VarNameList := TStringList.Create;
  DefStack := TDefStack.Create;
  ScannerStack := TScannerStack.Create;
  Self.Parser := Parser;

  scripter := nil;

  Reset;
end;

destructor TPAXScanner.Destroy;
begin
  VarNameList.Free;
  DefStack.Free;
  ScannerStack.Free;

  inherited;
end;

procedure TPAXScanner.SetScripter(AScripter: Pointer);
begin
  Scripter := AScripter;
end;

function TPAXScanner.GetText(P1, P2: Integer): String;
var
  S: ShortString;
  L: Integer;
begin
  L := P2 - P1 + 1;
  Move(Buff[P1], S[1], L);
  S[0] := Chr(L);
  result := S;
end;

procedure TPAXScanner.ReadToken;
begin
  if scripter <> nil then
  with TPAXBaseScripter(Scripter) do
  begin
    if CancelMessage <> '' then
      raise TPaxScriptFailure.Create(CancelMessage);

    Code.N := Code.Card;
    if Assigned(OnCompilerProgress) then
      OnCompilerProgress(Owner, CurrModule);
    Code.N := 0;
  end;

  Token.Position := P + 1;
end;

procedure TPAXScanner.Reset;
begin
  P := 0;
  LineNumber := 0;
  PosNumber := -1;
  Buff := '';
  BuffToken.Text := '';
  fScannerState := scanText;
  VarNameList.Clear;
  DefStack.Clear;
  ScannerStack.Clear;
  LookForward := false;
end;

procedure TPAXScanner.SetSourceCode(const Value: String);
begin
  Reset;
  Buff := Value + #255#255#255;
end;

function TPAXScanner.GetSourceCode: String;
begin
  result := Buff;
end;

function TPAXScanner.GetNextChar: Char;
begin
  Inc(P);
  result := Buff[P];
  Inc(PosNumber);

  c := result;
end;

function TPAXScanner.LA(N: Integer ): Char;
begin
  if BuffToken.Text <> '' then
  begin
    result := BuffToken.Text[P + N];
    Exit;
  end;

  result := Buff[P + N];
end;

function TPAXScanner.EndOfTagExpected: Boolean;
var
  I: Integer;
  ch: Char;
begin
  result := false;
  I := 1;
  repeat
     Ch := LA(I);
     case Ch of
        '?','%':
        begin
          result := true;
          Exit;
        end;
        #8, #9, #10, #13, #32: begin end;
        else
          Exit;
     end;
     Inc(I);
  until false;
end;

function TPAXScanner.NextToken: TPAXToken;
var
  SaveP, SaveLineNumber, SavePosNumber, SaveTotal: Integer;
  SaveToken: TPAXToken;
  SaveC: Char;
  SaveState: TScannerState;
begin
  LookForward := true;

  if ScannerStack.Count > 0 then
  begin
    Token.Text := '';
    Token.TokenClass := tcSeparator;
    Exit;
  end;

  SaveTotal := TPAXBaseScripter(Scripter).fTotalLineCount;
  SaveP := P;
  SaveLineNumber := LineNumber;
  SavePosNumber := PosNumber;
  SaveToken := Token;
  SaveC := c;
  SaveState := fScannerState;

  ReadToken;
  while Token.TokenClass = tcSeparator do
  begin
    if Token.ID = SP_EOF then
      Break;
    ReadToken;
  end;

  result := Token;

  P := SaveP;
  LineNumber := SaveLineNumber;
  PosNumber := SavePosNumber;
  Token := SaveToken;
  c := SaveC;
  TPAXBaseScripter(Scripter).fTotalLineCount := SaveTotal;
  fScannerState := SaveState;

  VarNameList.Clear;

  LookForward := false;
end;

function TPAXScanner.Next2Token: TPAXToken;
label Fin;
var
  SaveP, SaveLineNumber, SavePosNumber, SaveTotal: Integer;
  SaveToken: TPAXToken;
  SaveC: Char;
  SaveState: TScannerState;
begin
  LookForward := true;

  if ScannerStack.Count > 0 then
  begin
    Token.Text := '';
    Token.TokenClass := tcSeparator;
    Exit;
  end;

  SaveTotal := TPAXBaseScripter(Scripter).fTotalLineCount;
  SaveP := P;
  SaveLineNumber := LineNumber;
  SavePosNumber := PosNumber;
  SaveToken := Token;
  SaveC := c;
  SaveState := fScannerState;

  ReadToken;
  while Token.TokenClass = tcSeparator do
  begin
    if Token.ID = SP_EOF then
      goto Fin;
    ReadToken;
  end;

  ReadToken;
  while Token.TokenClass = tcSeparator do
  begin
    if Token.ID = SP_EOF then
      goto Fin;
    ReadToken;
  end;

Fin:

  result := Token;

  P := SaveP;
  LineNumber := SaveLineNumber;
  PosNumber := SavePosNumber;
  Token := SaveToken;
  c := SaveC;
  TPAXBaseScripter(Scripter).fTotalLineCount := SaveTotal;
  fScannerState := SaveState;

  VarNameList.Clear;

  LookForward := false;
end;

{
procedure TPAXScanner.ScanIdentifier;
var
  S: String;
begin
  Token.Position := P;

  S := c;
  while LA(1) in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do
    S := S + GetNextChar;
  Token.TokenClass := tcId;
  Token.Text := S;

  SetScannerState(scanProg);
end;
}


procedure TPAXScanner.ScanIdentifier;
begin
  Token.Position := P;

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

  Token.TokenClass := tcId;

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