Update the visitor pattern

Gwenael Casaccio · Gwenael Casaccio · commit 91c2712c00bb · 2010-09-03T14:53:02.000+02:00
diff --git a/IRFunction.st b/IRFunction.st
@@ -89,6 +89,11 @@ Instruction subclass: IRFunction [
         ^ variables at: aSymbol ifAbsent: aBlock
     ]
 
+    variablesDo: aOneArgBlock [
+
+	^ variables do: aOneArgBlock
+    ]
+
     instructions [
 
 	^ instructions
@@ -106,11 +111,7 @@ Instruction subclass: IRFunction [
 
     accept: aVisitor [
 
-        aVisitor visitFunction: self.
-        variables do: [ :each |
-            each accept: aVisitor ].
-        instructions do: [ :each |
-            each accept: aVisitor ]
+        aVisitor visitFunction: self
     ]
 ]
 
diff --git a/IRInterpret.st b/IRInterpret.st
@@ -35,7 +35,8 @@ IRVisitor subclass: IRInterpret [
 	i := 0.
 	aFunction argumentDo: [ :each |
 	    i := i + 1.
-	    variables at: each name put: (argsValue at: i) ]
+	    variables at: each name put: (argsValue at: i) ].
+	super visitFunction: aFunction
     ]
 
     variableValue: aSymbol [
diff --git a/IRPrinter.st b/IRPrinter.st
@@ -29,16 +29,18 @@ IRVisitor subclass: IRPrinter [
 
 	| i keywords |
 	keywords := aFunction name keywords.
-	keywords size = 1 ifTrue: [ ^ stream
+	keywords size = 1 ifTrue: [ stream
 					nextPutAll: keywords first;
-					nl ].
+					nl.
+				    ^ super visitFunction: aFunction ].
 	i := 1.
 	keywords do: [ :each |
 	    stream
 		nextPutAll: each , ' ', (aFunction argumentAt: i) name, ' ', (aFunction argumentAt: i) type name.
 	    i := i + 1.
 	    i > keywords size ifFalse: [ stream nextPutAll: ' ' ] ].
-	stream nl
+	stream nl.
+	super visitFunction: aFunction
     ]
 
     visitVariableDeclaration: aVariable [
diff --git a/IRVisitor.st b/IRVisitor.st
@@ -13,6 +13,11 @@ Object subclass: IRVisitor [
     ]
 
     visitFunction: aFunction [
+
+        aFunction variablesDo: [ :each |
+            each accept: self ].
+        aFunction instructionsDo: [ :each |
+            each accept: self ]
     ]
 
     visitInteger: anInteger [
diff --git a/Ret.st b/Ret.st
@@ -1,3 +1,18 @@
 Instruction subclass: Ret [
+
+    Ret class >> value: anObject [
+    ]
+
+    | value |
+
+    value: anobject [
+
+	value := anObject
+    ]
+
+    value [
+
+	^ value
+    ]
 ]
 
diff --git a/Thunder.st b/Thunder.st
@@ -122,5 +122,10 @@ Object subclass: Thunder [
 
 	self addInstruction: (Ret new) 
     ]
+
+    ret: anObject [
+
+        self addInstruction: (Ret value: anObject)
+    ]
 ]
 
diff --git a/UChar.st b/UChar.st
@@ -1,5 +1,10 @@
 Type subclass: UChar [
 
+    UChar class >> cname [
+
+        ^ 'unsigned char'
+    ]
+
     UChar class >> readFrom: aByteArray at: anInteger [
 
         ^ (aByteArray at: anInteger + 1) ifNil: [ self error: 'Memory is not initialized' ]
diff --git a/UInt.st b/UInt.st
@@ -1,3 +1,8 @@
 Type subclass: UInt [
+
+    UInt class >> cname [
+
+	^ 'unsigned int'
+    ]
 ]
 
diff --git a/package.xml b/package.xml
@@ -8,19 +8,22 @@
     <filein>tests/LifeTimeIntervalTest.st</filein>
     <filein>tests/LinearScanRegisterAllocTest.st</filein>
     <filein>tests/InterpretTest.st</filein>
+    <filein>tests/CTranslatorTest.st</filein>
     <file>tests/ThunderTest.st</file>
     <file>tests/VariableTest.st</file>
     <file>tests/PrinterTest.st</file>
     <file>tests/LifeTimeIntervalTest.st</file>
     <file>tests/LinearScanRegisterAllocTest.st</file>
     <file>tests/InterpretTest.st</file>
+    <file>tests/CTranslatorTest.st</file>
     <sunit>
       GSTThunder.ThunderTest
       GSTThunder.VariableTest
       GSTThunder.PrinterTest
       GSTThunder.LifeTimeIntervalTest
       GSTThunder.LinearScanRegisterAllocTest
       GSTThunder.InterpretTest
+      GSTThunder.CTranslatorTest
     </sunit>
   </test>
   <filein>Extends.st</filein>
diff --git a/tests/CTranslatorTest.st b/tests/CTranslatorTest.st
@@ -0,0 +1,16 @@
+TestCase subclass: CTranslatorTest [
+
+    testFunction [
+        <category: 'testing'>
+
+        | string th |
+        th := Thunder new.
+        th
+            function: #'foo:bar:' parameters: {#nb->UInt. #size->UChar} return: UInt.
+
+        string := (CTranslator on: th function) stream contents.
+        self assert: string =  'unsigned int foobar (unsigned int nb, unsigned char size)
+'
+    ]
+]
+
diff --git a/tests/PrinterTest.st b/tests/PrinterTest.st
@@ -28,7 +28,6 @@ a UInt
 	    variable: #b type: Int.
 
 	string := (IRPrinter on: th function) stream contents.
-
 	self assert: string =  'foo
 b Int
 a UInt
diff --git a/tr/c.st b/tr/c.st
@@ -1,5 +1,49 @@
 IRVisitor subclass: CTranslator [
 
+    CTranslator class >> on: aProgram [
+
+        ^ self new
+            initialize;
+            visitProgram: aProgram;
+            yourself
+    ]
+
+    | stream |
+
+    initialize [
+
+        stream := WriteStream on: String new
+    ]
+
+    stream [
+
+        ^ stream
+    ]
+
+    visitProgram: aProgram [
+
+        aProgram accept: self
+    ]
+
+    visitFunction: aFunction [
+
+        | keywords |
+	stream nextPutAll: aFunction return cname, ' '.
+        keywords := aFunction name keywords.
+        keywords size = 1 ifTrue: [ ^ stream
+                                        nextPutAll: keywords first, '( void ) ';
+                                        nl ].
+	keywords do: [ :each | stream nextPutAll: (each copyFrom: 1 to: each size - 1) ].
+	stream nextPutAll: ' ('.
+        1 to: keywords size do: [ :i |
+            stream
+                nextPutAll: (aFunction argumentAt: i) type cname, ' ', (aFunction argumentAt: i) name.
+            i = keywords size ifFalse: [ stream nextPutAll: ', ' ] ].
+	stream 
+	    nextPutAll: ')';
+	    nl
+    ]
+
     visitVariableDeclaration: aVariable [
 
         stream
diff --git a/tr/lightning.st b/tr/lightning.st
@@ -0,0 +1,3 @@
+IRVisitor subclass: Lightning [
+]
+

Original file line number	Diff line number	Diff line change
`@@ -89,6 +89,11 @@ Instruction subclass: IRFunction [`
`89`	`89`	`^ variables at: aSymbol ifAbsent: aBlock`
`90`	`90`	`]`
`91`	`91`
	`92`	`+ variablesDo: aOneArgBlock [`
	`93`	`+`
	`94`	`+ ^ variables do: aOneArgBlock`
	`95`	`+ ]`
	`96`	`+`
`92`	`97`	`instructions [`
`93`	`98`
`94`	`99`	`^ instructions`
`@@ -106,11 +111,7 @@ Instruction subclass: IRFunction [`
`106`	`111`
`107`	`112`	`accept: aVisitor [`
`108`	`113`
`109`		`- aVisitor visitFunction: self.`
`110`		`- variables do: [ :each \|`
`111`		`- each accept: aVisitor ].`
`112`		`- instructions do: [ :each \|`
`113`		`- each accept: aVisitor ]`
	`114`	`+ aVisitor visitFunction: self`
`114`	`115`	`]`
`115`	`116`	`]`
`116`	`117`
Original file line number	Diff line number	Diff line change
`@@ -35,7 +35,8 @@ IRVisitor subclass: IRInterpret [`
`35`	`35`	`i := 0.`
`36`	`36`	`aFunction argumentDo: [ :each \|`
`37`	`37`	`i := i + 1.`
`38`		`- variables at: each name put: (argsValue at: i) ]`
	`38`	`+ variables at: each name put: (argsValue at: i) ].`
	`39`	`+ super visitFunction: aFunction`
`39`	`40`	`]`
`40`	`41`
`41`	`42`	`variableValue: aSymbol [`
Original file line number	Diff line number	Diff line change
`@@ -13,6 +13,11 @@ Object subclass: IRVisitor [`
`13`	`13`	`]`
`14`	`14`
`15`	`15`	`visitFunction: aFunction [`
	`16`	`+`
	`17`	`+ aFunction variablesDo: [ :each \|`
	`18`	`+ each accept: self ].`
	`19`	`+ aFunction instructionsDo: [ :each \|`
	`20`	`+ each accept: self ]`
`16`	`21`	`]`
`17`	`22`
`18`	`23`	`visitInteger: anInteger [`
Original file line number	Diff line number	Diff line change
`@@ -122,5 +122,10 @@ Object subclass: Thunder [`
`122`	`122`
`123`	`123`	`self addInstruction: (Ret new)`
`124`	`124`	`]`
	`125`	`+`
	`126`	`+ ret: anObject [`
	`127`	`+`
	`128`	`+ self addInstruction: (Ret value: anObject)`
	`129`	`+ ]`
`125`	`130`	`]`
`126`	`131`
Original file line number	Diff line number	Diff line change
`@@ -1,3 +1,8 @@`
`1`	`1`	`Type subclass: UInt [`
	`2`	`+`
	`3`	`+ UInt class >> cname [`
	`4`	`+`
	`5`	`+ ^ 'unsigned int'`
	`6`	`+ ]`
`2`	`7`	`]`
`3`	`8`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+IRVisitor subclass: Lightning [`
	`2`	`+]`
	`3`	`+`