WC3 rev check

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
module Main where

import Text.Parsec
import Text.Parsec.String
import qualified Text.Parsec.Token as P
import Text.Parsec.Language (emptyDef)
import Data.Bits
import Data.List (foldl1', foldl')
import Data.Char (digitToInt)
import Control.Applicative ((<$>))
import Control.Monad
import Text.Show.Functions

lexer = P.makeTokenParser emptyDef
float = P.float lexer

nat = foldl' (\a i -> a * 10 + digitToInt i) 0 <$> many1 digit

type Quad = (Int, Int, Int, Int)

assign :: Char -> Parser Int
assign x = do { char x
              ; char '='
              ; val <- nat
              ; spaces
              ; return val}

triple :: Parser (Int, Int, Int)
triple = do { a <- assign 'A'
            ; b <- assign 'B'
            ; c <- assign 'C'
            ; return (a, b, c)}

oper :: Char -> Int -> Int -> Int
oper '+' = (+)
oper '*' = (*)
oper '-' = (-)
oper '^' = xor
oper '|' = (.|.)
oper '&' = (.&.)

getV :: Char -> Quad -> Int
getV 'A' (a, b, c, s) = a
getV 'B' (a, b, c, s) = b
getV 'C' (a, b, c, s) = c
getV 'S' (a, b, c, s) = s

upd :: Char -> Int -> Quad -> Quad
upd 'A' fn (a, b, c, d) = (fn, b, c, d)
upd 'B' fn (a, b, c, d) = (a, fn, c, d)
upd 'C' fn (a, b, c, d) = (a, b, fn, d)
upd 'S' fn (a, b, c, d) = (a, b, c, fn)

app :: Char -> Char -> Char -> Char -> Quad -> Quad
app toVal lval rval op quad = upd toVal (oper op (getV lval quad) (getV rval quad)) quad

parseOp :: Parser (Quad -> Quad)
parseOp = do { toval <- oneOf "ABCS"
             ; char '='
             ; lval <- oneOf "ABCS"
             ; op <- oneOf "+*-^|&"
             ; rval <- oneOf "ABCS"
             ; spaces
             ; return $ app toval lval rval op}

makeFun :: Parser (Int -> Quad)
makeFun = do { (a, b, c) <- triple
             ; n <- nat
             ; spaces
             ; funs <- count n parseOp
             ; let singleFun = foldl1' (flip (.)) funs
             ; return (\s -> singleFun (a, b, c, s))}

challenge =   "A=443747131 B=3328179921 C=1040998290 4 A=A^S B=B-C C=C^A A=A+B"

main = case parse makeFun "" challenge of
        Left err -> do print "Error,"
                       print err
        Right fn -> print $ fn 4