{-# LANGUAGE ForeignFunctionInterface #-}
{-# OPTIONS -lcircsim -L. #-}

-- gcc -fPIC -shared -o libcircsim.so circsim.c
-- ghci CircuitC.hs -lcircsim -L.

module CircuitC (execCircuit, execCircuit2, checkCircuit, checkCircuits) where

import Foreign.C.Types                                                                                                                                                                                                                          
import Foreign.Storable                                                                                                                                                                                                                         
import Foreign.Ptr                                                                                                                                                                                                                              
import Foreign.Marshal.Array                                                                                                                                                                                                                    
import Foreign.Marshal.Alloc                                                                                                                                                                                                                    
import System.IO.Unsafe                                                                                                                                                                                                                         

import Data.List
import Data.Maybe

import Encoding
import CircuitBase

foreign import ccall unsafe "circsim.h circsim"                                                                                                                                                                                                    
	imp_circsim :: CInt -> Ptr CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO ()                                                                                                                                                                                                     
-- (int gates, int *gatepins, int *states, int streamlen, int *stream)
foreign import ccall unsafe "circsim.h findcirc"                                                                                                                                                                                                    
	imp_findcirc :: CInt -> Ptr CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt                                                                                                                                                                                                    
-- (int gates, int *gatepins, int *states, int streamlen, int *stream, int *output)

normlists a b = unzip $ zip a b

execCircuit :: Stream s => Circuit -> s
execCircuit c = execCircuit2 c (streamread server_input ++ repeat T0)
execCircuit2 :: (Stream s1, Stream s2) => Circuit -> s1 -> s2
execCircuit2 c input = streamwrite $ execCircuit3 c $ streamread input

execCircuit3 c input = map toTrit $ snd $ circsim n (take (length n) $ repeat 0) i where
	n = circ_to_native c
	i = map fromTrit input :: [Int]

checkCircuit :: (Stream s1, Stream s2) => Circuit -> s1 -> s2 -> Bool
checkCircuit c input output = findcirc n i o where
	n = circ_to_native c
	(i, o) = normlists (map fromTrit $ streamread input) (map fromTrit $ streamread output)

checkCircuits :: (Stream s1, Stream s2) => s1 -> s2 -> [Circuit] -> [Circuit]
checkCircuits input output circs = map native_to_circ $ maybeToList $ findcircs (map circ_to_native circs) i o where
	(i, o) = normlists (map fromTrit $ streamread input) (map fromTrit $ streamread output)

circsim :: [Int] -> [Int] -> [Int] -> ([Int], [Int])
circsim gatepins state input = unsafePerformIO $ do
	let gates = length gatepins `div` 2
	let slen = length input
	pins <- newArray $ map fromIntegral gatepins :: IO (Ptr CInt)
	states <- newArray $ map fromIntegral state :: IO (Ptr CInt)
	sin <- newArray $ map fromIntegral input :: IO (Ptr CInt)
	imp_circsim (fromIntegral gates) pins states (fromIntegral slen) sin
	ostate <- peekArray (length state) states
	output <- peekArray slen sin
	free states
	free sin
	free pins
	return (map fromIntegral ostate, map fromIntegral output)

-- input and output must have the same length
findcircs :: [[Int]] -> [Int] -> [Int] -> Maybe [Int]
findcircs circs input output = unsafePerformIO $ do
	let slen = length input
	sin <- newArray $ map fromIntegral input :: IO (Ptr CInt)
	sout <- newArray $ map fromIntegral output :: IO (Ptr CInt)
	res <- findfirstcirc slen sin sout circs
	free sin
	free sout
	return res where
		findfirstcirc slen sin sout [] = return Nothing
		findfirstcirc slen sin sout (gatepins:circs) = do
			let gates = length gatepins `div` 2
			pins <- newArray $ map fromIntegral gatepins :: IO (Ptr CInt)
			res <- imp_findcirc (fromIntegral gates) pins (fromIntegral slen) sin sout
			free pins
			if (res /= 0) then return (Just gatepins) else findfirstcirc slen sin sout circs


-- input and output must have the same length
findcirc :: [Int] -> [Int] -> [Int] -> Bool
findcirc gatepins input output = unsafePerformIO $ do
	let gates = length gatepins `div` 2
	let slen = length input
	pins <- newArray $ map fromIntegral gatepins :: IO (Ptr CInt)
	sin <- newArray $ map fromIntegral input :: IO (Ptr CInt)
	sout <- newArray $ map fromIntegral output :: IO (Ptr CInt)
	res <- imp_findcirc (fromIntegral gates) pins (fromIntegral slen) sin sout
	free sin
	free sout
	free pins
	return $ res /= 0

brutecircs :: Int -> [Int] -> Maybe Circuit
brutecircs gates output = case findcircs (permutations [0..2*gates]) (map fromTrit $ streamread server_input) output of
							   Nothing -> Nothing
							   Just p -> Just $ circ_from_perm $ map (\x -> x-1) p


circ_to_native :: Circuit -> [Int]
circ_to_native (Circuit o p) = (map (1+) (o:p))

native_to_circ :: [Int] -> Circuit
native_to_circ n = let (o:p) = map (\x -> x-1) n in Circuit o p