-- GENERATED by C->Haskell Compiler, version 0.18.1 The shapeless maps, 31 Oct 2014 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Data/ABC/Internal/AIG.chs" #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

{- |
Module      : Data.ABC.Internal.AIG
Copyright   : Galois, Inc. 2010
License     : BSD3
Maintainer  : jhendrix@galois.com
Stability   : experimental
Portability : non-portable (c2hs, language extensions)

/Incomplete./ Binding of @aig\/aig\/aig.h@.  This defines the
next-generation heavy-weight AIG representation (similar to the original
"Data.ABC.Internal.ABC") which is used in internal versions
(@base\/abci\/abc.c@) 8D, 8 and occasionally for 9 (during which the GIA
is temporarily converted into an AIG for some processing.)

-}

module Data.ABC.Internal.AIG (
    -- * Types
    -- ** Enums
      Aig_Type_t(..)
    -- ** Empty types
    , Aig_Man_t_
    , Aig_Obj_t_
    -- ** Pointer types
    , Aig_Man_t
    , Aig_Obj_t
    -- * Memory management
    , aigRegular
    , aigNot
    , aigNotCond
    , aigIsComplement
    , aigManCiNum
    , aigManCoNum
    , aigManObjNumMax
    , aigManConst0
    , aigManConst1
    , aigManCi
    , aigManCo
    , aigObjId
      -- * aigMan.c
    , aigManStart
    , aigManStop
    , p_aigManStop
      -- * aigObj.c
    , aigObjCreateCi
    , aigObjCreateCo
      -- * Re-exports
    , CInt
    ) where




import Control.Applicative
import Foreign
import Foreign.C

import Data.ABC.Internal.VecPtr
{-# LINE 61 "src/Data/ABC/Internal/AIG.chs" #-}


data Aig_Type_t = AigObjNone
                | AigObjConst1
                | AigObjCi
                | AigObjCo
                | AigObjBuf
                | AigObjAnd
                | AigObjExor
                | AigObjVoid
  deriving (Enum,Show,Eq)

{-# LINE 63 "src/Data/ABC/Internal/AIG.chs" #-}


data Aig_Man_t_
data Aig_Obj_t_

type Aig_Man_t = Ptr (Aig_Man_t_)
{-# LINE 68 "src/Data/ABC/Internal/AIG.chs" #-}

type Aig_Obj_t = Ptr (Aig_Obj_t_)
{-# LINE 69 "src/Data/ABC/Internal/AIG.chs" #-}


aigObjWordPtr :: (WordPtr -> WordPtr) -> (Aig_Obj_t -> Aig_Obj_t)
aigObjWordPtr f = wordPtrToPtr . f . ptrToWordPtr

aigRegular :: Aig_Obj_t -> Aig_Obj_t
aigRegular = aigObjWordPtr (`clearBit` 0)

aigNot :: Aig_Obj_t -> Aig_Obj_t
aigNot = aigObjWordPtr (xor (bit 0))

aigNotCond :: Aig_Obj_t -> Bool -> Aig_Obj_t
aigNotCond o b = if b then aigNot o else o

aigIsComplement :: Aig_Obj_t -> Bool
aigIsComplement o = ptrToWordPtr o `testBit` 0

typeCInt :: Aig_Type_t -> CInt
typeCInt = fromIntegral . fromEnum

aigManNObj :: (Aig_Man_t) -> (Aig_Type_t) -> IO ((CInt))
aigManNObj a1 a2 =
  let {a1' = id a1} in 
  let {a2' = typeCInt a2} in 
  aigManNObj'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 92 "src/Data/ABC/Internal/AIG.chs" #-}


aigManCiNum :: Aig_Man_t -> IO CInt
aigManCiNum = flip aigManNObj AigObjCi

aigManCoNum :: Aig_Man_t -> IO CInt
aigManCoNum = flip aigManNObj AigObjCo

aigManObjNumMax :: Aig_Man_t -> IO Int
aigManObjNumMax man =
  vecPtrSize =<< (\ptr -> do {peekByteOff ptr 32 ::IO (Vec_Ptr_t)}) man

aigManConst0 :: Aig_Man_t -> IO Aig_Obj_t
aigManConst0 m = aigNot <$> aigManConst1 m

aigManConst1 :: Aig_Man_t -> IO Aig_Obj_t
aigManConst1 = (\ptr -> do {peekByteOff ptr 48 ::IO (Aig_Obj_t)})
{-# LINE 108 "src/Data/ABC/Internal/AIG.chs" #-}


aigManCi :: (Aig_Man_t) -> (CInt) -> IO ((Aig_Obj_t))
aigManCi a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  aigManCi'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 113 "src/Data/ABC/Internal/AIG.chs" #-}

aigManCo :: (Aig_Man_t) -> (CInt) -> IO ((Aig_Obj_t))
aigManCo a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  aigManCo'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 117 "src/Data/ABC/Internal/AIG.chs" #-}


-- Note: We use a function rather rather than just #get, because Aig_Obj_t
-- is a bitfield, and offsets are computed incorrectly by c2hs.
aigObjId :: (Aig_Obj_t) -> IO ((CInt))
aigObjId a1 =
  let {a1' = id a1} in 
  aigObjId'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 122 "src/Data/ABC/Internal/AIG.chs" #-}


{-
newAigManForeignPtr :: Ptr Aig_Man_t_ -> IO (Aig_Man_t)
newAigManForeignPtr ptr | ptr == nullPtr = throwIO NullPtrError
                        | otherwise      = newForeignPtr p_aigManStop ptr
-}

foreign import ccall unsafe "&Aig_ManStop"
    p_aigManStop :: FunPtr (Aig_Man_t -> IO ())

foreign import ccall unsafe "Aig_ManStop" aigManStop :: Aig_Man_t -> IO ()

aigManStart :: (CInt) -> IO ((Aig_Man_t))
aigManStart a1 =
  let {a1' = id a1} in 
  aigManStart'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 135 "src/Data/ABC/Internal/AIG.chs" #-}


aigObjCreateCi :: (Aig_Man_t) -> IO ((Aig_Obj_t))
aigObjCreateCi a1 =
  let {a1' = id a1} in 
  aigObjCreateCi'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 138 "src/Data/ABC/Internal/AIG.chs" #-}

aigObjCreateCo :: (Aig_Man_t) -> (Aig_Obj_t) -> IO ((Aig_Obj_t))
aigObjCreateCo a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  aigObjCreateCo'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 140 "src/Data/ABC/Internal/AIG.chs" #-}


foreign import ccall safe "Data/ABC/Internal/AIG.chs.h AbcBridge_Aig_ManNObj"
  aigManNObj'_ :: ((Aig_Man_t) -> (CInt -> (IO CInt)))

foreign import ccall safe "Data/ABC/Internal/AIG.chs.h AbcBridge_Aig_ManCi"
  aigManCi'_ :: ((Aig_Man_t) -> (CInt -> (IO (Aig_Obj_t))))

foreign import ccall safe "Data/ABC/Internal/AIG.chs.h AbcBridge_Aig_ManCo"
  aigManCo'_ :: ((Aig_Man_t) -> (CInt -> (IO (Aig_Obj_t))))

foreign import ccall safe "Data/ABC/Internal/AIG.chs.h AbcBridge_Aig_ObjId"
  aigObjId'_ :: ((Aig_Obj_t) -> (IO CInt))

foreign import ccall safe "Data/ABC/Internal/AIG.chs.h Aig_ManStart"
  aigManStart'_ :: (CInt -> (IO (Aig_Man_t)))

foreign import ccall safe "Data/ABC/Internal/AIG.chs.h Aig_ObjCreateCi"
  aigObjCreateCi'_ :: ((Aig_Man_t) -> (IO (Aig_Obj_t)))

foreign import ccall safe "Data/ABC/Internal/AIG.chs.h Aig_ObjCreateCo"
  aigObjCreateCo'_ :: ((Aig_Man_t) -> ((Aig_Obj_t) -> (IO (Aig_Obj_t))))