[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