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

"{ NameSpace: Smalltalk }"

Object subclass:#PEGFsaInterpret

	instanceVariableNames:'fsa debug retvals stream maxPriority'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-FSA'

!

!PEGFsaInterpret methodsFor:'accessing'!

debug

    ^ debug

!

debug: anObject

    debug := anObject

!

fsa

    ^ fsa

! !

!PEGFsaInterpret methodsFor:'debugging'!

reportFsa: anFsa

    debug ifTrue: [ 

        Transcript show: anFsa asString; cr.

    ]

!

reportStart

    debug ifTrue: [ 

        Transcript show: '============================'; cr.

    ]

!

reportStates: states

    debug ifTrue: [ 

        Transcript show: 'states: '; show: states asString; cr

    ]

! !

!PEGFsaInterpret methodsFor:'initialization'!

initialize

    super initialize.

    debug := true

! !

!PEGFsaInterpret methodsFor:'running'!

interpret

    | states newStates character run  |

    maxPriority := SmallInteger minVal.

    newStates := IdentitySet with: fsa startState.

    retvals := IdentityDictionary new.

    self recordNewState: fsa startState position: 0.

    self reportStart.

    self reportFsa: fsa.

    run := stream atEnd not.

    [run] whileTrue: [  

        states := newStates.

        newStates := IdentitySet new.

        character := stream peek.

        self reportStates: states.

        states do: [ :state |

            self expand: state on: character into: newStates.

        ].

        newStates isEmpty ifFalse: [ stream next ].

        run := stream atEnd not and: [ newStates isEmpty not ].

    ].

    ^ self return: newStates

!

interpret: anFsa on: aStream

    fsa := anFsa.

    stream := aStream.

    ^ self interpret

! !

!PEGFsaInterpret methodsFor:'running support'!

allowsTransition: t from: state transitionsTaken: transitionsTaken

"	(state hasPriority) ifTrue: [ 

        ^ state priority <= t priority

    ].

"	

    "state hasPriority ifTrue: [ "

"		transitionsTaken isEmpty ifTrue: [ ^ true ].

        ^ transitionsTaken anyOne priority <= t priority.

"	"]."

    ^ true

!

expand: state on: character into: newStates "transitionsTaken: transitionsTaken"

    | transitions transitionsTaken |

    transitionsTaken := OrderedCollection new.

    transitions := self sortedTransitionsFor: state.

    transitions do: [ :t | 

        (self allowsTransition: t from: state transitionsTaken: transitionsTaken) ifTrue: [ 

            t isEpsilon ifTrue: [  

                (t destination isFinal) ifTrue: [ 

                    newStates add: t destination.

                    self recordNewState: t destination position: stream position.

                ].

                "Descent into the next state"

                self 	expand: t destination 

                        on: character 

                        into: newStates.

                newStates isEmpty ifFalse: [ 

                    transitionsTaken add: t.

                ].

            ] ifFalse: [  

                (t accepts: character) ifTrue: [ 

                    transitionsTaken add: t.

                    newStates add: t destination.

                    self recordNewState: t destination.

                ]

            ] 

        ]

    ]

!

recordNewState: state

    ^ self recordNewState: state position: stream position + 1

!

recordNewState: state position: position

    (state isFinal) ifFalse: [ ^ self ].

    (maxPriority > state priority) ifTrue: [ ^ true ].

    self assert: state hasPriority description: 'final state must have priority'.

    (maxPriority < state priority) ifTrue: [ 

        retvals := IdentityDictionary new.

        maxPriority := state priority.

    ].

    state retvalAsCollection do: [ :r |

        retvals at: r put: position

    ].

!

return: states

    | priority priorities |

    priorities := (states select: #hasPriority thenCollect: #priority).

    priorities isEmpty ifTrue: [  

        ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ] 

    ].

    priority := priorities max.

    (maxPriority < priority) ifTrue: [ ^ IdentityDictionary new ].

    ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ]

!

sortedTransitionsFor: state

    ^ (fsa transitionsFor: state) asOrderedCollection

        "Dear future me, enjoy this:"

"		sort: [ :e1 :e2 | (e1 isEpsilon not and: [e2 isEpsilon]) not ])"

        sort: [ :e1 :e2 | e1 priority > e2 priority ]

! !