requires: {#LinkedCollection. #SortedSet. #SortedArray. #IdentityDictionary}.
provides: {#Digraph. #KeyedDigraph}.

collections addPrototype: #Digraph derivedFrom: {LinkedCollection}.
"Digraphs are directed graphs: collections of nodes and edges which are
directed links between the nodes. The nodes and edges are essential, while
the graph just assists the process and provides a Facade."
Digraph addSlot: #root.
"A root node, taken arbitrarily."

graph@(Digraph traits) derive
"This traits is collaborating, so when derive is used, the collaborating
traits must also be derived to provide automatic protection against the
derived graph user adding conflicting methods to the collaborators."
[| newG |
  newG: resend.
  newG traits addImmutableSlot: #Node valued: graph Node derive.
  newG traits addImmutableSlot: #Edge valued: graph Edge derive.
  newG
].

graph@(Digraph traits) newNodeFromAll: col
"Add a new node, linking from all the nodes in the collection to it. If there
are no nodes in the graph, make this one the root."
"TODO: Check that the nodes are in the graph first?"
[| node |
  node: graph Node clone.
  graph root
    ifNil: [graph root: node. ^ node]
    ifNotNil: [col do: [| :each | each addEdgeTo: node]].
  node
].

graph@(Digraph traits) newNodeFrom: node
[
  graph newNodeFromAll: {node}
].

graph@(Digraph traits) newEdgeFrom: source to: target
[
  graph Edge newFrom: source to: target
].

graph@(Digraph traits) allNodes
"Returns all nodes traceable from the root node."
[
  graph root allNodes
].

Digraph traits addPrototype: #Node derivedFrom: {Cloneable}.
Digraph Node addSlot: #transitions valued: ExtensibleArray clone.
"The collection of edges leading away from the node. They are ordered by
default. TODO: review and revise this."

node@(Digraph Node traits) addEdgeTo: target
[
  node transitions add: (Digraph Edge newTo: target)
].

node@(Digraph Node traits) hasSimpleLoop
"Answers whether an outgoing edge simply points back to the node."
[
  node transitions anySatisfy: [| :each | each target == node]
].

node@(Digraph Node traits) isTerminal
"Answers whether there are no outgoing edges or only a loopback."
[
  node transitions isEmpty
    or: [node transitions size = 1
	   and: [node hasSimpleLoop]]
].

node@(Digraph Node traits) allNodesInto: set
[
  (set includes: node) ifTrue: [^ node].
  set add: node.
  node transitions do: [| :each | each target allNodesInto: set].
  node
].

node@(Digraph Node traits) allNodes
[| nodes |
  nodes: Set newEmpty.
  node allNodesInto: nodes.
  nodes
].

node@(Digraph Node traits) removeDuplicateEdges
"TODO: Add a SortedSet and use that."
[
  node transitions: ((node transitions as: Set) as: SortedArray).
  node
].

node@(Digraph Node traits) removeDuplicateNodes
[| nodes |
  [nodes: node allNodes.
   nodes do: [| :each | each mergeTransitions. each removeDuplicateEdges].
   node removeDuplicateNodes: nodes] whileTrue.
  node
].

node@(Digraph Node traits) removeDuplicateNodes: col
"TODO: [BUGS] remove dependence on #action and #becomeForward:."
[| merged nodePartition |
  merged: False.
  nodePartition: Dictionary newEmpty.
  col do: [| :each | (nodePartition
			at: {each transitions. each action}
			ifAbsentPut: [ExtensibleArray newEmpty])
	       add: each].
  nodePartition
    do: [| :each seen |
	   seen: ExtensibleArray newEmpty.
	   each do: [| :thisNode existingNode |
		       existingNode: seen
			 detect: [| :otherNode | otherNode transitionsMatch: node]
			 ifNone: [].
		       existingNode
			 ifNil: [seen add: thisNode]
			 ifNotNil: [merged: True.
				    node becomeForward: existingNode]]].
  merged
].

Digraph traits addPrototype: #Edge derivedFrom: {Cloneable}.
Digraph Edge addSlot: #target.
"The target of the edge."

edge@(Digraph Edge traits) newFrom: source to: target
[
  source addEdgeTo: target
].

edge@(Digraph Edge traits) = edge2@(Digraph Edge traits)
[
  edge target = edge2 target
].

edge@(Digraph Edge traits) hash
[
  edge target hash
].

collections addPrototype: #KeyedDigraph derivedFrom: {Digraph}.
"Represents a state-transition machine. That is, the nodes and directed edges
are states and transitions, respectively, with the edges activated by one
of a set of keys that they possess."

node@(KeyedDigraph Node traits) addEdgeTo: target keys: col
[
  node transitions add: (Digraph Edge newTo: target keys: col)
].

node@(KeyedDigraph Node traits) allKeyTransitions: set into: node2
[| index each |
  (set includes: node) ifTrue: [^ {}].
  set add: node.
  node2 addActions: node action."TODO: remove this dependency on #action."
  index: 0.
  [index <= node transitions size]
    whileTrue: [each: (node transitions at: index).
		index: index + 1.
		each isNotKeyed
		  ifTrue: [each target allKeyTransitions: set into: node2]
		  ifFalse: [(node2 transitions includes: each)
			      ifFalse: [node2 transitions add: each]]].
  node
].

node@(KeyedDigraph Node traits) mergeKeyTransitions
[| targetMap |
  targetMap: IdentityDictionary newEmpty.
  node transitions copy
    do: [| :each | (targetMap includesKey: each target)
	     ifTrue: [(targetMap at: each target)
			mergeWith: each.
		      transitions remove: each]
	     ifFalse: [targetMap at: each target put: each]].
  node
].

node@(KeyedDigraph Node traits) mergeTransitions
[| nodes |
  nodes: node allNodes.
  nodes do: [| :each | each mergeKeyTransitions].
  node
].

node@(KeyedDigraph Node traits) transitionsMatch: node2
"TODO: Factor out the keys comparison into a hook method."
[
  node transitions
    allSatisfy: [| :each | (node transitions includes: each)
		     or: [each target = node2
			    and: [each keys =
				    (node transitions
				       detect: [| :edge | edge target = node]
				       ifNone: [^ False]) keys]]]
].

KeyedDigraph Edge addSlot: #keys valued: SortedSet newEmpty.
"The set of possible keys that can activate the edge as a transition.
No keys possible means that it is an epsilon transition."
"TODO: make this a SortedSet when that is implemented."

edge@(KeyedDigraph Edge traits) newTo: target
[| newE |
  newE: resend.
  newE keys: Nil.
  newE
].

edge@(KeyedDigraph Edge traits) newTo: target keys: col
[| newE |
  newE: (edge newTo: target).
  newE keys: col.
  newE
].

edge@(KeyedDigraph Edge traits) isEpsilonTransition
[
  edge keys isNil
].

edge@(KeyedDigraph Edge traits) isEmpty
[
  edge keys isEmpty
].

edge@(KeyedDigraph Edge traits) = edge2@(KeyedDigraph Edge traits)
[
  edge target = edge2 target and: [edge keys = edge2 keys]
].

edge@(KeyedDigraph Edge traits) hash
"TODO: ensure that this will work on more than just character-keys."
[
  (edge target hash bitShift: 14) bitXor: edge keys hash
].

edge@(KeyedDigraph Edge traits) does: seq includeKey: key
[| start stop mid |
  start: 0.
  stop: seq size.
  stop isZero ifTrue: [^ False].
  [mid: start + stop // 2. mid == start]
    whileFalse: [((seq at: mid) as: Integer) < (key as: Integer)
		   ifTrue: [start: mid]
		   ifFalse: [stop: mid]].
  (seq at: start) == key
    or: [(seq at: stop) == key]
].

edge@(KeyedDigraph Edge traits) removeKeys: seq
[
  edge keys: (edge keys reject: [| :each | edge does: seq includeKey: each])
].