{-# LANGUAGE FlexibleContexts #-}

module Circuits (
  -- wires
  Wire, newWire, query, set,
  -- gates
  newAnd, newOr, newNot, newNand, newNor, newXor
  ) where

import Data.IORef (IORef, newIORef, readIORef, modifyIORef)
import Control.Monad (forM_)

{- Wire -}

-- consists of an IORef holding its current value and a list of gates
-- which require updating when the value of this wire is updated
data Wire = Wire 
  { value       :: IORef Bool
  , connections :: IORef [Gate]
  }

instance Show Wire where
  show _ = "wire"

newWire :: IO Wire
newWire = do
  v <- newIORef False
  cs <- newIORef []
  return $ Wire v cs

-- add the given gate to the list of gates that should be updated when
-- the value of the wire is changed
connect :: Wire -> Gate -> IO ()
connect (Wire _ cs) g = do
  modifyIORef cs (g:)
  update g

-- return the current value of the wire
query :: Wire -> IO Bool
query (Wire v _) = readIORef v

-- assign the value to the wire and tell all connected gates to update
set :: Wire -> Bool -> IO ()
set (Wire v cs) b = do
  modifyIORef v (\_ -> b)
  gates <- readIORef cs
  forM_ gates update

{- Gate -}

-- this data structure is not exported. smart constructors return
-- output wire
data Gate =
  And  {in0 :: Wire, in1 :: Wire, out :: Wire} |
  Or   {in0 :: Wire, in1 :: Wire, out :: Wire} |
  Not  {in0 :: Wire, out :: Wire}              |
  Nand {in0 :: Wire, in1 :: Wire, out :: Wire} |
  Nor  {in0 :: Wire, in1 :: Wire, out :: Wire} |
  Xor  {in0 :: Wire, in1 :: Wire, out :: Wire}
  deriving Show

newGate :: (Wire -> Wire -> Wire -> Gate) -> Wire -> Wire -> IO Wire
newGate constructor in0 in1 = do
  out <- newWire
  let g = constructor in0 in1 out
  connect in0 g
  connect in1 g
  return out

newAnd :: Wire -> Wire -> IO Wire
newAnd = newGate And

newOr :: Wire -> Wire -> IO Wire
newOr = newGate Or

newNot :: Wire -> IO Wire
newNot in0 = do
  out <- newWire
  let g = Not in0 out
  connect in0 g
  return out

newNand :: Wire -> Wire -> IO Wire
newNand = newGate Nand

newNor :: Wire -> Wire -> IO Wire
newNor = newGate Nor

newXor :: Wire -> Wire -> IO Wire
newXor = newGate Xor

-- defines the behavior of each gate
update :: Gate -> IO ()
update (And in0 in1 out) = do
  v0 <- query in0
  v1 <- query in1
  set out (v0 && v1)
update (Or in0 in1 out) = do
  v0 <- query in0
  v1 <- query in1
  set out (v0 || v1)
update (Not in0 out) = do
  v <- query in0
  set out (not v)
update (Nand in0 in1 out) = do
  v0 <- query in0
  v1 <- query in1
  set out (not (v0 && v1))
update (Nor in0 in1 out) = do
  v0 <- query in0
  v1 <- query in1
  set out (not (v0 || v1))
update (Xor in0 in1 out) = do
  v0 <- query in0
  v1 <- query in1
  set out ((v0 && (not v1)) || ((not v0) && v1))
