"{ Package: 'stx:goodies/petitparser/compiler' }"!

!Character methodsFor:'*petitcompiler'!

ppcPrintable

    ^ self asInteger > 31 and: [ self asInteger < 127 ]

! !

!Object methodsFor:'*petitcompiler'!

isInlinedMethod

    ^ false

! !

!PPActionParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCActionNode new

        name: self name;

        block: block;

        child: parser;

        properties: properties;

        parser: self;

        yourself

! !

!PPActionParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

    block isSymbol ifTrue: [  

        ^ aPetitCompiler compileSymbolBlock: block for: self 

    ].

    ^ aPetitCompiler compileBlock: block for: self

! !

!PPAndParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCAndNode new

        name: self name;

        child: parser;

        yourself

! !

!PPCharSetPredicate methodsFor:'*petitcompiler'!

= anObject

    self == anObject ifTrue: [ ^ true ].

    self class == anObject class ifFalse: [ ^ false ].

    ^ classification = anObject classification

! !

!PPCharSetPredicate methodsFor:'*petitcompiler'!

block

    ^ block

! !

!PPCharSetPredicate methodsFor:'*petitcompiler'!

classification

    ^ classification

! !

!PPCharSetPredicate methodsFor:'*petitcompiler'!

equals: anotherPredicate

    self == anotherPredicate ifTrue: [ ^ true ].

    self class == anotherPredicate class ifFalse: [ ^ false ].

    ^ classification  = anotherPredicate classification.

! !

!PPCharSetPredicate methodsFor:'*petitcompiler'!

hash

    ^ classification hash

! !

!PPChoiceParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCChoiceNode new

        name: self name;

        children: parsers;

        parser: self;

        yourself

! !

!PPChoiceParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

    ^ aPetitCompiler compileChoice: self

! !

!PPContext methodsFor:'*petitcompiler'!

asCompiledParserContext

    ^ PPCContext new

        stream: stream;

        yourself

! !

!PPContext methodsFor:'*petitcompiler'!

atWs

    ^ false

! !

!PPContext methodsFor:'*petitcompiler'!

comment

    ^ self globalAt: #comment ifAbsent: [ nil ].

! !

!PPContext methodsFor:'*petitcompiler'!

comment: value

    ^ self globalAt: #comment put: value

! !

!PPContext methodsFor:'*petitcompiler'!

compiledParser

    ^ self globalAt: #compiledParser

! !

!PPContext methodsFor:'*petitcompiler'!

compiledParser: aPPParser

    ^ self globalAt: #compiledParser put: aPPParser

! !

!PPContext methodsFor:'*petitcompiler'!

lwRemember

    ^ self position

! !

!PPContext methodsFor:'*petitcompiler'!

lwRestore: position

    ^ self position: position

! !

!PPContext methodsFor:'*petitcompiler'!

methodInvoked: whatever

    "nothing to do"

! !

!PPContext methodsFor:'*petitcompiler'!

peek: anInteger

    ^ stream peek: anInteger

! !

!PPContext methodsFor:'*petitcompiler'!

setWs

    "nothing to do"

! !

!PPContext methodsFor:'*petitcompiler'!

skipSeparators

    ^ stream skipSeparators

! !

!PPContext methodsFor:'*petitcompiler'!

whitespace

    ^ self globalAt: #whitespace ifAbsent: [ nil ].

! !

!PPContext methodsFor:'*petitcompiler'!

whitespace: value

    ^ self globalAt: #whitespace put: value

! !

!PPDelegateParser methodsFor:'*petitcompiler'!

asCompilerNode

    self class == PPDelegateParser ifTrue: [ 

        ^ PPCForwardNode new

            name: self name;

            child: parser;

            yourself

    ].

    ^ super asCompilerNode 

! !

!PPDelegateParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

    (self class == PPDelegateParser) ifTrue: [ 

        (self name notNil and: [ parser name isNil ]) ifTrue: [ 

            parser name: self name.

            ^ parser compileWith: aPetitCompiler.

        ].

        (self name notNil and: [ parser name notNil ]) ifTrue: [ 

            ^ aPetitCompiler compileDelegate: self.

        ]

    ].

    ^ super compileWith: aPetitCompiler.

! !

!PPEndOfInputParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCEndOfInputNode new

        name: self name;

        child: parser;

        yourself	

! !

!PPEpsilonParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCNilNode new

! !

!PPEpsilonParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

    ^ aPetitCompiler compileNil

! !

!PPFailure methodsFor:'*petitcompiler'!

context: aPPContext

    context := aPPContext

! !

!PPFailure methodsFor:'*petitcompiler'!

message: text

    message := text

! !

!PPFailure methodsFor:'*petitcompiler'!

position: anInteger

    position := anInteger

! !

!PPJavaWhitespaceParser methodsFor:'*petitcompiler'!

= anotherParser

    anotherParser == self ifTrue: [ ^ true ].

   anotherParser class = self class ifFalse: [ ^ false ].

 ^ anotherParser name = self name

! !

!PPJavaWhitespaceParser methodsFor:'*petitcompiler'!

hash

    ^ self name hash

! !

!PPLiteralObjectParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCCharacterNode new

        character: literal;

        name: self name;

        yourself

! !

!PPLiteralObjectParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

    ^ aPetitCompiler compileCharacter: literal.

! !

!PPLiteralParser methodsFor:'*petitcompiler'!

id

    ^ literal printString

! !

!PPLiteralSequenceParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCLiteralNode new

        literal: literal;

        name: self name;

        yourself

! !

!PPLiteralSequenceParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

    ^ aPetitCompiler compileLiteral: literal.

! !

!PPNotParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCNotNode new 

        child: parser;

        name: self name;

        yourself

! !

!PPNotParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

    ^ aPetitCompiler compileNot: self

! !

!PPOptionalParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCOptionalNode new

        name: self name;

        child: parser;

        yourself

"	^ super asCompilerNode "

! !

!PPOptionalParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

    ^ aPetitCompiler compileOptional: self

! !

!PPParser methodsFor:'*petitcompiler'!

allNodesDo: aBlock seen: aSet

    "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."

    (aSet includes: self) ifTrue: [ ^ self ].

    aSet add: self.

    aBlock value: self.

    self children do: [ :each | 

        each allNodesDo: aBlock seen: aSet 

    ]

! !

!PPParser methodsFor:'*petitcompiler'!

asCompilerNode

    ^ PPCUnknownNode new

        parser: self;

        name: self name;

        yourself

! !

!PPParser methodsFor:'*petitcompiler'!

asCompilerTree

    ^ self transform: [ :p | p asCompilerNode  ]

! !

!PPParser methodsFor:'*petitcompiler'!

bridge

    ^ self

! !

!PPParser methodsFor:'*petitcompiler'!

compile

    ^ self compile: PPCArguments default

! !

!PPParser methodsFor:'*petitcompiler'!

compile: arguments

    self assert: (arguments isKindOf: PPCArguments).

    ^ PPCConfiguration default

        arguments: arguments;

        compile: self

! !

!PPParser methodsFor:'*petitcompiler'!

compile: arguments andParse: input

    ^ (self compile: arguments) parse: input

! !

!PPParser methodsFor:'*petitcompiler'!

compileAs: name

    | arguments |

    arguments := PPCArguments default.

    arguments name: name.

    ^ self compile: arguments

! !

!PPParser methodsFor:'*petitcompiler'!

    | configuration |

    ^ self compileWithConfiguration: configuration

! !

!PPParser methodsFor:'*petitcompiler'!

compileWithConfiguration: configuration

    ^ configuration compile: self

! !

!PPParser methodsFor:'*petitcompiler'!

firstSetSuchThat: block

    self halt: 'deprecated?'.

    ^ self firstSetSuchThat: block into: (OrderedCollection new) openSet: IdentitySet new.

! !

!PPParser methodsFor:'*petitcompiler'!

firstSetSuchThat: block into: aCollection openSet: aSet

    (aSet includes: self) ifTrue: [ ^ aCollection ].

    aSet add: self.

    (block value: self) ifTrue: [aCollection add: self. ^ aCollection ].

    self children do: [ :child | 

        child firstSetSuchThat: block into: aCollection openSet: aSet 

    ].

    ^ aCollection

! !

!PPParser methodsFor:'*petitcompiler'!

id

    self name ifNotNil: [ ^ self name ].

    ^ self hash asString

! !

!PPParser methodsFor:'*petitcompiler'!

isCompiled

    ^ false

! !

!PPParser methodsFor:'*petitcompiler'!

isContextFree

    ^ self propertyAt: #isContextFree ifAbsentPut: 

        [ self allParsers allSatisfy: [ :p | p isContextFreePrim ] ].

! !

!PPParser methodsFor:'*petitcompiler'!

isContextFreePrim

    ^ true

! !

!PPParser methodsFor:'*petitcompiler'!

isToken

    ^ false

! !

!PPParser methodsFor:'*petitcompiler'!

isTokenParser

    ^ false

! !

!PPParser methodsFor:'*petitcompiler'!

javaToken

    | ws |

    ws := PPJavaWhitespaceParser new.

    ^ ((ws, ((PPTokenParser on: self) tokenClass: PPJavaToken; yourself), ws) ==> #second)

        propertyAt: #'trimmingToken' put: true;

        yourself

! !

!PPParser methodsFor:'*petitcompiler'!

optimize

    ^ self copy

! !

!PPParser methodsFor:'*petitcompiler'!

optimized

    ^ self copy

! !

!PPParser methodsFor:'*petitcompiler'!

trimmingToken

    | ws |

    ws := #space asParser star.

    ^ ((ws, (PPTokenParser on: self), ws) ==> #second)

        propertyAt: #trimmingToken put: true;

        yourself

! !