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.

#### 102 lines 3.5 KiB Raw Permalink Blame History

 ``` ``` ```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) ```