--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaInterpret.st Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,180 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaInterpret
+ instanceVariableNames:'fsa debug retvals stream maxPriority'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaInterpret methodsFor:'accessing'!
+
+debug
+ ^ debug
+!
+
+debug: anObject
+ debug := anObject
+!
+
+fsa
+ ^ fsa
+! !
+
+!PEGFsaInterpret methodsFor:'debugging'!
+
+reportFsa: anFsa
+ debug ifTrue: [
+ Transcript show: anFsa asString; cr.
+ ]
+!
+
+reportStart
+ debug ifTrue: [
+ Transcript show: '============================'; cr.
+ ]
+!
+
+reportStates: states
+ debug ifTrue: [
+ Transcript show: 'states: '; show: states asString; cr
+ ]
+! !
+
+!PEGFsaInterpret methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ debug := true
+! !
+
+!PEGFsaInterpret methodsFor:'running'!
+
+interpret
+ | states newStates character run |
+ maxPriority := SmallInteger minVal.
+ newStates := IdentitySet with: fsa startState.
+ retvals := IdentityDictionary new.
+
+ self recordNewState: fsa startState position: 0.
+
+ self reportStart.
+ self reportFsa: fsa.
+
+ run := stream atEnd not.
+
+ [run] whileTrue: [
+ states := newStates.
+ newStates := IdentitySet new.
+ character := stream peek.
+
+ self reportStates: states.
+
+ states do: [ :state |
+ self expand: state on: character into: newStates.
+ ].
+
+ newStates isEmpty ifFalse: [ stream next ].
+ run := stream atEnd not and: [ newStates isEmpty not ].
+ ].
+
+ ^ self return: newStates
+!
+
+interpret: anFsa on: aStream
+ fsa := anFsa.
+ stream := aStream.
+
+ ^ self interpret
+! !
+
+!PEGFsaInterpret methodsFor:'running support'!
+
+allowsTransition: t from: state transitionsTaken: transitionsTaken
+" (state hasPriority) ifTrue: [
+ ^ state priority <= t priority
+ ].
+"
+ "state hasPriority ifTrue: [ "
+" transitionsTaken isEmpty ifTrue: [ ^ true ].
+ ^ transitionsTaken anyOne priority <= t priority.
+" "]."
+ ^ true
+!
+
+expand: state on: character into: newStates "transitionsTaken: transitionsTaken"
+ | transitions transitionsTaken |
+
+ transitionsTaken := OrderedCollection new.
+ transitions := self sortedTransitionsFor: state.
+ transitions do: [ :t |
+ (self allowsTransition: t from: state transitionsTaken: transitionsTaken) ifTrue: [
+ t isEpsilon ifTrue: [
+ (t destination isFinal) ifTrue: [
+ newStates add: t destination.
+ self recordNewState: t destination position: stream position.
+ ].
+
+ "Descent into the next state"
+ self expand: t destination
+ on: character
+ into: newStates.
+
+ newStates isEmpty ifFalse: [
+ transitionsTaken add: t.
+ ].
+
+ ] ifFalse: [
+ (t accepts: character) ifTrue: [
+ transitionsTaken add: t.
+ newStates add: t destination.
+ self recordNewState: t destination.
+ ]
+ ]
+ ]
+ ]
+!
+
+recordNewState: state
+ ^ self recordNewState: state position: stream position + 1
+!
+
+recordNewState: state position: position
+ (state isFinal) ifFalse: [ ^ self ].
+ (maxPriority > state priority) ifTrue: [ ^ true ].
+
+ self assert: state hasPriority description: 'final state must have priority'.
+ (maxPriority < state priority) ifTrue: [
+ retvals := IdentityDictionary new.
+ maxPriority := state priority.
+ ].
+
+
+ state retvalAsCollection do: [ :r |
+ retvals at: r put: position
+ ].
+!
+
+return: states
+ | priority priorities |
+ priorities := (states select: #hasPriority thenCollect: #priority).
+ priorities isEmpty ifTrue: [
+ ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ]
+ ].
+
+ priority := priorities max.
+
+ (maxPriority < priority) ifTrue: [ ^ IdentityDictionary new ].
+ ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ]
+!
+
+sortedTransitionsFor: state
+ ^ (fsa transitionsFor: state) asOrderedCollection
+ "Dear future me, enjoy this:"
+" sort: [ :e1 :e2 | (e1 isEpsilon not and: [e2 isEpsilon]) not ])"
+ sort: [ :e1 :e2 | e1 priority > e2 priority ]
+
+! !
+