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

"{ NameSpace: Smalltalk }"

Object subclass:#PEGFsaInterpret
	instanceVariableNames:'fsa debug retvals stream maxPriority'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-FSA'
!

!PEGFsaInterpret class methodsFor:'instance creation'!

new
    "return an initialized instance"

    ^ self basicNew initialize.
! !

!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 ]
            
! !