"

 COPYRIGHT (c) 2006 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic' }"

Object subclass:#Annotation

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Kernel-Extensions'

!

Annotation subclass:#NameSpace

	instanceVariableNames:'nameSpace'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Annotation

!

Annotation subclass:#Resource

	instanceVariableNames:'type value'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Annotation

!

Annotation subclass:#Unknown

	instanceVariableNames:'method key arguments'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Annotation

!

!Annotation class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2006 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

! !

!Annotation class methodsFor:'initialization'!

initialize

    "Invoked at system start or when the class is dynamically loaded."

    Smalltalk at:#Pragma put:self.

    "Modified: / 09-09-2011 / 07:16:26 / cg"

! !

!Annotation class methodsFor:'instance creation'!

for: aMethod selector: aSelector arguments: anArray

	^self new

		setMethod: aMethod;

		setKeyword: aSelector;

		setArguments: anArray;

		yourself

!

key: key arguments: arguments

    ^(self respondsTo: key)

        ifTrue:

            [self 

                perform: key 

                withArguments: arguments]

        ifFalse:

            [Annotation::Unknown new 

                key: key 

                arguments: arguments]

    "Created: / 19-05-2010 / 16:47:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-07-2010 / 16:22:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

method:method key:key arguments:arguments

    ^

    "/ cg: do not react on all those methods inherited from Object (such as inline:)

    "/ self respondsTo: key)

    (self class includesSelector:key) 

        ifTrue:

            [self 

                perform: key 

                withArguments: arguments]

        ifFalse:

            [Annotation::Unknown new

                method: method

                key: key 

                arguments: arguments]

    "Created: / 19-05-2010 / 16:47:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-07-2010 / 16:22:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Created: / 05-09-2011 / 04:39:17 / cg"

!

nameSpace: aString

    ^Annotation::NameSpace new nameSpaceName: aString

    "Created: / 19-05-2010 / 16:01:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Created: / 26-07-2012 / 23:05:28 / cg"

!

namespace: aString

    <resource: #obsolete>

    ^Annotation::NameSpace new nameSpaceName: aString

    "Created: / 19-05-2010 / 16:01:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

resource: type

    ^Annotation::Resource new type: type

    "Created: / 16-07-2010 / 11:31:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

resource: type value: value

    ^Annotation::Resource new 

        type: type;

        value: value

    "Created: / 16-07-2010 / 11:31:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Annotation class methodsFor:'finding'!

allNamed: aSymbol from: aSubClass to: aSuperClass

	"Answer a collection of all pragmas found in methods of all classes between aSubClass and aSuperClass (inclusive) whose keyword is aSymbol."

	^ Array streamContents: [ :stream |

		aSubClass withAllSuperclassesDo: [ :class |

			self withPragmasIn: class do:  [ :pragma |

				pragma keyword = aSymbol

					ifTrue: [ stream nextPut: pragma ] ].

			aSuperClass = class

				ifTrue: [ ^ stream contents ] ] ].

!

allNamed: aSymbol from: aSubClass to: aSuperClass sortedByArgument: anInteger

	"Answer a collection of all pragmas found in methods of all classes between aSubClass and aSuperClass (inclusive) whose keyword is aSymbol, sorted according to argument anInteger."

	^ self allNamed: aSymbol from: aSubClass to: aSuperClass sortedUsing: [ :a :b | (a argumentAt: anInteger) < (b argumentAt: anInteger) ].

!

allNamed: aSymbol from: aSubClass to: aSuperClass sortedUsing: aSortBlock

	"Answer a collection of all pragmas found in methods of all classes between aSubClass and aSuperClass (inclusive) whose keyword is aSymbol, sorted according to aSortBlock."

	^ (self allNamed: aSymbol from: aSubClass to: aSuperClass) sort: aSortBlock.

!

allNamed: aSymbol in: aClass

	"Answer a collection of all pragmas found in methods of aClass whose keyword is aSymbol."

	^ Array streamContents: [ :stream |

		self withPragmasIn: aClass do: [ :pragma |

			pragma keyword = aSymbol

				ifTrue: [ stream nextPut: pragma ] ] ].

!

allNamed: aSymbol in: aClass sortedByArgument: anInteger

	"Answer a collection of all pragmas found in methods of aClass whose keyword is aSymbol, sorted according to argument anInteger."

	^ self allNamed: aSymbol in: aClass sortedUsing: [ :a :b | (a argumentAt: anInteger) < (b argumentAt: anInteger) ].

!

allNamed: aSymbol in: aClass sortedUsing: aSortBlock

	"Answer a collection of all pragmas found in methods of aClass whose keyword is aSymbol, sorted according to aSortBlock."

	^ (self allNamed: aSymbol in: aClass) sort: aSortBlock.

! !

!Annotation class methodsFor:'private'!

keyword: aSymbol arguments: anArray

	^ self new

		setKeyword: aSymbol;

		setArguments: anArray;

		yourself.

!

withPragmasIn: aClass do: aBlock

        aClass selectorsAndMethodsDo: [ :selector :method | method annotationsDo: aBlock ].

    "Modified: / 20-08-2011 / 21:31:49 / cg"

! !

!Annotation methodsFor:'accessing'!

first

    ^self key

    "Created: / 10-07-2010 / 21:38:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

key

    ^self subclassResponsibility

    "Created: / 19-05-2010 / 16:23:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-07-2010 / 11:29:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Annotation methodsFor:'accessing-method'!

method

        "Answer the compiled-method containing the pragma."

        self halt:'inimplemented'

    "Modified: / 21-08-2011 / 12:44:37 / cg"

!

methodClass

        "Answer the class of the method containing the pragma."

        ^ self method methodClass

    "Modified: / 21-08-2011 / 12:44:47 / cg"

!

selector

        "Answer the selector of the method containing the pragma.

         Do not confuse this with the selector of the pragma's message pattern."

        ^ self method selector

    "Modified: / 21-08-2011 / 12:45:20 / cg"

! !

!Annotation methodsFor:'accessing-pragma'!

argumentAt: anInteger

	"Answer one of the arguments of the pragma."

	^ self arguments at: anInteger.

!

arguments

        "Answer the arguments of the receiving pragma. For a pragma defined as <key1: val1 key2: val2> this will answer #(val1 val2)."

    self subclassResponsibility

    "Modified: / 21-08-2011 / 12:43:54 / cg"

!

message

	"Answer the message of the receiving pragma."

	^ Message selector: self keyword arguments: self arguments. 

!

numArgs

	"Answer the number of arguments in the pragma."

	^ self arguments size.

! !

!Annotation methodsFor:'comparing'!

analogousCodeTo: anObject 

        ^self class == anObject class

          and: [self keyword == anObject keyword

          and: [self arguments = anObject arguments]]

    "Modified: / 21-08-2011 / 12:45:37 / cg"

! !

!Annotation methodsFor:'compatibility - squeak'!

keyword

    ^ self key

    "Created: / 05-09-2011 / 04:34:26 / cg"

! !

!Annotation methodsFor:'initialization'!

setArguments: anArray

    self subclassResponsibility

    "Modified: / 21-08-2011 / 12:45:51 / cg"

!

setKeyword: aSymbol

        self subclassResponsibility

    "Modified: / 21-08-2011 / 12:46:06 / cg"

!

setMethod: aCompiledMethod

        self subclassResponsibility

    "Modified: / 21-08-2011 / 12:46:16 / cg"

! !

!Annotation methodsFor:'printing'!

printOn:aStream

    "append a printed representation if the receiver to the argument, aStream"

    self storeOn:aStream.

    "Modified: / 19-05-2010 / 16:25:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Annotation methodsFor:'printing & storing'!

storeOn:aStream

    self subclassResponsibility

    "Created: / 19-05-2010 / 16:26:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Annotation methodsFor:'processing'!

annotatesClass: aClass

    ^self subclassResponsibility

    "Created: / 20-05-2010 / 11:15:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

annotatesMethod: aMethod

    ^self subclassResponsibility

    "Created: / 20-05-2010 / 11:15:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

sendTo: anObject

	"Send the pragma keyword together with its arguments to anObject and answer the result."

	^ anObject perform: self keyword withArguments: self arguments

!

withArgumentsDo: aBlock

	"Pass the arguments of the receiving pragma into aBlock and answer the result."

	^ aBlock valueWithArguments: self arguments

! !

!Annotation methodsFor:'queries'!

refersToLiteral: anObject

    (anObject == self key) ifTrue:[ ^ true ].

    ^ false

    "Created: / 26-07-2012 / 15:58:34 / cg"

! !

!Annotation methodsFor:'testing'!

hasLiteral: aLiteral

        ^self keyword == aLiteral 

           or: [self arguments hasLiteral: aLiteral]

    "Modified: / 21-08-2011 / 12:46:44 / cg"

!

hasLiteralSuchThat: aBlock

        "Answer true if litBlock returns true for any literal in the receiver, even if embedded in further array structure.

         This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"

        ^(aBlock value: self keyword)

           or: [self arguments hasLiteralSuchThat: aBlock]

    "Modified: / 21-08-2011 / 12:46:31 / cg"

!

isResource

    ^ false

    "Created: / 18-07-2012 / 19:28:39 / cg"

!

isUnknown

    ^ false

! !

!Annotation::NameSpace methodsFor:'accessing'!

key

    ^#namespace:

    "Created: / 19-05-2010 / 16:23:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nameSpace

    ^ nameSpace

!

nameSpace:something

    nameSpace := something.

! !

!Annotation::NameSpace methodsFor:'initialization'!

nameSpaceName: aString

    self nameSpace: (NameSpace name: aString)

    "Created: / 19-05-2010 / 16:02:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Annotation::NameSpace methodsFor:'printing & storing'!

storeOn:aStream

    "superclass Annotation says that I am responsible to implement this method"

    aStream nextPutAll: '(Annotation namespace: '.

    nameSpace name storeOn: aStream.

    aStream nextPut:$)

    "Modified: / 19-05-2010 / 16:27:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Annotation::NameSpace methodsFor:'processing'!

annotatesClass:aClass

    "Nothing to do"

    "Modified: / 20-05-2010 / 11:16:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

annotatesMethod:aMethod

    aMethod lookupObject: NamespaceAwareLookup instance

    "Modified: / 20-05-2010 / 11:18:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Annotation::Resource methodsFor:'accessing'!

key

    "superclass Annotation says that I am responsible to implement this method"

    ^value 

        ifNil:[#resource:]

        ifNotNil:[#resource:value:]

    "Modified: / 16-07-2010 / 11:30:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

type

    ^ type

!

type:something

    type := something.

!

value

    ^ value

!