[squeak-dev] The Inbox: ProtocolState-rww.1.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Oct 4 16:53:41 UTC 2020
A new version of ProtocolState was added to project The Inbox:
http://source.squeak.org/inbox/ProtocolState-rww.1.mcz
==================== Summary ====================
Name: ProtocolState-rww.1
Author: rww
Time: 3 October 2020, 11:35:56.550112 am
UUID: f7bda3e4-a8e9-4bfc-a2a1-c48130f1d006
Ancestors:
split out ProtocolState
==================== Snapshot ====================
SystemOrganization addCategory: #ProtocolState!
IdentityDictionary subclass: #ProtocolState
instanceVariableNames: 'stateName default'
classVariableNames: ''
poolDictionaries: ''
category: 'ProtocolState'!
!ProtocolState commentStamp: 'rww 6/8/2019 21:59' prior: 0!
I am a single state within a cyclic graph of states. My values are edges leading to another state in the graph. If the edge has an action associated with it then I perform the method of that name in my client object, passing the object which stepped me as argument, before following the edge.
Structure:
name Symbol -- my state's name
keys Object -- the input tokens that cause me to step
values #(Symbol1 Symbol2) -- an edge: the next state and a client action selector
default #(Symbol1 Symbol2) -- the edge I follow if no key matches the stepping object
I am intended to be inserted somewhere in the middle of a LayeredProtocol stack.
Originally from Ian Piumarta's [1] Telnet changeset [2] and PseudoTTY changeset [3].
[1] Ian Piumarta - http://piumarta.com/cv/bio.html
[2] telnet.103.cs - http://squeakvm.org/unix/goodies/telnet.301.cs
[3] PseudoTTY-3.2-4.st - http://squeakvm.org/unix/goodies/PseudoTTY-3.2-4.st!
----- Method: ProtocolState class>>basicNew (in category 'instance creation') -----
basicNew
^ super basicNew
initialize;
yourself!
----- Method: ProtocolState class>>created (in category 'accessing') -----
created
^ self new
stateName: #created;
yourself!
----- Method: ProtocolState class>>example (in category 'examples') -----
example
"ProtocolState example"
^(self name: #initial default: #echo: -> #initial)
at: 42 put: #echo42: -> #initial;
yourself!
----- Method: ProtocolState class>>name:default: (in category 'instance creation') -----
name: myName default: aTransition
^self new
stateName: myName;
default: aTransition!
----- Method: ProtocolState class>>submitted (in category 'accessing') -----
submitted
^ self new
stateName: #submitted;
yourself!
----- Method: ProtocolState>>= (in category 'comparing') -----
= anotherState
^ self == anotherState
or: [
self class == anotherState class
and: [ stateName = anotherState stateName ] ]!
----- Method: ProtocolState>>add: (in category 'accessing') -----
add: anAssociation
^self transitionAt: anAssociation key put: (self transitionFor: anAssociation value)!
----- Method: ProtocolState>>addAll: (in category 'accessing') -----
addAll: anAssociation
^self atAll: anAssociation key put: anAssociation value!
----- Method: ProtocolState>>addAllInteger: (in category 'accessing') -----
addAllInteger: anAssociation
^self atAllInteger: anAssociation key put: anAssociation value!
----- Method: ProtocolState>>addInteger: (in category 'accessing') -----
addInteger: anAssociation
^self transitionAt: anAssociation key asInteger put: (self transitionFor: anAssociation value)!
----- Method: ProtocolState>>at:put: (in category 'accessing') -----
at: key put: transition
^self transitionAt: key put: (self transitionFor: transition)!
----- Method: ProtocolState>>at:to:put: (in category 'accessing') -----
at: anObject to: limit put: transition
| edge |
edge := self transitionFor: transition.
anObject to: limit do: [:target | self transitionAt: target put: edge]!
----- Method: ProtocolState>>atAll:put: (in category 'accessing') -----
atAll: collection put: transition
| edge |
edge := self transitionFor: transition.
collection do: [:elt | self transitionAt: elt put: edge]!
----- Method: ProtocolState>>atAllInteger:put: (in category 'accessing') -----
atAllInteger: collection put: transition
| edge |
edge := self transitionFor: transition.
collection do: [:elt | self transitionAt: elt asInteger put: edge]!
----- Method: ProtocolState>>default (in category 'accessing') -----
default
^default!
----- Method: ProtocolState>>default: (in category 'accessing') -----
default: transition
self defaultTransition: (self transitionFor: transition)!
----- Method: ProtocolState>>defaultTransition: (in category 'accessing') -----
defaultTransition: aTransition
default := aTransition!
----- Method: ProtocolState>>hash (in category 'comparing') -----
hash
^ stateName hash + (self collect: [:e | e key]) hash!
----- Method: ProtocolState>>isStateNamed: (in category 'actions') -----
isStateNamed: aSymbol
^ stateName == aSymbol!
----- Method: ProtocolState>>name (in category 'accessing') -----
name
^ self stateName!
----- Method: ProtocolState>>name: (in category 'accessing') -----
name: aSymbol
stateName := aSymbol!
----- Method: ProtocolState>>printElementsOn: (in category 'printing') -----
printElementsOn: aStream
aStream nextPutAll: '(name: ' , stateName printString.
aStream nextPutAll: ' default: ' , default printString.
aStream nextPutAll: ' transitions:'.
self associationsDo: [:transition | aStream space. transition printOn: aStream.].
aStream nextPut: $).!
----- Method: ProtocolState>>printOn: (in category 'printing') -----
printOn: aStream
aStream
nextPutAll: 'State: ';
nextPutAll: stateName asString!
----- Method: ProtocolState>>stateName (in category 'accessing') -----
stateName
^ stateName!
----- Method: ProtocolState>>stateName: (in category 'accessing') -----
stateName: aSymbol
stateName := aSymbol!
----- Method: ProtocolState>>transitionAt: (in category 'accessing') -----
transitionAt: key
^super at: key ifAbsent: [default]!
----- Method: ProtocolState>>transitionAt:put: (in category 'accessing') -----
transitionAt: key put: edge
^super at: key put: edge!
----- Method: ProtocolState>>transitionEvent:value:client: (in category 'actions') -----
transitionEvent: event value: value client: client
| transition action toState |
self validateEvent: event.
transition := self transitionAt: event.
action := transition key.
toState := transition value.
action isNil
ifFalse: [(action numArgs == 0)
ifTrue: [client cull: value]].
toState
ifNil: [(KeyNotFound key: toState) signal]
ifNotNil: [^toState]
!
----- Method: ProtocolState>>transitionExistsForEvent: (in category 'private') -----
transitionExistsForEvent: event
self keysDo: [:key | (key = event) ifTrue: [^ true] ].
^ false!
----- Method: ProtocolState>>transitionFor: (in category 'private') -----
transitionFor: transition
^transition key -> transition value!
----- Method: ProtocolState>>validateEvent: (in category 'private') -----
validateEvent: event
^ (self transitionExistsForEvent: event)
ifTrue: [ true ]
ifFalse: [ (KeyNotFound new key: event) signal ]!
IdentityDictionary subclass: #ProtocolStateCompiler
instanceVariableNames: 'initialState'
classVariableNames: ''
poolDictionaries: ''
category: 'ProtocolState'!
!ProtocolStateCompiler commentStamp: '<historical>' prior: 0!
I am a collection of ProtocolStates constituting a transition graph for a StatefulProtocol. See my class side for some examples of how I construct state machine descriptions for you.
Note that before I can be used to drive a StatefulProtocol you *must* send me #compile. I will answer the initial ProtocolState in the compiled transition graph. (I will also complain if your protocol is broken. ;-) You subsequently pass this ProtocolState as the argument to StatefulProtocol class>>initialState: in order to instantiate a new StatefulProtocol.
Structure:
initialState Symbol -- the name of the initial (root) node in my transition graph!
----- Method: ProtocolStateCompiler class>>example (in category 'examples') -----
example
"A state machine that recognises occurrences of 'x' 'xy' and 'xy[digits...]z' in a stream of characters. Note: this is used by StateMachineTester, so don't modify it. See StateMachineTester class>>test for an example of use."
"ProtocolStateCompiler example"
| desc |
desc := self new.
(desc newState: #initial -> (#echo: -> #initial)) add: $x -> (nil -> #statex).
(desc newState: #statex -> (#echox: -> #initial)) add: $y -> (#initPrefix: -> #statexy).
(desc newState: #statexy -> (#echoxy: -> #initial))
add: $z -> (#echoxyz: -> #initial);
addAll: '0123456789' -> (#addPrefix: -> nil).
desc initialState: #initial.
^desc!
----- Method: ProtocolStateCompiler class>>example2 (in category 'examples') -----
example2
"ProtocolStateCompiler example2 explore"
^self example compile!
----- Method: ProtocolStateCompiler class>>example3 (in category 'examples') -----
example3 "Note: this example should pop up an error notifier during compilation"
"ProtocolStateCompiler example3 compile"
| desc |
desc := self new.
(desc newState: #initial -> (#echo: -> #initial)) add: $x -> (nil -> #statex).
(desc newState: #statex -> (#echox: -> #initial)) add: $y -> (nil -> #statexy).
(desc newState: #statexy -> (#echoxy: -> #initial)) add: $z -> (#echoxy: -> #statexyz).
(desc newState: #statexyz -> (#echoxy: -> #initial)) add: $z -> (#echoxyz: -> #statexyz).
desc initialState: #initial.
^desc!
----- Method: ProtocolStateCompiler class>>example4 (in category 'examples') -----
example4 "Note: this example should pop up an error notifier during compilation"
"ProtocolStateCompiler example4 compile"
| desc |
desc := self new.
(desc newState: 0 -> (#echo: -> 0)) add: $x -> (nil -> 1).
(desc newState: 1 -> (#echox: -> 0)) add: $y -> (nil -> 2).
(desc newState: 2 -> (#echoxy: -> 0)) add: $z -> (#echoxy: -> 3).
(desc newState: 3 -> (#echoxy: -> 0)) add: $z -> (#echoxyz: ->3).
desc initialState: 0.
^desc!
----- Method: ProtocolStateCompiler class>>initialState: (in category 'instance creation') -----
initialState: stateName
^self new initialState: stateName!
----- Method: ProtocolStateCompiler>>compile (in category 'compiling') -----
compile
"Compile my symbolic representation into a cyclic DAG and answer the root node"
| edge |
self valuesDo: [:state |
state defaultTransition: (self resolve: state default).
state keysDo: [:key |
edge := state at: key.
state transitionAt: key put: (self resolve: edge)]].
^self at: initialState!
----- Method: ProtocolStateCompiler>>initialState: (in category 'initialize-release') -----
initialState: stateName
initialState := stateName!
----- Method: ProtocolStateCompiler>>newState: (in category 'initialize-release') -----
newState: rule
^self newState: rule key default: rule value!
----- Method: ProtocolStateCompiler>>newState:default: (in category 'initialize-release') -----
newState: stateName default: transition
^self at: stateName put: (ProtocolState name: stateName default: transition)!
----- Method: ProtocolStateCompiler>>printElementsOn: (in category 'printing') -----
printElementsOn: aStream
aStream nextPutAll: '(initial: ' , initialState printString , ' states:'.
self keysDo: [:key | aStream space. key printOn: aStream].
aStream nextPut: $)!
----- Method: ProtocolStateCompiler>>resolve: (in category 'compiling') -----
resolve: edge
| action target |
action := edge key.
target := edge value.
target := (self includesKey: target)
ifTrue: [self at: target]
ifFalse: [target isNil
ifTrue: [nil]
ifFalse: [self error: 'unknown target state ' , edge printString]].
^ action -> target!
More information about the Squeak-dev
mailing list
|