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 <le...@elte.hu>:
>> 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
>>> Pharo-project@lists.gforge.inria.fr
>>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>> 
>> _______________________________________________
>> Pharo-project mailing list
>> Pharo-project@lists.gforge.inria.fr
>> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>> 
> 
> 
> 
> -- 
> Best regards,
> Igor Stasenko AKA sig.
> 
> _______________________________________________
> Pharo-project mailing list
> Pharo-project@lists.gforge.inria.fr
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
Pharo-project@lists.gforge.inria.fr
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project

Reply via email to