rm_jvinterpreterparser.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 759 行 · 第 1/2 页

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvInterpreterParser.PAS, released on 2002-07-04.
The Initial Developers of the Original Code are: Andrei Prygounkov <[e-mail]>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.
Contributor(s):
Last Modified: 2002-07-04
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
Description : Parser for JVCL Interpreter version 2
Known Issues:
-----------------------------------------------------------------------------}
{$I rm_JVCL.INC}
unit rm_JvInterpreterParser;

interface

uses
  SysUtils;

type
  TTokenTyp = type Integer;
  TJvInterpreterParser = class
  private
    FSource: string;
    FPCPos: PChar; { current parse position }
    procedure SetSource(Value: string);
    function GetPos: Integer;
    procedure SetPos(Value: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    { Token - returns next token }
    function Token: string;
    procedure Init;
    property Source: string read FSource write SetSource;
    property PCPos: PChar read FPCPos write FPCPos;
    property Pos: Integer read GetPos write SetPos;
  end;

  //JvInterpreterError = class(Exception)
  //
  //end;
  TPriorLevel = 0..8;
{ tokenizer }

function TokenTyp(const Token: string): TTokenTyp;
{ return operation priority }
function Prior(const TTyp: TTokenTyp): TPriorLevel;
function TypToken(const TTyp: TTokenTyp): string;
{ Token types }

const
  ttUnknown = -1; { unknown error - internal error in most cases - for debugging }
  ttEmpty = 0; { end of file - eof }
  ttIdentifier = 10; { Identifier }
  ttInteger = 11; { Integer constant }
  ttDouble = 12; { double constant }
  ttString = 13; { string constant }
  ttBoolean = 14; { boolean - variable type }
  ttLB = 40; { ( }
  ttRB = 41; { ) }
  ttCol = 42; { , }
  ttPoint = 43; { . }
  ttColon = 44; { : }
  ttSemicolon = 45; { ; }
  ttLS = 46; { [ }
  ttRS = 47; { ] }
  ttDoublePoint = 48; {..}
  ttDoubleQuote = 49; {"}

  ttFalse = 63; { false }
  ttTrue = 65; { true }
  ttBegin = 66; { begin }
  ttEnd = 67; { end }
  ttIf = 68; { if }
  ttThen = 69; { then }
  ttElse = 70; { else }
  ttWhile = 71; { while }
  ttDo = 72; { do }
  ttRepeat = 73; { repeat }
  ttUntil = 74; { until }
  ttProcedure = 75; { procedure }
  ttFunction = 76; { function }
  ttFor = 77; { for }
  ttTo = 78; { to }
  ttBreak = 79; { break }
  ttContinue = 80; { continue }
  ttVar = 81; { var }
  ttTry = 82; { try }
  ttFinally = 83; { finally }
  ttExcept = 84; { except }
  ttOn = 85; { on }
  ttRaise = 86; { raise }
  ttExternal = 87; { external }
  ttUnit = 88; { unit }
  ttUses = 89; { uses }
  ttConst = 90; { Const }
  ttPublic = 91; { Public }
  ttPrivate = 92; { Private }
  ttProtected = 93; { Protected }
  ttPublished = 94; { Published }
  ttProperty = 95; { Property }
  ttClass = 96; { Class }
  ttType = 97; { Type }
  ttInterface = 98; { Interface }
  ttImplementation = 99; { Implementation }
  ttExit = 100; { Exit }
  ttArray = 101; { Array }
  ttOf = 102; { Of }
  ttCase = 103; { Case }
  ttProgram = 104; { Program }
  ttIn = 105; { In }
  ttRecord = 106; { Record }
  ttDownTo = 107; { DownTo }
  { priority 8 - highest }
  ttNot = 21; { not }
  { priority 6 }
  ttMul = 22; { * }
  ttDiv = 23; { / }
  ttIntDiv = 24; { div }
  ttMod = 25; { mod }
  { priority 5 }
  ttAnd = 26; { and }
  { priority 4 }
  ttPlus = 27; { + }
  ttMinus = 28; { - }
  ttOr = 29; { or }
  { priority 3 }
  ttEqu = 30; { = }
  ttGreater = 31; { > }
  ttLess = 32; { < }
  ttNotEqu = 33; { <> }
  { priority 2 }
  ttEquGreater = 34; { >= }
  ttEquLess = 35; { <= }
  { priority 1 - lowest }
  { nothing }
  priorNot = 8;
  priorMul = 6;
  priorDiv = 6;
  priorIntDiv = 6;
  priorMod = 6;
  priorAnd = 5;
  priorPlus = 4;
  priorMinus = 4;
  priorOr = 4;
  priorEqu = 3;
  priorGreater = 3;
  priorLess = 3;
  priorNotEqu = 3;
  priorEquGreater = 2;
  priorEquLess = 2;
  ttFirstExpression = 10; { tokens for expression }
  ttLastExpression = 59; {                       }
  { keywords }
  kwTRUE = 'true';
  kwFALSE = 'false';
  kwOR = 'or';
  kwAND = 'and';
  kwNOT = 'not';
  kwDIV = 'div';
  kwMOD = 'mod';
  kwBEGIN = 'begin';
  kwEND = 'end';
  kwIF = 'if';
  kwTHEN = 'then';
  kwELSE = 'else';
  kwWHILE = 'while';
  kwDO = 'do';
  kwREPEAT = 'repeat';
  kwUNTIL = 'until';
  kwPROCEDURE = 'procedure';
  kwFUNCTION = 'function';
  kwFOR = 'for';
  kwTO = 'to';
  kwBREAK = 'break';
  kwCONTINUE = 'continue';
  kwVAR = 'var';
  kwTRY = 'try';
  kwFINALLY = 'finally';
  kwEXCEPT = 'except';
  kwON = 'on';
  kwRAISE = 'raise';
  kwEXTERNAL = 'external';
  kwUNIT = 'unit';
  kwUSES = 'uses';
  kwCONST = 'const';
  kwPUBLIC = 'public';
  kwPRIVATE = 'private';
  kwPROTECTED = 'protected';
  kwPUBLISHED = 'published';
  kwPROPERTY = 'property';
  kwCLASS = 'class';
  kwTYPE = 'type';
  kwINTERFACE = 'interface';
  kwIMPLEMENTATION = 'implementation';
  kwEXIT = 'exit';
  kwARRAY = 'array';
  kwOF = 'of';
  kwCASE = 'case';
  kwPROGRAM = 'program';
  kwIN = 'in';
  kwRECORD = 'record';
  kwDOWNTO = 'downto';

implementation

uses
  rm_JvInterpreter, rm_JvInterpreterConst;

const
  K = '''';

{*********************** tokenizer ***********************}
{ modified algorithm from mozilla source }
type
  TTokenTag = record
    // (rom) changed to PChar to get rid of hidden initialization section
    Token: PChar;
    TTyp: TTokenTyp;
  end;

const
  P_UNKNOWN = -1;
  MIN_WORD_LENGTH = 2;
  MAX_WORD_LENGTH = 14; { = length('implementation') }
  AssoIndices: array[0..175] of Integer = (
   {      0   1   2   3   4   5   6   7   8   9 }
   {00}35, 28, 4, 32, 19, 6, 7, 25, 28, 7,
   {10}3, 32, 20, 25, 5, 36, 10, 4, 44, 9,
   {20}39, 37, 37, 40, 2, 34, 19, 19, 40, 0,
   {30}20, 2, 26, 14, 40, 28, 44, 14, 28, 1,
   {40}21, 32, 20, 0, 9, 40, 44, 32, 31, 3,
   {50}27, 20, 21, 39, 41, 13, 11, 36, 26, 31,
   {60}24, 14, 33, 2, 43, 44, 39, 4, 34, 18,
   {70}9, 22, 40, 30, 2, 41, 39, 22, 12, 20,
   {80}26, 18, 4, 15, 9, 19, 3, 12, 10, 28,
   {90}29, 32, 8, 33, 22, 42, 27, 14, 3, 36,
   {100}11, 0, 32, 26, 30, 26, 15, 7, 32, 14,
   {110}16, 24, 12, 16, 29, 16, 28, 28, 31, 4,
   {120}14, 4, 0, 34, 2, 19, 20, 32, 4, 31,
   {130}18, 28, 25, 10, 27, 33, 6, 9, 4, 1,
   {140}13, 10, 35, 38, 4, 43, 15, 11, 43, 3,
   {150}33, 43, 11, 19, 15, 33, 19, 27, 17, 30,
   {160}44, 12, 26, 24, 25, 31, 38, 15, 0, 27,
   {170}19, 22, 14, 10, 4, 30);
  AssoValues: array[0..176] of Integer = (
   {      0   1   2   3   4   5   6   7   8   9 }
   {00}-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
   {10}-1, -1, -1, -1, -1, 2, -1, -1, -1, 43,
   {20}23, 19, 18, -1, -1, -1, -1, -1, -1, -1,
   {30}-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
   {40}-1, -1, 9, -1, 13, -1, -1, -1, 31, -1,
   {50}42, 4, -1, -1, -1, 36, -1, 26, -1, 20,
   {60}-1, 21, -1, -1, -1, 47, -1, -1, 24, -1,
   {70}38, -1, 45, 16, 14, 0, -1, -1, 25, -1,
   {80}46, -1, 10, 22, 7, 48, 34, -1, -1, -1,
   {90}39, 27, 6, -1, 33, -1, -1, 1, -1, -1,
   {100}41, -1, -1, 17, -1, 29, 44, -1, 28, -1,
   {110}15, 8, -1, 32, 12, -1, -1, -1, 11, -1,
   {120}37, -1, -1, 40, -1, -1, -1, 3, -1, -1,
   {130}-1, -1, -1, -1, -1, -1, -1, 5, -1, -1,
   {140}-1, -1, -1, -1, 35, -1, -1, -1, -1, -1,
   {150}30, -1, -1, -1, -1, -1, -1, -1, -1, -1,
   {160}-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
   {170}-1, -1, -1, -1, -1, -1, -1);
  WordList: array[0..48] of TTokenTag = (
    (Token: kwTRUE; TTyp: ttTrue),
    (Token: kwFALSE; TTyp: ttFalse),
    (Token: kwOR; TTyp: ttOr),
    (Token: kwAND; TTyp: ttAnd),
    (Token: kwNOT; TTyp: ttNot),
    (Token: kwDIV; TTyp: ttIntDiv{ttDiv}),   // whf 修改
    (Token: kwMOD; TTyp: ttMod),
    (Token: kwBEGIN; TTyp: ttBegin),
    (Token: kwEND; TTyp: ttEnd),
    (Token: kwIF; TTyp: ttIf),
    (Token: kwTHEN; TTyp: ttThen),
    (Token: kwELSE; TTyp: ttElse),
    (Token: kwWHILE; TTyp: ttWhile),
    (Token: kwDO; TTyp: ttDo),
    (Token: kwREPEAT; TTyp: ttRepeat),
    (Token: kwUNTIL; TTyp: ttUntil),
    (Token: kwPROCEDURE; TTyp: ttProcedure),
    (Token: kwFUNCTION; TTyp: ttFunction),
    (Token: kwFOR; TTyp: ttFor),
    (Token: kwTO; TTyp: ttTo),
    (Token: kwBREAK; TTyp: ttBreak),
    (Token: kwCONTINUE; TTyp: ttContinue),
    (Token: kwVAR; TTyp: ttVar),
    (Token: kwTRY; TTyp: ttTry),
    (Token: kwFINALLY; TTyp: ttFinally),
    (Token: kwEXCEPT; TTyp: ttExcept),
    (Token: kwON; TTyp: ttOn),
    (Token: kwRAISE; TTyp: ttRaise),
    (Token: kwEXTERNAL; TTyp: ttExternal),
    (Token: kwUNIT; TTyp: ttUnit),
    (Token: kwUSES; TTyp: ttUses),
    (Token: kwCONST; TTyp: ttConst),
    (Token: kwPUBLIC; TTyp: ttPublic),
    (Token: kwPRIVATE; TTyp: ttPrivate),
    (Token: kwPROTECTED; TTyp: ttProtected),
    (Token: kwPUBLISHED; TTyp: ttPublished),
    (Token: kwPROPERTY; TTyp: ttProperty),
    (Token: kwCLASS; TTyp: ttClass),
    (Token: kwTYPE; TTyp: ttType),
    (Token: kwINTERFACE; TTyp: ttInterface),
    (Token: kwIMPLEMENTATION; TTyp: ttImplementation),
    (Token: kwEXIT; TTyp: ttExit),
    (Token: kwARRAY; TTyp: ttArray),
    (Token: kwOF; TTyp: ttOf),
    (Token: kwCASE; TTyp: ttCase),
    (Token: kwPROGRAM; TTyp: ttProgram),
    (Token: kwIN; TTyp: ttIn),
    (Token: kwRECORD; TTyp: ttRecord),
    (Token: kwDOWNTO; TTyp: ttDownTo)
    );
{ convert string into token number using hash tables }

function PaTokenizeTag(const TokenStr: string): TTokenTyp;
var
  Len: Integer;
  HVal: Integer;
begin
  Result := P_UNKNOWN;
  HVal := -1;
  Len := Length(TokenStr);
  if (MIN_WORD_LENGTH <= Len) and (Len <= MAX_WORD_LENGTH) then
  begin
    HVal := Len;
    case HVal of
      1:
        HVal := HVal + AssoIndices[(Byte(TokenStr[1]) - Byte('a')) and $1F];
      2:
        begin
          HVal := HVal + AssoIndices[(Byte(TokenStr[1]) - Byte('a')) and $1F];
          HVal := HVal + AssoIndices[(Byte(TokenStr[2]) - Byte('a')) and $1F];
        end;
    else
      begin
        HVal := HVal + AssoIndices[(Byte(TokenStr[1]) - Byte('a')) and $1F];
        HVal := HVal + AssoIndices[(Byte(TokenStr[2]) - Byte('a')) and $1F];
        HVal := HVal + AssoIndices[(Byte(TokenStr[3]) - Byte('a')) and $1F];
      end;
    end;
    HVal := HVal + AssoIndices[(Byte(TokenStr[Len]) - Byte('a')) and $1F];
    HVal := AssoValues[HVal];
  end;
  if HVal <> -1 then
  begin
    if Cmp(WordList[HVal].Token, TokenStr) then
      Result := WordList[HVal].TTyp;
  end;
end;
const
  { !"#$%&'()*+,-./0123456789:;<=>? }
  Asso1Values: array[' '..'?'] of Integer =
  (-1, -1, -1, -1, -1, -1, -1, -1,
    ttLB, ttRB, ttMul, ttPlus, ttCol, ttMinus, ttPoint, ttDiv,
    ttInteger, ttInteger, ttInteger, ttInteger, ttInteger,
    ttInteger, ttInteger, ttInteger, ttInteger, ttInteger,
    ttColon, ttSemicolon, ttLess, ttEqu, ttGreater, -1);
{######################## tokenizer ########################}

{$IFNDEF Delphi}
function HasChar(const Ch: Char; const S: string): Boolean;
begin
  Result := Pos(Ch, S) > 0;
end;
{$ENDIF}

function TokenTyp(const Token: string): TTokenTyp;