"
stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE
Copyright (C) 2013-2014 Jan Vrany
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
"
"{ Package: 'stx:goodies/smallsense' }"
"{ NameSpace: SmallSense }"
Object subclass:#Manager
instanceVariableNames:'classes accessLock updater updaterThread seqno'
classVariableNames:'Instance'
poolDictionaries:''
category:'SmallSense-Smalltalk-Types-Info'
!
!Manager class methodsFor:'documentation'!
copyright
"
stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE
Copyright (C) 2013-2014 Jan Vrany
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
"
! !
!Manager class methodsFor:'instance creation'!
flush
"flushes the cached singleton"
self flushSingleton
"
self flushSingleton
"
"Created: / 16-12-2011 / 01:37:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-11-2014 / 17:34:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
flushSingleton
"flushes the cached singleton"
Instance notNil ifTrue:[
Instance release.
].
Instance := nil
"
self flushSingleton
"
"Modified: / 21-11-2014 / 17:34:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
instance
"returns a singleton"
Instance isNil ifTrue:[
Instance := self basicNew initialize.
].
^ Instance.
"Created: / 27-11-2011 / 15:30:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
new
"returns a singleton"
^ self instance.
"Modified: / 27-11-2011 / 15:30:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Manager methodsFor:'accessing'!
infoForClass: class
| info |
accessLock critical:[
info := self basicInfoForClass: class.
].
^info
"Created: / 27-11-2011 / 16:15:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
infoForClassOrNil: class
^classes at: class name ifAbsent: nil
"Created: / 27-11-2011 / 17:15:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Manager methodsFor:'accessing-private'!
basicInfoForClass: class
class isNil ifTrue:[^nil].
^classes at: class name ifAbsentPut:[
ClassInfo new
setManager: self
className: class name
].
"Created: / 27-11-2011 / 16:47:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Manager methodsFor:'change & update'!
update:what with:param from:sender
"Invoked when an object that I depend upon sends a change notification."
(UserPreferences current smallSenseBackgroundTypingEnabled == true) ifFalse:[ ^ self ].
sender ~~ Smalltalk ifTrue:[
super update:what with:param from:sender.
^self.
].
what == #methodInClass ifTrue:[
"/ If this is anonymous class, do not bother...
| nm |
nm := param first name.
(nm isSymbol and:[ Smalltalk includesKey: nm ]) ifTrue:[
self updateInfoForMethod: (param first >> param second).
].
^self.
].
"/ Transcript show: 'SmallSense: Smalltalk changed: ', what , ' with: ', param printString.
"Modified: / 18-03-2014 / 12:27:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Manager methodsFor:'initialization'!
initialize
"Invoked when a new instance is created."
classes := Dictionary new.
accessLock := Semaphore forMutualExclusion.
updater := BackgroundQueueProcessingJob
named: 'SmallSense background updater'
on: [:classOrMethod|self delayedUpdateInfoForClassOrMethod: classOrMethod].
updater priority: Processor userBackgroundPriority - 1.
(UserPreferences current smallSenseEnabled == true) ifTrue:[
Smalltalk addDependent: self.
].
seqno := 0
"Modified: / 22-10-2013 / 10:56:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
release
"Invoked when a new instance is created."
classes := nil.
accessLock := Semaphore forMutualExclusion.
updater stopAndRemoveAll.
(UserPreferences current smallSenseEnabled == true) ifTrue:[
Smalltalk removeDependent: self.
].
"Created: / 21-11-2014 / 17:36:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Manager methodsFor:'updating'!
updateInfoForClass: class
| info |
class programmingLanguage isSmalltalk ifFalse:[ ^ self ].
info := self infoForClassOrNil: class.
(info isNil or:[(info seqno ? 0) < (seqno - 100)]) ifTrue:[
updater add: class
].
seqno := seqno == SmallInteger maxVal ifTrue: [1] ifFalse:[seqno + 1]
"Created: / 27-11-2011 / 17:46:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-10-2013 / 11:38:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateInfoForMethod: method
| info |
method programmingLanguage isSmalltalk ifFalse:[ ^ self ].
info := self basicInfoForClass: method mclass.
info isNil ifTrue:[
updater add: method mclass
] ifFalse:[
updater add: method
]
"Created: / 28-11-2011 / 19:30:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Manager methodsFor:'updating-delayed'!
delayedUpdateInfoForClass: class
| superclass info instVarNames instVarTypes probe nprobed sourceStream |
superclass := class superclass.
superclass notNil ifTrue:[self updateInfoForClass: superclass].
info := self infoForClass: class.
info isErrorneous ifTrue:[ ^ self ].
info seqno: seqno.
[
instVarNames := class allInstVarNames.
instVarTypes := instVarNames collect: [:instvar | info infoForInstvar: instvar ].
"/ Check for the source stream - if none, then do not add methods (one cannot
"/ infer types without a source anyway and mark the class errorneous...
[
sourceStream := class sourceStream.
] on: Error do:[
sourceStream := nil.
].
sourceStream isNil ifTrue:[
info errorneous: true.
^ self.
].
class methodsDo:[:mthd|updater add:mthd].
probe := [:instance |
instVarTypes withIndexDo: [:instVarType :i |
instVarType union: ((Type withClass: (instance instVarAt: i) class) type trustfullness: 70).
].
nprobed := nprobed + 1.
nprobed > 100 ifTrue:[
"/ Probe at most 100 instancess
^ self
].
].
nprobed := 0.
class allInstancesDo: probe.
"/ Maube an abstract class?
nprobed < 100 ifTrue:[
class allSubInstancesDo: probe
].
] on: Error do:[:ex |
info errorneous: true.
Logger error:'Error when infering instvars for %1: %2' with: class name with: ex description
]
"Created: / 27-11-2011 / 18:04:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-11-2014 / 17:17:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
delayedUpdateInfoForClassOrMethod: classOrMethod
| currentThread |
currentThread := Processor activeProcess.
updaterThread ~~ currentThread ifTrue:[
updaterThread := currentThread.
updaterThread addExitAction:[
updater stopAndRemoveAll.
].
].
[
classOrMethod isBehavior ifTrue:[
self delayedUpdateInfoForClass: classOrMethod.
].
classOrMethod isMethod ifTrue:[
self delayedUpdateInfoForMethod: classOrMethod.
]
] on: Error do:[:ex|
Logger error: 'Error when infering for %1: %2' with: classOrMethod with: ex description.
]
"Created: / 27-11-2011 / 18:01:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-11-2014 / 17:39:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
delayedUpdateInfoForMethod: method
| inferencer |
[
method mclass isNil ifTrue:["Obsolete method" ^ self ].
method mclass programmingLanguage isSmalltalk ifFalse: [ ^ self ].
"/ Transcript showCR: 'SmallSense: updating info for: ', method printString.
inferencer := SmalltalkInferencer forMethod: method.
inferencer process.
] on: Error do:[:ex |
Logger error:'Error when infering for method %1: %2' with: method printString with: ex description
]
"Created: / 27-11-2011 / 18:06:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 21-11-2014 / 16:55:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Manager class methodsFor:'documentation'!
version_CVS
^ '$Header$'
!
version_HG
^ '$Changeset: <not expanded> $'
!
version_SVN
^ '$Id$'
! !