--- /dev/null
+# Extensionless files
+*
+!/**/
+!*.*
+
+# Haskell bits
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+cabal.project.local
+.HTF/
+
+
+# IPython / IHaskell notebook checkpoints
+.ipynb*
+
+# Sublime text
+*.sublime-workspace
+
+# Logs
+*.log
+
+# Profile exports
+*.ps
+
+# KDE
+.directory
+
--- /dev/null
+import Data.Map.Strict as M
+import Data.Map.Strict ((!))
+import Data.List
+
+data Coins = Red | Blue | Shiny | Corroded | Concave
+ deriving (Ord, Eq, Show, Enum, Bounded)
+
+allCoins = [Red .. Concave]
+
+main = print solve
+
+coins :: M.Map Coins Int
+coins = M.fromList $ zip [Red .. Concave] [2, 9, 5, 3, 7]
+
+solve :: [[Coins]]
+solve = [ [a, b, c, d, e]
+ | [a, b, c, d, e] <- permutations allCoins
+ , (coins ! a) + (coins ! b) * (coins ! c) ^2 + (coins ! d) ^3 - (coins ! e) == 399
+ ]
--- /dev/null
+---
+title: "Advent of Code 2022"
+output: html_document
+css: modest.css
+---
+Code to solve the [Advent of Code](http://adventofcode.com/2022/) puzzles. This year, I'm using the puzzles to develop my skills in [Haskell](https://wiki.haskell.org/Haskell). I'm writing up a [commentary on these puzzles and my solutions](https://work.njae.me.uk/tag/advent-of-code/) on my blog.
+
+[Learn you a Haskell](http://learnyouahaskell.com/chapters), [Introduction to Haskell 98](https://www.haskell.org/tutorial/index.html), and [Hackage](https://hackage.haskell.org/) are good resources.
+
+The [Cabal user guide](https://cabal.readthedocs.io/en/latest/index.html) and [How I Start: Haskell](http://howistart.org/posts/haskell/1/) are good sources of using the tools.
+
+# Toolchain
+
+Install Ghcup following [the instructions](https://www.haskell.org/ghcup/install/#installation), making sure to load the updated environment with
+
+```bash
+source /home/neil/.ghcup/env
+```
+
+and then set the default GHC to use with `ghcup set ghc 9.0.1` .
+
+Install [Haskell Language Server](https://haskell-language-server.readthedocs.io/en/latest/configuration.html) for Sublime Text
+
+
+## Creating the repository and project
+Create the repository as normal: create the project in Gitolite, clone it, and insert the `.gitignore` and `README.md` files.
+
+There's one package per day, with the code for each package in sub-directories of the root directory.
+
+Create the basic `cabal` project.
+
+```
+cabal init
+```
+
+Modify the `advent-of-code21.cabal` file as needed, such as updating the Cabal version and writing the `common` stanzas.
+
+## Creating subsequent days
+
+Each day lives in a separate directory, with code in the `src` directory.
+
+Compile with
+```
+cabal build
+```
+or
+```
+cabal build advent01
+```
+
+Run with
+```
+cabal run advent01
+```
+
+If you want to pass in additional RTS parameters, do it like this:
+```
+cabal run advent01 -- +RTS -K0 -RTS
+```
+
+Run interactively with
+```
+cabal repl advent01
+```
+or
+```
+stack ghci advent01:exe:advent01
+```
+if the first form is ambiguous.
+
+## Profiling
+
+To profile, use
+
+```
+cabal run advent01 --enable-profiling -- +RTS -N -p -s -hT
+```
+
+Or, you can simplify the RTS options by adding them to a new stanza in the cabal file:
+
+```
+executable advent01prof
+ import: common-extensions, build-directives
+ main-is: advent01/Main.hs
+ build-depends: text, containers, linear, array, pqueue, mtl, lens
+ ghc-options: -O2
+ -Wall
+ -threaded
+ -eventlog
+ -rtsopts "-with-rtsopts=-N -p -s -hT"
+```
+
+Only include the `-eventlog` directive if you want to use Threadscope to investigate parallel behaviour.
+
+then running
+
+```
+cabal run advent01prof --enable-profiling
+```
+
+
+Generate the profile graph with
+```
+hp2ps -M advent01.hp
+```
+
+
+# Packages
+
+Packages I used a lot:
+
+* [Containers](https://hackage.haskell.org/package/containers) (and some [better documentation](https://haskell-containers.readthedocs.io/en/latest/intro.html)); [Unordered containers](https://hackage.haskell.org/package/unordered-containers) is a mostly-equivalent alternative.
+* [Attoparsec](https://hackage.haskell.org/package/attoparsec) (and [Megaparsec](https://hackage.haskell.org/package/megaparsec), and [ReadP](https://hackage.haskell.org/package/base-4.14.1.0/docs/Text-ParserCombinators-ReadP.html) once).
+
+There are somewhat decent [tutorials on Megaparsec](https://markkarpov.com/tutorial/megaparsec.html) and [Attoparsec](https://www.schoolofhaskell.com/school/starting-with-haskell/libraries-and-frameworks/text-manipulation/attoparsec).
+
+Packages I didn't use much, but need to remember:
+
+* [Arithmoi](https://hackage.haskell.org/package/arithmoi) for number theory
+* [Pointed List](https://hackage.haskell.org/package/pointedlist-0.6.1) for zipper lists (sometimes circular)
+* [Vector](https://hackage.haskell.org/package/vector) for array-like things
+* [Linear](https://hackage.haskell.org/package/linear) for coordinate-vector like things
+* [Grid](https://hackage.haskell.org/package/grid) for 2-d grids
+* [Graph-wrapper](https://hackage.haskell.org/package/graph-wrapper) for graphs
+* [Lens](https://hackage.haskell.org/package/lens) (and a [summary of operators](https://github.com/ekmett/lens/wiki/Operators)). I didn't use these much this year, but did a lot last year.
+* [RWS](https://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-RWS-Lazy.html) (Reader-Writer-State monad stack); again, used a lot last year but not this year
+* [Monad loops](https://hackage.haskell.org/package/monad-loops-0.4.3/docs/Control-Monad-Loops.html), and [a description](https://conscientiousprogrammer.com/blog/2015/12/11/24-days-of-hackage-2015-day-11-monad-loops-avoiding-writing-recursive-functions-by-refactoring/)
+* [Replace-Megaparsec](https://github.com/jamesdbrock/replace-megaparsec), for using Mpc for all sorts of things traditionally done with regex substitutions.
+
+# Readme
+
+Build this readme file wth
+```
+pandoc -s README.md > README.html
+```
+
+(Using the [Modest style](https://github.com/markdowncss/modest).)
--- /dev/null
+take tablet
+go doorway
+go north
+go north
+go bridge
+continue
+down
+west
+passage
--- /dev/null
+take tablet
+use tablet
+doorway
+north
+north
+bridge
+continue
+down
+east
+take empty lantern
+west
+west
+passage
+ladder
+west
+south
+north
+take can
+use can
+use lantern
+west
+ladder
+darkness
+continue
+west
+west
+west
+west
+north
+take red coin
+north
+north
+west
+take blue coin
+up
+take shiny coin
+down
+east
+east
+take concave coin
+down
+take corroded coin
+up
+west
+look red coin
+look blue coin
+look shiny coin
+look corroded coin
+look concave coin
--- /dev/null
+take tablet
+doorway
+
+use tablet
+doorway
+look
+north
+north
+bridge
+continue
+down
+east
+take empty lantern
+west
+west
+passage
+ladder
+west
+south
+north
+take can
+use can
+use lantern
+west
+ladder
+darkness
+continue
+west
+west
+west
+west
+north
+take red coin
+north
+north
+west
+take blue coin
+up
+take shiny coin
+down
+east
+east
+take concave coin
+inv
+down
+take corroded coin
+up
+west
+look monument
+look
+look red coin
+look blue coin
+look shiny coin
+look corroded coin
+look concave coin
+help
+drop blue coin
+take blue coin
+use blue coin
+use red coin
+use shiny coin
+use concave coin
+use corroded coin
--- /dev/null
+take tablet
+# get first code
+use tablet
+doorway
+north
+north
+bridge
+continue
+down
+east
+take empty lantern
+west
+west
+passage
+ladder
+west
+south
+north
+take can
+use can
+use lantern
+west
+west
+south
+north
+# get second code
+west
+ladder
+darkness
+continue
+west
+west
+west
+west
+north
+take red coin
+north
+north
+west
+take blue coin
+up
+take shiny coin
+down
+east
+east
+take concave coin
+inv
+down
+take corroded coin
+up
+west
+look monument
+look
+look red coin
+look blue coin
+look shiny coin
+look corroded coin
+look concave coin
+use blue coin
+use red coin
+use shiny coin
+use concave coin
+use corroded coin
+# now got coin puzzle code
+north
+take teleporter
+use teleporter
+take business card
+take strange book
+look bookshelf
+look business card
+look strange book
--- /dev/null
+email: neil.synacor@njae.me.uk
+password: Wfffj&ZlQ#n£ZF9£
--- /dev/null
+take tablet
+doorway
+
+use tablet
+doorway
+look
+north
+north
+bridge
+continue
+down
+east
+take empty lantern
+west
+west
+passage
+ladder
+west
+south
+north
+take can
+use can
+use lantern
+west
+ladder
+darkness
+continue
+west
+west
+west
+west
+north
+take red coin
+north
+north
+west
+take blue coin
--- /dev/null
+take tablet
+use tablet
+go doorway
+north
+north
+bridge
+continue
+down
+east
+take empty lantern
+west
+west
+passage
+ladder
+west
+south
+north
+take can
+west
+use can
+use lantern
+ladder
+darkness
+continue
+west
+west
+west
+west
+north
+take red coin
--- /dev/null
+import SynacorEngine
+
+import Debug.Trace
+
+import Numeric
+import System.IO
+import Data.Char
+import Data.List
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+import Control.Lens -- hiding ((<|), (|>), (:>), (:<), indices)
+
+import Control.Monad.State.Strict
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.RWS.Strict
+
+-- import Data.Bits
+import Data.Word
+import Data.Binary.Get
+import qualified Data.ByteString.Lazy as BL
+
+
+data SynacorState = SynacorState
+ { _ssMachines :: [Machine]
+ , _ssInputs :: [String]
+ , _ssOutputs :: [String]
+ , _ssContinue :: Bool
+ , _ssUnsaved :: Bool
+ , _ssState :: [ExecutionState]
+ } deriving (Ord, Eq)
+makeLenses ''SynacorState
+
+instance Show SynacorState
+ where
+ show state =
+ intercalate ", "
+ [ "SynacorState"
+ , (show (length (state ^. ssMachines)) ++ " machines")
+ , "inputs " ++ (intercalate ":" $ state ^. ssInputs)
+ , "outputs " ++ (intercalate ":" $ fmap (take 20) $ state ^. ssOutputs)
+ , "conts " ++ (show $ state ^. ssContinue)
+ , "unsaved " ++ (show $ state ^. ssUnsaved)
+ , "states " ++ (show $ state ^. ssState)
+ ]
+
+main :: IO ()
+main =
+ do -- mem <- getMemory
+ -- print $ [(n, showHex (mem ! n) "") | n <- [0..5] ]
+ -- machineInput <- readFile "adventure_input.txt"
+ -- let mInp = wordify machineInput
+ -- let machine = makeMachine mem
+ -- let (exState, _machine, output) = runMachine mInp machine
+ -- print exState
+ -- putStrLn $ showOutput output
+
+ state0 <- emptyState
+ let state1 = runWithoutInput state0
+ let newOutput = head $ state1 ^. ssOutputs
+ putStrLn newOutput
+ -- let state1 = runOneInput state "take tablet"
+ -- print state0
+ -- print state
+ -- print state1
+
+ stateF <- adventureHarness state1
+ return ()
+ -- print $ stateF ^. ssInputs
+ -- print $ stateF ^. ssOutputs
+ -- print $ stateF ^. ssState
+ -- let machs = stateF ^. ssMachines
+ -- let machPairs = zipWith (==) machs $ tail machs
+ -- print $ machPairs
+
+emptyState :: IO SynacorState
+emptyState =
+ do mem <- getMemory
+ let machine = makeMachine mem
+ return $ SynacorState [machine] [] [] True False [Runnable]
+
+adventureHarness :: SynacorState -> IO SynacorState
+adventureHarness state =
+ do command <- prompt "> "
+ state' <- handleCommand command state
+ let newOutput = head $ state' ^. ssOutputs
+ putStrLn newOutput
+ if (state' ^. ssContinue)
+ then (adventureHarness state')
+ else return state'
+
+
+handleCommand :: String -> SynacorState -> IO SynacorState
+handleCommand ":quit" state = return $ state & ssContinue .~ False
+handleCommand ":save" state =
+ do filename <- prompt "Save as? "
+ let inputs = unlines $ tail $ reverse $ state ^. ssInputs
+ writeFile filename inputs
+ return $ state & ssUnsaved .~ True
+handleCommand ":load" state =
+ do filename <- prompt "From? "
+ machineInput <- readFile filename
+ let inputs = lines machineInput
+ initialState <- emptyState
+ let nonComments = filter (\i -> head i == '#') inputs
+ let state = foldl' runOneInput initialState ("" : nonComments)
+ return $ state & ssUnsaved .~ False
+handleCommand ":undo" state =
+ return $ state & ssMachines %~ tail
+ & ssInputs %~ tail
+ & ssOutputs %~ tail
+ & ssContinue .~ True
+ & ssUnsaved .~ True
+ & ssState %~ tail
+handleCommand ":recap" state =
+ do let inputs = take 3 $ state ^. ssInputs
+ let outputs = "" : (tail $ take 3 $ state ^. ssOutputs)
+ let inOuts = reverse $ zip inputs outputs
+ forM_ inOuts (\(i, o) ->
+ do putStrLn ("#> " ++ i)
+ putStrLn o
+ )
+ return state
+handleCommand command state = return $ runOneInput state command
+
+
+runWithoutInput :: SynacorState -> SynacorState
+runWithoutInput state = state & ssMachines %~ (machine' :)
+ -- & ssInputs %~ (input :)
+ & ssOutputs %~ ((showOutput output) :)
+ & ssContinue .~ True
+ & ssUnsaved .~ True
+ & ssState %~ (exState :)
+ where machine = head $ state ^. ssMachines
+ (exState, machine', output) = runMachine [] (machine & inputIndex .~ 0)
+
+runOneInput :: SynacorState -> String -> SynacorState
+runOneInput state input = state & ssMachines %~ (machine' :)
+ & ssInputs %~ (input :)
+ & ssOutputs %~ ((showOutput output) :)
+ & ssContinue .~ True
+ & ssUnsaved .~ True
+ & ssState %~ (exState :)
+ where machine = head $ state ^. ssMachines
+ inputW = wordify (input ++ "\n")
+ (exState, machine', output) = runMachine inputW (machine & inputIndex .~ 0)
+ -- output' = trace ("runone " ++ (show (machine == machine')) ++ " " ++ (show exState) ++ " " ++ (showOutput output)) output
+
+
+prompt :: String -> IO String
+prompt text = do
+ putStr text
+ hFlush stdout
+ getLine
+
+wordify :: String -> [Word16]
+wordify cs = fmap (fromIntegral . ord) cs
+
+showOutput :: [Word16] -> String
+showOutput output = fmap (chr . fromInteger . fromIntegral) output
+
+getMemory :: IO Memory
+getMemory = do
+ input <- BL.readFile "challenge.bin"
+ let cells = runGet getCells input
+ return $ M.fromList $ zip [0..] cells
+
+getCells :: Get [Word16]
+getCells = do
+ empty <- isEmpty
+ if empty
+ then return []
+ else do cell <- getWord16le
+ cells <- getCells
+ return (cell:cells)
+
+
--- /dev/null
+module SynacorEngine where
+
+import Debug.Trace
+
+-- import System.Environment
+import Data.Bits
+import Data.Word
+-- import Data.Binary.Get
+-- import qualified Data.ByteString.Lazy as BL
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+import Control.Lens
+import Data.List
+import Numeric
+
+import Control.Monad.State.Strict
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.RWS.Strict
+
+type Memory = M.Map Word16 Word16
+
+
+
+data Machine = Machine { _memory :: Memory
+ , _ip :: Word16
+ , _registers :: Memory
+ , _inputIndex :: Int
+ , _stack :: [Word16]
+ }
+ deriving (Show, Eq, Ord)
+makeLenses ''Machine
+
+type ProgrammedMachine = RWS [Word16] [Word16] Machine
+
+data ExecutionState = Runnable | Blocked | Terminated deriving (Ord, Eq, Show)
+
+-- returns (returnValue, finalMachine, outputs)
+
+runMachine :: [Word16] -> Machine -> (ExecutionState, Machine, [Word16])
+runMachine inputs machine = runRWS runAll inputs machine
+
+
+makeMachine :: Memory -> Machine
+makeMachine memory = Machine
+ { _ip = 0
+ , _inputIndex = 0
+ , _registers = M.fromList [ (r, 0) | r <- [0..7] ]
+ , _memory = memory
+ , _stack = []
+ }
+
+-- traceMachine x =
+-- do cip <- gets _ip
+-- opcode <- getLocation cip
+-- arg1 <- getValue (cip + 1)
+-- arg2 <- getValue (cip + 2)
+-- arg3 <- getValue (cip + 3)
+-- mem <- gets _memory
+-- regs <- gets _registers
+-- let raw1 = mem ! (cip + 1)
+-- let raw2 = mem ! (cip + 2)
+-- let raw3 = mem ! (cip + 3)
+-- let x' = trace (
+-- intercalate ": "
+-- [ "IP Addr"
+-- , show (showHex (cip * 2) "")
+-- , "IP"
+-- , (show (showHex cip ""))
+-- , "Op"
+-- , show (opcode)
+-- , "Args"
+-- , show (showHex arg1 "")
+-- , show (showHex arg2 "")
+-- , show (showHex arg3 "")
+-- , "Raw"
+-- , show (showHex raw1 "")
+-- , show (showHex raw2 "")
+-- , show (showHex raw3 "")
+-- , show (M.elems regs)
+-- ]
+-- ) x
+-- return x'
+
+runAll :: ProgrammedMachine ExecutionState
+runAll = do cip <- gets _ip
+ opcode <- getLocation cip
+ -- opcode' <- traceMachine opcode
+ -- exState <- runStep opcode'
+ exState <- runStep opcode
+ case exState of
+ Terminated -> return Terminated
+ Blocked -> return Blocked
+ _ -> runAll
+
+
+runStep :: Word16 -> ProgrammedMachine ExecutionState
+-- runStep n | trace (show n) False = undefined
+runStep 0 = return Terminated
+runStep 1 =
+ do cip <- gets _ip
+ regR <- getLocation (cip + 1)
+ let reg = regR .&. 7
+ value <- getValue (cip + 2)
+ advanceIP 3
+ modify (\m -> m & registers . ix reg .~ value)
+ return Runnable
+runStep 2 =
+ do cip <- gets _ip
+ value <- getValue (cip + 1)
+ advanceIP 2
+ modify (\m -> m & stack %~ (value :) )
+ return Runnable
+runStep 3 =
+ do cip <- gets _ip
+ tgt <- getLocation (cip + 1)
+ val <- gets (\m -> head $ m ^. stack)
+ modify (\m -> m & stack %~ tail )
+ putValue tgt val
+ advanceIP 2
+ return Runnable
+runStep 4 =
+ do cip <- gets _ip
+ tgt <- getLocation (cip + 1)
+ b <- getValue (cip + 2)
+ c <- getValue (cip + 3)
+ putValue tgt (if b == c then 1 else 0)
+ modify (\m -> m & ip %~ (+ 4))
+ return Runnable
+runStep 5 =
+ do cip <- gets _ip
+ tgt <- getLocation (cip + 1)
+ b <- getValue (cip + 2)
+ c <- getValue (cip + 3)
+ putValue tgt (if b > c then 1 else 0)
+ advanceIP 4
+ return Runnable
+runStep 6 =
+ do cip <- gets _ip
+ tgt <- getLocation (cip + 1)
+ modify (\m -> m & ip .~ tgt)
+ return Runnable
+runStep 7 =
+ do cip <- gets _ip
+ a <- getValue (cip + 1)
+ tgt <- getLocation (cip + 2)
+ if a /= 0
+ then modify (\m -> m & ip .~ tgt)
+ else advanceIP 3
+ return Runnable
+runStep 8 =
+ do cip <- gets _ip
+ a <- getValue (cip + 1)
+ tgt <- getLocation (cip + 2)
+ if a == 0
+ then modify (\m -> m & ip .~ tgt)
+ else advanceIP 3
+ return Runnable
+
+runStep 9 =
+ do cip <- gets _ip
+ a <- getLocation (cip + 1)
+ b <- getValue (cip + 2)
+ c <- getValue (cip + 3)
+ putValue a (b + c)
+ advanceIP 4
+ return Runnable
+runStep 10 =
+ do cip <- gets _ip
+ a <- getLocation (cip + 1)
+ b <- getValue (cip + 2)
+ c <- getValue (cip + 3)
+ putValue a (b * c)
+ advanceIP 4
+ return Runnable
+runStep 11 =
+ do cip <- gets _ip
+ a <- getLocation (cip + 1)
+ b <- getValue (cip + 2)
+ c <- getValue (cip + 3)
+ putValue a (b `mod` c)
+ advanceIP 4
+ return Runnable
+runStep 12 =
+ do cip <- gets _ip
+ a <- getLocation (cip + 1)
+ b <- getValue (cip + 2)
+ c <- getValue (cip + 3)
+ putValue a (b .&. c)
+ advanceIP 4
+ return Runnable
+runStep 13 =
+ do cip <- gets _ip
+ a <- getLocation (cip + 1)
+ b <- getValue (cip + 2)
+ c <- getValue (cip + 3)
+ putValue a (b .|. c)
+ advanceIP 4
+ return Runnable
+runStep 14 =
+ do cip <- gets _ip
+ a <- getLocation (cip + 1)
+ b <- getValue (cip + 2)
+ putValue a (complement b)
+ advanceIP 3
+ return Runnable
+
+runStep 15 =
+ do cip <- gets _ip
+ a <- getLocation (cip + 1)
+ b <- getValue (cip + 2)
+ v <- getValue b
+ putValue a v
+ advanceIP 3
+ return Runnable
+runStep 16 =
+ do cip <- gets _ip
+ a <- getValue (cip + 1)
+ b <- getValue (cip + 2)
+ putValue a b
+ advanceIP 3
+ return Runnable
+
+runStep 17 =
+ do cip <- gets _ip
+ a <- getValue (cip + 1)
+ modify (\m -> m & stack %~ ((cip + 2) :)
+ & ip .~ a)
+ return Runnable
+
+runStep 18 =
+ do val <- gets (\m -> head $ m ^. stack)
+ modify (\m -> m & stack %~ tail
+ & ip .~ val)
+ return Runnable
+
+runStep 19 =
+ do cip <- gets _ip
+ v <- getValue (cip + 1)
+ tell [v]
+ advanceIP 2
+ return Runnable
+
+runStep 20 =
+ do iIndex <- gets _inputIndex
+ inputs <- ask
+ cip <- gets _ip
+ tgt <- getLocation (cip + 1)
+ if (iIndex + 1) > (length inputs)
+ then return Blocked
+ else do let char = (inputs!!iIndex)
+ putValue tgt char
+ modify (\m -> m & inputIndex %~ (+ 1))
+ advanceIP 2
+ return Runnable
+
+runStep 21 =
+ do advanceIP 1
+ return Runnable
+runStep _ =
+ do advanceIP 1
+ return Runnable
+
+
+getValue :: Word16 -> ProgrammedMachine Word16
+getValue loc =
+ do mem <- gets _memory
+ regs <- gets _registers
+ let val = mem ! loc
+ if val < (2 ^ 15)
+ then return val
+ else return (regs ! (val .&. 7))
+
+
+
+ -- | loc < 32768 =
+ -- do mem <- gets _memory
+ -- return $ mem ! loc
+ -- | otherwise =
+ -- do regs <- gets _registers
+ -- return $ regs ! (loc `shiftR` 15)
+
+getLocation :: Word16 -> ProgrammedMachine Word16
+getLocation loc =
+ do mem <- gets _memory
+ return $ mem ! loc
+
+putValue :: Word16 -> Word16 -> ProgrammedMachine ()
+putValue loc value
+ | loc < (2 ^ 15) = modify (\m -> m & memory . ix loc .~ v)
+ | otherwise = modify (\m -> m & registers . ix (loc .&. 7) .~ v)
+ where v = value `mod` (2 ^ 15)
+
+advanceIP :: Word16 -> ProgrammedMachine ()
+advanceIP delta = modify (\m -> m & ip %~ (+ delta))
--- /dev/null
+Please record your progress by putting codes like
+this one into the challenge website: hORWzmTEPkRE
+
+The self-test completion code is: YSDJvoycpDhu
+
+You find yourself writing "PRfkKApjpukS" on the tablet. Perhaps it's some kind of code?
+
+Chiseled on the wall of one of the passageways, you see:
+
+ MSVFHKWMXrVA
+
+You take note of this and keep walking.
+
+
+You activate the teleporter! As you spiral through time and space, you think you see a pattern in the stars...
+
+ QiAHRHuQGxPx
--- /dev/null
+cabal-version: 3.6
+name: synacor-challenge
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis: Synacor challenge
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author: Neil Smith
+maintainer: NeilNjae@users.noreply.github.com
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files:
+ CHANGELOG.md
+ README.md
+
+common common-extensions
+ default-extensions: AllowAmbiguousTypes
+ , ApplicativeDo
+ , BangPatterns
+ , BlockArguments
+ , DataKinds
+ , DeriveFoldable
+ , DeriveFunctor
+ , DeriveGeneric
+ , DeriveTraversable
+ -- , DuplicateRecordFields
+ , EmptyCase
+ , FlexibleContexts
+ , FlexibleInstances
+ , FunctionalDependencies
+ , GADTs
+ , GeneralizedNewtypeDeriving
+ , ImplicitParams
+ , KindSignatures
+ , LambdaCase
+ , MonadComprehensions
+ , MonoLocalBinds
+ , MultiParamTypeClasses
+ , MultiWayIf
+ , NamedFieldPuns
+ , NegativeLiterals
+ , NumDecimals
+ -- , NoFieldSelectors
+ -- , OverloadedLists
+ -- , OverloadedRecordDot
+ , OverloadedStrings
+ , PartialTypeSignatures
+ , PatternGuards
+ , PatternSynonyms
+ , PolyKinds
+ , RankNTypes
+ , RecordWildCards
+ , ScopedTypeVariables
+ , TemplateHaskell
+ -- , TransformListComp
+ , TupleSections
+ , TypeApplications
+ , TypeFamilies
+ , TypeInType
+ , TypeOperators
+ , ViewPatterns
+
+common build-directives
+ build-depends: base >=4.16
+ default-language: Haskell2010
+ hs-source-dirs: ., app, src
+ other-modules: SynacorEngine
+ ghc-options: -O2
+ -Wall
+ -threaded
+ -rtsopts "-with-rtsopts=-N"
+
+executable synacor
+ import: common-extensions, build-directives
+ main-is: Main.hs
+ build-depends: split
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: containers, binary, bytestring, mtl, lens
+ hs-source-dirs: app, src
+ default-language: Haskell2010
+
+executable coinsolver
+ import: common-extensions
+ main-is: Main.hs
+ build-depends: split
+ main-is: CoinSolver.hs
+ build-depends: base >=4.16, containers
+ hs-source-dirs: app, src
+ default-language: Haskell2010
+ hs-source-dirs: ., app, src
+ ghc-options: -O2
+ -Wall
+ -threaded
+ -rtsopts "-with-rtsopts=-N"
+
+
+library
+ import: common-extensions
+ build-depends: base >=4.16, containers, binary, bytestring, mtl, lens
+ hs-source-dirs: ., app, src
+ exposed-modules: SynacorEngine
--- /dev/null
+{
+ "folders":
+ [
+ {
+ "path": "."
+ }
+ ]
+}
--- /dev/null
+take tablet
+doorway
--- /dev/null
+
+take tablet
+inv
+go south
+go north
+go doorway
+north
+north
+bridge
+continue
+down
--- /dev/null
+
+take tablet
+inv
+go doorway
+north
+north
+bridge
+continue
+down
+east
+take empty lantern
+west
+west
+passage
+ladder
--- /dev/null
+
+take tablet
+inv
+go doorway
+north
+north
+bridge
+continue
+down
+east
+take empty lantern
+west
+west
+passage
+ladder
+west
+south
+north
+take can
+west
--- /dev/null
+take tablet
+use tablet
+go doorway
+north
+north
+bridge
+continue
+down
+east
+take empty lantern
+west
+west
+passage
+ladder
+west
+south
+north
+take can
+west
+use can
+use lantern
+west
+south
+north
+west
--- /dev/null
+
+take tablet
+inv
+go doorway
+north
+north
+bridge
+continue
+down
+east
+take empty lantern
+west
+west
+passage
+ladder
+west
+south
+north
+take can
+west
+use can
+use lantern
projects / synacor-challenge.git / commitdiff