From: Neil Smith Date: Sun, 30 Jul 2023 08:26:10 +0000 (+0100) Subject: Solved adventure game X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;ds=sidebyside;h=133559acebf7fdefd20a0653833311ea1a6f8811;p=synacor-challenge.git Solved adventure game --- 133559acebf7fdefd20a0653833311ea1a6f8811 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..1a0ee39 --- /dev/null +++ b/.gitignore @@ -0,0 +1,42 @@ +# 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 + diff --git a/CoinSolver.hs b/CoinSolver.hs new file mode 100644 index 0000000..d3a9e13 --- /dev/null +++ b/CoinSolver.hs @@ -0,0 +1,19 @@ +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 + ] diff --git a/README.md b/README.md new file mode 100644 index 0000000..a617b7c --- /dev/null +++ b/README.md @@ -0,0 +1,137 @@ +--- +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).) diff --git a/adventure_input.txt b/adventure_input.txt new file mode 100644 index 0000000..c3ac999 --- /dev/null +++ b/adventure_input.txt @@ -0,0 +1,9 @@ +take tablet +go doorway +go north +go north +go bridge +continue +down +west +passage diff --git a/all_coins.txt b/all_coins.txt new file mode 100644 index 0000000..3122ffd --- /dev/null +++ b/all_coins.txt @@ -0,0 +1,49 @@ +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 diff --git a/challenge.bin b/challenge.bin new file mode 100644 index 0000000..ffe2d2a Binary files /dev/null and b/challenge.bin differ diff --git a/coins_used.txt b/coins_used.txt new file mode 100644 index 0000000..ad7f95d --- /dev/null +++ b/coins_used.txt @@ -0,0 +1,63 @@ +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 diff --git a/found_teleporter.txt b/found_teleporter.txt new file mode 100644 index 0000000..95d38c9 --- /dev/null +++ b/found_teleporter.txt @@ -0,0 +1,72 @@ +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 diff --git a/login-details.txt b/login-details.txt new file mode 100644 index 0000000..f5ad418 --- /dev/null +++ b/login-details.txt @@ -0,0 +1,2 @@ +email: neil.synacor@njae.me.uk +password: Wfffj&ZlQ#n£ZF9£ diff --git a/red_blue_coin.txt b/red_blue_coin.txt new file mode 100644 index 0000000..9cd005f --- /dev/null +++ b/red_blue_coin.txt @@ -0,0 +1,37 @@ +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 diff --git a/red_coin.txt b/red_coin.txt new file mode 100644 index 0000000..c954274 --- /dev/null +++ b/red_coin.txt @@ -0,0 +1,30 @@ +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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..0c9ceea --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,177 @@ +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) + + diff --git a/src/SynacorEngine.hs b/src/SynacorEngine.hs new file mode 100644 index 0000000..e036f5c --- /dev/null +++ b/src/SynacorEngine.hs @@ -0,0 +1,295 @@ +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)) diff --git a/src/synacor_codes.txt b/src/synacor_codes.txt new file mode 100644 index 0000000..f32d370 --- /dev/null +++ b/src/synacor_codes.txt @@ -0,0 +1,17 @@ +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 diff --git a/synacor-challenge.tgz b/synacor-challenge.tgz new file mode 100644 index 0000000..840a2e0 Binary files /dev/null and b/synacor-challenge.tgz differ diff --git a/synacor.cabal b/synacor.cabal new file mode 100644 index 0000000..11f7b23 --- /dev/null +++ b/synacor.cabal @@ -0,0 +1,117 @@ +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 diff --git a/synacor.sublime-project b/synacor.sublime-project new file mode 100644 index 0000000..24db303 --- /dev/null +++ b/synacor.sublime-project @@ -0,0 +1,8 @@ +{ + "folders": + [ + { + "path": "." + } + ] +} diff --git a/test1.txt b/test1.txt new file mode 100644 index 0000000..558f944 --- /dev/null +++ b/test1.txt @@ -0,0 +1,2 @@ +take tablet +doorway diff --git a/test2.txt b/test2.txt new file mode 100644 index 0000000..b14ced5 --- /dev/null +++ b/test2.txt @@ -0,0 +1,11 @@ + +take tablet +inv +go south +go north +go doorway +north +north +bridge +continue +down diff --git a/twisty_passages.txt b/twisty_passages.txt new file mode 100644 index 0000000..8110a03 --- /dev/null +++ b/twisty_passages.txt @@ -0,0 +1,15 @@ + +take tablet +inv +go doorway +north +north +bridge +continue +down +east +take empty lantern +west +west +passage +ladder diff --git a/twisty_passages_can.txt b/twisty_passages_can.txt new file mode 100644 index 0000000..eaa9080 --- /dev/null +++ b/twisty_passages_can.txt @@ -0,0 +1,20 @@ + +take tablet +inv +go doorway +north +north +bridge +continue +down +east +take empty lantern +west +west +passage +ladder +west +south +north +take can +west diff --git a/twisty_passages_code.txt b/twisty_passages_code.txt new file mode 100644 index 0000000..540cf57 --- /dev/null +++ b/twisty_passages_code.txt @@ -0,0 +1,25 @@ +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 diff --git a/twisty_passages_lit_lantern.txt b/twisty_passages_lit_lantern.txt new file mode 100644 index 0000000..d8ab10f --- /dev/null +++ b/twisty_passages_lit_lantern.txt @@ -0,0 +1,22 @@ + +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