"
COPYRIGHT (c) 2020 LabWare
"
"{ Package: 'stx:goodies/ring/core' }"
"{ NameSpace: Smalltalk }"
RGElement subclass:#RGMethod
instanceVariableNames:'sourceCode package author time tags'
classVariableNames:''
poolDictionaries:''
category:'Ring-Core-Kernel'
!
RGMethod comment:'RG2Method is a concrete representation of methods. It can be used to build browser for methods that are not in the image. It is polymorphic with CompiledMethod.
* We can ask a RG2Method for its selector using the selector message.
Example:
(Point>>#dist:) asRing2Definition selector
-> #dist
We can also ask the ring object representation of its class or the Smalltalk class actually implementing the corresponding compiledMethod.
* To access the ring class definition name, use parentName
aRG2MethodDefinition parentName
Example:
(Point>>#dist:) asRing2Definition parentName
-> #Point
* If you have a complete model where classes and methods are ring definition, to access the ring class definition , use parent
aRG2MethodDefinition parent
Example:
aRG2MethodDefinition(Point>>#dist:) parent
-> aRG2ClassDefinition(Point)
* If you want to access the smalltalk class that contains the compiledMethod that is represented by a ringMethodDefinition, use realParent
aRG2MethodDefinition realParent
Example:
(Point>>#dist:) asRing2Definition realParent
-> Point
Now a RingEntityDefinition offers two APIs: one that is generic and works for all the source code entities and this is the one we just
presented: parent, parentName and realParent. Having such interface is important to build generic tools that could manipulate
any entities in a polymorphic way (yes no isKindOf: everywhere).
In addition, a ring method definition offers a specific interface that should only be used when you know that you are solely manipulate
specific entity such as class element: method definition, class comment, and variables.
Here is the equivalence table
realParent realClass
parent ringClass
parentName className
* The message class returns the class of the object :).
Example:
(Point>>#dist:) asRing2Definition class
-> RingMethodDefinition
* The message className returns the name of the ring class defining the reingMethodDefinition.
Example:
(Point>>#dist:) asRing2Definition className
-> #Point
* If you have a complete model where classes and methods are ring definition, to access the ring class definition , use parent
aRG2MethodDefinition ringClass
Example:
aRG2MethodDefinition(Point>>#dist:) ringClass
-> aRG2ClassDefinition(Point)
* If you want to access the smalltalk class that contains the compiledMethod that is represented by a ringMethodDefinition, use realClass
aRG2MethodDefinition realClass
Example:
(Point>>#dist:) asRing2Definition realClass
-> Point
'
!
!RGMethod class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2020 LabWare
"
! !
!RGMethod methodsFor:'accessing'!
argumentNames
^ self ast argumentNames
!
ast
"Answer my AST with semantic analysis. See #parseTree."
^ self propertyNamed: #ast ifAbsentPut: [ self parseTree ]
"Modified: / 23-12-2020 / 08:30:34 / Jan Vrany <jan.vrany@labware.com>"
!
compiledMethod
^ self
!
fullName
"Keeps a unique description for the receiver. As annotation to avoid converting each time is invoked"
^ (self parent name, '>>#', self selector) asSymbol
!
hasSourceCode
^ self backend forMethod hasSourceCodeFor: self
!
isExtension
"The receiver is an extension when is defined in a different package to the one of its parent"
^ self parent package ~= self package
!
numArgs
^ self selector asString numArgs
!
parseTree
^(RBParser
parseMethod: self sourceCode
onError: [ :msg :pos | ^ nil ])
"Modified: / 22-12-2020 / 22:34:32 / Jan Vrany <jan.vrany@labware.com>"
!
selector
"Retrieves the name of the method"
^ self name asSymbol
!
sourceCode
^ self backend forMethod sourceCodeFor: self
!
sourceCode: anObject
"ATTENTION: There is no check here if the selector is changed!!"
self backend forMethod setSourceCodeFor: self to: anObject asString
"TODO: announcements"
!
sourceCodeForNoSelector
^ 'unresolvedMessage', String cr, String tab, '"source code for the method model not set"'
!
sourceCodeForNoSource
^ (Parser methodSpecificationForSelector: self selector), String cr, ' "source code for the method model not set"'
"Modified: / 22-12-2020 / 22:11:23 / Jan Vrany <jan.vrany@labware.com>"
! !
!RGMethod methodsFor:'accessing - backend'!
author
^ self backend forBehavior authorFor: self
!
author: aString
self backend forBehavior setAuthorFor: self to: aString
!
cleanTags
self changeProtocolDuring: [
self cleanTagsWithoutAnnouncemnt ]
!
cleanTagsWithoutAnnouncemnt
self backend forMethod cleanMethodTagsFor: self.
!
package
^ self backend forMethod methodPackageFor: self
!
package: anRGPackage
self backend forMethod setMethodPackageFor: self to: anRGPackage.
self environment addPackage: anRGPackage.
(self parent package = anRGPackage)
ifFalse: [ self package addExtensionMethod: self ].
!
protocol
| methodTags |
methodTags := self tags.
^ methodTags
ifEmpty: [ self class asYetUnclassifiedProtocolName]
ifNotEmpty: [ methodTags sorted first ]
!
protocol: aSymbol
self cleanTagsWithoutAnnouncemnt.
self tagWith: aSymbol.
!
tagWith: aSymbol
self changeProtocolDuring: [
self backend forMethod tagMethod: self with: aSymbol.
self parent addMethodTag: aSymbol.
]
!
tagsDo: aBlock
self backend forMethod tagsForMethod: self do: aBlock
!
time
^ self backend forBehavior timeFor: self
!
time: aDateAndTime
self backend forBehavior setTimeFor: self to: aDateAndTime
!
untagFrom: aSymbol
self backend forMethod untagMethod: self from: aSymbol
! !
!RGMethod methodsFor:'accessing - model'!
tags
| allTags |
allTags := IdentitySet new.
self tagsDo: [ :each | allTags add: each].
^ allTags asArray
! !
!RGMethod methodsFor:'backward compatibility'!
category
^ self protocol
! !
!RGMethod methodsFor:'default model values'!
defaultAuthor
^ ''
!
defaultSourceCode
^ self sourceCodeForNoSelector
!
defaultTags
^ Set new
!
defaultTime
^ Timestamp epoch
! !
!RGMethod methodsFor:'error handling'!
changeProtocolDuring: aBlock
| oldProtocol |
oldProtocol := self protocol.
aBlock value.
self announcer methodRecategorized: self from: oldProtocol
"Modified: / 22-12-2020 / 10:57:48 / Jan Vrany <jan.vrany@labware.com>"
! !
!RGMethod methodsFor:'initialization'!
initialize
super initialize.
sourceCode := self unresolvedValue: self defaultSourceCode.
tags := self unresolvedValue: self defaultTags. "tags must be set before package"
package := self unresolvedValue: self parent package.
author := self unresolvedValue: self defaultAuthor.
time := self unresolvedValue: self defaultTime.
!
initializeUnresolved
super initializeUnresolved.
sourceCode := self unresolvedValue: self defaultSourceCode.
tags := self unresolvedValue: self defaultTags.
package := self unresolvedValue: self parent package.
author := self unresolvedValue: self defaultAuthor.
time := self unresolvedValue: self defaultTime.
! !
!RGMethod methodsFor:'managing container'!
addoptToParentStub
super addoptToParentStub.
self environment backend createUnresolvedClassGroupFor: self parent.
self parent pvtAddLocalMethod: self.
!
defaultParentStub
^ self defaultClassStub
! !
!RGMethod methodsFor:'printing'!
printOn: aStream
self parent name ifNotNil: [
aStream nextPutAll: self parent name;
nextPutAll: '>>' ].
aStream print: self selector
! !
!RGMethod methodsFor:'private'!
astFromSource
^ RBParser parseMethod: self sourceCode
!
pvtSafeSourceCode
| aStringOrUnresolved |
aStringOrUnresolved := self pvtSourceCode.
^ aStringOrUnresolved isRingResolved
ifFalse: [
self pvtName isRingResolved
ifTrue: [ self sourceCodeForNoSource ]
ifFalse: [ self sourceCodeForNoSelector ] ]
ifTrue: [ aStringOrUnresolved value ]
!
pvtSourceCode
^ sourceCode
!
pvtSourceCode: anObject
sourceCode := anObject
!
pvtTagsDo: aBlock
^ tags value do: aBlock
! !
!RGMethod methodsFor:'private - backend interface'!
pvtAuthor
^ author value
!
pvtAuthor: aString
^ author := aString
!
pvtCleanTags
tags := self defaultTags.
"TODO:Announce if not empty"
!
pvtPackage
^ package value
!
pvtPackage: anRGPackageDefinition
self environment verifyOwnership: anRGPackageDefinition.
^ package := anRGPackageDefinition
!
pvtResolvableProperties
^ super pvtResolvableProperties, {
#sourceCode -> sourceCode.
#package -> package.
#author -> author.
#time -> time.
#tags -> tags.
}
!
pvtTagWith: aSymbol
tags isRingResolved ifFalse: [
self pvtCleanTags ].
tags add: aSymbol.
!
pvtTime
^ time value
!
pvtTime: aDateAndTime
^ time := aDateAndTime
!
pvtUntagFrom: aSymbol
(tags value includes: aSymbol)
ifTrue: [ tags remove: aSymbol ].
"TODO:Announce"
! !
!RGMethod methodsFor:'queries - class'!
methodClass
^ self parent
! !
!RGMethod methodsFor:'queries - tags'!
isTaggedWith: aSymbol
^self tags includes: aSymbol
! !
!RGMethod methodsFor:'removing'!
removeFromSystem
^ self parent removeLocalMethod: self
! !
!RGMethod methodsFor:'resolving'!
makeResolved
super makeResolved.
sourceCode := self sourceCode markAsRingResolved.
package := self package markAsRingResolved.
author := self author markAsRingResolved.
time := self time markAsRingResolved.
tags := self tags markAsRingResolved.
! !
!RGMethod methodsFor:'testing'!
isFromTrait
^ self parent isTrait
!
isLiteralMethod
"Ring methods does not know how to detect if they are literal"
^ false
!
isMetaSide
^ self parent isMeta
!
isMethod
^true
! !
!RGMethod class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
! !