!PEGFsaGenerator methodsFor:'hooks'!

afterAccept: node retval: retval

    retval checkSanity.

    ^ super afterAccept: node retval: retval

!

cache: node value: retval

    (self assert: (retval isKindOf: PEGFsa)).

    (cache includesKey: node) ifTrue: [

        self assert: (retval isIsomorphicTo: (cache at: node)).

    ].

    "I put copy of the FSA because FSA can be modified (e.g. concatenated to other FSA)"

    cache at: node put: retval copy.

!

openDetected: node

    "

        This should be called when there is a recursive definition of a token.

        The forward node caches the fsa stub with startState in order to reference it

    "

    ^ (self cachedValue: node)

! !

!PEGFsaGenerator methodsFor:'support'!

connect: fsa with: anotherFsa

    | finals |

    finals := fsa finalStates reject: [:s | s isFsaFailure ].

    self assert: (finals allSatisfy: [ :s | s priority = 0 ]).

    self assert: (finals allSatisfy: [:f | fsa states includes: f]).

    finals do: [ :final |

        | toAdopt |

        toAdopt := anotherFsa.

        toAdopt decreasePriority.

        final final: false.	

        fsa adopt: toAdopt.

        fsa addTransitionFrom: final to: toAdopt startState.

    ].

!

connectOverlapping: fsa with: anotherFsa

    | finals |

    finals := fsa finalStates reject: [:s | s isFsaFailure ].

    self assert: (finals allSatisfy: [ :s | s priority = 0 ]).

    self assert: (finals allSatisfy: [:f | fsa states includes: f]).

    finals do: [ :final |

        | toAdopt |

        toAdopt := anotherFsa copy.

        toAdopt decreasePriority.

        final final: false.	

        fsa adopt: toAdopt.

        fsa addTransitionFrom: final to: toAdopt startState.

    ].

!

sequenceOf: fsa and: anotherFsa

    | newFsa start   |

    newFsa := PEGFsa new.

    start := PEGFsaState new name: 'start'; yourself.

    newFsa addState: start.

    newFsa startState: start.

    newFsa adopt: fsa.

    newFsa addTransitionFrom: start to: fsa startState.

    (newFsa finalStates size == 1) ifTrue: [  

        self connect: newFsa with: anotherFsa.

    ] ifFalse: [ 

    (newFsa finalStates allSatisfy: [ :s | s transitions isEmpty ]) ifTrue: [  

        self connect: newFsa with: anotherFsa.

    ] ifFalse: [ 

        self connectOverlapping: newFsa with: anotherFsa.

    ]].

    newFsa determinize.

    ^ newFsa

! !

!PEGFsaGenerator methodsFor:'visiting'!

visitAnyNode: node

    | stop start fsa classification |

    start := PEGFsaState new.

    stop := PEGFsaState new.

    classification := Array new: 255 withAll: true.

    fsa := PEGFsa new

        addState: start;

        addState: stop;

        startState: start;

        finalState: stop;

        yourself.

    fsa addTransitionFrom: start to: stop onCharacterSet: (classification).

    ^ fsa

!

    self assert: (childrenFsa allSatisfy: [ :child | child isDeterministic  ]).

        childFsa decreasePriorityBy: priority.

        fsa addTransitionFrom: start to: childFsa startState.

        priority := priority + 1.

        fsa determinizeChoice.

visitEndOfFileNode: node

    | stop start fsa transition |

    start := PEGFsaState new.

    stop := PEGFsaState new.

    stop name: 'EOF'.

    fsa := PEGFsa new

        addState: start;

        addState: stop;

        startState: start;

        finalState: stop;

        yourself.

    transition := PEGFsaEOFTransition new

        predicate: [ :cp | cp == 0 ];

        destination: stop;

        yourself.

    start addTransition: transition.

    ^ fsa

!

visitForwardNode: node

    | fsa childFsa startState startStubState |

    fsa	 := PEGFsa new.

    startStubState := PEGFsaUncopiableState new.

    startState := PEGFsaState new.

    fsa addState: startStubState.

    fsa startState: startStubState.

    "  cache the incomplete fsa in order to allow for

        recursive back references... 

    "	

    self cache: node value: fsa.

    childFsa := self visit: node child.

    cache removeKey: node.

    fsa adopt: childFsa.

    fsa replace: startStubState with: startState.

    fsa addTransitionFrom: startState to: childFsa startState.

    fsa startState: startState.

    fsa name: self name.

    ^ fsa

!

visitMessagePredicateNode: node

    ^ self visitPredicateNode: node

!

visitNotCharacterNode: node

    self assert: (node child isKindOf: PPCCharacterNode).

    ^ self visitNotNode: node

!

        fs failure: true.

    fsa finalState: fsa startState.

    | fsa   |

    fsa finalState: fsa startState.

    | fsa |

"	finalState := PEGFsaState new."

"	fsa addState: finalState."

"		fsa addTransitionFrom: state to: finalState priority: fsa minPriority."

"		state hasPriority ifFalse: [ state priority: 0 ].

"	].

"	fsa finalState: finalState.	"

    | stop start fsa classification |

    classification := (1 to: 255) collect: [:codePoint | node predicate value: (Character codePoint: codePoint) ].

    fsa addTransitionFrom: start to: stop onCharacterSet: (classification).

    | fsa childrenFsa previousFsa  |

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

    self assert: (childrenFsa allSatisfy: [ :child | child isDeterministic  ]).

    previousFsa := childrenFsa first.

    childrenFsa allButFirst do: [ :nextFsa | 

        fsa := self sequenceOf: previousFsa and: nextFsa.

        previousFsa := fsa.

    | fsa  |

"	finalState := PEGFsaState new.

"	fsa := node child accept: self.

"	fsa addState: finalState.

"	

"		state hasPriority ifFalse: [ state priority: 0 ].

"	].

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

    fsa finalState: fsa startState.

!

visitTokenNode: node

    ^ self visit: node child

!

visitTrimmingTokenCharacterNode: node

    "I do not care about trimming (so far), it should be handled by TokenCodeGenerator"

    ^ self visit: node child

!

visitTrimmingTokenNode: node

    "I do not care about trimming (so far), it should be handled by TokenCodeGenerator"

    ^ self visit: node child