jvinterpreterparser.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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):

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,v 1.20 2005/02/17 10:20:38 marquardt Exp $

unit JvInterpreterParser;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  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 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';
  kwNIL = 'nil';

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

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvInterpreterParser.pas,v $';
    Revision: '$Revision: 1.20 $';
    Date: '$Date: 2005/02/17 10:20:38 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  JvInterpreter, JvInterpreterConst, 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') }

  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),
    (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): TTokenKind;
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;