Atomize

 (Available in 00 TS Tools(Base) - TS_Tools_Atomizer)

Source

METHOD Atomize( cSourceText AS STRING ) AS ARRAY PASCAL CLASS TS_Atomizer
LOCAL pItemCacheInfoItemIndex AS DWORD PTR
LOCAL pItemCacheInfoFirstChar AS BYTE PTR
LOCAL oAtomizerItemInComment AS TS_AtomizerItem
LOCAL oAtomizerItemInString AS TS_AtomizerItem
LOCAL lSpecialVOStringTst AS LOGIC
LOCAL dwMatchingSourceLen AS DWORD
LOCAL oAtomizerItemFound AS TS_AtomizerItem
LOCAL oAtomizerItemTest AS TS_AtomizerItem
LOCAL oAtomizerItemText AS TS_AtomizerItem
LOCAL oAtomizerItemPrev AS TS_AtomizerItem
LOCAL cAtomizerItemText AS STRING
LOCAL dwMatchingLongest AS DWORD
LOCAL oAtomizerLongest AS TS_AtomizerItem
LOCAL dwMatchingLength AS DWORD
LOCAL pTestSource AS BYTE PTR
LOCAL iCopySource AS DWORD
LOCAL pToAtomize AS BYTE PTR
LOCAL cToAtomize AS STRING
LOCAL iToAtomize AS DWORD
LOCAL zToAtomize AS DWORD
LOCAL bToAtomize AS BYTE
LOCAL aAtomized AS ARRAY
LOCAL lExact AS LOGIC
LOCAL iItem AS DWORD
   #IFDEF _TS_ATOMIZER_DETECT_NUMBERS
   LOCAL dwNumAddTypeInfo AS DWORD
   LOCAL lNumHasDigit AS LOGIC
   LOCAL lNumPositive AS LOGIC
   LOCAL lNumInteger AS LOGIC
   LOCAL lNumNumeric AS LOGIC
   LOCAL cNumNumber AS STRING
   LOCAL dwNumLen AS DWORD
   #ENDIF
   TSTrace Enter
   SELF:_ItemCreationBlocked+=1U
   lSpecialVOStringTst:=SELF:_SpecialVOStringBeg<>NULL_OBJECT
   oAtomizerItemInComment:=NULL_OBJECT
   oAtomizerItemInString:=NULL_OBJECT
   oAtomizerItemFound:=NULL_OBJECT
   oAtomizerItemPrev:=SELF:_GetWhite
   aAtomized:=ArrayCreate( 0U )
   IF SELF:IgnoreWhite
      IF SELF:_Mode==TS_ATOMIZER_INIT_MODE_PROG_VO1 .OR. SELF:_Mode ; ...
     ... ==TS_ATOMIZER_INIT_MODE_PROG_VO2 .OR. SELF:_Mode==TS_ATOMIZER_INIT_MODE_PROG_VO3
         cToAtomize:=AllTrim( StrTran( cSourceText, TS_C_TAB, TS_C_SPACE ) )
//       There is no way for the parser to have 2 meenings for '*'
         IF Left( cToAtomize, 1U )=="*"
            IF !( Left( cToAtomize, 2U )=="*/" )
               cToAtomize:="// "+SubStr2( cToAtomize, 2U )
            END
         END
      ELSE
         cToAtomize:=AllTrim( cSourceText )
      END
   ELSE
      cToAtomize:=SClone( cSourceText )
   END
   SELF:_SourceText:=cToAtomize
   zToAtomize:=SLen( cToAtomize )
   IF LOGIC( _CAST, zToAtomize )
      IF SELF:_IgnoreCase
         pToAtomize:=TS_StringAlloc( Upper( cToAtomize ) )
         IF pToAtomize==NULL_PTR
            TSTrace Fatal "(pToAtomize:=TS_StringAlloc(Upper(cToAtomize)))==NULL_PTR"  ; ...
           ... cSourceText
         END
      ELSE
         pToAtomize:=TS_StringAlloc( cToAtomize )
         IF pToAtomize==NULL_PTR
            TSTrace Fatal "(pToAtomize:=TS_StringAlloc(cToAtomize))==NULL_PTR" cSourceText
         END
      END
      IF pToAtomize<>NULL_PTR
         IF SELF:_ItemCacheInfoCreate( )
            pItemCacheInfoFirstChar:=SELF:_ItemCacheInfoFirstChar
            pItemCacheInfoItemIndex:=SELF:_ItemCacheInfoItemIndex
            #IFDEF _TS_ATOMIZER_DETECT_NUMBERS
               lNumHasDigit:=FALSE
               lNumPositive:=TRUE
               lNumInteger:=TRUE
               lNumNumeric:=TRUE
               cNumNumber:=TS_S_EMPTY
               dwNumLen:=0U
            #ENDIF
            oAtomizerItemInComment:=SELF:_ItemInComment
            iToAtomize:=1U
            iCopySource:=iToAtomize
            WHILE iToAtomize<=zToAtomize
               bToAtomize:=pToAtomize[ iToAtomize ]
               #IFDEF _TS_ATOMIZER_DETECT_NUMBERS
                  IF lNumNumeric
                     DO CASE
                     CASE bToAtomize>=TS_ASC_0 .OR. bToAtomize<=TS_ASC_9
                        cNumNumber+=CHR( bToAtomize )
                        lNumHasDigit:=TRUE
                        dwNumLen+=1U
                     CASE bToAtomize==TS_ASC_SIGN_PLUS
                        IF dwNumLen==0U
                           lNumPositive:=TRUE
                           dwNumLen+=1U
                        ELSE
                           lNumNumeric:=FALSE
                        END
                     CASE bToAtomize==TS_ASC_SIGN_MIN
                        IF dwNumLen==0U
                           cNumNumber+=CHR( bToAtomize )
                           lNumPositive:=FALSE
                           dwNumLen+=1U
                        ELSE
                           lNumNumeric:=FALSE
                        END
                     CASE bToAtomize==TS_ASC_DOT
                        IF lNumInteger
                           cNumNumber+=CHR( bToAtomize )
                           lNumInteger:=FALSE
                           dwNumLen+=1U
                        ELSE
                           lNumNumeric:=FALSE
                        END
                     OTHERWISE
                        lNumNumeric:=FALSE
                     END
                  END
               #ENDIF
               IF bToAtomize<TS_ASC_SPACE .AND. SELF:LessThenSpaceIsSpace
                  pToAtomize[ iToAtomize ]:=TS_ASC_SPACE
                  bToAtomize:=TS_ASC_SPACE
               END
               DO CASE
               CASE LOGIC( _CAST, oAtomizerItemInComment )
                  DO CASE
                  CASE LOGIC( _CAST, SELF:_EscapeItem ) .AND.  ; ...
                 ... LOGIC( _CAST, SELF:_EscapeItem:_Compare1 ; ...
                 ... ( pToAtomize+( iToAtomize-1U ) ) )
                     cToAtomize:=Left( cToAtomize, iToAtomize-1U )+SubStr2( cToAtomize ; ...
                    ... , iToAtomize+SELF:_EscapeItem:Len  ; ...
                    ... )
                     MemCopy( DWORD( _CAST, pToAtomize+( iToAtomize-1U ) ), DWORD ; ...
                    ... ( _CAST, pToAtomize+( iToAtomize-1U ) )+SELF:_EscapeItem:Len ; ...
                    ... , DWORD( _CAST, _SIZEOF( BYTE ) )*DWORD( zToAtomize-( iToAtomize ; ...
                    ... -1U )-SELF:_EscapeItem:Len  ; ...
                    ... ) )
                     zToAtomize-=SELF:_EscapeItem:Len
                     iToAtomize+=1U
                  CASE LOGIC( _CAST, oAtomizerItemInComment:_Compare1(  ; ...
                 ... pToAtomize+( iToAtomize-1U ) ) )
                     IF !SELF:IgnoreComment
                        IF iToAtomize>iCopySource
                           cAtomizerItemText:=SubStr3( cToAtomize, iCopySource, iToAtomize ; ...
                          ... -iCopySource )
                           IF LOGIC( _CAST, SLen( cAtomizerItemText ) )
                              oAtomizerItemText:=CreateInstance( SELF:_AtomizerItemClass ; ...
                             ... , SELF, NIL, cAtomizerItemText )
                              TSTrace SetCreatedAt oAtomizerItemText
                              oAtomizerItemText:_AddTypeInfo( _OR( TS_ATOMIZER_ITEMTYPE_COMMENT ; ...
                             ... , TS_ATOMIZER_ITEMTYPE_TEXT ) )
                              oAtomizerItemPrev:=oAtomizerItemText
                              AAdd( aAtomized, oAtomizerItemPrev )
                              oAtomizerItemText:=NULL_OBJECT
                           END
                        END
                        oAtomizerItemPrev:=oAtomizerItemInComment
                        AAdd( aAtomized, oAtomizerItemPrev )
                     END
                     iToAtomize+=oAtomizerItemInComment:Len
                     iCopySource:=iToAtomize
                     oAtomizerItemInComment:=NULL_OBJECT
                     #IFDEF _TS_ATOMIZER_DETECT_NUMBERS
                        lNumNumeric:=TRUE
                        IF LOGIC( _CAST, dwNumLen )
                           lNumHasDigit:=FALSE
                           lNumPositive:=TRUE
                           lNumInteger:=TRUE
                           cNumNumber:=TS_S_EMPTY
                           dwNumLen:=0U
                        END
                     #ENDIF
                  OTHERWISE
                     iToAtomize+=1U
                  END
               CASE LOGIC( _CAST, oAtomizerItemInString )
                  DO CASE
                  CASE LOGIC( _CAST, SELF:_EscapeItem ) .AND.  ; ...
                 ... LOGIC( _CAST, SELF:_EscapeItem:_Compare1 ; ...
                 ... ( pToAtomize+( iToAtomize-1U ) ) )
                     cToAtomize:=Left( cToAtomize, iToAtomize-1U )+SubStr2( cToAtomize ; ...
                    ... , iToAtomize+SELF:_EscapeItem:Len  ; ...
                    ... )
                     MemCopy( DWORD( _CAST, pToAtomize+( iToAtomize-1U ) ), DWORD ; ...
                    ... ( _CAST, pToAtomize+( iToAtomize-1U ) )+SELF:_EscapeItem:Len ; ...
                    ... , DWORD( _CAST, _SIZEOF( BYTE ) )*DWORD( zToAtomize-( iToAtomize ; ...
                    ... -1U )-SELF:_EscapeItem:Len  ; ...
                    ... ) )
                     zToAtomize-=SELF:_EscapeItem:Len
                     iToAtomize+=1U
                  CASE LOGIC( _CAST, oAtomizerItemInString:_Compare1( pToAtomize ; ...
                 ... +( iToAtomize-1U ) ) )
                     IF iToAtomize>iCopySource
                        cAtomizerItemText:=SubStr3( cToAtomize, iCopySource, iToAtomize ; ...
                       ... -iCopySource )
                        IF LOGIC( _CAST, SLen( cAtomizerItemText ) )
                           oAtomizerItemText:=CreateInstance( SELF:_AtomizerItemClass ; ...
                          ... , SELF, NIL, cAtomizerItemText )
                           TSTrace SetCreatedAt oAtomizerItemText
                           oAtomizerItemText:_AddTypeInfo( _OR( TS_ATOMIZER_ITEMTYPE_STRING ; ...
                          ... , TS_ATOMIZER_ITEMTYPE_TEXT ) )
                           oAtomizerItemPrev:=oAtomizerItemText
                           AAdd( aAtomized, oAtomizerItemPrev )
                           oAtomizerItemText:=NULL_OBJECT
                        END
                     END
                     oAtomizerItemPrev:=oAtomizerItemInString
                     AAdd( aAtomized, oAtomizerItemPrev )
                     iToAtomize+=oAtomizerItemInString:Len
                     iCopySource:=iToAtomize
                     oAtomizerItemInString:=NULL_OBJECT
                     #IFDEF _TS_ATOMIZER_DETECT_NUMBERS
                        lNumNumeric:=TRUE
                        IF LOGIC( _CAST, dwNumLen )
                           lNumHasDigit:=FALSE
                           lNumPositive:=TRUE
                           lNumInteger:=TRUE
                           cNumNumber:=TS_S_EMPTY
                           dwNumLen:=0U
                        END
                     #ENDIF
                  OTHERWISE
                     iToAtomize+=1U
                  END
               CASE bToAtomize==TS_B_MAX
                  TSTrace Warning "bToAtomize==TS_B_MAX" cSourceText
                  iToAtomize+=1U
                  #IFDEF _TS_ATOMIZER_DETECT_NUMBERS
                     lNumNumeric:=TRUE
                     IF LOGIC( _CAST, dwNumLen )
                        lNumHasDigit:=FALSE
                        lNumPositive:=TRUE
                        lNumInteger:=TRUE
                        cNumNumber:=TS_S_EMPTY
                        dwNumLen:=0U
                     END
                  #ENDIF
               CASE LOGIC( _CAST, DWORD( pItemCacheInfoItemIndex+bToAtomize ) )
                  iItem:=DWORD( pItemCacheInfoItemIndex+bToAtomize )
                  DO CASE
                  CASE pItemCacheInfoFirstChar[ iItem ]==bToAtomize
                     dwMatchingLongest:=0U
                     pTestSource:=pToAtomize+( iToAtomize-1U )
                     WHILE pItemCacheInfoFirstChar[ iItem ]==bToAtomize
                        oAtomizerItemTest:=SELF:_ItemsAtivated ; ...
                       ... [ iItem ]
                        oAtomizerItemTest:_Compare2( pTestSource, @dwMatchingLength ; ...
                       ... , @lExact )
                        IF LOGIC( _CAST, dwMatchingLength )
                           DO CASE
                           CASE lExact
                              IF oAtomizerItemFound==NULL_OBJECT .OR. oAtomizerItemTest:Len ; ...
                             ... >oAtomizerItemFound:Len
                                 oAtomizerItemFound:=oAtomizerItemTest
                              END
                           CASE dwMatchingLength>dwMatchingLongest
                              dwMatchingLongest:=dwMatchingLength
                              oAtomizerLongest:=oAtomizerItemTest
                           END
                        END
                        iItem+=1U
                     END
                     IF oAtomizerItemFound==NULL_OBJECT
                        IF oAtomizerLongest<>NULL_OBJECT
                           IF dwMatchingLongest>=SELF:MinAbbreviationLength
                              oAtomizerItemFound:=oAtomizerLongest
                              dwMatchingSourceLen:=dwMatchingLongest
                           END
                           oAtomizerLongest:=NULL_OBJECT
                        END
                     ELSE
                        dwMatchingSourceLen:=oAtomizerItemFound:Len
                        oAtomizerLongest:=NULL_OBJECT
                     END
                     oAtomizerItemTest:=NULL_OBJECT
                     DO CASE
                     CASE oAtomizerItemFound==NULL_OBJECT
                        IF LOGIC( _TS_AtomizerIsLabelPtr+DWORD( bToAtomize ) )
                           WHILE LOGIC( _TS_AtomizerIsLabelPtr+DWORD( BYTE( pTestSource  ; ...
                          ... ) ) )
                              iToAtomize+=1U
                              pTestSource+=1U
                           END
                        ELSE
                           iToAtomize+=1U
                        END
                     CASE oAtomizerItemFound:IsEscape
                        cToAtomize:=Left( cToAtomize, iToAtomize-1U )+SubStr2( cToAtomize ; ...
                       ... , iToAtomize+SELF:_EscapeItem:Len  ; ...
                       ... )
                        MemCopy( DWORD( _CAST, pToAtomize+( iToAtomize-1U ) ), DWORD ; ...
                       ... ( _CAST, pToAtomize+( iToAtomize-1U ) )+dwMatchingSourceLen ; ...
                       ... , DWORD( _CAST, _SIZEOF( BYTE ) )*DWORD( zToAtomize-(  ; ...
                       ... iToAtomize-1U )-dwMatchingSourceLen ) )
                        zToAtomize-=dwMatchingSourceLen
                        iToAtomize+=1U
                        oAtomizerItemFound:=NULL_OBJECT
                     OTHERWISE
                        IF iToAtomize>iCopySource
                           cAtomizerItemText:=SubStr3( cToAtomize, iCopySource, iToAtomize ; ...
                          ... -iCopySource )
                           IF LOGIC( _CAST, SLen( cAtomizerItemText ) )
                              oAtomizerItemText:=CreateInstance( SELF:_AtomizerItemClass ; ...
                             ... , SELF, NIL, cAtomizerItemText )
                              TSTrace SetCreatedAt oAtomizerItemText
                              #IFDEF _TS_ATOMIZER_DETECT_NUMBERS
                                 IF lNumNumeric .AND. lNumHasDigit
                                    oAtomizerItemText:_Number:=cNumNumber
                                    IF lNumPositive
                                       oAtomizerItemText:_Positive:=TRUE
                                    ELSE
                                       oAtomizerItemText:_Negative:=TRUE
                                    END
                                    IF lNumInteger
                                       oAtomizerItemText:_Integer:=TRUE
                                    ELSE
                                       oAtomizerItemText:_Float:=TRUE
                                    END
                                    oAtomizerItemText:_AddTypeInfo( dwNumAddTypeInfo  ; ...
                                   ... )
                                 END
                              #ENDIF
                              oAtomizerItemText:_AddTypeInfo( _OR( TS_ATOMIZER_ITEMTYPE_MAIN ; ...
                             ... , TS_ATOMIZER_ITEMTYPE_LABEL
//                            TSTrace ToDo "Needs more work!"
                              , TS_ATOMIZER_ITEMTYPE_FORBID_STRING
//                            TSTrace ToDo "Needs more work!"
                              , TS_ATOMIZER_ITEMTYPE_TEXT ) )
                              oAtomizerItemPrev:=oAtomizerItemText
                              AAdd( aAtomized, oAtomizerItemPrev )
                              oAtomizerItemText:=NULL_OBJECT
                           END
                        END
//                      .AND. oAtomizerItemFound==NULL_OBJECT
                        IF lSpecialVOStringTst .AND. bToAtomize==TS_ASC_SQUAREOPEN 
//                         TSTrace ToDo "This flag is not 'Exact', may need work! ; ...
//                        ... "
                           IF !oAtomizerItemPrev:IsForbidStringAsNext 
                              oAtomizerItemFound:=SELF:_SpecialVOStringBeg
                              dwMatchingSourceLen:=oAtomizerItemFound:Len
                              oAtomizerLongest:=NULL_OBJECT
                           END
                        END
                        DO CASE
                        CASE oAtomizerItemFound:IsComment .AND. SELF:IgnoreComment
//                         Do nothing
                        CASE oAtomizerItemFound:IsWhite .AND. SELF:IgnoreWhite
//                         Do nothing
                        OTHERWISE
                           oAtomizerItemPrev:=oAtomizerItemFound
                           AAdd( aAtomized, oAtomizerItemPrev )
                        END
                        iToAtomize+=dwMatchingSourceLen
                        iCopySource:=iToAtomize
                        DO CASE
                        CASE oAtomizerItemFound:IsDelimiterAndIsStringAndIsLeft
                           IF oAtomizerItemFound:_Match==NULL_OBJECT
                              oAtomizerItemInString:=oAtomizerItemFound
                           ELSE
                              oAtomizerItemInString:=oAtomizerItemFound:_Match
                           END
                        CASE oAtomizerItemFound:IsDelimiterAndIsCommentAndIsLeft
                           IF oAtomizerItemFound:_Match==NULL_OBJECT
                              cAtomizerItemText:=SubStr2( cToAtomize, iCopySource  ; ...
                             ... )
                              IF LOGIC( _CAST, SLen( cAtomizerItemText ) )
                                 oAtomizerItemText:=CreateInstance( SELF:_AtomizerItemClass ; ...
                                ... , SELF, NIL, cAtomizerItemText )
                                 TSTrace SetCreatedAt oAtomizerItemText
                                 oAtomizerItemText:_AddTypeInfo( _OR( TS_ATOMIZER_ITEMTYPE_COMMENT ; ...
                                ... , TS_ATOMIZER_ITEMTYPE_TEXT ) )
                                 oAtomizerItemPrev:=oAtomizerItemText
                                 AAdd( aAtomized, oAtomizerItemPrev )
                                 oAtomizerItemText:=NULL_OBJECT
                              END
                              iToAtomize+=SLen( cAtomizerItemText )
                              iCopySource:=iToAtomize
                           ELSE
                              oAtomizerItemInComment:=oAtomizerItemFound:_Match
                           END
                        END
                        oAtomizerItemFound:=NULL_OBJECT
                        #IFDEF _TS_ATOMIZER_DETECT_NUMBERS
                           lNumNumeric:=TRUE
                           IF LOGIC( _CAST, dwNumLen )
                              lNumHasDigit:=FALSE
                              lNumPositive:=TRUE
                              lNumInteger:=TRUE
                              cNumNumber:=TS_S_EMPTY
                              dwNumLen:=0U
                           END
                        #ENDIF
                     END
                  CASE LOGIC( _TS_AtomizerIsLabelPtr+DWORD( bToAtomize ) )
                     pTestSource:=pToAtomize+( iToAtomize-1U )
                     WHILE LOGIC( _TS_AtomizerIsLabelPtr+DWORD( BYTE( pTestSource  ; ...
                    ... ) ) )
                        iToAtomize+=1U
                        pTestSource+=1U
                     END
                  OTHERWISE
                     iToAtomize+=1U
                  END
               OTHERWISE
                  iToAtomize+=1U
               END
            END
            SELF:_ItemInComment:=NULL_OBJECT
            DO CASE
            CASE oAtomizerItemInComment<>NULL_OBJECT
               IF SELF:_MultiLine
                  IF !SELF:IgnoreComment
                     IF iToAtomize>iCopySource
                        cAtomizerItemText:=SubStr3( cToAtomize, iCopySource, iToAtomize ; ...
                       ... -iCopySource )
                        IF LOGIC( _CAST, SLen( cAtomizerItemText ) )
                           oAtomizerItemText:=CreateInstance( SELF:_AtomizerItemClass ; ...
                          ... , SELF, NIL, cAtomizerItemText )
                           TSTrace SetCreatedAt oAtomizerItemText
                           oAtomizerItemText:_AddTypeInfo( _OR( TS_ATOMIZER_ITEMTYPE_COMMENT ; ...
                          ... , TS_ATOMIZER_ITEMTYPE_TEXT ) )
                           oAtomizerItemPrev:=oAtomizerItemText
                           AAdd( aAtomized, oAtomizerItemPrev )
                           oAtomizerItemText:=NULL_OBJECT
                        END
                     END
                  END
                  SELF:_ItemInComment:=oAtomizerItemInComment
               ELSE
                  TSTrace Warning "oAtomizerItemInComment<>NULL_OBJECT" cSourceText
                  oAtomizerItemInComment:=NULL_OBJECT
               END
            CASE oAtomizerItemInString<>NULL_OBJECT
               TSTrace Warning "Not closed control structure, Missing '"+oAtomizerItemInString:Item ; ...
              ... +"'" cSourceText
               oAtomizerItemInString:=NULL_OBJECT
            CASE iToAtomize>iCopySource
               cAtomizerItemText:=SubStr3( cToAtomize, iCopySource, iToAtomize-iCopySource  ; ...
              ... )
               IF LOGIC( _CAST, SLen( cAtomizerItemText ) )
                  oAtomizerItemText:=CreateInstance( SELF:_AtomizerItemClass ; ...
                 ... , SELF, NIL, cAtomizerItemText )
                  TSTrace SetCreatedAt oAtomizerItemText
                  oAtomizerItemText:_AddTypeInfo( _OR( TS_ATOMIZER_ITEMTYPE_MAIN ; ...
                 ... , TS_ATOMIZER_ITEMTYPE_TEXT ) )
                  oAtomizerItemPrev:=oAtomizerItemText
                  AAdd( aAtomized, oAtomizerItemPrev )
                  oAtomizerItemText:=NULL_OBJECT
               END
            END
            pItemCacheInfoItemIndex:=NULL_PTR
            pItemCacheInfoFirstChar:=NULL_PTR
         ELSE
            TSTrace Warning "!SELF:_ItemCacheInfoCreate()" cSourceText
         END
         TS_MemFree( pToAtomize, TRUE )
         pToAtomize:=NULL_PTR
      END
   END
   SELF:_ItemCreationBlocked-=1U
   TSTrace Leave
RETURN aAtomized