--- a/compiler/PEGFsaGenerator.st Fri Jul 31 14:07:31 2015 +0100
+++ b/compiler/PEGFsaGenerator.st Mon Aug 17 12:56:02 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
! !