"

 COPYRIGHT (c) 2006 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic3' }"

"{ NameSpace: Smalltalk }"

Object subclass:#MethodFinder

	instanceVariableNames:'data answers selector argMap thisData mapStage mapList

		expressions cachedClass cachedArgNum cachedSelectorLists'

	classVariableNames:'AddAndRemove Approved Blocks BlocksOptional Dangerous'

	poolDictionaries:''

	category:'Interface-Tools'

!

!MethodFinder class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2006 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

  [author:]

    ported from Squeak and GUI enhanced by James Hayes james@exept.de

"

! !

!MethodFinder class methodsFor:'accessing'!

abortAllSignal

    "return the value of the static variable 'AbortAllSignal' (automatically generated)"

    ^ AbortAllSignal

!

abortAllSignal:something

    "set the value of the static variable 'AbortAllSignal' (automatically generated)"

    AbortAllSignal := something.

!

addAndRemove

    "return the value of the static variable 'AddAndRemove' (automatically generated)"

    ^ AddAndRemove

!

addAndRemove:something

    "set the value of the static variable 'AddAndRemove' (automatically generated)"

    AddAndRemove := something.

!

approved

    "return the value of the static variable 'Approved' (automatically generated)"

    ^ Approved

!

approved:something

    "set the value of the static variable 'Approved' (automatically generated)"

    Approved := something.

!

blocks

    "return the value of the static variable 'Blocks' (automatically generated)"

    ^ Blocks

!

blocks:something

    "set the value of the static variable 'Blocks' (automatically generated)"

    Blocks := something.

!

dangerous

    "return the value of the static variable 'Dangerous' (automatically generated)"

    ^ Dangerous

!

dangerous:something

    "set the value of the static variable 'Dangerous' (automatically generated)"

    Dangerous := something.

! !

!MethodFinder class methodsFor:'as yet unclassified'!

methodFor: dataAndAnswers

    "Return a Squeak expression that computes these answers.  

     (This method is called by the comment in the bottom pane of a MethodFinder.  

     Do not delete this method.)"

"/ but yes, I do !!

"/ the finder already shows all the implementors in the right pane;

"/ no need fr this.

"/    | resultOC selFinder resultString |

"/   

"/    resultOC _ (self new) load: dataAndAnswers; findMessage.

"/    resultString _ String streamContents: [:strm |

"/            resultOC do: [:exp | strm nextPut: $(; nextPutAll: exp; nextPut: $); space]].

"/

"/    Smalltalk isMorphic ifTrue: [

"/            selFinder _ (Display bestGuessOfCurrentWorld 

"/                            submorphThat: [:mm | 

"/                                            mm class == SystemWindow 

"/                                            and: [mm model isKindOf: SelectorBrowser]] 

"/                            ifNone: [^ resultString]) model.

"/            selFinder searchResult: resultOC].

"/

"/    ^ resultString

! !

!MethodFinder methodsFor:'accessing'!

answers

        ^ answers

!

data

        ^ data

!

expressions

        ^ expressions

!

selectors

        "Note the inst var does not have an S on the end"

        ^ selector

! !

!MethodFinder methodsFor:'arg maps'!

argMap

        ^ argMap 

!

makeAllMaps 

        "Make a giant list of all permutations of the args.  To find the function, we will try these permutations of the input data.  receiver, args."

        | ii |

        mapList _ Array new: argMap size factorial.

        ii _ 1.

        argMap permutationsDo: [:perm |

                mapList at: ii put: perm copy.

                ii _ ii + 1].

        mapStage _ 1.   "about to be bumped"

!

mapData 

        "Force the data through the map (permutation) to create the data to test."

        thisData _ data collect: [:realData |

                                        argMap collect: [:ind | realData at: ind]].

!

permuteArgs 

        "Run through ALL the permutations.  First one was as presented."

        data first size <= 1 ifTrue: [^ false]. "no other way"

        mapList isNil ifTrue: [self makeAllMaps].

        mapStage _ mapStage + 1.

        mapStage > mapList size ifTrue: [^ false].

        argMap _ mapList at: mapStage.

        self mapData.

        ^ true

!

thisData

        ^ thisData 

! !

!MethodFinder methodsFor:'find a constant'!

allNumbers

        "Return true if all answers and all data are numbers."

        answers do: [:aa | aa isNumber ifFalse: [^ false]].

        thisData do: [:vec |

                        vec do: [:nn | nn isNumber ifFalse: [^ false]]].

        ^ true

!

const

        | const |

        "See if (^ constant) is the answer"

        "quick test"

        ((const _ answers at: 1) closeTo: (answers at: 2)) ifFalse: [^ false].

        3 to: answers size do: [:ii | (const closeTo: (answers at: ii)) ifFalse: [^ false]].

        expressions add: '^ ', const printString.

        selector add: #yourself.

        ^ true

!

constDiv

        "See if (data1 // C) is the answer"

        self breakPoint:#cg.

        ^ false.

"/        const _ ((thisData at: 1) at: 1) // (answers at: 1).  "May not be right!!"

"/        got _ (subTest _ MethodFinder new copy: self addArg: const) 

"/                                searchForOne isEmpty not.

"/        got ifFalse: [^ false]. 

"/

"/        "replace data2 with const in expressions"

"/        subTest expressions do: [:exp |

"/                expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].

"/        selector addAll: subTest selectors.

"/        ^ true

!

constLessThan

        | const subTest got minConst maxConst tt |

        "See if (data1 <= C) or (data1 >= C) is the answer"

        "quick test"

        ((answers at: 1) class superclass == Boolean) ifFalse: [^ false].

        2 to: answers size do: [:ii | 

                ((answers at: ii) class superclass == Boolean) ifFalse: [^ false]].

        minConst _ Float infinity.  maxConst _ minConst negated.

        answers withIndexDo: [:aa :ii |

                aa ifTrue: [tt _ (thisData at: ii) at: 1.

                        minConst _ minConst min: tt.

                        maxConst _ maxConst max: tt]].

        const _ (thisData at: 1) at: 1.

        got _ (subTest _ MethodFinder new copy: self addArg: minConst) 

                                searchForOne isEmpty not.

        got ifFalse: ["try other extreme for <= >= "

                got _ (subTest _ MethodFinder new copy: self addArg: maxConst) 

                                searchForOne isEmpty not]. 

        got ifFalse: [^ false]. 

        "replace data2 with const in expressions"

        subTest expressions do: [:exp |

                expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].

        selector addAll: subTest selectors.

        ^ true

!

constLinear

        | const subTest got denom num slope offset |

        "See if (data1 * C1) + C2 is the answer.  In the form  #(C2 C1) polynomialEval: data1 "

        denom _ ((thisData at: 2) at: 1) - ((thisData at: 1) at: 1).

        denom = 0 ifTrue: [^ false].   "will divide by it"

        num _ (answers at: 2) - (answers at: 1).

    slope := (num asFloat / denom) reduce.

    offset := ((answers at: 2) - (((thisData at: 2) at: 1) * slope)) reduce.

        const _ Array with: offset with: slope.

        got _ (subTest _ MethodFinder new copy: self addArg: const) 

                                searchForOne isEmpty not.

        got ifFalse: [^ false]. 

        "replace data2 with const in expressions"

        subTest expressions do: [:exp |

                expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].

        selector addAll: subTest selectors.

        ^ true

!

constMod

        | subTest low |

        "See if mod, (data1 \\ C) is the answer"

        low _ answers max.

        low+1 to: low+20 do: [:const |

                subTest _ MethodFinder new copy: self addArg: const.

                (subTest testPerfect: #\\) ifTrue: [

                        expressions add: 'data1 \\ ', const printString.

                        selector add: #\\.

                        ^ true]].

        ^ false

!

constMult

        | const subTest got |

        "See if (data1 * C) is the answer"

        ((thisData at: 1) at: 1) = 0 ifTrue: [^ false].

        const _ ((answers at: 1) asFloat / ((thisData at: 1) at: 1)) reduce.

        got _ (subTest _ MethodFinder new copy: self addArg: const) 

                                searchForOne isEmpty not.

        got ifFalse: [^ false]. 

        "replace data2 with const in expressions"

        subTest expressions do: [:exp |

                expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].

        selector addAll: subTest selectors.

        ^ true

!

constPlus

        | const subTest got |

        "See if (data1 + C) is the answer"

        const _ (answers at: 1) - ((thisData at: 1) at: 1).

        got _ (subTest _ MethodFinder new copy: self addArg: const) 

                                searchForOne isEmpty not.

        got ifFalse: [^ false]. 

        "replace data2 with const in expressions"

        subTest expressions do: [:exp |

                expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].

        selector addAll: subTest selectors.

        ^ true

! !

!MethodFinder methodsFor:'initialization'!

cleanInputs:dataAndAnswerString 

    "Find and remove common mistakes.  Complain when ill formed."

    |fixed ddd rs places|

    ddd := dataAndAnswerString.

    fixed := false.

    rs := ReadStream on:ddd , ' '.

    places := OrderedCollection new.

    [

        rs upToAll_positionBefore:'#true'.

        rs atEnd

    ] whileFalse:[ places addFirst:rs position ].

    places do:[:pos | 

        ddd := ddd 

                copyReplaceFrom:pos

                to:pos

                with:''.

        fixed := true

    ].

    rs := ReadStream on:ddd.

    places := OrderedCollection new.

    [

        rs upToAll_positionBefore:'#false'.

        rs atEnd

    ] whileFalse:[ places addFirst:rs position ].

    places do:[:pos | 

        ddd := ddd 

                copyReplaceFrom:pos

                to:pos

                with:''.

        fixed := true

    ].

    fixed ifTrue:[

        self 

            information:'#(true false) are Symbols, not Booleans.  

Next time use { true. false }.'

    ].

    fixed := false.

    rs := ReadStream on:ddd.

    places := OrderedCollection new.

    [

        rs upToAll_positionBefore:'#nil'.

        rs atEnd

    ] whileFalse:[ places addFirst:rs position ].

    places do:[:pos | 

        ddd := ddd 

                copyReplaceFrom:pos

                to:pos

                with:''.

        fixed := true

    ].

    fixed ifTrue:[

        self 

            information:'#nil is a Symbol, not the authentic UndefinedObject.  

Next time use nil instead of #nil'

    ].

    ^ ddd

!

initialize

        "The methods we are allowed to use.  (MethodFinder new initialize) "

        Approved _ Set new.

        AddAndRemove _ Set new.

        Blocks _ Set new.

        BlocksOptional := Set new.

        "These modify an argument: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom:"

"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 isArray isFloat isFraction isInMemory isInteger isMorph isNil isNumber 

        isPoint isPseudoContext isText isTransparent isWebBrowser isCollection

        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" - not useful 

    "printing" 

        fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation 

    "class membership" 

        class isKindOf: #'isKindOf:orOf:' isMemberOf: respondsTo: respondsToArithmetic  

    "error handling" 

    "user interface" 

        defaultBackgroundColor defaultLabelForInspector fullScreenSize initialExtent modelWakeUp mouseUpBalk: 

        "newTileMorphRepresentative" windowActiveOnFirstClick windowReqNewLabel: 

    "system primitives"  

        instVarAt: instVarNamed: 

    "private" 

    "associating" -> 

    "converting" 

        as: asOrderedCollection asString 

    "casing" 

        caseOf: #'caseOf:otherwise:' 

    "binding" 

        bindingOf: 

    "macpal" 

        contentsChanged #'ifKindOf:thenDo:' instanceVariableValues  

    "flagging" 

        flag: 

    "translation support" 

    "objects from disk" 

    "finalization" 

    "ST/X converting"

        literalArrayEncoding

        ) do: [:sel | Approved add: sel].

        #(

        #'at:add:' #'at:modify:' #'at:put:' #'basicAt:put:' "NOT instVar:at:"

    "message handling" 

        perform: 

        #'perform:with:' #'perform:with:with:' #'perform:with:with:with:' #'perform:withArguments:' 

        #'perform:withArguments:inSuperclass:'

        #'perform:orSendTo:' 

        ) do: [:sel | AddAndRemove add: sel].

"Boolean, True, False, UndefinedObject"  

        #(

    "logical operations" 

        & eqv: not xor: |

    "controlling" 

        and: ifFalse: #'ifFalse:ifTrue:' ifTrue: #'ifTrue:ifFalse:' or: ifNil: ifNotNil:

    "copying" 

    "testing" 

        isEmptyOrNil isNilOrEmptyCollection notEmptyOrNil

        ) 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: