dws2tokenizer.pas

script language

            end;

          // converts Floating Point numbers
          caFloat:
            begin
              try
                oldsep := DecimalSeparator;
                DecimalSeparator := '.';
                Result.FFloat := StrToFloat(s);
                Result.FTyp := ttFloatVal;
                DecimalSeparator := oldsep;
              except
                on e: Exception do
                  FMsgs.AddCompilerStop(FPos, Format(TOK_InvalidFloatConstant, [s]));
              end;
            end;

          caSwitch:
            if Assigned(FSwitchHandler) then
            begin
              FHotPos := Result.FPos;

              // Ask parser if we should create a token or not
              if FSwitchHandler(UpperCase(s)) then
              begin
                Result.FTyp := ttSWITCH;
                Result.FString := UpperCase(s);
              end
              else
              begin
                state := sStart;
                s := '';
                Continue;
              end;
            end;

          caDotDot:
            Result.FTyp := ttDOTDOT;
        end;
        s := '';
      end;

      // If the token is complete then exit
      if trns.Final then
      begin
        FStartState := trns.NextState;
        exit;
      end
      else
        state := trns.NextState;
    end;
  except
    Result.Free;
    raise;
  end;

  // Couldn't read a token (end of FText reached)
  Result.Free;
  Result := nil;
end;

function TTokenizer.NameToType(const name: string): TTokenType;
var
  n: string;
begin
  n := UpperCase(name);
  Result := ttNAME;
  case n[1] of
    '/': Result := ttDIVIDE;
    '*': Result := ttTIMES;
    '+': Result := ttPLUS;
    '-': Result := ttMINUS;
    ';': Result := ttSEMI;
    '(': Result := ttBLEFT;
    ')': Result := ttBRIGHT;
    '[': Result := ttALEFT;
    ']': Result := ttARIGHT;
    '=': Result := ttEQ;
    '<':
      if n = '<' then
        Result := ttLESS
      else if n = '<=' then
        Result := ttLESSEQ
      else if n = '<>' then
        Result := ttNOTEQ;
    '>':
      if n = '>' then
        Result := ttGTR
      else if n = '>=' then
        Result := ttGTREQ;
    ':':
      if n = ':' then
        Result := ttCOLON
      else if n = ':=' then
        Result := ttASSIGN;
    ',': Result := ttCOMMA;
    '}': Result := ttCRIGHT;
    '.':
      if n = '.' then
        Result := ttDOT;
    'A':
      if n = 'AND' then
        Result := ttAND
      else if n = 'ARRAY' then
        Result := ttARRAY
      else if n = 'ABSTRACT' then
        Result := ttABSTRACT
      else if n = 'AS' then
        Result := ttAS;
    'B':
      if n = 'BEGIN' then
        Result := ttBEGIN
      else if n = 'BREAK' then
        Result := ttBREAK;
    'C':
      if n = 'CONST' then
        Result := ttCONST
      else if n = 'CLASS' then
        Result := ttCLASS
      else if n = 'CONSTRUCTOR' then
        Result := ttCONSTRUCTOR
      else if n = 'CONTINUE' then
        Result := ttCONTINUE
      else if n = 'CASE' then
        Result := ttCASE
      else if n = 'CDECL' then
        Result := ttCDECL;
    'D':
      if n = 'DO' then
        Result := ttDO
      else if n = 'DOWNTO' then
        Result := ttDOWNTO
      else if n = 'DIV' then
        Result := ttDIV
      else if n = 'DEFAULT' then
        Result := ttDEFAULT
      else if n = 'DESTRUCTOR' then
        Result := ttDESTRUCTOR;
    'E':
      if n = 'END' then
        Result := ttEND
      else if n = 'ELSE' then
        Result := ttELSE
      else if n = 'EXCEPT' then
        Result := ttEXCEPT
      else if n = 'EXIT' then
        Result := ttEXIT
      else if n = 'EXTERNAL' then
        Result := ttEXTERNAL;
    'F':
      if n = 'FOR' then
        Result := ttFOR
      else if n = 'FALSE' then
        Result := ttFALSE
      else if n = 'FUNCTION' then
        Result := ttFUNCTION
      else if n = 'FINALLY' then
        Result := ttFINALLY
      else if n = 'FASTCALL' then
        Result := ttFASTCALL
      else if n = 'FORWARD' then
        Result := ttFORWARD;
    'I':
      if n = 'IF' then
        Result := ttIF
      else if n = 'IN' then
        Result := ttIN
      else if n = 'IS' then
        Result := ttIS
      else if n = 'INHERITED' then
        Result := ttINHERITED
      else if n = 'INDEX' then
        Result := ttINDEX;
    'M':
      if n = 'MOD' then
        Result := ttMOD;
    'N':
      if n = 'NOT' then
        Result := ttNOT
      else if n = 'NIL' then
        Result := ttNIL;
    'O':
      if n = 'OR' then
        Result := ttOR
      else if n = 'OF' then
        Result := ttOF
      else if n = 'ON' then
        Result := ttON
      else if n = 'OVERRIDE' then
        Result := ttOVERRIDE
      else if n = 'OBJECT' then
        Result := ttOBJECT;
    'P':
      if n = 'PROCEDURE' then
        Result := ttPROCEDURE
      else if n = 'PROPERTY' then
        Result := ttPROPERTY
      else if n = 'PASCAL' then
        Result := ttPASCAL
      else if n = 'PRIVATE' then
        Result := ttPRIVATE
      else if n = 'PROTECTED' then
        Result := ttPROTECTED
      else if n = 'PUBLIC' then
        Result := ttPUBLIC
      else if n = 'PUBLISHED' then
        Result := ttPUBLISHED;
    'R':
      if n = 'REPEAT' then
        Result := ttREPEAT
      else if n = 'RECORD' then
        Result := ttRECORD
      else if n = 'READ' then
        Result := ttREAD
      else if n = 'RAISE' then
        Result := ttRAISE
      else if n = 'REINTRODUCE' then
        Result := ttREINTRODUCE
      else if n = 'REGISTER' then
        Result := ttREGISTER;
    'S':
      if n = 'STDCALL' then
        Result := ttSTDCALL;
    'T':
      if n = 'THEN' then
        Result := ttTHEN
      else if n = 'TO' then
        Result := ttTO
      else if n = 'TRUE' then
        Result := ttTRUE
      else if n = 'TYPE' then
        Result := ttTYPE
      else if n = 'TRY' then
        Result := ttTRY;
    'U':
      if n = 'UNTIL' then
        Result := ttUNTIL
      else if n = 'USES' then
        Result := ttUSES;
    'V':
      if n = 'VAR' then
        Result := ttVAR
      else if n = 'VIRTUAL' then
        Result := ttVIRTUAL;
    'W':
      if n = 'WHILE' then
        Result := ttWHILE
      else if n = 'WRITE' then
        Result := ttWRITE;
    'X':
      if n = 'XOR' then
        Result := ttXOR;
  end;
end;

const
  OPS = ['+', '-', '*', '/', '=', '<', '>'];
  SPACE = [' ', #9, #13, #10, #0];
  SPEC = ['(', ')', ',', ';', '[', ']', '}'];
  STOP = SPEC + OPS + SPACE + [':', '%', '.', '{'];
  STR = [#0..#255];
  NAM = ['A'..'Z', 'a'..'z', '_'];
  INT = ['0'..'9'];
  HEX = INT + ['A'..'F', 'a'..'f'];
  Start = ['''', '#', ':', '$', '.'] + NAM + INT + OPS;

procedure TTokenizer.KillToken;
begin
  FToken.Free;
  FToken := nil;
end;

initialization
  sStart := TState.Create;
  sComment := TState.Create;
  sCommentF := TState.Create;
  sSwitch := TState.Create;
  sSwitchNameF := TState.Create;
  sSlashComment0 := TState.Create;
  sSlashComment := TState.Create;
  sChar0 := TState.Create;
  sCharF := TState.Create;
  sCharHex := TState.Create;
  sCharHexF := TState.Create;
  sNameF := TState.Create;
  sIntF := TState.Create;
  sIntPoint := TState.Create;
  sIntPointF := TState.Create;
  sIntExp := TState.Create;
  sIntExp0 := TState.Create;
  sIntExpF := TState.Create;
  sHex := TState.Create;
  sHexF := TState.Create;
  sString0 := TState.Create;
  sStringF := TState.Create;
  sAssign0 := TState.Create;
  sGreaterF := TState.Create;
  sSmallerF := TState.Create;
  sDotDot := TState.Create;

  sStart.AddTransition(TSeekTransition.Create(SPACE, sStart, [], caNone));
  sStart.AddTransition(TConsumeTransition.Create(NAM, sNameF, [toStart], caNone));
  sStart.AddTransition(TConsumeTransition.Create(INT, sIntF, [toStart], caNone));
  sStart.AddTransition(TSeekTransition.Create([''''], sString0, [toStart],
    caNone));
  sStart.AddTransition(TSeekTransition.Create(['#'], sChar0, [toStart], caNone));
  sStart.AddTransition(TConsumeTransition.Create([':'], sAssign0, [toStart],
    caNone));
  sStart.AddTransition(TConsumeTransition.Create(['+', '-', '*', '='], sStart,
    [toStart, toFinal], caName));
  sStart.AddTransition(TConsumeTransition.Create([']'], sStart, [toStart, toFinal],
    caName));
  sStart.AddTransition(TConsumeTransition.Create(SPEC, sStart, [toStart, toFinal],
    caName));
  sStart.AddTransition(TConsumeTransition.Create(['/'], sSlashComment0, [toStart],
    caNone));
  sStart.AddTransition(TConsumeTransition.Create(['<'], sSmallerF, [toStart],
    caNone));
  sStart.AddTransition(TConsumeTransition.Create(['>'], sGreaterF, [toStart],
    caNone));
  sStart.AddTransition(TConsumeTransition.Create(['.'], sDotDot, [toStart],
    caNone));
  sStart.AddTransition(TSeekTransition.Create(['{'], sComment, [], caNone));
  sStart.AddTransition(TConsumeTransition.Create(['$'], sHex, [toStart], caNone));
  sStart.SetElse(TErrorTransition.Create(TOK_InvalidChar));

  sComment.AddTransition(TSeekTransition.Create(['}'], sStart, [], caClear));
  sComment.AddTransition(TSeekTransition.Create(['$'], sSwitch, [], caNone));
  sComment.SetElse(TSeekTransition.Create([], sCommentF, [], caNone));

  sCommentF.AddTransition(TSeekTransition.Create(['}'], sStart, [], caClear));
  sCommentF.SetElse(TSeekTransition.Create([], sCommentF, [], caNone));

  sSwitch.AddTransition(TConsumeTransition.Create(NAM, sSwitchNameF, [toStart],
    caNone));
  sSwitch.SetElse(TErrorTransition.Create(TOK_NameOfSwitchExpected));

  sSwitchNameF.AddTransition(TConsumeTransition.Create(NAM + INT, sSwitchNameF, [],
    caNone));
  sSwitchNameF.AddTransition(TCheckTransition.Create(STOP, sStart, [toFinal],
    caSwitch));
  sSwitchNameF.SetElse(TErrorTransition.Create(TOK_InvalidChar));

  sSlashComment0.AddTransition(TSeekTransition.Create(['/'], sSlashComment, [],
    caNone));
  sSlashComment0.SetElse(TCheckTransition.Create([], sStart, [toFinal], caName));

  sSlashComment.AddTransition(TSeekTransition.Create([#0, #10], sStart, [],
    caClear));
  sSlashComment.SetElse(TSeekTransition.Create([], sSlashComment, [], caNone));

  sChar0.AddTransition(TConsumeTransition.Create(INT, sCharF, [], caNone));
  sChar0.AddTransition(TConsumeTransition.Create(['$'], sCharHex, [], caNone));
  sChar0.SetElse(TErrorTransition.Create(TOK_NumberExpected));

  sCharF.AddTransition(TConsumeTransition.Create(INT, sCharF, [], caNone));
  sCharF.AddTransition(TCheckTransition.Create([''''], sStart, [], caChar));
  sCharF.AddTransition(TCheckTransition.Create(['#'], sStart, [], caChar));
  sCharF.AddTransition(TCheckTransition.Create(STOP, sStart, [toFinal], caChar));
  sCharF.SetElse(TErrorTransition.Create(TOK_InvalidChar));

  sCharHex.AddTransition(TConsumeTransition.Create(HEX, sCharHexF, [], caNone));
  sCharHex.SetElse(TErrorTransition.Create(TOK_HexDigitExpected));

  sCharHexF.AddTransition(TConsumeTransition.Create(HEX, sCharHexF, [], caNone));
  sCharHexF.AddTransition(TCheckTransition.Create([''''], sStart, [], caCharHex));
  sCharHexF.AddTransition(TCheckTransition.Create(['#'], sStart, [], caCharHex));
  sCharHexF.AddTransition(TCheckTransition.Create(STOP, sStart, [toFinal],
    caCharHex));
  sCharHexF.SetElse(TErrorTransition.Create(TOK_HexDigitExpected));

  sNameF.AddTransition(TConsumeTransition.Create(NAM + INT, sNameF, [], caNone));
  sNameF.AddTransition(TCheckTransition.Create(STOP, sStart, [toFinal], caName));
  sNameF.SetElse(TErrorTransition.Create(TOK_InvalidChar));

  sIntF.AddTransition(TConsumeTransition.Create(INT, sIntF, [], caNone));
  sIntF.AddTransition(TConsumeTransition.Create(['.'], sIntPoint, [], caNone));
  sIntF.AddTransition(TConsumeTransition.Create(['E', 'e'], sIntExp, [], caNone));
  sIntF.AddTransition(TCheckTransition.Create(STOP, sStart, [toFinal], caInteger));
  sIntF.SetElse(TErrorTransition.Create(TOK_NumberPointExponentExpected));

  sIntPoint.AddTransition(TCheckTransition.Create(['.'], sDotDot, [toFinal],
    caInteger));
  sIntPoint.AddTransition(TConsumeTransition.Create(INT, sIntPointF, [], caNone));
  sIntPoint.SetElse(TErrorTransition.Create(TOK_NumberExpected));

  sIntPointF.AddTransition(TConsumeTransition.Create(INT, sIntPointF, [], caNone));
  sIntPointF.AddTransition(TConsumeTransition.Create(['E', 'e'], sIntExp, [],
    caNone));
  sIntPointF.AddTransition(TCheckTransition.Create(STOP, sStart, [toFinal],
    caFloat));
  sIntPointF.SetElse(TErrorTransition.Create(TOK_NumberExponentExpected));

  sIntExp.AddTransition(TConsumeTransition.Create(['+', '-'], sIntExp0, [],
    caNone));
  sIntExp.AddTransition(TConsumeTransition.Create(INT, sIntExpF, [], caNone));
  sIntExp.SetElse(TErrorTransition.Create(TOK_NumberSignExpected));

  sIntExp0.AddTransition(TConsumeTransition.Create(INT, sIntExpF, [], caNone));
  sIntExp0.SetElse(TErrorTransition.Create(TOK_NumberExpected));

  sIntExpF.AddTransition(TConsumeTransition.Create(INT, sIntExpF, [], caNone));
  sIntExpF.AddTransition(TCheckTransition.Create(STOP, sStart, [toFinal],
    caFloat));
  sIntExpF.SetElse(TErrorTransition.Create(TOK_NumberExpected));

  sHex.AddTransition(TConsumeTransition.Create(HEX, sHexF, [], caNone));
  sHex.SetElse(TErrorTransition.Create(TOK_HexDigitExpected));

  sHexF.AddTransition(TConsumeTransition.Create(HEX, sHexF, [], caNone));
  sHexF.AddTransition(TCheckTransition.Create(STOP, sStart, [toFinal], caHex));
  sHexF.SetElse(TErrorTransition.Create(TOK_HexDigitExpected));

  sString0.AddTransition(TConsumeTransition.Create(STR - ['''', #13, #10],
    sString0,
    [], caNone));
  sString0.AddTransition(TSeekTransition.Create([''''], sStringF, [], caNone));
  sString0.SetElse(TErrorTransition.Create(TOK_StringTerminationError));

  sStringF.AddTransition(TConsumeTransition.Create([''''], sString0, [], caNone));
  sStringF.AddTransition(TCheckTransition.Create(['#'], sStart, [], caString));
  sStringF.AddTransition(TCheckTransition.Create(STOP, sStart, [toFinal],
    caString));
  sStringF.SetElse(TErrorTransition.Create(TOK_InvalidChar));

  sAssign0.AddTransition(TConsumeTransition.Create(['='], sStart, [toFinal],
    caName));
  sAssign0.AddTransition(TCheckTransition.Create(Start + STOP, sStart, [toFinal],
    caName));
  sAssign0.SetElse(TErrorTransition.Create(TOK_EqualityExpected));

  sGreaterF.AddTransition(TConsumeTransition.Create(['='], sStart, [toFinal],
    caName));
  sGreaterF.AddTransition(TCheckTransition.Create(Start + STOP, sStart, [toFinal],
    caName));
  sGreaterF.SetElse(TErrorTransition.Create(TOK_EqualityExpected));

  sSmallerF.AddTransition(TConsumeTransition.Create(['='], sStart, [toFinal],
    caName));
  sSmallerF.AddTransition(TConsumeTransition.Create(['>'], sStart, [toFinal],
    caName));
  sSmallerF.AddTransition(TCheckTransition.Create(Start + STOP, sStart, [toFinal],
    caName));
  sSmallerF.SetElse(TErrorTransition.Create(TOK_GreaterEqualityExpected));

  sDotDot.AddTransition(TConsumeTransition.Create(['.'], sStart, [toFinal],
    caDotDot));
  sDotDot.AddTransition(TCheckTransition.Create(NAM, sStart, [toFinal], caName));
  sDotDot.SetElse(TErrorTransition.Create(TOK_DotExpected));

finalization
  sStart.Free;
  sSpace.Free;
  sComment.Free;
  sCommentF.Free;
  sSwitch.Free;
  sSwitchNameF.Free;
  sSlashComment0.Free;
  sSlashComment.Free;
  sChar0.Free;
  sCharF.Free;
  sCharHex.Free;
  sCharHexF.Free;
  sNameF.Free;
  sIntF.Free;
  sIntPoint.Free;
  sIntPointF.Free;
  sIntExp.Free;
  sIntExp0.Free;
  sIntExpF.Free;
  sHex.Free;
  sHexF.Free;
  sString0.Free;
  sStringF.Free;
  sAssign0.Free;
  sGreaterF.Free;
  sSmallerF.Free;
  sDotDot.Free;
end.