102 lines
3.5 KiB
Haskell
102 lines
3.5 KiB
Haskell
|
|
module CircuitSimulator (execCircuit, execCircuit2, checkCircuit, checkCircuits) where
|
|
|
|
import Encoding
|
|
import CircuitBase
|
|
|
|
-- import Control.Monad.ST
|
|
import Data.Array.IO
|
|
import Data.Int
|
|
import System.IO.Unsafe
|
|
|
|
-- this is the gate function for "0#" (no other function found until now)
|
|
-- gate0 :: (Nat, Nat) -> (Nat, Nat)
|
|
-- gate0 (l,r) = (makef [0,2,1,1,0,2,2,1,0] (l,r), makef [2,2,2,2,0,1,2,1,0] (l,r))
|
|
|
|
-- helper to create gate functions
|
|
-- values for [(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]
|
|
-- makef l x = fromJust $ lookup x $ zip [(i,j) | i <- [0..2], j <- [0..2]] l
|
|
|
|
gate0 :: (Trit, Trit) -> (Trit, Trit)
|
|
gate0 (l, r) = (l - r, l * r - 1)
|
|
igate0 :: (Int8, Int8) -> (Int8, Int8)
|
|
igate0 (l, r) = ((l - r) `mod` 3, (l * r - 1) `mod` 3)
|
|
|
|
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 = execfactory (circfactory c) input
|
|
execCircuit3 c input = ec c input
|
|
|
|
checkCircuit :: (Stream s1, Stream s2) => Circuit -> s1 -> s2 -> Bool
|
|
checkCircuit c input output = cec c i o where
|
|
o = streamread output
|
|
i = streamread input
|
|
|
|
checkCircuits :: (Stream s1, Stream s2) => s1 -> s2 -> [Circuit] -> [Circuit]
|
|
checkCircuits input output circs = filter (\c -> cec c i o) circs where
|
|
o = streamread output
|
|
i = streamread input
|
|
|
|
sameprefix :: Eq a => [a] -> [a] -> Bool
|
|
sameprefix a b = all (uncurry (==)) $ zip a b
|
|
|
|
circfactory :: Circuit -> ([Trit], ([Trit], Trit) -> ([Trit], Trit))
|
|
circfactory circ = (map (const 0) (inPins circ), next) where
|
|
next (pins, inp) = (pint, if (-1 == outPin circ) then inp else pint !! (outPin circ)) where
|
|
pint = work 0 [] pins
|
|
work _ n [] = n
|
|
work k n o@(a:b:t) = let (c,d) = gate0 (get k, get (k+1)) in c `seq` d `seq` work (k+2) (n ++ [c,d]) t where
|
|
get x = let r = (inPins circ !! x) in if (-1 == r) then inp else (n ++ o) !! r
|
|
|
|
ec :: Circuit -> [Trit] -> [Trit]
|
|
ec circ input = map (toTrit . fromIntegral) $ unsafePerformIO $ do
|
|
state <- newListArray (-1, length pins - 1) (0:map (const 0) pins) :: IO (IOUArray Int Int8)
|
|
next [] state (map (fromIntegral . fromTrit) input)
|
|
where
|
|
pins = inPins circ
|
|
opin = outPin circ
|
|
next r state [] = return r
|
|
next r state (x:xs) = do
|
|
writeArray state (-1) x
|
|
work state 0 pins
|
|
e <- readArray state opin
|
|
next (r ++ [e]) state xs
|
|
work state k [] = return ()
|
|
work state k (a:b:t) = do
|
|
x <- readArray state a
|
|
y <- readArray state b
|
|
let (c, d) = igate0 (x, y)
|
|
writeArray state k c
|
|
writeArray state (k+1) d
|
|
work state (k+2) t
|
|
|
|
cec :: Circuit -> [Trit] -> [Trit] -> Bool
|
|
cec circ input output = unsafePerformIO $ do
|
|
state <- newListArray (-1, length pins - 1) (0:map (const 0) pins) :: IO (IOUArray Int Int8)
|
|
next [] state (map (fromIntegral . fromTrit) input) (map (fromIntegral . fromTrit) output)
|
|
where
|
|
pins = inPins circ
|
|
opin = outPin circ
|
|
next r state [] _ = return True
|
|
next r state _ [] = return True
|
|
next r state (x:xs) (y:ys) = do
|
|
writeArray state (-1) x
|
|
work state 0 pins
|
|
e <- readArray state opin
|
|
if (e /= y) then return False else next (r ++ [e]) state xs ys
|
|
work state k [] = return ()
|
|
work state k (a:b:t) = do
|
|
x <- readArray state a
|
|
y <- readArray state b
|
|
let (c, d) = igate0 (x, y)
|
|
writeArray state k c
|
|
writeArray state (k+1) d
|
|
work state (k+2) t
|
|
|
|
execfactory :: (a, (a, Trit) -> (a, Trit)) -> [Trit] -> [Trit]
|
|
execfactory (s, f) [] = []
|
|
execfactory (s, f) (x:xs) = o:execfactory (t, f) xs where (t, o) = f (s, x)
|