901 lines
20 KiB
Smalltalk
901 lines
20 KiB
Smalltalk
Class {
|
|
#name : 'PEGFsa',
|
|
#superclass : 'Object',
|
|
#instVars : [
|
|
'states',
|
|
'startState',
|
|
'name',
|
|
'distances',
|
|
'priorities'
|
|
],
|
|
#category : 'PetitCompiler-FSA'
|
|
}
|
|
|
|
{ #category : 'instance creation' }
|
|
PEGFsa class >> new [
|
|
"return an initialized instance"
|
|
|
|
^ self basicNew initialize.
|
|
]
|
|
|
|
{ #category : 'comparing' }
|
|
PEGFsa >> = anotherFsa [
|
|
"
|
|
Please note what the compare does. IMO nothing useful for now.
|
|
|
|
For comparing if two FSA's are equivalent, use isIsomorphicTo:
|
|
"
|
|
|
|
(self == anotherFsa) ifTrue: [ ^ true ].
|
|
(self class == anotherFsa class) ifFalse: [ ^ false ].
|
|
|
|
(startState = anotherFsa startState) ifFalse: [ ^ false ].
|
|
(name = anotherFsa name) ifFalse: [ ^ false ].
|
|
|
|
(states size = anotherFsa states size) ifFalse: [ ^ false ].
|
|
states do: [:s |
|
|
(anotherFsa states contains: [ :e | e = s ]) ifFalse: [ ^ false ].
|
|
].
|
|
^ true
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> addState: state [
|
|
self assert: (states includes: state) not.
|
|
states add: state
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> addTransitionFrom: fromState to: toState [
|
|
| transition |
|
|
self assert: (states includes: fromState).
|
|
self assert: (states includes: toState).
|
|
|
|
transition := PEGFsaEpsilonTransition new
|
|
destination: toState;
|
|
priority: 0;
|
|
yourself.
|
|
|
|
fromState addTransition: transition.
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> addTransitionFrom: fromState to: toState on: character [
|
|
self addTransitionFrom: fromState to: toState on: character priority: 0
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> addTransitionFrom: fromState to: toState on: character priority: priority [
|
|
| transition |
|
|
transition := PEGFsaCharacterTransition new
|
|
addCharacter: character;
|
|
destination: toState;
|
|
priority: priority;
|
|
yourself.
|
|
|
|
fromState addTransition: transition
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> addTransitionFrom: fromState to: toState onCharacterSet: characterSet [
|
|
self addTransitionFrom: fromState to: toState onCharacterSet: characterSet priority: 0
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> addTransitionFrom: fromState to: toState onCharacterSet: characterSet priority: priority [
|
|
| transition |
|
|
transition := PEGFsaCharacterTransition new
|
|
characterSet: characterSet;
|
|
destination: toState;
|
|
priority: priority;
|
|
yourself.
|
|
|
|
fromState addTransition: transition
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> addTransitionFrom: fromState to: toState onPredicate: block priority: priority [
|
|
| transition |
|
|
transition := PEGFsaPredicateTransition new
|
|
predicate: block;
|
|
destination: toState;
|
|
priority: priority;
|
|
yourself.
|
|
|
|
fromState addTransition: transition
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> 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 := PEGFsaEpsilonTransition new
|
|
destination: toState;
|
|
priority: priority;
|
|
yourself.
|
|
|
|
fromState addTransition: transition.
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> adopt: fsa [
|
|
states addAll: fsa reachableStates.
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> allTransitions [
|
|
^ self allTransitions: IdentitySet new
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> allTransitions: collection [
|
|
self states do: [ :s | collection addAll: s transitions ].
|
|
^ collection
|
|
]
|
|
|
|
{ #category : 'printing' }
|
|
PEGFsa >> asString [
|
|
| stream |
|
|
stream := WriteStream on: ''.
|
|
|
|
self topologicalOrder do: [ :state |
|
|
state printOn: stream.
|
|
stream nextPutAll: '> '.
|
|
|
|
(self transitionsFor: state) do: [ :transition |
|
|
stream nextPut: (Character codePoint: 13).
|
|
stream nextPut: (Character codePoint: 9).
|
|
transition printOn: stream.
|
|
].
|
|
stream nextPut: (Character codePoint: 13).
|
|
].
|
|
|
|
" stream nextPutAll: 'finals: '.
|
|
(states select: [:s | s isFinal ]) do: [:e | e printOn: stream ].
|
|
stream nextPut: (Character codePoint: 13).
|
|
"
|
|
^ stream contents.
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> backTransitions [
|
|
| transitionSet |
|
|
transitionSet := IdentitySet new.
|
|
self computeDistances.
|
|
|
|
self backTransitionsFrom: startState openSet: IdentitySet new transitionSet: transitionSet.
|
|
^ transitionSet
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> backTransitionsFrom: state openSet: openSet transitionSet: transitionSet [
|
|
(openSet includes: state) ifTrue: [
|
|
^ self
|
|
].
|
|
openSet add: state.
|
|
|
|
state transitions do: [ :t |
|
|
((openSet includes: t destination) and: [self is: state furtherThan: t destination]) ifTrue: [
|
|
transitionSet add: t
|
|
].
|
|
self backTransitionsFrom: t destination openSet: openSet copy transitionSet: transitionSet
|
|
]
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> canHavePPCId [
|
|
^ true
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> checkConsistency [
|
|
self assert: (states includes: startState).
|
|
|
|
states do: [ :s | s transitions do: [ :t |
|
|
self assert: (states includes: t destination).
|
|
] ].
|
|
^ true
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> checkFinalStatesPriorities [
|
|
self assert: (self finalStates allSatisfy: #hasPriority)
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> checkSanity [
|
|
self checkConsistency.
|
|
self checkTransitionsIdentity.
|
|
self checkTransitionsPriority.
|
|
self checkFinalStatesPriorities.
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> checkTransitionsIdentity [
|
|
| bag set |
|
|
bag := IdentityBag new.
|
|
set := IdentitySet new.
|
|
bag := self allTransitions: bag.
|
|
set := self allTransitions: set.
|
|
|
|
self assert: bag size == set size.
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> checkTransitionsPriority [
|
|
self finalStates do: [ :fs |
|
|
fs isMultivalue ifFalse: [
|
|
fs transitions allSatisfy: [ :t | fs priority >= t priority ]
|
|
]
|
|
]
|
|
]
|
|
|
|
{ #category : 'transformations' }
|
|
PEGFsa >> compact [
|
|
self error: 'deprecated?'
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> computeDistances [
|
|
| queue openSet |
|
|
distances := IdentityDictionary new.
|
|
queue := OrderedCollection with: startState.
|
|
openSet := IdentitySet new.
|
|
|
|
distances at: startState put: 0.
|
|
|
|
[ queue isEmpty not ] whileTrue: [
|
|
| state |
|
|
state := queue removeFirst.
|
|
openSet add: state.
|
|
|
|
state transitions do: [ :t |
|
|
(openSet includes: (t destination)) ifFalse: [
|
|
distances at: (t destination ) put: ((distances at: state) + 1).
|
|
queue addLast: (t destination)
|
|
]
|
|
]
|
|
].
|
|
|
|
^ distances
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> decreasePriority [
|
|
^ self decreasePriorityBy: 1
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> decreasePriorityBy: value [
|
|
self states select: [ :s | s hasPriority ] thenDo: [ :s |
|
|
s decreasePriorityBy: value.
|
|
].
|
|
|
|
self allTransitions do: [ :t |
|
|
t decreasePriorityBy: value
|
|
]
|
|
]
|
|
|
|
{ #category : 'ids' }
|
|
PEGFsa >> defaultName [
|
|
^ #fsa
|
|
]
|
|
|
|
{ #category : 'modifications - determinization' }
|
|
PEGFsa >> determinize [
|
|
^ PEGFsaSequenceDeterminizator new determinize: self.
|
|
|
|
]
|
|
|
|
{ #category : 'modifications - determinization' }
|
|
PEGFsa >> 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.
|
|
|
|
|
|
]
|
|
|
|
{ #category : 'modifications - determinization' }
|
|
PEGFsa >> determinizeChoice [
|
|
^ PEGFsaChoiceDeterminizator new determinize: self.
|
|
|
|
]
|
|
|
|
{ #category : 'modifications - determinization' }
|
|
PEGFsa >> determinizeStandard [
|
|
^ PEGFsaDeterminizator new determinize: self.
|
|
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> epsilonDestinationsFrom: state [
|
|
| openSet |
|
|
openSet := IdentitySet new.
|
|
self epsilonDestinationsFrom: state openSet: openSet.
|
|
^ openSet
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> epsilonDestinationsFrom: state openSet: openSet [
|
|
(openSet includes: state) ifTrue: [
|
|
^ self
|
|
].
|
|
|
|
openSet add: state.
|
|
|
|
((self transitionsFor: state) select: [ :t | t isEpsilon ]) do: [ :t |
|
|
self epsilonDestinationsFrom: t destination openSet: openSet
|
|
]
|
|
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> finalState: state [
|
|
self assert: state isFinal not.
|
|
state final: true.
|
|
state priority: 0.
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> finalStates [
|
|
^ self states select: [ :s | s isFinal ]
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> fixFinalStatePriorities [
|
|
self finalStates do: [ :s |
|
|
s hasPriority ifFalse: [ s priority: 0 ]
|
|
]
|
|
]
|
|
|
|
{ #category : '*PetitCompiler-GUI' }
|
|
PEGFsa >> gtGraphViewIn: composite [
|
|
<gtInspectorPresentationOrder: 0>
|
|
composite roassal2
|
|
title: 'Graph';
|
|
initializeView: [ RTMondrian new ];
|
|
painting: [ :view |
|
|
self viewGraphOn: view.
|
|
].
|
|
]
|
|
|
|
{ #category : '*PetitCompiler-GUI' }
|
|
PEGFsa >> gtStringViewIn: composite [
|
|
<gtInspectorPresentationOrder: 40>
|
|
|
|
composite text
|
|
title: 'Textual Representation';
|
|
display: [ :fsa | fsa asString ]
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> 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
|
|
]
|
|
|
|
{ #category : 'ids' }
|
|
PEGFsa >> hasName [
|
|
^ name isNil not
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> hasNoRetvals [
|
|
^ self finalStates isEmpty
|
|
|
|
|
|
]
|
|
|
|
{ #category : 'comparing' }
|
|
PEGFsa >> hash [
|
|
^ states hash bitXor: (startState hash bitXor: name hash)
|
|
]
|
|
|
|
{ #category : 'initialization' }
|
|
PEGFsa >> initialize [
|
|
states := IdentitySet new.
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> is: state furtherThan: anotherState [
|
|
|
|
^ (distances at: state) >= (distances at: anotherState)
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> isBackTransition: t [
|
|
^ self backTransitions includes: t
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> isDeterministic [
|
|
self reachableStates do: [ :state |
|
|
state transitionPairs do: [ :pair |
|
|
((pair first intersection: pair second) includes: true) ifTrue: [
|
|
^ false
|
|
]
|
|
]
|
|
].
|
|
^ true
|
|
]
|
|
|
|
{ #category : 'comparing' }
|
|
PEGFsa >> isIsomorphicTo: anotherFsa [
|
|
| topologicalOrder anotherTopologicalOrder |
|
|
|
|
"
|
|
Please not that this version of comparison is sensitive to the order
|
|
in which the transitions in state are ordered.
|
|
"
|
|
|
|
topologicalOrder := self topologicalOrder.
|
|
anotherTopologicalOrder := anotherFsa topologicalOrder.
|
|
|
|
topologicalOrder size == anotherTopologicalOrder size ifFalse: [ ^ false ].
|
|
|
|
topologicalOrder with: anotherTopologicalOrder do: [ :s1 :s2 |
|
|
(s1 canBeIsomorphicTo: s2) ifFalse: [ ^ false ]
|
|
].
|
|
|
|
^ true
|
|
"
|
|
transitions := topologicalOrder flatCollect: [ :s | s transitions ].
|
|
anotherTransitions := anotherTopologicalOrder flatCollect: [ :s | s transitions ].
|
|
"
|
|
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> isReachableState: state [
|
|
^ self reachableStates includes: state
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> isStartState: state [
|
|
^ startState == state
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PEGFsa >> isWithoutEpsilons [
|
|
self reachableStates do: [ :state |
|
|
state transitions do: [ :t |
|
|
t isEpsilon ifTrue: [ ^ false ]
|
|
]
|
|
].
|
|
^ true
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> isWithoutPriorities [
|
|
^ self states allSatisfy: [ :s |
|
|
s hasPriority not or: [
|
|
s stateInfos allSatisfy: [ :i | i priority == 0 ]
|
|
]
|
|
].
|
|
]
|
|
|
|
{ #category : 'transformations' }
|
|
PEGFsa >> mergeTransitions [
|
|
| |
|
|
self reachableStates do: [ :state |
|
|
state mergeTransitions.
|
|
]
|
|
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> minimize [
|
|
^ PEGFsaMinimizator new minimize: self
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> name [
|
|
^ name
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> name: anObject [
|
|
|
|
name := anObject
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> nonFinalStates [
|
|
^ self states reject: [ :s | s isFinal ]
|
|
]
|
|
|
|
{ #category : 'copying' }
|
|
PEGFsa >> postCopy [
|
|
| map |
|
|
super postCopy.
|
|
|
|
map := IdentityDictionary new.
|
|
states do: [ :s |
|
|
map at: s put: s copy.
|
|
].
|
|
|
|
states := map values asIdentitySet.
|
|
startState isNil ifFalse: [
|
|
startState := map at: startState.
|
|
].
|
|
|
|
states do: [ :s |
|
|
s transitions do: [:t |
|
|
t destination: (map at: t destination)
|
|
]
|
|
]
|
|
]
|
|
|
|
{ #category : 'ids' }
|
|
PEGFsa >> prefix [
|
|
^ 'scan'
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> reachableStates [
|
|
^ self statesReachableFrom: startState
|
|
]
|
|
|
|
{ #category : 'modifications - epsilons' }
|
|
PEGFsa >> removeEpsilonTransition: transition source: state [
|
|
^ self removeEpsilonTransition: transition source: state openSet: IdentitySet new
|
|
]
|
|
|
|
{ #category : 'modifications - epsilons' }
|
|
PEGFsa >> 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.
|
|
]
|
|
|
|
{ #category : 'modifications - epsilons' }
|
|
PEGFsa >> removeEpsilons [
|
|
"First, remove the negative values from epsilons"
|
|
self removeNegativeEpsilons.
|
|
|
|
states do: [ :state |
|
|
self removeEpsilonsFor: state
|
|
]
|
|
]
|
|
|
|
{ #category : 'modifications - epsilons' }
|
|
PEGFsa >> removeEpsilonsFor: state [
|
|
(self transitionsFor: state) copy do: [ :t |
|
|
(t isEpsilon and: [ t destination isStub not ]) ifTrue: [
|
|
self removeEpsilonTransition: t source: state
|
|
]
|
|
]
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> removeFinals [
|
|
self finalStates do: [ :s |
|
|
s final: false
|
|
]
|
|
]
|
|
|
|
{ #category : 'transformations' }
|
|
PEGFsa >> removeLowPriorityTransitions [
|
|
states do: [ :state |
|
|
self removeLowPriorityTransitionsFor: state
|
|
]
|
|
]
|
|
|
|
{ #category : 'transformations' }
|
|
PEGFsa >> removeLowPriorityTransitionsFor: state [
|
|
| transitions |
|
|
state hasPriority ifFalse: [ ^ self ].
|
|
state isFinal ifFalse: [ ^ self ].
|
|
"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
|
|
]
|
|
]
|
|
]
|
|
|
|
{ #category : 'modifications - epsilons' }
|
|
PEGFsa >> removeNegativeEpsilonTransition: transition source: state [
|
|
^ self removeNegativeEpsilonTransition: transition source: state openSet: IdentitySet new
|
|
]
|
|
|
|
{ #category : 'modifications - epsilons' }
|
|
PEGFsa >> 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.
|
|
|
|
]
|
|
|
|
{ #category : 'modifications - epsilons' }
|
|
PEGFsa >> removeNegativeEpsilons [
|
|
"
|
|
This will remove only negative values from epsilons, the epsilons itself will not
|
|
be removed!
|
|
"
|
|
states do: [ :state |
|
|
self removeNegativeEpsilonsFor: state
|
|
]
|
|
]
|
|
|
|
{ #category : 'modifications - epsilons' }
|
|
PEGFsa >> removeNegativeEpsilonsFor: state [
|
|
(self transitionsFor: state) copy do: [ :t |
|
|
t isEpsilon ifTrue: [
|
|
self removeNegativeEpsilonTransition: t source: state
|
|
]
|
|
]
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> removePriorities [
|
|
self states select: [ :s| s hasPriority ] thenDo: [ :s |
|
|
s priority: 0
|
|
].
|
|
|
|
self allTransitions do: [ :t |
|
|
t priority: 0
|
|
]
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> removeState: state [
|
|
self assert: (states includes: state).
|
|
states remove: state.
|
|
]
|
|
|
|
{ #category : 'transformations' }
|
|
PEGFsa >> removeUnreachableStates [
|
|
| reachable toRemove |
|
|
reachable := self reachableStates.
|
|
toRemove := OrderedCollection new.
|
|
|
|
states do: [ :s |
|
|
(reachable includes: s) ifFalse: [
|
|
toRemove add: s
|
|
]
|
|
].
|
|
|
|
toRemove do: [ :s | states remove: s ]
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> replace: state with: anotherState [
|
|
| transitions |
|
|
self assert: (state isKindOf: PEGFsaState).
|
|
self assert: (anotherState isKindOf: PEGFsaState).
|
|
|
|
transitions := self allTransitions.
|
|
|
|
transitions do: [ :t |
|
|
(t destination == state) ifTrue: [
|
|
t destination: anotherState.
|
|
]
|
|
].
|
|
|
|
state == startState ifTrue: [ startState := anotherState ].
|
|
states remove: state.
|
|
states add: anotherState.
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> retval: returnValue [
|
|
self finalStates do: [ :s |
|
|
self assert: s retval isNil.
|
|
s retval: returnValue
|
|
]
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> retvals [
|
|
^ (self finalStates flatCollect: [ :e | e retvals collect: #value ]) asIdentitySet
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> startState [
|
|
self assert: (states includes: startState).
|
|
^ startState
|
|
]
|
|
|
|
{ #category : 'modifications' }
|
|
PEGFsa >> startState: state [
|
|
self assert: (states includes: state).
|
|
|
|
startState := state
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> stateNamed: stateName [
|
|
^ states detect: [ :e | e name = stateName ]
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> statePairs [
|
|
| pairs ordered |
|
|
pairs := OrderedCollection new.
|
|
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))
|
|
]
|
|
].
|
|
|
|
self assert: (pairs allSatisfy: [ :e | e class == PEGFsaPair ]).
|
|
^ pairs
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> states [
|
|
^ states
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> states: whatever [
|
|
states := whatever
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> statesReachableFrom: state [
|
|
| openSet |
|
|
self assert: state isNil not.
|
|
|
|
openSet := IdentitySet new.
|
|
self statesReachableFrom: state openSet: openSet.
|
|
^ openSet
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> statesReachableFrom: state openSet: openSet [
|
|
(openSet contains: [:e | e == state]) ifTrue: [
|
|
^ self
|
|
].
|
|
|
|
openSet add: state.
|
|
|
|
(self transitionsFor: state) do: [ :t |
|
|
self statesReachableFrom: t destination openSet: openSet
|
|
]
|
|
|
|
|
|
]
|
|
|
|
{ #category : 'ids' }
|
|
PEGFsa >> suffix [
|
|
^ nil
|
|
]
|
|
|
|
{ #category : 'analysis' }
|
|
PEGFsa >> topologicalOrder [
|
|
| collection |
|
|
collection := OrderedCollection new.
|
|
|
|
self statesReachableFrom: startState openSet: collection.
|
|
^ collection
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> transitionFrom: from to: to [
|
|
^ from transitions detect: [ :t | t destination = to ]
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PEGFsa >> transitionsFor: state [
|
|
self assert: (states includes: state).
|
|
^ state transitions
|
|
]
|
|
|
|
{ #category : '*PetitCompiler-GUI' }
|
|
PEGFsa >> viewGraphOn: b [
|
|
b shape circle size: 50.
|
|
b shape color: Color gray muchLighter muchLighter.
|
|
b shape withText: #gtName.
|
|
b nodes: (self nonFinalStates).
|
|
|
|
b shape circle size: 50.
|
|
b shape color: Color gray muchLighter.
|
|
b shape withText: #gtName.
|
|
b nodes: (self finalStates).
|
|
|
|
b shape arrowedLine.
|
|
b edges
|
|
connectToAll: [ :state |
|
|
state transitions select: [:t | (self isBackTransition:t) not]
|
|
thenCollect: #destination ]
|
|
labelled: [ :t | (self transitionFrom: t key to: t value) gtName ].
|
|
|
|
b shape arrowedLine.
|
|
b shape color: Color red.
|
|
b edges
|
|
connectToAll: [ :state |
|
|
state transitions select: [:t | (self isBackTransition: t) ]
|
|
thenCollect: #destination ]
|
|
labelled: [ :t | (self transitionFrom: t key to: t value) gtName ].
|
|
|
|
|
|
b layout horizontalTree .
|
|
b layout layout horizontalGap: 30.
|
|
|
|
^ b
|
|
]
|