You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

108 lines
6.0 KiB

{-# 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