16bitAdder.hs

{-# LANGUAGE FlexibleContexts #-}
module Main where

import Language.Gator hiding (sequence, mapM)
import Data.FixedList
import qualified Data.FixedList
import Control.Applicative
import Data.Traversable

import Prelude hiding (sequence, mapM)

main :: IO ()
main = do
    l <- compile logic
    putStrLn "/* "
    print l
    putStrLn " */"
    putStrLn $ mkDot l

logic :: StateT Logic IO ()
logic = do
    let 
    inA <- mkNamedChannels newInputN "A"
    inB <- mkNamedChannels newInputN "B"
    cIn <- newInputN "Cin"
    outS <- mkNamedChannels newOutputN "S"
    outC <- newOutputN "Cout"

    (s,c) <- adder inA inB cIn
    sequence $ pure connect <*> s <*> outS
    connect c outC
    where
      mkNamedChannels f name = mapM (f . (name ++) . show) busChannels
      busChannels = fromFoldable' [0..] :: FixedList16 Int


--adder :: (MonadState Logic m, Traversable f, Applicative f, Out a, Out b, Out cIn) =>
--         f a -> f b -> cIn -> m (f XOrGate, Trace)
adder a b cIn = do
  t <- newTrace
  connect cIn t
  runStateT (sequence $ fmap StateT $ pure fullAdder <*> a <*> b) t
{-
 - A Full Adder.
 - See: http://en.wikipedia.org/wiki/Adder_(electronics)#Full_adder
 -}
--fullAdder :: (Out a, Out b, Out cIn, MonadState Logic m) =>  a -> b -> cIn -> m (XOrGate, Trace)
fullAdder inA inB inC = do
    xor0 <- doXOr inA inB
    xor1 <- doXOr xor0 inC

    and0 <- doAnd xor0 inC
    and1 <- doAnd inA inB

    or0  <- doOr  and0 and1
    -- Notice added trace here
    t <- newTrace
    connect or0 t
    return (xor1,t)