--- a/compiler/PEGFsa.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PEGFsa.st Mon Aug 17 12:13:16 2015 +0100
@@ -9,6 +9,14 @@
category:'PetitCompiler-FSA'
!
+!PEGFsa class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
!PEGFsa methodsFor:'accessing'!
allTransitions
@@ -27,8 +35,15 @@
!
minPriority
- "this is the worst estimate"
- ^ (self states size) negated
+ | priority |
+" defaultPriority := self states size negated.
+ self finalStates isEmpty ifTrue: [ ^ defaultPriority ].
+
+ ^ (self finalStates collect: [ :e | e priorityIfNone: defaultPriority ]) min
+"
+ priority := -1.
+ self allTransitions do: [ :t | t isEpsilon ifTrue: [ priority := priority + t priority ] ].
+ ^ priority
!
name
@@ -40,11 +55,12 @@
name := anObject
!
-prefix
- ^ 'fsa_'
+retvals
+ ^ (self finalStates flatCollect: [ :e | e retvals collect: #value ]) asIdentitySet
!
startState
+ self assert: (states includes: startState).
^ startState
!
@@ -56,8 +72,8 @@
^ states
!
-suffix
- ^ ''
+states: whatever
+ states := whatever
!
transitionFrom: from to: to
@@ -164,7 +180,27 @@
!
finalStates
- ^ self reachableStates select: [ :s | s isFinal ]
+ ^ self states select: [ :s | s isFinal ]
+!
+
+hasDistinctRetvals
+ | finalStates retvals |
+ finalStates := self finalStates.
+
+ (finalStates anySatisfy: [ :s | s isMultivalue ]) ifTrue: [ ^ false ].
+ retvals := finalStates collect: [:s | s retval].
+
+
+ (finalStates size == 1) ifTrue: [ ^ true ].
+
+
+ (retvals asSet size == 1) ifTrue: [ ^ true ].
+ "final states leads only to final states with the same retval"
+ (finalStates allSatisfy: [ :s |
+ (self statesReachableFrom: s) allSatisfy: [ :rs | rs retval value isNil or: [ rs retval value == s retval value ] ]
+ ]) ifTrue: [ ^ true ].
+
+ ^ false
!
is: state furtherThan: anotherState
@@ -176,6 +212,14 @@
^ self backTransitions includes: t
!
+isWithoutPriorities
+ ^ self states allSatisfy: [ :s |
+ s hasPriority not or: [
+ s stateInfos allSatisfy: [ :i | i priority == 0 ]
+ ]
+ ].
+!
+
joinPoints
^ self joinTransitions collect: [ :t | t destination ]
!
@@ -214,7 +258,7 @@
statePairs
| pairs ordered |
pairs := OrderedCollection new.
- ordered := self topologicalOrder.
+ ordered := self states asOrderedCollection.
1 to: (ordered size - 1) do: [ :index1 |
(index1 + 1) to: ordered size do: [ :index2 |
pairs add: (PEGFsaPair with: (ordered at: index1) with: (ordered at: index2))
@@ -258,7 +302,7 @@
= anotherFsa
"
- Please note what the compare does. IMO nothing useful for no.
+ Please note what the compare does. IMO nothing useful for now.
For comparing if two FSA's are equivalent, use isIsomorphicTo:
"
@@ -328,7 +372,7 @@
!PEGFsa methodsFor:'gt'!
gtGraphViewIn: composite
- <gtInspectorPresentationOrder: 41>
+ <gtInspectorPresentationOrder: 0>
composite roassal2
title: 'Graph';
initializeView: [ RTMondrian new ];
@@ -378,6 +422,24 @@
^ b
! !
+!PEGFsa methodsFor:'ids'!
+
+defaultName
+ ^ #fsa
+!
+
+hasName
+ ^ name isNil not
+!
+
+prefix
+ ^ nil
+!
+
+suffix
+ ^ nil
+! !
+
!PEGFsa methodsFor:'initialization'!
initialize
@@ -392,7 +454,16 @@
!
addTransitionFrom: fromState to: toState
- ^ self addTransitionFrom: fromState to: toState priority: 0
+ | transition |
+ self assert: (states includes: fromState).
+ self assert: (states includes: toState).
+
+ transition := PEGFsaEpsilonTransition new
+ destination: toState;
+ priority: 0;
+ yourself.
+
+ fromState addTransition: transition.
!
addTransitionFrom: fromState to: toState on: character
@@ -401,7 +472,7 @@
addTransitionFrom: fromState to: toState on: character priority: priority
| transition |
- transition := PEGFsaTransition new
+ transition := PEGFsaCharacterTransition new
addCharacter: character;
destination: toState;
priority: priority;
@@ -416,7 +487,7 @@
addTransitionFrom: fromState to: toState onCharacterSet: characterSet priority: priority
| transition |
- transition := PEGFsaTransition new
+ transition := PEGFsaCharacterTransition new
characterSet: characterSet;
destination: toState;
priority: priority;
@@ -425,12 +496,29 @@
fromState addTransition: transition
!
+addTransitionFrom: fromState to: toState onPredicate: block
+ self addTransitionFrom: fromState to: toState onPredicate: block priority: 0
+!
+
+addTransitionFrom: fromState to: toState onPredicate: block priority: priority
+ | transition |
+ transition := PEGFsaPredicateTransition new
+ predicate: block;
+ destination: toState;
+ priority: priority;
+ yourself.
+
+ fromState addTransition: transition
+!
+
addTransitionFrom: fromState to: toState priority: priority
| transition |
+ "should not use minus priority epsilons any more"
+ self assert: (priority == 0).
self assert: (states includes: fromState).
self assert: (states includes: toState).
- transition := PEGFsaTransition new
+ transition := PEGFsaEpsilonTransition new
destination: toState;
priority: priority;
yourself.
@@ -442,9 +530,24 @@
states addAll: fsa reachableStates.
!
+decreasePriority
+ ^ self decreasePriorityBy: 1
+!
+
+decreasePriorityBy: value
+ self states select: [ :s | s hasPriority ] thenDo: [ :s |
+ s decreasePriorityBy: value.
+ ].
+
+ self allTransitions do: [ :t |
+ t decreasePriorityBy: value
+ ]
+!
+
finalState: state
self assert: state isFinal not.
state final: true.
+ state priority: 0.
!
fixFinalStatePriorities
@@ -453,6 +556,20 @@
]
!
+minimize
+ ^ PEGFsaMinimizator new minimize: self
+!
+
+removePriorities
+ self states select: [ :s| s hasPriority ] thenDo: [ :s |
+ s priority: 0
+ ].
+
+ self allTransitions do: [ :t |
+ t priority: 0
+ ]
+!
+
removeState: state
self assert: (states includes: state).
states remove: state.
@@ -460,8 +577,8 @@
replace: state with: anotherState
| transitions |
- self assert: (state class == PEGFsaState).
- self assert: (anotherState class == PEGFsaState).
+ self assert: (state isKindOf: PEGFsaState).
+ self assert: (anotherState isKindOf: PEGFsaState).
transitions := self allTransitions.
@@ -470,7 +587,17 @@
t destination: anotherState.
]
].
- states := startState reachableStates.
+
+ state == startState ifTrue: [ startState := anotherState ].
+ states remove: state.
+ states add: anotherState.
+!
+
+retval: returnValue
+ self finalStates do: [ :s |
+ self assert: s retval isNil.
+ s retval: returnValue
+ ]
!
startState: state
@@ -479,6 +606,142 @@
startState := state
! !
+!PEGFsa methodsFor:'modifications - determinization'!
+
+determinize
+ ^ PEGFsaSequenceDeterminizator new determinize: self.
+!
+
+determinize: joinDictionary
+ self error: 'deprecated'.
+
+ self removeEpsilons.
+ self removeUnreachableStates.
+ self removeLowPriorityTransitions.
+ self mergeTransitions.
+
+
+ states := self topologicalOrder asOrderedCollection.
+
+ states do: [ :state |
+ state determinize: joinDictionary.
+ ].
+
+ states := startState reachableStates.
+
+ self removeUnreachableStates.
+ self removeLowPriorityTransitions.
+ self mergeTransitions.
+
+!
+
+determinizeChoice
+ ^ PEGFsaChoiceDeterminizator new determinize: self.
+!
+
+determinizeStandard
+ ^ PEGFsaDeterminizator new determinize: self.
+! !
+
+!PEGFsa methodsFor:'modifications - epsilons'!
+
+removeEpsilonTransition: transition source: state
+ ^ self removeEpsilonTransition: transition source: state openSet: IdentitySet new
+!
+
+removeEpsilonTransition: transition source: source openSet: openSet
+ | destination |
+ (openSet includes: transition) ifTrue: [ self error: 'loop in epsilons?!!' ].
+ openSet add: transition.
+
+ destination := transition destination.
+
+ "First Remove Recursively"
+ ((self transitionsFor: destination ) select: [ :t | t isEpsilon ]) do: [ :t |
+ self removeEpsilonTransition: t source: destination openSet: openSet
+ ].
+
+ self assert: transition isEpsilon.
+ self assert: transition priority = 0.
+
+ (destination transitions) do: [ :t |
+ source addTransition: (t copy)
+ ].
+
+ source mergeInfo: destination into: source.
+
+ destination isFinal ifTrue: [
+ source final: true.
+ source retval: destination retval.
+ ].
+
+ source removeTransition: transition.
+!
+
+removeEpsilons
+ "First, remove the negative values from epsilons"
+ self removeNegativeEpsilons.
+
+ states do: [ :state |
+ self removeEpsilonsFor: state
+ ]
+!
+
+removeEpsilonsFor: state
+ (self transitionsFor: state) copy do: [ :t |
+ (t isEpsilon and: [ t destination isStub not ]) ifTrue: [
+ self removeEpsilonTransition: t source: state
+ ]
+ ]
+!
+
+removeNegativeEpsilonTransition: transition source: state
+ ^ self removeNegativeEpsilonTransition: transition source: state openSet: IdentitySet new
+!
+
+removeNegativeEpsilonTransition: transition source: source openSet: openSet
+ | destination |
+ (openSet includes: transition) ifTrue: [ self error: 'loop in epsilons?!!' ].
+ openSet add: transition.
+
+ destination := transition destination.
+
+ "First Remove Recursively"
+ ((self transitionsFor: destination ) select: [ :t | t isEpsilon ]) do: [ :t |
+ self removeNegativeEpsilonTransition: t source: destination openSet: openSet
+ ].
+
+ "JK: Problem alert: if two different epsilons point to the same state,
+ it will decreas the state priority two times!! I don't know how to handle
+ this situation properly and I make sure during FSA generation that there
+ are no two paths to one state (except for loops).
+ "
+ (self statesReachableFrom: destination) do: [ :s |
+ s decreasePriorityBy: transition priority abs.
+ s transitions do: [ :t | t decreasePriorityBy: transition priority abs ]
+ ].
+
+ transition priority: 0.
+!
+
+removeNegativeEpsilons
+ "
+ This will remove only negative values from epsilons, the epsilons itself will not
+ be removed!!
+ "
+ states do: [ :state |
+ self removeNegativeEpsilonsFor: state
+ ]
+!
+
+removeNegativeEpsilonsFor: state
+ (self transitionsFor: state) copy do: [ :t |
+ t isEpsilon ifTrue: [
+ self removeNegativeEpsilonTransition: t source: state
+ ]
+ ]
+! !
+
!PEGFsa methodsFor:'printing'!
asString
@@ -525,6 +788,7 @@
checkSanity
self checkConsistency.
self checkTransitionsIdentity.
+ self checkTransitionsPriority.
self checkFinalStatesPriorities.
!
@@ -538,6 +802,14 @@
self assert: bag size == set size.
!
+checkTransitionsPriority
+ self finalStates do: [ :fs |
+ fs isMultivalue ifFalse: [
+ fs transitions allSatisfy: [ :t | fs priority >= t priority ]
+ ]
+ ]
+!
+
isDeterministic
self reachableStates do: [ :state |
state transitionPairs do: [ :pair |
@@ -569,115 +841,13 @@
!PEGFsa methodsFor:'transformations'!
compact
- self fixFinalStatePriorities.
- self determinize.
- self minimize.
-
- self checkSanity.
-!
-
-determinize
- | joinDictionary |
- self removeEpsilons.
-
- self removeUnreachableStates.
- self removeLowPriorityTransitions.
- self mergeTransitions.
-
- joinDictionary := Dictionary new.
- self topologicalOrder do: [:state | state determinize: joinDictionary ].
-
- states := startState reachableStates.
-
- self removeUnreachableStates.
- self removeLowPriorityTransitions.
- self mergeTransitions.
-
+ self error: 'deprecated?'
!
mergeTransitions
- | toRemove |
+ | |
self reachableStates do: [ :state |
- toRemove := OrderedCollection new.
- state transitionPairs do:[ :pair |
- (pair first destination = pair second destination) ifTrue: [
- pair first mergeWith: pair second.
- toRemove add: pair second.
- ]
- ].
- toRemove do: [ :t |
- state removeTransition: t
- ]
- ]
-!
-
-minimize
- | pair |
- pair := self statePairs detect: [ :p | p first equals: p second ] ifNone: [ nil ].
- [ pair isNil not ] whileTrue: [
- "Join priorities, because equivalency of priorities does not imply from the equeality of states"
- pair first joinPriority: pair second newState: pair first.
- pair first joinName: pair second newState: pair first.
- self replace: pair second with: pair first.
- self mergeTransitions.
- pair := self statePairs detect: [ :p | p first equals: p second ] ifNone: [ nil ].
- ].
-!
-
-removeEpsilonTransition: transition source: state
- ^ self removeEpsilonTransition: transition source: state openSet: IdentitySet new
-!
-
-removeEpsilonTransition: transition source: source openSet: openSet
- | destination |
- (openSet includes: transition) ifTrue: [ self error: 'loop in epsilons?!!' ].
- openSet add: transition.
-
- destination := transition destination.
-
- "First Remove Recursively"
- ((self transitionsFor: destination ) select: [ :t | t isEpsilon ]) do: [ :t |
- self removeEpsilonTransition: t source: destination openSet: openSet
- ].
-
- (transition priority abs) timesRepeat: [
- (self statesReachableFrom: destination) do: [ :s |
- s decreasePriority.
- s transitions do: [ :t | t decreasePriority ]
- ]
- ].
-
- (destination transitions) do: [ :t |
- source addTransition: (t copy)
- ].
-
- destination hasPriority ifTrue: [
- source hasPriority ifTrue: [
- "self assert: source priority == destination priority"
- self flag: 'I am not 100% sure about this case'
- ].
- source priority: destination priority
- ].
-
- destination isFinal ifTrue: [
- source final: true.
- source retval: destination retval.
- ].
-
- source removeTransition: transition.
-!
-
-removeEpsilons
- states do: [ :state |
- self removeEpsilonsFor: state
- ]
-!
-
-removeEpsilonsFor: state
- (self transitionsFor: state) copy do: [ :t |
- t isEpsilon ifTrue: [
- self removeEpsilonTransition: t source: state
- ]
+ state mergeTransitions.
]
!
@@ -688,10 +858,14 @@
!
removeLowPriorityTransitionsFor: state
+ | transitions |
state hasPriority ifFalse: [ ^ self ].
state isFinal ifFalse: [ ^ self ].
-
- state transitions do: [ :t |
+ "TODO JK: I can probably cut some transitions from multivalu as well"
+ state isMultivalue ifTrue: [ ^ self ].
+
+ transitions := state transitions copy.
+ transitions do: [ :t |
(t priority < state priority) ifTrue: [
state removeTransition: t
]