If we are going to manage the simulation in a pure functional manner, we still have to contend with the fact that during simulation, wires are objects with a fixed identity. A wire does not become a different wire just because its signal changes – the same wire is still hooked up to the same gates. Wires need to maintain their identity somehow.2² The alternative is reconstructing the full circuit any time a wire value changes, which is not so crazy as it sounds, given that it can be stored as a persistent data structure. But we won’t go down that route today.

In addition to the Signal type from before, we’ll define a Wire to be a string. This is its identity. We’ll also make a convenience function for creating a wire whose name is based on another wire name. This will be useful for creating unique wire names when we build circuits.

data Signal = Low | High
  deriving (Show, Eq, Ord, Bounded)

newtype Wire = Wire String
  deriving (Show, Eq, Ord)

make_wire (Wire base) suffix =
  Wire (base <> "." <> suffix)

We keep track of the state of the wires during simulation by maintaining a mapping from wire identity to signal. I’m not a fan of type aliases like this one3³ Type aliases increase indirection with no gain in abstraction. When faced with a type alias, the first thing I have to do to understand something is expand the alias to what it really stands for. So … what’s the point? I don’t get it., but for saving space in this article, it’ll have to do.

type WireState = Map Wire Signal

We will store signal changes as Change objects. They indicate at which time the signal changed, in which wire it changed, and what the signal changed to.

data Change = Change
  { time :: Int
  , wire :: Wire
  , signal :: Signal
  }
  deriving (Show, Eq, Ord)

A circuit is going to be a plain list of components.4⁴ Again, type alias for brevity in the code examples in the article. A component is a function that responds to changes and produces downstream changes.

type Circuit = [Change -> WireState -> [Change]]

For example, here’s the inverter. When it receives a change, it verifies that the change applies to its inputs, and if it does, it emits a change to its output, scheduled for a propagation delay later.5⁵ In this function, both pure calls are in list context, meaning they construct singleton lists. The way to understand it is that the inverter component has only one listener function, and it only produces at most one downstream change. (The second pure only runs if the guard passes. If the condition is false, an empty list of changes will be produced by this component.)

inverter :: Wire -> Wire -> Circuit
inverter input output =
  pure $ \change _ -> do
    guard (change.wire == input)
    pure $ Change (change.time + 2) output $
      case change.signal of
        Low -> High
        High -> Low

The code for the binary gates will be similar, except they need to look at both their inputs to see what the output should be. They get a convenience function to look up the state of a wire with a default.

look :: Wire -> WireState -> Signal
look w = Map.findWithDefault Low w

Then the and_gate is implemented as

and_gate :: Wire -> Wire -> Wire -> Circuit
and_gate a1 a2 output =
  pure $ \change state -> do
    guard (elem change.wire [a1, a2])
    pure $ Change (change.time + 3) output $
      case (look a1 state, look a2 state) of
        (High, High) -> High
        _ -> Low

and the or_gate is exactly the same but for the truth table.

or_gate :: Wire -> Wire -> Wire -> Circuit
or_gate a1 a2 output =
  pure $ \change state -> do
    guard (elem change.wire [a1, a2])
    pure $ Change (change.time + 5) output $
      case (look a1 state, look a2 state) of
        (Low, Low) -> Low
        _ -> High

Since Circuit is a type synonym for a plain list of components, we can compose components by appending lists. Here’s a half-adder.

half_adder :: Wire -> Wire -> Wire -> Wire -> Wire -> Circuit
half_adder ns a b s c =
  let
    d = make_wire ns "d"
    e = make_wire ns "e"
  in
    or_gate  a b   d     <>
    and_gate a b c       <>
    inverter     c   e   <>
    and_gate       d e s

The spacing between the arguments to the gates is not significant, but it does help with circuit recognition at a glance. The full adder is constructed similarly.

full_adder :: Wire -> Wire -> Wire -> Wire -> Wire -> Wire -> Circuit
full_adder ns a b c_in sum c_out =
  let
    s  = make_wire ns "s"
    c1 = make_wire ns "c1"
    c2 = make_wire ns "c2"
    ha1 = make_wire ns "ha1"
    ha2 = make_wire ns "ha2"
  in
    half_adder ha1 a c_in s      c1          <>
    half_adder ha1 b      s  sum    c2       <>
    or_gate                      c1 c2 c_out

Seeing it this way makes me realise how big of a circuit a full adder really is.

So far, we have only created circuits, not simulated them. The central portion of the pure simulation algorithm is a function execute_change that processes one Change, which produces a new WireState and potentially further Change events.

execute_change :: Circuit -> WireState -> Change
  -> (WireState, [Change])
execute_change circuit state change =
  let
    next_state =
      Map.insert change.wire change.signal state
    downstream_changes =
      concatMap (\component ->
        component change next_state
      ) circuit
  in
    (next_state, downstream_changes)

With this, we can write propagation as a generator-type loop. During each iteration, it will pop off the next change event, use execute_change to figure out the new wire state and downstream changes, and then yield the change event again. This will result in the propagate function returning a stream of changes as the simulation executes.

propagate :: Circuit -> [Change] -> [Change]
propagate circuit changes =
  let
    no_change state change =
      Map.lookup change.wire state == Just change.signal
    process_step state agenda =
      case agenda of
        -- If the agenda is empty, the circuit has stabilised.
        [] -> []
        -- Otherwise pop off the next change from the agenda.
        change : rest ->
          if no_change state change then
            -- If the change doesn't actually result in a
            -- change to the wire signal, ignore it.
            process_step state rest
          else
            let
              (next_state, downstream) =
                execute_change circuit state change
              future_changes =
                process_step next_state
                  (sort (downstream <> rest))
            in
              change : future_changes
  in
    process_step Map.empty (sort changes)

With this implementation, the circuit from sicp can be written as

sicp_circuit =
  half_adder (Wire "circuit")
    (Wire "input-1")
    (Wire "input-2")
    (Wire "sum")
    (Wire "carry")

and the wire assignments we’ll make are first setting input-1 high at time zero, then after eight time steps, we also set input-2 high.

wire_assignments =
  [ Change 0 (Wire "input-1") High
  , Change 8 (Wire "input-2") High
  ]

Off to the races we go!

result = propagate sicp_circuit wire_assignments

We don’t have a special probe action procedure any more, and we don’t need it. Since the propagate function yields back all the changes, we can filter that list for wires of interest, e.g. with

probe wire_name changes =
  for_ changes $ \c ->
    when (c.wire == Wire wire_name) $
      putStrLn (wire_name <> " (t=" <> show c.time <> ") new value: " <> show c.signal)

Then we can read back changes with something like

main = do
  probe "sum" changes
  probe "carry" changes

and we get what we expect.

sum (t=8) new value: Low
sum (t=8) new value: High
sum (t=16) new value: Low
carry (t=3) new value: Low
carry (t=11) new value: High

Since this is built as a generator, we can also incrementally consume results from circuits that never stabilise, such as the ring oscillator from before.

probe "feedback" $
  propagate (inverter (Wire "feedback") (Wire "feedback"))
    [Change 0 (Wire "feedback") Low]

Wheeee!

--------------- >8 -------
feedback (t=4368) new value: Low
feedback (t=4370) new value: High
feedback (t=4372) new value: Low
feedback (t=4374) new value: High
feedback (t=4376) new value: Low
feedback (t=4378) new value: High
feedback (t=4380) new value: Low
feedback (t=4382) new value: High
feedback (t=4384) new value: Low
feedback (t=4386) new value: High
feedback (t=4388) new value: Low
--------------- >8 -------

This version of the circuit simulator was satisfying to write. It took a bit of effort to get the propagation logic right, and it should probably be covered by tests, but now that it’s in place at least I feel like it reads fairly naturally.

That’s it from sicp for now!