The Trunk: Protocols-nice.15.mcz

Nicolas Cellier uploaded a new version of Protocols to project The Trunk:
http://source.squeak.org/trunk/Protocols-nice.15.mcz

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

Name: Protocols-nice.15
Author: nice
Time: 27 December 2009, 4:10:58 am
UUID: ef8036a8-df7c-4ec5-9c8e-73d9551a2479
Ancestors: Protocols-nice.14

Cosmetic: move or remove a few temps inside closures

=============== Diff against Protocols-nice.14 ===============

Item was changed:
  ----- Method: NumberType>>initialize (in category 'initialization') -----
  initialize
  "Initialize the receiver (automatically called when instances are created via 'new')"
 
- | aMethodCategory aMethodInterface |
  super initialize.
  "Vocabulary replaceNumberVocabulary"
  "Vocabulary addVocabulary: Vocabulary newNumberVocabulary"
 
  self vocabularyName: #Number.
  self documentation: 'Numbers are things that can do arithmetic, have their magnitudes compared, etc.'.
 
  #((comparing 'Determining which of two numbers is larger'
  (= < > <= >= ~= ~~))
  (arithmetic 'Basic numeric operation'
  (* + - / // \\ abs negated quo: rem:))
  (testing 'Testing a number'
  (even isDivisibleBy: negative odd positive sign))
  (#'mathematical functions' 'Trigonometric and exponential functions'
  (cos exp ln log log: raisedTo: sin sqrt squared tan raisedToInteger:))
  (converting 'Converting a number to another form'
  (@ asInteger asPoint degreesToRadians radiansToDegrees asSmallAngleDegrees asSmallPositiveDegrees))
  (#'truncation and round off' 'Making a real number (with a decimal point) into an integer'
  (ceiling floor roundTo: roundUpTo: rounded truncateTo: truncated))
  ) do:
 
  [:item |
+ | aMethodCategory |
  aMethodCategory := ElementCategory new categoryName: item first.
  aMethodCategory documentation: item second.
  item third do:
  [:aSelector |
+ | aMethodInterface |
  aMethodInterface := MethodInterface new conjuredUpFor: aSelector class: (Number whichClassIncludesSelector: aSelector).
  aMethodInterface argumentVariables do:
  [:var | var variableType: #Number].
 
  (#(* + - / // \\ abs negated quo: rem:
  cos exp ln log log: raisedTo: sin sqrt squared tan raisedToInteger:
  asInteger degreesToRadians radiansToDegrees asSmallAngleDegrees asSmallPositiveDegrees)
  includes: aSelector) ifTrue:
  [aMethodInterface resultType: #Number].
 
  (#( @  asPoint ) includes: aSelector) ifTrue:
  [aMethodInterface resultType: #Point].
 
  (#(= < > <= >= ~= ~~ even isDivisibleBy: negative odd positive) includes: aSelector) ifTrue:
  [aMethodInterface resultType: #Boolean].
 
  aMethodInterface setNotToRefresh.  
  self atKey: aSelector putMethodInterface: aMethodInterface.
  aMethodCategory elementAt: aSelector put: aMethodInterface].
  self addCategory: aMethodCategory].
 
  "
  (('truncation and round off' ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated)
  ('testing' basicType even isDivisibleBy: isInf isInfinite isNaN isNumber isZero negative odd positive sign strictlyPositive)
  ('converting' @ adaptToCollection:andSend: adaptToFloat:andSend: adaptToFraction:andSend: adaptToInteger:andSend: adaptToPoint:andSend: adaptToString:andSend: asInteger asNumber asPoint asSmallAngleDegrees asSmallPositiveDegrees degreesToRadians radiansToDegrees)
  ('intervals' to: to:by: to:by:do: to:do:)
  ('printing' defaultLabelForInspector isOrAreStringWith: newTileMorphRepresentative printOn: printStringBase: storeOn: storeOn:base: storeStringBase: stringForReadout)
  ('comparing' closeTo:)
  ('filter streaming' byteEncode:)
  ('as yet unclassified' reduce)"
 
 
 
  !

Item was changed:
  ----- Method: Vocabulary>>setCategoryStrings: (in category 'private') -----
  setCategoryStrings: categoryTriplets
  "Establish the category strings as per (internalCategorySymbol newCategoryWording balloon-help)"
 
+
- | category |
  categoryTriplets do:
+ [:triplet | | category |
- [:triplet |
  (category := self categoryAt: triplet first) ifNotNil: [
  category wording: triplet second.
  category helpMessage: triplet third]]!

Item was changed:
  ----- Method: Vocabulary class>>embraceAddedTypeVocabularies (in category 'class initialization') -----
  embraceAddedTypeVocabularies
  "If there are any type-vocabulary subclases not otherwise accounted for, acknowledge them at this time"
 
+
- | vocabulary |
  DataType allSubclasses do:
+ [:dataType | | vocabulary |
- [:dataType |
  vocabulary := dataType new.
  vocabulary representsAType
  ifTrue: [(self allStandardVocabularies includesKey: vocabulary vocabularyName)
  ifFalse: [self addStandardVocabulary: vocabulary]]]!

Item was changed:
  ----- Method: Vocabulary>>categoryList (in category 'queries') -----
  categoryList
  "Answer the category list considering only code implemented in my
  limitClass and lower. This variant is used when the limitClass and
  targetObjct are known"
+ | classToUse |
- | classToUse foundAMethod classThatImplements |
  classToUse := object class.
  ^ categories
+ select: [:aCategory | | foundAMethod |
- select: [:aCategory |
  foundAMethod := false.
  aCategory elementsInOrder
+ do: [:aSpec | | classThatImplements |
- do: [:aSpec |
  classThatImplements := classToUse whichClassIncludesSelector: aSpec selector.
  (classThatImplements notNil
  and: [classThatImplements includesBehavior: limitClass])
  ifTrue: [foundAMethod := true]].
  foundAMethod]
  thenCollect: [:aCategory | aCategory categoryName]!

Item was changed:
  ----- Method: Vocabulary>>categoryWithNameIn:thatIncludesSelector:forInstance:ofClass: (in category 'queries') -----
  categoryWithNameIn: categoryNames thatIncludesSelector: aSelector forInstance: targetInstance ofClass: targetClass
  "Answer the name of a category, from among the provided categoryNames, which defines the selector for the given class.  Note reimplementor"
 
+
- | itsName |
  self categories do:
+ [:aCategory | | itsName |
+ ((categoryNames includes: (itsName := aCategory categoryName)) and:  [aCategory includesKey: aSelector])
- [:aCategory | ((categoryNames includes: (itsName := aCategory categoryName)) and:  [aCategory includesKey: aSelector])
  ifTrue:
  [^ itsName]].
  ^ nil!

Item was changed:
  ----- Method: Vocabulary>>categoryListForInstance:ofClass:limitClass: (in category 'queries') -----
  categoryListForInstance: targetObject ofClass: aClass limitClass: mostGenericClass
  "Answer the category list for the given instance (may be nil) of the
  given class, considering only code implemented in mostGenericClass and
  lower "
+ | classToUse |
- | classToUse foundAMethod classThatImplements |
  classToUse := targetObject
  ifNil: [aClass]
  ifNotNil: [targetObject class].
  ^ categories
+ select: [:aCategory | | foundAMethod |
- select: [:aCategory |
  foundAMethod := false.
  aCategory elementsInOrder
+ do: [:aSpec | | classThatImplements |
- do: [:aSpec |
  classThatImplements := classToUse whichClassIncludesSelector: aSpec selector.
  (classThatImplements notNil
  and: [classThatImplements includesBehavior: mostGenericClass])
  ifTrue: [foundAMethod := true]].
  foundAMethod]
  thenCollect: [:aCategory | aCategory categoryName]!

Item was changed:
  ----- Method: FullVocabulary>>rigAFewCategories (in category 'initialization') -----
  rigAFewCategories
  "Formerly used to rig generic categories, now seemingly disfunctional and in abeyance"
 
- | aMethodCategory |
  true ifTrue: [^ self].
 
  self flag: #deferred.
  "Vocabulary fullVocabulary rigAFewCategories "
  #( (accessing 'Generally holds methods to read and write instance variables')
  (initialization 'messages typically sent when an object is created, to set up its initial state'))
 
  do:
  [:pair |
+ | aMethodCategory |
  aMethodCategory := ElementCategory new categoryName: pair first.
  aMethodCategory documentation: pair second.
  self addCategory: aMethodCategory]!

Item was changed:
  ----- Method: StringType>>initialize (in category 'initialization') -----
  initialize
  "Initialize the receiver (automatically called when instances are created via 'new')"
 
+
- | aMethodCategory aMethodInterface |
  super initialize.
  self vocabularyName: #String.
 
  #((accessing 'The basic info'
  (at: at:put: size endsWithDigit findString: findTokens: includesSubString: indexOf: indexOf:startingAt: indexOf:startingAt:ifAbsent: lineCorrespondingToIndex: lineCount lineNumber: startsWithDigit numArgs))
  (#'more accessing' 'More basic info'
  (allButFirst allButFirst: allButLast allButLast: at:ifAbsent: atAllPut: atPin: atRandom: atWrap: atWrap:put: fifth first first: fourth from:to:put: last last: lastIndexOf: lastIndexOf:ifAbsent: middle replaceAll:with: replaceFrom:to:with: replaceFrom:to:with:startingAt: second sixth third))
  (comparing 'Determining which comes first alphabeticly'
  (< <= = > >= beginsWith: endsWith: endsWithAnyOf: howManyMatch: match:))
  (testing 'Testing'
  (includes: isEmpty ifNil: ifNotNil: isAllDigits isAllSeparators isString lastSpacePosition))
  (converting 'Converting it to another form'
  (asCharacter asDate asInteger asLowercase asNumber asString asStringOrText asSymbol asText asTime asUppercase asUrl capitalized keywords numericSuffix romanNumber reversed splitInteger surroundedBySingleQuotes withBlanksTrimmed withSeparatorsCompacted withoutTrailingBlanks withoutTrailingDigits asSortedCollection))
  (copying 'Make another one like me'
  (copy copyFrom:to: copyUpTo: copyUpToLast: shuffled))
  (enumerating 'Passing over the letters'
  (collect: collectWithIndex: do: from:to:do: reverseDo: select: withIndexDo: detect: detect:ifNone:))
+ ) do: [:item | | aMethodCategory |
- ) do: [:item |
  aMethodCategory := ElementCategory new categoryName: item first.
  aMethodCategory documentation: item second.
  item third do:
+ [:aSelector | | aMethodInterface |
- [:aSelector |
  aMethodInterface := MethodInterface new initializeFor: aSelector.
  self atKey: aSelector putMethodInterface: aMethodInterface.
  aMethodCategory elementAt: aSelector put: aMethodInterface].
  self addCategory: aMethodCategory].
  !

Item was changed:
  ----- Method: Vocabulary class>>newTimeVocabulary (in category 'standard vocabulary access') -----
  newTimeVocabulary
  "Answer a Vocabulary object representing me"
+ | aVocabulary |
- | aVocabulary aMethodCategory aMethodInterface |
  "Vocabulary newTimeVocabulary"
  "Vocabulary addStandardVocabulary: Vocabulary newTimeVocabulary"
 
  aVocabulary := self new vocabularyName: #Time.
  aVocabulary documentation: 'Time knows about hours, minutes, and seconds.  For long time periods, use Date'.
 
  #((accessing 'The basic info'
  (hours minutes seconds))
  (arithmetic 'Basic numeric operations'
  (addTime: subtractTime: max: min: min:max:))
  (comparing 'Determining which is larger'
  (= < > <= >= ~= between:and:))
  (testing 'Testing'
  (ifNil: ifNotNil:))
  (printing 'Return a string for this Time'
  (hhmm24 print24 intervalString printMinutes printOn:))
  (converting 'Converting it to another form'
  (asSeconds asString))
  (copying 'Make another one like me'
  (copy))
+ ) do: [:item | | aMethodCategory |
- ) do: [:item |
  aMethodCategory := ElementCategory new categoryName: item first.
  aMethodCategory documentation: item second.
  item third do:
+ [:aSelector | | aMethodInterface |
- [:aSelector |
  aMethodInterface := MethodInterface new initializeFor: aSelector.
  aVocabulary atKey: aSelector putMethodInterface: aMethodInterface.
  aMethodCategory elementAt: aSelector put: aMethodInterface].
  aVocabulary addCategory: aMethodCategory].
  #(#addTime: subtractTime: max: min: = < > <= >= ~= ) do: [:sel |
  (aVocabulary methodInterfaceAt: sel ifAbsent: [self error: 'fix this method'])
  argumentVariables: (OrderedCollection with:
  (Variable new name: nil type: aVocabulary vocabularyName))].
  ^ aVocabulary!

Item was changed:
  ----- Method: Vocabulary>>initializeFromTable: (in category 'initialization') -----
  initializeFromTable: aTable
  "Initialize the receiver from a list of method-specification tuples, each of the form:
  (1) selector
  (2) companion setter selector (#none or nil indicate none)
  (3)  argument specification array, each element being an array of the form
  <arg name>  <arg type>
  (4)  result type, (#none or nil indicate none)
  (5)  array of category symbols, i.e. the categories in which this element should appear.
  (6)  help message. (optional)
  (7)  wording (optional)
  (8)  auto update flag (optional) - if #updating, set readout to refetch automatically
 
  Consult Vocabulary class.initializeTestVocabulary for an example of use"
 
+ | categoryList |
- |  aMethodCategory categoryList aMethodInterface aSelector doc wording |
  categoryList := Set new.
  aTable do:
  [:tuple | categoryList addAll: tuple fifth].
  categoryList := categoryList asSortedArray.
  categoryList do:
+ [:aCategorySymbol | | aMethodCategory |
- [:aCategorySymbol |
  aMethodCategory := ElementCategory new categoryName: aCategorySymbol.
  aTable do:
+ [:tuple | | doc aSelector wording aMethodInterface |
+ (tuple fifth includes: aCategorySymbol) ifTrue:
- [:tuple | (tuple fifth includes: aCategorySymbol) ifTrue:
  [aMethodInterface := MethodInterface new.
  aSelector := tuple first.
  aMethodInterface selector: aSelector type: tuple fourth setter: tuple second.
  aMethodCategory elementAt: aSelector put: aMethodInterface.
  self atKey: aSelector putMethodInterface: aMethodInterface.
  ((tuple third ~~ #none) and: [tuple third isEmptyOrNil not])
  ifTrue:
  [aMethodInterface argumentVariables: (tuple third collect:
  [:pair | Variable new name: pair first type: pair second])].
  doc := (tuple size >= 6 and: [(#(nil none unused) includes: tuple sixth) not])
  ifTrue:
  [tuple sixth]
  ifFalse:
  [nil].
    wording := (tuple size >= 7 and: [(#(nil none unused) includes: tuple seventh) not])
  ifTrue:
  [tuple seventh]
  ifFalse:
  [aSelector asString].
  aMethodInterface
  wording: wording;
  helpMessage: doc.
  tuple size >= 8 ifTrue:
  [aMethodInterface setToRefetch]]].
  self addCategory: aMethodCategory]!

Item was changed:
  ----- Method: Vocabulary>>methodInterfacesInCategory:forInstance:ofClass:limitClass: (in category 'queries') -----
  methodInterfacesInCategory: categoryName forInstance: anObject ofClass: aClass limitClass: aLimitClass
  "Answer a list of method interfaces of all methods in the given category, provided they are implemented no further away than aLimitClass."
 
+
- | defClass |
  ^ ((self allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass) collect:
  [:sel | methodInterfaces at: sel ifAbsent:
  [MethodInterface new conjuredUpFor: sel class: aClass]]) select:
+ [:aMethodInterface | | defClass |
- [:aMethodInterface |
  defClass := aClass whichClassIncludesSelector: aMethodInterface selector.
  (defClass notNil and: [defClass includesBehavior: aLimitClass])]!

Item was changed:
  ----- Method: Vocabulary>>addFromTable: (in category 'initialization') -----
  addFromTable: aTable
  "Add each method-specification tuples, each of the form:
  (1) selector
  (2) companion setter selector (#none or nil indicate none)
  (3)  argument specification array, each element being an array of the form
  <arg name>  <arg type>
  (4)  result type, (#none or nil indicate none)
  (5)  array of category symbols, i.e. the categories in which this element should appear.
  (6)  help message. (optional)
  (7)  wording (optional)
  (8)  auto update flag (optional) - if #updating, set readout to refetch automatically
 
  Make new categories as needed.
  Consult Vocabulary class.initializeTestVocabulary for an example of use"
 
+
- | aMethodCategory aMethodInterface aSelector doc wording |
  aTable do:
+ [:tuple |   tuple fifth do: [:aCategorySymbol | | aSelector aMethodInterface aMethodCategory doc wording |
- [:tuple |   tuple fifth do: [:aCategorySymbol |
  (aMethodCategory := self categoryAt: aCategorySymbol) ifNil: [
  aMethodCategory := ElementCategory new categoryName: aCategorySymbol.
  self addCategory: aMethodCategory].
 
  aMethodInterface := MethodInterface new.
  aSelector := tuple first.
  aMethodInterface selector: aSelector type: tuple fourth setter: tuple second.
  aMethodCategory elementAt: aSelector put: aMethodInterface.
  self atKey: aSelector putMethodInterface: aMethodInterface.
  ((tuple third ~~ #none) and: [tuple third isEmptyOrNil not])
  ifTrue:
  [aMethodInterface argumentVariables: (tuple third collect:
  [:pair | Variable new name: pair first type: pair second])].
 
 
  doc := (tuple size >= 6 and: [(#(nil none unused) includes: tuple sixth) not])
  ifTrue:
  [tuple sixth]
  ifFalse:
  [nil].
  wording := (tuple size >= 7 and: [(#(nil none unused) includes: tuple seventh) not])
  ifTrue:
  [tuple seventh]
  ifFalse:
  [aSelector].
  aMethodInterface
  wording: wording;
  helpMessage: doc.
  tuple size >= 8 ifTrue:
  [aMethodInterface setToRefetch]]].
  !