cudd-0.1.0.0: Cudd/File.chs

{-# LANGUAGE ForeignFunctionInterface, CPP, FlexibleContexts, RankNTypes #-}

module Cudd.File (
    DddmpVarInfoType(..),
    DddmpMode(..),
    DddmpVarMatchType(..),
    cuddBddStore,
    cuddBddLoad
    ) where

import Foreign.Storable
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Control.Monad

import Cudd.Cudd
import Cudd.C

#include "dddmp.h"

{#enum Dddmp_VarInfoType as DddmpVarInfoType {underscoreToCase} #}

--Hard coded values are needed because of limitations of c2hs
#c

enum DddmpMode {
    DddmpModeText    = 65,
    DddmpModeBinary  = 66,
    DddmpModeDefault = 68
};

#endc

{#enum DddmpMode {} #}

foreign import ccall safe "Dddmp_cuddBddStore"
    c_dddmpBddStore :: Ptr CDDManager -> CString -> Ptr CDDNode -> Ptr CString -> Ptr CInt -> CInt -> CInt -> CString -> Ptr CFile -> IO CInt

nullOnEmpty :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
nullOnEmpty lst act = 
    case lst of
        [] -> act nullPtr
        _  -> withArray lst act

cuddBddStore :: DDManager -> String -> DDNode -> [Int] -> DddmpMode -> DddmpVarInfoType -> String -> IO Bool
cuddBddStore (DDManager m) name (DDNode node) auxids mode varinfo fname = liftM (/= 0) $ 
    withCString name                      $ \pname ->
    withForeignPtr node                   $ \dp ->
    nullOnEmpty (map fromIntegral auxids) $ \pauxids -> 
    withCString fname                     $ \pfname -> 
        c_dddmpBddStore m pname dp nullPtr pauxids (fromIntegral $ fromEnum mode) (fromIntegral $ fromEnum varinfo) pfname nullPtr

{#enum Dddmp_VarMatchType as DddmpVarMatchType {underscoreToCase} #}

foreign import ccall safe "Dddmp_cuddBddLoad_s"
    c_dddmpBddLoad :: Ptr CDDManager -> CInt -> Ptr CString -> Ptr CInt -> Ptr CInt -> CInt -> CString -> Ptr CFile -> IO (Ptr CDDNode)

cuddBddLoad :: DDManager -> DddmpVarMatchType -> [Int] -> [Int] -> DddmpMode -> String -> IO (Maybe DDNode)
cuddBddLoad (DDManager m) matchtype auxids composeids mode fname = 
    nullOnEmpty (map fromIntegral auxids)     $ \pauxids -> 
    nullOnEmpty (map fromIntegral composeids) $ \pcomposeids -> 
    withCString fname                         $ \pfname -> do
        node <- c_dddmpBddLoad m (fromIntegral $ fromEnum matchtype) nullPtr pauxids pcomposeids (fromIntegral $ fromEnum mode) pfname nullPtr
        case node == nullPtr of
            True  -> return Nothing
            False -> do
                fp <- newForeignPtrEnv deref m node
                return $ Just $ DDNode fp