requires: {#LinkedCollection. #Set}.
provides: {#Graph}.

collections addPrototype: #Graph derivedFrom: {LinkedCollection}.
"An abstract traits for graphs."
Graph traits addPrototype: #Node derivedFrom: {Cloneable}.

g@(Graph traits) nodes
[
].

g@(Graph traits) edges
[
].

g@(Graph traits) nodesDo: block
[
  g nodes do: block
].

g@(Graph traits) edgesDo: block
[
  g edges do: block
].

collections ensureNamespace: #nodes.
nodes addSlot: #Node valued: Graph Node.

nodes addSlot: #Default valued: nodes Node.

nodes Node addSlot: #value.
"The abstract traits of nodes that are held in a graph. Each node holds onto
a corresponding object that is its value. Derivations add state or behavior
to represent edges in the graph."

node1@(nodes Node traits) = node2@(nodes Node traits)
[
  node1 value = node2 value
].

node@(nodes Node traits) hash
[
  node value hash
].

node@(nodes Node traits) markDo: block
"Visit each node in the graph once, applying the block. A node is only visited
after at least one of its predecessors, but not necessarily after all of them."
[| todo visited |
  todo: ({node} as: Set).
  visited: Set newEmpty.
  [todo isEmpty]
    whileFalse: [| each |
		   each: todo anyOne.
		   visited include: each.
		   block applyWith: each.
		   each
		     neighborsDo: [| :child | (visited includes: child)
				       ifFalse: [todo include: child]].
		   todo remove: node].
  node
].

node@(nodes Node traits) walkPre: preBlock post: postBlock
"Recursively walk the subtree rooted by the node. Apply preBlock to each node,
then walk the subtree below the node, then apply postBlock to the node."
[
  preBlock applyWith: node.
  node neighborsDo: [| :child | child walkPre: preBlock post: postBlock].
  postBlock applyWith: node.
  node
].

node@(nodes Node traits) isLeaf
[
  node degree = 0
].

node@(nodes Node traits) printOn: s
[
  s nextPut: $[.
  s value printOn: s.
  s nextPut: $].
].

nodes addPrototype: #Implicit derivedFrom: {nodes Node}.
"An Implicit Node has the edge structure represented within the value. It
forwards messages to access the edges."

nodes addPrototype: #Explicit derivedFrom: {nodes Node}.
"An Explicit Node stores the edges in a collection in a slot. The type varies
according to the graph's type."
nodes Explicit addSlot: #neighbors valued: Set newEmpty.

node@(nodes Explicit traits) copy
[| newN |
  newN: node clone.
  newN neighbors: node neighbors copy.
  newN
].

node@(nodes Explicit traits) degree
[
  node neighbors size
].

node@(nodes Explicit traits) neighborsDo: block
"Included to abstract over keyed vs. non-keyed edges."
[
  node neighbors do: block
].

node@(nodes Explicit traits) hasEdgeTo: x
[
  node neighbors includes: x
].

nodes addPrototype: #KeyedExplicit derivedFrom: {nodes Node}.
"Can access neighbors by a label/key."





collections addPrototype: #ConcreteGraph derivedFrom: {Graph}.
"Represents a collection of nodes. The various properties of the graph are
encoded in the type of nodes used: whether the graph is ordered, has a fixed
arity, or the edges are labelled/keyed."
ConcreteGraph addSlot: #nodes valued: Set newEmpty.
"A hashed Set of Nodes. The fact that it is hashed is relied upon."
ConcreteGraph addSlot: #nodeCreator valued: [].
"This is evaluated to create a new Node."
ConcreteGraph addSlot: #Node valued: nodes Default.
"Indicates the default node type and provides some parametricity."