> methodAndNode  := self
>               compile: source
>               classified: nil
>               notifying: nil
>               trailer: self defaultMethodTrailer
>               ifFail: [^nil].

??


On Jan 4, 2010, at 3:19 PM, Stéphane Ducasse wrote:

> Igor
> 
> what is the new way of doing
> 
>       methodAndNode  := self
>               compile: source
>               classified: nil
>               notifying: nil
>               trailer: #(0 0 0 0)
>               ifFail: [^nil].
> 
> in
> addTraitSelector: aSymbol withMethod: aCompiledMethod
>       "Add aMethod with selector aSymbol to my
>       methodDict. aMethod must not be defined locally."
> 
>       | source methodAndNode |
>       self assert: [(self includesLocalSelector: aSymbol) not].
>       self ensureLocalSelectors.
>               
>       source := aCompiledMethod getSourceReplacingSelectorWith: aSymbol.
>       methodAndNode  := self
>               compile: source
>               classified: nil
>               notifying: nil
>               trailer: #(0 0 0 0)
>               ifFail: [^nil].
>       methodAndNode method putSource: source fromParseNode: methodAndNode 
> node inFile: 2
>               withPreamble: [:f | f cr; nextPut: $!; nextChunkPut: 'Trait 
> method'; cr].
>                       
>       self basicAddSelector: aSymbol withMethod: methodAndNode method
> 
> 
> In squeak and pharo the following code is used and I was wondering if the API 
> (explicit ue of trailer: or bytes (maybe a trailerObject is passed - I did 
> not check) is good. I thought that this was the job of the 
> CompilerMethodTrailer to know the bytes. 
> 
> 
> compile: code classified: category notifying: requestor trailer: bytes 
> ifFail: failBlock
>       "Compile code without logging the source in the changes file"
> 
>       | methodNode |
>       methodNode  := self compilerClass new
>                               compile: code
>                               in: self
>                               classified: category 
>                               notifying: requestor
>                               ifFail: failBlock.
>       ^ CompiledMethodWithNode generateMethodFromNode: methodNode trailer: 
> bytes.
> 
> CompiledMethodWithNode>>generateMethodFromNode: aMethodNode trailer: bytes
>       ^ self method: (aMethodNode generate: bytes) node: aMethodNode.
> 
> Stef
> 
> 
> 
>> hmm. i thought i fixed this one.
>> 
>> 2010/1/4 Levente Uzonyi <[email protected]>:
>>> On Wed, 30 Dec 2009, Stéphane Ducasse wrote:
>>> 
>>>> BIG THANKS igor!!!
>>>> 
>>>> 11127
>>>> -----
>>>> 
>>>> - Issue 1690: New Method Trailer part 7 (cs 9)
>>> 
>>> There are still some issues. Some methods (for example TPureBehavior >>
>>> #addTraitSelector:withMethod:) still use the old trailer bytes #(0 0 0 0).
>>> These should be removed asap (I had to make some surgery with #become: to
>>> compile the new version.)
>>> 
>>> 
>>> Levente
>>> 
>>>> 
>>>> _______________________________________________
>>>> Pharo-project mailing list
>>>> [email protected]
>>>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>>> 
>>> _______________________________________________
>>> Pharo-project mailing list
>>> [email protected]
>>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>>> 
>> 
>> 
>> 
>> -- 
>> Best regards,
>> Igor Stasenko AKA sig.
>> 
>> _______________________________________________
>> Pharo-project mailing list
>> [email protected]
>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
> 
> 
> _______________________________________________
> Pharo-project mailing list
> [email protected]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[email protected]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project

Reply via email to