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

"{ NameSpace: Smalltalk }"

PPCNodeVisitor subclass:#PEGFsaGenerator
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-FSA'
!

!PEGFsaGenerator methodsFor:'as yet unclassified'!

visitCharSetPredicateNode: node
    | stop start fsa |
    start := PEGFsaState new.
    stop := PEGFsaState new.
    
    fsa := PEGFsa new
        addState: start;
        addState: stop;
        
        startState: start;
        finalState: stop;
        yourself.
    
    fsa addTransitionFrom: start to: stop onCharacterSet: (node predicate classification).
        
    ^ fsa
!

visitCharacterNode: node
    | stop start |
    start := PEGFsaState new.
    stop := PEGFsaState new.
    stop name: node character storeString.
    
    ^ PEGFsa new
        addState: start;
        addState: stop;
        
        startState: start;
        finalState: stop;

        addTransitionFrom: start to: stop on: node character;
        yourself
!

visitChoiceNode: node
    | priority childrenFsa fsa start |
    
    childrenFsa := node children collect: [ :child | child accept: self ].
    fsa := PEGFsa new.
    start := PEGFsaState new.
    
    fsa addState: start.
    fsa startState: start.

    priority := 0.
    childrenFsa do: [ :childFsa |
        fsa adopt: childFsa.
        fsa addTransitionFrom: start to: childFsa startState priority: priority.
        priority := priority + childFsa minPriority.
    ].

    ^ fsa
!

visitLiteralNode: node
    | states fsa |

    states := OrderedCollection new.
    (node literal size + 1) timesRepeat: [
        states add: PEGFsaState new
    ].

    fsa := PEGFsa new.
    states do: [ :state | fsa addState: state ].	
    fsa	 startState: states first;
         finalState: states last;
         yourself.
        
    (1 to: (states size - 1)) do: [ :index |
        fsa addTransitionFrom: (states at: index)
         	 to: (states at: index + 1)
             on: (node literal at: index).
        "set the name"
        (states at: (index + 1)) name: (node literal at: index). 
    ].

    fsa name: node literal.
    ^ fsa
!

visitNode: node
    self error: 'node not supported'
!

visitNotNode: node
    | fsa finalState |
    fsa := node child accept: self.
    finalState := PEGFsaState new
        name: '!!', fsa name asString;
        yourself.
    
    fsa finalStates do: [ :fs |
        fs retval: PEGFsaFailure new.
    ].
    
    fsa addState: finalState.
    fsa finalState: finalState.

    fsa addTransitionFrom: fsa startState to: finalState priority: -1.
    ^ fsa
!

visitOptionalNode: node
    | fsa startState finalState |

    fsa := node child accept: self.
    startState := PEGFsaState new
        yourself.

    finalState := PEGFsaState new
        final: true;
        yourself.

    fsa addState: startState.
    fsa addState: finalState.
    
    fsa addTransitionFrom: startState to: fsa startState priority: 0.
    fsa addTransitionFrom: startState to: finalState priority: fsa minPriority.

    fsa startState: startState.

    ^ fsa
!

visitPlusNode: node
    | fsa finalState |

    finalState := PEGFsaState new.
    fsa := node child accept: self.
    fsa addState: finalState.
    
    fsa finalStates do: [ :state |
        fsa addTransitionFrom: state to: (fsa startState).
        fsa addTransitionFrom: state to: finalState priority: -1.
        self assert: (state hasPriority not).
        state priority: 0.
        state final: false.
    ].

    fsa finalState: finalState.	
    
    ^ fsa
!

visitPredicateNode: node
    | stop start fsa  |
    start := PEGFsaState new.
    stop := PEGFsaState new.
    
    fsa := PEGFsa new
        addState: start;
        addState: stop;
        
        startState: start;
        finalState: stop;
        yourself.
    
    fsa addTransitionFrom: start to: stop onCharacterSet: (node predicate classification).
        
    ^ fsa
!

visitSequenceNode: node
    | childrenFsa fsa start previousFinalStates  |

    childrenFsa := node children collect: [ :child | child accept: self ].

    fsa := PEGFsa new.
    start := PEGFsaState new name: 'start'; yourself.
    fsa addState: start.
    fsa startState: start.

    fsa adopt: childrenFsa first.	
    fsa addTransitionFrom: start to: childrenFsa first startState.

    previousFinalStates := childrenFsa first finalStates.
    childrenFsa allButFirst do: [ :childFsa | 
        | newFinalStates |
        newFinalStates := IdentitySet new.
        previousFinalStates do: [ :state |
            | copy |
            copy := childFsa copy.
            fsa adopt: copy.
            
            state isFailure ifFalse: [ 
                state final: false.
                fsa addTransitionFrom: state to: copy startState.
            ].
            newFinalStates addAll: copy finalStates.
        ].
        previousFinalStates := newFinalStates.
    ].
    ^ fsa
!

visitStarNode: node
    | fsa finalState |

    finalState := PEGFsaState new.
    fsa := node child accept: self.
    fsa addState: finalState.
    
    fsa finalStates do: [ :state |
        fsa addTransitionFrom: state to: (fsa startState).
        self assert: (state hasPriority not).
        state priority: 0.
        state final: false.
    ].

    fsa addTransitionFrom: fsa startState to: finalState priority: -1.
    fsa finalState: finalState.

    ^ fsa
! !