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)