"{ 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

! !