'Demo of FastLexer Function 
'timed against Split & DSplit
' and with Dynamic array resizing and without
'also a wrapper to call like DSplit
'Demo by IDC
'FastLexer by Wayne Halsdorf

'Formatted with BCX_FORMAT Version 2008.11.25 on 11/28/08 02:10:02: PM
'DYNAMIC rStk[0,0] as CHAR
DYNAMIC rStk$[0]
DIM idx AS INT, q
DIM sA$
Dim myTimer as double, i as int
sA$ = "all of following is "
sA$ = sA$ & DQ$ & "inside double quotes, all text between will not be changed"
sA$ = sA$ & DQ$ & ", except this part"
PRINT sA$

'Let FastLexer redim the array
myTimer = timer
For i = 1 to 10000
idx = FastLexer(&rStk,sA$,"","i,",1) 'resize the array in Fastlexer
Next i
myTimer = timer - myTimer
PRINT "Idx: "  & STR$(idx)
FOR q = 1 TO idx
  PRINT STR$(q) & " " & rStk$[q]
NEXT q
Print "Lexar Time: " & str$(myTimer)

'test against Split function
DIM sStk$[20]
myTimer = timer 
For i = 1 to 10000
idx= SPLIT(sStk,sA$,"i,",3)
Next i
myTimer = timer - myTimer
Print "Split Time: " & str$(myTimer)

'test against DSplit function
DIM DYNAMIC tStk$[20]
myTimer = timer 
For i = 1 to 10000
'REDIM tStk$[20]
idx= DSPLIT(tStk,sA$,"i,",3)
Next i
myTimer = timer - myTimer
Print "DSplit Time: " & str$(myTimer)

'use a wrapper to pass DSplit type to FastLexer
myTimer = timer
For i = 1 to 10000
idx = LSplit(&rStk,sA$,"i,",3)
Next i
myTimer = timer - myTimer
Print "LSplit Time: " & str$(myTimer)

'test FastLexer using pre-dimmed array
DIM DYNAMIC vStk$[20]
myTimer = timer
For i = 1 to 10000
idx = FastLexer(&vStk$,sA$,"","i,") ' use pre-sized array
Next i
myTimer = timer - myTimer
Print "Lexar already dimmed - Time: " & str$(myTimer)

PAUSE

'Wrapper for DSplit function using FastLexer
FUNCTION LSplit(ByRef uStk as STRARRAY,user$, delim3$, excludetype as int) as INT
   SELECT CASE excludetype
   CASE 0
     FUNCTION = FastLexer(&uStk,user$,delim3$,"",1)
   CASE 1
     FUNCTION = FastLexer(&uStk,user$,"",delim3$,2048) 
   CASE 2
     FUNCTION = FastLexer(&uStk,user$,delim3$,"",2048)      
   CASE 3
     FUNCTION = FastLexer(&uStk,user$,"",delim3$,1)
   END SELECT
END FUNCTION

'*************************************************************
'sStkOut$ is a Dynamic string array passed to the function
'this will be redimensioned if iMinLen is not 0.
'sStkOut$ will contain the strings.
'sArg$ is string to parse
'sDelim1$ = delimiters to be removed
'sDelim2$ = delimiters to keep
'iMinLen Values:
' 0 - Do not resize the sStkOut$ array, default
' 1 - redimension the sStkOut$ array to minimum needed
' other - redimension the sStkOut$ array to minimum needed , minimum string
' length not to be shorter than this value
'Returns the number of cells in the redimmed array
'
'by Wayne Halsdorf 2008
'*************************************************************
FUNCTION FastLexer OPTIONAL (sStkOut AS CHAR PTR PTR PTR,sArg$, sDelim1$ ="", sDelim2$ = "", iMinLen = 0) AS integer

  RAW iCNT1=0
  RAW iCNT2=0
  RAW psD1 AS PCHAR
  RAW psD2 AS PCHAR
  RAW iNdx=1
  DYNAMIC szW[1][1] AS CHAR
  RAW sStk AS PCHAR PTR
  RAW fl_Fields = 1
  RAW  fl_MaxFieldLen = 0
  ' do pseudo lex to get field count and resize the array
  IF iMinLen then

    WHILE sArg[iCNT1]
      IF sArg[iCNT1] = 34 THEN ' quotes - string literals
        IF iCNT2 THEN
          fl_Fields++
          IF fl_MaxFieldLen < iCNT2 THEN fl_MaxFieldLen = iCNT2
          iCNT2 = 0
        END IF

        WHILE sArg[++iCNT1] <> 34
          iCNT2++
          IF sArg[iCNT1] = 0 THEN GOTO exfieldcnt
          IF sArg[iCNT1] = 10 OR sArg[iCNT1] = 13 THEN
             sArg[iCNT1] = 34 : EXIT WHILE
          END IF 
        WEND

        fl_Fields++
        IF fl_MaxFieldLen < iCNT2 THEN fl_MaxFieldLen = iCNT2
        iCNT2 = 0
        GOTO fieldcnt
      END IF
      psD1 = sDelim1

      WHILE *psD1           'check for delim1 arguments
        IF *(psD1++) = sArg[iCNT1] THEN
          IF iCNT2 THEN
            fl_Fields++
            IF fl_MaxFieldLen < iCNT2 THEN fl_MaxFieldLen = iCNT2
            iCNT2 = 0
          END IF
          GOTO fieldcnt
        END IF
      WEND

      psD2 = sDelim2

      WHILE *psD2           'check for delim2 arguments
        IF *(psD2++) = sArg[iCNT1] THEN
          IF iCNT2 THEN fl_Fields++
          fl_Fields++
          IF fl_MaxFieldLen < iCNT2 THEN fl_MaxFieldLen = iCNT2
          iCNT2 = 0
          GOTO fieldcnt
        END IF
      WEND

      iCNT2++


fieldcnt:
      INCR iCNT1
    WEND

    'IF iCNT2 = 0 THEN DECR fl_Fields
    IF fl_MaxFieldLen < iCNT2 THEN fl_MaxFieldLen = iCNT2


exfieldcnt:
    fl_MaxFieldLen += 2
    iCNT1 = 0   ' Reset counters
    iCNT2 = 0

    'resize the array
    szW = *sStkOut
    FREE(szW)
    szW = NULL
    ' String length will be minimum unless iMinLen is greater than fl_MaxFieldLen
    IF iMinLen THEN
      ' No smaller than iMinLen
      IF iMinLen > fl_MaxFieldLen THEN
        fl_MaxFieldLen = iMinLen '+256
      END IF
    END IF
    REDIM szW[fl_Fields+2][fl_MaxFieldLen] ' we need extra 2 fl_Fields
    *sStkOut = szW
    sStk = *sStkOut
    szW = NULL
  ELSE
    sStk = *sStkOut
  END IF 'iMinLen

  'the real fastlexer function
  WHILE sArg[iCNT1]

    IF sArg[iCNT1] = 34 THEN ' quotes - string literals
      IF iCNT2 THEN sStk[iNdx++][iCNT2]=0 : iCNT2=0
      sStk[iNdx][0] = 34

      WHILE sArg[++iCNT1] <> 34
        sStk[iNdx][++iCNT2] = sArg[iCNT1]
        IF sArg[iCNT1] = 0 THEN GOTO ex 'clean-up dynamic array before exit
        IF sArg[iCNT1] = 10 OR sArg[iCNT1] = 13 THEN
          sArg[iCNT1] = 34 : EXIT WHILE
        END IF
      WEND

      sStk[iNdx][++iCNT2] = sArg[iCNT1]
      sStk[iNdx++][++iCNT2]=0
      iCNT2=0
      GOTO again
    END IF
    psD1 = sDelim1

    WHILE *psD1           'check for delim1 arguments
      IF *(psD1++) = sArg[iCNT1] THEN
        IF iCNT2 THEN sStk[iNdx++][iCNT2]=0 : iCNT2=0
        GOTO again
      END IF
    WEND

    psD2 = sDelim2

    WHILE *psD2           'check for delim2 arguments
      IF *(psD2++) = sArg[iCNT1] THEN
        IF iCNT2 THEN sStk[iNdx++][iCNT2]=0
        sStk[iNdx][0] = sArg[iCNT1]
        sStk[iNdx++][1]=0 : iCNT2 = 0
        GOTO again
      END IF
    WEND

    sStk[iNdx][iCNT2++]=sArg[iCNT1]


again:
    INCR iCNT1
  WEND

  sStk[iNdx][iCNT2]=0
  IF iCNT2 = 0 THEN DECR iNdx

ex:

  FUNCTION = iNdx

END FUNCTION