"

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 doSemanticAnalysisIn: self methodClass ]

!

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 ]) methodClass: self methodClass.

!

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

    ^ self selector asMethodPreamble, String cr, String tab, '"source code for the method model not set"'

! !

!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

! !

!RGMethod methodsFor:'error handling'!

changeProtocolDuring: aBlock

    | oldProtocol |

    oldProtocol := self protocol.

    aBlock value.

    self announce: (MethodRecategorized method: self oldProtocol: oldProtocol)

! !

!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

! !