https://math.stackexchange.com/a/4926755

main.hs

module Main where

type Lit = Int

data Expr
    = And Expr Expr
    | Xor Expr Expr
    | Add Expr Expr
    | Zero
    | Unit
    | Lit Lit
    deriving (Eq, Ord, Show)

cond :: Int -> Bool
cond l = go where
    xor :: Bool -> Bool -> Bool
    True `xor` True = False
    True `xor` False = True
    False `xor` True = True
    False `xor` False = False
    evalExpr :: (Lit -> Bool) -> Expr -> Bool
    evalExpr env (And e1 e2) = evalExpr env e1 && evalExpr env e2
    evalExpr env (Xor e1 e2) = evalExpr env e1 `xor` evalExpr env e2
    evalExpr env (Add e1 e2) = evalExpr env e1 || evalExpr env e2
    evalExpr env (Zero) = False
    evalExpr env (Unit) = True
    evalExpr env (Lit i) = env i
    mkEnv :: Int -> [Lit -> Bool]
    mkEnv 0 = return $ \i -> False
    mkEnv n = do
        let n' = pred n
        env <- mkEnv n'
        b <- [True, False]
        return $ \i -> if i == n' then b else env i
    go :: Bool
    go = xors [ evalExpr env (And (Lit 0) (Lit 1)) | env <- mkEnv 2, env 0 /= env 1 ]
    xors :: [Bool] -> Bool
    xors = foldr xor False

goal :: Int -> Bool
goal l = go where
    xor :: Bool -> Bool -> Bool
    True `xor` True = False
    True `xor` False = True
    False `xor` True = True
    False `xor` False = False
    evalExpr :: (Lit -> Bool) -> Expr -> Bool
    evalExpr env (And e1 e2) = evalExpr env e1 && evalExpr env e2
    evalExpr env (Xor e1 e2) = evalExpr env e1 `xor` evalExpr env e2
    evalExpr env (Add e1 e2) = evalExpr env e1 || evalExpr env e2
    evalExpr env (Zero) = False
    evalExpr env (Unit) = True
    evalExpr env (Lit i) = env i
    mkEnv :: Int -> [Lit -> Bool]
    mkEnv 0 = return $ \i -> False
    mkEnv n = do
        let n' = pred n
        env <- mkEnv n'
        b <- [True, False]
        return $ \i -> if i == n' then b else env i
    go :: Bool
    go = and [ evalExpr env (And (Lit 0) (Lit 1)) | env <- mkEnv 2, env 0 /= env 1 ]

main :: IO ()
main = print [cond 5, cond 6, test 5, test 6]