Moved Intcode interpreter into a separate module, ensured all previous days still... intcode-module
authorNeil Smith <neil.git@njae.me.uk>
Mon, 9 Dec 2019 19:45:37 +0000 (19:45 +0000)
committerNeil Smith <neil.git@njae.me.uk>
Mon, 9 Dec 2019 19:45:37 +0000 (19:45 +0000)
12 files changed:
advent02/package.yaml
advent02/src/advent02.hs
advent05/package.yaml
advent05/src/advent05.hs
advent05/src/advent05rws.hs [deleted file]
advent07/package.yaml
advent07/src/advent07.hs
advent09/package.yaml
advent09/src/advent09.hs
intcode/package.yaml [new file with mode: 0644]
intcode/src/Intcode.hs [new file with mode: 0644]
stack.yaml

index e77a633..b080b0b 100644 (file)
@@ -56,6 +56,5 @@ executables:
     dependencies:
     - base >= 2 && < 6
     - text
-    - megaparsec
+    - intcode
     - containers
-    - mtl
index 6eddc0a..1c127f7 100644 (file)
@@ -1,36 +1,15 @@
--- Some code taken from [AoC 2017 day 5](https://adventofcode.com/2017/day/5), 
---    and some from [AoC 2018 day 21](https://adventofcode.com/2018/day/21)
 
-import Data.Text (Text)
 import qualified Data.Text.IO as TIO
 
-import Data.Void (Void)
-
-import Text.Megaparsec hiding (State)
-import Text.Megaparsec.Char
-import qualified Text.Megaparsec.Char.Lexer as L
-import qualified Control.Applicative as CA
-
-import Control.Monad (unless)
-import Control.Monad.State.Strict
-
-import qualified Data.IntMap.Strict as M
-import Data.IntMap.Strict ((!))
-
-type Memory = M.IntMap Int
-
-data Machine = Machine { _memory :: Memory
-                       , _ip :: Int
-                       } 
-               deriving (Show, Eq)
-
-type ProgrammedMachine = State Machine ()
+import Intcode
 
+import qualified Data.Map as M
+import Data.Map ((!))
 
 main :: IO ()
 main = do 
         text <- TIO.readFile "data/advent02.txt"
-        let mem = successfulParse text
+        let mem = parseMachineMemory text
         let machine = makeMachine mem
         print $ part1 machine
         print $ part2 machine
@@ -49,74 +28,14 @@ part2 machine = noun * 100 + verb
                                           nounVerbResult n v machine == part2Target ]
 
 
-makeMachine :: [Int] -> Machine
-makeMachine memory = Machine {_ip = 0, _memory = M.fromList $ zip [0..] memory}
+nounVerbResult :: Integer -> Integer -> Machine -> Integer
+nounVerbResult noun verb machine = machineOutput machine'
+    where   (_, machine', _) = runMachine [] nvMachine
+            nvMachine = machineNounVerb machine noun verb
 
-nounVerbResult :: Int -> Int -> Machine -> Int
-nounVerbResult noun verb machine = machineOutput nvMachine
-    where nvMachine0 = machineNounVerb machine noun verb
-          nvMachine = execState runAll nvMachine0
-
-machineNounVerb :: Machine -> Int -> Int -> Machine
+machineNounVerb :: Machine -> Integer -> Integer -> Machine
 machineNounVerb machine noun verb = machine { _memory = M.insert 1 noun $ M.insert 2 verb $ _memory machine }
 
-machineOutput :: Machine -> Int
+machineOutput :: Machine -> Integer
 machineOutput machine = (_memory machine)!0
 
-
-runAll :: ProgrammedMachine
-runAll = do m0 <- get
-            unless (lkup (_ip m0) (_memory m0) == 99)
-                do runStep
-                   runAll
-
-runStep :: ProgrammedMachine
-runStep = 
-    do m0 <- get
-       let mem = _memory m0
-       let ip = _ip m0
-       let (mem', ip') = perform (mem!ip) ip mem
-       put m0 {_ip = ip', _memory = mem'}
-
-perform :: Int -> Int -> Memory -> (Memory, Int)
-perform 1 ip mem = (iInsert (ip + 3) (a + b) mem, ip + 4)
-    where a = mem!>(ip + 1)
-          b = mem!>(ip + 2)
-perform 2 ip mem = (iInsert (ip + 3) (a * b) mem, ip + 4)
-    where a = mem!>(ip + 1)
-          b = mem!>(ip + 2)
-
-
--- Some IntMap utility functions, for syntactic sugar
-
--- prefix version of (!)
-lkup k m = m!k
-
--- indirect lookup
-(!>) m k = m!(m!k)
-
--- indirect insert
-iInsert k v m = M.insert (m!k) v m
-
-
-
--- Parse the input file
-type Parser = Parsec Void Text
-
-sc :: Parser ()
-sc = L.space (skipSome spaceChar) CA.empty CA.empty
--- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
-
-lexeme  = L.lexeme sc
-integer = lexeme L.decimal
--- signedInteger = L.signed sc integer
-symb = L.symbol sc
-comma = symb ","
-
-memoryP = integer `sepBy` comma
-
-successfulParse :: Text -> [Int]
-successfulParse input = 
-        case parse memoryP "input" input of
-                Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
-                Right memory -> memory
\ No newline at end of file
index 20dde11..768fc18 100644 (file)
@@ -56,16 +56,4 @@ executables:
     dependencies:
     - base >= 2 && < 6
     - text
-    - megaparsec
-    - containers
-    - mtl
-
-  advent05rws:
-    main: advent05rws.hs
-    source-dirs: src
-    dependencies:
-    - base >= 2 && < 6
-    - text
-    - megaparsec
-    - containers
-    - mtl
+    - intcode
index 2368edb..5b76b30 100644 (file)
-import Debug.Trace
 
-import Data.Text (Text)
 import qualified Data.Text.IO as TIO
 
-import Data.Void (Void)
-
-import Text.Megaparsec hiding (State)
-import Text.Megaparsec.Char
-import qualified Text.Megaparsec.Char.Lexer as L
-import qualified Control.Applicative as CA
-
-import Control.Monad (unless)
-import Control.Monad.State.Strict
-import Control.Monad.Reader
-import Control.Monad.Writer
-
-import qualified Data.IntMap.Strict as M
-import Data.IntMap.Strict ((!))
-import Data.List
-
-type Memory = M.IntMap Int
-
-data Machine = Machine { _memory :: Memory
-                       , _ip :: Int
-                       , _inputIndex :: Int
-                       } 
-               deriving (Show, Eq)
-
-type ProgrammedMachine = WriterT [Int] (ReaderT ([Int]) (State Machine)) ()
-
-data ParameterMode = Position | Immediate deriving (Ord, Eq, Show)
+import Intcode
 
 
 main :: IO ()
 main = do 
         text <- TIO.readFile "data/advent05.txt"
-        let mem = successfulParse text
+        let mem = parseMachineMemory text
         print $ findMachineOutput [1] mem
         print $ findMachineOutput [5] mem
 
 
 findMachineOutput inputs program = last output
-    where   finalStack = 
-                runState (
-                    runReaderT (
-                        runWriterT runAll
-                               ) 
-                        inputs
-                         ) 
-                         (makeMachine program)
-            ((_retval, output), _machine) = finalStack
-
-makeMachine :: [Int] -> Machine
-makeMachine memory = Machine    {_ip = 0, _inputIndex = 0
-                                , _memory = M.fromList $ zip [0..] memory
-                                }
-
-
-runAll :: ProgrammedMachine
-runAll = do mem <- gets _memory
-            ip <- gets _ip
-            unless (mem!ip == 99)
-                do runStep
-                   runAll
-
-runStep :: ProgrammedMachine
-runStep = 
-    do mem <- gets _memory
-       ip <- gets _ip
-       let opcode = (mem!ip) `mod` 100
-       let modes = parameterModes ((mem!ip) `div` 100)
-       fetchInput opcode
-       putOutput opcode modes
-       mem' <- gets _memory
-       let (mem'', ip') = perform opcode ip modes mem'
-       modify (\m -> m {_ip = ip', _memory = mem''})
-
-
--- fetchInput opcode | trace ("Input with opcode " ++ show opcode) False = undefined
-fetchInput 3 =
-    do mem <- gets _memory
-       ip <- gets _ip
-       inputIndex <- gets _inputIndex
-       inputs <- ask 
-       let mem' = iInsert (ip + 1) (inputs!!inputIndex) mem
-       modify (\m -> m {_inputIndex = inputIndex + 1, _memory = mem'})
-fetchInput _ = return ()
-
-
--- putOutput opcode _modes | trace ("Output with opcode " ++ show opcode) False = undefined
-putOutput 4 modes =
-    do mem <- gets _memory
-       ip <- gets _ip
-       let v = getMemoryValue (ip + 1) (modes!!0) mem
-       tell [v]
-putOutput _ _ = return ()       
-
-
-perform :: Int -> Int -> [ParameterMode] -> Memory -> (Memory, Int)
--- perform instr ip modes mem | trace ("Perform ip " ++ show ip ++ " opcode " ++ show instr ++ " modes " ++ (show (take 3 modes)) ++ " args " ++ (intercalate ", " (map show [(mem!(ip+1)), (mem!(ip+2)), (mem!(ip+3))]))) False = undefined
-perform 1 ip modes mem = (iInsert (ip + 3) (a + b) mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-perform 2 ip modes mem = (iInsert (ip + 3) (a * b) mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-perform 3 ip _ mem = (mem, ip + 2)
-perform 4 ip _ mem = (mem, ip + 2)
-perform 5 ip modes mem = (mem, ip')
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          ip' = if a /= 0 then b else ip + 3
-perform 6 ip modes mem = (mem, ip')
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          ip' = if a == 0 then b else ip + 3
-perform 7 ip modes mem = (iInsert (ip + 3) res mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          res = if a < b then 1 else 0
-perform 8 ip modes mem = (iInsert (ip + 3) res mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          res = if a == b then 1 else 0
-perform _ ip _ mem = (mem, ip)
-
-
-getMemoryValue loc Position mem = mem!>loc
-getMemoryValue loc Immediate mem = mem!loc
-
-
-parameterModes :: Int -> [ParameterMode]
-parameterModes modeCode = unfoldr generateMode modeCode
-
-generateMode :: Int -> Maybe (ParameterMode, Int)
-generateMode modeCode = Just (mode, modeCode `div` 10)
-    where mode = case (modeCode `mod` 10) of 
-                    0 -> Position
-                    1 -> Immediate
-
-
--- Some IntMap utility functions, for syntactic sugar
-
--- prefix version of (!)
-lkup k m = m!k
-
--- indirect lookup
-(!>) m k = m!(m!k)
-
--- indirect insert
-iInsert k v m = M.insert (m!k) v m
-
-
-
--- Parse the input file
-type Parser = Parsec Void Text
-
-sc :: Parser ()
-sc = L.space (skipSome spaceChar) CA.empty CA.empty
--- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
-
-lexeme  = L.lexeme sc
-integer = lexeme L.decimal
-signedInteger = L.signed sc integer
-symb = L.symbol sc
-comma = symb ","
-
-memoryP = signedInteger `sepBy` comma
-
-successfulParse :: Text -> [Int]
-successfulParse input = 
-        case parse memoryP "input" input of
-                Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
-                Right memory -> memory
\ No newline at end of file
+    where (_, _, output) = runProgram inputs program
diff --git a/advent05/src/advent05rws.hs b/advent05/src/advent05rws.hs
deleted file mode 100644 (file)
index b82bbf7..0000000
+++ /dev/null
@@ -1,170 +0,0 @@
-import Debug.Trace
-
-import Data.Text (Text)
-import qualified Data.Text.IO as TIO
-
-import Data.Void (Void)
-
-import Text.Megaparsec hiding (State)
-import Text.Megaparsec.Char
-import qualified Text.Megaparsec.Char.Lexer as L
-import qualified Control.Applicative as CA
-
-import Control.Monad (unless)
-import Control.Monad.State.Strict
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Monad.RWS.Strict
-
-
-import qualified Data.IntMap.Strict as M
-import Data.IntMap.Strict ((!))
-import Data.List
-
-type Memory = M.IntMap Int
-
-data Machine = Machine { _memory :: Memory
-                       , _ip :: Int
-                       , _inputIndex :: Int
-                       } 
-               deriving (Show, Eq)
-
-type ProgrammedMachine = RWS [Int] [Int] Machine ()
-
-data ParameterMode = Position | Immediate deriving (Ord, Eq, Show)
-
-
-main :: IO ()
-main = do 
-        text <- TIO.readFile "data/advent05.txt"
-        let mem = successfulParse text
-        print $ findMachineOutput [1] mem
-        print $ findMachineOutput [5] mem
-
-findMachineOutput :: [Int] -> [Int] -> Int
-findMachineOutput inputs program = last output
-    where (_machine, output) = execRWS runAll inputs (makeMachine program)
-
-
-makeMachine :: [Int] -> Machine
-makeMachine memory = Machine    {_ip = 0, _inputIndex = 0
-                                , _memory = M.fromList $ zip [0..] memory
-                                }
-
-
-runAll :: ProgrammedMachine
-runAll = do mem <- gets _memory
-            ip <- gets _ip
-            unless (mem!ip == 99)
-                do runStep
-                   runAll
-
-runStep :: ProgrammedMachine
-runStep = 
-    do mem <- gets _memory
-       ip <- gets _ip
-       let opcode = (mem!ip) `mod` 100
-       let modes = parameterModes ((mem!ip) `div` 100)
-       fetchInput opcode
-       putOutput opcode modes
-       mem' <- gets _memory
-       let (mem'', ip') = perform opcode ip modes mem'
-       modify (\m -> m {_ip = ip', _memory = mem''})
-
-
--- fetchInput opcode | trace ("Input with opcode " ++ show opcode) False = undefined
-fetchInput 3 =
-    do mem <- gets _memory
-       ip <- gets _ip
-       inputIndex <- gets _inputIndex
-       inputs <- ask 
-       let mem' = iInsert (ip + 1) (inputs!!inputIndex) mem
-       modify (\m -> m {_inputIndex = inputIndex + 1, _memory = mem'})
-fetchInput _ = return ()
-
-
--- putOutput opcode _modes | trace ("Output with opcode " ++ show opcode) False = undefined
-putOutput 4 modes =
-    do mem <- gets _memory
-       ip <- gets _ip
-       let v = getMemoryValue (ip + 1) (modes!!0) mem
-       tell [v]
-putOutput _ _ = return ()       
-
-
-perform :: Int -> Int -> [ParameterMode] -> Memory -> (Memory, Int)
--- perform instr ip modes mem | trace ("Perform ip " ++ show ip ++ " opcode " ++ show instr ++ " modes " ++ (show (take 3 modes)) ++ " args " ++ (intercalate ", " (map show [(mem!(ip+1)), (mem!(ip+2)), (mem!(ip+3))]))) False = undefined
-perform 1 ip modes mem = (iInsert (ip + 3) (a + b) mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-perform 2 ip modes mem = (iInsert (ip + 3) (a * b) mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-perform 3 ip _ mem = (mem, ip + 2)
-perform 4 ip _ mem = (mem, ip + 2)
-perform 5 ip modes mem = (mem, ip')
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          ip' = if a /= 0 then b else ip + 3
-perform 6 ip modes mem = (mem, ip')
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          ip' = if a == 0 then b else ip + 3
-perform 7 ip modes mem = (iInsert (ip + 3) res mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          res = if a < b then 1 else 0
-perform 8 ip modes mem = (iInsert (ip + 3) res mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          res = if a == b then 1 else 0
-perform _ ip _ mem = (mem, ip)
-
-
-getMemoryValue loc Position mem = mem!>loc
-getMemoryValue loc Immediate mem = mem!loc
-
-
-parameterModes :: Int -> [ParameterMode]
-parameterModes modeCode = unfoldr generateMode modeCode
-
-generateMode :: Int -> Maybe (ParameterMode, Int)
-generateMode modeCode = Just (mode, modeCode `div` 10)
-    where mode = case (modeCode `mod` 10) of 
-                    0 -> Position
-                    1 -> Immediate
-
-
--- Some IntMap utility functions, for syntactic sugar
-
--- prefix version of (!)
-lkup k m = m!k
-
--- indirect lookup
-(!>) m k = m!(m!k)
-
--- indirect insert
-iInsert k v m = M.insert (m!k) v m
-
-
-
--- Parse the input file
-type Parser = Parsec Void Text
-
-sc :: Parser ()
-sc = L.space (skipSome spaceChar) CA.empty CA.empty
--- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
-
-lexeme  = L.lexeme sc
-integer = lexeme L.decimal
-signedInteger = L.signed sc integer
-symb = L.symbol sc
-comma = symb ","
-
-memoryP = signedInteger `sepBy` comma
-
-successfulParse :: Text -> [Int]
-successfulParse input = 
-        case parse memoryP "input" input of
-                Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
-                Right memory -> memory
\ No newline at end of file
index 18d6c87..bfc3e3f 100644 (file)
@@ -56,6 +56,5 @@ executables:
     dependencies:
     - base >= 2 && < 6
     - text
-    - megaparsec
     - containers
-    - mtl
+    - intcode
index 27c7875..d359780 100644 (file)
@@ -1,56 +1,30 @@
 import Debug.Trace
 
-import Data.Text (Text)
-import qualified Data.Text.IO as TIO
-
-import Data.Void (Void)
-
-import Text.Megaparsec hiding (State)
-import Text.Megaparsec.Char
-import qualified Text.Megaparsec.Char.Lexer as L
-import qualified Control.Applicative as CA
-
-import Control.Monad (unless)
-import Control.Monad.State.Strict
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Monad.RWS.Strict
+import Intcode
 
+import qualified Data.Text.IO as TIO
 
 import qualified Data.IntMap.Strict as M
 import Data.IntMap.Strict ((!))
 import Data.List
 import Data.Function (on)
 
-type Memory = M.IntMap Int
-
-data Machine = Machine { _memory :: Memory
-                       , _ip :: Int
-                       , _inputIndex :: Int
-                       } 
-               deriving (Show, Eq)
-
-type ProgrammedMachine = RWS [Int] [Int] Machine
 
 data EncapsulatedMacine = EncapsulatedMacine 
     { _machine :: Machine
     , _executionState :: ExecutionState
-    , _initialInput :: [Int]
-    , _currentInput :: [Int]
-    , _machineOutput :: [Int]
+    , _initialInput :: [Integer]
+    , _currentInput :: [Integer]
+    , _machineOutput :: [Integer]
     } deriving (Show, Eq)
 
-data ParameterMode = Position | Immediate deriving (Ord, Eq, Show)
-
-data ExecutionState = Runnable | Blocked | Terminated  deriving (Ord, Eq, Show)
-
 type Pipeline = M.IntMap EncapsulatedMacine
 
 
 main :: IO ()
 main = do 
         text <- TIO.readFile "data/advent07.txt"
-        let mem = successfulParse text
+        let mem = parseMachineMemory text
         print $ part1 mem
         print $ part2 mem
 
@@ -61,7 +35,8 @@ part1 mem = maximum outputs
 
 chainMachines mem settings = foldl' (chainMachine mem) 0 settings
 
-chainMachine mem prevOutput setting = findMachineOutput [setting, prevOutput] mem
+chainMachine mem prevOutput setting = last output
+    where (_, _, output) = runProgram [setting, prevOutput] mem
 
 
 part2 mem = maximum outputs
@@ -69,14 +44,14 @@ part2 mem = maximum outputs
             pipelines = map (buildPipeline mem) inputs
             outputs = map runPipeline pipelines
 
-buildPipeline :: [Int] -> [Int] -> Pipeline
+buildPipeline :: [Integer] -> [Integer] -> Pipeline
 buildPipeline mem input = M.insert 0 machine0' pipeline
     where pipeline = M.fromList $ zip [0..] $ map (encapsulate mem) input
           machine0 = pipeline!0
           machine0' = machine0 { _initialInput = (_initialInput machine0) ++ [0]}
 
 
-encapsulate :: [Int] -> Int -> EncapsulatedMacine
+encapsulate :: [Integer] -> Integer -> EncapsulatedMacine
 encapsulate mem input = EncapsulatedMacine 
     { _machine = makeMachine mem
     , _executionState = Runnable
@@ -86,7 +61,7 @@ encapsulate mem input = EncapsulatedMacine
     }
 
 
-runPipeline :: Pipeline -> Int
+runPipeline :: Pipeline -> Integer
 -- runPipeline pipeline | trace (pipelineTrace pipeline) False = undefined
 runPipeline pipeline 
     | finished pipeline = last $ _machineOutput $ snd $ M.findMax pipeline
@@ -118,7 +93,6 @@ emTrace e = intercalate " ; " terms
                   , show $ _machineOutput e
                   ]
 
-
 finished :: Pipeline -> Bool
 finished = M.null . runnableMachines
 
@@ -132,140 +106,4 @@ runEncapsulatedMachine e = e { _machine = machine'
                              }
     where   machine = _machine e
             input = _currentInput e
-            (halted, machine', output) = runRWS runAll input machine
-
-
-findMachineOutput :: [Int] -> [Int] -> Int
-findMachineOutput inputs program = last output
-    where (_haltedBecause, _machine, output) = runRWS runAll inputs (makeMachine program)
-
-
-makeMachine :: [Int] -> Machine
-makeMachine memory = Machine    {_ip = 0, _inputIndex = 0
-                                , _memory = M.fromList $ zip [0..] memory
-                                }
-
-
-runAll :: ProgrammedMachine ExecutionState
-runAll = do mem <- gets _memory
-            ip <- gets _ip
-            input <- ask
-            iIndex <- gets _inputIndex
-            let acutalInputLength = length input
-            let requiredInputLength = iIndex + 1
-            if (mem!ip == 99)
-            then return Terminated
-            else    if (mem!ip == 3 && requiredInputLength > acutalInputLength)
-                    then return Blocked
-                    else do runStep
-                            runAll
-
-runStep :: ProgrammedMachine ()
-runStep = 
-    do mem <- gets _memory
-       ip <- gets _ip
-       let opcode = (mem!ip) `mod` 100
-       let modes = parameterModes ((mem!ip) `div` 100)
-       fetchInput opcode
-       putOutput opcode modes
-       mem' <- gets _memory
-       let (mem'', ip') = perform opcode ip modes mem'
-       modify (\m -> m {_ip = ip', _memory = mem''})
-
-fetchInput :: Int -> ProgrammedMachine ()
--- fetchInput opcode | trace ("Input with opcode " ++ show opcode) False = undefined
-fetchInput 3 =
-    do mem <- gets _memory
-       ip <- gets _ip
-       inputIndex <- gets _inputIndex
-       inputs <- ask 
-       let mem' = iInsert (ip + 1) (inputs!!inputIndex) mem
-       modify (\m -> m {_inputIndex = inputIndex + 1, _memory = mem'})
-fetchInput _ = return ()
-
-putOutput :: Int -> [ParameterMode] -> ProgrammedMachine ()
--- putOutput opcode _modes | trace ("Output with opcode " ++ show opcode) False = undefined
-putOutput 4 modes =
-    do mem <- gets _memory
-       ip <- gets _ip
-       let v = getMemoryValue (ip + 1) (modes!!0) mem
-       tell [v]
-putOutput _ _ = return ()       
-
-
-perform :: Int -> Int -> [ParameterMode] -> Memory -> (Memory, Int)
--- perform instr ip modes mem | trace ("Perform ip " ++ show ip ++ " opcode " ++ show instr ++ " modes " ++ (show (take 3 modes)) ++ " args " ++ (intercalate ", " (map show [(mem!(ip+1)), (mem!(ip+2)), (mem!(ip+3))]))) False = undefined
-perform 1 ip modes mem = (iInsert (ip + 3) (a + b) mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-perform 2 ip modes mem = (iInsert (ip + 3) (a * b) mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-perform 3 ip _ mem = (mem, ip + 2)
-perform 4 ip _ mem = (mem, ip + 2)
-perform 5 ip modes mem = (mem, ip')
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          ip' = if a /= 0 then b else ip + 3
-perform 6 ip modes mem = (mem, ip')
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          ip' = if a == 0 then b else ip + 3
-perform 7 ip modes mem = (iInsert (ip + 3) res mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          res = if a < b then 1 else 0
-perform 8 ip modes mem = (iInsert (ip + 3) res mem, ip + 4)
-    where a = getMemoryValue (ip + 1) (modes!!0) mem
-          b = getMemoryValue (ip + 2) (modes!!1) mem
-          res = if a == b then 1 else 0
-perform _ ip _ mem = (mem, ip)
-
-
-getMemoryValue loc Position mem = mem!>loc
-getMemoryValue loc Immediate mem = mem!loc
-
-
-parameterModes :: Int -> [ParameterMode]
-parameterModes modeCode = unfoldr generateMode modeCode
-
-generateMode :: Int -> Maybe (ParameterMode, Int)
-generateMode modeCode = Just (mode, modeCode `div` 10)
-    where mode = case (modeCode `mod` 10) of 
-                    0 -> Position
-                    1 -> Immediate
-
-
--- Some IntMap utility functions, for syntactic sugar
-
--- prefix version of (!)
-lkup k m = m!k
-
--- indirect lookup
-(!>) m k = m!(m!k)
-
--- indirect insert
-iInsert k v m = M.insert (m!k) v m
-
-
-
--- Parse the input file
-type Parser = Parsec Void Text
-
-sc :: Parser ()
-sc = L.space (skipSome spaceChar) CA.empty CA.empty
--- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
-
-lexeme  = L.lexeme sc
-integer = lexeme L.decimal
-signedInteger = L.signed sc integer
-symb = L.symbol sc
-comma = symb ","
-
-memoryP = signedInteger `sepBy` comma
-
-successfulParse :: Text -> [Int]
-successfulParse input = 
-        case parse memoryP "input" input of
-                Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
-                Right memory -> memory
\ No newline at end of file
+            (halted, machine', output) = runMachine input machine
index 6f444ae..814aaab 100644 (file)
@@ -56,6 +56,4 @@ executables:
     dependencies:
     - base >= 2 && < 6
     - text
-    - megaparsec
-    - containers
-    - mtl
+    - intcode
index e8b98a5..6984329 100644 (file)
-import Debug.Trace
+import Intcode
 
-import Data.Text (Text)
+-- import Data.Text (Text)
 import qualified Data.Text.IO as TIO
 
-import Data.Void (Void)
-
-import Text.Megaparsec hiding (State)
-import Text.Megaparsec.Char
-import qualified Text.Megaparsec.Char.Lexer as L
-import qualified Control.Applicative as CA
-
--- import Control.Monad (unless)
-import Control.Monad.State.Strict
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Monad.RWS.Strict
-
-
-import qualified Data.Map.Strict as M
-import Data.Map.Strict ((!))
-import Data.List
--- import Data.Function (on)
-
-type Memory = M.Map Integer Integer
-
-data Machine = Machine { _memory :: Memory
-                       , _ip :: Integer
-                       , _inputIndex :: Int
-                       , _rb :: Integer
-                       } 
-               deriving (Show, Eq)
-
-type ProgrammedMachine = RWS [Integer] [Integer] Machine
-
-data ExecutionState = Runnable | Blocked | Terminated  deriving (Ord, Eq, Show)
-
-data ParameterMode = Position | Immediate | Relative deriving (Ord, Eq, Show)
-
-
 main :: IO ()
 main = do 
         text <- TIO.readFile "data/advent09.txt"
-        let mem = successfulParse text
+        let mem = parseMachineMemory text
         print $ part1 mem
         print $ part2 mem
 
+part1 mem = head output
+    where (_, _, output) = runProgram [1] mem
 
-part1 mem = findMachineOutput [1] mem
-
-part2 mem = findMachineOutput [2] mem
-
-
-findMachineOutput :: [Integer] -> [Integer] -> [Integer]
-findMachineOutput inputs program = output
-    where (_haltedBecause, _machine, output) = runRWS runAll inputs (makeMachine program)
-
-
-makeMachine :: [Integer] -> Machine
-makeMachine memory = Machine    {_ip = 0, _inputIndex = 0, _rb = 0
-                                , _memory = M.fromList $ zip [0..] memory
-                                }
-
-
-runAll :: ProgrammedMachine ExecutionState
-runAll = do mem <- gets _memory
-            ip <- gets _ip
-            input <- ask
-            iIndex <- gets _inputIndex
-            let acutalInputLength = length input
-            let requiredInputLength = iIndex + 1
-            if (mem!ip == 99)
-            then return Terminated
-            else    if (mem!ip == 3 && requiredInputLength > acutalInputLength)
-                    then return Blocked
-                    else do runStep
-                            runAll
-
-runStep :: ProgrammedMachine ()
-runStep = 
-    do mem <- gets _memory
-       ip <- gets _ip
-       rb <- gets _rb
-       let opcode = (mem!ip) `mod` 100
-       let modes = parameterModes ((mem!ip) `div` 100)
-       fetchInput opcode modes
-       putOutput opcode modes
-       mem' <- gets _memory
-       let (mem'', ip', rb') = perform opcode ip modes rb mem'
-       modify (\m -> m {_ip = ip', _memory = mem'', _rb = rb'})
-
-fetchInput :: Integer -> [ParameterMode] -> ProgrammedMachine ()
--- fetchInput opcode _modes | trace ("Input with opcode " ++ show opcode) False = undefined
-fetchInput 3 modes =
-    do mem <- gets _memory
-       ip <- gets _ip
-       rb <- gets _rb
-       inputIndex <- gets _inputIndex
-       inputs <- ask 
-       let mem' = iInsert (ip + 1) (modes!!0) rb (inputs!!inputIndex) mem
-       modify (\m -> m {_inputIndex = inputIndex + 1, _memory = mem'})
-fetchInput _ _ = return ()
-
-putOutput :: Integer -> [ParameterMode] -> ProgrammedMachine ()
--- putOutput opcode _modes | trace ("Output with opcode " ++ show opcode) False = undefined
-putOutput 4 modes =
-    do mem <- gets _memory
-       ip <- gets _ip
-       rb <- gets _rb
-       let v = getMemoryValue (ip + 1) (modes!!0) rb mem
-       tell [v]
-putOutput _ _ = return ()       
-
-
-perform :: Integer -> Integer -> [ParameterMode] -> Integer -> Memory -> (Memory, Integer, Integer)
--- perform instr ip modes rb mem | trace ("Perform ip " ++ show ip ++ " opcode " ++ show instr ++ " modes " ++ (show (take 3 modes)) ++ " rb " ++ (show rb) ++ " args " ++ (intercalate ", " (map show [(mem!(ip+1)), (mem!(ip+2)), (mem!(ip+3))]))) False = undefined
-perform 1 ip modes rb mem = (iInsert (ip + 3) (modes!!2) rb (a + b) mem, ip + 4, rb)
-    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
-          b = getMemoryValue (ip + 2) (modes!!1) rb mem
-perform 2 ip modes rb mem = (iInsert (ip + 3) (modes!!2) rb (a * b) mem, ip + 4, rb)
-    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
-          b = getMemoryValue (ip + 2) (modes!!1) rb mem
-perform 3 ip _ rb mem = (mem, ip + 2, rb)
-perform 4 ip _ rb mem = (mem, ip + 2, rb)
-perform 5 ip modes rb mem = (mem, ip', rb)
-    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
-          b = getMemoryValue (ip + 2) (modes!!1) rb mem
-          ip' = if a /= 0 then b else ip + 3
-perform 6 ip modes rb mem = (mem, ip', rb)
-    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
-          b = getMemoryValue (ip + 2) (modes!!1) rb mem
-          ip' = if a == 0 then b else ip + 3
-perform 7 ip modes rb mem = (iInsert (ip + 3) (modes!!2) rb res mem, ip + 4, rb)
-    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
-          b = getMemoryValue (ip + 2) (modes!!1) rb mem
-          res = if a < b then 1 else 0
-perform 8 ip modes rb mem = (iInsert (ip + 3) (modes!!2) rb res mem, ip + 4, rb)
-    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
-          b = getMemoryValue (ip + 2) (modes!!1) rb mem
-          res = if a == b then 1 else 0
-perform 9 ip modes rb mem = (mem, ip + 2, rb + a)
-    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
-perform _ ip _ rb mem = (mem, ip, rb)
-
-
-getMemoryValue :: Integer -> ParameterMode -> Integer -> Memory -> Integer
-getMemoryValue loc Position rb mem = getMemoryValue loc' Immediate rb mem
-    where loc' = M.findWithDefault 0 loc mem
-getMemoryValue loc Immediate _ mem = M.findWithDefault 0 loc mem
-getMemoryValue loc Relative rb mem = getMemoryValue loc' Immediate 0 mem
-    where loc' = rb + M.findWithDefault 0 loc mem
-
--- indirect insert
-iInsert :: Integer -> ParameterMode -> Integer -> Integer -> Memory -> Memory
-iInsert loc Position _rb value mem = M.insert loc' value mem
-    where loc' = M.findWithDefault 0 loc mem
-iInsert loc Immediate _rb value mem = M.insert loc value mem
-iInsert loc Relative rb value mem = M.insert loc' value mem
-    where loc' = rb + M.findWithDefault 0 loc mem
-
-parameterModes :: Integer -> [ParameterMode]
-parameterModes modeCode = unfoldr generateMode modeCode
-
-generateMode :: Integer -> Maybe (ParameterMode, Integer)
-generateMode modeCode = Just (mode, modeCode `div` 10)
-    where mode = case (modeCode `mod` 10) of 
-                    0 -> Position
-                    1 -> Immediate
-                    2 -> Relative
-
--- Parse the input file
-type Parser = Parsec Void Text
-
-sc :: Parser ()
-sc = L.space (skipSome spaceChar) CA.empty CA.empty
--- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
-
-lexeme  = L.lexeme sc
-integer = lexeme L.decimal
-signedInteger = L.signed sc integer
-symb = L.symbol sc
-comma = symb ","
-
-memoryP = signedInteger `sepBy` comma
+part2 mem = head output
+    where (_, _, output) = runProgram [2] mem
 
-successfulParse :: Text -> [Integer]
-successfulParse input = 
-        case parse memoryP "input" input of
-                Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
-                Right memory -> memory
diff --git a/intcode/package.yaml b/intcode/package.yaml
new file mode 100644 (file)
index 0000000..339a24f
--- /dev/null
@@ -0,0 +1,59 @@
+# This YAML file describes your package. Stack will automatically generate a
+# Cabal file when you run `stack build`. See the hpack website for help with
+# this file: <https://github.com/sol/hpack>.
+
+name: intcode
+synopsis: Advent of Code
+version: '0.0.1'
+
+default-extensions:
+- AllowAmbiguousTypes
+- ApplicativeDo
+- BangPatterns
+- BlockArguments
+- DataKinds
+- DeriveFoldable
+- DeriveFunctor
+- DeriveGeneric
+- DeriveTraversable
+- EmptyCase
+- FlexibleContexts
+- FlexibleInstances
+- FunctionalDependencies
+- GADTs
+- GeneralizedNewtypeDeriving
+- ImplicitParams
+- KindSignatures
+- LambdaCase
+- MonadComprehensions
+- MonoLocalBinds
+- MultiParamTypeClasses
+- MultiWayIf
+- NegativeLiterals
+- NumDecimals
+- OverloadedLists
+- OverloadedStrings
+- PartialTypeSignatures
+- PatternGuards
+- PatternSynonyms
+- PolyKinds
+- RankNTypes
+- RecordWildCards
+- ScopedTypeVariables
+- TemplateHaskell
+- TransformListComp
+- TupleSections
+- TypeApplications
+- TypeInType
+- TypeOperators
+- ViewPatterns
+
+
+library:
+    source-dirs: src
+    dependencies:
+    - base >= 2 && < 6
+    - text
+    - megaparsec
+    - containers
+    - mtl
diff --git a/intcode/src/Intcode.hs b/intcode/src/Intcode.hs
new file mode 100644 (file)
index 0000000..bdc4cb4
--- /dev/null
@@ -0,0 +1,183 @@
+module Intcode where
+
+import Debug.Trace
+
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+
+import Data.Void (Void)
+
+import Text.Megaparsec hiding (State)
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
+import qualified Control.Applicative as CA
+
+-- import Control.Monad (unless)
+import Control.Monad.State.Strict
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.RWS.Strict
+
+
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+import Data.List
+
+type Memory = M.Map Integer Integer
+
+data Machine = Machine { _memory :: Memory
+                       , _ip :: Integer
+                       , _inputIndex :: Int
+                       , _rb :: Integer
+                       } 
+               deriving (Show, Eq)
+
+type ProgrammedMachine = RWS [Integer] [Integer] Machine
+
+data ExecutionState = Runnable | Blocked | Terminated  deriving (Ord, Eq, Show)
+
+data ParameterMode = Position | Immediate | Relative deriving (Ord, Eq, Show)
+
+
+-- returns (returnValue, finalMachine, outputs)
+runProgram :: [Integer] -> [Integer] -> (ExecutionState, Machine, [Integer])
+runProgram inputs program = runMachine inputs (makeMachine program)
+
+runMachine :: [Integer] -> Machine -> (ExecutionState, Machine, [Integer])
+runMachine inputs machine = runRWS runAll inputs machine
+
+
+makeMachine :: [Integer] -> Machine
+makeMachine memory = Machine    {_ip = 0, _inputIndex = 0, _rb = 0
+                                , _memory = M.fromList $ zip [0..] memory
+                                }
+
+
+runAll :: ProgrammedMachine ExecutionState
+runAll = do mem <- gets _memory
+            ip <- gets _ip
+            input <- ask
+            iIndex <- gets _inputIndex
+            let acutalInputLength = length input
+            let requiredInputLength = iIndex + 1
+            if (mem!ip == 99)
+            then return Terminated
+            else    if (mem!ip == 3 && requiredInputLength > acutalInputLength)
+                    then return Blocked
+                    else do runStep
+                            runAll
+
+runStep :: ProgrammedMachine ()
+runStep = 
+    do mem <- gets _memory
+       ip <- gets _ip
+       rb <- gets _rb
+       let opcode = (mem!ip) `mod` 100
+       let modes = parameterModes ((mem!ip) `div` 100)
+       fetchInput opcode modes
+       putOutput opcode modes
+       mem' <- gets _memory
+       let (mem'', ip', rb') = perform opcode ip modes rb mem'
+       modify (\m -> m {_ip = ip', _memory = mem'', _rb = rb'})
+
+fetchInput :: Integer -> [ParameterMode] -> ProgrammedMachine ()
+-- fetchInput opcode _modes | trace ("Input with opcode " ++ show opcode) False = undefined
+fetchInput 3 modes =
+    do mem <- gets _memory
+       ip <- gets _ip
+       rb <- gets _rb
+       inputIndex <- gets _inputIndex
+       inputs <- ask 
+       let mem' = iInsert (ip + 1) (modes!!0) rb (inputs!!inputIndex) mem
+       modify (\m -> m {_inputIndex = inputIndex + 1, _memory = mem'})
+fetchInput _ _ = return ()
+
+putOutput :: Integer -> [ParameterMode] -> ProgrammedMachine ()
+-- putOutput opcode _modes | trace ("Output with opcode " ++ show opcode) False = undefined
+putOutput 4 modes =
+    do mem <- gets _memory
+       ip <- gets _ip
+       rb <- gets _rb
+       let v = getMemoryValue (ip + 1) (modes!!0) rb mem
+       tell [v]
+putOutput _ _ = return ()       
+
+
+perform :: Integer -> Integer -> [ParameterMode] -> Integer -> Memory -> (Memory, Integer, Integer)
+-- perform instr ip modes rb mem | trace ("Perform ip " ++ show ip ++ " opcode " ++ show instr ++ " modes " ++ (show (take 3 modes)) ++ " rb " ++ (show rb) ++ " args " ++ (intercalate ", " (map show [(mem!(ip+1)), (mem!(ip+2)), (mem!(ip+3))]))) False = undefined
+perform 1 ip modes rb mem = (iInsert (ip + 3) (modes!!2) rb (a + b) mem, ip + 4, rb)
+    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
+          b = getMemoryValue (ip + 2) (modes!!1) rb mem
+perform 2 ip modes rb mem = (iInsert (ip + 3) (modes!!2) rb (a * b) mem, ip + 4, rb)
+    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
+          b = getMemoryValue (ip + 2) (modes!!1) rb mem
+perform 3 ip _ rb mem = (mem, ip + 2, rb)
+perform 4 ip _ rb mem = (mem, ip + 2, rb)
+perform 5 ip modes rb mem = (mem, ip', rb)
+    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
+          b = getMemoryValue (ip + 2) (modes!!1) rb mem
+          ip' = if a /= 0 then b else ip + 3
+perform 6 ip modes rb mem = (mem, ip', rb)
+    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
+          b = getMemoryValue (ip + 2) (modes!!1) rb mem
+          ip' = if a == 0 then b else ip + 3
+perform 7 ip modes rb mem = (iInsert (ip + 3) (modes!!2) rb res mem, ip + 4, rb)
+    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
+          b = getMemoryValue (ip + 2) (modes!!1) rb mem
+          res = if a < b then 1 else 0
+perform 8 ip modes rb mem = (iInsert (ip + 3) (modes!!2) rb res mem, ip + 4, rb)
+    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
+          b = getMemoryValue (ip + 2) (modes!!1) rb mem
+          res = if a == b then 1 else 0
+perform 9 ip modes rb mem = (mem, ip + 2, rb + a)
+    where a = getMemoryValue (ip + 1) (modes!!0) rb mem
+perform _ ip _ rb mem = (mem, ip, rb)
+
+
+getMemoryValue :: Integer -> ParameterMode -> Integer -> Memory -> Integer
+getMemoryValue loc Position rb mem = getMemoryValue loc' Immediate rb mem
+    where loc' = M.findWithDefault 0 loc mem
+getMemoryValue loc Immediate _ mem = M.findWithDefault 0 loc mem
+getMemoryValue loc Relative rb mem = getMemoryValue loc' Immediate 0 mem
+    where loc' = rb + M.findWithDefault 0 loc mem
+
+-- indirect insert
+iInsert :: Integer -> ParameterMode -> Integer -> Integer -> Memory -> Memory
+iInsert loc Position _rb value mem = M.insert loc' value mem
+    where loc' = M.findWithDefault 0 loc mem
+iInsert loc Immediate _rb value mem = M.insert loc value mem
+iInsert loc Relative rb value mem = M.insert loc' value mem
+    where loc' = rb + M.findWithDefault 0 loc mem
+
+parameterModes :: Integer -> [ParameterMode]
+parameterModes modeCode = unfoldr generateMode modeCode
+
+generateMode :: Integer -> Maybe (ParameterMode, Integer)
+generateMode modeCode = Just (mode, modeCode `div` 10)
+    where mode = case (modeCode `mod` 10) of 
+                    0 -> Position
+                    1 -> Immediate
+                    2 -> Relative
+
+
+-- Parse the input file
+type Parser = Parsec Void Text
+
+sc :: Parser ()
+sc = L.space (skipSome spaceChar) CA.empty CA.empty
+-- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
+
+lexeme  = L.lexeme sc
+integer = lexeme L.decimal
+signedInteger = L.signed sc integer
+symb = L.symbol sc
+comma = symb ","
+
+memoryP = signedInteger `sepBy` comma
+
+
+parseMachineMemory :: Text -> [Integer]
+parseMachineMemory input = 
+        case parse memoryP "input" input of
+                Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+                Right memory -> memory
index 8f4b3e1..ef4e6be 100644 (file)
@@ -46,6 +46,7 @@ packages:
 - advent07
 - advent08
 - advent09
+- intcode
 
 
 # Dependency packages to be pulled from upstream that are not in the resolver.