Browse Source

Use Monad for decoding

master
Stefan Bühler 12 years ago
parent
commit
61a2808d71
  1. 6
      CircuitBase.hs
  2. 80
      Encoding.hs

6
CircuitBase.hs

@ -10,11 +10,13 @@ data Chamber = Chamber { upperPipe :: [Int], mainChamber :: Bool, lowerPipe :: [
data Car = Car { chambers :: [Chamber] }
instance Encode Chamber where
sdecode xs = let (x0, (a,b,c)) = sdecode xs in (x0, Chamber a (not b) c)
sdecode = do
(a, b, c) <- sdecode
return $ Chamber a (not b) c
sencode (Chamber a b c) = sencode (a, not b, c)
instance Encode Car where
sdecode xs = let (x0, a) = sdecode xs in (x0, Car a)
sdecode = sdecode >>= (return . Car)
sencode (Car a) = sencode a
server_input = "01202101210201202"

80
Encoding.hs

@ -2,6 +2,8 @@
module Encoding (Trit(..), Encode(..), Stream(..), encode, decode, decodeStrict, toTrit, fromTrit) where
import Control.Monad
data Trit = T0 | T1 | T2 deriving (Enum, Eq)
instance Show Trit where
@ -30,8 +32,6 @@ toTrit = toEnum
fromTrit :: Integral i => Trit -> i
fromTrit = fromIntegral . fromEnum
type DR a = ([Trit], a)
class Stream a where
streamread :: a -> [Trit]
streamwrite :: [Trit] -> a
@ -48,50 +48,75 @@ instance Stream String where
streamread = map (toEnum . read . (:[]))
streamwrite = concat . map (show . fromEnum)
data Decoder i o = Decoder { doDecode :: [i] -> ([i], o) }
type Encoder o i = i -> [o]
type DR a = Decoder Trit a
instance Monad (Decoder i) where
f >>= g = Decoder $ \x -> let (x0, r0) = doDecode f x in doDecode (g r0) x0
f >> g = Decoder $ \x -> let (x0, r0) = doDecode f x in doDecode g x0
return a = Decoder $ \x -> (x, a)
fail = error
class Encode a where
sdecode :: [Trit] -> ([Trit], a)
sencode :: a -> [Trit]
sdecode :: DR a
sencode :: Encoder Trit a
encode :: (Stream s, Encode a) => a -> s
encode = streamwrite . sencode
decode :: (Stream s, Encode a) => s -> a
decode = snd . sdecode . streamread
decode = snd . (doDecode sdecode) . streamread
decodeStrict :: (Stream s, Encode a) => s -> a
decodeStrict x = case (sdecode $ streamread x) of
decodeStrict x = case (doDecode sdecode $ streamread x) of
([], a) -> a
(_, _) -> error "Expected end of input"
getTrit :: Decoder Trit Trit
getTrit = Decoder $ \xs -> case xs of
[] -> error "Unexpected end of stream"
(i:xs) -> (xs, i)
instance Encode Bool where
sdecode xs = case sdecode xs :: DR Int of
(x0, 0) -> (x0, False)
(x0, 1) -> (x0, True)
(x0, i) -> error "Expected 0 or 1"
sdecode = do
i <- sdecode :: DR Int
case i of
0 -> return False
1 -> return True
_ -> fail "Expected 0 or 1"
sencode True = [1]
sencode False = [0]
instance Encode Trit where
sdecode [] = error "Unexpected end of stream"
sdecode (i:xs) = (xs, i)
sdecode = getTrit
sencode t = [t]
instance Encode a => Encode [a] where
sdecode [] = error "Unexpected end of stream"
sdecode (T0:xs) = (xs, [])
sdecode (T1:xs) = let (x0, a) = sdecode xs in (x0, [a])
sdecode (T2:T2:xs) = let (x0, a) = sdecode xs :: DR Int in get [] (a+2) x0 where
get r 0 x = (x, r)
get r k x | k > 0 = let (xn, e) = sdecode x in get (r ++ e) (k-1) xn
sdecode = do
i <- getTrit
case i of
T0 -> return []
T1 -> sdecode >>= (\x -> return [x])
T2 -> do
i <- getTrit
case i of
T2 -> do
n <- sdecode :: DR Int
replicateM (n+2) sdecode
_ -> fail "Unexpected end of stream"
sencode [] = [T0]
sencode [x] = T1:sencode x
sencode xs = (sencode $ length xs - 2) ++ concat (map sencode xs)
instance Encode Int where
sdecode xs = let (x0, i) = sdecode xs :: DR Integer in (x0, fromIntegral i)
sdecode = do
n <- sdecode :: DR Integer
return $ fromIntegral n
sencode i = sencode (fromIntegral i :: Integer)
instance Encode Integer where
sdecode xs = let (x0, digits) = sdecode xs :: DR [Trit] in
let sum = decodeTern digits in (x0, (3^(length digits - 1) `div` 2) + sum)
sdecode = do
digits <- sdecode :: DR [Trit]
return $ decodeTern digits + (3^(length digits - 1) `div` 2)
sencode n
| n < 0 = error "Can't encode negative numbers"
| n == 0 = [0]
@ -100,11 +125,17 @@ instance Encode Integer where
log3 n = (head $ filter (\len -> n < base len) [0..]) - 1
instance (Encode a, Encode z) => Encode (a, z) where
sdecode xs = let (x0, a) = sdecode xs in let (x1, z) = sdecode x0 in (x1, (a, z))
sdecode = do
a <- sdecode
z <- sdecode
return (a, z)
sencode (a, z) = sencode a ++ sencode z
instance (Encode (a, b), Encode z) => Encode (a, b, z) where
sdecode xs = let (x0, (a, b)) = sdecode xs in let (x1, z) = sdecode x0 in (x1, (a, b, z))
sdecode = do
(a, b) <- sdecode
z <- sdecode
return (a, b, z)
sencode (a, b, z) = sencode (a, b) ++ sencode z
decodeTern :: Integral i => [Trit] -> i
@ -115,6 +146,3 @@ decodeTern digits = dec 0 digits where
encodeTern :: Integral i => Int -> i -> [Trit]
encodeTern 0 0 = []
encodeTern k x = (encodeTern (k-1) (x `div` 3)) ++ [toTrit $ fromIntegral (x `mod` 3)]
-- cartanks :: Car -> Nat
-- cartanks = (1+) . maximum . concat . map (\(upper, _, lower) -> upper ++ lower)

Loading…
Cancel
Save