{-# LANGUAGE ViewPatterns, PatternGuards #-}

-- | This is an experimental module for an ABC intermediate language
-- involving a graph-based representation of the ABC program. The idea
-- is to simplify translation into other languages - such as Haskell -
-- while minimizing intermediate allocations. 
--
-- Currently, the translation is minimal, and uses a boxes-and-wires 
-- metaphor. Sophisticated optimizations on the graph should be feasible
-- (leveraging ABC's causal commutativity and spatial idempotence) but
-- are unlikely to actually be developed (at least not in Haskell).
--
-- Thoughts: I should probably separate partial evaluation from graph
-- construction...
--
-- Even with this minimalism, it takes a surprising amount of work to
-- perform a decent language translation....
--
module Graph 
    ( abc2graph
    , Box
    , Wire(..), CodeBundle(..)
    , NumWire, BoolWire, SrcWire
    , textToWire, wireToText
    , Label, NodeLabel, WireLabel, BoxLabel
    , Node(..)
    , nodeInputWires, nodeOutputWires
    , MkGraph, runMkGraph, evalMkGraph
    , GCX, gcx0
    ) where

import Control.Applicative
import Control.Monad 
import Control.Monad.Trans.State
import Control.Monad.Trans.Error
import Control.Monad.Trans.Writer.Strict
import Data.Functor.Identity

import Data.Ratio
import qualified Data.Map as M
import qualified Data.Set as Set
import Data.Set (Set)

import ABC.Operators

newtype Label n = Label Integer deriving (Ord,Eq)
type NodeLabel = Label Node
type WireLabel = Label Wire
type BoxLabel  = Label Box

type MkGraph = StateT GCX (ErrorT String Identity) 
runMkGraph :: GCX -> MkGraph a -> Either String (a,GCX)
evalMkGraph :: MkGraph a -> Either String a

runMkGraph gcx op = runIdentity $ runErrorT $ runStateT op gcx
evalMkGraph = runIdentity . runErrorT . flip evalStateT gcx0

-- | stateful context
data GCX = GCX
    { gcx_gensym  :: !Integer -- to generate unique labels (any type)
    , gcx_nodes   :: [Node] -- primitive operations in graph
    , gcx_elab    :: M.Map WireLabel Wire -- elaborations for wire structure
    , gcx_progs   :: M.Map [Op] BoxLabel -- to help detect cycles
    , gcx_subs    :: M.Map BoxLabel Box -- pre-implemented boxes
    }

-- | a generic wire or bundle of wires
data Wire
    = Var  !WireLabel
    | Num  NumWire
    | Code CodeBundle
    | Prod Wire Wire | Unit
    | Sum  BoolWire Wire Wire  -- (true+false) to avoid 'not' operations ?,C
    | Seal String Wire
    -- Note: for sum compositions, outer booleans override inner booleans.


type CWire a = Either WireLabel a

data CodeBundle = CodeBundle
    { cb_src  :: SrcWire
    , cb_copy :: BoolWire -- may copy (not affine)
    , cb_drop :: BoolWire -- may drop (not relevant)
    }

type NumWire  = CWire Rational
type SrcWire  = CWire [Op]
type BoolWire = CWire Bool 

-- | a 'box' is a generic model of a subgraph
type Box = Wire -> MkGraph Wire


-- | a 'node' is a primitive, labeled box, roughly corresponding to
-- ABC operators. A graph essentially consists of a set of nodes.
data Node  -- typically (label inputs outputs)
    -- math nodes
    = N_add (NumWire,NumWire) NumWire -- N(a)*N(b) → N(a+b)
    | N_neg NumWire NumWire -- N(a) → N(-a)
    | N_mul (NumWire,NumWire) NumWire -- N(a)*N(b) → N(a*b)
    | N_inv NumWire NumWire -- N(a) → N(1/a)
    | N_divMod (NumWire,NumWire) (NumWire,NumWire) -- N(dividend)*N(divisor)→N(quotient)*N(remainder)

    -- boolean manipulation nodes 
    | N_boolOr  (WireLabel,WireLabel) WireLabel
    | N_boolAnd (WireLabel,WireLabel) WireLabel
    | N_boolNot WireLabel WireLabel

    -- safety tests
    | N_boolAssert WireLabel ()  -- from K,C  (same as assert true)
    | N_eqvAssert (Wire,Wire) () -- from {&≡}
    | N_eqvNumAssert (NumWire,NumWire) ()
    | N_eqvBoolAssert (WireLabel,WireLabel) ()

    -- substructural type info
    | N_boolCopyable WireLabel WireLabel -- var in, bool out
    | N_boolDroppable WireLabel WireLabel -- var in, bool out

    -- program manipulation nodes
    | N_apply (WireLabel,Wire) WireLabel -- (a→a')*a → a'; also used for 'cond'
    | N_quote Wire SrcWire -- a → (s→(a*s))
    | N_comp (SrcWire,SrcWire) SrcWire -- (a→b)*(b→c) → (a→c)

    -- conditional behavior...
    | N_cond (SrcWire,Wire) Wire
    | N_merge Wire Wire -- (a+a') → a
    | N_gt (NumWire,NumWire) BoolWire -- N(a)*N(b) → (a>b)?
    | N_nonZero NumWire BoolWire

    -- extended node primitives
    | N_tok String   Wire Wire -- ABC's {tokens}; type not locally known
    | N_sub BoxLabel Wire Wire -- call a named local subroutine
    deriving (Show)

instance Show (Label n) where 
    showsPrec _ (Label n) = showChar '_' . shows n

instance Show Wire where
    showsPrec _ (Var lbl) = showChar 'v' . shows lbl
    showsPrec _ (wireToText -> Just txt) = shows (show txt)
    showsPrec _ (Num (Right r)) = 
        let num = numerator r in
        let den = denominator r in
        let sd = if (1==den) then showChar '/' . shows den else id in
        showChar 'N' . showChar '(' . shows num . sd . showChar ')'
    showsPrec _ (Num  (Left lbl)) = showChar 'n' . shows lbl
    showsPrec _ (Code _) = showString "[box]"
    showsPrec _ (Prod a b) = showChar '(' . shows a . showChar '*' . shows b . showChar ')'
    showsPrec _ Unit = showString "unit"
    showsPrec _ (Sum (Right True) a b) =
        showString "(0*" . shows a . showChar '+' . shows b . showChar ')'
    showsPrec _ (Sum (Right False) a b) =
        showChar '(' . shows a . showString "+0*" . shows b . showChar ')'
    showsPrec _ (Sum _ a b) =
        showChar '(' . shows a . showChar '+' . shows b . showChar ')'
    showsPrec _ (Seal tok a) = shows a . showChar '{' . showString tok . showChar '}'

wireToText :: Wire -> Maybe String
wireToText (Sum (Right True) (Prod c cs) _) = (:) <$> wireToChar c <*> wireToText cs
wireToText (Sum (Right False) _ Unit) = pure ""

wireToChar :: Wire -> Maybe Char
wireToChar (Num (Right r)) | inCharRange r = (Just . toEnum . fromInteger . numerator) r
wireToChar _ = Nothing

inCharRange :: Rational -> Bool
inCharRange r = (1 == denominator r) && (0 <= n) && (n <= 0x10ffff) where
    n = numerator r

textToWire :: String -> MkGraph Wire
textToWire (c:cs) =
    let cWire = (Num . Right . fromIntegral . fromEnum) c in
    textToWire cs >>= \ csWire ->
    return (Sum (Right True) (Prod cWire csWire) Unit)
textToWire [] = newSumInR Unit 

-- wrap a value into a sum with a labeled void
newSumInL, newSumInR :: Wire -> MkGraph Wire
newSumInL w = newVar >>= \ v -> return (Sum (Right True)  w v)
newSumInR w = newVar >>= \ v -> return (Sum (Right False) v w)

-- create a fresh variable
newVar :: MkGraph Wire
newVar = Var <$> newLabel

newCWire :: MkGraph (CWire a)
newCWire = Left <$> newLabel

newBool :: MkGraph BoolWire
newNumber :: MkGraph NumWire
newSrc :: MkGraph SrcWire
newCodeBundle :: MkGraph CodeBundle
newBool = newCWire
newNumber = newCWire
newSrc = newCWire
newCodeBundle = CodeBundle <$> newSrc <*> newBool <*> newBool

newLabel :: MkGraph (Label n) 
newLabel = 
    get >>= \ gcx ->
    let lNum = 1 + gcx_gensym gcx in
    put (gcx { gcx_gensym = lNum }) >>
    return (Label lNum)

gcx0 :: GCX
gcx0 = GCX
    { gcx_gensym = 0
    , gcx_nodes = []
    , gcx_progs = M.empty
    , gcx_subs = M.empty
    , gcx_elab = M.empty
    }

-- | compute a graph from ABC code with initial wire
abc2graph :: [Op] -> Box
abc2graph ops w = abc2sub ops >> runABC ops w 

-- generate a subroutine
abc2sub :: [Op] -> MkGraph BoxLabel
abc2sub ops =
    get >>= \ gcx ->
    let progs = gcx_progs gcx in
    case M.lookup ops progs of
        Just box -> return box
        Nothing -> 
            newLabel >>= \ box ->
            let progs' = M.insert ops box progs in
            let subs' = M.insert box (runABC ops) (gcx_subs gcx) in
            let gcx' = gcx { gcx_progs = progs', gcx_subs = subs' } in
            put gcx' >> 
            return box

-- call a named subprogram
callSubroutine :: BoxLabel -> Box
callSubroutine lbl arg = 
    newVar >>= \ result ->
    emitNode (N_sub lbl arg result) >>
    return result

-- add code to the graph
emitNode :: Node -> MkGraph ()
emitNode node = modify $ \ gcx -> gcx { gcx_nodes = (node : gcx_nodes gcx) }

-- runABC will actually emit nodes associated with the ABC operators
runABC :: [Op] -> Box
runABC (op:ops) = runOp op >=> runABC ops
runABC [] = return

runOp :: Op -> Box
runOp Op_l = opl
runOp Op_r = opr
runOp Op_w = opw
runOp Op_z = opz
runOp Op_v = opv
runOp Op_c = opc
runOp Op_L = opL
runOp Op_R = opR
runOp Op_W = opW
runOp Op_Z = opZ
runOp Op_V = opV
runOp Op_C = opC
runOp (BL ops) = opBL ops
runOp (TL str) = opTL str
runOp (Tok tok) = opTok tok
runOp Op_copy = opCopy
runOp Op_drop = opDrop
runOp Op_add = opAdd
runOp Op_neg = opNeg
runOp Op_mul = opMul
runOp Op_inv = opInv
runOp Op_divMod = opDivMod
runOp Op_ap = opApply
runOp Op_cond = opCond
runOp Op_quote = opQuote
runOp Op_comp = opCompose
runOp Op_rel = opRel
runOp Op_aff = opAff
runOp Op_distrib = opDistrib
runOp Op_factor = opFactor
runOp Op_merge = opMerge
runOp Op_assert = opAssert
runOp Op_gt = opGT
runOp Op_introNum = opIntroNum
runOp Op_0 = opDigit 0
runOp Op_1 = opDigit 1
runOp Op_2 = opDigit 2
runOp Op_3 = opDigit 3
runOp Op_4 = opDigit 4
runOp Op_5 = opDigit 5
runOp Op_6 = opDigit 6
runOp Op_7 = opDigit 7
runOp Op_8 = opDigit 8
runOp Op_9 = opDigit 9
runOp Op_SP = return
runOp Op_LF = return

opl,opr,opw,opz,opv,opc :: Box
opL,opR,opW,opZ,opV,opC :: Box
opBL :: [Op] -> Box
opTL :: String -> Box
opTok :: String -> Box
opCopy,opDrop :: Box
opAdd,opNeg,opMul,opInv,opDivMod :: Box
opApply,opCond,opQuote,opCompose,opAff,opRel :: Box
opDistrib,opFactor,opMerge,opAssert :: Box
opGT :: Box
opIntroNum :: Box
opDigit :: Int -> Box

opl abc =
    asProd abc >>= \ (a,bc) ->
    asProd bc >>= \ (b,c) ->
    return (Prod (Prod a b) c)
opr abc = 
    asProd abc >>= \ (ab,c) ->
    asProd ab >>= \ (a,b) ->
    return (Prod a (Prod b c))
opw abc =
    asProd abc >>= \ (a,bc) ->
    asProd bc >>= \ (b,c) ->
    return (Prod b (Prod a c))
opz abcd =
    asProd abcd >>= \ (a,bcd) ->
    opw bcd >>= \ cbd ->
    return (Prod a cbd)
opv a = return (Prod a Unit)
opc au = 
    asProd au >>= \ (a,u) ->
    asUnit u >>
    return a

opL = onFst opL'
opR = onFst opR'
opW = onFst opW'
opZ = onFst opZ'
opV = onFst opV'
opC = onFst opC'

onFst :: Box -> Box
onFst f ae = asProd ae >>= \ (a,e) -> f a >>= \ a' -> return (Prod a' e)

opL',opR',opW',opZ',opV',opC' :: Box

opL' abc = 
    asSum abc >>= \ (inA, a, bc) ->
    asSum bc >>= \ (inB_unless_inA, b, c) ->
    boolOr inA inB_unless_inA >>= \ inAB ->
    return (Sum inAB (Sum inA a b) c)
opR' abc =
    asSum abc >>= \ (inAB, ab, c) ->
    asSum ab >>= \ (inA_when_inAB, a, b) ->
    boolAnd inAB inA_when_inAB >>= \ inA ->
    return (Sum inA a (Sum inAB b c))
opW' abc =
    asSum abc >>= \ (inA,a,bc) ->
    asSum bc >>= \ (inB_unless_inA,b,c) ->
    boolNot inA >>= \ notInA ->
    boolAnd notInA inB_unless_inA >>= \ inB ->
    return (Sum inB b (Sum inA a c))
opZ' abcd =
    asSum abcd >>= \ (inA,a,bcd) ->
    opW' bcd >>= \ cbd ->
    return (Sum inA a cbd)
opV' a = newVar >>= Sum (Right True) a
opC' av =
    asSum av >>= \ (inA,a,v) ->
    boolAssert inA >> 
    return a

-- access components of a wire; also, infer structure of wires
asProd :: Wire -> MkGraph (Wire,Wire)
asUnit :: Wire -> MkGraph ()
asNumber :: Wire -> MkGraph NumWire
asSum :: Wire -> MkGraph (BoolWire, Wire, Wire)
asCode :: Wire -> MkGraph CodeBundle

asProd (Prod a b) = return (a,b)
asProd (Var w) = autoElab w (Prod <$> newVar <*> newVar) >>= asProd
asProd v = fail $ "expecting product @ " ++ show v

asUnit Unit = return ()
asUnit (Var w) = autoElab w (pure Unit) >>= asUnit
asUnit v = fail $ "expecting unit @ " ++ show v

asNumber (Num a) = return a
asNumber (Var w) = autoElab w (Num <$> newNumber) >>= \ asNum 
asNumber v = fail $ "expecting number @ " ++ show v

asSum (Sum c a b) = return (c,a,b)
asSum (Var w) = autoElab w (Sum <$> newBool <*> newVar <*> newVar) >>= asSum
asSum v = fail $ "expecting sum @ " ++ show v 

asCode (Code cb) = return cb
asCode (Var w) = autoElab w (Code <$> newCodeBundle) >>= asCode where
asCode v = fail $ "expecting code @ " ++ show v

autoElab :: WireLabel -> MkGraph Wire -> MkGraph Wire
autoElab w newW =
    get >>= \ gcx ->
    case M.lookup w (gcx_elab gcx) of
        Just w' -> return w' 
        Nothing -> 
            newW >>= \ w' ->
            let elab' = M.insert w w' (gcx_elab gcx) in
            put (gcx { gcx_elab = elab' }) >>
            return w'

boolOr  :: BoolWire -> BoolWire -> MkGraph BoolWire
boolAnd :: BoolWire -> BoolWire -> MkGraph BoolWire
boolNot :: BoolWire -> MkGraph BoolWire
boolAssert :: BoolWire -> MkGraph ()

boolOr (Right True) _ = return (Right True)
boolOr _ (Right True) = return (Right True)
boolOr (Right False) w = return w
boolOr w (Right False) = return w
boolOr (Left x) (Left y) = 
    newLabel >>= \ z ->
    emitNode (N_boolOr (x,y) z) >>
    return (Left z)

boolAnd (Right True) w = return w
boolAnd w (Right True) = return w
boolAnd (Right False) _ = return (Right False)
boolAnd _ (Right False) = return (Right False)
boolAnd (Left x) (Left y) =
    newLabel >>= \ z ->
    emitNode (N_boolAnd (x,y) z) >> 
    return (Left z)

boolNot (Right b) = return (Right (not b))
boolNot (Left x) =
    newBool >>= \ z ->
    emitNode (N_boolNot x z) >>
    return (Left z)

boolAssert (Right True) = return ()
boolAssert (Right False) = fail "static assertion failure"
boolAssert (Left b) = emitNode (N_boolAssert b)

boolCopyable :: Wire -> MkGraph BoolWire
boolCopyable (Num _) = return (Right True)
boolCopyable (Code cb) = cb_copy cb
boolCopyable (Prod a b) = boolAnd <*> boolCopyable a <*> boolCopyable b
boolCopyable Unit = return (Right True)
boolCopyable (Sum _ a b) = boolAnd <*> boolCopyable a <*> boolCopyable b
boolCopyable (Seal _ v) = boolCopyable v
boolCopyable (Var v) =
    newLabel >>= \ vCopyable ->
    emitNode (N_boolCopyable v vCopyable) >>
    return (Left vCopyable)

boolDroppable :: Wire -> MkGraph BoolWire
boolDroppable (Num _) = return (Right True)
boolDroppable (Code cb) = cb_drop cb
boolDroppable (Prod a b) = boolAnd <*> boolDroppable a <*> boolDroppable b
boolDroppable Unit = return (Right True)
boolDroppable (Sum _ a b) = boolAnd <*> boolDroppable a <*> boolDroppable b
boolDroppable (Seal _ v) = boolDroppable v
boolDroppable (Var v) =
    newLabel >>= \ vDroppable ->
    emitNode (N_boolDroppable v vDroppable) >>
    return (Left vDroppable)

opBL ops = return . Prod . Code . cb where
    cb = CodeBundle { cb_src = Right ops
                    , cb_copy = Right True
                    , cb_drop = Right True }

opTL txt = return . Prod . (textToWire txt)

-- todo: optimize this for common known cases
-- such as &≡ (assert equivalence)
opTok sealer@(':':_) w = return (Seal sealer w)
opTok ('.':s) w = unseal (':':s) w 
opTok tok w =
    newVar >>= \ v ->
    emitNode (N_tok tok w v) >>
    return v

unseal :: String -> Box
unseal s (Seal s' w) | (s == s') = return w
unseal s (Var w) = autoElab w (Seal s <$> newVar) >>= unseal s
unseal s v = fail $ "expecting sealed {:"++s++"} @ " ++ show v

opCopy ae =
    asProd ae >>= \ (a,e) ->
    boolCopyable a >>= \ mayCopy ->
    boolAssert mayCopy >>
    return (Prod a (Prod a e))

opDrop ae =
    asProd ae >>= \ (a,e) ->
    boolDroppable a >>= \ mayDrop ->
    boolAssert mayDrop >>
    return e

opAdd abe =
    asProd abe >>= \ (a,be) ->
    asProd be >>= \ (b,e) ->
    asNumber a >>= \ na ->
    asNumber b >>= \ nb ->
    numberAdd na nb >>= \ nc ->
    return (Prod (Num nc) e)

numberAdd :: NumWire -> NumWire -> MkGraph NumWire
numberAdd (Right a) (Right b) = return $ Right (a+b)
numberAdd a b =
    newNumber >>= \ c ->
    emitNode (N_add (a,b) c) >>
    return c

opNeg ae =
    asProd ae >>= \ (a,e) ->
    asNumber a >>= \ na ->
    numberNeg na >>= \ nc ->
    return (Prod (Num nc) e)

numberNeg :: NumWire -> MkGraph NumWire
numberNeg (Right a) = return $ Right (negate a)
numberNeg v =
    newNumber >>= \ r ->
    emitNode (N_neg v r) >>
    return r

opMul abe = 
    asProd abe >>= \ (a,be) ->
    asProd be >>= \ (b,e) ->
    asNumber a >>= \ na ->
    asNumber b >>= \ nb ->
    numberMul na nb >>= \ nc ->
    return (Prod (Num nc) e)

numberMul :: NumWire -> NumWire -> MkGraph NumWire
numberMul (Right a) (Right b) = return $ Right (a*b)
numberMul a b =
    newNumber >>= \ r ->
    emitNode (N_mul (a,b) r) >> 
    return r

opInv ae =
    asProd ae >>= \ (a,e) ->
    asNumber a >>= \ na ->
    numberInv na >>= \ nc ->
    return (Prod (Num nc) e)

numberInv :: NumWire -> MkGraph NumWire
numberInv (Right a) =
    if (0 == a) then fail "invert (/) on zero" else
    return (Right (recip a))
numberInv v =
    newNumber >>= \ r ->
    emitNode (N_inv v r) >>
    return r

opDivMod bae =
    asProd bae >>= \ (b,ae) ->
    asProd ae >>= \ (a,e) ->
    asNumber b >>= \ nb ->
    asNumber a >>= \ na ->
    numberDivMod na nb >>= \ (nq,nr) -> 
    return (Prod (Num nr) (Prod (Num nq) e))

numberDivMod :: NumWire -> NumWire -> MkGraph (NumWire, NumWire)
numberDivMod _ (Right b) | (0 == b) = fail $ "divmod (Q) by 0"
numberDivMod (Right a) (Right b) =
    let (q,r) = divModQ a b in
    return (Right (fromIntegral q), Right r)
numberDivMod a b =
    
    

opApply bxe =
    asProd bxe >>= \ (b,xe) ->
    asProd xe >>= \ (x,e) ->
    asCode b >>= \ cb ->
    callCode b x >>= \ x' ->
    return (Prod x' e)

callCode :: SrcWire -> Box
callCode (Right abc) x = abc2sub abc >>= flip callSubroutine x
callCode (Left w) x =
    newVar >>= \ x' ->
    emitNode (N_apply (w,x) x') >>
    return x'

opCond  bxye =
    asProd bxye >>= \ (b,xye) ->
    asProd xye >>= \ (xy,e) ->
    asSum xy >>= \ (inY,x,y) ->
    asCode b >>= \ cb ->
    boolAssert (cb_drop cb) >>
    


    | N_quote Wire SrcWire -- a → (s→(a*s))
    | N_comp (SrcWire,SrcWire) SrcWire -- (a→b)*(b→c) → (a→c)
        



opApply,opCond,opQuote,opCompose,opAff,opRel :: Box
opDistrib,opFactor,opMerge,opAssert :: Box
opGT :: Box
opIntroNum :: Box
opDigit :: Int -> Box




-- TODO: figure out these sophisticated booleans
--  * assume inner sums don't account for outer conditions
-- processing the graph...
nodeInputWires, nodeOutputWires :: Node -> Set WireLabel
nodeInputWires = execWriter . emitInputWires
nodeOutputWires = execWriter . emitOutputWires

type SetWriter e = Writer (Set e)

emit :: (Ord e) => e -> SetWriter e ()
emit = tell . Set.singleton

emitInputWires, emitOutputWires :: Node -> SetWriter WireLabel ()
emitWire :: Wire -> SetWriter WireLabel ()

emitWire (Var l) = emit l
emitWire (Num n) = emitCWire n
emitWire (Code cb) = 
    emitCWire (cb_src cb) >> 
    emitCWire (cb_copy cb) >> 
    emitCWire (cb_drop cb)
emitWire (Prod a b) = emitWire a >> emitWire b
emitWire (Sum c a b) = emitCWire c >> emitWire a >> emitWire b
emitWire (Seal _ a) = emitWire a

emitCWire :: CWire a -> SetWriter WireLabel ()
emitCWire (Left l) = emit l
emitCWire (Right _) = return ()

emitInputWires (N_add (a,b) _) = emitCWire a >> emitCWire b
emitInputWires (N_neg a _) = emitCWire a
emitInputWires (N_mul (a,b) _) = emitCWire a >> emitCWire b
emitInputWires (N_inv a _) = emitCWire a
emitInputWires (N_divMod (a,b) _) = emitCWire a >> emitCWire b
emitInputWires (N_boolOr (a,b) _) = emit a >> emit b
emitInputWires (N_boolAnd (a,b) _) = emit a >> emit b
emitInputWires (N_boolNot a _) = emit a
emitInputWires (N_boolAssert a _) = emit a
emitInputWires (N_apply (src,arg) _) = emitCWire src >> emitWire arg
emitInputWires (N_quote v _) = emitWire v
emitInputWires (N_comp (a,b) _) = emitCWire a >> emitCWire b
emitInputWires (N_cond (c,src,arg) _) = emitCWire c >> emitCWire src >> emitWire arg
emitInputWires (N_merge (a,b) _) = emitWire a >> emitWire b
emitInputWires (N_gt (a,b) _) = emitCWire a >> emitCWire b
emitInputWires (N_nonZero a _) = emitCWire a
emitInputWires (N_tok _ a _) = emitWire a
emitInputWires (N_sub _ a _) = emitWire a

emitOutputWires (N_add _ c) = emitCWire c
emitOutputWires (N_neg _ a') = emitCWire a'
emitOutputWires (N_mul _ c) = emitCWire c
emitOutputWires (N_inv _ a') = emitCWire a'
emitOutputWires (N_divMod _ (q,r)) = emitCWire q >> emitCWire r
emitOutputWires (N_boolOr _ c) = emit c
emitOutputWires (N_boolAnd _ c) = emit c
emitOutputWires (N_boolNot _ b) = emit b
emitOutputWires (N_boolAssert _ ()) = return ()
emitOutputWires (N_apply _ w) = emitWire w
emitOutputWires (N_quote _ src) = emitCWire src
emitOutputWires (N_comp _ xz) = emitCWire xz
emitOutputWires (N_cond _ w) = emitWire w
emitOutputWires (N_merge _ w) = emitWire w
emitOutputWires (N_gt _ c) = emitCWire c
emitOutputWires (N_nonZero _ b) = emitCWire b
emitOutputWires (N_tok _ _ w) = emitWire w
emitOutputWires (N_sub _ _ w) = emitWire w
