'From Squeak3.1alpha of 28 February 2001 [latest update: #4039] on 22 May 2001 at 9:45:56 pm'! "Change Set: MthFinder6-tk Date: 22 May 2001 Author: Ted Kaehler Fix several minor MethodFinder bugs: [ ] Symbols that can't possibly be selectors are not returned by Symbol class>>selectorsContaining:. [ ] Since method names can begin with Uppercase now, those symbols are included. [ ] Sort the list with upper and lowercase intermixed. [ ] For speed, remove one layer of calls when text-searching each symbol. [ ] MethodFinder>>verify now tests some of the new cases -- find a constant. [ ] stop testing a selector that does not return a value #printOn:format: [ ] force the user's system to initialize the Approved selectors (but only if it had already been inialized before). "! !MethodFinder methodsFor: 'initialize' stamp: 'tk 5/18/2001 19:23'! initialize "The methods we are allowed to use. (MethodFinder new initialize) " Approved _ Set new. AddAndRemove _ Set new. Blocks _ Set new. "These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:" "Object" #("in class, instance creation" categoryForUniclasses chooseUniqueClassName initialInstance isSystemDefined newFrom: officialClass readCarefullyFrom: "accessing" at: basicAt: basicSize bindWithTemp: in: size yourself "testing" basicType ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isPseudoContext isText isTransparent isWebBrowser knownName notNil pointsTo: wantsSteps "comparing" = == closeTo: hash hashMappedBy: identityHash identityHashMappedBy: identityHashPrintString ~= ~~ "copying" clone copy shallowCopy "dependents access" canDiscardEdits dependents hasUnacceptedEdits "updating" changed changed: okToChange update: windowIsClosing "printing" fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation "class membership" class isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass "error handling" "user interface" addModelMenuItemsTo:forMorph:hand: defaultBackgroundColor defaultLabelForInspector fullScreenSize initialExtent modelWakeUp mouseUpBalk: newTileMorphRepresentative windowActiveOnFirstClick windowReqNewLabel: "system primitives" asOop instVarAt: instVarNamed: "private" "associating" -> "converting" as: asOrderedCollection asString "casing" caseOf: caseOf:otherwise: "binding" bindingOf: "macpal" contentsChanged currentEvent currentHand currentWorld flash ifKindOf:thenDo: instanceVariableValues scriptPerformer "flagging" flag: "translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel]. #(at:add: at:modify: at:put: basicAt:put: "NOT instVar:at:" "message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: ) do: [:sel | AddAndRemove add: sel]. "Boolean, True, False, UndefinedObject" #("logical operations" & eqv: not xor: | "controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifFalse: or: "copying" "testing" isEmptyOrNil) do: [:sel | Approved add: sel]. "Behavior" #("initialize-release" "accessing" compilerClass decompilerClass evaluatorClass format methodDict parserClass sourceCodeTemplate subclassDefinerClass "testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords "copying" "printing" defaultNameStemForInstances printHierarchy "creating class hierarchy" "creating method dictionary" "instance creation" basicNew basicNew: new new: "accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses "accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent: "accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instVarNames instanceCount sharedPools someInstance subclassInstVarNames "testing class hierarchy" inheritsFrom: kindOfSubclass "testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: scopeHas:ifTrue: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichSelectorsStoreInto: "enumerating" "user interface" "private" indexIfCompact) do: [:sel | Approved add: sel]. "ClassDescription" #("initialize-release" "accessing" classVersion isMeta name theNonMetaClass "copying" "printing" classVariablesString instanceVariablesString sharedPoolsString "instance variables" checkForInstVarsOK: "method dictionary" "organization" category organization whichCategoryIncludesSelector: "compiling" acceptsLoggingOfCompilation wantsChangeSetLogging "fileIn/Out" definition "private" ) do: [:sel | Approved add: sel]. "Class" #("initialize-release" "accessing" classPool "testing" "copying" "class name" "instance variables" "class variables" classVarAt: classVariableAssociationAt: "pool variables" "compiling" "subclass creation" "fileIn/Out" ) do: [:sel | Approved add: sel]. "Metaclass" #("initialize-release" "accessing" isSystemDefined soleInstance "copying" "instance creation" "instance variables" "pool variables" "class hierarchy" "compiling" "fileIn/Out" nonTrivial ) do: [:sel | Approved add: sel]. "Context, BlockContext" #(receiver client method receiver tempAt: "debugger access" mclass pc selector sender shortStack sourceCode tempNames tempsAndValues "controlling" "printing" "system simulation" "initialize-release" "accessing" hasMethodReturn home numArgs "evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments: "controlling" "scheduling" "instruction decoding" "printing" "private" "system simulation" ) do: [:sel | Approved add: sel]. #(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel]. "Message" #("inclass, instance creation" selector: selector:argument: selector:arguments: "accessing" argument argument: arguments sends: "printing" "sending" ) do: [:sel | Approved add: sel]. #("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel]. "Magnitude" #("comparing" < <= > >= between:and: "testing" max: min: min:max: ) do: [:sel | Approved add: sel]. "Date, Time" #("in class, instance creation" fromDays: fromSeconds: fromString: newDay:month:year: newDay:year: today "in class, general inquiries" dateAndTimeNow dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: leapYear: nameOfDay: nameOfMonth: "accessing" day leap monthIndex monthName weekday year "arithmetic" addDays: subtractDate: subtractDays: "comparing" "inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous: "converting" asSeconds "printing" mmddyy mmddyyyy printFormat: "private" firstDayOfMonthIndex: weekdayIndex "in class, instance creation" fromSeconds: now "in class, general inquiries" dateAndTimeFromSeconds: dateAndTimeNow millisecondClockValue millisecondsToRun: totalSeconds "accessing" hours minutes seconds "arithmetic" addTime: subtractTime: "comparing" "printing" intervalString print24 "converting") do: [:sel | Approved add: sel]. #("private" hours: hours:minutes:seconds: day:year: ) do: [:sel | AddAndRemove add: sel]. "Number" #("in class" readFrom:base: "arithmetic" * + - / // \\ abs negated quo: reciprocal rem: "mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan "truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated "comparing" "testing" even isDivisibleBy: isInf isInfinite isNaN isZero negative odd positive sign strictlyPositive "converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees "intervals" to: to:by: "printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel]. "Integer" #("in class" primesUpTo: "testing" isPowerOfTwo "arithmetic" alignedTo: "comparing" "truncation and round off" atRandom normalize "enumerating" timesRepeat: "mathematical functions" degreeCos degreeSin factorial gcd: lcm: take: "bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask: "converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit "printing" asStringWithCommas hex hex8 radix: "system primitives" lastDigit replaceFrom:to:with:startingAt: "private" "benchmarks" ) do: [:sel | Approved add: sel]. "SmallInteger, LargeNegativeInteger, LargePositiveInteger" #("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" "system primitives" digitAt: digitLength "private" fromString:radix: ) do: [:sel | Approved add: sel]. #(digitAt:put: ) do: [:sel | AddAndRemove add: sel]. "Float" #("arithmetic" "mathematical functions" reciprocalFloorLog: reciprocalLogBase2 timesTwoPower: "comparing" "testing" "truncation and round off" exponent fractionPart integerPart significand significandAsInteger "converting" asApproximateFraction asIEEE32BitWord asTrueFraction "copying") do: [:sel | Approved add: sel]. "Fraction, Random" #(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel]. #(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel]. "Collection" #("accessing" anyOne "testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf: "enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect: "converting" asBag asCharacterSet asSet asSortedArray asSortedCollection asSortedCollection: "printing" "private" maxSize "arithmetic" "math functions" average max median min range sum) do: [:sel | Approved add: sel]. #("adding" add: addAll: addIfNotPresent: "removing" remove: remove:ifAbsent: removeAll: removeAllFoundIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel]. "SequenceableCollection" #("comparing" hasEqualElements: "accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atRandom: atWrap: fifth first fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third "removing" "copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sortBy: "enumerating" collectWithIndex: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval: "converting" asArray asDictionary asFloatArray asIntegerArray asStringWithCr asWordArray reversed "private" copyReplaceAll:with:asTokens: ) do: [:sel | Approved add: sel]. #( swap:with:) do: [:sel | AddAndRemove add: sel]. "ArrayedCollection, Bag" #("private" defaultElement "sorting" isSorted "accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" ) do: [:sel | Approved add: sel]. #( mergeSortFrom:to:by: sort sort: add: add:withOccurrences: "private" setDictionary ) do: [:sel | AddAndRemove add: sel]. "Other messages that modify the receiver" #(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with: removeFirst removeLast) do: [:sel | AddAndRemove add: sel]. self initialize2. " MethodFinder new initialize. MethodFinder new organizationFiltered: Set " ! ! !MethodFinder methodsFor: 'initialize' stamp: 'tk 5/18/2001 19:18'! verify "Test a bunch of examples" " MethodFinder new verify " Approved ifNil: [self initialize]. "Sets of allowed selectors" (MethodFinder new load: #( (0) 0 (30) 0.5 (45) 0.707106 (90) 1) ) searchForOne asArray = #('data1 degreeSin') ifFalse: [self error: 'should have found it']. (MethodFinder new load: { { true. [3]. [4]}. 3. { false. [0]. [6]}. 6} ) searchForOne asArray = #('data1 ifTrue: data2 ifFalse: data3') ifFalse: [ self error: 'should have found it']. (MethodFinder new load: {#(1). true. #(2). false. #(5). true. #(10). false} ) searchForOne asArray = #('data1 odd') ifFalse: [self error: 'should have found it']. "will correct the date type of #true, and complain" (MethodFinder new load: #((4 2) '2r100' (255 16) '16rFF' (14 8) '8r16') ) searchForOne asArray = #('data1 radix: data2' 'data1 printStringBase: data2' 'data1 storeStringBase: data2') ifFalse: [self error: 'should have found it']. (MethodFinder new load: {{Point x: 3 y: 4}. 4. {Point x: 1 y: 5}. 5} ) searchForOne asArray = #('data1 y') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #(('abcd') $a ('TedK') $T) ) searchForOne asArray = #('data1 asCharacter' 'data1 first' 'data1 anyOne') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #(('abcd' 1) $a ('Ted ' 3) $d ) ) searchForOne asArray = #('data1 at: data2' 'data1 atPin: data2' 'data1 atWrap: data2') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #(((12 4 8)) 24 ((1 3 6)) 10 ) ) searchForOne asArray= #('data1 sum') ifFalse: [self error: 'should have found it']. "note extra () needed for an Array object as an argument" (MethodFinder new load: #((14 3) 11 (-10 5) -15 (4 -3) 7) ) searchForOne asArray = #('data1 - data2') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #((4) 4 (-10) 10 (-3) 3 (2) 2 (-6) 6 (612) 612) ) searchForOne asArray = #('data1 abs') ifFalse: [self error: 'should have found it']. (MethodFinder new load: {#(4 3). true. #(-7 3). false. #(5 1). true. #(5 5). false} ) searchForOne asArray = #('data1 > data2') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #((5) 0.2 (2) 0.5) ) searchForOne asArray = #('data1 reciprocal') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #((12 4 8) 2 (1 3 6) 2 (5 2 16) 8) ) searchForOne asArray = #() " '(data3 / data2) ' want to be able to leave out args" ifFalse: [self error: 'should have found it']. (MethodFinder new load: #((0.0) 0.0 (1.5) 0.997495 (0.75) 0.681639) ) searchForOne asArray = #('data1 sin') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #((7 5) 2 (4 5) 4 (-9 4) 3) ) searchForOne asArray = #('data1 \\ data2') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #((7) 2 (4) 2 ) ) searchForOne asArray = #('^ 2') ifFalse: [self error: 'should have found it']. (MethodFinder new load: {#(7). true. #(4.1). true. #(1.5). false} ) searchForOne asArray = #('data1 >= 4.1') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #((35) 3 (17) 1 (5) 5) ) searchForOne asArray = #('data1 \\ 8') ifFalse: [self error: 'should have found it']. (MethodFinder new load: #((36) 7 (50) 10 ) ) searchForOne asArray = #('data1 quo: 5' 'data1 // 5') ifFalse: [ self error: 'should have found it']. (MethodFinder new load: #( ((2 3) 2) 8 ((2 3) 5) 17 ) ) searchForOne asArray = #('data1 polynomialEval: data2') ifFalse: [ self error: 'should have found it']. (MethodFinder new load: #((2) 8 (5) 17 ) ) searchForOne asArray = #('#(2 3) polynomialEval: data1') ifFalse: [ self error: 'should have found it']. ! ! !SelectorBrowser methodsFor: 'as yet unclassified' stamp: 'tk 5/22/2001 21:37'! contents: aString notifying: aController "Take what the user typed and find all selectors containing it" | tokens raw sorted | contents _ aString. classList _ #(). classListIndex _ 0. selectorIndex _ 0. tokens _ contents asString findTokens: ' .'. selectorList _ Cursor wait showWhile: [ tokens size = 1 ifTrue: [raw _ (Symbol selectorsContaining: contents asString). sorted _ raw as: SortedCollection. sorted sortBlock: [:x :y | x asLowercase <= y asLowercase]. sorted asArray] ifFalse: [self quickList]]. "find selectors from a single example of data" self changed: #messageList. self changed: #classList. ^ true! ! !Symbol class methodsFor: 'access' stamp: 'tk 5/18/2001 18:54'! selectorsContaining: aString "Answer a list of selectors that contain aString within them. Case-insensitive. Does return symbols that begin with a capital letter." | size selectorList ascii | selectorList _ OrderedCollection new. (size _ aString size) = 0 ifTrue: [^selectorList]. aString size = 1 ifTrue: [ ascii _ aString first asciiValue. ascii < 128 ifTrue: [selectorList add: (SymbolTable like: aString)] ]. aString first isLetter ifFalse: [ aString size == 2 ifTrue: [Symbol hasInterned: aString ifTrue: [:s | selectorList add: s]]. ^selectorList ]. selectorList _ selectorList copyFrom: 2 to: selectorList size. SymbolTable do: [:each | each size >= size ifTrue: [(each findSubstring: aString in: each startingAt: 1 matchTable: CaseInsensitiveOrder) > 0 ifTrue: [selectorList add: each]]]. ^selectorList reject: [:each | "reject non-selectors, but keep ones that begin with an uppercase" each numArgs < 0 and: [each asString withFirstCharacterDownshifted numArgs < 0]]. "Symbol selectorsContaining: 'scon'"! ! "Postscript: If the MethodFinder has already been initialized in the user's system, do it again to catch new things we added." (MethodFinder classPool at: #Approved) ifNotNil: [MethodFinder new initialize]. !