devtools/PPPrinter.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Sat, 19 Mar 2016 00:12:47 +0100
changeset 556 51c6afba5c91
parent 123 353f9f08be3f
permissions -rw-r--r--
CI: Use VM provided by Pharo team on both Linux and Windows. Hand-crafter Pharo VM is no longer needed as the Linux slave in SWING build farm has been upgraded so it has compatible GLIBC. This makes CI scripts simpler and more usable for other people.

"{ 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 $'
! !