SystemOrganization addCategory: #'Geppetto2-Tests'! SystemOrganization addCategory: #'Geppetto2-Kernel'! SystemOrganization addCategory: #'Geppetto2-Parameters'! SystemOrganization addCategory: #'Geppetto2-Operations'! SystemOrganization addCategory: #'Geppetto2-Private'! SystemOrganization addCategory: #'Geppetto2-Wrappers'! SystemOrganization addCategory: #'Geppetto2-Wrappers-Tests'! SystemOrganization addCategory: #'Geppetto2-Continuations'! !RBAssignmentNode methodsFor: '*geppetto2' stamp: 'md 3/9/2007 18:25'! addNode: aNode after: anotherNode parent addNode: aNode after: self! ! !RBAssignmentNode methodsFor: '*geppetto2' stamp: 'md 2/12/2007 20:55'! addNode: aNode before: anotherNode parent addNode: aNode before: self! ! !BlockContext methodsFor: '*geppetto2' stamp: 'md 2/21/2007 09:46'! blockArgNames | stream myClient | stream := (InstructionStream on: self home method) pc: self startpc. myClient := GPBlockTempDecompiler new. self numArgs timesRepeat: [stream interpretNextInstructionFor: myClient]. ^myClient offsets reversed collect: [:offset | self home methodNode tempNames at: offset + 1]. ! ! !BlockContext methodsFor: '*geppetto2' stamp: 'md 2/23/2007 12:15'! link ^GPLink metaObject: self. ! ! !BlockContext methodsFor: '*geppetto2' stamp: 'md 2/18/2007 00:30'! valueSelector self numArgs = 0 ifTrue: [^#value]. ^(String streamContents: [:stream | stream nextPutAll: 'value:'. (self numArgs - 1) timesRepeat: [stream nextPutAll: 'value:']]) asSymbol.! ! !CompiledMethod methodsFor: '*geppetto2' stamp: 'md 3/20/2007 17:25'! assignments ^self reflectiveMethod assignments.! ! !CompiledMethod methodsFor: '*geppetto2' stamp: 'md 3/20/2007 17:25'! blocks ^self reflectiveMethod blocks.! ! !CompiledMethod methodsFor: '*geppetto2' stamp: 'md 3/20/2007 17:25'! nodes ^self reflectiveMethod nodes.! ! !CompiledMethod methodsFor: '*geppetto2' stamp: 'md 3/20/2007 17:25'! sends ^self reflectiveMethod sends.! ! !CompiledMethod methodsFor: '*geppetto2' stamp: 'md 3/20/2007 17:25'! statements ^self reflectiveMethod statements.! ! !CompiledMethod methodsFor: '*geppetto2' stamp: 'md 3/21/2007 15:10'! variables ^self reflectiveMethod variables.! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 2/7/2007 11:03'! addBefore: aNode "insert this code in front of myself, if possible. Will horribly fail else" parent addNode: aNode before: self. ! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 3/29/2007 16:19'! addLinkAnnotation: aLink self annotationAt: #link ifAbsent: [self addAnnotation: (Annotation forKey: #link)]. (self annotationAt: #link) addValue: aLink. self resetCache.! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 2/20/2007 08:09'! executeBlockAfter: aBlock self link: (aBlock link control: #after).! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 2/20/2007 08:09'! executeBlockBefore: aBlock self link: aBlock link! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 3/8/2007 22:15'! gpAddAfter: aNode "insert this code in front of myself, if possible. Will horribly fail else" parent addNode: aNode after: self. ! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 3/9/2007 10:19'! gpAddBefore: aNode parent addNode: aNode before: self. ! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 2/27/2007 21:26'! gpreplaceWith: aNode ^self replaceWith: aNode! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 2/19/2007 17:59'! hasAnyLink ^self hasAnnotation: #link! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 2/19/2007 18:01'! hasLink: aLink self hasAnyLink ifFalse: [^false.]. ^(self annotationAt: #link) values includes: aLink. ! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 3/1/2007 17:34'! link: aLink aLink hookOn: self. ! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 2/19/2007 18:23'! links self hasAnyLink ifFalse: [^#()]. ^(self annotationAt: #link) values! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 3/29/2007 16:19'! removeAllLinks self hasAnyLink ifFalse: [^self]. self removeAnnotation: #link. self resetCache.! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 3/29/2007 16:19'! removeLink: aLink self hasAnyLink ifFalse: [^self]. (self annotationAt: #link) values remove: aLink ifAbsent:[].. (self annotationAt: #link) values ifEmpty: [self removeAllLinks]. self resetCache.! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 3/1/2007 17:37'! resetCache self methodNode resetCache.! ! !RBProgramNode methodsFor: '*geppetto2' stamp: 'md 2/26/2007 17:32'! supportedReifications ^(GPParameter subclasses select: [:each | each nodes anySatisfy: [:class | self isKindOf: class]]) collect: [:each | each key]. ! ! TestCase subclass: #GPBlockContextTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Tests'! !GPBlockContextTest methodsFor: 'testing' stamp: 'md 2/18/2007 00:18'! testBlockNames | block names | block := [:hey :du | ^hey + du]. names := block blockArgNames. self assert: names first = 'hey'. self assert: names second = 'du'.! ! !GPBlockContextTest methodsFor: 'testing' stamp: 'md 2/18/2007 00:25'! testValueSelector self assert: ([1] valueSelector = #value). self assert: ([:each | 1] valueSelector = #value:). self assert: ([:each :each2 | 1] valueSelector = #value:value:). self assert: ([:each :each2 :each3 | 1] valueSelector = #value:value:value:).! ! TestCase subclass: #GPContinuationTest instanceVariableNames: 'tmp tmp2' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Continuations'! !GPContinuationTest methodsFor: 'utilities' stamp: 'md 3/9/2007 16:40'! callcc: aBlock ^ GPContinuation currentDo: aBlock! ! !GPContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:26'! testBlockEscape | x | tmp := 0. x := [ tmp := tmp + 1. tmp2 value ]. self callcc: [ :cc | tmp2 := cc. x value ]. tmp2 := [ ]. x value. self assert: tmp = 2! ! !GPContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:27'! testBlockTemps | y | #(1 2 3) do: [ :i | | x | x := i. tmp ifNil: [ tmp2 := (self callcc: [ :cc | tmp := cc. [ :q ] ]) ]. tmp2 value: x. x := 17 ]. y := (self callcc: [ :cc | tmp value: cc. 42 ]). self assert: y = 1! ! !GPContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:27'! testBlockVars | continuation | tmp := 0. tmp := (self callcc: [ :cc | continuation := cc. 0 ]) + tmp. tmp2 ifNotNil: [ tmp2 value ] ifNil: [ #(1 2 3) do: [ :i | self callcc: [ :cc | tmp2 := cc. continuation value: i ] ] ]. self assert: tmp = 6! ! !GPContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:28'! testComprehension "What should this print out? | yin yang | yin := [ :x | Transcript cr. x ] value: Continuation current. yang := [ :x | Transcript nextPut: $*. x ] value: Continuation current. yin value: yang"! ! !GPContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 18:24'! testInvokeMultiple | assoc | assoc := self callcc: [ :cc | cc -> 0 ]. assoc value: assoc value + 1. self assert: assoc value ~= 5. assoc value = 4 ifFalse: [ assoc key invoke: [ assoc ] ]! ! !GPContinuationTest methodsFor: 'tests' stamp: 'mb 2/6/2007 18:20'! testInvokeSimple | x continuation | x := self callcc: [ :cc | continuation := cc. false ]. x ifFalse: [ continuation invoke: [ true & true ] ]. "Must have a least one message send in this block for VW" self assert: x! ! !GPContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:27'! testMethodTemps | i continuation | i := 0. i := i + (self callcc: [:cc | continuation := cc. 1]). self assert: i ~= 3. i = 2 ifFalse: [ continuation value: 2 ]! ! !GPContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 18:22'! testReentrant | assoc | assoc := self callcc: [ :cc | cc -> 0 ]. assoc value: assoc value + 1. self assert: assoc value ~= 5. assoc value = 4 ifFalse: [ assoc key value: assoc ]! ! !GPContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:28'! testSimpleCallCC | x continuation | x := self callcc: [ :cc | continuation := cc. false ]. x ifFalse: [ continuation value: true ]. self assert: x! ! !GPContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:28'! testSimplestCallCC | x | x := self callcc: [ :cc | cc value: true ]. self assert: x! ! TestCase subclass: #GPCountMethodWrapperTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Wrappers-Tests'! !GPCountMethodWrapperTest methodsFor: 'testing' stamp: 'md 3/20/2007 17:12'! testCounts | wrapper instance | wrapper := self wrapperClass on: #methodOne inClass: GPMwClassA. wrapper install. instance := GPMwClassA new. self assert: wrapper count = 0. instance methodOne. self assert: wrapper count = 1. instance methodOne. self assert: wrapper count = 2. wrapper uninstall.! ! !GPCountMethodWrapperTest methodsFor: 'private' stamp: 'md 2/24/2007 15:49'! wrapperClass ^ GPCountMethodWrapper! ! TestCase subclass: #GPMethodWrapperTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Wrappers-Tests'! !GPMethodWrapperTest methodsFor: 'testing' stamp: 'md 3/20/2007 17:12'! testInstallInstantiateUninstall | wrapper instance | wrapper := self wrapperClass on: #methodOne inClass: GPMwClassA. wrapper install. instance := GPMwClassA new. instance methodOne. wrapper uninstall. instance methodOne.! ! !GPMethodWrapperTest methodsFor: 'testing' stamp: 'md 3/20/2007 17:12'! testInstantiateInstallUninstall | wrapper instance | wrapper := self wrapperClass on: #methodOne inClass: GPMwClassA. instance := GPMwClassA new. instance methodOne. wrapper install. instance methodOne. wrapper uninstall. instance methodOne.! ! !GPMethodWrapperTest methodsFor: 'testing' stamp: 'md 2/25/2007 19:05'! testMethodWrapper |w| GPCounter reset. w := GPSimpleMethodWrapper on: #example inClass: GPExamples. w install. self assert: (GPCounter counter = 0). 3 timesRepeat: [self assert: (GPExamples new example = 11)]. self assert: (GPCounter counter = 6). GPCounter reset. w uninstall. 3 timesRepeat: [self assert: (GPExamples new example = 11)]. self assert: (GPCounter counter = 0). ! ! !GPMethodWrapperTest methodsFor: 'testing' stamp: 'md 2/25/2007 19:06'! testMethodWrapperWithState |w| w := GPCountMethodWrapper on: #example inClass: GPExamples. w install. self assert: (w count = 0). 3 timesRepeat: [self assert: (GPExamples new example = 11)]. self assert: (w count = 3). w uninstall. w reset. 3 timesRepeat: [self assert: (GPExamples new example = 11)]. self assert: (w count = 0). ! ! !GPMethodWrapperTest methodsFor: 'testing' stamp: 'md 3/20/2007 17:12'! testOnInClass | wrapper clientSelector wrappedClass | clientSelector := #methodOne. wrappedClass := GPMwClassA. wrapper := self wrapperClass on: clientSelector inClass: wrappedClass. self assert: wrapper clientSelector == clientSelector. self assert: wrapper clientMethod == nil. "self assert: wrapper definingClass == nil." self assert: wrapper wrappedClass == wrappedClass. "self assert: (wrapper realObjectAt: wrapper methodPosition) == wrapper." "self assert: (wrapper realObjectAt: wrapper arrayPosition) == Array." wrapper uninstall.! ! !GPMethodWrapperTest methodsFor: 'private' stamp: 'md 2/24/2007 18:48'! wrapperClass ^ GPMethodWrapper! ! TestCase subclass: #GPTimeMethodWrapperTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Wrappers-Tests'! !GPTimeMethodWrapperTest methodsFor: 'testing' stamp: 'md 3/20/2007 17:11'! testAverageTime | wrapper instance count | count := 10. wrapper := self wrapperClass on: #methodDelay inClass: GPMwClassA. wrapper install. instance := GPMwClassA new. count timesRepeat: [instance methodDelay]. self assert: wrapper count = count. self assert: (wrapper time / count asFloat) = wrapper averageTime. wrapper uninstall.! ! !GPTimeMethodWrapperTest methodsFor: 'testing' stamp: 'md 3/20/2007 17:12'! testCounts | wrapper instance | wrapper := self wrapperClass on: #methodDelay inClass: GPMwClassA. wrapper install. instance := GPMwClassA new. self assert: wrapper count = 0. instance methodDelay. self assert: wrapper count = 1. instance methodDelay. self assert: wrapper count = 2. wrapper uninstall.! ! !GPTimeMethodWrapperTest methodsFor: 'testing' stamp: 'md 3/20/2007 17:11'! testCountsAndTimes | wrapper instance | wrapper := self wrapperClass on: #methodDelay inClass: GPMwClassA. wrapper install. instance := GPMwClassA new. self assert: wrapper count = 0. self assert: wrapper time = 0. instance methodDelay. self assert: wrapper count = 1. self assert: wrapper time > 0. instance methodDelay. self assert: wrapper count = 2. self assert: wrapper time > 0. wrapper uninstall.! ! !GPTimeMethodWrapperTest methodsFor: 'testing' stamp: 'md 3/20/2007 17:11'! testTimes | wrapper instance previousTime | wrapper := self wrapperClass on: #methodDelay inClass: GPMwClassA. wrapper install. instance := GPMwClassA new. self assert: wrapper time = 0. previousTime := wrapper time. instance methodDelay. self assert: wrapper time > previousTime. previousTime := wrapper time. instance methodDelay. self assert: wrapper time > previousTime. wrapper uninstall.! ! !GPTimeMethodWrapperTest methodsFor: 'private' stamp: 'md 2/24/2007 19:17'! wrapperClass ^ GPTimeMethodWrapper! ! TestCase subclass: #GeppettoTest instanceVariableNames: 'gplink' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Tests'! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/13/2007 10:03'! assertContext: aContext GPCounter inc. self assert: (aContext isKindOf: MethodContext).! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/8/2007 21:15'! assertControl: aSymbol GPCounter inc. self assert: (aSymbol = #before).! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/23/2007 17:01'! assertGlobal: aNode GPCounter inc. self assert: (aNode isKindOf: RBVariableNode). ! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/8/2007 17:58'! assertLink: link GPCounter inc. self assert: (link isKindOf: GPLink). self assert: (link arguments = #(link)).! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/12/2007 22:19'! assertMethod GPCounter inc! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/12/2007 23:36'! assertMethod: aMethodNode GPCounter inc. self assert: (aMethodNode isKindOf: RBMethodNode)! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/13/2007 11:52'! assertMethodArg1: anObject GPCounter inc. self assert: (anObject = 5)! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/13/2007 12:05'! assertMethodArgs: anArray GPCounter inc. self assert: (anArray first = 5)! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/9/2007 11:01'! assertName: aName GPCounter inc. self assert: (aName = 'i').! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/9/2007 14:00'! assertNode: aNode GPCounter inc. self assert: (aNode isKindOf: RBProgramNode).! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/15/2007 10:06'! assertOperationMethod: anOperation GPCounter inc. self assert: (anOperation isKindOf: GPMethod). self assert: (anOperation arguments class = Array). self assert: (anOperation receiver isKindOf: GPExamples).! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/13/2007 10:26'! assertReceiverForMethod: anObject GPCounter inc. self assert: (anObject isKindOf: GPExamples) ! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/13/2007 10:30'! assertSelectorMethod: aSymbol GPCounter inc. self assert: (aSymbol = #example).! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/13/2007 10:07'! assertSelf: aContext GPCounter inc. self assert: (aContext isKindOf: GPExamples).! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/13/2007 10:57'! assertSenderForMethod: anObject GPCounter inc. self assert: (anObject isKindOf: GeppettoTest) ! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/8/2007 21:24'! assertSenderSelector: aSymbol GPCounter inc. self assert: (aSymbol isSymbol).! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/15/2007 10:45'! assertSenderSelectorForMethod: aSymbol GPCounter inc. self assert: (aSymbol = #testReifyMethodSenderSelector).! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 3/1/2007 13:41'! checkArg: array1 arg: array2 GPCounter inc. self assert: array1 == array2.! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 3/9/2007 15:57'! continue: aContinuation GPCounter inc. aContinuation value: 11.! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/12/2007 20:50'! csend: selector to: receiver withArguments: argument GPCounter inc.! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/12/2007 13:48'! deactivate: aLink GPCounter inc. aLink condition: false. ! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/7/2007 17:18'! iVarAt: offset in: object GPCounter inc. ^object instVarAt: offset.! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/7/2007 17:21'! iVarAt: offset in: object to: newvalue GPCounter inc. ^object instVarAt: offset put: newvalue! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/7/2007 17:18'! iVarNamed: varname in: object GPCounter inc. ^object instVarNamed: varname.! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/7/2007 18:21'! iVarNamed: varname in: object to: newvalue GPCounter inc. ^object instVarNamed: varname put: newvalue! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/8/2007 15:33'! operation: anOperation GPCounter inc. ^anOperation value.! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/20/2007 16:05'! operationProceed: anOperation context: aContext GPCounter inc. anOperation value. thisContext swapSender: aContext. ! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/7/2007 12:49'! return77 ^77! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/7/2007 17:18'! send: selector to: receiver with: argument GPCounter inc. ^receiver perform: selector with: argument! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/8/2007 11:34'! send: selector to: receiver withArguments: argument GPCounter inc. ^receiver perform: selector withArguments: argument! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/8/2007 14:51'! tempVarAt: offtset in: aContext GPCounter inc. ^aContext tempAt: offtset.! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/8/2007 14:51'! tempVarAt: offtset in: aContext put: newValue GPCounter inc. ^aContext tempAt: offtset put: newValue.! ! !GeppettoTest class methodsFor: 'examples' stamp: 'md 2/26/2007 16:53'! uninstall: aLink GPCounter inc. aLink uninstall.! ! !GeppettoTest methodsFor: 'tools' stamp: 'md 2/19/2007 17:59'! assertNoLinks: aMethod aMethod nodes do: [:node | self assert: node hasAnyLink not].! ! !GeppettoTest methodsFor: 'tools' stamp: 'md 3/20/2007 17:25'! removeLinks: aMethod aMethod reflectiveMethod methodNode nodesDo: [:node | node hasAnyLink ifTrue: [node removeAllLinks]].! ! !GeppettoTest methodsFor: 'setup' stamp: 'md 3/28/2007 11:22'! setup gplink := nil. GPExamples methodDict values do: [:method | self removeLinks: method. self assertNoLinks: method. ].! ! !GeppettoTest methodsFor: 'setup' stamp: 'md 3/28/2007 11:22'! tearDown gplink ifNotNil: [gplink uninstall]. GPExamples methodDict values do: [:method | self removeLinks: method. self assertNoLinks: method. ].! ! !GeppettoTest methodsFor: 'testing - blocks' stamp: 'md 2/27/2007 21:11'! testBlockAfter gplink := GPLink new metaObject: [GPCounter inc]; control: #after. (GPExamples>>#exampleBlock) blocks do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleBlock = 8). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - blocks' stamp: 'md 2/27/2007 21:15'! testBlockArg1 gplink := GPLink metaObject: [:arg1 | self assert: arg1 = 2. GPCounter inc]. (GPExamples>>#exampleBlock) blocks do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleBlock = 8). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - blocks' stamp: 'md 2/27/2007 21:18'! testBlockArguments gplink := GPLink metaObject: [:arguments | self assert: (arguments first = 2). GPCounter inc]. (GPExamples>>#exampleBlock) blocks do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleBlock = 8). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - meta' stamp: 'md 2/22/2007 18:27'! testBlockAsLink (GPExamples>>#example) sends do: [:node | node link: ([:control | GPCounter inc. self assert: (control = #before)] link) ]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). self removeLinks: (GPExamples>>#example).! ! !GeppettoTest methodsFor: 'testing - meta' stamp: 'md 2/23/2007 11:02'! testBlockAsMeta gplink := GPLink new metaObject: [:control | GPCounter inc. self assert: (control = #before)]; selector: #value:; arguments: #(control). (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - meta' stamp: 'md 2/23/2007 11:04'! testBlockAsMetaNoArg gplink := GPLink metaObject: [GPCounter inc]. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - meta' stamp: 'md 2/23/2007 11:22'! testBlockAsMetaNoSel gplink := GPLink new metaObject: [:control | GPCounter inc. self assert: (control = #before)]; arguments: #(control). (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - meta' stamp: 'md 2/23/2007 12:08'! testBlockAsMetaNoSelNoArg gplink := GPLink metaObject: [:control | GPCounter inc. self assert: (control = #before)]. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - blocks' stamp: 'md 4/14/2007 00:40'! testBlockBefore gplink := GPLink metaObject: [GPCounter inc]. (GPExamples>>#exampleBlock) blocks do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleBlock = 8). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - blocks' stamp: 'md 3/9/2007 09:48'! testBlockReplace gplink := GPLink new metaObject: [GPCounter inc. 5]; control: #instead. (GPExamples>>#exampleBlock) blocks do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleBlock = 5). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - condition' stamp: 'md 2/19/2007 18:51'! testConditionArgument gplink := GPLink new metaObject: self class; selector: #assertControl:; arguments: #(control); condition: [:context | context receiver class = GPExamples]. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). ! ! !GeppettoTest methodsFor: 'testing - condition' stamp: 'md 2/19/2007 23:08'! testConditionArgumentLink gplink := GPLink new metaObject: self class; selector: #assertControl:; arguments: #(control); condition: [:link | link = gplink]. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). ! ! !GeppettoTest methodsFor: 'testing - condition' stamp: 'md 2/21/2007 09:26'! testConditionArgumentMultiple gplink := GPLink new metaObject: self class; selector: #assertControl:; arguments: #(control); condition: [:link :context | self assert: (context isKindOf: ContextPart). link = gplink]. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). ! ! !GeppettoTest methodsFor: 'testing - condition' stamp: 'md 3/8/2007 22:07'! testConditionArgumentNoInline gplink := GPLink new metaObject: self class; selector: #assertControl:; arguments: #(control); noInlineCondition; condition: [:context | context receiver class = GPExamples]. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). ! ! !GeppettoTest methodsFor: 'testing - condition' stamp: 'md 2/19/2007 22:40'! testConditionBoolean gplink := GPLink new metaObject: self class; selector: #assertControl:; arguments: #(control); condition: false. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 0). gplink condition: true. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). ! ! !GeppettoTest methodsFor: 'testing - condition' stamp: 'md 2/19/2007 22:41'! testConditionSimple gplink := GPLink new metaObject: self class; selector: #assertControl:; arguments: #(control); condition: [false]. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 0). gplink condition: [true]. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). ! ! !GeppettoTest methodsFor: 'testing - meta' stamp: 'md 2/21/2007 09:37'! testExecuteBlockBefore (GPExamples>>#example) sends do: [:node | node executeBlockBefore: [:control | GPCounter inc]. ]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). self removeLinks: (GPExamples>>#example).! ! !GeppettoTest methodsFor: 'testing - link API' stamp: 'md 2/19/2007 22:43'! testLinkAPI gplink := GPLink new metaObject: Object new; selector: #tagNode:. self assert: gplink notNil. self assert: (gplink metaObject isKindOf: Object). self assert: (gplink selector = #tagNode:). self assert: (gplink control = #before).! ! !GeppettoTest methodsFor: 'testing - link API' stamp: 'md 2/19/2007 22:43'! testLinkAPIArgs gplink := GPLink new metaObject: self class; selector: #tagNode:; arguments: #(node). self assert: (gplink arguments = #(node)).! ! !GeppettoTest methodsFor: 'testing - link API' stamp: 'md 3/9/2007 09:48'! testLinkCompatibilityCheck gplink := (GPLink metaObject: self class) selector: #operation:; control: #instead; arguments: #(arg1). self should: [(GPExamples>>#example) variables do: [:send | send link: gplink]] raise: Error whoseDescriptionIncludes: 'not possible on this node' description: 'Wrong reification arguments for this node '.! ! !GeppettoTest methodsFor: 'testing - link update' stamp: 'md 2/21/2007 09:26'! testLinkDeactivate gplink := GPLink new metaObject: self class; selector: #deactivate:; control: #before; arguments: #(link); condition: true. (GPExamples>>#example) statements do: [:node | node isMessage ifTrue: [node link: gplink]]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 0).! ! !GeppettoTest methodsFor: 'testing - link update' stamp: 'md 3/9/2007 09:48'! testLinkReplaceInactive gplink := GPLink new metaObject: self class; selector: #send:to:withArguments:; control: #instead; arguments: #(selector receiver arguments); condition: [false]. ((GPExamples>>#example) nodes select: #isMessage) do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 0). gplink condition: [true]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). ! ! !GeppettoTest methodsFor: 'testing - link update' stamp: 'md 3/9/2007 09:48'! testLinkReplaceInactiveNotInlined gplink := GPLink new metaObject: self class; selector: #send:to:withArguments:; control: #instead; arguments: #(selector receiver arguments); noInlineCondition; condition: [false]. ((GPExamples>>#example) nodes select: #isMessage) do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 0). gplink condition: [true]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). ! ! !GeppettoTest methodsFor: 'testing - link update' stamp: 'md 2/21/2007 09:40'! testLinkUninstall gplink := GPLink new metaObject: self class; selector: #uninstall:; control: #before; arguments: #(link); condition: true. (GPExamples>>#example) statements do: [:node | node isMessage ifTrue: [node link: gplink]]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 0).! ! !GeppettoTest methodsFor: 'testing - link update' stamp: 'md 2/21/2007 09:40'! testLinkUpdating gplink := GPLink new metaObject: self class; selector: #assertControl:; arguments: #(control). (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). gplink selector: #assertNode:; arguments: #(node). self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - moScope' stamp: 'md 3/8/2007 20:27'! testMoScope gplink := GPLink new metaObjectCreator: [self class]; selector: #assertControl:; moScope: #class; arguments: #(control). (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - moScope' stamp: 'md 3/8/2007 22:03'! testMoScopeNode gplink := GPLink new metaObjectCreator: [self class]; selector: #assertControl:; moScope: #node; arguments: #(control). (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). self assert: gplink metaObject size = 1.! ! !GeppettoTest methodsFor: 'testing - moScope' stamp: 'md 3/8/2007 22:04'! testMoScopeObject gplink := GPLink new metaObjectCreator: [self class]; selector: #assertControl:; moScope: #object; arguments: #(control). (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). self assert: (GPExamples new example = 11). self assert: gplink metaObject size = 2.! ! !GeppettoTest methodsFor: 'testing - meta' stamp: 'md 3/9/2007 09:48'! testObjectAsMeta gplink := GPLink new metaObject: #object; selector: #instVarAt:put:; control: #instead; arguments: #(offset newValue). (GPExamples>>#exampleIvar) assignments do: [:node | node link: gplink]. self assert: (GPExamples new exampleIvar = 11). ! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:49'! testOperationAssignment gplink := (GPLink metaObject: self class) selector: #operation:; control: #instead; arguments: #(operation). (GPExamples>>#exampleIvar) assignments do: [:send | send link: gplink]. GPCounter reset. self assert: (GPExamples new exampleIvar = 11). self assert: GPCounter counter = 1. ! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:48'! testOperationAssignmentProceed gplink := (GPLink metaObject: self class) selector: #operationProceed:context:; control: #instead; arguments: #(operation context). (GPExamples>>#exampleIvar) assignments do: [:send | send link: gplink]. GPCounter reset. self assert: (GPExamples new exampleIvar = 11). self assert: GPCounter counter = 1. ! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:49'! testOperationAssignmentTemp gplink := (GPLink metaObject: self class) selector: #operation:; control: #instead; arguments: #(operation). (GPExamples>>#example) assignments do: [:send | send link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: GPCounter counter = 2. ! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:48'! testOperationSend gplink := GPLink new metaObject: self class; selector: #operation:; control: #instead; arguments: #(operation). (GPExamples>>#example) sends do: [:send | send link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: GPCounter counter = 1. ! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:49'! testOperationSendManyArgs gplink := GPLink new metaObject: self class; selector: #operation:; control: #instead; arguments: #(operation). (GPExamples>>#exampleSendmanyArgs) sends do: [:send | send link: gplink]. GPCounter reset. self assert: (GPExamples new exampleSendmanyArgs = 15). self assert: GPCounter counter = 2. ! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:49'! testOperationSendMetaBlock gplink := GPLink new metaObject: self class; selector: #operation:; control: #instead; arguments: #(operation). (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: GPCounter counter = 1. ! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:50'! testOperationSendObjectSpecific | object | object := GPExamples new. gplink := (GPLink metaObject: self class) selector: #operation:; control: #instead; condition: [:context | context receiver = object]; arguments: #(operation). (GPExamples>>#example) sends do: [:send | send link: gplink]. GPCounter reset. self assert: (object example = 11). self assert: GPCounter counter = 1. self assert: (GPExamples new example = 11). self assert: GPCounter counter = 1. ! ! !GeppettoTest methodsFor: 'testing - proceed' stamp: 'md 3/9/2007 09:49'! testOperationSendProceed gplink := GPLink new metaObject: [:proceed | GPCounter inc. proceed value]; selector: #value:; control: #instead; arguments: #(proceed). (GPExamples>>#example) sends do: [:send | send link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: GPCounter counter = 1.! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:50'! testOperationSendZeroArgs gplink := GPLink new metaObject: self class; selector: #operation:; control: #instead; arguments: #(operation). (GPExamples>>#exampleSendZeroArg) sends do: [:send | send link: gplink]. GPCounter reset. self assert: (GPExamples new exampleSendZeroArg = 5 factorial). self assert: GPCounter counter = 1. ! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:50'! testOperationVariable gplink := (GPLink metaObject: self class) selector: #operation:; control: #instead; arguments: #(operation). (GPExamples>>#exampleIvar) variables do: [:send | send link: gplink]. GPCounter reset. self assert: (GPExamples new exampleIvar = 11). self assert: GPCounter counter = 1. ! ! !GeppettoTest methodsFor: 'testing - operation' stamp: 'md 3/9/2007 09:50'! testOperationVariableTemp gplink := (GPLink metaObject: self class) selector: #operation:; control: #instead; arguments: #(operation). (GPExamples>>#example) variables do: [:send | send link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: GPCounter counter = 2. ! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 2/21/2007 09:28'! testReificationAsMeta gplink := GPLink new metaObject: #object; selector: #testReifyMo. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:50'! testReificationAsMetaClass gplink := GPLink new metaObject: #class; control: #instead; selector: #name. (GPExamples>>#example) sends do: [:node | node link: gplink]. self assert: (GPExamples new example = 'GPExamples'). ! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 2/23/2007 17:03'! testReifyClassVarAssignment gplink := GPLink metaObject: [:node | GPCounter inc. self assert: node isAssignment]. (GPExamples>>#exampleClassWrite) assignments do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleClassWrite = 5). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 2/24/2007 10:00'! testReifyClassVarAssignmentBinding gplink := GPLink metaObject: [:binding | GPCounter inc. self assert: (binding key = #Test)]. (GPExamples>>#exampleClassWrite) assignments do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleClassWrite = 5). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 2/24/2007 09:36'! testReifyClassVarAssignmentNewValue gplink := GPLink metaObject: [:newValue | GPCounter inc. self assert: newValue = 5]. (GPExamples>>#exampleClassWrite) assignments do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleClassWrite = 5). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 3/9/2007 09:50'! testReifyClassVarAssignmentOperation gplink := GPLink new metaObject: self class; selector: #operation:; control: #instead; arguments: #(operation). (GPExamples>>#exampleClassWrite) assignments do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleClassWrite = 5). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 3/9/2007 09:50'! testReifyClassVarAssignmentProceed gplink := GPLink new metaObject: [:proceed | GPCounter inc. proceed value]; control: #instead. (GPExamples>>#exampleClassWrite) assignments do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleClassWrite = 5). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - continuations' stamp: 'md 3/9/2007 16:40'! testReifyContinuation gplink := GPLink new metaObject: [:continuation | GPCounter inc. self assert: (continuation isKindOf: GPContinuation)]. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - continuations' stamp: 'md 3/9/2007 16:41'! testReifyContinuationReplace gplink := GPLink new metaObject: [:continuation | GPCounter inc. self assert: (continuation isKindOf: GPContinuation). 11]; control: #instead. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - continuations' stamp: 'md 3/9/2007 15:57'! testReifyContinuationReplaceValue gplink := GPLink new metaObject: self class; selector: #continue:; arguments: #(continuation); control: #instead. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - continuations' stamp: 'md 3/9/2007 15:58'! testReifyContinuationReplaceValue2 gplink := GPLink new metaObject: [:continuation | GPCounter inc. continuation value: 11]; control: #instead. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - continuations' stamp: 'md 3/9/2007 15:58'! testReifyContinuationReplaceValueOperation gplink := GPLink new metaObject: [:continuation :operation | GPCounter inc. continuation value: operation value]; control: #instead. (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 2/21/2007 09:28'! testReifyControl gplink := GPLink new metaObject: self class; selector: #assertControl:; control: #before; arguments: #(control). (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/8/2007 22:07'! testReifyControlNoInlineMeta gplink := GPLink new metaObject: self class; selector: #assertControl:; control: #before; noInlineMeta; arguments: #(control). (GPExamples>>#example) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1). ! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 2/23/2007 14:08'! testReifyGlobalRead gplink := GPLink new metaObject: self class; selector: #assertGlobal:; arguments: #(node). ((GPExamples>>#exampleGlobalRead) variables select: [:node | node isRead]) do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleGlobalRead = Smalltalk). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 2/24/2007 09:59'! testReifyGlobalReadBinding gplink := GPLink metaObject: [:binding | GPCounter inc. self assert: (binding key = #Smalltalk)]. ((GPExamples>>#exampleGlobalRead) variables select: [:node | node isGlobal]) do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleGlobalRead = Smalltalk). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 3/9/2007 09:50'! testReifyGlobalReadOperation gplink := GPLink new metaObject: self class; selector: #operation:; control: #instead; arguments: #(operation). ((GPExamples>>#exampleGlobalRead) variables select: [:node | node isRead]) do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleGlobalRead = Smalltalk). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 3/9/2007 09:50'! testReifyGlobalReadProceed gplink := GPLink new metaObject: [:proceed | GPCounter inc. proceed value]; control: #instead. ((GPExamples>>#exampleGlobalRead) variables select: [:node | node isGlobal]) do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleGlobalRead = Smalltalk). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - globals' stamp: 'md 2/23/2007 16:54'! testReifyGlobalReadValue gplink := GPLink metaObject: [:value | GPCounter inc. self assert: value = Smalltalk]. ((GPExamples>>#exampleGlobalRead) variables select: [:node | node isGlobal]) do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleGlobalRead = Smalltalk). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:50'! testReifyIvarAssignment gplink := GPLink new metaObject: self class; selector: #iVarAt:in:to:; control: #instead; arguments: #(offset object newValue). (GPExamples>>#exampleIvar) assignments do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleIvar = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:50'! testReifyIvarAssignmentName gplink := GPLink new metaObject: self class; selector: #iVarNamed:in:to:; control: #instead; arguments: #(varname object newValue). (GPExamples>>#exampleIvar) assignments do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleIvar = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:50'! testReifyIvarRead gplink := GPLink new metaObject: self class; selector: #'iVarAt:in:'; control: #instead; arguments: #(offset object). ((GPExamples>>#exampleIvar) variables select: [:node | node isRead]) do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleIvar = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 2/21/2007 09:30'! testReifyIvarReifyName gplink := GPLink new metaObject: self class; selector: #'assertName:'; control: #before; arguments: #(varname). (GPExamples>>#exampleIvar) statements do: [:node | (node isVariable and: [node isRead]) ifTrue: [node link: gplink]]. GPCounter reset. self assert: (GPExamples new exampleIvar = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 2/21/2007 09:30'! testReifyLink gplink := GPLink new metaObject: self class; selector: #assertLink:; control: #before; arguments: #(link). (GPExamples>>#example) statements do: [:node | node isMessage ifTrue: [node link: gplink]]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:45'! testReifyMethodAfter gplink := GPLink new metaObject: self class; selector: #assertMethod; control: #after. (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: GPCounter counter = 1.! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 3/28/2007 11:43'! testReifyMethodArg1 gplink := GPLink new metaObject: self class; selector: #assertMethodArg1:; control: #before; arguments: #(arg1). (GPExamples>>#examplea:b:) methodNode link: gplink. GPCounter reset. self assert: ((GPExamples new examplea: 5 b: 6) = 11). self assert: (GPCounter counter = 1). gplink uninstall.! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:46'! testReifyMethodArguments gplink := GPLink new metaObject: self class; selector: #assertMethodArgs:; control: #before; arguments: #(arguments). (GPExamples>>#examplea:b:) methodNode link: gplink. GPCounter reset. self assert: ((GPExamples new examplea: 5 b: 6) = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 3/28/2007 11:20'! testReifyMethodBefore gplink := GPLink new metaObject: self class; selector: #assertMethod; control: #before. (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: GPCounter counter = 1.! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:46'! testReifyMethodContext gplink := GPLink new metaObject: self class; selector: #assertContext:; control: #before; arguments: #(context). (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:46'! testReifyMethodControl gplink := GPLink new metaObject: self class; selector: #assertControl:; control: #before; arguments: #(control). (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 3/28/2007 14:34'! testReifyMethodLink gplink := GPLink new metaObject: self class; selector: #assertLink:; control: #before; arguments: #(link). (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:47'! testReifyMethodNode gplink := GPLink new metaObject: self class; selector: #assertMethod:; control: #after; arguments: #(node). (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:47'! testReifyMethodOperation gplink := GPLink new metaObject: self class; selector: #assertOperationMethod:; control: #before; arguments: #(operation). (GPExamples>>#examplea:b:) methodNode link: gplink. GPCounter reset. self assert: ((GPExamples new examplea: 5 b: 6) = 11). self assert: GPCounter counter = 1.! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:47'! testReifyMethodOperationManyArguments gplink := GPLink new metaObject: self class; selector: #assertOperationMethod:; control: #before; arguments: #(operation). (GPExamples>>#examplea:b:c:d:e:) methodNode link: gplink. GPCounter reset. self assert: ((GPExamples new examplea: 1 b: 1 c: 1 d: 1 e: 1) = 5). self assert: GPCounter counter = 1.! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 3/9/2007 09:51'! testReifyMethodOperationReplace gplink := GPLink new metaObject: self class; selector: #assertOperationMethod:; control: #instead; arguments: #(operation). (GPExamples>>#examplea:b:) methodNode link: gplink. GPCounter reset. GPExamples new examplea: 5 b: 6. self assert: GPCounter counter = 1.! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 3/9/2007 09:51'! testReifyMethodOperationReplaceCondition gplink := GPLink new metaObject: self class; selector: #assertOperationMethod:; control: #instead; arguments: #(operation); condition: [true]. (GPExamples>>#examplea:b:) methodNode link: gplink. GPCounter reset. GPExamples new examplea: 5 b: 6. self assert: GPCounter counter = 1.! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 3/9/2007 09:51'! testReifyMethodOperationReplaceConditionFalse gplink := GPLink new metaObject: self class; selector: #assertOperationMethod:; control: #instead; arguments: #(operation); condition: [false]. (GPExamples>>#examplea:b:) methodNode link: gplink. GPCounter reset. GPExamples new examplea: 5 b: 6. self assert: GPCounter counter = 0.! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:49'! testReifyMethodReceiver gplink := GPLink new metaObject: self class; selector: #assertReceiverForMethod:; control: #before; arguments: #(receiver). (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - result' stamp: 'md 3/10/2007 14:05'! testReifyMethodResult "gplink := GPLink new metaObject: [:result | GPCounter inc. self assert: result = true]; control: #after. (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: GPCounter counter = 1."! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:49'! testReifyMethodSelector gplink := GPLink new metaObject: self class; selector: #assertSelectorMethod:; control: #before; arguments: #(selector). (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/20/2007 09:13'! testReifyMethodSelf gplink := GPLink new metaObject: self class; selector: #assertSelf:; control: #before; arguments: #(object). (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:50'! testReifyMethodSender gplink := GPLink new metaObject: self class; selector: #assertSenderForMethod:; control: #before; arguments: #(sender). (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - methods' stamp: 'md 2/19/2007 22:50'! testReifyMethodSenderSelector gplink := GPLink new metaObject: self class; selector: #assertSenderSelectorForMethod:; control: #before; arguments: #(senderselector). (GPExamples>>#example) methodNode link: gplink. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 1).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 2/21/2007 09:30'! testReifyNode gplink := GPLink new metaObject: self class; selector: #assertNode:; control: #before; arguments: #(node). (GPExamples>>#example) statements do: [:node | node isMessage ifTrue: [node link: gplink]]. GPCounter reset. self assert: (GPExamples new example = 11). ! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 2/21/2007 09:30'! testReifyNodeBeforeAfter gplink := GPLink new metaObject: self class; selector: #assertNode:; control: #beforeafter; arguments: #(node). (GPExamples>>#example) statements do: [:node | node isAssignment ifTrue: [node link: gplink]]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 4)! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:51'! testReifySend gplink := GPLink new metaObject: self class; selector: #send:to:with:; control: #instead; arguments: #(selector receiver arg1). (GPExamples>>#example) statements do: [:node | node isMessage ifTrue: [node link: gplink]]. self assert: (GPExamples new example = 11).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:51'! testReifySendArguments2 gplink := GPLink new metaObject: self class; selector: #send:to:withArguments:; control: #instead; arguments: #(selector receiver arguments). (GPExamples>>#exampleSend) sends do: [:node | node link: gplink]. self assert: (GPExamples new exampleSend).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 2/21/2007 09:37'! testReifySendArgumentsDual gplink := GPLink new metaObject: self class; selector: #checkArg:arg:; arguments: #(arguments arguments). (GPExamples>>#exampleSend) sends do: [:node | node link: gplink]. self assert: (GPExamples new exampleSend).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:51'! testReifySendArgumentsMany gplink := GPLink new metaObject: self class; selector: #send:to:withArguments:; control: #instead; arguments: #(selector receiver arguments). (GPExamples>>#exampleSendmanyArgs) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleSendmanyArgs = 15). self assert: (GPCounter counter = 2)! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:51'! testReifySendArgumentsZero gplink := GPLink new metaObject: self class; selector: #send:to:withArguments:; control: #instead; arguments: #(selector receiver arguments). (GPExamples>>#exampleSendZeroArg) sends do: [:node | node link: gplink]. self assert: ((GPExamples new exampleSendZeroArg) = 5 factorial).! ! !GeppettoTest methodsFor: 'testing - result' stamp: 'md 3/9/2007 18:08'! testReifySendResult gplink := GPLink new metaObject: [:result | GPCounter inc. self assert: result = true]; control: #after. (GPExamples>>#exampleSend2) sends do: [:node | node link: gplink]. GPCounter reset. self assert: (GPExamples new exampleSend2). self assert: GPCounter counter = 1.! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:51'! testReifyTempVarAssign gplink := GPLink new metaObject: self class; selector: #'tempVarAt:in:put:'; control: #instead; arguments: #(offset context newValue). (GPExamples>>#example) nodes do: [:node | (node isAssignment) ifTrue: [node link: gplink]]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - reifications' stamp: 'md 3/9/2007 09:51'! testReifyTempVarRead gplink := GPLink new metaObject: self class; selector: #'tempVarAt:in:'; control: #instead; arguments: #(offset context). (GPExamples>>#example) variables do: [:node | node isRead ifTrue: [node link: gplink]]. GPCounter reset. self assert: (GPExamples new example = 11). self assert: (GPCounter counter = 2).! ! !GeppettoTest methodsFor: 'testing - continuations' stamp: 'md 3/9/2007 16:41'! testRequestsContiunation gplink := GPLink new metaObject: [:continuation | GPCounter inc. self assert: (continuation isKindOf: GPContinuation)]. self assert: gplink requestsContinuation.! ! !GeppettoTest methodsFor: 'testing - examples' stamp: 'md 2/21/2007 09:25'! testStatementCounter | nodes | nodes := OrderedCollection new. gplink := GPCounter link. (GPExamples>>#example) statements do: [:node | node isAssignment ifTrue: [ nodes add: node. node link: gplink ] ]. nodes do: [:node | self assert: (node hasLink: gplink). ]. self assert: (GPExamples new example = 11). self assert: gplink metaObject count = 2.! ! !GeppettoTest methodsFor: 'testing - examples' stamp: 'md 2/21/2007 09:16'! testStatementCounterAfter gplink := GPCounter link control: #after. (GPExamples>>#example) statements do: [:node | node isAssignment ifTrue: [node link: gplink]]. self assert: (GPExamples new example = 11). self assert: gplink metaObject count = 2.! ! !GeppettoTest methodsFor: 'testing - examples' stamp: 'md 2/21/2007 09:23'! testStatementCounterBefore gplink := GPCounter link. (GPExamples>>#example) assignments do: [:node | node link: gplink]. self assert: (GPExamples new example = 11). self assert: gplink metaObject count = 2.! ! !GeppettoTest methodsFor: 'testing - examples' stamp: 'md 3/9/2007 09:51'! testStatementSimpleReplace gplink := GPLink new metaObject: self class; selector: #return77; control: #instead. (GPExamples>>#example) sends do: [:node | node link: gplink]. self assert: (GPExamples new example = 77).! ! !GeppettoTest methodsFor: 'testing - multiple' stamp: 'md 2/26/2007 16:54'! testTwoLinks | link1 link2 | link1 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #before; arguments: #(selector receiver arguments). link2 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #before; arguments: #(selector receiver arguments). (GPExamples>>#exampleSend) sends do: [:node | node link: link1; link: link2]. GPCounter reset. self assert: (GPExamples new exampleSend). self assert: (GPCounter counter = 2). link1 uninstall. link2 uninstall. ! ! !GeppettoTest methodsFor: 'testing - multiple' stamp: 'md 2/26/2007 16:54'! testTwoLinksAfter | link1 link2 | link1 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #after; arguments: #(selector receiver arguments). link2 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #after; arguments: #(selector receiver arguments). (GPExamples>>#exampleSend2) sends do: [:node | node link: link1; link: link2]. GPCounter reset. self assert: (GPExamples new exampleSend2). self assert: (GPCounter counter = 2). link1 uninstall. link2 uninstall. ! ! !GeppettoTest methodsFor: 'testing - multiple' stamp: 'md 2/26/2007 16:54'! testTwoLinksAfter2 | link1 link2 | link1 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #after; arguments: #(selector receiver arguments). link2 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #after; arguments: #(selector receiver arguments). (GPExamples>>#exampleSend2) sends do: [:node | node link: link2; link: link1]. GPCounter reset. self assert: (GPExamples new exampleSend2). self assert: (GPCounter counter = 2). link1 uninstall. link2 uninstall. ! ! !GeppettoTest methodsFor: 'testing - multiple' stamp: 'md 3/9/2007 10:04'! testTwoLinksAfterReplace | link1 link2 | link1 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #after; arguments: #(selector receiver arguments). link2 := GPLink new metaObject: self class; selector: #send:to:withArguments:; control: #instead; arguments: #(selector receiver arguments). (GPExamples>>#exampleSend2) sends do: [:node | node link: link1; link: link2]. GPCounter reset. self assert: (GPExamples new exampleSend2). self assert: (GPCounter counter = 2). link1 uninstall. link2 uninstall. ! ! !GeppettoTest methodsFor: 'testing - multiple' stamp: 'md 3/9/2007 10:04'! testTwoLinksAfterReplace2 | link1 link2 | link1 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #after; arguments: #(selector receiver arguments). link2 := GPLink new metaObject: self class; selector: #send:to:withArguments:; control: #instead; arguments: #(selector receiver arguments). (GPExamples>>#exampleSend2) sends do: [:node | node link: link2; link: link1]. GPCounter reset. self assert: (GPExamples new exampleSend2). self assert: (GPCounter counter = 2). link1 uninstall. link2 uninstall. ! ! !GeppettoTest methodsFor: 'testing - multiple' stamp: 'md 3/9/2007 10:04'! testTwoLinksBeforeReplace | link1 link2 | link1 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #before; arguments: #(selector receiver arguments). link2 := GPLink new metaObject: self class; selector: #send:to:withArguments:; control: #instead; arguments: #(selector receiver arguments). (GPExamples>>#exampleSend) sends do: [:node | node link: link1; link: link2]. GPCounter reset. self assert: (GPExamples new exampleSend). self assert: (GPCounter counter = 2). link1 uninstall. link2 uninstall ! ! !GeppettoTest methodsFor: 'testing - multiple' stamp: 'md 3/9/2007 10:04'! testTwoLinksReplace | link1 link2 | link1 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #instead; arguments: #(selector receiver arguments). link2 := GPLink new metaObject: self class; selector: #csend:to:withArguments:; control: #instead; arguments: #(selector receiver arguments). "for now" self should: [(GPExamples>>#exampleSend2) sends do: [:node | node link: link1; link: link2]] raise: Error whoseDescriptionIncludes: 'not yet' description: 'Multipe replace not supported '. link1 uninstall. link2 uninstall ! ! !ClassScope methodsFor: '*geppetto2' stamp: 'md 2/24/2007 09:42'! theClass ^class! ! !GlobalVar methodsFor: '*geppetto2' stamp: 'md 2/24/2007 09:59'! assoc ^assoc! ! Object subclass: #GPContinuation instanceVariableNames: 'values' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Continuations'! !GPContinuation class methodsFor: 'instance creation' stamp: 'ab 6/15/2003 19:13'! current ^ self fromContext: thisContext sender! ! !GPContinuation class methodsFor: 'instance creation' stamp: 'ab 6/15/2003 19:13'! currentDo: aBlock ^ aBlock value: (self fromContext: thisContext sender)! ! !GPContinuation class methodsFor: 'instance creation' stamp: 'ab 6/15/2003 19:13'! fromContext: aStack ^self new initializeFromContext: aStack! ! !GPContinuation class methodsFor: 'instance creation' stamp: 'md 3/9/2007 16:05'! gpCurrentDo: aBlock ^ aBlock value: (self fromContext: thisContext gpsender)! ! !GPContinuation methodsFor: 'private' stamp: 'md 3/9/2007 16:40'! initializeFromContext: aContext | valueStream context | valueStream := WriteStream on: (Array new: 20). context := aContext. [context notNil] whileTrue: [valueStream nextPut: context. 1 to: context class instSize do: [:i | valueStream nextPut: (context instVarAt: i)]. 1 to: context size do: [:i | valueStream nextPut: (context at: i)]. context := context sender]. values := valueStream contents! ! !GPContinuation methodsFor: 'evaluating' stamp: 'lr 2/6/2007 17:19'! invoke: aBlock "Invoke the continuation and evaluates aBlock within the captured execution context." | activation | aBlock fixTemps. self terminate: thisContext. self restoreValues. activation := aBlock asContext. activation swapSender: values first. thisContext swapSender: activation! ! !GPContinuation methodsFor: 'accessing' stamp: 'ab 6/15/2003 19:18'! numArgs ^ 1! ! !GPContinuation methodsFor: 'private' stamp: 'md 3/9/2007 16:40'! restoreValues | valueStream context | valueStream := values readStream. [valueStream atEnd] whileFalse: [context := valueStream next. 1 to: context class instSize do: [:i | context instVarAt: i put: valueStream next]. 1 to: context size do: [:i | context at: i put: valueStream next]]! ! !GPContinuation methodsFor: 'private' stamp: 'ab 6/15/2003 19:13'! terminate: aContext | context | context := aContext. [context notNil] whileTrue: [context := context swapSender: nil] ! ! !GPContinuation methodsFor: 'evaluating' stamp: 'ab 6/15/2003 19:13'! value self value: nil! ! !GPContinuation methodsFor: 'evaluating' stamp: 'lr 1/5/2007 18:35'! value: anObject "Invoke the continuation and answer anObject as return value." self terminate: thisContext. self restoreValues. thisContext swapSender: values first. ^ anObject! ! !GPContinuation methodsFor: 'evaluating' stamp: 'lr 1/5/2007 16:02'! valueWithArguments: anArray anArray size = 1 ifFalse: [ ^ self error: 'continuations can only be resumed with one argument' ]. self value: anArray first! ! Object subclass: #GPCounter instanceVariableNames: 'count' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Tests'! GPCounter class instanceVariableNames: 'counter'! GPCounter class instanceVariableNames: 'counter'! !GPCounter class methodsFor: 'counter' stamp: 'md 2/7/2007 17:17'! counter ^counter! ! !GPCounter class methodsFor: 'counter' stamp: 'md 2/7/2007 17:17'! inc counter := counter + 1.! ! !GPCounter class methodsFor: 'protocol' stamp: 'md 2/8/2007 20:51'! link ^ GPLink new metaObject: self new; selector: #inc. ! ! !GPCounter class methodsFor: 'counter' stamp: 'md 2/7/2007 17:17'! reset counter := 0.! ! !GPCounter methodsFor: 'counter' stamp: 'md 2/7/2007 08:55'! count ^count! ! !GPCounter methodsFor: 'counter' stamp: 'md 2/7/2007 08:55'! inc count := count + 1.! ! !GPCounter methodsFor: 'initialize-release' stamp: 'md 2/14/2007 20:42'! initialize count := 0! ! Object subclass: #GPExamples uses: TJMethod instanceVariableNames: 'i' classVariableNames: 'Test' poolDictionaries: '' category: 'Geppetto2-Tests'! GPExamples class uses: TJMethod classTrait instanceVariableNames: ''! !GPExamples class methodsFor: 'accessing' stamp: 'md 3/31/2007 19:13'! compilerClass ^ PECompiler! ! !GPExamples class methodsFor: 'accessing' stamp: 'md 3/20/2007 17:24'! parseTreeFor: aSymbol ^(self compiledMethodAt: aSymbol) reflectiveMethod methodNode! ! !GPExamples class methodsFor: 'compiling' stamp: 'md 3/20/2007 17:28'! recompile: selector from: oldClass | jMethod | jMethod := (oldClass >> selector) reflectiveMethodOrNil. (jMethod notNil and: [ jMethod hasMethodClass not ]) ifTrue: [ jMethod methodClass: oldClass ]. super recompile: selector from: oldClass. ! ! !GPExamples methodsFor: 'examples' stamp: 'md 4/13/2007 22:53'! example | a b | a := 5. b := 6. ^ a + b. ! ! !GPExamples methodsFor: 'examples' stamp: 'md 3/29/2007 18:52'! exampleBlock | b | b := [:a | a + 6]. b value: 2. ^b value: 2.! ! !GPExamples methodsFor: 'examples' stamp: 'md 2/22/2007 17:59'! exampleClassWrite Test := 5. ^Test.! ! !GPExamples methodsFor: 'examples' stamp: 'md 2/22/2007 17:59'! exampleGlobalRead | t | t := Smalltalk. ^t. ! ! !GPExamples methodsFor: 'examples' stamp: 'md 2/22/2007 17:59'! exampleIvar i := 6. ^ i + 5. ! ! !GPExamples methodsFor: 'examples' stamp: 'md 2/22/2007 17:59'! exampleSend | a b | a := 5. b := 7. ^ 6 between: 5 and: 7. ! ! !GPExamples methodsFor: 'examples' stamp: 'md 3/9/2007 17:30'! exampleSend2 | a b r | a := 5. b := 7. r := 6 between: 5 and: 7. ^r. ! ! !GPExamples methodsFor: 'examples' stamp: 'md 2/22/2007 17:59'! exampleSendZeroArg ^ 5 factorial ! ! !GPExamples methodsFor: 'examples' stamp: 'md 2/22/2007 17:59'! exampleSendmanyArgs ^ self send: #+ with: 1 with: 2 with: 3 with: 4 with: 5. ! ! !GPExamples methodsFor: 'examples' stamp: 'md 3/16/2007 15:28'! exampleWriteTransform | a | a := 5 + 9. ^a.! ! !GPExamples methodsFor: 'examples' stamp: 'md 3/28/2007 11:49'! examplea: a b: b ^ a + b. ! ! !GPExamples methodsFor: 'examples' stamp: 'md 2/22/2007 17:59'! examplea: a b: b c: c d: d e: e ^ a + b + c + d + e. ! ! !GPExamples methodsFor: 'examples' stamp: 'md 3/5/2007 16:06'! send: sel with: a with: b with: c with: d with: e GPCounter inc. ^{a. b. c. d. e.} inject: 0 into: [:result :each | result perform: sel with: each]! ! !GPExamples methodsFor: 'examples' stamp: ''! testReifyMo GPCounter inc! ! Object subclass: #GPLink instanceVariableNames: 'mo condition selector control arguments nodes properties' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Kernel'! !GPLink class methodsFor: 'as yet unclassified' stamp: 'md 2/9/2007 20:07'! metaObject: aMeta ^self new metaObject: aMeta.! ! !GPLink methodsFor: 'link api' stamp: 'md 2/13/2007 17:37'! after self control: #after! ! !GPLink methodsFor: 'accessing' stamp: 'md 2/7/2007 13:01'! arguments ^arguments! ! !GPLink methodsFor: 'link api' stamp: 'md 2/23/2007 12:20'! arguments: anArray self checkReification: anArray. arguments := anArray. self update.! ! !GPLink methodsFor: 'link api' stamp: 'md 2/13/2007 17:36'! before self control: #before! ! !GPLink methodsFor: 'link installation' stamp: 'md 3/1/2007 17:44'! checkCompatibilityWith: aNode | supported | supported := aNode supportedReifications. self arguments do: [:arg | (supported includes: arg) ifFalse: [self error: 'reification not possible on this node']]. ! ! !GPLink methodsFor: 'link installation' stamp: 'md 3/9/2007 10:08'! checkForMultipleInstead: aNode self isInstead ifFalse: [^self]. "check all installed links, error message when instead" aNode links do: [:each | each isInstead ifTrue: [self error: 'Multiple instead not yet supported']].! ! !GPLink methodsFor: 'testing' stamp: 'md 2/26/2007 17:32'! checkReification: anArray anArray do: [:each | (GPParameter allKeys includes: each) ifFalse: [self error: 'wrong reification']].! ! !GPLink methodsFor: 'accessing' stamp: 'md 2/9/2007 15:43'! condition ^condition! ! !GPLink methodsFor: 'link api' stamp: 'md 2/23/2007 12:23'! condition: aCondition (aCondition isBlock or: [aCondition isBoolean]) ifFalse: [ self error: 'condition needs to be a block or boolean']. aCondition isBlock ifTrue: [self checkReification: aCondition blockArgNames]. condition := aCondition. self isInlineCondition ifTrue: [self update].! ! !GPLink methodsFor: 'accessing' stamp: 'md 2/3/2007 16:39'! control ^control.! ! !GPLink methodsFor: 'link api' stamp: 'md 3/9/2007 10:05'! control: aSymbol (#(before after beforeafter instead) includes: aSymbol) ifFalse: [ self error: 'Control', aSymbol printString, ' not supported!!']. control := aSymbol. self update.! ! !GPLink methodsFor: 'testing' stamp: 'md 2/12/2007 10:02'! hasCondition ^condition notNil.! ! !GPLink methodsFor: 'testing' stamp: 'md 3/8/2007 21:28'! hasMoScope properties ifNil: [^false]. ^self properties includesKey: #moScope! ! !GPLink methodsFor: 'link installation' stamp: 'md 3/9/2007 10:05'! hookOn: aNode self checkCompatibilityWith: aNode. self checkForMultipleInstead: aNode. "for now, only one". aNode addLinkAnnotation: self. self nodes add: aNode. ! ! !GPLink methodsFor: 'initializing' stamp: 'md 3/1/2007 18:04'! initialize control := #before. selector := #value. arguments := #().! ! !GPLink methodsFor: 'link api' stamp: 'md 2/13/2007 17:37'! instead self control: #instead! ! !GPLink methodsFor: 'testing' stamp: 'md 2/14/2007 19:58'! isActive ^condition value! ! !GPLink methodsFor: 'testing' stamp: 'md 2/14/2007 19:58'! isActive: anObject ^condition value: anObject! ! !GPLink methodsFor: 'testing' stamp: 'md 2/14/2007 19:58'! isActive: anObjectA with: anObjectB ^condition value: anObjectA value: anObjectB! ! !GPLink methodsFor: 'testing' stamp: 'md 2/14/2007 19:59'! isActive: anObjectA with: anObjectB with: anObjectC ^condition value: anObjectA value: anObjectB value: anObjectC! ! !GPLink methodsFor: 'testing' stamp: 'md 2/14/2007 19:59'! isActive: anObjectA with: anObjectB with: anObjectC with: anObjectD ^condition value: anObjectA value: anObjectB value: anObjectC value: anObjectD! ! !GPLink methodsFor: 'testing' stamp: 'md 3/9/2007 10:07'! isAfter ^control == #after! ! !GPLink methodsFor: 'testing' stamp: 'md 3/9/2007 10:06'! isBefore ^control == #before! ! !GPLink methodsFor: 'testing' stamp: 'md 3/9/2007 10:07'! isBeforeAfter ^control == #beforeafter! ! !GPLink methodsFor: 'testing' stamp: 'md 3/8/2007 22:01'! isInlineCondition properties ifNil: [^true]. ^self properties at: #noInlineCondition ifAbsent: [true].! ! !GPLink methodsFor: 'testing' stamp: 'md 3/8/2007 22:01'! isInlineMeta properties ifNil: [^true]. ^self properties at: #noInlineMeta ifAbsent: [true].! ! !GPLink methodsFor: 'testing' stamp: 'md 3/9/2007 10:06'! isInstead ^control == #instead! ! !GPLink methodsFor: 'accessing' stamp: 'md 2/13/2007 18:20'! metaObject ^mo! ! !GPLink methodsFor: 'link api' stamp: 'md 2/23/2007 12:24'! metaObject: anObject mo := anObject. mo isBlock ifTrue: [ self checkReification: mo blockArgNames. "Block meta Object. We need to set the link's arguments to the args of the Block" arguments ifEmpty: [self arguments: (mo blockArgNames collect: #asSymbol)]. selector == #value ifTrue:[self selector: mo valueSelector]. ]. self update.! ! !GPLink methodsFor: 'link api' stamp: 'md 3/8/2007 20:56'! metaObjectCreator ^self properties at: #metaObjectCreator.! ! !GPLink methodsFor: 'link api' stamp: 'md 3/15/2007 16:16'! metaObjectCreator: aBlock self properties at: #metaObjectCreator put: aBlock. "this needs to be a weakkeydictionary..." mo := Dictionary new.! ! !GPLink methodsFor: 'link api' stamp: 'md 3/8/2007 20:24'! metaObjectFor: anObject ^mo at: anObject ifAbsentPut: [self metaObjectCreator value]! ! !GPLink methodsFor: 'accessing' stamp: 'md 3/8/2007 21:11'! moScope ^self properties at: #moScope ifAbsent: [#link].! ! !GPLink methodsFor: 'link api' stamp: 'md 3/8/2007 20:57'! moScope: aSymbol self properties at: #moScope put: aSymbol.! ! !GPLink methodsFor: 'link api' stamp: 'md 3/8/2007 22:01'! noInlineCondition self properties at: #noInlineCondtition put: true.! ! !GPLink methodsFor: 'link api' stamp: 'md 3/8/2007 22:01'! noInlineMeta self properties at: #noInlineMeta put: true.! ! !GPLink methodsFor: 'accessing' stamp: 'md 3/1/2007 18:01'! nodes ^nodes ifNil: [nodes := Set new].! ! !GPLink methodsFor: 'accessing' stamp: 'md 3/8/2007 20:37'! properties ^properties ifNil: [properties := Dictionary new].! ! !GPLink methodsFor: 'testing' stamp: 'md 3/9/2007 15:48'! requestsContinuation "mo = #continuation ifTrue: [^true]." ^arguments includes: #continuation! ! !GPLink methodsFor: 'testing' stamp: 'md 3/9/2007 17:51'! requestsResult ^arguments includes: #result! ! !GPLink methodsFor: 'accessing' stamp: 'md 2/3/2007 16:39'! selector ^selector.! ! !GPLink methodsFor: 'link api' stamp: 'md 2/23/2007 11:46'! selector: aSymbol selector := aSymbol. self update.! ! !GPLink methodsFor: 'link installation' stamp: 'md 3/1/2007 18:26'! uninstall nodes ifNotNil: [nodes do: [:node | node removeLink: self]].! ! !GPLink methodsFor: 'link installation' stamp: 'md 3/1/2007 18:25'! update nodes ifNotNil: [nodes do: [:node | node resetCache]].! ! Object subclass: #GPMethodWrapper instanceVariableNames: 'wrappedClass clientMethod definingClass clientSelector wrappingWrapper beforeLink afterLink insteadLink' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Wrappers'! GPMethodWrapper subclass: #GPCountMethodWrapper instanceVariableNames: 'count' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Wrappers'! !GPCountMethodWrapper commentStamp: 'md 2/24/2007 15:23' prior: 0! A count method wrapper counts the number of times the method is called. Instance Variables count: invocation counter! !GPCountMethodWrapper methodsFor: 'before after' stamp: 'md 2/24/2007 14:48'! beforeMethod self count: self count + 1.! ! !GPCountMethodWrapper methodsFor: 'initializing' stamp: 'md 2/24/2007 14:49'! class: aClass selector: aSymbol self count: 0. ^ super class: aClass selector: aSymbol! ! !GPCountMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 14:49'! count ^count! ! !GPCountMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 14:49'! count: aNumber count := aNumber! ! !GPCountMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 14:52'! reset count := 0.! ! GPCountMethodWrapper subclass: #GPTimeMethodWrapper instanceVariableNames: 'time' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Wrappers'! !GPTimeMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 15:29'! averageTime ^ self count == 0 ifTrue: [0] ifFalse: [self totalTime / self count asFloat]! ! !GPTimeMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 15:30'! class: aClass selector: aSymbol self time: 0. ^ super class: aClass selector: aSymbol! ! !GPTimeMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 15:29'! time ^time! ! !GPTimeMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 15:29'! time: anObject time := anObject! ! !GPTimeMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 15:30'! totalTime ^ self time! ! !GPTimeMethodWrapper methodsFor: 'evaluating' stamp: 'md 2/24/2007 15:28'! valueWithReceiver: anObject arguments: argumentsArray "This method was overriden so that recursive calls will have a different beginTime." | beginTime | beginTime := Time millisecondClockValue. self count: self count + 1. ^ [ self clientMethod valueWithReceiver: anObject arguments: argumentsArray ] ensure: [self time: self time + (Time millisecondClockValue - beginTime max: 0)]! ! !GPMethodWrapper class methodsFor: 'instance creation' stamp: 'md 2/24/2007 19:05'! on: aSelector inClass: aClass ^self new class: aClass selector: aSelector. ! ! !GPMethodWrapper methodsFor: 'before after' stamp: 'md 2/19/2007 12:12'! afterMethod! ! !GPMethodWrapper methodsFor: 'before after' stamp: 'md 2/19/2007 12:13'! beforeMethod! ! !GPMethodWrapper methodsFor: 'initialization' stamp: 'md 2/24/2007 19:07'! class: aClass selector: aSelector self wrappedClass: aClass. self clientSelector: aSelector.! ! !GPMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 19:10'! clientMethod ^clientMethod! ! !GPMethodWrapper methodsFor: 'accessing' stamp: 'md 2/25/2007 18:14'! clientMethod: aMethod clientMethod := aMethod! ! !GPMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 19:04'! clientSelector ^clientSelector! ! !GPMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 19:04'! clientSelector: aSel clientSelector := aSel! ! !GPMethodWrapper methodsFor: 'installing' stamp: 'md 2/25/2007 18:13'! install "find out what exactly is overritten in our subclass... and do a link *just* for that" (self class methodDict keys includes: #valueWithReceiver:arguments:) ifTrue: [ insteadLink := GPLink new metaObject: self; selector: #valueWithReceiver:arguments:operation:; control: #instead; arguments: #(object arguments operation). self methodNode link: insteadLink. ^self. ]. (self class methodDict keys includes: #beforeMethod) ifTrue: [ beforeLink := GPLink new metaObject: self; selector: #beforeMethod; control: #before. self methodNode link: beforeLink. ]. (self class methodDict keys includes: #afterMethod) ifTrue: [ afterLink := GPLink new metaObject: self; selector: #afterMethod; control: #after. self methodNode link: afterLink. ]. ! ! !GPMethodWrapper methodsFor: 'accessing' stamp: 'md 2/25/2007 19:08'! method ^wrappedClass>>clientSelector! ! !GPMethodWrapper methodsFor: 'accessing' stamp: 'md 3/20/2007 17:25'! methodNode ^self method reflectiveMethod methodNode! ! !GPMethodWrapper methodsFor: 'installing' stamp: 'md 2/25/2007 19:40'! uninstall self methodNode removeLink: beforeLink; removeLink: afterLink; removeLink: insteadLink.! ! !GPMethodWrapper methodsFor: 'before after' stamp: 'md 2/25/2007 18:21'! valueWithReceiver: receiver arguments: args operation: method self clientMethod: method. ^self valueWithReceiver: receiver arguments: args. ! ! !GPMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 19:08'! wrappedClass ^wrappedClass! ! !GPMethodWrapper methodsFor: 'accessing' stamp: 'md 2/24/2007 19:08'! wrappedClass: aClass wrappedClass := aClass! ! GPMethodWrapper subclass: #GPSimpleMethodWrapper instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Wrappers'! !GPSimpleMethodWrapper commentStamp: 'md 2/24/2007 15:24' prior: 0! A very simple MethodWrapper for testing. It increments GPCounter before and after, but has no state of it's own! !GPSimpleMethodWrapper methodsFor: 'before after' stamp: 'md 2/19/2007 12:12'! afterMethod GPCounter inc! ! !GPSimpleMethodWrapper methodsFor: 'before after' stamp: 'md 2/19/2007 12:12'! beforeMethod GPCounter inc! ! Object subclass: #GPMwClassA uses: TJMethod instanceVariableNames: 'x' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Wrappers-Tests'! !GPMwClassA commentStamp: '' prior: 0! Instance Variables: x ! GPMwClassA class uses: TJMethod classTrait instanceVariableNames: ''! !GPMwClassA class methodsFor: 'accessing' stamp: 'md 3/31/2007 19:13'! compilerClass ^PECompiler! ! !GPMwClassA class methodsFor: 'accessing' stamp: 'md 3/20/2007 17:24'! parseTreeFor: aSymbol ^(self compiledMethodAt: aSymbol) reflectiveMethod methodNode! ! !GPMwClassA methodsFor: 'debugging' stamp: 'md 3/19/2007 00:04'! methodDelay (Delay forMilliseconds: 1) wait.! ! !GPMwClassA methodsFor: 'debugging' stamp: 'md 2/24/2007 18:45'! methodOne "Transcript cr; show: 'MwClassA>>methodOne'."! ! !GPMwClassA methodsFor: 'debugging' stamp: 'md 2/24/2007 18:45'! methodTwo "Transcript cr; show: 'MwClassA>>methodTwo'."! ! !GPMwClassA methodsFor: 'debugging' stamp: 'md 2/24/2007 18:45'! methodWithArgument: anInteger self x: self x + anInteger. ^ self x! ! !GPMwClassA methodsFor: 'debugging' stamp: 'md 2/24/2007 18:45'! methodWithException Warning new signal: 'Ouch'.! ! !GPMwClassA methodsFor: 'debugging' stamp: 'md 2/25/2007 18:34'! methodWithoutException ^ 69 ! ! !GPMwClassA methodsFor: 'accessing' stamp: 'md 3/19/2007 00:04'! x "^ " ^ x! ! !GPMwClassA methodsFor: 'accessing' stamp: 'md 3/19/2007 00:04'! x: anInteger x := anInteger. ! ! GPMwClassA subclass: #GPMwClassB uses: TJMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Wrappers-Tests'! GPMwClassB class uses: TJMethod classTrait instanceVariableNames: ''! !GPMwClassB class methodsFor: 'accessing' stamp: 'md 3/31/2007 19:13'! compilerClass ^PECompiler! ! !GPMwClassB class methodsFor: 'accessing' stamp: 'md 3/20/2007 17:24'! parseTreeFor: aSymbol ^(self compiledMethodAt: aSymbol) reflectiveMethod methodNode! ! !GPMwClassB methodsFor: 'debugging' stamp: 'md 3/19/2007 00:04'! methodThree "Transcript cr; show: 'MwClassB>>methodThree'." ! ! !GPMwClassB methodsFor: 'debugging' stamp: 'md 3/19/2007 00:04'! methodTwo "Transcript cr; show: 'MwClassB>>methodTwo'." ! ! Object subclass: #GPOperation instanceVariableNames: 'context' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! GPOperation subclass: #GPAssignment instanceVariableNames: 'newValue' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPAssignment methodsFor: 'accessing' stamp: 'md 2/9/2007 14:32'! newValue ^newValue! ! !GPAssignment methodsFor: 'accessing' stamp: 'md 2/9/2007 14:31'! newValue: anObject newValue := anObject! ! GPAssignment subclass: #GPGlobalAssignment instanceVariableNames: 'binding' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPGlobalAssignment class methodsFor: 'instance creation' stamp: 'md 2/24/2007 10:18'! binding: aBinding newValue: val ^self new binding: aBinding; newValue: val.! ! !GPGlobalAssignment class methodsFor: 'instance creation' stamp: 'md 2/24/2007 10:18'! binding: aBinding newValue: val context: aContext ^self new binding: aBinding; newValue: val; context: aContext.! ! !GPGlobalAssignment methodsFor: 'accessing' stamp: 'md 2/24/2007 10:02'! binding ^binding! ! !GPGlobalAssignment methodsFor: 'accessing' stamp: 'md 2/24/2007 10:02'! binding: anAssoc binding := anAssoc! ! !GPGlobalAssignment methodsFor: 'evaluating' stamp: 'md 2/24/2007 10:02'! oldValue ^binding value! ! !GPGlobalAssignment methodsFor: 'evaluating' stamp: 'md 2/24/2007 10:03'! value context ifNotNil: [thisContext swapSender: context]. ^binding value: newValue. ! ! GPAssignment subclass: #GPInstanceAssignment instanceVariableNames: 'object offset' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPInstanceAssignment class methodsFor: 'instance creation' stamp: 'md 2/23/2007 17:29'! offset: offset in: object put: newValue ^self new offset: offset; object: object; newValue: newValue.! ! !GPInstanceAssignment class methodsFor: 'instance creation' stamp: 'md 2/23/2007 17:29'! offset: offset in: object put: newValue context: aContext ^self new offset: offset; object: object; newValue: newValue; context: aContext! ! !GPInstanceAssignment methodsFor: 'accessing' stamp: 'md 2/23/2007 17:24'! object ^object! ! !GPInstanceAssignment methodsFor: 'accessing' stamp: 'md 2/23/2007 17:25'! object: anObject object := anObject! ! !GPInstanceAssignment methodsFor: 'accessing' stamp: 'md 2/23/2007 17:24'! offset ^offset! ! !GPInstanceAssignment methodsFor: 'accessing' stamp: 'md 2/23/2007 17:24'! offset: anOffset offset := anOffset! ! !GPInstanceAssignment methodsFor: 'evaluating' stamp: 'md 2/22/2007 17:25'! oldValue ^object instVarAt: offset.! ! !GPInstanceAssignment methodsFor: 'evaluating' stamp: 'md 2/23/2007 17:22'! value context ifNotNil: [thisContext swapSender: context]. ^object instVarAt: offset put: newValue. ! ! GPAssignment subclass: #GPTempAssignment instanceVariableNames: 'frame offset' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPTempAssignment class methodsFor: 'instance creation' stamp: 'md 2/23/2007 17:28'! offset: offset in: object put: newValue ^self new offset: offset; frame: object; newValue: newValue.! ! !GPTempAssignment class methodsFor: 'instance creation' stamp: 'md 2/23/2007 17:28'! offset: offset in: object put: newValue context: aContext ^self new offset: offset; frame: object; newValue: newValue; context: aContext! ! !GPTempAssignment methodsFor: 'accessing' stamp: 'md 2/23/2007 17:25'! frame ^frame! ! !GPTempAssignment methodsFor: 'accessing' stamp: 'md 2/23/2007 17:25'! frame: aContext frame := aContext! ! !GPTempAssignment methodsFor: 'accessing' stamp: 'md 2/23/2007 17:25'! offset ^offset! ! !GPTempAssignment methodsFor: 'accessing' stamp: 'md 2/23/2007 17:26'! offset: anOffset offset := anOffset! ! !GPTempAssignment methodsFor: 'evaluating' stamp: 'md 2/23/2007 17:27'! oldValue ^frame tempAt: offset! ! !GPTempAssignment methodsFor: 'evaluating' stamp: 'md 2/23/2007 17:27'! value context ifNotNil: [thisContext swapSender: context]. ^frame tempAt: offset put: newValue! ! GPOperation subclass: #GPBlock instanceVariableNames: 'block arguments' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPBlock methodsFor: 'accessing' stamp: 'md 2/23/2007 18:07'! arguments ^arguments! ! !GPBlock methodsFor: 'accessing' stamp: 'md 2/23/2007 18:07'! arguments: anArray arguments := anArray! ! !GPBlock methodsFor: 'accessing' stamp: 'md 2/23/2007 18:07'! block ^block! ! !GPBlock methodsFor: 'accessing' stamp: 'md 2/23/2007 18:06'! block: aBlock block := aBlock! ! !GPBlock methodsFor: 'evaluating' stamp: 'md 2/23/2007 18:09'! value context ifNotNil: [thisContext swapSender: context]. ^arguments ifNil: [block value] ifNotNil: [block valueWithArguments: arguments].! ! GPOperation subclass: #GPMessageSend instanceVariableNames: 'receiver selector arguments' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPMessageSend class methodsFor: 'instance creation' stamp: 'md 2/22/2007 17:12'! receiver: anObject selector: aSymbol ^ self receiver: anObject selector: aSymbol arguments: #()! ! !GPMessageSend class methodsFor: 'instance creation' stamp: 'md 2/22/2007 17:12'! receiver: anObject selector: aSymbol argument: aParameter ^ self receiver: anObject selector: aSymbol arguments: (Array with: aParameter)! ! !GPMessageSend class methodsFor: 'instance creation' stamp: 'md 2/22/2007 17:12'! receiver: anObject selector: aSymbol arguments: anArray ^ self new receiver: anObject; selector: aSymbol; arguments: anArray! ! !GPMessageSend class methodsFor: 'instance creation' stamp: 'md 2/22/2007 17:35'! receiver: anObject selector: aSymbol arguments: anArray context: aContext ^ self new receiver: anObject; selector: aSymbol; arguments: anArray; context: aContext.! ! !GPMessageSend methodsFor: 'accessing' stamp: 'md 2/22/2007 17:07'! arguments ^arguments! ! !GPMessageSend methodsFor: 'accessing' stamp: 'md 2/22/2007 17:07'! arguments: anArray arguments := anArray! ! !GPMessageSend methodsFor: 'private' stamp: 'md 2/22/2007 17:10'! collectArguments: anArgArray "Private" | staticArgs | staticArgs := self arguments. ^(anArgArray size = staticArgs size) ifTrue: [anArgArray] ifFalse: [(staticArgs isEmpty ifTrue: [ staticArgs := Array new: selector numArgs] ifFalse: [staticArgs copy] ) replaceFrom: 1 to: (anArgArray size min: staticArgs size) with: anArgArray startingAt: 1]! ! !GPMessageSend methodsFor: 'testing' stamp: 'md 2/22/2007 17:09'! isMessageSend ^true ! ! !GPMessageSend methodsFor: 'accessing' stamp: 'md 2/22/2007 17:08'! receiver ^receiver! ! !GPMessageSend methodsFor: 'accessing' stamp: 'md 2/22/2007 17:07'! receiver: anObject receiver := anObject! ! !GPMessageSend methodsFor: 'accessing' stamp: 'md 2/22/2007 17:08'! selector ^selector! ! !GPMessageSend methodsFor: 'accessing' stamp: 'md 2/22/2007 17:07'! selector: aSymbol selector := aSymbol! ! !GPMessageSend methodsFor: 'evaluating' stamp: 'md 2/22/2007 18:40'! value "Send the message and answer the return value" context ifNotNil: [thisContext swapSender: context]. arguments ifNil: [^ receiver perform: selector]. ^ receiver perform: selector withArguments: (self collectArguments: arguments)! ! !GPMessageSend methodsFor: 'evaluating' stamp: 'md 2/22/2007 18:40'! valueWithArguments: anArray context ifNotNil: [thisContext swapSender: context]. ^ receiver perform: selector withArguments: (self collectArguments: anArray)! ! GPOperation subclass: #GPMethod instanceVariableNames: 'method arguments receiver' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPMethod class methodsFor: 'instance creation' stamp: 'md 2/13/2007 10:14'! method: aMethod receiver: anObject arguments: args ^self new method: aMethod; receiver: anObject; arguments: args! ! !GPMethod class methodsFor: 'instance creation' stamp: 'md 2/22/2007 17:35'! method: aMethod receiver: anObject arguments: args context: aContext ^self new method: aMethod; receiver: anObject; arguments: args; context: aContext ! ! !GPMethod methodsFor: 'accessing' stamp: 'md 2/13/2007 10:11'! arguments ^arguments! ! !GPMethod methodsFor: 'accessing' stamp: 'md 2/13/2007 10:11'! arguments: anArray arguments := anArray! ! !GPMethod methodsFor: 'accessing' stamp: 'md 2/13/2007 10:10'! method ^method! ! !GPMethod methodsFor: 'accessing' stamp: 'md 2/13/2007 10:10'! method: aMethod method := aMethod! ! !GPMethod methodsFor: 'accessing' stamp: 'md 2/13/2007 10:11'! receiver ^receiver! ! !GPMethod methodsFor: 'accessing' stamp: 'md 2/13/2007 10:11'! receiver: anObject receiver := anObject! ! !GPMethod methodsFor: 'evaluating' stamp: 'md 2/22/2007 18:40'! value context ifNotNil: [thisContext swapSender: context]. arguments ifNil: [^ receiver executeMethod: method]. ^receiver withArgs: arguments executeMethod: method.! ! !GPMethod methodsFor: 'evaluating' stamp: 'md 2/23/2007 14:43'! valueWithReceiver: anObject arguments: anArray context ifNotNil: [thisContext swapSender: context]. ^receiver withArgs: arguments executeMethod: method.! ! !GPOperation methodsFor: 'accessing' stamp: 'md 2/22/2007 17:29'! context ^context! ! !GPOperation methodsFor: 'accessing' stamp: 'md 2/22/2007 17:29'! context: aContext context := aContext! ! !GPOperation methodsFor: 'evaluating' stamp: 'md 2/15/2007 10:49'! value self subclassResponsibility.! ! GPOperation subclass: #GPVariable instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! GPVariable subclass: #GPGlobalVariable instanceVariableNames: 'binding' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPGlobalVariable class methodsFor: 'instance creation' stamp: 'md 2/24/2007 10:06'! binding: aBinding ^self new binding: aBinding! ! !GPGlobalVariable class methodsFor: 'instance creation' stamp: 'md 2/24/2007 10:06'! binding: aBinding context: aContext ^self new binding: aBinding; context: aContext! ! !GPGlobalVariable methodsFor: 'accessing' stamp: 'md 2/24/2007 10:05'! binding ^binding! ! !GPGlobalVariable methodsFor: 'accessing' stamp: 'md 2/24/2007 10:05'! binding: aBinding binding := aBinding! ! !GPGlobalVariable methodsFor: 'evaluating' stamp: 'md 2/24/2007 10:05'! value context ifNotNil: [thisContext swapSender: context]. ^binding value! ! GPVariable subclass: #GPInstanceVariable instanceVariableNames: 'object offset' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPInstanceVariable class methodsFor: 'instance creation' stamp: 'md 2/23/2007 17:39'! offset: offset in: object ^self new offset: offset; object: object.! ! !GPInstanceVariable class methodsFor: 'instance creation' stamp: 'md 2/23/2007 17:40'! offset: offset in: object context: aContext ^self new offset: offset; object: object; context: aContext! ! !GPInstanceVariable methodsFor: 'accessing' stamp: 'md 2/23/2007 17:37'! object ^object! ! !GPInstanceVariable methodsFor: 'accessing' stamp: 'md 2/23/2007 17:37'! object: anObject object := anObject! ! !GPInstanceVariable methodsFor: 'accessing' stamp: 'md 3/22/2007 14:33'! offset ^offset! ! !GPInstanceVariable methodsFor: 'accessing' stamp: 'md 3/22/2007 14:33'! offset: aNumber offset := aNumber! ! !GPInstanceVariable methodsFor: 'evaluation' stamp: 'md 2/23/2007 17:42'! value context ifNotNil: [thisContext swapSender: context]. ^object instVarAt: offset ! ! GPVariable subclass: #GPTempVariable instanceVariableNames: 'frame offset' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Operations'! !GPTempVariable class methodsFor: 'instance creation' stamp: 'md 2/23/2007 17:40'! offset: offset in: object ^self new offset: offset; frame: object.! ! !GPTempVariable class methodsFor: 'instance creation' stamp: 'md 2/23/2007 17:40'! offset: offset in: object context: aContext ^self new offset: offset; frame: object; context: aContext! ! !GPTempVariable methodsFor: 'accessing' stamp: 'md 2/23/2007 17:39'! frame ^frame! ! !GPTempVariable methodsFor: 'accessing' stamp: 'md 2/23/2007 17:39'! frame: aContext frame := aContext! ! !GPTempVariable methodsFor: 'accessing' stamp: 'md 2/23/2007 17:38'! offset ^offset! ! !GPTempVariable methodsFor: 'accessing' stamp: 'md 2/23/2007 17:38'! offset: aNumber offset := aNumber! ! !GPTempVariable methodsFor: 'evaluation' stamp: 'md 2/23/2007 17:41'! value context ifNotNil: [thisContext swapSender: context]. ^frame tempAt: offset ! ! Object subclass: #GPParameter instanceVariableNames: 'node link' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! GPParameter subclass: #GPArg1Parameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPArg1Parameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:57'! key ^#arg1! ! !GPArg1Parameter class methodsFor: 'plugin interface' stamp: 'md 2/27/2007 21:16'! nodes ^{RBMessageNode. RBMethodNode. RBBlockNode}! ! !GPArg1Parameter methodsFor: 'code generation' stamp: 'md 2/15/2007 10:10'! genForRBProgramNode ^node arguments first! ! GPParameter subclass: #GPArg2Parameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPArg2Parameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:58'! key ^#arg2! ! !GPArg2Parameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:35'! nodes ^{RBMessageNode. RBMethodNode}! ! !GPArg2Parameter methodsFor: 'code generation' stamp: 'md 2/15/2007 10:11'! genForRBProgramNode ^node arguments second! ! GPParameter subclass: #GPArg3Parameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPArg3Parameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:58'! key ^#arg3! ! !GPArg3Parameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:35'! nodes ^{RBMessageNode. RBMethodNode}! ! !GPArg3Parameter methodsFor: 'code generation' stamp: 'md 2/15/2007 10:11'! genForRBProgramNode ^node arguments third! ! GPParameter subclass: #GPArg4Parameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPArg4Parameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:58'! key ^#arg4! ! !GPArg4Parameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:35'! nodes ^{RBMessageNode. RBMethodNode}! ! !GPArg4Parameter methodsFor: 'code generation' stamp: 'md 2/15/2007 10:11'! genForRBProgramNode ^node arguments fourth! ! GPParameter subclass: #GPArgumentsParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPArgumentsParameter class methodsFor: 'plugin interface' stamp: 'md 2/10/2007 23:19'! key ^#arguments! ! !GPArgumentsParameter class methodsFor: 'plugin interface' stamp: 'md 2/27/2007 21:17'! nodes ^{RBMessageNode. RBMethodNode. RBBlockNode}! ! !GPArgumentsParameter methodsFor: 'code generation' stamp: 'md 4/14/2007 01:59'! genForRBProgramNode node numArgs = 0 ifTrue: [^#() asLiteralNode]. node numArgs <= 4 ifTrue: [ ^RBMessageNode receiver: Array asLiteralNode selector: (#braceWith numArgs: node numArgs) arguments: node arguments ]. node numArgs > 4 ifTrue: [ | stream messages | stream := RBMessageNode receiver: Array asLiteralNode selector: #braceStream: argument: node arguments size asLiteralNode. messages := (node arguments collect: [:each | RBMessageNode receiver: stream selector: #nextPut: argument: each]) asOrderedCollection. messages add: (RBMessageNode receiver: stream selector: #braceArray). ^RBCascadeNode messages: messages. ].! ! !GPArgumentsParameter methodsFor: 'code generation' stamp: 'md 2/27/2007 21:18'! optimize ^node isBlock not and: [node selector numArgs >0].! ! GPParameter subclass: #GPBindingParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPBindingParameter class methodsFor: 'plugin interface' stamp: 'md 2/24/2007 09:56'! key ^#binding! ! !GPBindingParameter class methodsFor: 'plugin interface' stamp: 'md 2/24/2007 09:47'! nodes ^{RBAssignmentNode. RBVariableNode}! ! !GPBindingParameter methodsFor: 'code generation' stamp: 'md 2/24/2007 10:00'! genForRBAssignmentNode ^node variable binding assoc asLiteralNode ! ! !GPBindingParameter methodsFor: 'code generation' stamp: 'md 2/24/2007 10:01'! genForRBVariableNode ^node binding assoc asLiteralNode ! ! GPParameter subclass: #GPClassParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPClassParameter class methodsFor: 'plugin interface' stamp: 'md 2/23/2007 12:35'! key ^#class! ! !GPClassParameter class methodsFor: 'plugin interface' stamp: 'md 2/23/2007 12:35'! nodes ^{RBProgramNode}! ! !GPClassParameter methodsFor: 'code generation' stamp: 'md 2/23/2007 12:36'! genForRBProgramNode ^RBMessageNode receiver: (RBVariableNode named: 'self') selector: #class! ! !GPClassParameter methodsFor: 'code generation' stamp: 'md 2/23/2007 12:36'! optimize ^true! ! GPParameter subclass: #GPContinuationParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPContinuationParameter class methodsFor: 'as yet unclassified' stamp: 'md 3/9/2007 11:47'! key ^#continuation! ! !GPContinuationParameter class methodsFor: 'as yet unclassified' stamp: 'md 3/9/2007 11:47'! nodes ^{RBProgramNode}.! ! !GPContinuationParameter methodsFor: 'code generation' stamp: 'md 3/9/2007 15:59'! genForRBProgramNode ^RBVariableNode named: 'continuation'.! ! GPParameter subclass: #GPControlParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPControlParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:52'! key ^#control! ! !GPControlParameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:36'! nodes ^{RBProgramNode}! ! !GPControlParameter methodsFor: 'code generation' stamp: 'md 2/12/2007 20:44'! genForRBProgramNode ^link control asLiteralNode! ! GPParameter subclass: #GPLinkParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPLinkParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:54'! key ^#link! ! !GPLinkParameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:36'! nodes ^{RBProgramNode}! ! !GPLinkParameter methodsFor: 'code generation' stamp: 'md 2/12/2007 20:46'! genForRBProgramNode ^link asLiteralNode! ! GPParameter subclass: #GPNewValueParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPNewValueParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:48'! key ^#newValue! ! !GPNewValueParameter class methodsFor: 'plugin interface' stamp: 'md 2/24/2007 09:38'! nodes ^{RBAssignmentNode}! ! !GPNewValueParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:49'! genForRBAssignmentNode ^node value! ! GPParameter subclass: #GPNodeParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPNodeParameter class methodsFor: 'plugin interface' stamp: 'md 2/10/2007 22:07'! key ^#node! ! !GPNodeParameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:29'! nodes ^{RBProgramNode}.! ! !GPNodeParameter methodsFor: 'code generation' stamp: 'md 2/12/2007 23:32'! genForJMethodNode ^node copy asLiteralNode! ! !GPNodeParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:39'! genForRBProgramNode ^node asLiteralNode! ! GPParameter subclass: #GPObjectParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPObjectParameter class methodsFor: 'plugin interface' stamp: 'md 2/20/2007 09:11'! key ^#object! ! !GPObjectParameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:37'! nodes ^{RBProgramNode}! ! !GPObjectParameter methodsFor: 'code generation' stamp: 'md 2/17/2007 12:10'! genForRBProgramNode ^RBVariableNode named: 'self'! ! GPParameter subclass: #GPOffsetParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPOffsetParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:30'! key ^#offset! ! !GPOffsetParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:30'! nodes ^{RBVariableNode. RBAssignmentNode}! ! !GPOffsetParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:48'! genForRBAssignmentNode ^ node variable binding index asLiteralNode! ! !GPOffsetParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:44'! genForRBVariableNode ^ node binding index asLiteralNode! ! GPParameter subclass: #GPOperationParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPOperationParameter class methodsFor: 'plugin interface' stamp: 'md 2/10/2007 17:18'! key ^#operation! ! !GPOperationParameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:36'! nodes ^{RBMessageNode . RBAssignmentNode. RBVariableNode. RBMethodNode}! ! !GPOperationParameter methodsFor: 'code generation' stamp: 'md 2/26/2007 17:59'! genForRBAssignmentNode node variable isTemp ifTrue: [ ^RBMessageNode receiver: GPTempAssignment asLiteralNode selector: #offset:in:put: arguments: {node variable binding index asLiteralNode . RBVariableNode named: 'thisContext' . node value}]. node variable isInstance ifTrue: [ ^RBMessageNode receiver: GPInstanceAssignment asLiteralNode selector: #offset:in:put: arguments: {node variable binding index asLiteralNode . RBVariableNode named: 'self' . node value}]. node variable isGlobal ifTrue: [ ^RBMessageNode receiver: GPGlobalAssignment asLiteralNode selector: #binding:newValue: arguments: {(GPBindingParameter node: node link: link) genForRBAssignmentNode. (GPNewValueParameter node: node link: link) genForRBAssignmentNode}. ].! ! !GPOperationParameter methodsFor: 'code generation' stamp: 'md 2/26/2007 17:55'! genForRBMessageNode ^ RBMessageNode receiver: GPMessageSend asLiteralNode selector: #receiver:selector:arguments: arguments: {node receiver. node selector asLiteralNode. (GPArgumentsParameter node: node link: link) genForRBMessageNode}! ! !GPOperationParameter methodsFor: 'code generation' stamp: 'md 2/26/2007 17:55'! genForRBMethodNode "The method wrapped needs to be the method with just not our link" | methodNode | methodNode := node copy. methodNode annotations: methodNode annotations copy. methodNode removeLink: link. ^ RBMessageNode receiver: GPMethod asLiteralNode selector: #method:receiver:arguments: arguments: { methodNode generate compiledMethod asLiteralNode. RBMessageNode receiver: (RBVariableNode named: 'thisContext') selector: #receiver. (GPArgumentsParameter node: node link: link) genForRBMethodNode} ! ! !GPOperationParameter methodsFor: 'code generation' stamp: 'md 2/26/2007 17:57'! genForRBVariableNode node isTemp ifTrue: [ ^RBMessageNode receiver: GPTempVariable asLiteralNode selector: #offset:in: arguments: {node binding index asLiteralNode. RBVariableNode named: 'thisContext'}]. node isInstance ifTrue: [ ^RBMessageNode receiver: GPInstanceVariable asLiteralNode selector: #offset:in: arguments: {node binding index asLiteralNode. RBVariableNode named: 'self'}]. node isGlobal ifTrue: [ ^RBMessageNode receiver: GPGlobalVariable asLiteralNode selector: #binding: arguments: {(GPBindingParameter node: node link: link) genForRBVariableNode} ]. ! ! !GPOperationParameter methodsFor: 'code generation' stamp: 'md 2/15/2007 10:18'! optimize ^true! ! !GPParameter class methodsFor: 'querying' stamp: 'md 2/13/2007 09:14'! allKeys ^self subclasses collect: [:plugin | plugin key]! ! !GPParameter class methodsFor: 'plugin interface' stamp: 'md 2/10/2007 22:12'! key ^self subclassResponsibility! ! !GPParameter class methodsFor: 'instance creation' stamp: 'md 2/12/2007 20:42'! node: aNode link: aLink ^self new node: aNode; link: aLink.! ! !GPParameter class methodsFor: 'plugin interface' stamp: 'md 2/10/2007 22:11'! nodes ^self subclassResponsibility! ! !GPParameter methodsFor: 'code generation' stamp: 'md 3/31/2007 18:59'! genForPEReflectiveMethodNode ^self genForRBMethodNode! ! !GPParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:47'! genForRBAssignmentNode ^self genForRBProgramNode! ! !GPParameter methodsFor: 'code generation' stamp: 'md 2/27/2007 21:17'! genForRBBlockNode ^self genForRBProgramNode! ! !GPParameter methodsFor: 'code generation' stamp: 'md 3/30/2007 10:06'! genForRBGlobalVariableNode ^self genForRBVariableNode! ! !GPParameter methodsFor: 'code generation' stamp: 'md 3/30/2007 10:06'! genForRBInstanceVariableNode ^self genForRBVariableNode! ! !GPParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:39'! genForRBMessageNode ^self genForRBProgramNode! ! !GPParameter methodsFor: 'code generation' stamp: 'md 2/12/2007 23:22'! genForRBMethodNode ^self genForRBProgramNode ! ! !GPParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:34'! genForRBProgamNode self subclassResponsibility! ! !GPParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:39'! genForRBProgramNode self subclassResponsibility! ! !GPParameter methodsFor: 'code generation' stamp: 'md 3/30/2007 10:06'! genForRBTempVariableNode ^self genForRBVariableNode! ! !GPParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:39'! genForRBVariableNode ^self genForRBProgramNode! ! !GPParameter methodsFor: 'accessing' stamp: 'md 2/12/2007 20:43'! link: aLink link := aLink.! ! !GPParameter methodsFor: 'accessing' stamp: 'md 2/10/2007 17:35'! node ^node! ! !GPParameter methodsFor: 'accessing' stamp: 'md 2/10/2007 17:35'! node: aNode node := aNode! ! !GPParameter methodsFor: 'code generation' stamp: 'md 2/15/2007 10:17'! optimize "do we optimize this reification if there are multiple ones?" ^false! ! GPParameter subclass: #GPProceedParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPProceedParameter class methodsFor: 'plugin interface' stamp: 'md 2/22/2007 17:32'! key ^#proceed! ! !GPProceedParameter class methodsFor: 'plugin interface' stamp: 'md 2/22/2007 17:32'! nodes ^{RBMessageNode . RBAssignmentNode. RBVariableNode. RBMethodNode}! ! !GPProceedParameter methodsFor: 'code generation' stamp: 'md 2/26/2007 17:59'! genForRBAssignmentNode node variable isTemp ifTrue: [ ^RBMessageNode receiver: GPTempAssignment asLiteralNode selector: #offset:in:put:context: arguments: {node variable binding index asLiteralNode . RBVariableNode named: 'thisContext' . node value. RBVariableNode named: 'thisContext'}]. node variable isInstance ifTrue: [ ^RBMessageNode receiver: GPInstanceAssignment asLiteralNode selector: #offset:in:put:context: arguments: {node variable binding index asLiteralNode . RBVariableNode named: 'self' . node value. RBVariableNode named: 'thisContext'}]. node variable isGlobal ifTrue: [ ^RBMessageNode receiver: GPGlobalAssignment asLiteralNode selector: #binding:newValue:context: arguments: {(GPBindingParameter node: node link: link) genForRBAssignmentNode. (GPNewValueParameter node: node link: link) genForRBAssignmentNode. RBVariableNode named: 'thisContext'}. ].! ! !GPProceedParameter methodsFor: 'code generation' stamp: 'md 2/26/2007 17:56'! genForRBMessageNode ^ RBMessageNode receiver: GPMessageSend asLiteralNode selector: #receiver:selector:arguments:context: arguments: {node receiver. node selector asLiteralNode. (GPArgumentsParameter node: node link: link) genForRBMessageNode. RBVariableNode named: 'thisContext'}! ! !GPProceedParameter methodsFor: 'code generation' stamp: 'md 2/26/2007 17:55'! genForRBMethodNode ^ RBMessageNode receiver: GPMethod asLiteralNode selector: #method:receiver:arguments:context: arguments: { RBMessageNode receiver: (RBVariableNode named: 'thisContext') selector: #method. RBMessageNode receiver: (RBVariableNode named: 'thisContext') selector: #receiver. (GPArgumentsParameter node: node link: link) genForRBMethodNode. RBVariableNode named: 'thisContext'} ! ! !GPProceedParameter methodsFor: 'code generation' stamp: 'md 2/26/2007 17:57'! genForRBVariableNode node isTemp ifTrue: [ ^RBMessageNode receiver: GPTempVariable asLiteralNode selector: #offset:in:context: arguments: {node binding index asLiteralNode. RBVariableNode named: 'thisContext'. RBVariableNode named: 'thisContext'}]. node isInstance ifTrue: [ ^ RBMessageNode receiver: GPInstanceVariable asLiteralNode selector: #offset:in:context: arguments: {node binding index asLiteralNode. RBVariableNode named: 'self'. RBVariableNode named: 'thisContext'}]. node isGlobal ifTrue: [ ^RBMessageNode receiver: GPGlobalVariable asLiteralNode selector: #binding:context: arguments: {(GPBindingParameter node: node link: link) genForRBVariableNode. RBVariableNode named: 'thisContext'} ]. ! ! !GPProceedParameter methodsFor: 'code generation' stamp: 'md 2/22/2007 17:32'! optimize ^true! ! GPParameter subclass: #GPReceiverParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPReceiverParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:56'! key ^#receiver! ! !GPReceiverParameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:36'! nodes ^{RBMessageNode. RBMethodNode}! ! !GPReceiverParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:17'! genForRBMessageNode ^node receiver! ! !GPReceiverParameter methodsFor: 'code generation' stamp: 'md 2/13/2007 10:25'! genForRBMethodNode ^RBMessageNode receiver: (RBVariableNode named: 'thisContext') selector: #receiver! ! !GPReceiverParameter methodsFor: 'code generation' stamp: 'md 2/15/2007 10:19'! optimize ^node isKindOf: RBMethodNode! ! GPParameter subclass: #GPResultParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPResultParameter class methodsFor: 'plugin interface' stamp: 'md 3/9/2007 17:28'! key ^#result! ! !GPResultParameter class methodsFor: 'plugin interface' stamp: 'md 3/9/2007 17:28'! nodes ^{RBMessageNode. RBMethodNode}! ! !GPResultParameter methodsFor: 'code generation' stamp: 'md 3/9/2007 18:10'! genForRBProgramNode ^RBVariableNode named: 'gpResultkkdkdkkd'.! ! GPParameter subclass: #GPSelectorParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPSelectorParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:55'! key ^#selector! ! !GPSelectorParameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 12:37'! nodes ^{RBMessageNode. RBMethodNode}! ! !GPSelectorParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:17'! genForRBMessageNode ^node selector asLiteralNode! ! !GPSelectorParameter methodsFor: 'code generation' stamp: 'md 2/13/2007 10:30'! genForRBMethodNode ^node selector asLiteralNode! ! GPParameter subclass: #GPSenderParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPSenderParameter class methodsFor: 'plugin interface' stamp: 'md 2/10/2007 18:03'! key ^#sender! ! !GPSenderParameter class methodsFor: 'plugin interface' stamp: 'md 3/31/2007 18:58'! nodes ^{RBMessageNode .PEReflectiveMethodNode}! ! !GPSenderParameter methodsFor: 'code generation' stamp: 'md 2/10/2007 22:19'! genForRBMessageNode ^RBVariableNode named: 'self'! ! !GPSenderParameter methodsFor: 'code generation' stamp: 'md 2/13/2007 11:30'! genForRBMethodNode ^RBMessageNode receiver: (RBMessageNode receiver: (RBVariableNode named: 'thisContext') selector: #gpsender) selector: #receiver. ! ! !GPSenderParameter methodsFor: 'code generation' stamp: 'md 2/15/2007 10:20'! optimize ^node isKindOf: RBMethodNode! ! GPParameter subclass: #GPSenderSelectorParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPSenderSelectorParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:55'! key ^#senderselector! ! !GPSenderSelectorParameter class methodsFor: 'plugin interface' stamp: 'md 3/31/2007 18:58'! nodes ^{RBMessageNode .PEReflectiveMethodNode}! ! !GPSenderSelectorParameter methodsFor: 'code generation' stamp: 'md 4/1/2007 13:13'! genForRBMessageNode ^ RBMessageNode receiver: (RBMessageNode receiver: (RBVariableNode named: 'thisContext') selector: #sender) selector: #selector.! ! !GPSenderSelectorParameter methodsFor: 'code generation' stamp: 'md 4/1/2007 13:12'! genForRBMethodNode ^ RBMessageNode receiver: (RBMessageNode receiver: (RBVariableNode named: 'thisContext') selector: #gpsender) selector: #selector.! ! !GPSenderSelectorParameter methodsFor: 'code generation' stamp: 'md 2/15/2007 10:20'! optimize ^true! ! GPParameter subclass: #GPThisContextParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPThisContextParameter class methodsFor: 'plugin interface' stamp: 'md 2/10/2007 22:08'! key ^#context! ! !GPThisContextParameter class methodsFor: 'plugin interface' stamp: 'md 2/15/2007 13:47'! nodes ^{RBProgramNode}.! ! !GPThisContextParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:36'! genForRBProgramNode ^RBVariableNode named: 'thisContext'! ! GPParameter subclass: #GPValueParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPValueParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:49'! key ^#value! ! !GPValueParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:49'! nodes ^{RBVariableNode. RBAssignmentNode}! ! !GPValueParameter methodsFor: 'code generation' stamp: 'md 2/23/2007 16:53'! genForRBProgramNode node isGlobal ifTrue: [^node binding value asLiteralNode]. ^node variable! ! GPParameter subclass: #GPVarNameParameter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Parameters'! !GPVarNameParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:31'! key ^#varname! ! !GPVarNameParameter class methodsFor: 'plugin interface' stamp: 'md 2/11/2007 10:31'! nodes ^{RBVariableNode. RBAssignmentNode}! ! !GPVarNameParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:49'! genForRBAssignmentNode ^ node variable binding name asLiteralNode! ! !GPVarNameParameter methodsFor: 'code generation' stamp: 'md 2/11/2007 11:45'! genForRBVariableNode ^ node binding name asLiteralNode! ! Object subclass: #GPTODO instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Tests'! !GPTODO methodsFor: 'Metrics' stamp: 'md 3/1/2007 21:58'! bench "just run the Tests" "self new bench" ^[GeppettoTest buildSuite run] timeToRun! ! !GPTODO methodsFor: 'TODO' stamp: 'md 3/9/2007 18:27'! todo ' -> Test: #result for after end of method -> Port Benchmarks and Examples of Geppetto 1 ============================================================================== -> think about multiple replace... -> complex link composition of Reflex. -> Optimize multiple links - preamble comes allways *after* condition check. - preamble sets all reifications of *this* link, conditionally: (temp ifNil: [temp := doReify]) - inside the hook, use just temp access. - check: condition is before preamble --> always generate reifications -> Support for Hookset like declarative pattern based definition of nodes -> Detect excessive recompiles of update, turn off inlining mo/condition '! ! !Object methodsFor: '*geppetto2' stamp: 'md 2/12/2007 11:00'! isBoolean ^false! ! !RBBlockNode methodsFor: '*geppetto2' stamp: 'md 3/8/2007 22:17'! gpAddAfter: aNode self body: (RBMessageNode receiver: (RBBlockNode body: self body) selector: #ensure: arguments: {RBBlockNode body: aNode copy asSequenceNode}) asSequenceNode.! ! !RBBlockNode methodsFor: '*geppetto2' stamp: 'md 3/8/2007 22:17'! gpAddBefore: aNode self body addNodeFirst: aNode.! ! !RBBlockNode methodsFor: '*geppetto2' stamp: 'md 2/27/2007 21:27'! gpreplaceWith: aNode self body: aNode copy asSequenceNode.! ! InstructionClient subclass: #GPBlockTempDecompiler instanceVariableNames: 'offsets' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Private'! !GPBlockTempDecompiler methodsFor: 'initialize-release' stamp: 'md 2/13/2007 16:05'! initialize offsets := OrderedCollection new. ^super initialize! ! !GPBlockTempDecompiler methodsFor: 'accessing' stamp: 'md 2/13/2007 16:07'! offsets ^offsets! ! !GPBlockTempDecompiler methodsFor: 'instruction decoding' stamp: 'md 2/13/2007 16:21'! popIntoTemporaryVariable: offset "Remove Top Of Stack And Store Into Temporary Variable bytecode." offsets add: offset.! ! !GPBlockTempDecompiler methodsFor: 'instruction decoding' stamp: 'md 2/13/2007 16:27'! storeIntoTemporaryVariable: offset "Store Top Of Stack Into Temporary Variable Of Method bytecode." offsets add: offset.! ! !RBMessageNode methodsFor: '*Geppetto2' stamp: 'md 2/9/2007 11:03'! addNode: a before: b parent addNode: a before: self.! ! !PEReflectiveMethodNode methodsFor: '*geppetto2' stamp: 'md 3/28/2007 15:15'! gpAddAfter: aNode self after add: aNode.! ! !PEReflectiveMethodNode methodsFor: '*geppetto2' stamp: 'md 3/28/2007 15:15'! gpAddBefore: aNode self before add: aNode.! ! !PEReflectiveMethodNode methodsFor: '*geppetto2' stamp: 'md 2/27/2007 21:25'! gpreplaceWith: aNode self body: aNode copy asSequenceNode.! ! !PEReflectiveMethodNode methodsFor: '*geppetto2' stamp: 'md 3/1/2007 17:38'! link: aLink aLink hookOn: self ! ! !PEReflectiveMethodNode methodsFor: '*geppetto2' stamp: 'md 3/21/2007 15:11'! resetCache self scope: nil. self parent ifNotNil: [self parent invalidate].! ! RBProgramNodeVisitor subclass: #GPStatementCollector instanceVariableNames: 'statements' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Private'! !GPStatementCollector methodsFor: 'visitor-double dispatching' stamp: 'md 2/10/2007 16:41'! acceptAssignmentNode: anAssignmentNode "self visitNode: anAssignmentNode variable." self visitNode: anAssignmentNode value! ! !GPStatementCollector methodsFor: 'visitor-double dispatching' stamp: 'md 2/10/2007 16:50'! acceptSequenceNode: aSequenceNode "self visitTemporaryVariables: aSequenceNode temporaries." aSequenceNode statements do: [:each | self visitNode: each]! ! !GPStatementCollector methodsFor: 'initialize-release' stamp: 'md 2/10/2007 16:33'! initialize statements := OrderedCollection new.! ! !GPStatementCollector methodsFor: 'accessing' stamp: 'md 2/10/2007 16:36'! statements ^statements! ! !GPStatementCollector methodsFor: 'visiting' stamp: 'md 2/10/2007 16:37'! visitMethodArguments: aNodeCollection "don't visit arguments"! ! !GPStatementCollector methodsFor: 'visiting' stamp: 'md 2/10/2007 16:33'! visitNode: aNode statements add: aNode. ^super visitNode: aNode.! ! MultiValuedAnnotation subclass: #GPLinkAnnotation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Kernel'! !GPLinkAnnotation class methodsFor: 'accessing' stamp: 'md 2/7/2007 09:41'! keys ^#(link)! ! !GPLinkAnnotation methodsFor: 'testing' stamp: 'md 2/3/2007 16:55'! isSourceVisible ^false! ! !ReflectiveMethod methodsFor: '*geppetto2' stamp: 'md 2/10/2007 09:30'! assignments ^self nodes select: [:each | each isAssignment].! ! !ReflectiveMethod methodsFor: '*geppetto2' stamp: 'md 2/27/2007 21:04'! blocks ^self nodes select: [:each | each isBlock].! ! !ReflectiveMethod methodsFor: '*geppetto2' stamp: 'md 2/24/2007 19:13'! isMethod ^true! ! !ReflectiveMethod methodsFor: '*geppetto2' stamp: 'md 2/9/2007 19:32'! nodes | nodes | nodes := OrderedCollection new. self methodNode nodesDo: [:node | nodes add: node]. ^nodes! ! !ReflectiveMethod methodsFor: '*geppetto2' stamp: 'md 3/9/2007 18:44'! replaceNode: aNode withNode: anotherNode methodNode == aNode ifTrue: [self methodNode: anotherNode].! ! !ReflectiveMethod methodsFor: '*geppetto2' stamp: 'md 2/10/2007 09:31'! sends ^self nodes select: [:each | each isMessage].! ! !ReflectiveMethod methodsFor: '*geppetto2' stamp: 'md 2/10/2007 16:36'! statements ^(GPStatementCollector new visitNode: self methodNode) statements! ! !ReflectiveMethod methodsFor: '*geppetto2' stamp: 'md 2/10/2007 16:40'! variables ^self statements select: [:each | each isVariable].! ! !MethodContext methodsFor: '*geppetto2' stamp: 'md 4/18/2007 13:18'! gpsender ^(sender receiver isKindOf: ReflectiveMethod) ifTrue: [sender sender] ifFalse: [sender].! ! PECompilerPlugin subclass: #GPTransformer instanceVariableNames: 'node link hook plugins table ptable' classVariableNames: '' poolDictionaries: '' category: 'Geppetto2-Kernel'! !GPTransformer methodsFor: 'transformation' stamp: 'md 3/8/2007 22:16'! addPreamble: aNode ptable do: [:each | aNode gpAddBefore: each].! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 3/8/2007 22:00'! genInitialHook | metaObject | metaObject := (link metaObject isSymbol and: [self reifications includes: link metaObject]) "Allow reifications as MetaObject" ifTrue: [table at: link metaObject] ifFalse: [link isInlineMeta ifTrue: [link metaObject asLiteralNode] ifFalse: [RBMessageNode receiver: link asLiteralNode selector: #metaObject]]. link hasMoScope ifTrue: [metaObject := RBMessageNode receiver: link asLiteralNode selector: #metaObjectFor: arguments: {table at: link moScope}]. hook := RBMessageNode receiver: metaObject selector: link selector arguments: (link arguments collect: #asLiteralNode). ! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 2/23/2007 00:09'! genSelectorFor: aCondition ^link isInlineCondition ifTrue: [link condition valueSelector] ifFalse: [#isActive numArgs: aCondition numArgs]. ! ! !GPTransformer methodsFor: 'accessing' stamp: 'md 2/7/2007 14:43'! hook: aHook hook := aHook! ! !GPTransformer methodsFor: 'initializing' stamp: 'md 2/26/2007 17:32'! initForNode: aNode node := aNode. table := Dictionary new. ptable := Dictionary new. plugins := Dictionary new. "register all the plugins that can reify information for this node" GPParameter subclasses do: [:plugin | (plugin nodes anySatisfy: [:class | node isKindOf: class]) ifTrue: [ plugins at: plugin key put: (plugin node: node link: link)] ]! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 3/9/2007 18:24'! insertCode link isBefore ifTrue: [node gpAddBefore: hook]. link isAfter ifTrue: [node gpAddAfter: hook]. link isBeforeAfter ifTrue: [node gpAddAfter: hook. node gpAddBefore: hook]. link isInstead ifTrue: [node gpreplaceWith: hook].! ! !GPTransformer methodsFor: 'accessing' stamp: 'md 2/7/2007 14:43'! link: aLink link := aLink! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 2/14/2007 21:29'! patchArguments hook arguments: (link arguments collect: [:each | table at: each]) ! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 2/15/2007 10:35'! reifications "all reifications the plugins installed can do. Installed are only the plugins compatible with the node" ^plugins values collect: [:each | each class key].! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 2/15/2007 10:34'! selectorForNode "The selector to be called on the Reification plugin" ^('genFor' , node class name) asSymbol.! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 3/21/2007 13:27'! setupTable "Here we set up two tables: for every reification requested, we put the Reifier Plugin into 'table'. If a second reification is requested that requires complex code, we move the reification code into the preamble's 'ptable' and put an tempVarRead into the main table instead Later we just access 'table at: symbol' to get code for a requested reification and generate a preamble that fills those variable at the beginning of the link's code" | reification | reification := OrderedCollection new. reification addAll: link arguments. link metaObject isSymbol ifTrue: [reification add: link metaObject]. (link condition isKindOf: BlockContext) ifTrue: [reification addAll: (link condition blockArgNames collect: #asSymbol)]. link hasMoScope ifTrue: [reification add: link moScope]. reification do: [:symbol | (plugins at: symbol) optimize ifTrue: [ "don't bother to optimize one-bytecode reifications" ((table includesKey: symbol) and: [(ptable includesKey: symbol) not]) ifTrue: [ | var | "we already saw this one, use temp instead" var := RBVariableNode named: ('gphhhddd', symbol). ptable at: symbol put: (RBAssignmentNode variable: var value: (table at: symbol)). node methodNode body addTemporaryNamed: 'gphhhddd', symbol. table at: symbol put: var. ]. ]. table at: symbol ifAbsentPut: [(plugins at: symbol) perform: self selectorForNode]. ]! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 3/21/2007 13:30'! transform "Main transformation method" (link isInlineCondition and: [link condition = false]) ifTrue: [^self]. "nothing to do..." self setupTable. link hasCondition ifFalse: [self addPreamble: node]. self genInitialHook. self patchArguments. self wrapCondition. link requestsContinuation ifTrue: [self wrapContinuation]. link requestsResult ifTrue: [self wrapResult]. self insertCode. ! ! !GPTransformer methodsFor: 'visiting' stamp: 'md 2/19/2007 17:59'! visitNode: aNode aNode hasAnyLink ifTrue: [ aNode links do: [:each | link := each. self initForNode: aNode. self transform. ]. ]. super visitNode: aNode. ! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 3/21/2007 13:29'! wrapCondition | ifSelector ifArguments condReceiver condSelector condArguments blockBody blockBody2 | link hasCondition ifFalse: [^self]. "no condition" (link isInlineCondition and: [link condition = true]) ifTrue: [^self]. "no condition needed" condReceiver := (link isInlineCondition ifTrue: [link condition] ifFalse: [link]) asLiteralNode. condSelector := self genSelectorFor: link condition. (condSelector numArgs = 0) ifTrue: [condArguments := #()]. (condSelector numArgs > 0) ifTrue: [ condArguments := OrderedCollection new. 1 to: condSelector numArgs do: [:i | condArguments add: (table at: (link condition blockArgNames at: i) asSymbol)] ]. ifSelector := link isInstead ifTrue: [#ifTrue:ifFalse:] ifFalse:[#ifTrue:]. blockBody := hook asSequenceNode. self addPreamble: hook. blockBody2 := (node isKindOf: RBMethodNode) ifTrue: [node body] ifFalse: [node copy asSequenceNode]. ifArguments := link isInstead ifTrue: [{RBBlockNode body: blockBody. RBBlockNode body: blockBody2 }] ifFalse: [{RBBlockNode body: blockBody}]. hook := RBMessageNode receiver: (RBMessageNode receiver: condReceiver selector: condSelector arguments: condArguments) selector: ifSelector arguments: ifArguments. ! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 3/30/2007 17:18'! wrapContinuation | continuationBlock | continuationBlock := RBBlockNode arguments: {RBVariableNode named: 'continuation'} body: hook asSequenceNode. hook := RBMessageNode receiver: GPContinuation asLiteralNode selector: #gpCurrentDo: argument: continuationBlock. ! ! !GPTransformer methodsFor: 'transformation' stamp: 'md 3/10/2007 14:04'! wrapResult | parent | parent := node parent. node methodNode body addTemporaryNamed: 'gpResultkkdkdkkd'. node isMethod ifFalse: [ node replaceWith: ((RBAssignmentNode variable: (RBVariableNode named: 'gpResultkkdkdkkd') value: node copy) parent: parent)] ifTrue: [ | toReplace | toReplace := node body statements first. toReplace replaceWith: (RBAssignmentNode variable: (RBVariableNode named: 'gpResultkkdkdkkd') value: toReplace copy). toReplace methodNode body addTemporaryNamed: 'gpResultkkdkdkkd'. ] ! ! !RBReturnNode methodsFor: '*geppetto2' stamp: 'md 2/9/2007 11:14'! addNode: aNode after: anotherNode self halt. "TODO"! ! !RBReturnNode methodsFor: '*geppetto2' stamp: 'md 2/7/2007 13:27'! addNode: aNode before: anotherNode parent addNode: aNode before: self! ! !Boolean methodsFor: '*geppetto2' stamp: 'md 2/12/2007 11:00'! isBoolean ^true! !