--- a/Annotation.st	Sun Aug 21 12:33:30 2011 +0200
+++ b/Annotation.st	Sun Aug 21 12:47:20 2011 +0200
@@ -53,6 +53,17 @@
 	privateIn:Annotation
 !
 
+Annotation comment:'I represent an occurrence of a pragma in a compiled method.  A pragma is a literal message pattern that occurs between angle brackets at the start of a method after any temporaries.  A common example is the primitive pragma:
+	<primitive: 123 errorCode: ''errorCode''>
+but one can add one''s own and use them as metadata attached to a method.  Because pragmas are messages one can browsse senders and implementors and perform them.  One can query a method for its pragmas by sendng it the pragmas message, which answers an Array of instances of me, one for each pragma in the method.
+I can provide information about the defining class, method, its selector, as well as the information about the pragma keyword and its arguments. See the two ''accessing'' protocols for details. ''accessing-method'' provides information about the method the pragma is found in, while ''accessing-pragma'' is about the pragma itself.
+Instances are retrieved using one of the pragma search methods of the ''finding'' protocol on the class side.
+To browse all methods with pragmas in the system evaluate
+	SystemNavigation default browseAllSelect: [:m| m pragmas notEmpty]
+and to browse all nonprimitive methods with pragmas evaluate
+	SystemNavigation default browseAllSelect: [:m| m primitive isZero and: [m pragmas notEmpty]]'
+!
+
 !Annotation class methodsFor:'documentation'!
 
 copyright
@@ -83,8 +94,26 @@
 "
 ! !
 
+!Annotation class methodsFor:'initialization'!
+
+initialize
+    "Invoked at system start or when the class is dynamically loaded."
+
+    Pragma := self.
+
+    "Modified: / 20-08-2011 / 21:21:24 / 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)
@@ -124,6 +153,68 @@
     "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
@@ -141,7 +232,101 @@
     "Modified: / 16-07-2010 / 11:29:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!Annotation methodsFor:'printing & storing'!
+!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"
+!
+
+keyword
+        "Answer the keyword of the pragma (the selector of its message pattern).
+         For a pragma defined as <key1: val1 key2: val2> this will answer #key1:key2:."
+        
+        self subclassResponsibility
+
+    "Modified: / 21-08-2011 / 12:45:07 / 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:'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"
@@ -149,7 +334,9 @@
     self storeOn:aStream.
 
     "Modified: / 19-05-2010 / 16:25:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+! !
+
+!Annotation methodsFor:'printing & storing'!
 
 storeOn:aStream
 
@@ -172,10 +359,38 @@
     ^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:'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"
+!
+
 isUnknown
     ^ false
 ! !
@@ -348,9 +563,11 @@
 !Annotation class methodsFor:'documentation'!
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.2 2011-07-03 15:00:45 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.3 2011-08-21 10:47:20 cg Exp $'
 !
 
 version_SVN
     ^ '§Id: Annotation.st,v 1.1 2011/06/28 11:04:04 vrany Exp §'
 ! !
+
+Annotation initialize!