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 |