The Inbox: ProtocolState-rww.1.mcz

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!