never executed always true always false

    1 {-|
    2 Module:      Y2015.D07
    3 Description: Advent of Code Day 07 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the day 07 set of problems for <adventofcode.com>.
    8 -}
    9 
   10 module Y2015.D07
   11     ( wire
   12     , circuitParser
   13     , parseCircuits
   14     , override
   15 ) where
   16 
   17 import Y2015.Util (regularParse, intParser)
   18 
   19 import           Control.Applicative   ((<|>))
   20 import           Data.Bits             ((.&.), (.|.), shift, complement)
   21 import           Data.Function.Memoize (memoize)
   22 import           Data.Map.Strict       (Map)
   23 import qualified Data.Map.Strict  as   M
   24 import           Data.Word             (Word16)
   25 import           Text.Parsec.Char      (digit, letter, endOfLine)
   26 import           Text.Parsec.String    (Parser)
   27 import           Text.Parsec
   28     ( lookAhead
   29     , many
   30     , many1
   31     , optional
   32     , skipMany
   33     , skipMany1
   34     , space
   35     , string
   36     , try)
   37 
   38 type Wire = String
   39 
   40 data Atom = Val Word16 | Var String
   41           deriving (Show)
   42 
   43 data Gate = Singleton Atom
   44           | And       Atom Atom
   45           | Or        Atom Atom
   46           | LShift    Atom Int
   47           | RShift    Atom Int
   48           | Not       Atom
   49           deriving (Show)
   50 
   51 data Instruction = Instruction Gate Wire
   52                  deriving (Show)
   53 
   54 -- |Parsec parser for list of 'Instruction's
   55 circuitParser :: Parser [Instruction] -- ^ Parser
   56 circuitParser = many (pInstruction <* optional endOfLine)
   57 
   58 pInstruction :: Parser Instruction
   59 pInstruction = Instruction <$> pGate <*> pWire
   60 
   61 pGate :: Parser Gate
   62 pGate =  try (Singleton <$> atom <* lookAhead arrow)
   63      <|> try (And       <$> atom <* gate "AND"    <*> atom)
   64      <|> try (Or        <$> atom <* gate "OR"     <*> atom)
   65      <|> try (LShift    <$> atom <* gate "LSHIFT" <*> bits)
   66      <|> try (RShift    <$> atom <* gate "RSHIFT" <*> bits)
   67      <|> try (Not       <$          gate "NOT"    <*> atom)
   68 
   69 pWire :: Parser Wire
   70 pWire = arrow *> many1 letter
   71 
   72 gate :: String -> Parser ()
   73 gate s = skipMany space *> string s *> skipMany1 space
   74 
   75 bits :: Parser Int
   76 bits = intParser
   77 
   78 atom :: Parser Atom
   79 atom =  try (Var <$> many1 letter)
   80     <|> try (Val .read <$> many1 digit)
   81 
   82 arrow :: Parser ()
   83 arrow = skipMany1 space *> string "->" *> skipMany1 space
   84 
   85 voltageOn :: Map String Gate -> String -> Word16
   86 voltageOn m = resolve
   87     where eval :: String -> Word16
   88           eval wire' = case M.lookup wire' m of
   89                        Just (Singleton x) -> atom' x
   90                        Just (And x y)     -> atom' x .&. atom' y
   91                        Just (Or x y)      -> atom' x .|. atom' y
   92                        Just (LShift x i)  -> shift (atom' x) i
   93                        Just (RShift x i)  -> shift (atom' x) (-i)
   94                        Just (Not x)       -> complement (atom' x)
   95                        Nothing            -> 0
   96           resolve = memoize eval
   97           atom' (Val i) = i
   98           atom' (Var v) = resolve v
   99 
  100 -- |Constructs then returns resulting voltage from wiring spec
  101 wire :: String        -- ^ Wire to find voltage on
  102      -> [Instruction] -- ^ List of instructions
  103      -> Word16        -- ^ Resulting voltage on indicated wire
  104 wire s = flip voltageOn s . M.fromList . map toPair
  105     where toPair (Instruction g w) = (w, g)
  106 
  107 -- |Helper function to parse 'Instruction's
  108 parseCircuits :: String                            -- ^ Input string
  109               -> [Instruction] -- ^ Either parse error or 'Instruction's
  110 parseCircuits = either err suc . regularParse circuitParser
  111   where err = error . show
  112         suc r = r
  113 
  114 -- |Inject a manual instruction.
  115 override :: Word16      -- ^ Value to inject into 'Instruction'.
  116          -> Instruction -- ^ Resulting 'Instruction'.
  117 override s = Instruction (Singleton (Val s)) "b"