fxga...@gmail.com
unread,Apr 24, 2012, 12:54:25 PM4/24/12You do not have permission to delete messages in this group
Either email addresses are anonymous for this group or you need the view member email addresses permission to view the original message
to
Hi Bob
Is really easy to get pragmas working on Dolphin Smalltalk without compiler support.
At the end of this message there is the source code for the Pragmas port. I don't know if this port is exactly the same as the current Pharo or Squeak version but I think is very close. I don't provide support for this ;)
How to use?
test
"Simulate Pharo <option: 0>"
##(Pragma option: 0)
^foo
Best Regards
Sebastian Calvo
| package |
package := Package name: 'Dolphin Pragmas'.
package paxVersion: 1;
basicComment: ''.
package classNames
add: #Pragma;
yourself.
package methodNames
add: #CompiledCode -> #pragmas;
yourself.
package binaryGlobalNames: (Set new
yourself).
package globalAliases: (Set new
yourself).
package setPrerequisites: (IdentitySet new
add: 'Object Arts\Dolphin\Base\Dolphin';
yourself).
package!
"Class Definitions"!
Object subclass: #Pragma
instanceVariableNames: 'method keyword arguments'
classVariableNames: ''
poolDictionaries: ''
classInstanceVariableNames: ''!
"Global Aliases"!
"Loose Methods"!
!CompiledCode methodsFor!
pragmas
"Answer the pragmas referenced by the receiver."
| answer |
answer := OrderedCollection new.
self literalsDo:
[:each |
(each isKindOf: Pragma)
ifTrue:
[each setMethod: self.
answer add: each]].
^answer asArray! !
!CompiledCode categoriesFor: #pragmas!enumerating!public! !
"End of package definition"!
"Source Globals"!
"Classes"!
Pragma guid: (GUID fromString: '{E323F6EE-6E3E-4908-8A8C-109030E2AB35}')!
Pragma comment: 'Pharo class 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]]!!'!
!Pragma categoriesForClass!Kernel-Objects! !
!Pragma methodsFor!
analogousCodeTo: anObject
^self class == anObject class
and: [keyword == anObject keyword
and: [arguments = anObject arguments]]!
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)."
^ arguments!
arguments: anObject
arguments := anObject!
key
"Answer the keyword of the pragma (the selector of its message pattern).
This accessor provides polymorphism with Associations used for properties."
^keyword!
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:."
^ keyword!
keyword: anObject
keyword := anObject!
message
"Answer the message of the receiving pragma."
^ Message selector: self keyword arguments: self arguments. !
method
"Answer the compiled-method containing the pragma."
^ method!
method: anObject
method := anObject!
methodClass
"Answer the class of the method containing the pragma."
^ method methodClass!
numArgs
"Answer the number of arguments in the pragma."
^ self arguments size.!
printOn: aStream
aStream nextPut: $<.
self keyword isUnary
ifTrue: [ aStream nextPutAll: self keyword ]
ifFalse: [
self keyword keywords with: self arguments do: [ :key :arg |
aStream nextPutAll: key; space; print: arg; space ].
aStream skip: -1 ].
aStream nextPut: $>.!
selector
"Answer the selector of the method containing the pragma.
Do not confuse this with the selector of the pragma's message pattern."
^method selector!
sendTo: anObject
"Send the pragma keyword together with its arguments to anObject and answer the result."
^ anObject perform: self keyword withArguments: self arguments!
setArguments: anArray
arguments := anArray!
setKeyword: aSymbol
keyword := aSymbol!
setMethod: aCompiledMethod
self whileMutableDo: [method := aCompiledMethod]!
withArgumentsDo: aBlock
"Pass the arguments of the receiving pragma into aBlock and answer the result."
^ aBlock valueWithArguments: self arguments! !
!Pragma categoriesFor: #analogousCodeTo:!comparing!public! !
!Pragma categoriesFor: #argumentAt:!accessing/pragma!public! !
!Pragma categoriesFor: #arguments!accessing!accessing/pragma!public! !
!Pragma categoriesFor: #arguments:!accessing!private! !
!Pragma categoriesFor: #key!accessing/pragma!public! !
!Pragma categoriesFor: #keyword!accessing!accessing/pragma!public! !
!Pragma categoriesFor: #keyword:!accessing!private! !
!Pragma categoriesFor: #message!accessing/pragma!public! !
!Pragma categoriesFor: #method!accessing!accessing/method!public! !
!Pragma categoriesFor: #method:!accessing!private! !
!Pragma categoriesFor: #methodClass!accessing/method!public! !
!Pragma categoriesFor: #numArgs!accessing/pragma!public! !
!Pragma categoriesFor: #printOn:!printing!public! !
!Pragma categoriesFor: #selector!accessing/method!public! !
!Pragma categoriesFor: #sendTo:!processing!public! !
!Pragma categoriesFor: #setArguments:!initialization!public! !
!Pragma categoriesFor: #setKeyword:!initialization!public! !
!Pragma categoriesFor: #setMethod:!initialization!public! !
!Pragma categoriesFor: #withArgumentsDo:!processing!public! !
!Pragma class methodsFor!
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.!
doesNotUnderstand: failedMessage
"Answer a new instance of the receiver
with keyword and arguments obtained from
failedMessage."
^self keyword: failedMessage selector arguments: failedMessage arguments!
for: aMethod selector: aSelector arguments: anArray
^self new
setMethod: aMethod;
setKeyword: aSelector;
setArguments: anArray;
yourself!
keyword: aSymbol
"Answer a new instance of the receiver without arguments."
^self keyword: aSymbol arguments: #()!
keyword: aSymbol arguments: anArray
self assert: [aSymbol argumentCount = anArray size].
^ self new
setKeyword: aSymbol;
setArguments: anArray;
isImmutable: true;
yourself.!
keyword: aSymbol with: arg1
"Answer a new instance of the receiver with arg1 as argument."
^self keyword: aSymbol arguments: (Array with: arg1)!
keyword: aSymbol with: arg1 with: arg2
"Answer a new instance of the receiver with arg1, arg2 as arguments."
^self keyword: aSymbol arguments: (Array with: arg1 with: arg2)!
keyword: aSymbol with: arg1 with: arg2 with: arg3
"Answer a new instance of the receiver with arg1, arg2, arg3 as arguments."
^self keyword: aSymbol arguments: (Array with: arg1 with: arg2 with: arg3)!
keyword: aSymbol with: arg1 with: arg2 with: arg3 with: arg4
"Answer a new instance of the receiver with arg1, arg2, arg3, arg4 as arguments."
^self keyword: aSymbol arguments: (Array with: arg1 with: arg2 with: arg3 with: arg4)!
keyword: aSymbol withAll: argumentArray
"Answer a new instance of the receiver with the arguments in argumentsArrsy."
^self keyword: aSymbol arguments: argumentArray!
withPragmasIn: aClass do: aBlock
aClass selectorsAndMethodsDo: [ :selector :method | method pragmas do: aBlock ].! !
!Pragma class categoriesFor: #allNamed:from:to:!finding!public! !
!Pragma class categoriesFor: #allNamed:from:to:sortedByArgument:!finding!public! !
!Pragma class categoriesFor: #allNamed:from:to:sortedUsing:!finding!public! !
!Pragma class categoriesFor: #allNamed:in:!finding!public! !
!Pragma class categoriesFor: #allNamed:in:sortedByArgument:!finding!public! !
!Pragma class categoriesFor: #allNamed:in:sortedUsing:!finding!public! !
!Pragma class categoriesFor: #doesNotUnderstand:!instance creation!public! !
!Pragma class categoriesFor: #for:selector:arguments:!instance creation!public! !
!Pragma class categoriesFor: #keyword:!instance creation!public! !
!Pragma class categoriesFor: #keyword:arguments:!private! !
!Pragma class categoriesFor: #keyword:with:!instance creation!public! !
!Pragma class categoriesFor: #keyword:with:with:!instance creation!public! !
!Pragma class categoriesFor: #keyword:with:with:with:!instance creation!public! !
!Pragma class categoriesFor: #keyword:with:with:with:with:!instance creation!public! !
!Pragma class categoriesFor: #keyword:withAll:!instance creation!public! !
!Pragma class categoriesFor: #withPragmasIn:do:!private! !
"Binary Globals"!