The Inbox: Tools-LM.828.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
24 messages Options
12
Reply | Threaded
Open this post in threaded view
|

The Inbox: Tools-LM.828.mcz

commits-2
A new version of Tools was added to project The Inbox:
http://source.squeak.org/inbox/Tools-LM.828.mcz

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

Name: Tools-LM.828
Author: LM
Time: 13 August 2018, 1:25:54.504807 pm
UUID: 061511ca-729a-ce43-a08c-8057c24f7406
Ancestors: Tools-tcj.827

Added the ability to exclude specific objects from the  PointerFinder.
Improved the Explorer's "chase pointers" context menu to exclude the Explorer itself from the search (includes some meta-programming, not ideal, but certainly better than previously, ideas for improvement appreciated).
Changed the way the PointerExplorer displays references, it now states the associations name on the left, and the Objects hash is moved to the right, together with the objects displayString.
These changes make it much easier to understand how the objects are associated with each other and should make it easier to track down memory leaks.

=============== Diff against Tools-tcj.827 ===============

Item was changed:
  ----- Method: Inspector>>chasePointers (in category 'menu commands') -----
  chasePointers
  | selected  saved |
  self selectionIndex = 0 ifTrue: [^ self changed: #flash].
  selected := self selection.
  saved := self object.
  [self object: nil.
  (Smalltalk includesKey: #PointerFinder)
  ifTrue: [PointerFinder on: selected]
  ifFalse: [self inspectPointers]]
  ensure: [self object: saved]!

Item was changed:
  ----- Method: ObjectExplorer>>chasePointersForSelection (in category 'menus - actions') -----
  chasePointersForSelection
 
+ PointerFinder on: self object except: {self}, ObjectExplorerWrapper allInstances!
- self flag: #tooMany. "mt: Note that we might want to ignore references caused by this tool."
- self object chasePointers.!

Item was changed:
  ----- Method: PointerExplorer>>rootObject: (in category 'accessing') -----
  rootObject: anObject
 
+ self root key: 'root'.
- self root key: anObject identityHash asString.
  super rootObject: anObject.!

Item was changed:
  ----- Method: PointerExplorerWrapper>>contents (in category 'accessing') -----
  contents
  "Return the wrappers with the objects holding references to item. Eldest objects come first, weak only referencers are at the end and have parentheses around their identity hash."
 
  | objects weakOnlyReferences |
  objects := self object inboundPointersExcluding: { self. self item. model }.
  weakOnlyReferences := OrderedCollection new.
  objects removeAllSuchThat: [ :each |
  each class == self class
  or: [ each class == PointerExplorer
  or: [ (each isContext
  and: [ (each objectClass: each receiver) == PointerExplorer ] )
  or: [ (each pointsOnlyWeaklyTo: self object)
  ifTrue: [ weakOnlyReferences add: each. true ]
  ifFalse: [ false ] ] ] ] ].
  ^(objects replace: [ :each |
+ self class with: each name: (self nameForParent: each) model: self object ])
- self class with: each name: each identityHash asString model: self object ])
  addAll: (weakOnlyReferences replace: [ :each |
+ (self class with: each name: '(', (self nameForParent: each), ')' model: self object)
- (self class with: each name: '(', each identityHash asString, ')' model: self object)
  weakOnly: true;
  yourself ]);
  yourself!

Item was added:
+ ----- Method: PointerExplorerWrapper>>explorerStringFor: (in category 'converting') -----
+ explorerStringFor: anObject
+
+ ^ anObject identityHash asString, ': ', (super explorerStringFor: anObject).!

Item was added:
+ ----- Method: PointerExplorerWrapper>>memberNameFrom:to: (in category 'accessing') -----
+ memberNameFrom: aParent to: aChild
+
+ 1 to: aParent class instSize do: [ :instVarIndex |
+ (aParent instVarAt: instVarIndex) = aChild
+ ifTrue: [ ^ '#', (aParent class instVarNameForIndex: instVarIndex)]].
+ "This also covers arrays"
+ 1 to: aParent basicSize do: [ :index |
+ (aParent basicAt: index) = aChild
+ ifTrue: [^ index asString]].
+ ^ '???'!

Item was added:
+ ----- Method: PointerExplorerWrapper>>nameForParent: (in category 'accessing') -----
+ nameForParent: anObject
+
+ ^  self memberNameFrom: anObject to: self object!

Item was changed:
  Model subclass: #PointerFinder
+ instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex excludedObjects'
- instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Tools-Debugger'!
 
  !PointerFinder commentStamp: '<historical>' prior: 0!
  I can search for reasons why a certain object isn't garbage collected.  I'm a quick port of a VisualWorks program written by Hans-Martin Mosner.  Call me as shown below.  I'll search for a path from a global variable to the given object, presenting it in a small morphic UI.
 
  Examples:
  PointerFinder on: self currentHand
  PointerFinder on: StandardSystemView someInstance
 
  Now, let's see why this image contains more HandMorphs as expected...
 
  HandMorph allInstancesDo: [:e | PointerFinder on: e]!

Item was added:
+ ----- Method: PointerFinder class>>on:except: (in category 'instance creation') -----
+ on: anObject except: aCollection
+ ^ self new
+ goal: anObject;
+ excludedObjects: aCollection;
+ search;
+ open!

Item was changed:
  ----- Method: PointerFinder>>buildList (in category 'application') -----
  buildList
  | list obj parent object key |
  list := OrderedCollection new.
  obj := goal.
 
  [list addFirst: obj.
+ obj := parents at: obj ifAbsent: [nil].
- obj := parents at: obj ifAbsent: [].
  obj == nil] whileFalse.
  list removeFirst.
  parent := Smalltalk.
  objectList := OrderedCollection new.
  pointerList := OrderedCollection new.
  [list isEmpty]
  whileFalse:
  [object := list removeFirst.
  key := nil.
  (parent isKindOf: Dictionary)
  ifTrue: [list size >= 2
  ifTrue:
  [key := parent keyAtValue: list second ifAbsent: [].
  key == nil
  ifFalse:
  [object := list removeFirst; removeFirst.
  pointerList add: key printString , ' -> ' , object class name]]].
  key == nil
  ifTrue:
  [parent class == object ifTrue: [key := 'CLASS'].
  key == nil ifTrue: [1 to: parent class instSize do: [:i | key == nil ifTrue: [(parent instVarAt: i)
  == object ifTrue: [key := parent class instVarNameForIndex: i]]]].
  key == nil ifTrue: [parent isCompiledCode ifTrue: [key := 'literals?']].
  key == nil ifTrue: [1 to: parent basicSize do: [:i | key == nil ifTrue: [(parent basicAt: i)
  == object ifTrue: [key := i printString]]]].
  key == nil ifTrue: [(parent isMorph and: [object isKindOf: Array]) ifTrue: [key := 'submorphs?']].
  key == nil ifTrue: [key := '???'].
  pointerList add: key , ': ' , object class name, (object isMorph ifTrue: [' (', object identityHash asString, ')'] ifFalse: [ String empty ]) ].
  objectList add: object.
  parent := object]!

Item was added:
+ ----- Method: PointerFinder>>excludedObjects (in category 'accessing') -----
+ excludedObjects
+
+ ^ excludedObjects ifNil: [excludedObjects := OrderedCollection new]!

Item was added:
+ ----- Method: PointerFinder>>excludedObjects: (in category 'accessing') -----
+ excludedObjects: aCollection
+
+ excludedObjects := aCollection!

Item was changed:
  ----- Method: PointerFinder>>followObject: (in category 'application') -----
  followObject: anObject
+
+ (self excludedObjects includes: anObject)
+ ifTrue: [^ false].
  anObject outboundPointersDo: [:ea |
  (self follow: ea from: anObject)
  ifTrue: [^ true]].
  ^ false!

Item was changed:
  ----- Method: PointerFinder>>initialize (in category 'application') -----
  initialize
  parents := IdentityDictionary new: 20000.
  parents at: Smalltalk put: nil.
  parents at: Processor put: nil.
  parents at: self put: nil.
 
  toDo := OrderedCollection new: 5000.
  toDo add: Smalltalk.
+ toDoNext := OrderedCollection new: 5000.!
- toDoNext := OrderedCollection new: 5000!


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Eliot Miranda-2
Hi,

regarding

+    obj := parents at: obj ifAbsent: [nil].
-    obj := parents at: obj ifAbsent: [].

Please no.  One must know that the empty block evaluates to nil.  It is illiterate not to.  So the verbosity is bad; it implies uncertainty (“does the empty block evaluate to nil?  maybe not ‘cuz here it’s written explicitly”), it requires more typing, it’s ugly.  

Another thing one should know is that 
    e ifTrue: [s]
is the same as
    e ifTrue: [s] ifFalse: []
etc. ie, if e is false the value is nil.


_,,,^..^,,,_ (phone)

On Aug 13, 2018, at 3:25 AM, [hidden email] wrote:

A new version of Tools was added to project The Inbox:
http://source.squeak.org/inbox/Tools-LM.828.mcz

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

Name: Tools-LM.828
Author: LM
Time: 13 August 2018, 1:25:54.504807 pm
UUID: 061511ca-729a-ce43-a08c-8057c24f7406
Ancestors: Tools-tcj.827

Added the ability to exclude specific objects from the  PointerFinder.
Improved the Explorer's "chase pointers" context menu to exclude the Explorer itself from the search (includes some meta-programming, not ideal, but certainly better than previously, ideas for improvement appreciated).
Changed the way the PointerExplorer displays references, it now states the associations name on the left, and the Objects hash is moved to the right, together with the objects displayString.
These changes make it much easier to understand how the objects are associated with each other and should make it easier to track down memory leaks.

=============== Diff against Tools-tcj.827 ===============

Item was changed:
 ----- Method: Inspector>>chasePointers (in category 'menu commands') -----
 chasePointers
     | selected  saved |
     self selectionIndex = 0 ifTrue: [^ self changed: #flash].
     selected := self selection.
     saved := self object.
     [self object: nil.
     (Smalltalk includesKey: #PointerFinder)
         ifTrue: [PointerFinder on: selected]
         ifFalse: [self inspectPointers]]
         ensure: [self object: saved]!

Item was changed:
 ----- Method: ObjectExplorer>>chasePointersForSelection (in category 'menus - actions') -----
 chasePointersForSelection
     
+    PointerFinder on: self object except: {self}, ObjectExplorerWrapper allInstances!
-    self flag: #tooMany. "mt: Note that we might want to ignore references caused by this tool."
-    self object chasePointers.!

Item was changed:
 ----- Method: PointerExplorer>>rootObject: (in category 'accessing') -----
 rootObject: anObject

+    self root key: 'root'.
-    self root key: anObject identityHash asString.
     super rootObject: anObject.!

Item was changed:
 ----- Method: PointerExplorerWrapper>>contents (in category 'accessing') -----
 contents
     "Return the wrappers with the objects holding references to item. Eldest objects come first, weak only referencers are at the end and have parentheses around their identity hash."

     | objects weakOnlyReferences |
     objects := self object inboundPointersExcluding: { self. self item. model }.
     weakOnlyReferences := OrderedCollection new.
     objects removeAllSuchThat: [ :each |
         each class == self class
             or: [ each class == PointerExplorer
             or: [ (each isContext
                 and: [ (each objectClass: each receiver) == PointerExplorer ] )
             or: [ (each pointsOnlyWeaklyTo: self object)
                 ifTrue: [ weakOnlyReferences add: each. true ]
                 ifFalse: [ false ] ] ] ] ].
      ^(objects replace: [ :each |    
+        self class with: each name: (self nameForParent: each) model: self object ])
-        self class with: each name: each identityHash asString model: self object ])
         addAll: (weakOnlyReferences replace: [ :each |
+            (self class with: each name: '(', (self nameForParent: each), ')' model: self object)
-            (self class with: each name: '(', each identityHash asString, ')' model: self object)
                 weakOnly: true;
                 yourself ]);
         yourself!

Item was added:
+ ----- Method: PointerExplorerWrapper>>explorerStringFor: (in category 'converting') -----
+ explorerStringFor: anObject
+
+    ^ anObject identityHash asString, ': ', (super explorerStringFor: anObject).!

Item was added:
+ ----- Method: PointerExplorerWrapper>>memberNameFrom:to: (in category 'accessing') -----
+ memberNameFrom: aParent to: aChild
+
+    1 to: aParent class instSize do: [ :instVarIndex |
+        (aParent instVarAt: instVarIndex) = aChild
+            ifTrue: [ ^ '#', (aParent class instVarNameForIndex: instVarIndex)]].
+    "This also covers arrays"
+    1 to: aParent basicSize do: [ :index |
+        (aParent basicAt: index) = aChild
+            ifTrue: [^ index asString]].
+    ^ '???'!

Item was added:
+ ----- Method: PointerExplorerWrapper>>nameForParent: (in category 'accessing') -----
+ nameForParent: anObject
+
+    ^  self memberNameFrom: anObject to: self object!

Item was changed:
 Model subclass: #PointerFinder
+    instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex excludedObjects'
-    instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex'
     classVariableNames: ''
     poolDictionaries: ''
     category: 'Tools-Debugger'!

 !PointerFinder commentStamp: '<historical>' prior: 0!
 I can search for reasons why a certain object isn't garbage collected.  I'm a quick port of a VisualWorks program written by Hans-Martin Mosner.  Call me as shown below.  I'll search for a path from a global variable to the given object, presenting it in a small morphic UI.

 Examples:
     PointerFinder on: self currentHand
     PointerFinder on: StandardSystemView someInstance

 Now, let's see why this image contains more HandMorphs as expected...

 HandMorph allInstancesDo: [:e | PointerFinder on: e]!

Item was added:
+ ----- Method: PointerFinder class>>on:except: (in category 'instance creation') -----
+ on: anObject except: aCollection
+    ^ self new
+        goal: anObject;
+        excludedObjects: aCollection;
+        search;
+        open!

Item was changed:
 ----- Method: PointerFinder>>buildList (in category 'application') -----
 buildList
     | list obj parent object key |
     list := OrderedCollection new.
     obj := goal.
     
     [list addFirst: obj.
+    obj := parents at: obj ifAbsent: [nil].
-    obj := parents at: obj ifAbsent: [].
     obj == nil] whileFalse.
     list removeFirst.
     parent := Smalltalk.
     objectList := OrderedCollection new.
     pointerList := OrderedCollection new.
     [list isEmpty]
         whileFalse:
             [object := list removeFirst.
             key := nil.
             (parent isKindOf: Dictionary)
                 ifTrue: [list size >= 2
                         ifTrue:
                             [key := parent keyAtValue: list second ifAbsent: [].
                             key == nil
                                 ifFalse:
                                     [object := list removeFirst; removeFirst.
                                     pointerList add: key printString , ' -> ' , object class name]]].
             key == nil
                 ifTrue:
                     [parent class == object ifTrue: [key := 'CLASS'].
                     key == nil ifTrue: [1 to: parent class instSize do: [:i | key == nil ifTrue: [(parent instVarAt: i)
                                     == object ifTrue: [key := parent class instVarNameForIndex: i]]]].
                     key == nil ifTrue: [parent isCompiledCode ifTrue: [key := 'literals?']].
                     key == nil ifTrue: [1 to: parent basicSize do: [:i | key == nil ifTrue: [(parent basicAt: i)
                                     == object ifTrue: [key := i printString]]]].
                     key == nil ifTrue: [(parent isMorph and: [object isKindOf: Array]) ifTrue: [key := 'submorphs?']].
                     key == nil ifTrue: [key := '???'].
                     pointerList add: key , ': ' , object class name, (object isMorph ifTrue: [' (', object identityHash asString, ')'] ifFalse: [ String empty ]) ].
             objectList add: object.
             parent := object]!

Item was added:
+ ----- Method: PointerFinder>>excludedObjects (in category 'accessing') -----
+ excludedObjects
+
+    ^ excludedObjects ifNil: [excludedObjects := OrderedCollection new]!

Item was added:
+ ----- Method: PointerFinder>>excludedObjects: (in category 'accessing') -----
+ excludedObjects: aCollection
+
+    excludedObjects := aCollection!

Item was changed:
 ----- Method: PointerFinder>>followObject: (in category 'application') -----
 followObject: anObject
+
+    (self excludedObjects includes: anObject)
+        ifTrue: [^ false].
     anObject outboundPointersDo: [:ea |
         (self follow: ea from: anObject)
             ifTrue: [^ true]].
     ^ false!

Item was changed:
 ----- Method: PointerFinder>>initialize (in category 'application') -----
 initialize
     parents := IdentityDictionary new: 20000.
     parents at: Smalltalk put: nil.
     parents at: Processor put: nil.
     parents at: self put: nil.

     toDo := OrderedCollection new: 5000.
     toDo add: Smalltalk.
+    toDoNext := OrderedCollection new: 5000.!
-    toDoNext := OrderedCollection new: 5000!




Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Tobias Pape
Hey

> On 14.08.2018, at 04:59, Eliot Miranda <[hidden email]> wrote:
>
> Hi,
>
> regarding
>
>> +    obj := parents at: obj ifAbsent: [nil].
>> -    obj := parents at: obj ifAbsent: [].
>
> Please no.  One must know that the empty block evaluates to nil.  It is illiterate not to.  So the verbosity is bad; it implies uncertainty (“does the empty block evaluate to nil?  maybe not ‘cuz here it’s written explicitly”), it requires more typing, it’s ugly.  
>
Oh come on :D
If I ask my students that have at least one year of Squeak experience, less than 5% would know that [] evaluates to nil.
Also, I think it is really better to be explicit and say "I want nil when there is nothing in there".

I'd even rather say to forbid [] :P ;)


> Another thing one should know is that
>     e ifTrue: [s]
> is the same as
>     e ifTrue: [s] ifFalse: []
> etc. ie, if e is false the value is nil.
>

You know that I did not know that five years in into using Squeak (that is when I started implementing for my master's thesis)?
It's only obvious in hindsight. I had rather expected to

        e ifTrue: [s]  ===> false OR s

Which is an equally sensible variant.

I don't want wo argue that things are bad. but let's not go down that road and say One Must Know That ... :)


best regards
        -tobi


>
> _,,,^..^,,,_ (phone)
>
> On Aug 13, 2018, at 3:25 AM, [hidden email] wrote:
>
>> A new version of Tools was added to project The Inbox:
>> http://source.squeak.org/inbox/Tools-LM.828.mcz
>>
>> ==================== Summary ====================
>>
>> Name: Tools-LM.828
>> Author: LM
>> Time: 13 August 2018, 1:25:54.504807 pm
>> UUID: 061511ca-729a-ce43-a08c-8057c24f7406
>> Ancestors: Tools-tcj.827
>>
>> Added the ability to exclude specific objects from the  PointerFinder.
>> Improved the Explorer's "chase pointers" context menu to exclude the Explorer itself from the search (includes some meta-programming, not ideal, but certainly better than previously, ideas for improvement appreciated).
>> Changed the way the PointerExplorer displays references, it now states the associations name on the left, and the Objects hash is moved to the right, together with the objects displayString.
>> These changes make it much easier to understand how the objects are associated with each other and should make it easier to track down memory leaks.
>>
>> =============== Diff against Tools-tcj.827 ===============
>>
>> Item was changed:
>>  ----- Method: Inspector>>chasePointers (in category 'menu commands') -----
>>  chasePointers
>>      | selected  saved |
>>      self selectionIndex = 0 ifTrue: [^ self changed: #flash].
>>      selected := self selection.
>>      saved := self object.
>>      [self object: nil.
>>      (Smalltalk includesKey: #PointerFinder)
>>          ifTrue: [PointerFinder on: selected]
>>          ifFalse: [self inspectPointers]]
>>          ensure: [self object: saved]!
>>
>> Item was changed:
>>  ----- Method: ObjectExplorer>>chasePointersForSelection (in category 'menus - actions') -----
>>  chasePointersForSelection
>>      
>> +    PointerFinder on: self object except: {self}, ObjectExplorerWrapper allInstances!
>> -    self flag: #tooMany. "mt: Note that we might want to ignore references caused by this tool."
>> -    self object chasePointers.!
>>
>> Item was changed:
>>  ----- Method: PointerExplorer>>rootObject: (in category 'accessing') -----
>>  rootObject: anObject
>>
>> +    self root key: 'root'.
>> -    self root key: anObject identityHash asString.
>>      super rootObject: anObject.!
>>
>> Item was changed:
>>  ----- Method: PointerExplorerWrapper>>contents (in category 'accessing') -----
>>  contents
>>      "Return the wrappers with the objects holding references to item. Eldest objects come first, weak only referencers are at the end and have parentheses around their identity hash."
>>
>>      | objects weakOnlyReferences |
>>      objects := self object inboundPointersExcluding: { self. self item. model }.
>>      weakOnlyReferences := OrderedCollection new.
>>      objects removeAllSuchThat: [ :each |
>>          each class == self class
>>              or: [ each class == PointerExplorer
>>              or: [ (each isContext
>>                  and: [ (each objectClass: each receiver) == PointerExplorer ] )
>>              or: [ (each pointsOnlyWeaklyTo: self object)
>>                  ifTrue: [ weakOnlyReferences add: each. true ]
>>                  ifFalse: [ false ] ] ] ] ].
>>       ^(objects replace: [ :each |    
>> +        self class with: each name: (self nameForParent: each) model: self object ])
>> -        self class with: each name: each identityHash asString model: self object ])
>>          addAll: (weakOnlyReferences replace: [ :each |
>> +            (self class with: each name: '(', (self nameForParent: each), ')' model: self object)
>> -            (self class with: each name: '(', each identityHash asString, ')' model: self object)
>>                  weakOnly: true;
>>                  yourself ]);
>>          yourself!
>>
>> Item was added:
>> + ----- Method: PointerExplorerWrapper>>explorerStringFor: (in category 'converting') -----
>> + explorerStringFor: anObject
>> +
>> +    ^ anObject identityHash asString, ': ', (super explorerStringFor: anObject).!
>>
>> Item was added:
>> + ----- Method: PointerExplorerWrapper>>memberNameFrom:to: (in category 'accessing') -----
>> + memberNameFrom: aParent to: aChild
>> +
>> +    1 to: aParent class instSize do: [ :instVarIndex |
>> +        (aParent instVarAt: instVarIndex) = aChild
>> +            ifTrue: [ ^ '#', (aParent class instVarNameForIndex: instVarIndex)]].
>> +    "This also covers arrays"
>> +    1 to: aParent basicSize do: [ :index |
>> +        (aParent basicAt: index) = aChild
>> +            ifTrue: [^ index asString]].
>> +    ^ '???'!
>>
>> Item was added:
>> + ----- Method: PointerExplorerWrapper>>nameForParent: (in category 'accessing') -----
>> + nameForParent: anObject
>> +
>> +    ^  self memberNameFrom: anObject to: self object!
>>
>> Item was changed:
>>  Model subclass: #PointerFinder
>> +    instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex excludedObjects'
>> -    instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex'
>>      classVariableNames: ''
>>      poolDictionaries: ''
>>      category: 'Tools-Debugger'!
>>
>>  !PointerFinder commentStamp: '<historical>' prior: 0!
>>  I can search for reasons why a certain object isn't garbage collected.  I'm a quick port of a VisualWorks program written by Hans-Martin Mosner.  Call me as shown below.  I'll search for a path from a global variable to the given object, presenting it in a small morphic UI.
>>
>>  Examples:
>>      PointerFinder on: self currentHand
>>      PointerFinder on: StandardSystemView someInstance
>>
>>  Now, let's see why this image contains more HandMorphs as expected...
>>
>>  HandMorph allInstancesDo: [:e | PointerFinder on: e]!
>>
>> Item was added:
>> + ----- Method: PointerFinder class>>on:except: (in category 'instance creation') -----
>> + on: anObject except: aCollection
>> +    ^ self new
>> +        goal: anObject;
>> +        excludedObjects: aCollection;
>> +        search;
>> +        open!
>>
>> Item was changed:
>>  ----- Method: PointerFinder>>buildList (in category 'application') -----
>>  buildList
>>      | list obj parent object key |
>>      list := OrderedCollection new.
>>      obj := goal.
>>      
>>      [list addFirst: obj.
>> +    obj := parents at: obj ifAbsent: [nil].
>> -    obj := parents at: obj ifAbsent: [].
>>      obj == nil] whileFalse.
>>      list removeFirst.
>>      parent := Smalltalk.
>>      objectList := OrderedCollection new.
>>      pointerList := OrderedCollection new.
>>      [list isEmpty]
>>          whileFalse:
>>              [object := list removeFirst.
>>              key := nil.
>>              (parent isKindOf: Dictionary)
>>                  ifTrue: [list size >= 2
>>                          ifTrue:
>>                              [key := parent keyAtValue: list second ifAbsent: [].
>>                              key == nil
>>                                  ifFalse:
>>                                      [object := list removeFirst; removeFirst.
>>                                      pointerList add: key printString , ' -> ' , object class name]]].
>>              key == nil
>>                  ifTrue:
>>                      [parent class == object ifTrue: [key := 'CLASS'].
>>                      key == nil ifTrue: [1 to: parent class instSize do: [:i | key == nil ifTrue: [(parent instVarAt: i)
>>                                      == object ifTrue: [key := parent class instVarNameForIndex: i]]]].
>>                      key == nil ifTrue: [parent isCompiledCode ifTrue: [key := 'literals?']].
>>                      key == nil ifTrue: [1 to: parent basicSize do: [:i | key == nil ifTrue: [(parent basicAt: i)
>>                                      == object ifTrue: [key := i printString]]]].
>>                      key == nil ifTrue: [(parent isMorph and: [object isKindOf: Array]) ifTrue: [key := 'submorphs?']].
>>                      key == nil ifTrue: [key := '???'].
>>                      pointerList add: key , ': ' , object class name, (object isMorph ifTrue: [' (', object identityHash asString, ')'] ifFalse: [ String empty ]) ].
>>              objectList add: object.
>>              parent := object]!
>>
>> Item was added:
>> + ----- Method: PointerFinder>>excludedObjects (in category 'accessing') -----
>> + excludedObjects
>> +
>> +    ^ excludedObjects ifNil: [excludedObjects := OrderedCollection new]!
>>
>> Item was added:
>> + ----- Method: PointerFinder>>excludedObjects: (in category 'accessing') -----
>> + excludedObjects: aCollection
>> +
>> +    excludedObjects := aCollection!
>>
>> Item was changed:
>>  ----- Method: PointerFinder>>followObject: (in category 'application') -----
>>  followObject: anObject
>> +
>> +    (self excludedObjects includes: anObject)
>> +        ifTrue: [^ false].
>>      anObject outboundPointersDo: [:ea |
>>          (self follow: ea from: anObject)
>>              ifTrue: [^ true]].
>>      ^ false!
>>
>> Item was changed:
>>  ----- Method: PointerFinder>>initialize (in category 'application') -----
>>  initialize
>>      parents := IdentityDictionary new: 20000.
>>      parents at: Smalltalk put: nil.
>>      parents at: Processor put: nil.
>>      parents at: self put: nil.
>>
>>      toDo := OrderedCollection new: 5000.
>>      toDo add: Smalltalk.
>> +    toDoNext := OrderedCollection new: 5000.!
>> -    toDoNext := OrderedCollection new: 5000!
>>
>>
>


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Eliot Miranda-2
Hi Tobias,

> On Aug 13, 2018, at 11:43 PM, Tobias Pape <[hidden email]> wrote:
>
> Hey
>
>> On 14.08.2018, at 04:59, Eliot Miranda <[hidden email]> wrote:
>>
>> Hi,
>>
>> regarding
>>
>>> +    obj := parents at: obj ifAbsent: [nil].
>>> -    obj := parents at: obj ifAbsent: [].
>>
>> Please no.  One must know that the empty block evaluates to nil.  It is illiterate not to.  So the verbosity is bad; it implies uncertainty (“does the empty block evaluate to nil?  maybe not ‘cuz here it’s written explicitly”), it requires more typing, it’s ugly.  
>>
> Oh come on :D
> If I ask my students that have at least one year of Squeak experience, less than 5% would know that [] evaluates to nil.
> Also, I think it is really better to be explicit and say "I want nil when there is nothing in there".
>
> I'd even rather say to forbid [] :P ;)

That way leads to American English...or Newspeak (Orwell) ;-)

Seriously, there is a flaw in the teaching if your figures are right.  Literacy is important.  Brevity is important. Idiom is important.  And knowing what the basic elements of the language are is important.  That [] value == nil is true is important.

>> Another thing one should know is that
>>    e ifTrue: [s]
>> is the same as
>>    e ifTrue: [s] ifFalse: []
>> etc. ie, if e is false the value is nil.
>>
>
> You know that I did not know that five years in into using Squeak (that is when I started implementing for my master's thesis)?

Did you never read the definitions for ifTrue: and ifFalse: ?

> It's only obvious in hindsight. I had rather expected to
>
>    e ifTrue: [s]  ===> false OR s
>
> Which is an equally sensible variant.
>
> I don't want wo argue that things are bad. but let's not go down that road and say One Must Know That ... :)

But yes, one /should/ know that.  The core classes should be read.  If you want to raise a generation of JavaScripters then sure, ignore literacy.  But if you want to raise a generation that can appreciate great, carefully considered design, educate them to think and to read and write well.  Everything else is Ebonics and the Prussian Model.

>
>
> best regards
>    -tobi
>
>
>>
>> _,,,^..^,,,_ (phone)
>>
>>> On Aug 13, 2018, at 3:25 AM, [hidden email] wrote:
>>>
>>> A new version of Tools was added to project The Inbox:
>>> http://source.squeak.org/inbox/Tools-LM.828.mcz
>>>
>>> ==================== Summary ====================
>>>
>>> Name: Tools-LM.828
>>> Author: LM
>>> Time: 13 August 2018, 1:25:54.504807 pm
>>> UUID: 061511ca-729a-ce43-a08c-8057c24f7406
>>> Ancestors: Tools-tcj.827
>>>
>>> Added the ability to exclude specific objects from the  PointerFinder.
>>> Improved the Explorer's "chase pointers" context menu to exclude the Explorer itself from the search (includes some meta-programming, not ideal, but certainly better than previously, ideas for improvement appreciated).
>>> Changed the way the PointerExplorer displays references, it now states the associations name on the left, and the Objects hash is moved to the right, together with the objects displayString.
>>> These changes make it much easier to understand how the objects are associated with each other and should make it easier to track down memory leaks.
>>>
>>> =============== Diff against Tools-tcj.827 ===============
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>chasePointers (in category 'menu commands') -----
>>> chasePointers
>>>     | selected  saved |
>>>     self selectionIndex = 0 ifTrue: [^ self changed: #flash].
>>>     selected := self selection.
>>>     saved := self object.
>>>     [self object: nil.
>>>     (Smalltalk includesKey: #PointerFinder)
>>>         ifTrue: [PointerFinder on: selected]
>>>         ifFalse: [self inspectPointers]]
>>>         ensure: [self object: saved]!
>>>
>>> Item was changed:
>>> ----- Method: ObjectExplorer>>chasePointersForSelection (in category 'menus - actions') -----
>>> chasePointersForSelection
>>>
>>> +    PointerFinder on: self object except: {self}, ObjectExplorerWrapper allInstances!
>>> -    self flag: #tooMany. "mt: Note that we might want to ignore references caused by this tool."
>>> -    self object chasePointers.!
>>>
>>> Item was changed:
>>> ----- Method: PointerExplorer>>rootObject: (in category 'accessing') -----
>>> rootObject: anObject
>>>
>>> +    self root key: 'root'.
>>> -    self root key: anObject identityHash asString.
>>>     super rootObject: anObject.!
>>>
>>> Item was changed:
>>> ----- Method: PointerExplorerWrapper>>contents (in category 'accessing') -----
>>> contents
>>>     "Return the wrappers with the objects holding references to item. Eldest objects come first, weak only referencers are at the end and have parentheses around their identity hash."
>>>
>>>     | objects weakOnlyReferences |
>>>     objects := self object inboundPointersExcluding: { self. self item. model }.
>>>     weakOnlyReferences := OrderedCollection new.
>>>     objects removeAllSuchThat: [ :each |
>>>         each class == self class
>>>             or: [ each class == PointerExplorer
>>>             or: [ (each isContext
>>>                 and: [ (each objectClass: each receiver) == PointerExplorer ] )
>>>             or: [ (each pointsOnlyWeaklyTo: self object)
>>>                 ifTrue: [ weakOnlyReferences add: each. true ]
>>>                 ifFalse: [ false ] ] ] ] ].
>>>      ^(objects replace: [ :each |    
>>> +        self class with: each name: (self nameForParent: each) model: self object ])
>>> -        self class with: each name: each identityHash asString model: self object ])
>>>         addAll: (weakOnlyReferences replace: [ :each |
>>> +            (self class with: each name: '(', (self nameForParent: each), ')' model: self object)
>>> -            (self class with: each name: '(', each identityHash asString, ')' model: self object)
>>>                 weakOnly: true;
>>>                 yourself ]);
>>>         yourself!
>>>
>>> Item was added:
>>> + ----- Method: PointerExplorerWrapper>>explorerStringFor: (in category 'converting') -----
>>> + explorerStringFor: anObject
>>> +
>>> +    ^ anObject identityHash asString, ': ', (super explorerStringFor: anObject).!
>>>
>>> Item was added:
>>> + ----- Method: PointerExplorerWrapper>>memberNameFrom:to: (in category 'accessing') -----
>>> + memberNameFrom: aParent to: aChild
>>> +
>>> +    1 to: aParent class instSize do: [ :instVarIndex |
>>> +        (aParent instVarAt: instVarIndex) = aChild
>>> +            ifTrue: [ ^ '#', (aParent class instVarNameForIndex: instVarIndex)]].
>>> +    "This also covers arrays"
>>> +    1 to: aParent basicSize do: [ :index |
>>> +        (aParent basicAt: index) = aChild
>>> +            ifTrue: [^ index asString]].
>>> +    ^ '???'!
>>>
>>> Item was added:
>>> + ----- Method: PointerExplorerWrapper>>nameForParent: (in category 'accessing') -----
>>> + nameForParent: anObject
>>> +
>>> +    ^  self memberNameFrom: anObject to: self object!
>>>
>>> Item was changed:
>>> Model subclass: #PointerFinder
>>> +    instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex excludedObjects'
>>> -    instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex'
>>>     classVariableNames: ''
>>>     poolDictionaries: ''
>>>     category: 'Tools-Debugger'!
>>>
>>> !PointerFinder commentStamp: '<historical>' prior: 0!
>>> I can search for reasons why a certain object isn't garbage collected.  I'm a quick port of a VisualWorks program written by Hans-Martin Mosner.  Call me as shown below.  I'll search for a path from a global variable to the given object, presenting it in a small morphic UI.
>>>
>>> Examples:
>>>     PointerFinder on: self currentHand
>>>     PointerFinder on: StandardSystemView someInstance
>>>
>>> Now, let's see why this image contains more HandMorphs as expected...
>>>
>>> HandMorph allInstancesDo: [:e | PointerFinder on: e]!
>>>
>>> Item was added:
>>> + ----- Method: PointerFinder class>>on:except: (in category 'instance creation') -----
>>> + on: anObject except: aCollection
>>> +    ^ self new
>>> +        goal: anObject;
>>> +        excludedObjects: aCollection;
>>> +        search;
>>> +        open!
>>>
>>> Item was changed:
>>> ----- Method: PointerFinder>>buildList (in category 'application') -----
>>> buildList
>>>     | list obj parent object key |
>>>     list := OrderedCollection new.
>>>     obj := goal.
>>>
>>>     [list addFirst: obj.
>>> +    obj := parents at: obj ifAbsent: [nil].
>>> -    obj := parents at: obj ifAbsent: [].
>>>     obj == nil] whileFalse.
>>>     list removeFirst.
>>>     parent := Smalltalk.
>>>     objectList := OrderedCollection new.
>>>     pointerList := OrderedCollection new.
>>>     [list isEmpty]
>>>         whileFalse:
>>>             [object := list removeFirst.
>>>             key := nil.
>>>             (parent isKindOf: Dictionary)
>>>                 ifTrue: [list size >= 2
>>>                         ifTrue:
>>>                             [key := parent keyAtValue: list second ifAbsent: [].
>>>                             key == nil
>>>                                 ifFalse:
>>>                                     [object := list removeFirst; removeFirst.
>>>                                     pointerList add: key printString , ' -> ' , object class name]]].
>>>             key == nil
>>>                 ifTrue:
>>>                     [parent class == object ifTrue: [key := 'CLASS'].
>>>                     key == nil ifTrue: [1 to: parent class instSize do: [:i | key == nil ifTrue: [(parent instVarAt: i)
>>>                                     == object ifTrue: [key := parent class instVarNameForIndex: i]]]].
>>>                     key == nil ifTrue: [parent isCompiledCode ifTrue: [key := 'literals?']].
>>>                     key == nil ifTrue: [1 to: parent basicSize do: [:i | key == nil ifTrue: [(parent basicAt: i)
>>>                                     == object ifTrue: [key := i printString]]]].
>>>                     key == nil ifTrue: [(parent isMorph and: [object isKindOf: Array]) ifTrue: [key := 'submorphs?']].
>>>                     key == nil ifTrue: [key := '???'].
>>>                     pointerList add: key , ': ' , object class name, (object isMorph ifTrue: [' (', object identityHash asString, ')'] ifFalse: [ String empty ]) ].
>>>             objectList add: object.
>>>             parent := object]!
>>>
>>> Item was added:
>>> + ----- Method: PointerFinder>>excludedObjects (in category 'accessing') -----
>>> + excludedObjects
>>> +
>>> +    ^ excludedObjects ifNil: [excludedObjects := OrderedCollection new]!
>>>
>>> Item was added:
>>> + ----- Method: PointerFinder>>excludedObjects: (in category 'accessing') -----
>>> + excludedObjects: aCollection
>>> +
>>> +    excludedObjects := aCollection!
>>>
>>> Item was changed:
>>> ----- Method: PointerFinder>>followObject: (in category 'application') -----
>>> followObject: anObject
>>> +
>>> +    (self excludedObjects includes: anObject)
>>> +        ifTrue: [^ false].
>>>     anObject outboundPointersDo: [:ea |
>>>         (self follow: ea from: anObject)
>>>             ifTrue: [^ true]].
>>>     ^ false!
>>>
>>> Item was changed:
>>> ----- Method: PointerFinder>>initialize (in category 'application') -----
>>> initialize
>>>     parents := IdentityDictionary new: 20000.
>>>     parents at: Smalltalk put: nil.
>>>     parents at: Processor put: nil.
>>>     parents at: self put: nil.
>>>
>>>     toDo := OrderedCollection new: 5000.
>>>     toDo add: Smalltalk.
>>> +    toDoNext := OrderedCollection new: 5000.!
>>> -    toDoNext := OrderedCollection new: 5000!
>>>
>>>
>>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Leon Matthes
In the interest of full disclosure, I should probably first tell you, that I
am the original author of the commit and I actually am one of Tobias
students and are now at about one year of squeak/smalltalk experience and up
until a few days ago fell right in the middle of the 95% of students who
didn't know for certain that [] == nil is true.


Eliot Miranda-2 wrote
> That way leads to American English...or Newspeak (Orwell) ;-)
>
> Seriously, there is a flaw in the teaching if your figures are right.
> Literacy is important.  Brevity is important. Idiom is important.  And
> knowing what the basic elements of the language are is important.  That []
> value == nil is true is important.

I was very likely once taught that [] == nil is true, but it is just
something that comes up so rarely, that I just forgot about it.
I did actually check the implementation to make sure, it is true, as I
suspected, but because it is important for the algorithm in question I
wanted to make sure everyone can understand the code, even if they don't
have much experience with smalltalk. In my personal opinion, easy
understandability, even by newcomers is more important than brevity, because
otherwise you will just scare people away from the language, if you first
need to study it for years on end before you can sufficiently read it.
If brevity is important to you however, I would suggest a middle ground of
"obj := parents at: obj ifAbsent: nil" as a compromise.
nil is just one more character than [], but more clearly represents the
intent.
But this solution is indeed less idiomatic, therefore I'm not really
satisfied with it either, I would like to hear someone else's stance on it
however.


Eliot Miranda-2 wrote

>>> Another thing one should know is that
>>>    e ifTrue: [s]
>>> is the same as
>>>    e ifTrue: [s] ifFalse: []
>>> etc. ie, if e is false the value is nil.
>>>
>>
>> You know that I did not know that five years in into using Squeak (that
>> is when I started implementing for my master's thesis)?
>
> Did you never read the definitions for ifTrue: and ifFalse: ?

I did read them in my first few weeks of study and was amazed that you could
actually look into the definitions of such primitive procedures but again,
its just something thats almost never important, and therefore not
necessarily something to actively remember.


Eliot Miranda-2 wrote

>> It's only obvious in hindsight. I had rather expected to
>>
>>    e ifTrue: [s]  ===> false OR s
>>
>> Which is an equally sensible variant.
>>
>> I don't want wo argue that things are bad. but let's not go down that
>> road and say One Must Know That ... :)
>
> But yes, one /should/ know that.  The core classes should be read.  If you
> want to raise a generation of JavaScripters then sure, ignore literacy.
> But if you want to raise a generation that can appreciate great, carefully
> considered design, educate them to think and to read and write well.
> Everything else is Ebonics and the Prussian Model.

Again, one probably should know that, if one is a long time smalltalk
developer but there are always people that don't. Maybe its because they
just started squeak/smalltalk, or never got around to reading those few
particular methods. In any case, I think we should always include the people
that don't know every nook and cranny of the language they are working with,
because otherwise we would neglect new programmers, who are just so very
important for the health of a language.

I would be interested though why you think extreme brevity is so crucially
important, because I often don't see the use of it, except that its a little
less typing, so maybe I'm missing the point here.

I would also appreciate feedback on this small piece of code:
    + PointerFinder on: self object except: {self}, ObjectExplorerWrapper
allInstances!
    - self flag: #tooMany. "mt: Note that we might want to ignore references
caused by this tool."
    - self object chasePointers.!
I really don't like the use of allInstances in this case, but I didn' see a
better way to find the ObjectExplorerWrappers that might hog references to
the Object in question.

Kind regards,
Leon



--
Sent from: http://forum.world.st/Squeak-Dev-f45488.html

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Florin Mateoc-4
On 8/14/2018 4:52 AM, Leon Matthes wrote:

> In the interest of full disclosure, I should probably first tell you, that I
> am the original author of the commit and I actually am one of Tobias
> students and are now at about one year of squeak/smalltalk experience and up
> until a few days ago fell right in the middle of the 95% of students who
> didn't know for certain that [] == nil is true.
>
>
> Eliot Miranda-2 wrote
>> That way leads to American English...or Newspeak (Orwell) ;-)
>>
>> Seriously, there is a flaw in the teaching if your figures are right.
>> Literacy is important.  Brevity is important. Idiom is important.  And
>> knowing what the basic elements of the language are is important.  That []
>> value == nil is true is important.
> I was very likely once taught that [] == nil is true, but it is just
> something that comes up so rarely, that I just forgot about it.
> I did actually check the implementation to make sure, it is true, as I
> suspected, but because it is important for the algorithm in question I
> wanted to make sure everyone can understand the code, even if they don't
> have much experience with smalltalk. In my personal opinion, easy
> understandability, even by newcomers is more important than brevity, because
> otherwise you will just scare people away from the language, if you first
> need to study it for years on end before you can sufficiently read it.
> If brevity is important to you however, I would suggest a middle ground of
> "obj := parents at: obj ifAbsent: nil" as a compromise.
> nil is just one more character than [], but more clearly represents the
> intent.
> But this solution is indeed less idiomatic, therefore I'm not really
> satisfied with it either, I would like to hear someone else's stance on it
> however.
>
>
> Eliot Miranda-2 wrote
>>>> Another thing one should know is that
>>>>    e ifTrue: [s]
>>>> is the same as
>>>>    e ifTrue: [s] ifFalse: []
>>>> etc. ie, if e is false the value is nil.
>>>>
>>> You know that I did not know that five years in into using Squeak (that
>>> is when I started implementing for my master's thesis)?
>> Did you never read the definitions for ifTrue: and ifFalse: ?
> I did read them in my first few weeks of study and was amazed that you could
> actually look into the definitions of such primitive procedures but again,
> its just something thats almost never important, and therefore not
> necessarily something to actively remember.
>
>
> Eliot Miranda-2 wrote
>>> It's only obvious in hindsight. I had rather expected to
>>>
>>>    e ifTrue: [s]  ===> false OR s
>>>
>>> Which is an equally sensible variant.
>>>
>>> I don't want wo argue that things are bad. but let's not go down that
>>> road and say One Must Know That ... :)
>> But yes, one /should/ know that.  The core classes should be read.  If you
>> want to raise a generation of JavaScripters then sure, ignore literacy.
>> But if you want to raise a generation that can appreciate great, carefully
>> considered design, educate them to think and to read and write well.
>> Everything else is Ebonics and the Prussian Model.
> Again, one probably should know that, if one is a long time smalltalk
> developer but there are always people that don't. Maybe its because they
> just started squeak/smalltalk, or never got around to reading those few
> particular methods. In any case, I think we should always include the people
> that don't know every nook and cranny of the language they are working with,
> because otherwise we would neglect new programmers, who are just so very
> important for the health of a language.
>
> I would be interested though why you think extreme brevity is so crucially
> important, because I often don't see the use of it, except that its a little
> less typing, so maybe I'm missing the point here.
>
> I would also appreciate feedback on this small piece of code:
>     + PointerFinder on: self object except: {self}, ObjectExplorerWrapper
> allInstances!
>     - self flag: #tooMany. "mt: Note that we might want to ignore references
> caused by this tool."
>     - self object chasePointers.!
> I really don't like the use of allInstances in this case, but I didn' see a
> better way to find the ObjectExplorerWrappers that might hog references to
> the Object in question.


Why don't you like the use of allInstances in this case? finding all references belongs to the same kind of meta
programming activities as finding all instances, so if there is a case where allInstances should be used, it is exactly
something like this

Regarding the previous issues discussed, I agree that #ifTrue: is not obvious. More than that, I have seen many bugs
caused by people not realizing that it would sometimes return nil, even if the block would always return something
notNil. So I would argue against brevity in this instance, I think

    e ifTrue: [s] ifFalse: []

would avoid these kinds of errors, so I would prefer it.


But I would also argue against [nil]. It is true that Smalltalk was meant to be very readable and approachable, not just
by beginners but by children, and it is not an accident that it reads so much like "normal" English.

Still, blocks are not English-like, they are one of the constructs that do need to be learned. And I have never seen
bugs caused by ifAbsent: []. If it is not obvious what ifAbsent: [] does, the reader would be driven towards looking at
what an empty block returns, and they would learn it at that [point, as they should, even if they did not remember it
initially from when it was taught.


> Kind regards,
> Leon
>
>
>
> --
> Sent from: http://forum.world.st/Squeak-Dev-f45488.html
>


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Eliot Miranda-2
In reply to this post by Leon Matthes
Hi Leon,

> On Aug 14, 2018, at 1:52 AM, Leon Matthes <[hidden email]> wrote:
>
> In the interest of full disclosure, I should probably first tell you, that I
> am the original author of the commit and I actually am one of Tobias
> students and are now at about one year of squeak/smalltalk experience and up
> until a few days ago fell right in the middle of the 95% of students who
> didn't know for certain that [] == nil is true.

I do not mean this as a personal attack.  You are clearly a strong programmer and I am grateful for your participation and contributions.  I hope that you will see my critique of one tiny part of a valuable commit as a plea to avoid a slippery slope, not an attack in your abilities.  You have proven your abilities.  My concern for where the slope leads is speculative and perhaps I am wrong, but I think my concern is valid.  I hope to persuade you below.

> Eliot Miranda-2 wrote
>> That way leads to American English...or Newspeak (Orwell) ;-)
>>
>> Seriously, there is a flaw in the teaching if your figures are right.
>> Literacy is important.  Brevity is important. Idiom is important.  And
>> knowing what the basic elements of the language are is important.  That []
>> value == nil is true is important.
>
> I was very likely once taught that [] == nil is true, but it is just
> something that comes up so rarely, that I just forgot about it.
> I did actually check the implementation to make sure, it is true, as I
> suspected, but because it is important for the algorithm in question I
> wanted to make sure everyone can understand the code, even if they don't
> have much experience with smalltalk. In my personal opinion, easy
> understandability, even by newcomers is more important than brevity, because
> otherwise you will just scare people away from the language, if you first
> need to study it for years on end before you can sufficiently read it.
> If brevity is important to you however, I would suggest a middle ground of
> "obj := parents at: obj ifAbsent: nil" as a compromise.
> nil is just one more character than [], but more clearly represents the
> intent.
> But this solution is indeed less idiomatic, therefore I'm not really
> satisfied with it either, I would like to hear someone else's stance on it
> however.
>
>
> Eliot Miranda-2 wrote
>>>> Another thing one should know is that
>>>>   e ifTrue: [s]
>>>> is the same as
>>>>   e ifTrue: [s] ifFalse: []
>>>> etc. ie, if e is false the value is nil.
>>>
>>> You know that I did not know that five years in into using Squeak (that
>>> is when I started implementing for my master's thesis)?
>>
>> Did you never read the definitions for ifTrue: and ifFalse: ?
>
> I did read them in my first few weeks of study and was amazed that you could
> actually look into the definitions of such primitive procedures but again,
> its just something thats almost never important, and therefore not
> necessarily something to actively remember.
>
>
> Eliot Miranda-2 wrote
>>> It's only obvious in hindsight. I had rather expected to
>>>
>>>   e ifTrue: [s]  ===> false OR s
>>>
>>> Which is an equally sensible variant.
>>>
>>> I don't want wo argue that things are bad. but let's not go down that
>>> road and say One Must Know That ... :)
>>
>> But yes, one /should/ know that.  The core classes should be read.  If you
>> want to raise a generation of JavaScripters then sure, ignore literacy.
>> But if you want to raise a generation that can appreciate great, carefully
>> considered design, educate them to think and to read and write well.
>> Everything else is Ebonics and the Prussian Model.
>
> Again, one probably should know that, if one is a long time smalltalk
> developer but there are always people that don't. Maybe its because they
> just started squeak/smalltalk, or never got around to reading those few
> particular methods. In any case, I think we should always include the people
> that don't know every nook and cranny of the language they are working with,
> because otherwise we would neglect new programmers, who are just so very
> important for the health of a language.

I disagree strongly that we should always include “the people
that don't know every nook and cranny of the language” for several reasons.  First, knowing that [] == nil is true is foundational.  It is extremely common.  If one does not know that [] == nil then there is lots of code in the system one does not understand.  You might  count the number of occurrences of [] and [nil].  One can always posit an ignorant programmer.  But whereas ignorant programmers can be enlightened, or better still enlighten themselves, a language that falls into disrepair maybe irretrievably damaged.  I grew up in Britain speaking British English and I live in the United States and am occasionally shocked by the loss of precision in the use of English here.  It has real effects.  Lots of people in the US think that “inflammable” means “cannot burn”; it means the opposite.

Would not the effect of failing to maintain high standards of literacy in a communal programming system is increasing doubt and uncertainty in the community members and verbosity and higher maintenance costs in the code?

A number of far greater thinkers than I have made simplicity a foundational principle. William of Occam stated, Non sunt multiplicanda entia sine necessitate (Entities are not to be multiplied without necessity).  It is attributed to Einstein that “all things should be made as simple as possible – but no simpler”.  And then there’s KISS (Keep It Simple, Stupid”.

Does this apply to [nil]?  Maybe not.  But what’s your reaction to those who fail to use der, die, das, dem & den correctly?  Do you feel that the person has something to learn or that German should be bastardized to compensate for their failings?

> I would be interested though why you think extreme brevity is so crucially
> important, because I often don't see the use of it, except that its a little
> less typing, so maybe I'm missing the point here.

I don’t value brevity in this case. I value not obscuring basic semantics.  I value a shared language that increases in beauty, not lessens.

>
> I would also appreciate feedback on this small piece of code:
>    + PointerFinder on: self object except: {self}, ObjectExplorerWrapper
> allInstances!
>    - self flag: #tooMany. "mt: Note that we might want to ignore references
> caused by this tool."
>    - self object chasePointers.!
> I really don't like the use of allInstances in this case, but I didn' see a
> better way to find the ObjectExplorerWrappers that might hog references to
> the Object in question.

Traverse the world looking for submorphs whose models are ObjectExplorers and collect their ObjectExplorerWrappers.  The use of allInstances is indeed wrong.  Look also for Inspectors.  A PointerFinder or Inspector could indeed be the object holding onto something that should be garbage collected, and these UI objects can become disconnected from the scene graph, for example left in some global variable during a debugging session.  But think carefully about the criteria for choosing which PointerFinders and Inspectors are considered excludable; does one include those in different projects?  What about ones that are hidden or partially obscured behind other windows?

In general be suspicious of allInstances.  It is appropriate for schema evolution, where it is essential that every object of a particular class change shape, but for finding things, graph traversal is always going to be faster, and allInstances may uncover zombie objects that the garbage collector has yet to reclaim.  Test by timing collecting all instances of CompiledMethod and timing finding all CompiledMethods by traversing from Class rootsOfTheWorld.

> Kind regards,
> Leon

Regards to you.  Apologies for being a pedantic old man ;-)

> --
> Sent from: http://forum.world.st/Squeak-Dev-f45488.html

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Bob Arning-2


On 8/14/18 11:34 AM, Eliot Miranda wrote:
> Traverse the world looking for submorphs whose models are ObjectExplorers and collect their ObjectExplorerWrappers.  The use of allInstances is indeed wrong.  Look also for Inspectors.  A PointerFinder or Inspector could indeed be the object holding onto something that should be garbage collected, and these UI objects can become disconnected from the scene graph, for example left in some global variable during a debugging session.  But think carefully about the criteria for choosing which PointerFinders and Inspectors are considered excludable; does one include those in different projects?  What about ones that are hidden or partially obscured behind other windows?
Or even worse, instances which are held off-screen altogether, by undo
stacks, e.g. Can't count how many times something didn't go away due to
a ref through that path.

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Leon Matthes
In reply to this post by Eliot Miranda-2
Eliot Miranda-2 wrote
> I do not mean this as a personal attack.  You are clearly a strong
> programmer and I am grateful for your participation and contributions.  I
> hope that you will see my critique of one tiny part of a valuable commit
> as a plea to avoid a slippery slope, not an attack in your abilities.  You
> have proven your abilities.  My concern for where the slope leads is
> speculative and perhaps I am wrong, but I think my concern is valid.  I
> hope to persuade you below.

Thank you for your kind words and your concern, I appreciate it :-)


Eliot Miranda-2 wrote

> I disagree strongly that we should always include “the people
> that don't know every nook and cranny of the language” for several
> reasons.  First, knowing that [] == nil is true is foundational.  It is
> extremely common.  If one does not know that [] == nil then there is lots
> of code in the system one does not understand.  You might  count the
> number of occurrences of [] and [nil].  One can always posit an ignorant
> programmer.  But whereas ignorant programmers can be enlightened, or
> better still enlighten themselves, a language that falls into disrepair
> maybe irretrievably damaged.  I grew up in Britain speaking British
> English and I live in the United States and am occasionally shocked by the
> loss of precision in the use of English here.  It has real effects.  Lots
> of people in the US think that “inflammable” means “cannot burn”; it means
> the opposite.
>
> Would not the effect of failing to maintain high standards of literacy in
> a communal programming system is increasing doubt and uncertainty in the
> community members and verbosity and higher maintenance costs in the code?
>
> A number of far greater thinkers than I have made simplicity a
> foundational principle. William of Occam stated, Non sunt multiplicanda
> entia sine necessitate (Entities are not to be multiplied without
> necessity).  It is attributed to Einstein that “all things should be made
> as simple as possible – but no simpler”.  And then there’s KISS (Keep It
> Simple, Stupid”.
>
> Does this apply to [nil]?  Maybe not.  But what’s your reaction to those
> who fail to use der, die, das, dem & den correctly?  Do you feel that the
> person has something to learn or that German should be bastardized to
> compensate for their failings?


Florian Mateoc-4 wrote

> But I would also argue against [nil]. It is true that Smalltalk was meant
> to be very readable and approachable, not just
> by beginners but by children, and it is not an accident that it reads so
> much like "normal" English.
>
> Still, blocks are not English-like, they are one of the constructs that do
> need to be learned. And I have never seen
> bugs caused by ifAbsent: []. If it is not obvious what ifAbsent: [] does,
> the reader would be driven towards looking at
> what an empty block returns, and they would learn it at that [point, as
> they should, even if they did not remember it
> initially from when it was taught.

Well maybe I underestimated how foundational [] == nil seems to be, I'm just
rarely a fan of anything that is implicitly returned.
May just be the fact that I often write C++, where a missing return may
compile but then have undefined behavior at runtime, which has made me crazy
multiple times already. :P
As the consensus seems to be to use [] instead of [nil], I will change it
back in the next commit.


Eliot Miranda-2 wrote

> Traverse the world looking for submorphs whose models are ObjectExplorers
> and collect their ObjectExplorerWrappers.  The use of allInstances is
> indeed wrong.  Look also for Inspectors.  A PointerFinder or Inspector
> could indeed be the object holding onto something that should be garbage
> collected, and these UI objects can become disconnected from the scene
> graph, for example left in some global variable during a debugging
> session.  But think carefully about the criteria for choosing which
> PointerFinders and Inspectors are considered excludable; does one include
> those in different projects?  What about ones that are hidden or partially
> obscured behind other windows?
>
> In general be suspicious of allInstances.  It is appropriate for schema
> evolution, where it is essential that every object of a particular class
> change shape, but for finding things, graph traversal is always going to
> be faster, and allInstances may uncover zombie objects that the garbage
> collector has yet to reclaim.  Test by timing collecting all instances of
> CompiledMethod and timing finding all CompiledMethods by traversing from
> Class rootsOfTheWorld.


Bob Arning-2 wrote
> Or even worse, instances which are held off-screen altogether, by undo
> stacks, e.g. Can't count how many times something didn't go away due to
> a ref through that path.

I was already thinking about traversing the World to collect all the
instances but it seemed a bit disproportionate effort, because I couldn't
think of a use case where allInstances might lead to a problem.
But as I see, there are a lot more problems with it than I thought.
I will try to find time in the next few days to revisit the code and change
that.

Just one more question:
I'm new to committing to the Inbox, if I change the code to not use
allInstances, what would be the best procedure to upload the changes to the
Inbox?
Should I just commit as usual, which would create a completely new thread in
the forum, or is there some way to upload the changes to the existing thread
apart from just linking to an upload of the .mcz?

Kind regards and thanks to everyone for your help ;-),
Leon



--
Sent from: http://forum.world.st/Squeak-Dev-f45488.html

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Eliot Miranda-2
In reply to this post by Bob Arning-2
Hi Bob,

> On Aug 14, 2018, at 8:46 AM, Bob Arning <[hidden email]> wrote:
>
>
>
>> On 8/14/18 11:34 AM, Eliot Miranda wrote:
>> Traverse the world looking for submorphs whose models are ObjectExplorers and collect their ObjectExplorerWrappers.  The use of allInstances is indeed wrong.  Look also for Inspectors.  A PointerFinder or Inspector could indeed be the object holding onto something that should be garbage collected, and these UI objects can become disconnected from the scene graph, for example left in some global variable during a debugging session.  But think carefully about the criteria for choosing which PointerFinders and Inspectors are considered excludable; does one include those in different projects?  What about ones that are hidden or partially obscured behind other windows?
> Or even worse, instances which are held off-screen altogether, by undo stacks, e.g. Can't count how many times something didn't go away due to a ref through that path.

Exactly.  Much better example than mine.

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Eliot Miranda-2
In reply to this post by Florin Mateoc-4
Hi Florin,

> On Aug 14, 2018, at 8:03 AM, Florin Mateoc <[hidden email]> wrote:
>
>> On 8/14/2018 4:52 AM, Leon Matthes wrote:
>> In the interest of full disclosure, I should probably first tell you, that I
>> am the original author of the commit and I actually am one of Tobias
>> students and are now at about one year of squeak/smalltalk experience and up
>> until a few days ago fell right in the middle of the 95% of students who
>> didn't know for certain that [] == nil is true.
>>
>>
>> Eliot Miranda-2 wrote
>>> That way leads to American English...or Newspeak (Orwell) ;-)
>>>
>>> Seriously, there is a flaw in the teaching if your figures are right.
>>> Literacy is important.  Brevity is important. Idiom is important.  And
>>> knowing what the basic elements of the language are is important.  That []
>>> value == nil is true is important.
>> I was very likely once taught that [] == nil is true, but it is just
>> something that comes up so rarely, that I just forgot about it.
>> I did actually check the implementation to make sure, it is true, as I
>> suspected, but because it is important for the algorithm in question I
>> wanted to make sure everyone can understand the code, even if they don't
>> have much experience with smalltalk. In my personal opinion, easy
>> understandability, even by newcomers is more important than brevity, because
>> otherwise you will just scare people away from the language, if you first
>> need to study it for years on end before you can sufficiently read it.
>> If brevity is important to you however, I would suggest a middle ground of
>> "obj := parents at: obj ifAbsent: nil" as a compromise.
>> nil is just one more character than [], but more clearly represents the
>> intent.
>> But this solution is indeed less idiomatic, therefore I'm not really
>> satisfied with it either, I would like to hear someone else's stance on it
>> however.
>>
>>
>> Eliot Miranda-2 wrote
>>>>> Another thing one should know is that
>>>>>   e ifTrue: [s]
>>>>> is the same as
>>>>>   e ifTrue: [s] ifFalse: []
>>>>> etc. ie, if e is false the value is nil.
>>>>>
>>>> You know that I did not know that five years in into using Squeak (that
>>>> is when I started implementing for my master's thesis)?
>>> Did you never read the definitions for ifTrue: and ifFalse: ?
>> I did read them in my first few weeks of study and was amazed that you could
>> actually look into the definitions of such primitive procedures but again,
>> its just something thats almost never important, and therefore not
>> necessarily something to actively remember.
>>
>>
>> Eliot Miranda-2 wrote
>>>> It's only obvious in hindsight. I had rather expected to
>>>>
>>>>   e ifTrue: [s]  ===> false OR s
>>>>
>>>> Which is an equally sensible variant.
>>>>
>>>> I don't want wo argue that things are bad. but let's not go down that
>>>> road and say One Must Know That ... :)
>>> But yes, one /should/ know that.  The core classes should be read.  If you
>>> want to raise a generation of JavaScripters then sure, ignore literacy.
>>> But if you want to raise a generation that can appreciate great, carefully
>>> considered design, educate them to think and to read and write well.
>>> Everything else is Ebonics and the Prussian Model.
>> Again, one probably should know that, if one is a long time smalltalk
>> developer but there are always people that don't. Maybe its because they
>> just started squeak/smalltalk, or never got around to reading those few
>> particular methods. In any case, I think we should always include the people
>> that don't know every nook and cranny of the language they are working with,
>> because otherwise we would neglect new programmers, who are just so very
>> important for the health of a language.
>>
>> I would be interested though why you think extreme brevity is so crucially
>> important, because I often don't see the use of it, except that its a little
>> less typing, so maybe I'm missing the point here.
>>
>> I would also appreciate feedback on this small piece of code:
>>    + PointerFinder on: self object except: {self}, ObjectExplorerWrapper
>> allInstances!
>>    - self flag: #tooMany. "mt: Note that we might want to ignore references
>> caused by this tool."
>>    - self object chasePointers.!
>> I really don't like the use of allInstances in this case, but I didn' see a
>> better way to find the ObjectExplorerWrappers that might hog references to
>> the Object in question.
>
>
> Why don't you like the use of allInstances in this case? finding all references belongs to the same kind of meta
> programming activities as finding all instances, so if there is a case where allInstances should be used, it is exactly
> something like this

The point is that the garbage collector is not eager.  A reference counting GC can be eager, except in the collection of cycles.  Practical implementations almost always include some form of deferment, such as Peter Deutsch’s Deferred Reference Counting, which defers counting the stack until a fixed sized zero count table has filled up.  So in practice garbage collectors do not collect all garbage immediately.  But allInstances indiscriminately trawls the heap, potentially reviving otherwise inaccessible objects that are yet to be collected.  In this case these objects can’t possibly prevent GC, so they’re spurious.  In this case it does no harm (a false positive of something that should be excluded has no effect on the pointer search).  But it’s still potentially go gust by and, as I said, slower to compute than traversing my the scene graph.

This last point is important.  With 64-bits we can have apps with huge heaps and a PointerFinder may be a very important tool in fixing storage leaks within them.  Even more important then that time not be wasted using a catch all like allInstances to kick off a search.

> Regarding the previous issues discussed, I agree that #ifTrue: is not obvious. More than that, I have seen many bugs
> caused by people not realizing that it would sometimes return nil, even if the block would always return something
> notNil. So I would argue against brevity in this instance, I think
>
>     e ifTrue: [s] ifFalse: []
>
> would avoid these kinds of errors, so I would prefer it.

This one is more debatable, but I find it troublesome that someone would not know what the default return is.  It could be self, it could be nil, but that there is a definition is important, and it should be known.  So for me I always go for the short form.

 I think that the implementation of control structure via closures and messages is a) a core part of the system design, implying extensible control structures, deeply elegant and informed by computability theory, b) foundational to the system, both in the system being built upon these control structures, and in their definition being included in the system, and, with sufficient effort, actually extensible (see Marcus Denker’s magnificent mustBeBooleanMagic: in Pharo), b) beautifully concise; one can read the entirety of Boolean, True and False in a few minutes and the insight it gives into system design is enormous.  I still remember the thrill of getting it for the first time.  A teacher of Smalltalk should strive to give their students that same thrill.  This is one of the most profound and beautiful parts of the system and of computing.  The curly bracket languages are so weak in good part because they don’t embody this.

> But I would also argue against [nil]. It is true that Smalltalk was meant to be very readable and approachable, not just
> by beginners but by children, and it is not an accident that it reads so much like "normal" English.
>
> Still, blocks are not English-like, they are one of the constructs that do need to be learned. And I have never seen
> bugs caused by ifAbsent: []. If it is not obvious what ifAbsent: [] does, the reader would be driven towards looking at
> what an empty block returns, and they would learn it at that [point, as they should, even if they did not remember it
> initially from when it was taught.

*1

>> Kind regards,
>> Leon
>>
>>
>>
>> --
>> Sent from: http://forum.world.st/Squeak-Dev-f45488.html

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Eliot Miranda-2
In reply to this post by Leon Matthes
Hi Leon,

> On Aug 14, 2018, at 9:24 AM, Leon Matthes <[hidden email]> wrote

[snip]

> Just one more question:
> I'm new to committing to the Inbox, if I change the code to not use
> allInstances, what would be the best procedure to upload the changes to the
> Inbox?
> Should I just commit as usual, which would create a completely new thread in
> the forum, or is there some way to upload the changes to the existing thread
> apart from just linking to an upload of the .mcz?

That’s a good point.  It might be nice if mail readers could thread across closely related subjects, but we can’t expect that they will :-).  As far as committing you have no choice; you have to start from your original commit or a merge with another version of the same package.  But if you want to join the two threads you can always use some hack such as responding to the new thread with a message that contains a link to the old thread in the mail archive.

> Kind regards and thanks to everyone for your help ;-),
> Leon

Reply | Threaded
Open this post in threaded view
|

Re: implicit values (was "The Inbox: Tools-LM.828.mcz")

Craig Latta
In reply to this post by Leon Matthes

Hi Leon--

> ...I would like to hear someone else's stance on it however.

     I also think everyone should know that ([] value) is nil, so
writing "ifAbsent: []" is fine. But I wouldn't mind an explicit
expression inside those brackets, either, even if that expression is
"nil". No one's legitimacy is at stake in either case. A comment to
explain what that nil will signify later could be useful in some situations.

     In contrast, seeing someone write "^self" at the end of every
method that answers self (at least, without a comment to explain any
subtlety there may be) would drive me insane. :)


-C

--
Craig Latta
Black Page Digital
Amsterdam :: San Francisco
[hidden email]
+31   6 2757 7177 (SMS ok)
+ 1 415  287 3547 (no SMS)


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Chris Muller-3
In reply to this post by Eliot Miranda-2
Hi Eliot,

On Mon, Aug 13, 2018 at 9:59 PM, Eliot Miranda <[hidden email]> wrote:

> Hi,
>
> regarding
>
> +    obj := parents at: obj ifAbsent: [nil].
> -    obj := parents at: obj ifAbsent: [].
>
>
> Please no.  One must know that the empty block evaluates to nil.  It is
> illiterate not to.  So the verbosity is bad; it implies uncertainty (“does
> the empty block evaluate to nil?  maybe not ‘cuz here it’s written
> explicitly”), it requires more typing, it’s ugly.

But the return value from the block is ^actually consumed^ by the
while condition, so making an explicit reference to nil greatly
improves readability.  If the value were NOT consumed, then I would
agree that no return object should be specified, however I would
implore you never to write this code:   [].   Instead:

     [ "always put an intention-revealing comment inside" ]

Why?  Because emptiness is inherently ambiguous -- e.g., did the
programmer forget to fill that part in?  Or was he intending to
actually "return nil".  Talk about uncertainty!

I've always felt our code should appeal to the _broadest_ audience
possible, so that even those illiterate in Smalltalk could still read
it and follow it.  It requires an expert Smalltalker and deep
consideration (and prioritization!) of the human <---> Smalltalk
"negotiation" to write code that is, all at once, terse, beautiful and
able be easily readable even to the broadest possible audience.

Best,
  Chris

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Bob Arning-2
In reply to this post by Leon Matthes


On 8/14/18 4:52 AM, Leon Matthes wrote:
> until a few days ago fell right in the middle of the 95% of students who
> didn't know for certain that [] == nil is true.
It might be worth noting in the interest of clarity that [] == nil is
false. [] value == nil would be true.

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Kjell Godo
In reply to this post by Eliot Miranda-2
e ifTrue:[ a a a ]                     “<—————--[  = e ifTrue:[ ... ]ifFalse:[]  ][  [] returns nil  ]”

and if you can switch word wrap on and off you can move this comment way to the right so just the arrow is showing when word wrap is off so if you see an arrow you can either ignore it or turn wordwrap on and see it. in this way you can include a lot of comments and see them or not see them via word wrap on or off
<—-[ BorgLisp comments look like <—-[ ... ] which I am not reserving any rights to ][ pyublic domain to anyone else who also wants to ][   by the way ]

so how often would i do this? kind of teaching comment? only when i feel like it is my guess unless this could be automated some way and I didn’t have to do anything

and this word automated links to the idea of neglecting to make a manual and books which are separated from the thing by a non zero distance and instead writing the books into a mouse over or code selection thing that pops up some kind of manual level explaining which might include a auto generated manual which collects it all into one place which maybe was just a haphazard collection of such explanations which might then make it easier to write this haphazard auto manual<—-[ have a style guide up at the top which says there is no style guide ][ to make it easier to write in the hope that something might get written ] so it’s easier to write and easier to add to wiki like because manuals get written at great cost and then they sit because nobody is going to do that again. but if people could add to it wiki like with no restrictions they still wouldn’t do it but you have to try don’t you no style guide

so you select something and popUp command [ Explain This ] and then you get a default if you hit the space bar or a listSelector which offers to attempt to explain whatever it is in the various different ways listed or all ways with your last selection preselected

the spotter seems to be trying to do this kind of thing but without the manual level part of it in my experience maybe I was using it wrong

so like what if the various books and PDFs were hooked up to this [ Explain This ] or [ Spotter ] command then the various books could be in the listSelector and if you click on a book or [ Search All ] it tensor flows or CYCs or etc searches it and assembles whatever it’s got and then you can also click on any or a or the book or something if nothing came up and go to the book(s) etc maybe via a paywall or whatever if it’s really good or was costly to make or donate a donate wall 

or maybe if you click on a hit it sends you to that place in the book or pdf

( absoluteDrivel— ( paypal works good if lots of people use it but they didn’t but maybe they do it now i finally do it now after avoiding it like the plague for some decades and their stock is up and I’m looking forwards now to paying quickly and easily<—-[ and I hit myself in the forhead now and bray tell I could have had a V8 but I got a straight 6 for some treason wedded to i better not say ][ (she who must be obeyed) ] quick and easy pay for some of these things that somebody died to bring into this world so donate I will if it takes no more than 15 seconds to do it
and I can do it by eye roll<—-[ a rolling of the eyeballs ][ keep em rotating counter clockwise ]
because it’s not the money that people object to i think ( so think Apple store got a huge chunk of my money by making it easy to pay too easy those f )riends it’s the blood sweat and next of kin of paying that people object to )and then and then when it erases everything you just typed in for the leventy leventhy time and asks you to to start over and retype it all back in again that’s when people’s heads explode out on the freeway and they vow they start making vows they shake their fist up at the clouds out the window and they start making all sorts of vows invoking pitch forks lightning bolts skulls crosst bones and all sorts of infernal regions which they grab just like chimpanzees - a I’m sorry I just called them a chimpanzee thats not right that’s so wrong that’s specist sorry and it isn’t fair to the rest of the chimpanzees so sorry sorry excuse me pardon me just trying to be funny here so so me but not for money here    so    and then they grab a gun and start waving it out the winda and start looking at some body to shoot at (US 2018) one of them dang liberals but there’s no body around until they catch a glimps of somebody  in the mirror and that’s no fun for they next of kin so son which is great fun for the peanut gallery but hey not much else who all advocate vociferously for all such failures to be included in all payment GUIs from here to the here after and on to eternity those speaking hearing deaf mutes because they have not got any kids    yet but when they do their kids will all turn on them and they will then pray tell    me too    and    nobody told me    this was going to happen so then so then from then on you cannot get blood out of a stone that’s twice shy and twice burned unless they’re backed up at the edge of a cliff or paywall hi and they got to like my           like my my or maybe they would rather just die<———-[ not advocating this ] click

so up with paypal and whatever else makes it easy no doubt they are looking at crypto if not or visa will  not too sleezy )<—-[ absoluteDrivel ]

On Tue, Aug 14, 2018 at 09:56 Eliot Miranda <[hidden email]> wrote:
Hi Leon,

> On Aug 14, 2018, at 9:24 AM, Leon Matthes <[hidden email]> wrote

[snip]

> Just one more question:
> I'm new to committing to the Inbox, if I change the code to not use
> allInstances, what would be the best procedure to upload the changes to the
> Inbox?
> Should I just commit as usual, which would create a completely new thread in
> the forum, or is there some way to upload the changes to the existing thread
> apart from just linking to an upload of the .mcz?

That’s a good point.  It might be nice if mail readers could thread across closely related subjects, but we can’t expect that they will :-).  As far as committing you have no choice; you have to start from your original commit or a merge with another version of the same package.  But if you want to join the two threads you can always use some hack such as responding to the new thread with a message that contains a link to the old thread in the mail archive.

> Kind regards and thanks to everyone for your help ;-),
> Leon



Reply | Threaded
Open this post in threaded view
|

Re: implicit values (was "The Inbox: Tools-LM.828.mcz")

Chris Muller-3
In reply to this post by Craig Latta
Hi,

I'm obviously very interested in this subject...

>> ...I would like to hear someone else's stance on it however.
>
>      I also think everyone should know that ([] value) is nil, so
> writing "ifAbsent: []" is fine. But I wouldn't mind an explicit
> expression inside those brackets, either, even if that expression is
> "nil". No one's legitimacy is at stake in either case. A comment to
> explain what that nil will signify later could be useful in some situations.
>
>      In contrast, seeing someone write "^self" at the end of every
> method that answers self (at least, without a comment to explain any
> subtlety there may be) would drive me insane. :)

Ah, but the question being asked is the opposite.  i.e., should
String>>#asString remain as:

    ^ self

?   Or, changed to an empty method (to rely on implicit "return self")?

According to me and Kent Beck's "Interesting Return Value" pattern, it
absolutely should be explicit.  Removing it would not be a good way to
promote "literacy".

I believe Squeak can go so much further when
intelligent-but-illiterate people can read the code.  Syntactic
literacy will come quickly and naturally to those who can maintain
enough interest to stay past their first day, but those little details
won't carry them very far compared to being able to read the code with
little effort.

Best,
  Chris

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Eliot Miranda-2
In reply to this post by Kjell Godo
Hi All,

    I have to say that Kjell has never posted anything I have found helpful or interesting or even on topic.  I suggest blocking him.

On Tue, Aug 14, 2018 at 1:45 PM, Kjell Godo <[hidden email]> wrote:
e ifTrue:[ a a a ]                     “<—————--[  = e ifTrue:[ ... ]ifFalse:[]  ][  [] returns nil  ]”

and if you can switch word wrap on and off you can move this comment way to the right so just the arrow is showing when word wrap is off so if you see an arrow you can either ignore it or turn wordwrap on and see it. in this way you can include a lot of comments and see them or not see them via word wrap on or off
<—-[ BorgLisp comments look like <—-[ ... ] which I am not reserving any rights to ][ pyublic domain to anyone else who also wants to ][   by the way ]

so how often would i do this? kind of teaching comment? only when i feel like it is my guess unless this could be automated some way and I didn’t have to do anything

and this word automated links to the idea of neglecting to make a manual and books which are separated from the thing by a non zero distance and instead writing the books into a mouse over or code selection thing that pops up some kind of manual level explaining which might include a auto generated manual which collects it all into one place which maybe was just a haphazard collection of such explanations which might then make it easier to write this haphazard auto manual<—-[ have a style guide up at the top which says there is no style guide ][ to make it easier to write in the hope that something might get written ] so it’s easier to write and easier to add to wiki like because manuals get written at great cost and then they sit because nobody is going to do that again. but if people could add to it wiki like with no restrictions they still wouldn’t do it but you have to try don’t you no style guide

so you select something and popUp command [ Explain This ] and then you get a default if you hit the space bar or a listSelector which offers to attempt to explain whatever it is in the various different ways listed or all ways with your last selection preselected

the spotter seems to be trying to do this kind of thing but without the manual level part of it in my experience maybe I was using it wrong

so like what if the various books and PDFs were hooked up to this [ Explain This ] or [ Spotter ] command then the various books could be in the listSelector and if you click on a book or [ Search All ] it tensor flows or CYCs or etc searches it and assembles whatever it’s got and then you can also click on any or a or the book or something if nothing came up and go to the book(s) etc maybe via a paywall or whatever if it’s really good or was costly to make or donate a donate wall 

or maybe if you click on a hit it sends you to that place in the book or pdf

( absoluteDrivel— ( paypal works good if lots of people use it but they didn’t but maybe they do it now i finally do it now after avoiding it like the plague for some decades and their stock is up and I’m looking forwards now to paying quickly and easily<—-[ and I hit myself in the forhead now and bray tell I could have had a V8 but I got a straight 6 for some treason wedded to i better not say ][ (she who must be obeyed) ] quick and easy pay for some of these things that somebody died to bring into this world so donate I will if it takes no more than 15 seconds to do it
and I can do it by eye roll<—-[ a rolling of the eyeballs ][ keep em rotating counter clockwise ]
because it’s not the money that people object to i think ( so think Apple store got a huge chunk of my money by making it easy to pay too easy those f )riends it’s the blood sweat and next of kin of paying that people object to )and then and then when it erases everything you just typed in for the leventy leventhy time and asks you to to start over and retype it all back in again that’s when people’s heads explode out on the freeway and they vow they start making vows they shake their fist up at the clouds out the window and they start making all sorts of vows invoking pitch forks lightning bolts skulls crosst bones and all sorts of infernal regions which they grab just like chimpanzees - a I’m sorry I just called them a chimpanzee thats not right that’s so wrong that’s specist sorry and it isn’t fair to the rest of the chimpanzees so sorry sorry excuse me pardon me just trying to be funny here so so me but not for money here    so    and then they grab a gun and start waving it out the winda and start looking at some body to shoot at (US 2018) one of them dang liberals but there’s no body around until they catch a glimps of somebody  in the mirror and that’s no fun for they next of kin so son which is great fun for the peanut gallery but hey not much else who all advocate vociferously for all such failures to be included in all payment GUIs from here to the here after and on to eternity those speaking hearing deaf mutes because they have not got any kids    yet but when they do their kids will all turn on them and they will then pray tell    me too    and    nobody told me    this was going to happen so then so then from then on you cannot get blood out of a stone that’s twice shy and twice burned unless they’re backed up at the edge of a cliff or paywall hi and they got to like my           like my my or maybe they would rather just die<———-[ not advocating this ] click

so up with paypal and whatever else makes it easy no doubt they are looking at crypto if not or visa will  not too sleezy )<—-[ absoluteDrivel ]

On Tue, Aug 14, 2018 at 09:56 Eliot Miranda <[hidden email]> wrote:
Hi Leon,

> On Aug 14, 2018, at 9:24 AM, Leon Matthes <[hidden email]> wrote

[snip]

> Just one more question:
> I'm new to committing to the Inbox, if I change the code to not use
> allInstances, what would be the best procedure to upload the changes to the
> Inbox?
> Should I just commit as usual, which would create a completely new thread in
> the forum, or is there some way to upload the changes to the existing thread
> apart from just linking to an upload of the .mcz?

That’s a good point.  It might be nice if mail readers could thread across closely related subjects, but we can’t expect that they will :-).  As far as committing you have no choice; you have to start from your original commit or a merge with another version of the same package.  But if you want to join the two threads you can always use some hack such as responding to the new thread with a message that contains a link to the old thread in the mail archive.

> Kind regards and thanks to everyone for your help ;-),
> Leon







--
_,,,^..^,,,_
best, Eliot


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

David T. Lewis
On Tue, Aug 14, 2018 at 03:14:34PM -0700, Eliot Miranda wrote:
> Hi All,
>
>     I have to say that Kjell has never posted anything I have found helpful
> or interesting or even on topic.  I suggest blocking him.

-1

I see nothing malicious or harmful here. I don't think we need to block
anyone unless actual harm is intended, or damage is being done.

Dave


>
> On Tue, Aug 14, 2018 at 1:45 PM, Kjell Godo <[hidden email]> wrote:
>
> > e ifTrue:[ a a a ]                     ???<???????????????--[  = e ifTrue:[ ...
> > ]ifFalse:[]  ][  [] returns nil  ]???
> >
> > and if you can switch word wrap on and off you can move this comment way
> > to the right so just the arrow is showing when word wrap is off so if you
> > see an arrow you can either ignore it or turn wordwrap on and see it. in
> > this way you can include a lot of comments and see them or not see them via
> > word wrap on or off
> > <???-[ BorgLisp comments look like <???-[ ... ] which I am not reserving any
> > rights to ][ pyublic domain to anyone else who also wants to ][   by the
> > way ]
> >
> > so how often would i do this? kind of teaching comment? only when i feel
> > like it is my guess unless this could be automated some way and I didn???t
> > have to do anything
> >
> > and this word automated links to the idea of neglecting to make a manual
> > and books which are separated from the thing by a non zero distance and
> > instead writing the books into a mouse over or code selection thing that
> > pops up some kind of manual level explaining which might include a auto
> > generated manual which collects it all into one place which maybe was just
> > a haphazard collection of such explanations which might then make it easier
> > to write this haphazard auto manual<???-[ have a style guide up at the top
> > which says there is no style guide ][ to make it easier to write in the
> > hope that something might get written ] so it???s easier to write and easier
> > to add to wiki like because manuals get written at great cost and then they
> > sit because nobody is going to do that again. but if people could add to it
> > wiki like with no restrictions they still wouldn???t do it but you have to
> > try don???t you no style guide
> >
> > so you select something and popUp command [ Explain This ] and then you
> > get a default if you hit the space bar or a listSelector which offers to
> > attempt to explain whatever it is in the various different ways listed or
> > all ways with your last selection preselected
> >
> > the spotter seems to be trying to do this kind of thing but without the
> > manual level part of it in my experience maybe I was using it wrong
> >
> > so like what if the various books and PDFs were hooked up to this [
> > Explain This ] or [ Spotter ] command then the various books could be in
> > the listSelector and if you click on a book or [ Search All ] it tensor
> > flows or CYCs or etc searches it and assembles whatever it???s got and then
> > you can also click on any or a or the book or something if nothing came up
> > and go to the book(s) etc maybe via a paywall or whatever if it???s really
> > good or was costly to make or donate a donate wall
> >
> > or maybe if you click on a hit it sends you to that place in the book or
> > pdf
> >
> > ( absoluteDrivel??? ( paypal works good if lots of people use it but they
> > didn???t but maybe they do it now i finally do it now after avoiding it like
> > the plague for some decades and their stock is up and I???m looking forwards
> > now to paying quickly and easily<???-[ and I hit myself in the forhead now
> > and bray tell I could have had a V8 but I got a straight 6 for some treason
> > wedded to i better not say ][ (she who must be obeyed) ] quick and easy pay
> > for some of these things that somebody died to bring into this world so
> > donate I will if it takes no more than 15 seconds to do it
> > and I can do it by eye roll<???-[ a rolling of the eyeballs ][ keep em
> > rotating counter clockwise ]
> > because it???s not the money that people object to i think ( so think Apple
> > store got a huge chunk of my money by making it easy to pay too easy those
> > f )riends it???s the blood sweat and next of kin of paying that people object
> > to )and then and then when it erases everything you just typed in for the
> > leventy leventhy time and asks you to to start over and retype it all back
> > in again that???s when people???s heads explode out on the freeway and they vow
> > they start making vows they shake their fist up at the clouds out the
> > window and they start making all sorts of vows invoking pitch forks
> > lightning bolts skulls crosst bones and all sorts of infernal regions which
> > they grab just like chimpanzees - a I???m sorry I just called them a
> > chimpanzee thats not right that???s so wrong that???s specist sorry and it
> > isn???t fair to the rest of the chimpanzees so sorry sorry excuse me pardon
> > me just trying to be funny here so so me but not for money here    so
> >  and then they grab a gun and start waving it out the winda and start
> > looking at some body to shoot at (US 2018) one of them dang liberals but
> > there???s no body around until they catch a glimps of somebody  in the mirror
> > and that???s no fun for they next of kin so son which is great fun for the
> > peanut gallery but hey not much else who all advocate vociferously for all
> > such failures to be included in all payment GUIs from here to the here
> > after and on to eternity those speaking hearing deaf mutes because they
> > have not got any kids    yet but when they do their kids will all turn on
> > them and they will then pray tell    me too    and    nobody told me
> >  this was going to happen so then so then from then on you cannot get blood
> > out of a stone that???s twice shy and twice burned unless they???re backed up
> > at the edge of a cliff or paywall hi and they got to like my           like
> > my my or maybe they would rather just die<?????????-[ not advocating this ] click
> >
> > so up with paypal and whatever else makes it easy no doubt they are
> > looking at crypto if not or visa will  not too sleezy )<???-[ absoluteDrivel ]
> >
> > On Tue, Aug 14, 2018 at 09:56 Eliot Miranda <[hidden email]>
> > wrote:
> >
> >> Hi Leon,
> >>
> >> > On Aug 14, 2018, at 9:24 AM, Leon Matthes <[hidden email]>
> >> wrote
> >>
> >> [snip]
> >>
> >> > Just one more question:
> >> > I'm new to committing to the Inbox, if I change the code to not use
> >> > allInstances, what would be the best procedure to upload the changes to
> >> the
> >> > Inbox?
> >> > Should I just commit as usual, which would create a completely new
> >> thread in
> >> > the forum, or is there some way to upload the changes to the existing
> >> thread
> >> > apart from just linking to an upload of the .mcz?
> >>
> >> That???s a good point.  It might be nice if mail readers could thread
> >> across closely related subjects, but we can???t expect that they will :-).
> >> As far as committing you have no choice; you have to start from your
> >> original commit or a merge with another version of the same package.  But
> >> if you want to join the two threads you can always use some hack such as
> >> responding to the new thread with a message that contains a link to the old
> >> thread in the mail archive.
> >>
> >> > Kind regards and thanks to everyone for your help ;-),
> >> > Leon
> >>
> >>
> >
> >
> >
>
>
> --
> _,,,^..^,,,_
> best, Eliot

>


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Tools-LM.828.mcz

Florin Mateoc-4
In reply to this post by Eliot Miranda-2
Hi Eliot,

On 8/14/2018 12:49 PM, Eliot Miranda wrote:
> Hi Florin,
>
>> On Aug 14, 2018, at 8:03 AM, Florin Mateoc <[hidden email]> wrote:
>>
>>> On 8/14/2018 4:52 AM, Leon Matthes wrote:
...

>>> I would also appreciate feedback on this small piece of code:
>>>    + PointerFinder on: self object except: {self}, ObjectExplorerWrapper
>>> allInstances!
>>>    - self flag: #tooMany. "mt: Note that we might want to ignore references
>>> caused by this tool."
>>>    - self object chasePointers.!
>>> I really don't like the use of allInstances in this case, but I didn' see a
>>> better way to find the ObjectExplorerWrappers that might hog references to
>>> the Object in question.
>>
>> Why don't you like the use of allInstances in this case? finding all references belongs to the same kind of meta
>> programming activities as finding all instances, so if there is a case where allInstances should be used, it is exactly
>> something like this
> The point is that the garbage collector is not eager.  A reference counting GC can be eager, except in the collection of cycles.  Practical implementations almost always include some form of deferment, such as Peter Deutsch’s Deferred Reference Counting, which defers counting the stack until a fixed sized zero count table has filled up.  So in practice garbage collectors do not collect all garbage immediately.  But allInstances indiscriminately trawls the heap, potentially reviving otherwise inaccessible objects that are yet to be collected.  In this case these objects can’t possibly prevent GC, so they’re spurious.  In this case it does no harm (a false positive of something that should be excluded has no effect on the pointer search).  But it’s still potentially go gust by and, as I said, slower to compute than traversing my the scene graph.
>
> This last point is important.  With 64-bits we can have apps with huge heaps and a PointerFinder may be a very important tool in fixing storage leaks within them.  Even more important then that time not be wasted using a catch all like allInstances to kick off a search.


I was too succinct in my comment, thus inexact. Of course, both allInstances and allReferences closely interact with the
garbage collector.

E.g. in VisualAge, the implementation of allInstances is actually not a primitive but:

allInstances
    "Answer an indexable collection containing all the instances of the
     receiver."

    "There might not be any, so check for that case first."
    self basicAllInstances isEmpty  ifTrue: [ ^ #()].

    "Since there are instances, clean house and ask a second time."
    self methodDictionary notNil ifTrue: [
        "Let go of any classes and method dictionaries being kept in vm caches."
        self methodDictionary flushCache].
    System globalGarbageCollect.
    ^ self basicAllInstances


And very similarly, the implementation of allReferences is:

allReferences
    "Answer an indexable collection containing all the objects which
     reference the receiver."

    self basicAllReferences isEmpty  ifTrue: [ ^ #()].
    System globalGarbageCollect.
    ^ self basicAllReferences


Where basicAllInstances and basicAllReferences are the actual primitives.

When chasing memory leaks, you have to have an understanding of what can possibly hold onto the objects that you are
looking for, including the very tools that you are using as you are looking for references, possibly open inspectors,
debuggers, closures in methods invoked, etc. Of course, the snippet shown above is only a crude approximation of that,
but I don't think that the usage of allInstances in itself is a problem.

Presumably when you start chasing a memory leak, the leak is real and something other than object explorers are holding
onto the object, and those other references are more relevant to your search, but, as Bob said, it is easy to shoot
yourself in the foot if you forget about your exclusions


>> Regarding the previous issues discussed, I agree that #ifTrue: is not obvious. More than that, I have seen many bugs
>> caused by people not realizing that it would sometimes return nil, even if the block would always return something
>> notNil. So I would argue against brevity in this instance, I think
>>
>>     e ifTrue: [s] ifFalse: []
>>
>> would avoid these kinds of errors, so I would prefer it.
> This one is more debatable, but I find it troublesome that someone would not know what the default return is.  It could be self, it could be nil, but that there is a definition is important, and it should be known.  So for me I always go for the short form.
>
>  I think that the implementation of control structure via closures and messages is a) a core part of the system design, implying extensible control structures, deeply elegant and informed by computability theory, b) foundational to the system, both in the system being built upon these control structures, and in their definition being included in the system, and, with sufficient effort, actually extensible (see Marcus Denker’s magnificent mustBeBooleanMagic: in Pharo), b) beautifully concise; one can read the entirety of Boolean, True and False in a few minutes and the insight it gives into system design is enormous.  I still remember the thrill of getting it for the first time.  A teacher of Smalltalk should strive to give their students that same thrill.  This is one of the most profound and beautiful parts of the system and of computing.  The curly bracket languages are so weak in good part because they don’t embody this.
>

I tend to view

    e ifTrue: [s]

as merely syntactic sugar for

    e ifTrue: [s] ifFalse: []

and I am not a fan of syntactic sugar - these expressions are perfectly equivalent, with no chance of them ever being
extended to mean something different - especially when the syntactic sugar form is error-prone.

They feel more like allowing braces to be omitted in curly bracket languages when there's a single statement in the
branch - sure, the end result is more concise, and the developers should really learn their control structures, but the
additional errors being introduced as a result make it not worth it IMHO



12