devtools/PPPrinter.st
changeset 123 353f9f08be3f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/devtools/PPPrinter.st	Fri Jan 11 10:57:40 2013 +0100
@@ -0,0 +1,174 @@
+"{ Package: 'stx:goodies/petitparser/devtools' }"
+
+PPParserVisitor subclass:#PPPrinter
+	instanceVariableNames:'stream root'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitParser-Utils'
+!
+
+
+!PPPrinter class methodsFor:'instance creation'!
+
+new
+    "return an initialized instance"
+
+    ^ self basicNew initialize.
+! !
+
+!PPPrinter class methodsFor:'printing'!
+
+print: parser
+    ^self new print: parser.
+
+    "Created: / 11-01-2013 / 09:51:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPPrinter methodsFor:'accessing'!
+
+stream
+    ^ stream
+!
+
+stream:something
+    stream := something.
+! !
+
+!PPPrinter methodsFor:'initialization'!
+
+initialize
+    stream := String new writeStream.
+    root := nil.
+
+    "Modified: / 11-01-2013 / 09:21:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPPrinter methodsFor:'printing'!
+
+print: parser
+    self visit: parser.
+    ^stream contents
+
+    "Created: / 11-01-2013 / 09:51:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPPrinter methodsFor:'visiting'!
+
+visit:anObject 
+    "visit anObject (visitor pattern).
+     The object should call back one of my visitXXXX methods."
+
+    anObject name notNil ifTrue:[
+        stream nextPutAll: anObject name.
+        root isNil ifTrue:[
+            stream cr; cr; tab.
+            stream nextPut: $^.
+            root := anObject.
+            anObject acceptVisitor:self.
+        ].
+        ^self
+    ].
+    stream nextPut:$(.
+    anObject acceptVisitor:self.
+    stream nextPut:$)
+
+    "Created: / 11-01-2013 / 09:17:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPChoiceParser:anObject 
+    "dispatched back from the visited pPChoiceParser-object (visitor pattern)"
+
+    "fall back to general object-case - please change as required"
+
+    root == anObject ifTrue:[stream space].
+
+    anObject children 
+        do: [:parser|self visit: parser. root == anObject ifTrue:[stream cr; tab] ifFalse:[stream space]]
+        separatedBy:[stream nextPutAll: '/ '].
+
+    "Created: / 11-01-2013 / 09:18:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPEpsilonParser:anObject 
+    stream nextPutAll: 'nil asParser'
+
+    "Created: / 11-01-2013 / 09:34:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPLiteralObjectParser:anObject 
+    self visitPPLiteralParser: anObject
+
+    "Created: / 11-01-2013 / 09:29:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPLiteralParser:anObject 
+    anObject literal storeOn: stream.
+    stream nextPutAll: ' asParser'
+
+    "Created: / 11-01-2013 / 09:29:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPLiteralSequenceParser:anObject 
+    self visitPPLiteralParser: anObject
+
+    "Created: / 11-01-2013 / 09:29:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPOptionalParser:anObject 
+    self visit: anObject children anElement.
+    stream nextPutAll: ' optional'.
+
+    "Created: / 11-01-2013 / 09:27:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPPredicateObjectParser:anObject 
+    stream nextPutAll: '(self error: ''Cannot print predicate object parsers'')'
+
+    "Created: / 11-01-2013 / 09:32:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPRepeatingParser:anObject 
+    self visit: anObject children anElement.
+    (anObject min == 0 and:[anObject max = SmallInteger maxVal]) ifTrue:[
+        stream nextPutAll:' star'.
+        ^self.
+    ].
+    (anObject min == 1 and:[anObject max = SmallInteger maxVal]) ifTrue:[
+        stream nextPutAll:' plus'.
+        ^self.
+    ].
+
+    stream 
+        nextPutAll:' min: ';
+        nextPutAll: anObject min printString;
+        nextPutAll:' max: ';
+        nextPutAll: anObject max printString
+
+    "Created: / 11-01-2013 / 09:27:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPSequenceParser:anObject 
+    "dispatched back from the visited pPSequenceParser-object (visitor pattern)"
+
+    anObject children 
+        do: [:parser|self visit: parser]
+        separatedBy:[stream nextPutAll: ' , '].
+
+    "Created: / 11-01-2013 / 09:18:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPPUnresolvedParser:anObject 
+    stream nextPutAll: '(self error: ''Unresolved'')'
+
+    "Created: / 11-01-2013 / 09:33:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPPrinter class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/devtools/PPPrinter.st,v 1.1 2013-01-11 09:57:40 vrany Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/devtools/PPPrinter.st,v 1.1 2013-01-11 09:57:40 vrany Exp $'
+! !