The Trunk: ToolBuilder-Kernel-mt.125.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
12 messages Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: ToolBuilder-Kernel-mt.125.mcz

commits-2
Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.125.mcz

==================== Summary ====================

Name: ToolBuilder-Kernel-mt.125
Author: mt
Time: 11 July 2019, 8:50:30.487838 am
UUID: 3f3a21f8-a141-734f-8aed-f0c21aff22b9
Ancestors: ToolBuilder-Kernel-mt.124

Updates the search for class names using the new find-features feature on strings. Find WeakIdentityKeyDictionary (in a small list of results) with any of the following patterns:

WKD
Weak*Dict*
WeakDict
WeakIdentityKeyDictionary

=============== Diff against ToolBuilder-Kernel-mt.124 ===============

Item was changed:
  ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') -----
  classOrTraitFrom: environment pattern: pattern label: label
+ "Given a pattern and an environment, try to find a class or trait using several strategies:
+ - EXACT: If there is a class or trait whose name exactly given by pattern, return it.
+ - UPPER: If the pattern is upper-case only, find camel-case letters with that sequence.
+ - WILD: Try the pattern as-is for regular wild-card search.
+ - FEATURE: Split patterns at feature boundaries and insert wild cards between.
+ - FUZZY: Split patterns at feature boundaries BUT treat each feature as a full class name.
+ If there is only one class or trait in the given environment whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
- "If there is a class or trait whose name exactly given by pattern, return it.
- If there is only one class or trait in the given environment whose name matches pattern, return it.
- Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
- This method ignores separator characters in the pattern"
 
+ !!!! In any case, separator characters in the pattern are ignored."
+
+ | toMatch potentialNames names selectedIndex |
+
+ "If there's a class or trait named as pattern, then return it."
+ (environment classOrTraitNamed: pattern) ifNotNil: [:classOrTrait | ^ classOrTrait].
+
+ "Validate pattern."
- | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
  toMatch := pattern copyWithoutAll: Character separators.
+ toMatch := toMatch asLowercase copyWithout: $..
  toMatch ifEmpty: [ ^nil ].
+
+ "Fetch search space."
+ names := OrderedCollection new.
+ potentialNames := environment classAndTraitNames asOrderedCollection.
+
+ "Try uppercase-only patterns for patterns such as 'WKD' to find 'WeakIdentityKeyDictionary' etc."
+ names ifEmpty: [
+ (pattern allSatisfy: [:char | char isUppercase]) ifTrue: [
+ potentialNames do: [:each |
+ | patternStream |
+ patternStream := pattern readStream.
+ each detect: [:char |
+ (patternStream atEnd not and: [patternStream peek = char])
+ ifTrue: [
+ patternStream next.
+ patternStream atEnd
+ ifTrue: [names add: each. true "Match!!"]
+ ifFalse: [false "Not yet..."]]
+ ifFalse: [false "No match..."] ] ifNone: [] ] ]].
+
+ "Try wildcard search for patterns such as 'Weak*Dict*' to find 'WeakIdentityKeyDictionary' etc."
+ names ifEmpty: [
+ names := potentialNames select: [ :each | toMatch match: each ]].
- "If there's a class or trait named as pattern, then return it."
- Symbol hasInterned: pattern ifTrue: [ :symbol |
- environment at: symbol ifPresent: [ :maybeClassOrTrait |
- ((maybeClassOrTrait isKindOf: Class) or: [
- maybeClassOrTrait isTrait ])
- ifTrue: [ ^maybeClassOrTrait ] ] ].
- "No exact match, look for potential matches."
- toMatch := pattern asLowercase copyWithout: $..
- potentialNames := (environment classAndTraitNames) asOrderedCollection.
- names := pattern last = $. "This is some old hack, using String>>#match: may be better."
- ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
- ifFalse: [
- potentialNames select: [ :each |
- each includesSubstring: toMatch caseSensitive: false ] ].
- exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
- lines := OrderedCollection new.
- exactMatch ifNotNil: [ lines add: 1 ].
- "Also try some fuzzy matching."
- reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
- potentialNames includes: each ].
- reducedIdentifiers ifNotEmpty: [
- names addAll: reducedIdentifiers.
- lines add: 1 + names size + reducedIdentifiers size ].
- "Let the user select if there's more than one possible match. This may give surprising results."
- names size = 0 ifTrue: [^ nil "nothing matches"].
 
+ "Try feature-based search for patterns such as 'WeakDict' to find 'WeakIdentityKeyDictionary' etc."
+ names ifEmpty: [
+ toMatch := pattern copyWithoutAll: '.*#'.
+ toMatch findFeatures in: [:features |
+ "1) Insert wildcards between features and at the end."
+ toMatch := (features joinSeparatedBy: '*'), '*'.
+ names := potentialNames select: [ :each | toMatch match: each ].
+ names ifEmpty: [
+ "2) Insert wildcards before, between, and after features."
+ toMatch := '*', (features joinSeparatedBy: '*'), '*'.
+ names := potentialNames select: [ :each | toMatch match: each ] ]] ].
+
+ "Try some fuzzy matching."
+ names addAll: (pattern suggestedTypeNames select: [ :each | potentialNames includes: each ]).
+
+ "Still no match?"
+ names ifEmpty: [ ^ nil ].
+
+ "Let the user select if there's more than one possible match. This may give surprising results."
  selectedIndex := names size = 1
  ifTrue: [ 1 ]
+ ifFalse: [ self chooseFrom: names title: label ].
- ifFalse: [
- exactMatch ifNotNil: [ names addFirst: exactMatch ].
- self chooseFrom: names lines: lines title: label ].
  selectedIndex = 0 ifTrue: [ ^nil ].
  ^environment at: (names at: selectedIndex) asSymbol!


Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

Kjell Godo


On Mon, Jul 15, 2019 at 00:18 <[hidden email]> wrote:
Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.125.mcz

==================== Summary ====================

Name: ToolBuilder-Kernel-mt.125
Author: mt
Time: 11 July 2019, 8:50:30.487838 am
UUID: 3f3a21f8-a141-734f-8aed-f0c21aff22b9
Ancestors: ToolBuilder-Kernel-mt.124

Updates the search for class names using the new find-features feature on strings. Find WeakIdentityKeyDictionary (in a small list of results) with any of the following patterns:

WKD
Weak*Dict*
WeakDict
WeakIdentityKeyDictionary

=============== Diff against ToolBuilder-Kernel-mt.124 ===============

Item was changed:
  ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') -----
  classOrTraitFrom: environment pattern: pattern label: label
+       "Given a pattern and an environment, try to find a class or trait using several strategies:
+               - EXACT: If there is a class or trait whose name exactly given by pattern, return it.
+               - UPPER: If the pattern is upper-case only, find camel-case letters with that sequence.
+               - WILD: Try the pattern as-is for regular wild-card search.
+               - FEATURE: Split patterns at feature boundaries and insert wild cards between.
+               - FUZZY: Split patterns at feature boundaries BUT treat each feature as a full class name.
+       If there is only one class or trait in the given environment whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       "If there is a class or trait whose name exactly given by pattern, return it.
-       If there is only one class or trait in the given environment whose name matches pattern, return it.
-       Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       This method ignores separator characters in the pattern"

+       !!!! In any case, separator characters in the pattern are ignored."
+       
+       | toMatch potentialNames names selectedIndex |
+       
+       "If there's a class or trait named as pattern, then return it."
+       (environment classOrTraitNamed: pattern) ifNotNil: [:classOrTrait | ^ classOrTrait].
+
+       "Validate pattern."     
-       | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
        toMatch := pattern copyWithoutAll: Character separators.
+       toMatch := toMatch asLowercase copyWithout: $..
        toMatch ifEmpty: [ ^nil ].
+
+       "Fetch search space."
+       names := OrderedCollection new.
+       potentialNames := environment classAndTraitNames asOrderedCollection.
+
+       "Try uppercase-only patterns for patterns such as 'WKD' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               (pattern allSatisfy: [:char | char isUppercase]) ifTrue: [
+                       potentialNames do: [:each |
+                               | patternStream |
+                               patternStream := pattern readStream.<—-[ [_]— you don’t


really need to recreate this same patternStream for each [ :each ... ] do you ? ]



+                               each detect: [:char |
+                                       (patternStream atEnd not and: [patternStream peek = char])
+                                               ifTrue: [
+                                                       patternStream next.
+                                                       patternStream atEnd
+                                                               ifTrue: [names add: each. true "Match!!"]
+                                                               ifFalse: [false "Not yet..."]]
+                                               ifFalse: [false "No match..."] ] ifNone: [] ] ]].

<——————-—-[ [_]— using KEGGenerators maybe it could be done like
 [ | last eNGen | 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] )ifNotNil:[ :patternGen |
      potentialNames select:[ :eachName | last := false .
            ( patternGen shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ] . last := b&&last ] ]
                                   with:( eNGen := eachName asGenerator )
               ) iterate . last
            ]
      ]”<——-[ [x]— >>lastDo: evaluates its input on last element p of pattern 
                      [x]— >>shuffle:with: does (p=c)<=>( patternGen next ) i think
                      [x]— >>yourselfDo: returns its receiver r after doing( aBlock value:r )
                      [_]— String>>asCharacters = String>>asCharacter<—-[ is part
                               of the singular is plural idea of you don’t have to separate 
                               singular from plural with KEGGenerators just do( obj asGen ) ] ]”
] value .”<—-[ [_]— move local vars last & eNGen up and delete this >>value ]”

or 

 [ | last eNGen | 
 ( 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] 
 ) shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ]. last:=b&&last ] ] ]
    with:( eNGen := KEGGenerator streamGenerator ) 
 )ifNotNil:[ :shuffleGen |
      potentialNames select:[ :eachName | last := false . eNGen genOn:eacName . 
            shuffleGen iterate . last
            ]
      ]”<——-[ [_]— this actually does not reAllocate any ..Generator in the loop ]”
] value .”<—-[ untested . not looked up . unpublished >>genOn: = >>on: i think ]”


+
+       "Try wildcard search for patterns such as 'Weak*Dict*' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               names := potentialNames select: [ :each | toMatch match: each ]].
-       "If there's a class or trait named as pattern, then return it."
-       Symbol hasInterned: pattern ifTrue: [ :symbol |
-               environment at: symbol ifPresent: [ :maybeClassOrTrait |
-                       ((maybeClassOrTrait isKindOf: Class) or: [
-                               maybeClassOrTrait isTrait ])
-                                       ifTrue: [ ^maybeClassOrTrait ] ] ].
-       "No exact match, look for potential matches."
-       toMatch := pattern asLowercase copyWithout: $..
-       potentialNames := (environment classAndTraitNames) asOrderedCollection.
-       names := pattern last = $. "This is some old hack, using String>>#match: may be better."
-               ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
-               ifFalse: [
-                       potentialNames select: [ :each |
-                               each includesSubstring: toMatch caseSensitive: false ] ].
-       exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
-       lines := OrderedCollection new.
-       exactMatch ifNotNil: [ lines add: 1 ].
-       "Also try some fuzzy matching."
-       reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
-               potentialNames includes: each ].
-       reducedIdentifiers ifNotEmpty: [
-               names addAll: reducedIdentifiers.
-               lines add: 1 + names size + reducedIdentifiers size ].
-       "Let the user select if there's more than one possible match. This may give surprising results."
-       names size = 0 ifTrue: [^ nil "nothing matches"].

+       "Try feature-based search for patterns such as 'WeakDict' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               toMatch := pattern copyWithoutAll: '.*#'.
+               toMatch findFeatures in: [:features |
+                       "1) Insert wildcards between features and at the end."
+                       toMatch := (features joinSeparatedBy: '*'), '*'.
+                       names := potentialNames select: [ :each | toMatch match: each ].
+                       names ifEmpty: [       
+                               "2) Insert wildcards before, between, and after features."
+                               toMatch := '*', (features joinSeparatedBy: '*'), '*'.
+                               names := potentialNames select: [ :each | toMatch match: each ] ]] ].
+       
+       "Try some fuzzy matching."
+       names addAll: (pattern suggestedTypeNames select: [ :each | potentialNames includes: each ]).
+       
+       "Still no match?"
+       names ifEmpty: [ ^ nil ].
+
+       "Let the user select if there's more than one possible match. This may give surprising results."       
        selectedIndex := names size = 1
                ifTrue: [ 1 ]
+               ifFalse: [ self chooseFrom: names title: label ].
-               ifFalse: [
-                       exactMatch ifNotNil: [ names addFirst: exactMatch ].
-                       self chooseFrom: names lines: lines title: label ].
        selectedIndex = 0 ifTrue: [ ^nil ].
        ^environment at: (names at: selectedIndex) asSymbol!




Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

Kjell Godo
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  pattern inject:( 1 )into:[ :i :p | 
    (( stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 06:55 Kjell Godo <[hidden email]> wrote:


On Mon, Jul 15, 2019 at 00:18 <[hidden email]> wrote:
Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.125.mcz

==================== Summary ====================

Name: ToolBuilder-Kernel-mt.125
Author: mt
Time: 11 July 2019, 8:50:30.487838 am
UUID: 3f3a21f8-a141-734f-8aed-f0c21aff22b9
Ancestors: ToolBuilder-Kernel-mt.124

Updates the search for class names using the new find-features feature on strings. Find WeakIdentityKeyDictionary (in a small list of results) with any of the following patterns:

WKD
Weak*Dict*
WeakDict
WeakIdentityKeyDictionary

=============== Diff against ToolBuilder-Kernel-mt.124 ===============

Item was changed:
  ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') -----
  classOrTraitFrom: environment pattern: pattern label: label
+       "Given a pattern and an environment, try to find a class or trait using several strategies:
+               - EXACT: If there is a class or trait whose name exactly given by pattern, return it.
+               - UPPER: If the pattern is upper-case only, find camel-case letters with that sequence.
+               - WILD: Try the pattern as-is for regular wild-card search.
+               - FEATURE: Split patterns at feature boundaries and insert wild cards between.
+               - FUZZY: Split patterns at feature boundaries BUT treat each feature as a full class name.
+       If there is only one class or trait in the given environment whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       "If there is a class or trait whose name exactly given by pattern, return it.
-       If there is only one class or trait in the given environment whose name matches pattern, return it.
-       Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       This method ignores separator characters in the pattern"

+       !!!! In any case, separator characters in the pattern are ignored."
+       
+       | toMatch potentialNames names selectedIndex |
+       
+       "If there's a class or trait named as pattern, then return it."
+       (environment classOrTraitNamed: pattern) ifNotNil: [:classOrTrait | ^ classOrTrait].
+
+       "Validate pattern."     
-       | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
        toMatch := pattern copyWithoutAll: Character separators.
+       toMatch := toMatch asLowercase copyWithout: $..
        toMatch ifEmpty: [ ^nil ].
+
+       "Fetch search space."
+       names := OrderedCollection new.
+       potentialNames := environment classAndTraitNames asOrderedCollection.
+
+       "Try uppercase-only patterns for patterns such as 'WKD' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               (pattern allSatisfy: [:char | char isUppercase]) ifTrue: [
+                       potentialNames do: [:each |
+                               | patternStream |
+                               patternStream := pattern readStream.<—-[ [_]— you don’t


really need to recreate this same patternStream for each [ :each ... ] do you ? ]



+                               each detect: [:char |
+                                       (patternStream atEnd not and: [patternStream peek = char])
+                                               ifTrue: [
+                                                       patternStream next.
+                                                       patternStream atEnd
+                                                               ifTrue: [names add: each. true "Match!!"]
+                                                               ifFalse: [false "Not yet..."]]
+                                               ifFalse: [false "No match..."] ] ifNone: [] ] ]].

<——————-—-[ [_]— using KEGGenerators maybe it could be done like
 [ | last eNGen | 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] )ifNotNil:[ :patternGen |
      potentialNames select:[ :eachName | last := false .
            ( patternGen shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ] . last := b&&last ] ]
                                   with:( eNGen := eachName asGenerator )
               ) iterate . last
            ]
      ]”<——-[ [x]— >>lastDo: evaluates its input on last element p of pattern 
                      [x]— >>shuffle:with: does (p=c)<=>( patternGen next ) i think
                      [x]— >>yourselfDo: returns its receiver r after doing( aBlock value:r )
                      [_]— String>>asCharacters = String>>asCharacter<—-[ is part
                               of the singular is plural idea of you don’t have to separate 
                               singular from plural with KEGGenerators just do( obj asGen ) ] ]”
] value .”<—-[ [_]— move local vars last & eNGen up and delete this >>value ]”

or 

 [ | last eNGen | 
 ( 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] 
 ) shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ]. last:=b&&last ] ] ]
    with:( eNGen := KEGGenerator streamGenerator ) 
 )ifNotNil:[ :shuffleGen |
      potentialNames select:[ :eachName | last := false . eNGen genOn:eacName . 
            shuffleGen iterate . last
            ]
      ]”<——-[ [_]— this actually does not reAllocate any ..Generator in the loop ]”
] value .”<—-[ untested . not looked up . unpublished >>genOn: = >>on: i think ]”


+
+       "Try wildcard search for patterns such as 'Weak*Dict*' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               names := potentialNames select: [ :each | toMatch match: each ]].
-       "If there's a class or trait named as pattern, then return it."
-       Symbol hasInterned: pattern ifTrue: [ :symbol |
-               environment at: symbol ifPresent: [ :maybeClassOrTrait |
-                       ((maybeClassOrTrait isKindOf: Class) or: [
-                               maybeClassOrTrait isTrait ])
-                                       ifTrue: [ ^maybeClassOrTrait ] ] ].
-       "No exact match, look for potential matches."
-       toMatch := pattern asLowercase copyWithout: $..
-       potentialNames := (environment classAndTraitNames) asOrderedCollection.
-       names := pattern last = $. "This is some old hack, using String>>#match: may be better."
-               ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
-               ifFalse: [
-                       potentialNames select: [ :each |
-                               each includesSubstring: toMatch caseSensitive: false ] ].
-       exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
-       lines := OrderedCollection new.
-       exactMatch ifNotNil: [ lines add: 1 ].
-       "Also try some fuzzy matching."
-       reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
-               potentialNames includes: each ].
-       reducedIdentifiers ifNotEmpty: [
-               names addAll: reducedIdentifiers.
-               lines add: 1 + names size + reducedIdentifiers size ].
-       "Let the user select if there's more than one possible match. This may give surprising results."
-       names size = 0 ifTrue: [^ nil "nothing matches"].

+       "Try feature-based search for patterns such as 'WeakDict' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               toMatch := pattern copyWithoutAll: '.*#'.
+               toMatch findFeatures in: [:features |
+                       "1) Insert wildcards between features and at the end."
+                       toMatch := (features joinSeparatedBy: '*'), '*'.
+                       names := potentialNames select: [ :each | toMatch match: each ].
+                       names ifEmpty: [       
+                               "2) Insert wildcards before, between, and after features."
+                               toMatch := '*', (features joinSeparatedBy: '*'), '*'.
+                               names := potentialNames select: [ :each | toMatch match: each ] ]] ].
+       
+       "Try some fuzzy matching."
+       names addAll: (pattern suggestedTypeNames select: [ :each | potentialNames includes: each ]).
+       
+       "Still no match?"
+       names ifEmpty: [ ^ nil ].
+
+       "Let the user select if there's more than one possible match. This may give surprising results."       
        selectedIndex := names size = 1
                ifTrue: [ 1 ]
+               ifFalse: [ self chooseFrom: names title: label ].
-               ifFalse: [
-                       exactMatch ifNotNil: [ names addFirst: exactMatch ].
-                       self chooseFrom: names lines: lines title: label ].
        selectedIndex = 0 ifTrue: [ ^nil ].
        ^environment at: (names at: selectedIndex) asSymbol!




Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

Kjell Godo
WHOOPS
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 07:59 Kjell Godo <[hidden email]> wrote:
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 06:55 Kjell Godo <[hidden email]> wrote:


On Mon, Jul 15, 2019 at 00:18 <[hidden email]> wrote:
Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.125.mcz

==================== Summary ====================

Name: ToolBuilder-Kernel-mt.125
Author: mt
Time: 11 July 2019, 8:50:30.487838 am
UUID: 3f3a21f8-a141-734f-8aed-f0c21aff22b9
Ancestors: ToolBuilder-Kernel-mt.124

Updates the search for class names using the new find-features feature on strings. Find WeakIdentityKeyDictionary (in a small list of results) with any of the following patterns:

WKD
Weak*Dict*
WeakDict
WeakIdentityKeyDictionary

=============== Diff against ToolBuilder-Kernel-mt.124 ===============

Item was changed:
  ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') -----
  classOrTraitFrom: environment pattern: pattern label: label
+       "Given a pattern and an environment, try to find a class or trait using several strategies:
+               - EXACT: If there is a class or trait whose name exactly given by pattern, return it.
+               - UPPER: If the pattern is upper-case only, find camel-case letters with that sequence.
+               - WILD: Try the pattern as-is for regular wild-card search.
+               - FEATURE: Split patterns at feature boundaries and insert wild cards between.
+               - FUZZY: Split patterns at feature boundaries BUT treat each feature as a full class name.
+       If there is only one class or trait in the given environment whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       "If there is a class or trait whose name exactly given by pattern, return it.
-       If there is only one class or trait in the given environment whose name matches pattern, return it.
-       Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       This method ignores separator characters in the pattern"

+       !!!! In any case, separator characters in the pattern are ignored."
+       
+       | toMatch potentialNames names selectedIndex |
+       
+       "If there's a class or trait named as pattern, then return it."
+       (environment classOrTraitNamed: pattern) ifNotNil: [:classOrTrait | ^ classOrTrait].
+
+       "Validate pattern."     
-       | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
        toMatch := pattern copyWithoutAll: Character separators.
+       toMatch := toMatch asLowercase copyWithout: $..
        toMatch ifEmpty: [ ^nil ].
+
+       "Fetch search space."
+       names := OrderedCollection new.
+       potentialNames := environment classAndTraitNames asOrderedCollection.
+
+       "Try uppercase-only patterns for patterns such as 'WKD' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               (pattern allSatisfy: [:char | char isUppercase]) ifTrue: [
+                       potentialNames do: [:each |
+                               | patternStream |
+                               patternStream := pattern readStream.<—-[ [_]— you don’t


really need to recreate this same patternStream for each [ :each ... ] do you ? ]



+                               each detect: [:char |
+                                       (patternStream atEnd not and: [patternStream peek = char])
+                                               ifTrue: [
+                                                       patternStream next.
+                                                       patternStream atEnd
+                                                               ifTrue: [names add: each. true "Match!!"]
+                                                               ifFalse: [false "Not yet..."]]
+                                               ifFalse: [false "No match..."] ] ifNone: [] ] ]].

<——————-—-[ [_]— using KEGGenerators maybe it could be done like
 [ | last eNGen | 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] )ifNotNil:[ :patternGen |
      potentialNames select:[ :eachName | last := false .
            ( patternGen shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ] . last := b&&last ] ]
                                   with:( eNGen := eachName asGenerator )
               ) iterate . last
            ]
      ]”<——-[ [x]— >>lastDo: evaluates its input on last element p of pattern 
                      [x]— >>shuffle:with: does (p=c)<=>( patternGen next ) i think
                      [x]— >>yourselfDo: returns its receiver r after doing( aBlock value:r )
                      [_]— String>>asCharacters = String>>asCharacter<—-[ is part
                               of the singular is plural idea of you don’t have to separate 
                               singular from plural with KEGGenerators just do( obj asGen ) ] ]”
] value .”<—-[ [_]— move local vars last & eNGen up and delete this >>value ]”

or 

 [ | last eNGen | 
 ( 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] 
 ) shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ]. last:=b&&last ] ] ]
    with:( eNGen := KEGGenerator streamGenerator ) 
 )ifNotNil:[ :shuffleGen |
      potentialNames select:[ :eachName | last := false . eNGen genOn:eacName . 
            shuffleGen iterate . last
            ]
      ]”<——-[ [_]— this actually does not reAllocate any ..Generator in the loop ]”
] value .”<—-[ untested . not looked up . unpublished >>genOn: = >>on: i think ]”


+
+       "Try wildcard search for patterns such as 'Weak*Dict*' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               names := potentialNames select: [ :each | toMatch match: each ]].
-       "If there's a class or trait named as pattern, then return it."
-       Symbol hasInterned: pattern ifTrue: [ :symbol |
-               environment at: symbol ifPresent: [ :maybeClassOrTrait |
-                       ((maybeClassOrTrait isKindOf: Class) or: [
-                               maybeClassOrTrait isTrait ])
-                                       ifTrue: [ ^maybeClassOrTrait ] ] ].
-       "No exact match, look for potential matches."
-       toMatch := pattern asLowercase copyWithout: $..
-       potentialNames := (environment classAndTraitNames) asOrderedCollection.
-       names := pattern last = $. "This is some old hack, using String>>#match: may be better."
-               ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
-               ifFalse: [
-                       potentialNames select: [ :each |
-                               each includesSubstring: toMatch caseSensitive: false ] ].
-       exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
-       lines := OrderedCollection new.
-       exactMatch ifNotNil: [ lines add: 1 ].
-       "Also try some fuzzy matching."
-       reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
-               potentialNames includes: each ].
-       reducedIdentifiers ifNotEmpty: [
-               names addAll: reducedIdentifiers.
-               lines add: 1 + names size + reducedIdentifiers size ].
-       "Let the user select if there's more than one possible match. This may give surprising results."
-       names size = 0 ifTrue: [^ nil "nothing matches"].

+       "Try feature-based search for patterns such as 'WeakDict' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               toMatch := pattern copyWithoutAll: '.*#'.
+               toMatch findFeatures in: [:features |
+                       "1) Insert wildcards between features and at the end."
+                       toMatch := (features joinSeparatedBy: '*'), '*'.
+                       names := potentialNames select: [ :each | toMatch match: each ].
+                       names ifEmpty: [       
+                               "2) Insert wildcards before, between, and after features."
+                               toMatch := '*', (features joinSeparatedBy: '*'), '*'.
+                               names := potentialNames select: [ :each | toMatch match: each ] ]] ].
+       
+       "Try some fuzzy matching."
+       names addAll: (pattern suggestedTypeNames select: [ :each | potentialNames includes: each ]).
+       
+       "Still no match?"
+       names ifEmpty: [ ^ nil ].
+
+       "Let the user select if there's more than one possible match. This may give surprising results."       
        selectedIndex := names size = 1
                ifTrue: [ 1 ]
+               ifFalse: [ self chooseFrom: names title: label ].
-               ifFalse: [
-                       exactMatch ifNotNil: [ names addFirst: exactMatch ].
-                       self chooseFrom: names lines: lines title: label ].
        selectedIndex = 0 ifTrue: [ ^nil ].
        ^environment at: (names at: selectedIndex) asSymbol!




Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

Kjell Godo
WHOOPS
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true  . [
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
  ]on:Error do:[ :e | false ]
  ]


On Mon, Jul 15, 2019 at 08:03 Kjell Godo <[hidden email]> wrote:
WHOOPS
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 07:59 Kjell Godo <[hidden email]> wrote:
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 06:55 Kjell Godo <[hidden email]> wrote:


On Mon, Jul 15, 2019 at 00:18 <[hidden email]> wrote:
Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.125.mcz

==================== Summary ====================

Name: ToolBuilder-Kernel-mt.125
Author: mt
Time: 11 July 2019, 8:50:30.487838 am
UUID: 3f3a21f8-a141-734f-8aed-f0c21aff22b9
Ancestors: ToolBuilder-Kernel-mt.124

Updates the search for class names using the new find-features feature on strings. Find WeakIdentityKeyDictionary (in a small list of results) with any of the following patterns:

WKD
Weak*Dict*
WeakDict
WeakIdentityKeyDictionary

=============== Diff against ToolBuilder-Kernel-mt.124 ===============

Item was changed:
  ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') -----
  classOrTraitFrom: environment pattern: pattern label: label
+       "Given a pattern and an environment, try to find a class or trait using several strategies:
+               - EXACT: If there is a class or trait whose name exactly given by pattern, return it.
+               - UPPER: If the pattern is upper-case only, find camel-case letters with that sequence.
+               - WILD: Try the pattern as-is for regular wild-card search.
+               - FEATURE: Split patterns at feature boundaries and insert wild cards between.
+               - FUZZY: Split patterns at feature boundaries BUT treat each feature as a full class name.
+       If there is only one class or trait in the given environment whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       "If there is a class or trait whose name exactly given by pattern, return it.
-       If there is only one class or trait in the given environment whose name matches pattern, return it.
-       Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       This method ignores separator characters in the pattern"

+       !!!! In any case, separator characters in the pattern are ignored."
+       
+       | toMatch potentialNames names selectedIndex |
+       
+       "If there's a class or trait named as pattern, then return it."
+       (environment classOrTraitNamed: pattern) ifNotNil: [:classOrTrait | ^ classOrTrait].
+
+       "Validate pattern."     
-       | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
        toMatch := pattern copyWithoutAll: Character separators.
+       toMatch := toMatch asLowercase copyWithout: $..
        toMatch ifEmpty: [ ^nil ].
+
+       "Fetch search space."
+       names := OrderedCollection new.
+       potentialNames := environment classAndTraitNames asOrderedCollection.
+
+       "Try uppercase-only patterns for patterns such as 'WKD' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               (pattern allSatisfy: [:char | char isUppercase]) ifTrue: [
+                       potentialNames do: [:each |
+                               | patternStream |
+                               patternStream := pattern readStream.<—-[ [_]— you don’t


really need to recreate this same patternStream for each [ :each ... ] do you ? ]



+                               each detect: [:char |
+                                       (patternStream atEnd not and: [patternStream peek = char])
+                                               ifTrue: [
+                                                       patternStream next.
+                                                       patternStream atEnd
+                                                               ifTrue: [names add: each. true "Match!!"]
+                                                               ifFalse: [false "Not yet..."]]
+                                               ifFalse: [false "No match..."] ] ifNone: [] ] ]].

<——————-—-[ [_]— using KEGGenerators maybe it could be done like
 [ | last eNGen | 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] )ifNotNil:[ :patternGen |
      potentialNames select:[ :eachName | last := false .
            ( patternGen shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ] . last := b&&last ] ]
                                   with:( eNGen := eachName asGenerator )
               ) iterate . last
            ]
      ]”<——-[ [x]— >>lastDo: evaluates its input on last element p of pattern 
                      [x]— >>shuffle:with: does (p=c)<=>( patternGen next ) i think
                      [x]— >>yourselfDo: returns its receiver r after doing( aBlock value:r )
                      [_]— String>>asCharacters = String>>asCharacter<—-[ is part
                               of the singular is plural idea of you don’t have to separate 
                               singular from plural with KEGGenerators just do( obj asGen ) ] ]”
] value .”<—-[ [_]— move local vars last & eNGen up and delete this >>value ]”

or 

 [ | last eNGen | 
 ( 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] 
 ) shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ]. last:=b&&last ] ] ]
    with:( eNGen := KEGGenerator streamGenerator ) 
 )ifNotNil:[ :shuffleGen |
      potentialNames select:[ :eachName | last := false . eNGen genOn:eacName . 
            shuffleGen iterate . last
            ]
      ]”<——-[ [_]— this actually does not reAllocate any ..Generator in the loop ]”
] value .”<—-[ untested . not looked up . unpublished >>genOn: = >>on: i think ]”


+
+       "Try wildcard search for patterns such as 'Weak*Dict*' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               names := potentialNames select: [ :each | toMatch match: each ]].
-       "If there's a class or trait named as pattern, then return it."
-       Symbol hasInterned: pattern ifTrue: [ :symbol |
-               environment at: symbol ifPresent: [ :maybeClassOrTrait |
-                       ((maybeClassOrTrait isKindOf: Class) or: [
-                               maybeClassOrTrait isTrait ])
-                                       ifTrue: [ ^maybeClassOrTrait ] ] ].
-       "No exact match, look for potential matches."
-       toMatch := pattern asLowercase copyWithout: $..
-       potentialNames := (environment classAndTraitNames) asOrderedCollection.
-       names := pattern last = $. "This is some old hack, using String>>#match: may be better."
-               ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
-               ifFalse: [
-                       potentialNames select: [ :each |
-                               each includesSubstring: toMatch caseSensitive: false ] ].
-       exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
-       lines := OrderedCollection new.
-       exactMatch ifNotNil: [ lines add: 1 ].
-       "Also try some fuzzy matching."
-       reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
-               potentialNames includes: each ].
-       reducedIdentifiers ifNotEmpty: [
-               names addAll: reducedIdentifiers.
-               lines add: 1 + names size + reducedIdentifiers size ].
-       "Let the user select if there's more than one possible match. This may give surprising results."
-       names size = 0 ifTrue: [^ nil "nothing matches"].

+       "Try feature-based search for patterns such as 'WeakDict' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               toMatch := pattern copyWithoutAll: '.*#'.
+               toMatch findFeatures in: [:features |
+                       "1) Insert wildcards between features and at the end."
+                       toMatch := (features joinSeparatedBy: '*'), '*'.
+                       names := potentialNames select: [ :each | toMatch match: each ].
+                       names ifEmpty: [       
+                               "2) Insert wildcards before, between, and after features."
+                               toMatch := '*', (features joinSeparatedBy: '*'), '*'.
+                               names := potentialNames select: [ :each | toMatch match: each ] ]] ].
+       
+       "Try some fuzzy matching."
+       names addAll: (pattern suggestedTypeNames select: [ :each | potentialNames includes: each ]).
+       
+       "Still no match?"
+       names ifEmpty: [ ^ nil ].
+
+       "Let the user select if there's more than one possible match. This may give surprising results."       
        selectedIndex := names size = 1
                ifTrue: [ 1 ]
+               ifFalse: [ self chooseFrom: names title: label ].
-               ifFalse: [
-                       exactMatch ifNotNil: [ names addFirst: exactMatch ].
-                       self chooseFrom: names lines: lines title: label ].
        selectedIndex = 0 ifTrue: [ ^nil ].
        ^environment at: (names at: selectedIndex) asSymbol!




Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

marcel.taeumel
Hi Kjell,

thanks for your suggestions. This algorithm is bound to what support is there in the Trunk image. So KEGGenerators is no option here.

Your alternative looks like this for Squeak:

potentialNames select: [:eachName | | first stillAMatch |
first := true.
stillAMatch := true.
((pattern inject: 1 into: [:i :char | 
stillAMatch
ifTrue: [
(eachName findString: char asString startingAt: i)
in: [:i1 |
stillAMatch := (first ifTrue: [i = i1] ifFalse: [i < i1]).
first := false];
yourself] 
ifFalse: [0]] ) > 0) & stillAMatch ] 

For 'WKD' as input, it takes 695 microseconds to find the results. The current version (after the re-used stream), takes 1670 microseconds to find the results.

Maybe we can also get rid of that "char asString" ? Or is that optimized?

Best,
Marcel

Am 15.07.2019 17:08:54 schrieb Kjell Godo <[hidden email]>:

WHOOPS
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true  . [
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
  ]on:Error do:[ :e | false ]
  ]


On Mon, Jul 15, 2019 at 08:03 Kjell Godo <[hidden email]> wrote:
WHOOPS
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 07:59 Kjell Godo <[hidden email]> wrote:
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 06:55 Kjell Godo <[hidden email]> wrote:


On Mon, Jul 15, 2019 at 00:18 <[hidden email]> wrote:
Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.125.mcz

==================== Summary ====================

Name: ToolBuilder-Kernel-mt.125
Author: mt
Time: 11 July 2019, 8:50:30.487838 am
UUID: 3f3a21f8-a141-734f-8aed-f0c21aff22b9
Ancestors: ToolBuilder-Kernel-mt.124

Updates the search for class names using the new find-features feature on strings. Find WeakIdentityKeyDictionary (in a small list of results) with any of the following patterns:

WKD
Weak*Dict*
WeakDict
WeakIdentityKeyDictionary

=============== Diff against ToolBuilder-Kernel-mt.124 ===============

Item was changed:
  ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') -----
  classOrTraitFrom: environment pattern: pattern label: label
+       "Given a pattern and an environment, try to find a class or trait using several strategies:
+               - EXACT: If there is a class or trait whose name exactly given by pattern, return it.
+               - UPPER: If the pattern is upper-case only, find camel-case letters with that sequence.
+               - WILD: Try the pattern as-is for regular wild-card search.
+               - FEATURE: Split patterns at feature boundaries and insert wild cards between.
+               - FUZZY: Split patterns at feature boundaries BUT treat each feature as a full class name.
+       If there is only one class or trait in the given environment whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       "If there is a class or trait whose name exactly given by pattern, return it.
-       If there is only one class or trait in the given environment whose name matches pattern, return it.
-       Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       This method ignores separator characters in the pattern"

+       !!!! In any case, separator characters in the pattern are ignored."
+       
+       | toMatch potentialNames names selectedIndex |
+       
+       "If there's a class or trait named as pattern, then return it."
+       (environment classOrTraitNamed: pattern) ifNotNil: [:classOrTrait | ^ classOrTrait].
+
+       "Validate pattern."     
-       | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
        toMatch := pattern copyWithoutAll: Character separators.
+       toMatch := toMatch asLowercase copyWithout: $..
        toMatch ifEmpty: [ ^nil ].
+
+       "Fetch search space."
+       names := OrderedCollection new.
+       potentialNames := environment classAndTraitNames asOrderedCollection.
+
+       "Try uppercase-only patterns for patterns such as 'WKD' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               (pattern allSatisfy: [:char | char isUppercase]) ifTrue: [
+                       potentialNames do: [:each |
+                               | patternStream |
+                               patternStream := pattern readStream.<—-[ [_]— you don’t


really need to recreate this same patternStream for each [ :each ... ] do you ? ]



+                               each detect: [:char |
+                                       (patternStream atEnd not and: [patternStream peek = char])
+                                               ifTrue: [
+                                                       patternStream next.
+                                                       patternStream atEnd
+                                                               ifTrue: [names add: each. true "Match!!"]
+                                                               ifFalse: [false "Not yet..."]]
+                                               ifFalse: [false "No match..."] ] ifNone: [] ] ]].

<——————-—-[ [_]— using KEGGenerators maybe it could be done like
 [ | last eNGen | 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] )ifNotNil:[ :patternGen |
      potentialNames select:[ :eachName | last := false .
            ( patternGen shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ] . last := b&&last ] ]
                                   with:( eNGen := eachName asGenerator )
               ) iterate . last
            ]
      ]”<——-[ [x]— >>lastDo: evaluates its input on last element p of pattern 
                      [x]— >>shuffle:with: does (p=c)<=>( patternGen next ) i think
                      [x]— >>yourselfDo: returns its receiver r after doing( aBlock value:r )
                      [_]— String>>asCharacters = String>>asCharacter<—-[ is part
                               of the singular is plural idea of you don’t have to separate 
                               singular from plural with KEGGenerators just do( obj asGen ) ] ]”
] value .”<—-[ [_]— move local vars last & eNGen up and delete this >>value ]”

or 

 [ | last eNGen | 
 ( 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] 
 ) shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ]. last:=b&&last ] ] ]
    with:( eNGen := KEGGenerator streamGenerator ) 
 )ifNotNil:[ :shuffleGen |
      potentialNames select:[ :eachName | last := false . eNGen genOn:eacName . 
            shuffleGen iterate . last
            ]
      ]”<——-[ [_]— this actually does not reAllocate any ..Generator in the loop ]”
] value .”<—-[ untested . not looked up . unpublished >>genOn: = >>on: i think ]”


+
+       "Try wildcard search for patterns such as 'Weak*Dict*' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               names := potentialNames select: [ :each | toMatch match: each ]].
-       "If there's a class or trait named as pattern, then return it."
-       Symbol hasInterned: pattern ifTrue: [ :symbol |
-               environment at: symbol ifPresent: [ :maybeClassOrTrait |
-                       ((maybeClassOrTrait isKindOf: Class) or: [
-                               maybeClassOrTrait isTrait ])
-                                       ifTrue: [ ^maybeClassOrTrait ] ] ].
-       "No exact match, look for potential matches."
-       toMatch := pattern asLowercase copyWithout: $..
-       potentialNames := (environment classAndTraitNames) asOrderedCollection.
-       names := pattern last = $. "This is some old hack, using String>>#match: may be better."
-               ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
-               ifFalse: [
-                       potentialNames select: [ :each |
-                               each includesSubstring: toMatch caseSensitive: false ] ].
-       exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
-       lines := OrderedCollection new.
-       exactMatch ifNotNil: [ lines add: 1 ].
-       "Also try some fuzzy matching."
-       reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
-               potentialNames includes: each ].
-       reducedIdentifiers ifNotEmpty: [
-               names addAll: reducedIdentifiers.
-               lines add: 1 + names size + reducedIdentifiers size ].
-       "Let the user select if there's more than one possible match. This may give surprising results."
-       names size = 0 ifTrue: [^ nil "nothing matches"].

+       "Try feature-based search for patterns such as 'WeakDict' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               toMatch := pattern copyWithoutAll: '.*#'.
+               toMatch findFeatures in: [:features |
+                       "1) Insert wildcards between features and at the end."
+                       toMatch := (features joinSeparatedBy: '*'), '*'.
+                       names := potentialNames select: [ :each | toMatch match: each ].
+                       names ifEmpty: [       
+                               "2) Insert wildcards before, between, and after features."
+                               toMatch := '*', (features joinSeparatedBy: '*'), '*'.
+                               names := potentialNames select: [ :each | toMatch match: each ] ]] ].
+       
+       "Try some fuzzy matching."
+       names addAll: (pattern suggestedTypeNames select: [ :each | potentialNames includes: each ]).
+       
+       "Still no match?"
+       names ifEmpty: [ ^ nil ].
+
+       "Let the user select if there's more than one possible match. This may give surprising results."       
        selectedIndex := names size = 1
                ifTrue: [ 1 ]
+               ifFalse: [ self chooseFrom: names title: label ].
-               ifFalse: [
-                       exactMatch ifNotNil: [ names addFirst: exactMatch ].
-                       self chooseFrom: names lines: lines title: label ].
        selectedIndex = 0 ifTrue: [ ^nil ].
        ^environment at: (names at: selectedIndex) asSymbol!




Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

Kjell Godo
[_]— how about 


0 < ( ( eachName select:[ :c | c isUpperCase ] ) 
               indexOfSubCollection: pattern )



On Mon, Jul 15, 2019 at 09:24 Marcel Taeumel <[hidden email]> wrote:
Hi Kjell,

thanks for your suggestions. This algorithm is bound to what support is there in the Trunk image. So KEGGenerators is no option here.

Your alternative looks like this for Squeak:

potentialNames select: [:eachName | | first stillAMatch |
first := true.
stillAMatch := true.
((pattern inject: 1 into: [:i :char | 
stillAMatch
ifTrue: [
(eachName findString: char asString startingAt: i)
in: [:i1 |
stillAMatch := (first ifTrue: [i = i1] ifFalse: [i < i1]).
first := false];
yourself] 
ifFalse: [0]] ) > 0) & stillAMatch ] 

For 'WKD' as input, it takes 695 microseconds to find the results. The current version (after the re-used stream), takes 1670 microseconds to find the results.

Maybe we can also get rid of that "char asString" ? Or is that optimized?

Best,
Marcel

Am 15.07.2019 17:08:54 schrieb Kjell Godo <[hidden email]>:

WHOOPS
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true  . [
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
  ]on:Error do:[ :e | false ]
  ]


On Mon, Jul 15, 2019 at 08:03 Kjell Godo <[hidden email]> wrote:
WHOOPS
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 07:59 Kjell Godo <[hidden email]> wrote:
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 06:55 Kjell Godo <[hidden email]> wrote:


On Mon, Jul 15, 2019 at 00:18 <[hidden email]> wrote:
Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.125.mcz

==================== Summary ====================

Name: ToolBuilder-Kernel-mt.125
Author: mt
Time: 11 July 2019, 8:50:30.487838 am
UUID: 3f3a21f8-a141-734f-8aed-f0c21aff22b9
Ancestors: ToolBuilder-Kernel-mt.124

Updates the search for class names using the new find-features feature on strings. Find WeakIdentityKeyDictionary (in a small list of results) with any of the following patterns:

WKD
Weak*Dict*
WeakDict
WeakIdentityKeyDictionary

=============== Diff against ToolBuilder-Kernel-mt.124 ===============

Item was changed:
  ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') -----
  classOrTraitFrom: environment pattern: pattern label: label
+       "Given a pattern and an environment, try to find a class or trait using several strategies:
+               - EXACT: If there is a class or trait whose name exactly given by pattern, return it.
+               - UPPER: If the pattern is upper-case only, find camel-case letters with that sequence.
+               - WILD: Try the pattern as-is for regular wild-card search.
+               - FEATURE: Split patterns at feature boundaries and insert wild cards between.
+               - FUZZY: Split patterns at feature boundaries BUT treat each feature as a full class name.
+       If there is only one class or trait in the given environment whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       "If there is a class or trait whose name exactly given by pattern, return it.
-       If there is only one class or trait in the given environment whose name matches pattern, return it.
-       Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       This method ignores separator characters in the pattern"

+       !!!! In any case, separator characters in the pattern are ignored."
+       
+       | toMatch potentialNames names selectedIndex |
+       
+       "If there's a class or trait named as pattern, then return it."
+       (environment classOrTraitNamed: pattern) ifNotNil: [:classOrTrait | ^ classOrTrait].
+
+       "Validate pattern."     
-       | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
        toMatch := pattern copyWithoutAll: Character separators.
+       toMatch := toMatch asLowercase copyWithout: $..
        toMatch ifEmpty: [ ^nil ].
+
+       "Fetch search space."
+       names := OrderedCollection new.
+       potentialNames := environment classAndTraitNames asOrderedCollection.
+
+       "Try uppercase-only patterns for patterns such as 'WKD' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               (pattern allSatisfy: [:char | char isUppercase]) ifTrue: [
+                       potentialNames do: [:each |
+                               | patternStream |
+                               patternStream := pattern readStream.<—-[ [_]— you don’t


really need to recreate this same patternStream for each [ :each ... ] do you ? ]



+                               each detect: [:char |
+                                       (patternStream atEnd not and: [patternStream peek = char])
+                                               ifTrue: [
+                                                       patternStream next.
+                                                       patternStream atEnd
+                                                               ifTrue: [names add: each. true "Match!!"]
+                                                               ifFalse: [false "Not yet..."]]
+                                               ifFalse: [false "No match..."] ] ifNone: [] ] ]].

<——————-—-[ [_]— using KEGGenerators maybe it could be done like
 [ | last eNGen | 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] )ifNotNil:[ :patternGen |
      potentialNames select:[ :eachName | last := false .
            ( patternGen shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ] . last := b&&last ] ]
                                   with:( eNGen := eachName asGenerator )
               ) iterate . last
            ]
      ]”<——-[ [x]— >>lastDo: evaluates its input on last element p of pattern 
                      [x]— >>shuffle:with: does (p=c)<=>( patternGen next ) i think
                      [x]— >>yourselfDo: returns its receiver r after doing( aBlock value:r )
                      [_]— String>>asCharacters = String>>asCharacter<—-[ is part
                               of the singular is plural idea of you don’t have to separate 
                               singular from plural with KEGGenerators just do( obj asGen ) ] ]”
] value .”<—-[ [_]— move local vars last & eNGen up and delete this >>value ]”

or 

 [ | last eNGen | 
 ( 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] 
 ) shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ]. last:=b&&last ] ] ]
    with:( eNGen := KEGGenerator streamGenerator ) 
 )ifNotNil:[ :shuffleGen |
      potentialNames select:[ :eachName | last := false . eNGen genOn:eacName . 
            shuffleGen iterate . last
            ]
      ]”<——-[ [_]— this actually does not reAllocate any ..Generator in the loop ]”
] value .”<—-[ untested . not looked up . unpublished >>genOn: = >>on: i think ]”


+
+       "Try wildcard search for patterns such as 'Weak*Dict*' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               names := potentialNames select: [ :each | toMatch match: each ]].
-       "If there's a class or trait named as pattern, then return it."
-       Symbol hasInterned: pattern ifTrue: [ :symbol |
-               environment at: symbol ifPresent: [ :maybeClassOrTrait |
-                       ((maybeClassOrTrait isKindOf: Class) or: [
-                               maybeClassOrTrait isTrait ])
-                                       ifTrue: [ ^maybeClassOrTrait ] ] ].
-       "No exact match, look for potential matches."
-       toMatch := pattern asLowercase copyWithout: $..
-       potentialNames := (environment classAndTraitNames) asOrderedCollection.
-       names := pattern last = $. "This is some old hack, using String>>#match: may be better."
-               ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
-               ifFalse: [
-                       potentialNames select: [ :each |
-                               each includesSubstring: toMatch caseSensitive: false ] ].
-       exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
-       lines := OrderedCollection new.
-       exactMatch ifNotNil: [ lines add: 1 ].
-       "Also try some fuzzy matching."
-       reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
-               potentialNames includes: each ].
-       reducedIdentifiers ifNotEmpty: [
-               names addAll: reducedIdentifiers.
-               lines add: 1 + names size + reducedIdentifiers size ].
-       "Let the user select if there's more than one possible match. This may give surprising results."
-       names size = 0 ifTrue: [^ nil "nothing matches"].

+       "Try feature-based search for patterns such as 'WeakDict' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               toMatch := pattern copyWithoutAll: '.*#'.
+               toMatch findFeatures in: [:features |
+                       "1) Insert wildcards between features and at the end."
+                       toMatch := (features joinSeparatedBy: '*'), '*'.
+                       names := potentialNames select: [ :each | toMatch match: each ].
+                       names ifEmpty: [       
+                               "2) Insert wildcards before, between, and after features."
+                               toMatch := '*', (features joinSeparatedBy: '*'), '*'.
+                               names := potentialNames select: [ :each | toMatch match: each ] ]] ].
+       
+       "Try some fuzzy matching."
+       names addAll: (pattern suggestedTypeNames select: [ :each | potentialNames includes: each ]).
+       
+       "Still no match?"
+       names ifEmpty: [ ^ nil ].
+
+       "Let the user select if there's more than one possible match. This may give surprising results."       
        selectedIndex := names size = 1
                ifTrue: [ 1 ]
+               ifFalse: [ self chooseFrom: names title: label ].
-               ifFalse: [
-                       exactMatch ifNotNil: [ names addFirst: exactMatch ].
-                       self chooseFrom: names lines: lines title: label ].
        selectedIndex = 0 ifTrue: [ ^nil ].
        ^environment at: (names at: selectedIndex) asSymbol!





Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

Kjell Godo


But since the names are all really short i think the way you did it is probably best





On Mon, Jul 15, 2019 at 10:04 Kjell Godo <[hidden email]> wrote:
[_]— how about 

No that won’t work won’t fulfill the specification
0 < ( ( eachName select:[ :c | c isUpperCase ] ) 
               indexOfSubCollection: pattern )

almost

On Mon, Jul 15, 2019 at 09:24 Marcel Taeumel <[hidden email]> wrote:
Hi Kjell,

thanks for your suggestions. This algorithm is bound to what support is there in the Trunk image. So KEGGenerators is no option here.

Your alternative looks like this for Squeak:

potentialNames select: [:eachName | | first stillAMatch |
first := true.
stillAMatch := true.
((pattern inject: 1 into: [:i :char | 
stillAMatch
ifTrue: [
(eachName findString: char asString startingAt: i)
in: [:i1 |
stillAMatch := (first ifTrue: [i = i1] ifFalse: [i < i1]).
first := false];
yourself] 
ifFalse: [0]] ) > 0) & stillAMatch ] 

For 'WKD' as input, it takes 695 microseconds to find the results. The current version (after the re-used stream), takes 1670 microseconds to find the results.

Maybe we can also get rid of that "char asString" ? Or is that optimized?

Best,
Marcel

Am 15.07.2019 17:08:54 schrieb Kjell Godo <[hidden email]>:

WHOOPS
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true  . [
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
  ]on:Error do:[ :e | false ]
  ]


On Mon, Jul 15, 2019 at 08:03 Kjell Godo <[hidden email]> wrote:
WHOOPS
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 07:59 Kjell Godo <[hidden email]> wrote:
[_]— or how about 

 
potentialNames select:[ :eachName | | first stillAMatch | first := stillAMatch := true .
  ( ( pattern inject:( 1 )into:[ :i :p | 
     stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i 
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i = i1]ifFalse:[i<i1] . first := false ] 
       ifFalse:[ 0 ] ] 
    ) ~= 0 
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 06:55 Kjell Godo <[hidden email]> wrote:


On Mon, Jul 15, 2019 at 00:18 <[hidden email]> wrote:
Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.125.mcz

==================== Summary ====================

Name: ToolBuilder-Kernel-mt.125
Author: mt
Time: 11 July 2019, 8:50:30.487838 am
UUID: 3f3a21f8-a141-734f-8aed-f0c21aff22b9
Ancestors: ToolBuilder-Kernel-mt.124

Updates the search for class names using the new find-features feature on strings. Find WeakIdentityKeyDictionary (in a small list of results) with any of the following patterns:

WKD
Weak*Dict*
WeakDict
WeakIdentityKeyDictionary

=============== Diff against ToolBuilder-Kernel-mt.124 ===============

Item was changed:
  ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') -----
  classOrTraitFrom: environment pattern: pattern label: label
+       "Given a pattern and an environment, try to find a class or trait using several strategies:
+               - EXACT: If there is a class or trait whose name exactly given by pattern, return it.
+               - UPPER: If the pattern is upper-case only, find camel-case letters with that sequence.
+               - WILD: Try the pattern as-is for regular wild-card search.
+               - FEATURE: Split patterns at feature boundaries and insert wild cards between.
+               - FUZZY: Split patterns at feature boundaries BUT treat each feature as a full class name.
+       If there is only one class or trait in the given environment whose name matches pattern, return it. Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       "If there is a class or trait whose name exactly given by pattern, return it.
-       If there is only one class or trait in the given environment whose name matches pattern, return it.
-       Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
-       This method ignores separator characters in the pattern"

+       !!!! In any case, separator characters in the pattern are ignored."
+       
+       | toMatch potentialNames names selectedIndex |
+       
+       "If there's a class or trait named as pattern, then return it."
+       (environment classOrTraitNamed: pattern) ifNotNil: [:classOrTrait | ^ classOrTrait].
+
+       "Validate pattern."     
-       | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
        toMatch := pattern copyWithoutAll: Character separators.
+       toMatch := toMatch asLowercase copyWithout: $..
        toMatch ifEmpty: [ ^nil ].
+
+       "Fetch search space."
+       names := OrderedCollection new.
+       potentialNames := environment classAndTraitNames asOrderedCollection.
+
+       "Try uppercase-only patterns for patterns such as 'WKD' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               (pattern allSatisfy: [:char | char isUppercase]) ifTrue: [
+                       potentialNames do: [:each |
+                               | patternStream |
+                               patternStream := pattern readStream.<—-[ [_]— you don’t


really need to recreate this same patternStream for each [ :each ... ] do you ? ]



+                               each detect: [:char |
+                                       (patternStream atEnd not and: [patternStream peek = char])
+                                               ifTrue: [
+                                                       patternStream next.
+                                                       patternStream atEnd
+                                                               ifTrue: [names add: each. true "Match!!"]
+                                                               ifFalse: [false "Not yet..."]]
+                                               ifFalse: [false "No match..."] ] ifNone: [] ] ]].

<——————-—-[ [_]— using KEGGenerators maybe it could be done like
 [ | last eNGen | 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] )ifNotNil:[ :patternGen |
      potentialNames select:[ :eachName | last := false .
            ( patternGen shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ] . last := b&&last ] ]
                                   with:( eNGen := eachName asGenerator )
               ) iterate . last
            ]
      ]”<——-[ [x]— >>lastDo: evaluates its input on last element p of pattern 
                      [x]— >>shuffle:with: does (p=c)<=>( patternGen next ) i think
                      [x]— >>yourselfDo: returns its receiver r after doing( aBlock value:r )
                      [_]— String>>asCharacters = String>>asCharacter<—-[ is part
                               of the singular is plural idea of you don’t have to separate 
                               singular from plural with KEGGenerators just do( obj asGen ) ] ]”
] value .”<—-[ [_]— move local vars last & eNGen up and delete this >>value ]”

or 

 [ | last eNGen | 
 ( 
 ( pattern asCharacters lastDo:[ :p | last := true . p ] 
 ) shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ]. last:=b&&last ] ] ]
    with:( eNGen := KEGGenerator streamGenerator ) 
 )ifNotNil:[ :shuffleGen |
      potentialNames select:[ :eachName | last := false . eNGen genOn:eacName . 
            shuffleGen iterate . last
            ]
      ]”<——-[ [_]— this actually does not reAllocate any ..Generator in the loop ]”
] value .”<—-[ untested . not looked up . unpublished >>genOn: = >>on: i think ]”


+
+       "Try wildcard search for patterns such as 'Weak*Dict*' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               names := potentialNames select: [ :each | toMatch match: each ]].
-       "If there's a class or trait named as pattern, then return it."
-       Symbol hasInterned: pattern ifTrue: [ :symbol |
-               environment at: symbol ifPresent: [ :maybeClassOrTrait |
-                       ((maybeClassOrTrait isKindOf: Class) or: [
-                               maybeClassOrTrait isTrait ])
-                                       ifTrue: [ ^maybeClassOrTrait ] ] ].
-       "No exact match, look for potential matches."
-       toMatch := pattern asLowercase copyWithout: $..
-       potentialNames := (environment classAndTraitNames) asOrderedCollection.
-       names := pattern last = $. "This is some old hack, using String>>#match: may be better."
-               ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
-               ifFalse: [
-                       potentialNames select: [ :each |
-                               each includesSubstring: toMatch caseSensitive: false ] ].
-       exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
-       lines := OrderedCollection new.
-       exactMatch ifNotNil: [ lines add: 1 ].
-       "Also try some fuzzy matching."
-       reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
-               potentialNames includes: each ].
-       reducedIdentifiers ifNotEmpty: [
-               names addAll: reducedIdentifiers.
-               lines add: 1 + names size + reducedIdentifiers size ].
-       "Let the user select if there's more than one possible match. This may give surprising results."
-       names size = 0 ifTrue: [^ nil "nothing matches"].

+       "Try feature-based search for patterns such as 'WeakDict' to find 'WeakIdentityKeyDictionary' etc."
+       names ifEmpty: [
+               toMatch := pattern copyWithoutAll: '.*#'.
+               toMatch findFeatures in: [:features |
+                       "1) Insert wildcards between features and at the end."
+                       toMatch := (features joinSeparatedBy: '*'), '*'.
+                       names := potentialNames select: [ :each | toMatch match: each ].
+                       names ifEmpty: [       
+                               "2) Insert wildcards before, between, and after features."
+                               toMatch := '*', (features joinSeparatedBy: '*'), '*'.
+                               names := potentialNames select: [ :each | toMatch match: each ] ]] ].
+       
+       "Try some fuzzy matching."
+       names addAll: (pattern suggestedTypeNames select: [ :each | potentialNames includes: each ]).
+       
+       "Still no match?"
+       names ifEmpty: [ ^ nil ].
+
+       "Let the user select if there's more than one possible match. This may give surprising results."       
        selectedIndex := names size = 1
                ifTrue: [ 1 ]
+               ifFalse: [ self chooseFrom: names title: label ].
-               ifFalse: [
-                       exactMatch ifNotNil: [ names addFirst: exactMatch ].
-                       self chooseFrom: names lines: lines title: label ].
        selectedIndex = 0 ifTrue: [ ^nil ].
        ^environment at: (names at: selectedIndex) asSymbol!





Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

timrowledge
I really like making the search tool more helpful; thnak you.

It reminds me that many (many...) years ago a colleague at ParcPlace did a quick 'soundex' search implementation. It was fairly simple and seemed to work quite well for those times when you don't know the exact speliiiing ov yur thngg. It might be an interesting avenue to wander down.

tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
Strange OpCodes: CLOUT: Call Long-distance On Unused Telephone



Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

Kjell Godo
?


( ( eachName select:[ :c | c isUpperCase and:[ pattern includes: c ] ] )
     indexOfSubCollection: pattern 
) > 0

0 < ( ( eachName select:[ :c | pattern includes: c ] ] ) indexOfSubCollection: pattern )




?

On Mon, Jul 15, 2019 at 10:22 tim Rowledge <[hidden email]> wrote:
I really like making the search tool more helpful; thnak you.

It reminds me that many (many...) years ago a colleague at ParcPlace did a quick 'soundex' search implementation. It was fairly simple and seemed to work quite well for those times when you don't know the exact speliiiing ov yur thngg. It might be an interesting avenue to wander down.

tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
Strange OpCodes: CLOUT: Call Long-distance On Unused Telephone





Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

marcel.taeumel
Hi Kjell,

here are more Benchmarks:  

| p n |
p := 'WKD'
n := 'WeakIdentityKeyDictionary'.

[ | first stillAMatch |
first := stillAMatch := true.
(0 < (p inject: 1 into: [:i :char | 
stillAMatch ifFalse: [0] ifTrue: [
(n findString: char asString startingAt: i caseSensitive: true)
in: [:i1 | stillAMatch := (first ifTrue: [i = i1] ifFalse: [i < i1]). first := false];
yourself]] ) ) & stillAMatch
] bench
'1,960,000 per second. 510 nanoseconds per run.'

[ | first i |
first := true.
i := 0.
p allSatisfy: [:char |
i := i + 1. 
(n findString: char asString startingAt: i caseSensitive: true)
in: [:i1 | first ifTrue: [first := false. i = i1] ifFalse: [i < i1] ] ]
] bench  
'1,770,000 per second. 564 nanoseconds per run.'


[((n select: [:c | c isUppercase and: [p includes: c]]) indexOfSubCollection: p) > 0] bench
'928,000 per second. 1.08 microseconds per run.'

[((n select: [:c | c isUppercase and: [p includes: c]]) findString: p) > 0] bench
'897,000 per second. 1.11 microseconds per run.'

[((n select: [:c | p includes: c]) indexOfSubCollection: p) > 0] bench
'493,000 per second. 2.03 microseconds per run.'

[((n select: [:c | p includes: c]) findString: p) > 0] bench
'495,000 per second. 2.02 microseconds per run.'

So, your solution is the fastest. I still wonder why I would need that final "& stillAMatch" at the end? And isn't "i = i1" rather "i1 = 1" and "i < i1" rather "i1 > 0"? And why isn't the starting index increasing? Did I make a copy-and-paste mistake? :-) The pattern 'WWK' should check for two separate $W's. Also, Squeak's cascade is slower than using a temp.

This is the current version:

| p n |
p := 'WKD'
n := 'WeakIdentityKeyDictionary'.

[ | first stillAMatch i1 |
first := stillAMatch := true.
0 < (p inject: 0 into: [:i :char | 
stillAMatch ifFalse: [0] ifTrue: [
i1 := (n findString: char asString startingAt: i+1 caseSensitive: true).
stillAMatch := (first ifTrue: [i1 = 1] ifFalse: [i1 > 0]).
first := false.
i1]] ) 
] bench
'2,390,000 per second. 419 nanoseconds per run.'

Best,
Marcel

Am 15.07.2019 21:17:50 schrieb Kjell Godo <[hidden email]>:

?


( ( eachName select:[ :c | c isUpperCase and:[ pattern includes: c ] ] )
     indexOfSubCollection: pattern 
) > 0

0 < ( ( eachName select:[ :c | pattern includes: c ] ] ) indexOfSubCollection: pattern )




?

On Mon, Jul 15, 2019 at 10:22 tim Rowledge <[hidden email]> wrote:
I really like making the search tool more helpful; thnak you.

It reminds me that many (many...) years ago a colleague at ParcPlace did a quick 'soundex' search implementation. It was fairly simple and seemed to work quite well for those times when you don't know the exact speliiiing ov yur thngg. It might be an interesting avenue to wander down.

tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
Strange OpCodes: CLOUT: Call Long-distance On Unused Telephone





Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: ToolBuilder-Kernel-mt.125.mcz

marcel.taeumel
Here are two other faster versions:

| p n |
p := 'WKD'
n := 'WeakIdentityKeyDictionary'.

[ | isMatch lookupIndex |
isMatch := true.
lookupIndex := 0.
1 to: p size do: [:charIndex | | char |
char := p at: charIndex.
isMatch ifTrue: [
lookupIndex := (n findString: char asString startingAt: lookupIndex+1 caseSensitive: true).
isMatch := lookupIndex > 0]].
isMatch 
] bench
'3,050,000 per second. 328 nanoseconds per run.'


[ | isMatch lookupIndex |
isMatch := true.
lookupIndex := 0.
1 to: p size do: [:charIndex | 
isMatch := isMatch and: [0 <
(lookupIndex := n
findString: (p at: charIndex) asString
startingAt: lookupIndex+1 caseSensitive: true)]].
isMatch
] bench
 '3,080,000 per second. 325 nanoseconds per run.'

This is fun. :-D

Best,
Marcel

Am 16.07.2019 09:11:29 schrieb Marcel Taeumel <[hidden email]>:

Hi Kjell,

here are more Benchmarks:  

| p n |
p := 'WKD'
n := 'WeakIdentityKeyDictionary'.

[ | first stillAMatch |
first := stillAMatch := true.
(0 < (p inject: 1 into: [:i :char | 
stillAMatch ifFalse: [0] ifTrue: [
(n findString: char asString startingAt: i caseSensitive: true)
in: [:i1 | stillAMatch := (first ifTrue: [i = i1] ifFalse: [i < i1]). first := false];
yourself]] ) ) & stillAMatch
] bench
'1,960,000 per second. 510 nanoseconds per run.'

[ | first i |
first := true.
i := 0.
p allSatisfy: [:char |
i := i + 1. 
(n findString: char asString startingAt: i caseSensitive: true)
in: [:i1 | first ifTrue: [first := false. i = i1] ifFalse: [i < i1] ] ]
] bench  
'1,770,000 per second. 564 nanoseconds per run.'


[((n select: [:c | c isUppercase and: [p includes: c]]) indexOfSubCollection: p) > 0] bench
'928,000 per second. 1.08 microseconds per run.'

[((n select: [:c | c isUppercase and: [p includes: c]]) findString: p) > 0] bench
'897,000 per second. 1.11 microseconds per run.'

[((n select: [:c | p includes: c]) indexOfSubCollection: p) > 0] bench
'493,000 per second. 2.03 microseconds per run.'

[((n select: [:c | p includes: c]) findString: p) > 0] bench
'495,000 per second. 2.02 microseconds per run.'

So, your solution is the fastest. I still wonder why I would need that final "& stillAMatch" at the end? And isn't "i = i1" rather "i1 = 1" and "i < i1" rather "i1 > 0"? And why isn't the starting index increasing? Did I make a copy-and-paste mistake? :-) The pattern 'WWK' should check for two separate $W's. Also, Squeak's cascade is slower than using a temp.

This is the current version:

| p n |
p := 'WKD'
n := 'WeakIdentityKeyDictionary'.

[ | first stillAMatch i1 |
first := stillAMatch := true.
0 < (p inject: 0 into: [:i :char | 
stillAMatch ifFalse: [0] ifTrue: [
i1 := (n findString: char asString startingAt: i+1 caseSensitive: true).
stillAMatch := (first ifTrue: [i1 = 1] ifFalse: [i1 > 0]).
first := false.
i1]] ) 
] bench
'2,390,000 per second. 419 nanoseconds per run.'

Best,
Marcel

Am 15.07.2019 21:17:50 schrieb Kjell Godo <[hidden email]>:

?


( ( eachName select:[ :c | c isUpperCase and:[ pattern includes: c ] ] )
     indexOfSubCollection: pattern 
) > 0

0 < ( ( eachName select:[ :c | pattern includes: c ] ] ) indexOfSubCollection: pattern )




?

On Mon, Jul 15, 2019 at 10:22 tim Rowledge <[hidden email]> wrote:
I really like making the search tool more helpful; thnak you.

It reminds me that many (many...) years ago a colleague at ParcPlace did a quick 'soundex' search implementation. It was fairly simple and seemed to work quite well for those times when you don't know the exact speliiiing ov yur thngg. It might be an interesting avenue to wander down.

tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
Strange OpCodes: CLOUT: Call Long-distance On Unused Telephone