diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PEGFsaState.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PEGFsaState.st Fri Jul 24 15:37:23 2015 +0100 @@ -0,0 +1,455 @@ +"{ Package: 'stx:goodies/petitparser/compiler' }" + +"{ NameSpace: Smalltalk }" + +Object subclass:#PEGFsaState + instanceVariableNames:'name retval priority transitions final multivalue' + classVariableNames:'' + poolDictionaries:'' + category:'PetitCompiler-FSA' +! + +!PEGFsaState methodsFor:'accessing'! + +destination + self assert: transitions size = 1. + ^ transitions anyOne destination +! + +destinations + ^ (transitions collect: #destination) asIdentitySet +! + +final + ^ final +! + +final: anObject + final := anObject +! + +multivalue + ^ multivalue +! + +multivalue: anObject + multivalue := anObject +! + +name + ^ name +! + +name: anObject + name := anObject asString +! + +prefix + ^ 'state' +! + +priority + ^ priority +! + +priority: anObject + priority := anObject +! + +priorityIfNone: value + ^ self hasPriority ifTrue: [ self priority ] ifFalse: [ value ] +! + +retval + ^ retval +! + +retval: anObject + retval := anObject +! + +retvalAsCollection + ^ self isMultivalue ifTrue: [ + self retval + ] ifFalse: [ + Array with: self retval + ] +! + +suffix + ^ '' +! + +transitions + ^ transitions +! ! + +!PEGFsaState methodsFor:'analysis'! + +reachableStates + | openSet | + openSet := IdentitySet new. + self reachableStatesOpenSet: openSet. + ^ openSet +! + +reachableStatesOpenSet: openSet + (openSet includes: self) ifTrue: [ + ^ self + ]. + + openSet add: self. + + (self transitions) do: [ :t | + t destination reachableStatesOpenSet: openSet + ]. + +! + +transitionPairs + | size pairs collection | + size := transitions size. + pairs := OrderedCollection new: (size - 1) * size / 2. + + collection := transitions asOrderedCollection. + + 1 to: (size - 1) do: [ :index1 | + (index1 + 1 to: size) do: [ :index2 | + pairs add: (PEGFsaPair new + first: (collection at: index1); + second: (collection at: index2); + yourself). + ] + ]. + ^ pairs +! ! + +!PEGFsaState methodsFor:'comparing'! + += anotherState + (self == anotherState) ifTrue: [ ^ true ]. + (self class == anotherState class) ifFalse: [ ^ true ]. + + (name == anotherState name) ifFalse: [ ^ false ]. + (priority == anotherState priority) ifFalse: [ ^ false ]. + (multivalue == anotherState multivalue) ifFalse: [ ^ false ]. + (retval = anotherState retval) ifFalse: [ ^ false ]. + (final = anotherState final) ifFalse: [ ^ false ]. + + (transitions size = anotherState transitions size) ifFalse: [ ^ false ]. + transitions do: [:t | + (anotherState transitions contains: [:at | at = t]) ifFalse: [ ^ false ]. + ]. + + ^ true +! + +canBeIsomorphicTo: anotherState + (name == anotherState name) ifFalse: [ ^ false ]. + (priority == anotherState priority) ifFalse: [ ^ false ]. + (multivalue == anotherState multivalue) ifFalse: [ ^ false ]. + (final == anotherState final) ifFalse: [ ^ false ]. + (transitions size == anotherState transitions size) ifFalse: [ ^ false ]. + (retval = anotherState retval) ifFalse: [ ^ false ]. + + ^ true +! + +equals: anotherState + (self == anotherState) ifTrue: [ ^ true ]. + (anotherState class == PEGFsaState) ifFalse: [ ^ false ]. + + (retval = anotherState retval) ifFalse: [ ^ false ]. + (multivalue = anotherState multivalue) ifFalse: [ ^ false ]. + (self isFinal = anotherState isFinal) ifFalse: [ ^ false ]. + + (self hasPriority and: [anotherState hasPriority]) ifTrue: [ + (priority == anotherState priority) ifFalse: [ ^ false ]. + ]. + + (transitions size == anotherState transitions size) ifFalse: [ ^ false ]. + anotherState transitions do: [ :t | + (transitions contains: [ :e | e equals: t]) ifFalse: [ ^ false ] + ]. + + ^ true +! + +hash + ^ retval hash bitXor: ( + priority hash bitXor: ( + multivalue hash bitXor: + "JK: Size is not the best option here, but it one gets infinite loops otherwise" + transitions size hash)). +! + +isIsomorphicTo: anotherState resolvedSet: set + (self == anotherState) ifTrue: [ ^ true ]. + + (name == anotherState name) ifFalse: [ ^ false ]. + (priority == anotherState priority) ifFalse: [ ^ false ]. + (multivalue == anotherState multivalue) ifFalse: [ ^ false ]. + (retval = anotherState retval) ifFalse: [ ^ false ]. + (final = anotherState final) ifFalse: [ ^ false ]. + + (transitions size = anotherState transitions size) ifFalse: [ ^ false ]. + transitions do: [:t | + (anotherState transitions contains: [:at | t isIsomorphicto: at]) ifFalse: [ ^ false ]. + ]. + + ^ true +! ! + +!PEGFsaState methodsFor:'copying'! + +postCopy + super postCopy. + transitions := (transitions collect: [ :t | t copy ]). + retval := retval copy. +! ! + +!PEGFsaState methodsFor:'gt'! + +gtName + | gtName | + gtName := name. + + self hasPriority ifTrue: [ + gtName := gtName asString, ',', self priority asString. + ]. + + ^ gtName +! ! + +!PEGFsaState methodsFor:'initialization'! + +initialize + super initialize. + + transitions := OrderedCollection new. + multivalue := false. +! ! + +!PEGFsaState methodsFor:'modifications'! + +addTransition: t + self assert: (transitions identityIncludes: t) not. + transitions add: t +! + +decreasePriority + (self isFinal and: [ self hasPriority not ]) ifTrue: [ + priority := 0. + ]. + priority isNil ifFalse: [ + priority := priority - 1 + ] +! + +removeTransition: t + self assert: (transitions includes: t). + transitions remove: t +! ! + +!PEGFsaState methodsFor:'printing'! + +printNameOn: aStream + self name isNil + ifTrue: [ aStream print: self hash ] + ifFalse: [ aStream nextPutAll: self name ] +! + +printOn: aStream + super printOn: aStream. + aStream nextPut: $(. + self printNameOn: aStream. + aStream nextPut: Character space. + aStream nextPutAll: self identityHash asString. + self isFinal ifTrue: [ + aStream nextPutAll: ' FINAL'. + ]. + aStream nextPut: (Character codePoint: 32). + aStream nextPutAll: priority asString. + aStream nextPut: $) +! ! + +!PEGFsaState methodsFor:'testing'! + +canHavePPCId + ^ true +! + +hasEqualPriorityTo: state + "nil - nil" + (self hasPriority not and: [state hasPriority not]) ifTrue: [ ^ true ]. + + "nil - priority" + (self hasPriority) ifFalse: [ ^ false ]. + + "priority - nil" + state hasPriority ifFalse: [ ^ false ]. + + "priority - priority" + ^ self priority = state priority +! + +hasHigherPriorityThan: state + "nil - nil" + (self hasPriority not and: [state hasPriority not]) ifTrue: [ ^ true ]. + + "nil - priority" + (self hasPriority) ifFalse: [ ^ false ]. + + "priority - nil" + state hasPriority ifFalse: [ ^ true ]. + + "priority - priority" + ^ self priority > state priority +! + +hasPriority + ^ priority isNil not +! + +isFailure + ^ self isFinal and: [ retval class == PEGFsaFailure ] +! + +isFinal + final isNil ifTrue: [ ^ false ]. + + final ifTrue: [ +" self assert: self hasPriority. " + ^ true + ]. + + ^ false +! + +isMultivalue + ^ multivalue +! ! + +!PEGFsaState methodsFor:'transformation'! + +determinize + ^ self determinize: Dictionary new. +! + +determinize: dictionary + self transitionPairs do: [ :pair | + self assert: (pair first destination = pair second destination) not. + (pair first overlapsWith: pair second) ifTrue: [ + self determinizeOverlap: pair first second: pair second joinDictionary: dictionary + ] + ]. +! + +determinizeOverlap: t1 second: t2 joinDictionary: dictionary + | pair t1Prime t2Prime tIntersection | + pair := PEGFsaPair with: t1 with: t2. + + (dictionary includes: pair) ifTrue: [ self error: 'should not happen'.]. + dictionary at: pair put: nil. + + tIntersection := t1 join: t2 joinDictionary: dictionary. + t1Prime := PEGFsaTransition new + destination: t1 destination; + characterSet: (t1 complement: t2); + yourself. + t2Prime := PEGFsaTransition new + destination: t2 destination; + characterSet: (t2 complement: t1); + yourself. + + + self removeTransition: t1. + self removeTransition: t2. + + tIntersection isEpsilon ifFalse: [ self addTransition: tIntersection ]. + t1Prime isEpsilon ifFalse: [ self addTransition: t1Prime ]. + t2Prime isEpsilon ifFalse: [ self addTransition: t2Prime ]. + + dictionary at: pair put: (Array + with: tIntersection + with: t1Prime + with: t2Prime + ) +! + +join: state + ^ self join: state joinDictionary: Dictionary new +! + +join: state joinDictionary: dictionary + | pair newState | + pair := PEGFsaPair with: self with: state. + (dictionary includesKey: pair) ifTrue: [ ^ dictionary at: pair ]. + + newState := PEGFsaState new. + + dictionary at: pair put: newState. + + self joinFinal: state newState: newState. + self joinPriority: state newState: newState. + self joinRetval: state newState: newState. + self joinName: state newState: newState. + + newState transitions addAll: (self transitions collect: #copy). + newState transitions addAll: (state transitions collect: #copy). + newState determinize: dictionary. + + ^ dictionary at: pair put: newState +! + +joinFinal: state newState: newState + (self hasEqualPriorityTo: state) ifTrue: [ + ^ newState final: (self isFinal or: [ state isFinal ]). + ]. + + (self hasHigherPriorityThan: state) ifTrue: [ + ^ newState final: self isFinal. + ]. + + newState final: state isFinal. + +! + +joinName: state newState: newState + newState name: self name asString, '-', state name asString. +! + +joinPriority: state newState: newState + (self hasHigherPriorityThan: state) ifTrue: [ + newState priority: self priority. + ^ self + ]. + + newState priority: state priority. +! + +joinRetval: state newState: newState + self isFinal ifFalse: [ ^ newState retval: state retval ]. + state isFinal ifFalse: [ ^ newState retval: self retval ]. + + (self priority = state priority) ifTrue: [ + newState multivalue: true. + ^ newState retval: { self retval . state retval }. + ]. + + "Both are final" + self priority isNil ifTrue: [ + ^ newState retval: state retval. + ]. + + state priority isNil ifTrue: [ + ^ newState retval: self retval. + ]. + + (self priority > state priority) ifTrue: [ + ^ newState retval: self retval. + ]. + + ^ newState retval: state retval. +! ! +