summaryrefslogtreecommitdiff
path: root/2015/day07.hs
blob: 215355f549ca84e1f5f0b93cb5403abf4fa7cf66 (plain)
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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
module Main where

import Data.Char
import Data.List
import Control.Monad
import Data.Bits
import Data.Word
import qualified Data.Map as Map
import qualified Data.Set as Set

type Inttype = Word16

data Literal = LNum Inttype | LName String

data Command = Immediate Literal |
               Monadic (Inttype -> Inttype) Literal |
               Dyadic (Inttype -> Inttype -> Inttype) Literal Literal

type Statement = (Command,String)

type Cache = Map.Map String Inttype

complement16 :: Inttype -> Inttype
complement16 i = i `xor` 0xffff

shiftL16 :: Inttype -> Int -> Inttype
shiftL16 i n = (shiftL i n) .&. 0xffff

shiftR16 :: Inttype -> Int -> Inttype
shiftR16 i n = (shiftR i n) .&. 0xffff

parseLit :: String -> Literal
parseLit s = if isDigit (head s) then LNum (read s) else LName s

parse :: [String] -> Statement
parse l = (parse' (init $ init $ l),last l)

parse' :: [String] -> Command
parse' [n] = Immediate (parseLit n)
parse' ["NOT",n] = Monadic complement16 (parseLit n)
parse' [a,"AND",b] = Dyadic (.&.) (parseLit a) (parseLit b)
parse' [a,"OR",b] = Dyadic (.|.) (parseLit a) (parseLit b)
parse' [a,"LSHIFT",b] = Dyadic (\i n -> shiftL16 i (fromIntegral n)) (parseLit a) (parseLit b)
parse' [a,"RSHIFT",b] = Dyadic (\i n -> shiftR16 i (fromIntegral n)) (parseLit a) (parseLit b)

collectOutputs :: [Statement] -> [String]
collectOutputs stmts = Set.toList $ collectOutputs' stmts Set.empty

collectOutputs' :: [Statement] -> Set.Set String -> Set.Set String
collectOutputs' [] set = set
collectOutputs' ((_,target):ss) set = collectOutputs' ss $ Set.insert target set

neededBy :: String -> Command -> Bool
neededBy n (Immediate l) = case l of
    LNum _ -> False
    LName ln -> n == ln
neededBy n (Monadic _ l) = case l of
    LNum _ -> False
    LName ln -> n == ln
neededBy n (Dyadic _ (LNum _) b) = case b of
    LNum _ -> False
    LName bn -> n == bn
neededBy n (Dyadic _ (LName an) b) = case b of
    LNum _ -> n == an
    LName bn -> n == an || n == bn

leaves :: [Statement] -> [String]
leaves stmts = leaves' (map fst stmts) (collectOutputs stmts)

leaves' :: [Command] -> [String] -> [String]
leaves' _ [] = []
leaves' cmds (o:os) = if any (neededBy o) cmds then leaves' cmds os else o:leaves' cmds os

getValue :: String -> [Statement] -> Cache -> (Inttype,Cache)
getValue nm stmts cc = getValue' nm stmts stmts cc

getValue' :: String -> [Statement] -> [Statement] -> Cache -> (Inttype,Cache)
getValue' nm [] _ cc = case Map.lookup nm cc of
    Nothing -> undefined
    Just i -> (i,cc)
getValue' nm ((cmd,target):ss) stmts cc = case Map.lookup nm cc of
    Nothing -> if nm == target then execCmd cmd stmts cc else getValue' nm ss stmts cc
    Just i -> (i,cc)

resolveLit :: Literal -> [Statement] -> Cache -> (Inttype,Cache)
resolveLit (LNum i) _ cc = (i,cc)
resolveLit (LName n) stmts cc = (value,Map.insert n value cc2)
    where (value,cc2) = getValue n stmts cc

execCmd :: Command -> [Statement] -> Cache -> (Inttype,Cache)
execCmd (Immediate l) stmts cc = resolveLit l stmts cc
execCmd (Monadic f l) stmts cc = (f resl,cc2)
    where (resl,cc2) = resolveLit l stmts cc
execCmd (Dyadic f a b) stmts cc = (f resa resb,cc3)
    where (resa,cc2) = resolveLit a stmts cc
          (resb,cc3) = resolveLit b stmts cc2

day7 :: IO ()
day7 = do
    input <- readFile "input.txt"
    let stmts = [parse (words l) | l <- (lines input)]
    let lvs = leaves stmts
    print lvs
    print [fst $ getValue lv stmts Map.empty | lv <- lvs]

main = day7