rm_jvinterpreterparser.pas

这是一个功能强大

{-----------------------------------------------------------------------------
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 <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s): Peter Schraut (http://www.console-de.de)

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:
-----------------------------------------------------------------------------}
// $Id: JvInterpreterParser.pas 10206 2006-01-17 20:26:52Z obones $

{ history (JVCL Library versions):

Upcoming JVCL 3.00
    - peter schraut added shl, shr and xor support
}


unit rm_JvInterpreterParser;

{$I rm_jvcl.inc}

interface

uses
  SysUtils;

type
  TTokenKind = type Integer;

  TJvInterpreterParser = class(TObject)
  private
    FSource: string;
    FPCPos: PChar; { current parse position }
    procedure SetSource(const Value: string);
    function GetPos: Integer;
    procedure SetPos(Value: Integer);
  public
    { 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): TTokenKind;
{ return operation priority }
function Prior(const TTyp: TTokenKind): TPriorLevel;
function TypToken(const TTyp: TTokenKind): 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 6 }
  ttShl = 36; { shl } // [peter schraut: added on 2005/08/14]
  ttShr = 37; { shr } // [peter schraut: added on 2005/08/14]

  { priority 3 }
  ttXor = 38; { xor } // [peter schraut: added on 2005/08/14]

  { 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;
  priorShl = 6; // [peter schraut: added on 2005/08/14]
  priorShr = 6; // [peter schraut: added on 2005/08/14]
  priorXor = 3; // [peter schraut: added on 2005/08/14]
  
  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';
  kwNIL = 'nil';
  kwSHL = 'shl'; // [peter schraut: added on 2005/08/14]
  kwSHR = 'shr'; // [peter schraut: added on 2005/08/14]
  kwXOR = 'xor'; // [peter schraut: added on 2005/08/14]

  { directives }
  drNAME = 'name';
  drINDEX = 'index';

implementation

uses
  {$IFDEF UNITVERSIONING}
  rm_JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  rm_JvInterpreter, rm_JvInterpreterConst, rm_JvConsts;

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: TTokenKind;
  end;

const
  P_UNKNOWN = -1;
  MIN_WORD_LENGTH = 2;
  MAX_WORD_LENGTH = 14; { = length('implementation') }


  // [peter schraut: added on 2005/08/14]
  // Created new HashTable to avoid collisions
  // with added keywords such as shl, shr and xor
  // Mantis 3333 (ivan_ra): optimized version
   AssoIndices: array [0..31] of Integer = (
        { 0   1   2   3   4   5   6   7   8   9 }
    {00} 50, 80, 25, 13, 92, 71, 87, 61, 91, 99,
    {10} 73, 95, 27, 7, 16, 1, 96, 41, 91, 99,
    {20} 19, 15, 72, 71, 50, 30, 9, 6, 45, 27,
    {30} 79, 61);

   AssoValues: array [0..255] of Integer = (
        { 0   1   2   3   4   5   6   7   8   9 }
    {00} -1, -1, -1, -1, -1, -1, 44, 10, -1, -1,
    {10} 37, -1, -1, -1, -1, 7, -1, -1, -1, -1,
    {20} -1, -1, -1, 27, -1, -1, -1, -1, -1, -1,
    {30} -1, -1, 26, -1, -1, 20, -1, 25, -1, -1,
    {40} -1, 30, 39, -1, -1, -1, -1, 13, -1, -1,
    {50} -1, -1, -1, -1, -1, -1, -1, 1, -1, -1,
    {60} -1, -1, -1, -1, -1, 12, -1, -1, -1, -1,
    {70} -1, -1, 6, -1, -1, -1, -1, -1, -1, -1,
    {80} 34, -1, -1, -1, -1, -1, 3, -1, -1, 49,
    {90} -1, -1, 45, -1, -1, -1, -1, -1, -1, -1,
    {100} 2, 41, -1, -1, -1, -1, -1, 46, -1, 28,
    {110}-1, -1, 17, -1, -1, -1, 36, -1, 11, -1,
    {120}-1, -1, 35, 48, -1, -1, -1, -1, 8, -1,
    {130}-1, 32, -1, 19, -1, -1, -1, 5, -1, -1,
    {140}40, -1, -1, -1, -1, -1, -1, -1, 21, -1,
    {150}22, -1, 31, -1, -1, -1, -1, -1, -1, 16,
    {160}43, -1, -1, -1, -1, -1, -1, -1, -1, -1,
    {170}-1, -1, 18, -1, -1, -1, -1, 47, -1, -1,
    {180}-1, -1, -1, -1, -1, -1, -1, 42, -1, -1,
    {190}-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
    {200}-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
    {210}-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
    {220}29, -1, -1, -1, 4, 15, 24, -1, -1, -1,
    {230}-1, -1, 33, -1, -1, 9, -1, 50, -1, 14,
    {240}-1, -1, -1, 23, -1, -1, 38, -1, -1, -1,
    {250}-1, -1, -1, -1, -1, 0);

  WordList: array [0..51] 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),
    (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),
    (Token: kwSHL; TTyp: ttShl), // [peter schraut: added on 2005/08/14]
    (Token: kwSHR; TTyp: ttShr), // [peter schraut: added on 2005/08/14]
    (Token: kwXOR; TTyp: ttXor)  // [peter schraut: added on 2005/08/14]
    );

{ convert string into token number using hash tables }
// [peter schraut: added on 2005/08/14]