The Trunk: Collections-nice.265.mcz

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

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

Name: Collections-nice.265
Author: nice
Time: 27 December 2009, 4:56:32 am
UUID: bfa554c4-f01a-4c79-850a-4c052d93e58c
Ancestors: Collections-nice.264

Cosmetic: move or remove a few temps inside closures

=============== Diff against Collections-nice.264 ===============

Item was changed:
  ----- Method: Collection>>detectMax: (in category 'enumerating') -----
  detectMax: aBlock
  "Evaluate aBlock with each of the receiver's elements as the argument.
  Answer the element for which aBlock evaluates to the highest magnitude.
  If collection empty, return nil.  This method might also be called elect:."
 
+ | maxElement maxValue |
+ self do: [:each | | val |
- | maxElement maxValue val |
- self do: [:each |
  maxValue == nil
  ifFalse: [
  (val := aBlock value: each) > maxValue ifTrue: [
  maxElement := each.
  maxValue := val]]
  ifTrue: ["first element"
  maxElement := each.
  maxValue := aBlock value: each].
  "Note that there is no way to get the first element that works
  for all kinds of Collections.  Must test every one."].
  ^ maxElement!

Item was changed:
  ----- Method: WordArray class>>bobsTest (in category 'as yet unclassified') -----
  bobsTest
+ | wa answer |
- | wa s1 s2 wa2 answer rawData |
  "
  WordArray bobsTest
  "
  answer := OrderedCollection new.
  wa := WordArray with: 16r01020304 with: 16r05060708.
+ {false. true} do: [ :pad | | rawData s1 s2 wa2 |
- {false. true} do: [ :pad |
  0 to: 3 do: [ :skip |
  s1 := RWBinaryOrTextStream on: ByteArray new.
 
  s1 next: skip put: 0. "start at varying positions"
  wa writeOn: s1.
  pad ifTrue: [s1 next: 4-skip put: 0]. "force length to be multiple of 4"
 
  rawData := s1 contents.
  s2 := RWBinaryOrTextStream with: rawData.
  s2 reset.
  s2 skip: skip. "get to beginning of object"
  wa2 := WordArray newFromStream: s2.
  answer add: {
  rawData size.
  skip.
  wa2 = wa.
  wa2 asArray collect: [ :each | each radix: 16]
  }
  ].
  ].
  ^answer explore!

Item was changed:
  ----- Method: String>>encodeForHTTPWithTextEncoding:conditionBlock: (in category 'converting') -----
  encodeForHTTPWithTextEncoding: encodingName conditionBlock: conditionBlock
  "change dangerous characters to their %XX form, for use in HTTP transactions"
 
+ | httpSafeStream encodedStream |
- | httpSafeStream encodedStream cont |
  httpSafeStream := WriteStream on: (String new).
  encodedStream := MultiByteBinaryOrTextStream on: (String new: 6).
  encodedStream converter: (TextConverter newForEncoding: encodingName).
+ self do: [:c | | cont |
- self do: [:c |
  (conditionBlock value: c)
  ifTrue: [httpSafeStream nextPut: (Character value: c charCode)]
  ifFalse: [
  encodedStream text; resetToStart.
  encodedStream nextPut: c.
  encodedStream position: 0.
  encodedStream binary.
  cont := encodedStream contents.
  cont do: [:byte |
  httpSafeStream nextPut: $%.
  httpSafeStream nextPut: (byte // 16) asHexDigit.
  httpSafeStream nextPut: (byte \\ 16) asHexDigit.
  ].
  ].
  ].
  ^ httpSafeStream contents.
  !

Item was changed:
  ----- Method: Matrix>>preMultiplyByMatrix: (in category 'arithmetic') -----
  preMultiplyByMatrix: m
  "Answer m +* self where m is a Matrix."
+
- |s|
 
  nrows = m columnCount ifFalse: [self error: 'dimensions do not conform'].
+ ^Matrix rows: m rowCount columns: ncols tabulate: [:row :col | | s |
- ^Matrix rows: m rowCount columns: ncols tabulate: [:row :col |
  s := 0.
  1 to: nrows do: [:k | s := (m at: row at: k) * (self at: k at: col) + s].
  s]!

Item was changed:
  ----- Method: Text>>removeAttributesThat:replaceAttributesThat:by: (in category 'converting') -----
  removeAttributesThat: removalBlock replaceAttributesThat: replaceBlock by: convertBlock
  "Enumerate all attributes in the receiver. Remove those passing removalBlock and replace those passing replaceBlock after converting it through convertBlock"
+ | added removed |
- | added removed new |
  "Deliberately optimized for the no-op default."
  added := removed := nil.
  runs withStartStopAndValueDo: [ :start :stop :attribs |
+ attribs do: [ :attrib | | new |
- attribs do: [ :attrib |
  (removalBlock value: attrib) ifTrue:[
  removed ifNil:[removed := WriteStream on: #()].
  removed nextPut: {start. stop. attrib}.
  ] ifFalse:[
  (replaceBlock value: attrib) ifTrue:[
  removed ifNil:[removed := WriteStream on: #()].
  removed nextPut: {start. stop. attrib}.
  new := convertBlock value: attrib.
  added ifNil:[added := WriteStream on: #()].
  added nextPut: {start. stop. new}.
  ].
  ].
  ].
  ].
  (added == nil and:[removed == nil]) ifTrue:[^self].
  "otherwise do the real work"
  removed ifNotNil:[removed contents do:[:spec|
  self removeAttribute: spec last from: spec first to: spec second]].
  added ifNotNil:[added contents do:[:spec|
  self addAttribute: spec last from: spec first to: spec second]].!

Item was changed:
  ----- Method: PositionableStream>>fileInFor:announcing: (in category 'fileIn/Out') -----
  fileInFor: client announcing: announcement
  "This is special for reading expressions from text that has been formatted
  with exclamation delimitors. The expressions are read and passed to the
  Compiler. Answer the result of compilation.  Put up a progress report with
       the given announcement as the title.
  Does NOT handle preambles or postscripts specially."
+ | val |
- | val chunk |
  announcement displayProgressAt: Sensor cursorPoint
  from: 0 to: self size
  during:
  [:bar |
  [self atEnd]
  whileFalse:
  [bar value: self position.
  self skipSeparators.
+ [ | chunk |
+ val := (self peekFor: $!!) ifTrue: [
- [ val := (self peekFor: $!!) ifTrue: [
  (Compiler evaluate: self nextChunk for: client logged: false) scanFrom: self
  ] ifFalse: [
  chunk := self nextChunk.
  self checkForPreamble: chunk.
  Compiler evaluate: chunk for: client logged: true ].
  ] on: InMidstOfFileinNotification
   do: [ :ex | ex resume: true].
  self atEnd ifFalse: [ self skipStyleChunk ]].
  self close].
  "Note:  The main purpose of this banner is to flush the changes file."
  SmalltalkImage current logChange: '----End fileIn of ' , self name , '----'.
  Smalltalk forgetDoIts.
  ^ val!

Item was changed:
  ----- Method: Collection>>detectMin: (in category 'enumerating') -----
  detectMin: aBlock
  "Evaluate aBlock with each of the receiver's elements as the argument.
  Answer the element for which aBlock evaluates to the lowest number.
  If collection empty, return nil."
 
+ | minElement minValue |
+ self do: [:each | | val |
- | minElement minValue val |
- self do: [:each |
  minValue == nil
  ifFalse: [
  (val := aBlock value: each) < minValue ifTrue: [
  minElement := each.
  minValue := val]]
  ifTrue: ["first element"
  minElement := each.
  minValue := aBlock value: each].
  "Note that there is no way to get the first element that works
  for all kinds of Collections.  Must test every one."].
  ^ minElement!

Item was changed:
  ----- Method: Array>>preMultiplyByMatrix: (in category 'arithmetic') -----
  preMultiplyByMatrix: m
  "Answer m+*self where m is a Matrix."
- |s|
-
  m columnCount = self size ifFalse: [self error: 'dimensions do not conform'].
  ^(1 to: m rowCount) collect: [:row |
+ | s |
  s := 0.
  1 to: self size do: [:k | s := (m at: row at: k) * (self at: k) + s].
  s]!

Item was changed:
  ----- Method: String>>findSelector (in category 'converting') -----
  findSelector
  "Dan's code for hunting down selectors with keyword parts; while this doesn't give a true parse, in most cases it does what we want, in where it doesn't, we're none the worse for it."
+ | sel possibleParens |
- | sel possibleParens level n |
  sel := self withBlanksTrimmed.
  (sel includes: $:) ifTrue:
  [sel := sel copyReplaceAll: ':' with: ': '. "for the style (aa max:bb) with no space"
  possibleParens := sel findTokens: Character separators.
  sel := self class streamContents:
+ [:s | | level |
+ level := 0.
- [:s | level := 0.
  possibleParens do:
+ [:token | | n |
- [:token |
  (level = 0 and: [token endsWith: ':'])
  ifTrue: [s nextPutAll: token]
  ifFalse: [(n := token occurrencesOf: $( ) > 0 ifTrue: [level := level + n].
  (n := token occurrencesOf: $[ ) > 0 ifTrue: [level := level + n].
  (n := token occurrencesOf: $] ) > 0 ifTrue: [level := level - n].
  (n := token occurrencesOf: $) ) > 0 ifTrue: [level := level - n]]]]].
 
  sel isEmpty ifTrue: [^ nil].
  sel isOctetString ifTrue: [sel := sel asOctetString].
  Symbol hasInterned: sel ifTrue:
  [:aSymbol | ^ aSymbol].
  ^ nil!

Item was changed:
  ----- Method: Symbol class>>possibleSelectorsFor: (in category 'private') -----
  possibleSelectorsFor: misspelled
  "Answer an ordered collection of possible corrections
  for the misspelled selector in order of likelyhood"
 
+ | numArgs candidates lookupString best binary short long first |
- | numArgs candidates lookupString best binary short long first ss |
  lookupString := misspelled asLowercase. "correct uppercase selectors to lowercase"
  numArgs := lookupString numArgs.
  (numArgs < 0 or: [lookupString size < 2]) ifTrue: [^ OrderedCollection new: 0].
  first := lookupString first.
  short := lookupString size - (lookupString size // 4 max: 3) max: 2.
  long := lookupString size + (lookupString size // 4 max: 3).
 
  "First assemble candidates for detailed scoring"
  candidates := OrderedCollection new.
+ self allSymbolTablesDo: [:s | | ss |
+ (((ss := s size) >= short "not too short"
- self allSymbolTablesDo: [:s | (((ss := s size) >= short "not too short"
  and: [ss <= long "not too long"
  or: [(s at: 1) = first]]) "well, any length OK if starts w/same letter"
  and: [s numArgs = numArgs]) "and numArgs is the same"
  ifTrue: [candidates add: s]].
 
  "Then further prune these by correctAgainst:"
  best := lookupString correctAgainst: candidates.
  ((misspelled last ~~ $:) and: [misspelled size > 1]) ifTrue: [
  binary := misspelled, ':'. "try for missing colon"
  Symbol hasInterned: binary ifTrue: [:him | best addFirst: him]].
  ^ best!

Item was changed:
  ----- Method: String>>correctAgainstEnumerator:continuedFrom: (in category 'private') -----
  correctAgainstEnumerator: wordBlock continuedFrom: oldCollection
  "The guts of correction, instead of a wordList, there is a block that should take another block and enumerate over some list with it."
 
+ | choices results maxChoices scoreMin |
- | choices scoreMin results score maxChoices |
  scoreMin := self size // 2 min: 3.
  maxChoices := 10.
  oldCollection isNil
  ifTrue: [ choices := SortedCollection sortBlock: [ :x :y | x value > y value ] ]
  ifFalse: [ choices := oldCollection ].
  wordBlock isNil
  ifTrue:
  [ results := OrderedCollection new.
  1 to: (maxChoices min: choices size) do: [ :i | results add: (choices at: i) key ] ]
  ifFalse:
+ [ wordBlock value: [ :word | | score |
- [ wordBlock value: [ :word |
  (score := self alike: word) >= scoreMin ifTrue:
  [ choices add: (Association key: word value: score).
  (choices size >= maxChoices) ifTrue: [ scoreMin := (choices at: maxChoices) value] ] ].
  results := choices ].
  ^ results!

Item was changed:
  ----- Method: String>>findAnySubStr:startingAt: (in category 'accessing') -----
  findAnySubStr: delimiters startingAt: start
  "Answer the index of the character within the receiver, starting at start, that begins a substring matching one of the delimiters.  delimiters is an Array of Strings (Characters are permitted also).  If the receiver does not contain any of the delimiters, answer size + 1."
 
+ | min |
- | min ind |
  min := self size + 1.
+ delimiters do: [:delim | | ind | "May be a char, a string of length 1, or a substring"
- delimiters do: [:delim | "May be a char, a string of length 1, or a substring"
  delim isCharacter
  ifTrue: [ind := self indexOfSubCollection: (String with: delim)
  startingAt: start ifAbsent: [min]]
  ifFalse: [ind := self indexOfSubCollection: delim
  startingAt: start ifAbsent: [min]].
  min := min min: ind].
  ^ min!

Item was changed:
  ----- Method: Array>>evalStrings (in category 'converting') -----
  evalStrings
    "Allows you to construct literal arrays.
      #(true false nil '5@6' 'Set new' '''text string''') evalStrings
      gives an array with true, false, nil, a Point, a Set, and a String
      instead of just a bunch of Symbols"
+    
-     | it |
 
+     ^ self collect: [:each | | it |
-     ^ self collect: [:each |
          it := each.
          each == #true ifTrue: [it := true].
       each == #false ifTrue: [it := false].
          each == #nil ifTrue: [it := nil].
          (each isString and:[each isSymbol not]) ifTrue: [
  it := Compiler evaluate: each].
          each class == Array ifTrue: [it := it evalStrings].
          it]!

Item was changed:
  ----- Method: Character class>>initializeClassificationTable (in category 'class initialization') -----
  initializeClassificationTable
  "
  Initialize the classification table. The classification table is a
  compact encoding of upper and lower cases of characters with
 
  - bits 0-7: The lower case value of this character.
  - bits 8-15: The upper case value of this character.
  - bit 16: lowercase bit (e.g., isLowercase == true)
  - bit 17: uppercase bit (e.g., isUppercase == true)
 
  "
+ | ch1 |
- | ch1 ch2 |
 
  LowercaseBit := 1 bitShift: 16.
  UppercaseBit := 1 bitShift: 17.
 
  "Initialize the letter bits (e.g., isLetter == true)"
  LetterBits := LowercaseBit bitOr: UppercaseBit.
 
  ClassificationTable := Array new: 256.
  "Initialize the defaults (neither lower nor upper case)"
  0 to: 255 do:[:i|
  ClassificationTable at: i+1 put: (i bitShift: 8) + i.
  ].
 
  "Initialize character pairs (upper-lower case)"
  #(
  "Basic roman"
  ($A $a) ($B $b) ($C $c) ($D $d)
  ($E $e) ($F $f) ($G $g) ($H $h)
  ($I $i) ($J $j) ($K $k) ($L $l)
  ($M $m) ($N $n) ($O $o) ($P $p)
  ($Q $q) ($R $r) ($S $s) ($T $t)
  ($U $u) ($V $v) ($W $w) ($X $x)
  ($Y $y) ($Z $z)
  "International"
  ($Ä $ä) ($Å $å) ($Ç $ç) ($É $é)
  ($Ñ $ñ) ($Ö $ö) ($Ü $ü) ($À $à)
  ($à $ã) ($Õ $õ) ($Œ $œ) ($Æ $æ)
  "International - Spanish"
  ($Á $á) ($Í $í) ($Ó $ó) ($Ú $ú)
  "International - PLEASE CHECK"
  ($È $è) ($Ì $ì) ($Ò $ò) ($Ù $ù)
  ($Ë $ë) ($Ï $ï)
  ($Â $â) ($Ê $ê) ($Î $î) ($Ô $ô) ($Û $û)
+ ) do:[:pair| | ch2 |
- ) do:[:pair|
  ch1 := pair first asciiValue.
  ch2 := pair last asciiValue.
  ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch2 + UppercaseBit.
  ClassificationTable at: ch2+1 put: (ch1 bitShift: 8) + ch2 + LowercaseBit.
  ].
 
  "Initialize a few others for which we only have lower case versions."
  #($ß $Ø $ø $ÿ) do:[:char|
  ch1 := char asciiValue.
  ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch1 + LowercaseBit.
  ].
  !

Item was changed:
  ----- Method: RunArray>>withStartStopAndValueDo: (in category 'accessing') -----
  withStartStopAndValueDo: aBlock
+ | start |
- | start stop |
  start := 1.
  runs with: values do:
+ [:len : val | | stop |
+ stop := start + len - 1.
- [:len : val | stop := start + len - 1.
  aBlock value: start value: stop value: val.
  start := stop + 1]
  !

Item was changed:
  ----- Method: PositionableStream>>fileInAnnouncing: (in category 'fileIn/Out') -----
  fileInAnnouncing: announcement
  "This is special for reading expressions from text that has been formatted
  with exclamation delimitors. The expressions are read and passed to the
  Compiler. Answer the result of compilation.  Put up a progress report with
       the given announcement as the title."
 
+ | val |
- | val chunk |
  announcement
  displayProgressAt: Sensor cursorPoint
  from: 0
  to: self size
  during:
  [:bar |
  [self atEnd] whileFalse:
  [bar value: self position.
  self skipSeparators.
 
+ [ | chunk |
+ val := (self peekFor: $!!)
- [val := (self peekFor: $!!)
  ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self]
  ifFalse:
  [chunk := self nextChunk.
  self checkForPreamble: chunk.
  Compiler evaluate: chunk logged: true]]
  on: InMidstOfFileinNotification
  do: [:ex | ex resume: true].
  self skipStyleChunk].
  self close].
  "Note:  The main purpose of this banner is to flush the changes file."
  SmalltalkImage current logChange: '----End fileIn of ' , self name , '----'.
  self flag: #ThisMethodShouldNotBeThere. "sd"
  Smalltalk forgetDoIts.
  ^val!