1 files changed, 54 insertions, 0 deletions
diff --git a/2017/23.hs b/2017/23.hs
new file mode 100644
index 0000000..cd962f6
--- /dev/null
+++ b/2017/23.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE BangPatterns #-}
+import Control.Monad
+import Data.Char
+import qualified Data.Map.Strict as Map
+import Data.Map.Strict ((!))
+import Debug.Trace
+
+
+data Ref = Reg Int | Const Int
+  deriving Show
+
+data Ins = Set Int Ref | Sub Int Ref | Mul Int Ref | Jnz Ref Ref
+  deriving Show
+
+parse :: String -> Ins
+parse str = case words str of
+    ["set", x, y] -> Set (preg x) (pref y)
+    ["sub", x, y] -> Sub (preg x) (pref y)
+    ["mul", x, y] -> Mul (preg x) (pref y)
+    ["jnz", x, y] -> Jnz (pref x) (pref y)
+  where
+    pref s = if isAlpha (head s) then Reg (preg s) else Const (read s)
+    preg [c] = ord c - ord 'a'
+
+run :: [Ins] -> Int
+run program = go 0 0 (Map.fromList [(i, 0) | i <- [0..7]])
+  where
+    proglen :: Int
+    proglen = length program
+
+    go :: Int -> Int -> Map.Map Int Int -> Int
+    go !idx !count _ | idx < 0 || idx >= proglen = count
+    go !idx !count !regs = case program !! idx of
+        Set reg ref -> go (succ idx) count (Map.insert reg (getref ref regs) regs)
+        Sub reg ref -> go (succ idx) count (Map.insert reg (regs ! reg - getref ref regs) regs)
+        Mul reg ref -> go (succ idx) (succ count) (Map.insert reg (regs ! reg * getref ref regs) regs)
+        Jnz (Const 0) ref -> go (succ idx) count regs
+        Jnz (Const _) ref -> go (idx + getref ref regs) count regs
+        Jnz (Reg r) ref -> go (idx + if regs ! r == 0 then 1 else getref ref regs) count regs
+
+    getref :: Ref -> Map.Map Int Int -> Int
+    getref (Const i) _ = i
+    getref (Reg r) regs = regs ! r
+
+isprime :: Int -> Bool
+isprime n =
+    let s = floor (sqrt (fromIntegral n))
+    in not . null $ filter (\d -> n `rem` d == 0) [2..s]
+
+main :: IO ()
+main = do
+    program <- liftM (map parse . lines) (readFile "23.in")
+    print $ run program
+    print $ sum $ map (fromEnum . isprime) [106700, 106717 .. 123700]