#OTHER by cg
authorClaus Gittinger <cg@exept.de>
Fri, 06 May 2016 12:41:27 +0200
changeset 16462 b6190d4c7f4c
parent 16461 a3f5e981e592
child 16463 06f1e610b85a
#OTHER by cg class: SystemBrowser changed: #searchBlockForAllCallsOn:ignoreCase:match: #searchBlockForStringLiteral:ignoreCase:match: fixed
SystemBrowser.st
--- a/SystemBrowser.st	Fri May 06 12:19:16 2016 +0200
+++ b/SystemBrowser.st	Fri May 06 12:41:27 2016 +0200
@@ -5169,7 +5169,7 @@
      (these operations are executed a zillion times in an inner loop,
       therefore, the speedup is noticable)"
      
-    |doMatch sel lcString quickSearch idx|
+    |doMatch sel quickSearch idx|
 
     doMatch := doMatchArg.
     (doMatch and:[aSelectorString = '*']) ifTrue:[
@@ -5184,12 +5184,6 @@
     (doMatch or:[ignoreCase]) ifTrue:[
         "/ a matchString or ignoreCase - need string matching procedure
 
-        ignoreCase ifTrue:[
-            lcString := aSelectorString asLowercase.
-        ] ifFalse:[
-            lcString := aSelectorString.
-        ].
-
         quickSearch := aSelectorString.
         (quickSearch startsWith:'*') ifTrue:[
             quickSearch := quickSearch copyButFirst
@@ -5207,7 +5201,7 @@
         (ignoreCase and:[quickSearch includesMatchCharacters not]) ifTrue:[
             doMatch ifFalse:[
                 ^ [:class :methodArg :s |
-                    |method src inLiterals lcQuickSearch skip|
+                    |method src inLiterals skip|
 
                     inLiterals := skip := false.
                     method := methodArg originalMethodIfWrapped.
@@ -5220,11 +5214,12 @@
                         ].    
                     ].
                     skip ifFalse:[
-                        inLiterals := (method 
-                                            literalsDetect:[:aLiteral|
-                                                (aLiteral isMemberOf:Symbol) 
-                                                and:[(aLiteral sameAs:aSelectorString)]] 
-                                            ifNone:nil) notNil
+                        inLiterals := 
+                            (method 
+                                literalsDetect:[:aLiteral|
+                                    (aLiteral isMemberOf:Symbol) 
+                                    and:[(aLiteral sameAs:aSelectorString)]] 
+                                ifNone:nil) notNil
                     ].
 
                     inLiterals 
@@ -5235,7 +5230,7 @@
             ].
             
             ^ [:class :methodArg :s |
-                |method src inLiterals lcQuickSearch skip|
+                |method src inLiterals skip|
 
                 inLiterals := skip := false.
                 method := methodArg originalMethodIfWrapped.
@@ -5248,17 +5243,19 @@
                     ].
                 ].    
                 skip ifFalse:[
-                    inLiterals := (method 
-                                        literalsDetect:[:aLiteral|
-                                            (aLiteral isMemberOf:Symbol) 
-                                            and:[(aLiteral includesString:quickSearch caseSensitive:false)
-                                            and:[(lcString match:aLiteral caseSensitive:false)]]] 
-                                        ifNone:nil) notNil
+                    inLiterals := 
+                        (method 
+                            literalsDetect:[:aLiteral|
+                                (aLiteral isMemberOf:Symbol) 
+                                and:[(aLiteral includesString:quickSearch caseSensitive:false)
+                                and:[(aSelectorString match:aLiteral caseSensitive:false)]]] 
+                            ifNone:nil) notNil
                 ].
       
                 inLiterals 
                 and:[
-                    method messagesSent contains:[:sel | aSelectorString match:aSelectorString caseSensitive:false]
+                    method messagesSent 
+                        contains:[:sel | aSelectorString match:aSelectorString caseSensitive:false]
                 ]
            ].
         ].
@@ -5278,12 +5275,13 @@
                     ].    
                 ].    
                 skip ifFalse:[
-                    inLiterals := (method 
-                                        literalsDetect:[:aLiteral|
-                                            (aLiteral isMemberOf:Symbol) 
-                                            and:[(lcString includesString:quickSearch)
-                                            and:[(lcString match:aLiteral)]]] 
-                                        ifNone:nil) notNil
+                    inLiterals := 
+                        (method 
+                            literalsDetect:[:aLiteral|
+                                (aLiteral isMemberOf:Symbol) 
+                                and:[(aLiteral includesString:quickSearch)
+                                and:[(aSelectorString match:aLiteral)]]] 
+                            ifNone:nil) notNil
                 ].
                 inLiterals and:[ method messagesSent includes:aSelectorString]
            ].
@@ -5303,11 +5301,11 @@
                 ].
             ].    
             skip ifFalse:[
-                inLiterals := (method literalsDetect:[:aLiteral|
-                                        (aLiteral isMemberOf:Symbol) 
-                                        and:[(ignoreCase and:[lcString match:aLiteral asLowercase])
-                                            or:[ignoreCase not and:[lcString match:aLiteral]]]] 
-                                    ifNone:nil) notNil
+                inLiterals := 
+                    (method literalsDetect:[:aLiteral|
+                        (aLiteral isMemberOf:Symbol) 
+                        and:[ aSelectorString match:aLiteral asLowercase caseSensitive:ignoreCase not]
+                    ] ifNone:nil) notNil
             ].
             inLiterals 
             and:[ 
@@ -5720,7 +5718,7 @@
 searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg
     "return a block to search for a string-literal."
 
-    |pattern s doMatch checkLiteral|
+    |pattern doMatch checkLiteral checkSource quickCheckString firstMatchIndex lastMatchIndex|
 
     aString isEmpty ifTrue:[^ [:cls :mthd :sel | true ]].
     
@@ -5737,32 +5735,70 @@
         aString last == $* ifFalse:[
             pattern := pattern,'*'
         ].
-        checkLiteral := 
-            [:lit |
-                lit isString
-                and:[lit isSymbol not
-                and:[s match:lit caseSensitive:ignoreCase not]]
-            ]
+        checkLiteral := [:lit | pattern match:lit caseSensitive:ignoreCase not].
+        firstMatchIndex := aString indexOfAny:'*#['.
+        lastMatchIndex := aString lastIndexOfAny:'*#['.
+        "/ which is longer - left or right part
+        firstMatchIndex-1 "nleft" > (aString size-lastMatchIndex) "nright" ifTrue:[
+            "/ use left part as quickSearch
+            quickCheckString := aString copyTo:firstMatchIndex-1
+        ] ifFalse:[
+            "/ use right part as quickSearch
+            quickCheckString := aString copyFrom:lastMatchIndex+1            
+        ].    
+        quickCheckString size > 1 ifTrue:[
+            checkSource := [:src | src includesString:quickCheckString caseSensitive:ignoreCase not]
+        ] ifFalse:[
+            checkSource := [:src | true]. "/ not worth the effort
+        ].    
     ] ifFalse:[
         ignoreCase ifTrue:[
-            checkLiteral :=
-                [:lit |
-                    lit isString
-                    and:[lit isSymbol not
-                    and:[lit includesString:aString caseSensitive:true]]
-                ]
+            checkLiteral := [:lit | lit includesString:aString caseSensitive:true].
+            checkSource := [:src | src includesString:aString caseSensitive:true].
         ] ifFalse:[
-            checkLiteral :=
-                [:lit |
-                    lit isString
-                    and:[lit isSymbol not
-                    and:[lit includesString:aString]]
-                ]
+            checkLiteral := [:lit | lit includesString:aString].
+            checkSource := [:src | src includesString:aString].
         ].    
     ].
         
-    ^ [:cls :mthd :sel | 
-        (mthd literalsDetect:checkLiteral ifNone:[nil]) notNil
+    ^ [:cls :methodArg :sel | 
+        "/ sorry: the following does not work, because stc does not place string-constants
+        "/ into the literals.
+        "/        (mthd literalsDetect:[:lit |
+        "/            lit isString
+        "/            and:[ lit isSymbol not
+        "/            and:[ checkLiteral value:lit ]]
+        "/        ] ifNone:[nil]) 
+        "/            notNil
+        "/ so we must parse here (sigh)
+        
+        |method src skip tree found|
+
+        skip := found := false.
+        method := methodArg originalMethodIfWrapped.
+        method isLazyMethod ifTrue:[
+            src := method source.
+            (src notNil) ifTrue:[
+                method makeRealMethod.
+            ] ifFalse:[
+                skip := true
+            ].    
+        ].
+        skip ifFalse:[
+            src := method source.
+            (src includes:$') ifTrue:[ "/ eliminates many
+                (checkSource value:src) ifTrue:[
+                    tree := cls parseTreeFor:sel.
+                    "/ walk
+                    found :=
+                        tree usedLiterals contains:[:lit |
+                            lit isString
+                            and:[ lit isSymbol not
+                            and:[ checkLiteral value:lit ]]]
+                ].        
+            ].        
+        ].
+        found
       ]
 
     "