Squeak-dev December 2021

squeak-dev@lists.squeakfoundation.org

30 participants
390 discussions

Merge Request: deprecateExceptions.1.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 01 Dec '21

01 Dec '21

=============== Summary =============== Change Set: deprecateExceptions Date: 7 November 2021 Author: Christoph Thiede This change set cleans up several unused exceptions. The classes Abort and ExceptionAboutToReturn are deleted. The classes EndOfStream, FontSubstitutionDuringLoading, NanError, and UndeclaredVariableReference are deprecated. See http://forum.world.st/Dead-exceptions-td5121827.html. (Finally! This tab has been waiting in my browser for me for almost 14 months...) =============== Diff =============== Abort (removed) - Exception subclass: #Abort - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'System-Exceptions' - - Abort class - instanceVariableNames: '' - - "" ChangeSet>>fileOutOn: {fileIn/Out} · ct 11/7/2021 16:44 (changed) fileOutOn: stream "Write out all the changes the receiver knows about" | classList traits classes traitList list | (self isEmpty and: [stream isKindOf: FileStream]) ifTrue: [self inform: 'Warning: no changes to file out']. - traits := self changedClasses reject: [:each | each isBehavior]. + traits := self changedClasses select: [:each | each isTrait]. classes := self changedClasses select: [:each | each isBehavior]. traitList := self class traitsOrder: traits asOrderedCollection. classList := self class superclassOrder: classes asOrderedCollection. list := OrderedCollection new addAll: traitList; addAll: classList; yourself. "First put out rename, max classDef and comment changes." list do: [:aClass | self fileOutClassDefinition: aClass on: stream]. "Then put out all the method changes" list do: [:aClass | self fileOutChangesFor: aClass on: stream]. "Finally put out removals, final class defs and reorganization if any" list reverseDo: [:aClass | self fileOutPSFor: aClass on: stream]. self classRemoves sort do: [:aClassName | stream nextChunkPut: 'Smalltalk removeClassNamed: #', aClassName; cr]. EndOfStream (changed) Error subclass: #EndOfStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Collections-Exceptions' + category: '60Deprecated-Collections-Exceptions' EndOfStream class instanceVariableNames: '' "Signalled when ReadStream>>next encounters a premature end." ExceptionAboutToReturn (removed) - Notification subclass: #ExceptionAboutToReturn - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Kernel-Exceptions-Kernel' - - ExceptionAboutToReturn class - instanceVariableNames: '' - - "" FontSubstitutionDuringLoading (changed) Notification subclass: #FontSubstitutionDuringLoading instanceVariableNames: 'familyName pixelSize' classVariableNames: '' poolDictionaries: '' - category: 'Etoys-Squeakland-System-Support' + category: '60Deprecated-Etoys-Squeakland-System-Support' FontSubstitutionDuringLoading class instanceVariableNames: '' "signaled by font loading code when reading a DiskProxy that calls for a missing font." NaNError (changed) ArithmeticError subclass: #NaNError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Kernel-Numbers-Exceptions' + category: '60Deprecated-Kernel-Numbers-Exceptions' NaNError class instanceVariableNames: '' "NaNError is signaled by various operations that would either result in or operate on an NaN input." UndeclaredVariableReference (changed) Notification subclass: #UndeclaredVariableReference instanceVariableNames: 'parser varName varStart varEnd' classVariableNames: '' poolDictionaries: '' - category: 'Compiler-Support' + category: '60Deprecated-Compiler-Support' UndeclaredVariableReference class instanceVariableNames: '' "" --- Sent from Squeak Inbox Talk

2 1

The Trunk: EToys-mt.451.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.451.mcz ==================== Summary ==================== Name: EToys-mt.451 Author: mt Time: 1 December 2021, 3:04:50.536361 pm UUID: 5370cee5-1d0f-a940-a8a3-d78500f6d2d9 Ancestors: EToys-mt.450 Complements 60Deprecated-mt.98 =============== Diff against EToys-mt.450 =============== Item was removed: - Notification subclass: #FontSubstitutionDuringLoading - instanceVariableNames: 'familyName pixelSize' - classVariableNames: '' - poolDictionaries: '' - category: 'Etoys-Squeakland-System-Support'! - - !FontSubstitutionDuringLoading commentStamp: '<historical>' prior: 0! - signaled by font loading code when reading a DiskProxy that calls for a missing font.! Item was removed: - ----- Method: FontSubstitutionDuringLoading class>>forFamilyName:pixelSize: (in category 'instance creation') ----- - forFamilyName: aName pixelSize: aSize - ^(self new) - familyName: aName; - pixelSize: aSize; - yourself.! Item was removed: - ----- Method: FontSubstitutionDuringLoading>>defaultAction (in category 'accessing') ----- - defaultAction - familyName ifNil: [ familyName := 'NoName' ]. - pixelSize ifNil: [ pixelSize := 12 ]. - - ^((familyName beginsWith: 'Comic') - ifTrue: [ TextStyle named: (Preferences standardEToysFont familyName) ] - ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! Item was removed: - ----- Method: FontSubstitutionDuringLoading>>familyName (in category 'accessing') ----- - familyName - "Answer the value of familyName" - - ^ familyName! Item was removed: - ----- Method: FontSubstitutionDuringLoading>>familyName: (in category 'accessing') ----- - familyName: anObject - "Set the value of familyName" - - familyName := anObject! Item was removed: - ----- Method: FontSubstitutionDuringLoading>>pixelSize (in category 'accessing') ----- - pixelSize - "Answer the value of pixelSize" - - ^ pixelSize! Item was removed: - ----- Method: FontSubstitutionDuringLoading>>pixelSize: (in category 'accessing') ----- - pixelSize: anObject - "Set the value of pixelSize" - - pixelSize := anObject! Item was removed: - ----- Method: FontSubstitutionDuringLoading>>printOn: (in category 'accessing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPut: $(; - nextPutAll: familyName; - nextPut: $-; - print: pixelSize; - nextPut: $).!

1 0

The Trunk: System-mt.1260.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1260.mcz ==================== Summary ==================== Name: System-mt.1260 Author: mt Time: 1 December 2021, 3:04:04.496361 pm UUID: e07c1e08-e164-5547-8acd-4f02569df6b3 Ancestors: System-mt.1259 Complements 60Deprecated-mt.98 =============== Diff against System-mt.1259 =============== Item was removed: - Exception subclass: #Abort - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'System-Exceptions'! Item was removed: - ----- Method: Abort>>defaultAction (in category 'handling') ----- - defaultAction - "No one has handled this error, but now give them a chance to decide how to debug it. If none handle this either then open debugger (see UnhandedError-defaultAction)" - - UnhandledError signalForException: self! Item was changed: ----- Method: ChangeSet>>fileOutOn: (in category 'fileIn/Out') ----- fileOutOn: stream "Write out all the changes the receiver knows about" | classList traits classes traitList list | (self isEmpty and: [stream isKindOf: FileStream]) ifTrue: [self inform: 'Warning: no changes to file out']. + traits := self changedClasses select: [:each | each isTrait]. - traits := self changedClasses reject: [:each | each isBehavior]. classes := self changedClasses select: [:each | each isBehavior]. traitList := self class traitsOrder: traits asOrderedCollection. classList := self class superclassOrder: classes asOrderedCollection. list := OrderedCollection new addAll: traitList; addAll: classList; yourself. "First put out rename, max classDef and comment changes." list do: [:aClass | self fileOutClassDefinition: aClass on: stream]. "Then put out all the method changes" list do: [:aClass | self fileOutChangesFor: aClass on: stream]. "Finally put out removals, final class defs and reorganization if any" list reverseDo: [:aClass | self fileOutPSFor: aClass on: stream]. self classRemoves sort do: [:aClassName | stream nextChunkPut: 'Smalltalk removeClassNamed: #', aClassName; cr].! Item was changed: + (PackageInfo named: 'System') postscript: 'Smalltalk removeClassNamed: #Abort.'! - (PackageInfo named: 'System') postscript: ' - (Preferences preferenceAt: #debugLogTimestamp) categoryList: #(''debug''). - - #(abbreviatedBrowserButtons allowEtoyUserCustomEvents alternativeButtonsInScrollBars automaticPlatformSettings compressFlashImages defaultFileOutFormatMacRoman dragNDropWithAnimation extractFlashInHighestQuality extractFlashInHighQuality menuButtonInToolPane translationWithBabel) - do: [:sel | Preferences removePreference: sel]. - '!

1 0

The Trunk: Compiler-mt.463.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-mt.463.mcz ==================== Summary ==================== Name: Compiler-mt.463 Author: mt Time: 1 December 2021, 3:02:38.419361 pm UUID: 027e34e7-89f6-9f4a-9427-06e250551f38 Ancestors: Compiler-mt.462 Complements 60Deprecated-mt.98 =============== Diff against Compiler-mt.462 =============== Item was removed: - Notification subclass: #UndeclaredVariableReference - instanceVariableNames: 'parser varName varStart varEnd' - classVariableNames: '' - poolDictionaries: '' - category: 'Compiler-Support'! Item was removed: - ----- Method: UndeclaredVariableReference>>defaultAction (in category 'exceptionDescription') ----- - defaultAction - ^parser correctVariable: varName interval: (varStart to: varEnd)! Item was removed: - ----- Method: UndeclaredVariableReference>>parser (in category 'accessing') ----- - parser - ^parser! Item was removed: - ----- Method: UndeclaredVariableReference>>parser: (in category 'accessing') ----- - parser: aParser - parser := aParser! Item was removed: - ----- Method: UndeclaredVariableReference>>varEnd (in category 'accessing') ----- - varEnd - ^varEnd! Item was removed: - ----- Method: UndeclaredVariableReference>>varEnd: (in category 'accessing') ----- - varEnd: aNumber - varEnd := aNumber! Item was removed: - ----- Method: UndeclaredVariableReference>>varName (in category 'accessing') ----- - varName - ^varName! Item was removed: - ----- Method: UndeclaredVariableReference>>varName: (in category 'accessing') ----- - varName: aString - varName := aString! Item was removed: - ----- Method: UndeclaredVariableReference>>varStart (in category 'accessing') ----- - varStart - ^varStart! Item was removed: - ----- Method: UndeclaredVariableReference>>varStart: (in category 'accessing') ----- - varStart: aNumber - varStart := aNumber!

1 0

The Trunk: 60Deprecated-mt.98.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-mt.98.mcz ==================== Summary ==================== Name: 60Deprecated-mt.98 Author: mt Time: 1 December 2021, 3:02:00.010361 pm UUID: 1bb3677a-7e50-3043-971c-ce643a23de98 Ancestors: 60Deprecated-mt.97 Clean up unused exceptions. Deprecations: - FontSubstitutionDuringLoading - NaNError - UndeclaredVariableReference Removals: - Abort - ExceptionAboutToReturn See: - http://lists.squeakfoundation.org/pipermail/squeak-dev/2020-September/21147… - http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-November/216929… =============== Diff against 60Deprecated-mt.97 =============== Item was changed: SystemOrganization addCategory: #'60Deprecated-Collections-Streams'! SystemOrganization addCategory: #'60Deprecated-HelpSystem-Core-Model'! SystemOrganization addCategory: #'60Deprecated-Kernel-Methods'! SystemOrganization addCategory: #'60Deprecated-Morphic-Events'! SystemOrganization addCategory: #'60Deprecated-Morphic-Widgets'! SystemOrganization addCategory: #'60Deprecated-NSPlugin-System-Support'! SystemOrganization addCategory: #'60Deprecated-System-Support'! SystemOrganization addCategory: #'60Deprecated-Tools-Inspector'! SystemOrganization addCategory: #'60Deprecated-Tools-Menus'! + SystemOrganization addCategory: #'60Deprecated-Etoys-Squeakland-System-Support'! + SystemOrganization addCategory: #'60Deprecated-Kernel-Numbers-Exceptions'! + SystemOrganization addCategory: #'60Deprecated-Compiler-Support'! Item was added: + Notification subclass: #FontSubstitutionDuringLoading + instanceVariableNames: 'familyName pixelSize' + classVariableNames: '' + poolDictionaries: '' + category: '60Deprecated-Etoys-Squeakland-System-Support'! + + !FontSubstitutionDuringLoading commentStamp: '<historical>' prior: 0! + signaled by font loading code when reading a DiskProxy that calls for a missing font.! Item was added: + ----- Method: FontSubstitutionDuringLoading class>>forFamilyName:pixelSize: (in category 'instance creation') ----- + forFamilyName: aName pixelSize: aSize + ^(self new) + familyName: aName; + pixelSize: aSize; + yourself.! Item was added: + ----- Method: FontSubstitutionDuringLoading>>defaultAction (in category 'accessing') ----- + defaultAction + familyName ifNil: [ familyName := 'NoName' ]. + pixelSize ifNil: [ pixelSize := 12 ]. + + ^((familyName beginsWith: 'Comic') + ifTrue: [ TextStyle named: (Preferences standardEToysFont familyName) ] + ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! Item was added: + ----- Method: FontSubstitutionDuringLoading>>familyName (in category 'accessing') ----- + familyName + "Answer the value of familyName" + + ^ familyName! Item was added: + ----- Method: FontSubstitutionDuringLoading>>familyName: (in category 'accessing') ----- + familyName: anObject + "Set the value of familyName" + + familyName := anObject! Item was added: + ----- Method: FontSubstitutionDuringLoading>>pixelSize (in category 'accessing') ----- + pixelSize + "Answer the value of pixelSize" + + ^ pixelSize! Item was added: + ----- Method: FontSubstitutionDuringLoading>>pixelSize: (in category 'accessing') ----- + pixelSize: anObject + "Set the value of pixelSize" + + pixelSize := anObject! Item was added: + ----- Method: FontSubstitutionDuringLoading>>printOn: (in category 'accessing') ----- + printOn: aStream + super printOn: aStream. + aStream nextPut: $(; + nextPutAll: familyName; + nextPut: $-; + print: pixelSize; + nextPut: $).! Item was added: + ArithmeticError subclass: #NaNError + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: '60Deprecated-Kernel-Numbers-Exceptions'! + + !NaNError commentStamp: 'ar 12/14/2010 00:03' prior: 0! + NaNError is signaled by various operations that would either result in or operate on an NaN input.! Item was added: + ----- Method: NaNError>>isResumable (in category 'testing') ----- + isResumable + "NaNError is always resumable" + ^true! Item was added: + ----- Method: NaNError>>messageText (in category 'accessing') ----- + messageText + "Return an exception's message text." + + ^messageText ifNil:['This operation would result in NaN ']! Item was added: + Notification subclass: #UndeclaredVariableReference + instanceVariableNames: 'parser varName varStart varEnd' + classVariableNames: '' + poolDictionaries: '' + category: '60Deprecated-Compiler-Support'! Item was added: + ----- Method: UndeclaredVariableReference>>defaultAction (in category 'exceptionDescription') ----- + defaultAction + ^parser correctVariable: varName interval: (varStart to: varEnd)! Item was added: + ----- Method: UndeclaredVariableReference>>parser (in category 'accessing') ----- + parser + ^parser! Item was added: + ----- Method: UndeclaredVariableReference>>parser: (in category 'accessing') ----- + parser: aParser + parser := aParser! Item was added: + ----- Method: UndeclaredVariableReference>>varEnd (in category 'accessing') ----- + varEnd + ^varEnd! Item was added: + ----- Method: UndeclaredVariableReference>>varEnd: (in category 'accessing') ----- + varEnd: aNumber + varEnd := aNumber! Item was added: + ----- Method: UndeclaredVariableReference>>varName (in category 'accessing') ----- + varName + ^varName! Item was added: + ----- Method: UndeclaredVariableReference>>varName: (in category 'accessing') ----- + varName: aString + varName := aString! Item was added: + ----- Method: UndeclaredVariableReference>>varStart (in category 'accessing') ----- + varStart + ^varStart! Item was added: + ----- Method: UndeclaredVariableReference>>varStart: (in category 'accessing') ----- + varStart: aNumber + varStart := aNumber!

1 0

The Trunk: KernelTests-pre.411.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Patrick Rein uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-pre.411.mcz ==================== Summary ==================== Name: KernelTests-pre.411 Author: pre Time: 1 December 2021, 2:59:24.70697 pm UUID: 9f32b7e6-180b-9546-bff8-6c26eb483605 Ancestors: KernelTests-ct.410 Adds two tests for #evaluate:wheneverChangIn: and thereby also for ObjectViewer. =============== Diff against KernelTests-ct.410 =============== Item was added: + ----- Method: ObjectTest>>testEvaluateWheneverChangeIn (in category 'tests - debugging') ----- + testEvaluateWheneverChangeIn + + | counter instance target | + instance := Object new. + counter := 0. + target := #notExecuted. + instance + evaluate: [target := #executed] + wheneverChangeIn: [counter]. + counter := counter + 1. + + instance name. + + self assert: #executed equals: target.! Item was added: + ----- Method: ObjectTest>>testEvaluateWheneverChangeInTransparent (in category 'tests - debugging') ----- + testEvaluateWheneverChangeInTransparent + + | instance | + instance := Object new. + instance + evaluate: [] + wheneverChangeIn: []. + self assert: instance yourself == instance.!

1 0

The Trunk: Kernel-pre.1430.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Patrick Rein uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-pre.1430.mcz ==================== Summary ==================== Name: Kernel-pre.1430 Author: pre Time: 1 December 2021, 2:57:51.27597 pm UUID: 2ac40a83-9e98-f24b-9bcf-ad603b6e7054 Ancestors: Kernel-nice.1429 Slightly improves the ObjectViewer by returning the ObjectViewer whenever the wrapped object would return itself. Thereby, the ObjectViewer stays in place somewhat longer. Recategorizes the ObjectViewer interface on Object to debugging, as it does not have anything to do with dependents access. =============== Diff against Kernel-nice.1429 =============== Item was changed: + ----- Method: Object>>evaluate:wheneverChangeIn: (in category 'debugging') ----- - ----- Method: Object>>evaluate:wheneverChangeIn: (in category 'dependents access') ----- evaluate: actionBlock wheneverChangeIn: aspectBlock | viewerThenObject objectThenViewer | objectThenViewer := self. viewerThenObject := ObjectViewer on: objectThenViewer. objectThenViewer become: viewerThenObject. "--- Then ---" objectThenViewer xxxViewedObject: viewerThenObject evaluate: actionBlock wheneverChangeIn: aspectBlock! Item was changed: ----- Method: ObjectViewer>>doesNotUnderstand: (in category 'very few messages') ----- doesNotUnderstand: aMessage "Check for change after sending aMessage" | returnValue newValue | recursionFlag ifTrue: [^ aMessage sendTo: tracedObject]. recursionFlag := true. returnValue := aMessage sendTo: tracedObject. + returnValue == tracedObject ifTrue: [ + "Keep the ObjectViewer in place as long as possible" + returnValue := self]. newValue := valueBlock cull: aMessage. newValue = lastValue ifFalse: [changeBlock cull: aMessage. lastValue := newValue]. recursionFlag := false. ^ returnValue!

1 0

Anybody got an elegent construct for this functional monstrosity?
by gettimothy 01 Dec '21

01 Dec '21

I have a ReadStream and I want to detect some substrings in it. This works, but it is ugly. ((self match:'{|') | (self match:'|-') | (self match:'|}') | (self match:'{{') | (self match:'}}') | (self match:'[[') | (self match:']]') | (self match:'__') | (self match:'==') | (self match:'::') | (self match:'**') | (self match:'##') | (self match:'''') ) Is anybody aware of an elegant approach to this? Something along the lines of self matchAny: { '{|' . '|-' . '|}' . '{{' . '}}' . '[[' . ']]' . '__' . '==' . '::' . '**' . '##' . '''' } thx in advance

3 8

The Trunk: Tools-mt.1074.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1074.mcz ==================== Summary ==================== Name: Tools-mt.1074 Author: mt Time: 25 November 2021, 11:44:01.944354 am UUID: 39954290-b416-f242-a5b0-c7aea0e3c6a6 Ancestors: Tools-mt.1073 Adds a property protocol to Workspace to avoid having to go through #containingWindow to store extra stuff, which does not even work for MVC, just for morphs (i.e., SystemWindow, not StandardSystemView). Reuses a workspace's "bindings" with each property being prefixed with a "_" to not interfere with regular bindings. Note that such extra properties have already been added to #containingWindow in the past. =============== Diff against Tools-mt.1073 =============== Item was added: + ----- Method: Workspace>>hasProperty: (in category 'binding - properties') ----- + hasProperty: aSymbol + + | propertyValue | + propertyValue := self valueOfProperty: aSymbol. + propertyValue ifNil: [^ false]. + propertyValue == false ifTrue: [^ false]. + ^ true! Item was changed: ----- Method: Workspace>>initialize (in category 'initialize-release') ----- initialize super initialize. + bindings := Dictionary new. - self initializeBindings. acceptDroppedMorphs := false. mustDeclareVariables := self class declareVariablesAutomatically not. environment := Environment current! Item was removed: - ----- Method: Workspace>>initializeBindings (in category 'binding') ----- - initializeBindings - - bindings := Dictionary new! Item was added: + ----- Method: Workspace>>removeProperty: (in category 'binding - properties') ----- + removeProperty: aSymbol + + bindings removeKey: ('_', aSymbol) asSymbol ifAbsent: [].! Item was added: + ----- Method: Workspace>>resetBindings (in category 'binding') ----- + resetBindings + "Remove all bindings that are not prefixed with an $_. See #setProperty:toValue:." + + bindings keysAndValuesRemove: [:key :value | key first ~= $_]! Item was added: + ----- Method: Workspace>>setProperty:toValue: (in category 'binding - properties') ----- + setProperty: aSymbol toValue: anObject + + anObject ifNil: [^ self removeProperty: aSymbol]. + bindings at: ('_', aSymbol) asSymbol put: anObject.! Item was added: + ----- Method: Workspace>>valueOfProperty: (in category 'binding - properties') ----- + valueOfProperty: aSymbol + + ^ self valueOfProperty: aSymbol ifAbsent: nil! Item was added: + ----- Method: Workspace>>valueOfProperty:ifAbsent: (in category 'binding - properties') ----- + valueOfProperty: aSymbol ifAbsent: aBlock + + ^ bindings at: ('_', aSymbol) asSymbol ifAbsent: aBlock!

4 5

The Trunk: Kernel-nice.1429.mcz
by commits＠source.squeak.org 01 Dec '21

01 Dec '21

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1429.mcz ==================== Summary ==================== Name: Kernel-nice.1429 Author: nice Time: 1 December 2021, 2:35:08.604257 am UUID: 1a855b7e-d5db-4907-ba56-ab7c28e4ed38 Ancestors: Kernel-nice.1428 Fixup SmallInteger>>sqrt so that it answers nearest Float to exact square root. In some cases, when aSmallInteger isAnExactFloat not (thus above 53 bits, for 64 bits image only), sqrt was not returning the nearest Float to exact sqrt. We have deployed efforts for having the LargePositiveInteger answering nearest Float to their exact sqrt, we were supposed to offer the same level for SmallInteger too. For example take: x := SmallInteger maxVal - 64. We have: (2**60)-(2**6)-1 = x. or in factored form: (1-(2** -54) - (2** -60)) * (2**60) = x. when taking exact square root: (1-(2** -54) - (2** -60)) sqrt * (2**30) = x sqrt. But (1-(2** -54) - (2** -60)) sqrt is approximated with: (1-(2** -55) - (2** -61) - eps) where: eps<(2** -100) This term will be rounded asFloat to 1.0, because much closer to 1.0 than to 1.0 predecessor, that is: (1-(2** -53)) the boundary between those 2 Floats being: (1-(2** -54)) We thus expect: x sqrt asFloat = (2**30). However: y := x asFloat. will be rounded down to: (1-(2** -54)-(2** -60)) asFloat * (2**60) = y. (1-(2** -53)) * (2**60) = y. because slightly smaller than the boundary (1-(2** -54)) seen above. taking y square root: (1-(2** -53)) sqrt * (2**30) = y sqrt. First term is approximated with: (1-(2** -54) - eps) where: eps<(2** -100) Once again, slightly below the (1-(2** -54)) boundary. This time, the result is rounded down asFloat: (1-(2** -53)) * (2**30) = y sqrt asFloat. That is the predecessor of the expected result. We observe a double rounding at work: (SmallInteger maxVal - 64) asFloat is rounded down (SmallInteger maxVal - 64) asFloat sqrt is rounded down again because slightly less than boundary between 2r1.0e30 predecessor and 2r1.0e30. We have shown in comment that double rounding cannot occur in case of a squared integer (up to 60 bits), but it can occur for inexact square. We'd thus better resort to more careful algorithm already developped in LargePositiveInteger case. =============== Diff against Kernel-nice.1428 =============== Item was changed: ----- Method: SmallInteger>>sqrt (in category 'mathematical functions') ----- sqrt "Answer the square root of the receiver. If the square root is exact, answer an Integer, else answer a Float approximation" | floatResult integerResult | self negative ifTrue: [ ^ DomainError signal: 'sqrt undefined for number less than zero.' ]. floatResult := self asFloat sqrt. integerResult := floatResult truncated. "Note: truncated works for 60-bit SmallInteger If self is a square s^2, but asFloat rounds down, + f = s^2*(1-e), f^0.5 = s*(1-e)^0.5 = s*(1-0.5*e-O(e^2)) - f = s^2*(1-e), f^0.5 = s*(1-e)^0.5 = s*(1-0.5*e+O(e^2)) since s asFloat is exact, and e <= 0.5*ulp(1), + s*(1-0.5*e-O(e^2)) always rounds to s" - s*(1-0.5*e+O(e^2)) always rounds to s" integerResult * integerResult = self ifTrue: [^integerResult]. + self isAnExactFloat ifTrue: [^floatResult]. + "self has more bits than Float precision, so self asFloat and floatResult might be inexact. + Use large integer algorithm for a guaranty of returning the nearest float to exact result. + Note that shifting by 8 is enough because SmallInteger maxVal highBit - Float precision < 8" + ^(self << 8) sqrt timesTwoPower: -4! - ^floatResult!

2 1

Jump to page: