--- /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 $'
+! !