diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaGenerator.st --- a/compiler/PEGFsaGenerator.st Fri Jul 24 15:06:54 2015 +0100 +++ b/compiler/PEGFsaGenerator.st Mon Aug 17 12:13:16 2015 +0100 @@ -9,7 +9,114 @@ category:'PetitCompiler-FSA' ! -!PEGFsaGenerator methodsFor:'as yet unclassified'! +!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 +! visitCharSetPredicateNode: node | stop start fsa | @@ -48,8 +155,9 @@ visitChoiceNode: node | priority childrenFsa fsa start | - childrenFsa := node children collect: [ :child | child accept: self ]. + self assert: (childrenFsa allSatisfy: [ :child | child isDeterministic ]). + fsa := PEGFsa new. start := PEGFsaState new. @@ -58,14 +166,72 @@ priority := 0. childrenFsa do: [ :childFsa | + childFsa decreasePriorityBy: priority. fsa adopt: childFsa. - fsa addTransitionFrom: start to: childFsa startState priority: priority. - priority := priority + childFsa minPriority. + fsa addTransitionFrom: start to: childFsa startState. + priority := priority + 1. + + fsa determinizeChoice. ]. ^ fsa ! +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 +! + visitLiteralNode: node | states fsa | @@ -92,10 +258,20 @@ ^ fsa ! +visitMessagePredicateNode: node + ^ self visitPredicateNode: node +! + visitNode: node self error: 'node not supported' ! +visitNotCharacterNode: node + self assert: (node child isKindOf: PPCCharacterNode). + + ^ self visitNotNode: node +! + visitNotNode: node | fsa finalState | fsa := node child accept: self. @@ -104,63 +280,49 @@ yourself. fsa finalStates do: [ :fs | - fs retval: PEGFsaFailure new. + fs failure: true. ]. - fsa addState: finalState. - fsa finalState: finalState. - - fsa addTransitionFrom: fsa startState to: finalState priority: -1. + fsa finalState: fsa startState. + ^ fsa ! visitOptionalNode: node - | fsa startState finalState | + | fsa | 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 finalState: fsa startState. ^ fsa ! visitPlusNode: node - | fsa finalState | + | fsa | - finalState := PEGFsaState new. +" finalState := PEGFsaState new." fsa := node child accept: self. - fsa addState: finalState. +" 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. +" fsa addTransitionFrom: state to: finalState priority: fsa minPriority." +" state hasPriority ifFalse: [ state priority: 0 ]. state final: false. - ]. +" ]. - fsa finalState: finalState. +" fsa finalState: finalState. " ^ fsa ! visitPredicateNode: node - | stop start fsa | + | stop start fsa classification | start := PEGFsaState new. stop := PEGFsaState new. + classification := (1 to: 255) collect: [:codePoint | node predicate value: (Character codePoint: codePoint) ]. + fsa := PEGFsa new addState: start; addState: stop; @@ -169,61 +331,55 @@ finalState: stop; yourself. - fsa addTransitionFrom: start to: stop onCharacterSet: (node predicate classification). - + fsa addTransitionFrom: start to: stop onCharacterSet: (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. + | fsa childrenFsa previousFsa | + childrenFsa := node children collect: [ :child | self visit: child ]. + self assert: (childrenFsa allSatisfy: [ :child | child isDeterministic ]). - 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. + previousFsa := childrenFsa first. + childrenFsa allButFirst do: [ :nextFsa | + fsa := self sequenceOf: previousFsa and: nextFsa. + previousFsa := fsa. ]. + ^ fsa ! visitStarNode: node - | fsa finalState | + | fsa | - finalState := PEGFsaState new. - fsa := node child accept: self. - fsa addState: 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 hasPriority ifFalse: [ state priority: 0 ]. state final: false. - ]. +" ]. - fsa addTransitionFrom: fsa startState to: finalState priority: -1. - fsa finalState: finalState. +" fsa addTransitionFrom: fsa startState to: finalState priority: -1." + fsa finalState: fsa startState. ^ fsa +! + +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 ! !