Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 1fe2763

Browse files
committed
starting on day 18 reflections
1 parent d035570 commit 1fe2763

File tree

2 files changed

+277
-17
lines changed

2 files changed

+277
-17
lines changed

‎reflections.md‎

Lines changed: 231 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1789,6 +1789,237 @@ Day 18
17891789

17901790
[d18c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day18.hs
17911791

1792+
Day 18 was pretty fun, and I'm probably going to write a blog post on my final
1793+
solution at some point. It's nice because you can basically "compile" your
1794+
code to run on an abstract machine, and the difference between Part 1 and Part
1795+
2 is pretty much just the interpretation of that machine.
1796+
1797+
### The Language
1798+
1799+
First, we can look at an encoding of our language, as a simple ADT describing
1800+
each of the commands.
1801+
1802+
```haskell
1803+
type Addr = Either Char Int
1804+
1805+
addr :: String -> Addr
1806+
addr [c] | isAlpha c = Left c
1807+
addr str = Right (read str)
1808+
1809+
data Op = OSnd Addr
1810+
| OBin (Int -> Int -> Int) Char Addr
1811+
| ORcv Char
1812+
| OJgz Addr Addr
1813+
1814+
parseOp :: String -> Op
1815+
parseOp inp = case words inp of
1816+
"snd":(addr->c):_ -> OSnd c
1817+
"set":(x:_):(addr->y):_ -> OBin (const id) x y
1818+
"add":(x:_):(addr->y):_ -> OBin (+) x y
1819+
"mul":(x:_):(addr->y):_ -> OBin (*) x y
1820+
"mod":(x:_):(addr->y):_ -> OBin mod x y
1821+
"rcv":(x:_):_ -> ORcv x
1822+
"jgz":(addr->x):(addr->y):_ -> OJgz x y
1823+
_ -> error "Bad parse"
1824+
1825+
parse :: String -> Tape Op
1826+
parse = unsafeTape . map parseOp . lines
1827+
```
1828+
1829+
Here I'm using `Tape Op` to represent the current program memory and position
1830+
of the program counter -- it's a list of commands, essentially, "focused" on a
1831+
specific point with O(1) access to that focus and O(n) jumps. It's probably
1832+
better as a vector paired with an Int, but I already had my `Tape` code from
1833+
earlier!
1834+
1835+
### The Abstract Machine
1836+
1837+
Now to define the abstract machine (the "IO", so to speak) that we run our
1838+
program on.
1839+
1840+
There are really only two ways that our program interacts with an outside
1841+
world:
1842+
1843+
1. `Snd`-ing, which takes a single `Int` as a parameter and has no result
1844+
2. `Rcv`-ing, which takes a single `Int` as a parameter and has an `Int`
1845+
result
1846+
1847+
The `Rcv` `Int` parameter will be the value of the register being `Rcv`'d. It
1848+
is used by Part 1, but not by Part 2.
1849+
1850+
```haskell
1851+
data Command :: Type -> Type where
1852+
CRcv :: Int -> Command Int -- ^ input is current value of buffer
1853+
CSnd :: Int -> Command () -- ^ input is thing being sent
1854+
1855+
type Machine = Prompt Command
1856+
```
1857+
1858+
Here I am using the great *MonadPrompt* library, which allows us to create an
1859+
abstract `Monad` from a GADT of commands. Our `Machine` (a type synonym of
1860+
`Prompt Command`) will have a `Functor`, `Applicative`, and `Monad` instance
1861+
(so `fmap`, `return`, etc.), but also two "effectful commands":
1862+
1863+
```haskell
1864+
(prompt . CRcv) :: Int -> Machine Int
1865+
(prompt . CSnd) :: Int -> Machine ()
1866+
```
1867+
1868+
You can think of it as primitives for our monads, like `putStrLn` and `getLine`
1869+
for `IO`.
1870+
1871+
I find it convenient to alias these:
1872+
1873+
```haskell
1874+
rcvMachine :: Int -> Machine Int
1875+
rcvMachine = prompt . CRcv
1876+
1877+
sndMachine :: Int -> Machine ()
1878+
sndMachine = prompt . CSnd
1879+
```
1880+
1881+
The *MonadPrompt* library gives us the ability to "run" a `Prompt Command` by
1882+
giving an *interpreter function*:
1883+
1884+
```haskell
1885+
runPromptM
1886+
:: Monad m
1887+
=> (forall x. Command x -> m x)
1888+
-> Prompt Command a
1889+
-> m a
1890+
```
1891+
1892+
Essentially, given a way to "interpret" any `Command` in the context of a monad
1893+
of our choice, `m`, it will "run" the `Prompt Command` for us, firing our
1894+
interpreter whenever necessary.
1895+
1896+
### Language Logic
1897+
1898+
Now to implement the language itself:
1899+
1900+
```haskell
1901+
data ProgState = PS { _psTape :: Tape Op
1902+
, _psRegs :: M.Map Char Int
1903+
}
1904+
makeClassy ''ProgState
1905+
1906+
type TapeProg = MaybeT (StateT ProgState Machine)
1907+
```
1908+
1909+
Our stepping of our program needs some monad to work with, so we use `MaybeT
1910+
(StateT ProgState Machine)`. The `MaybeT` parameter tells us if our program
1911+
leaves the bounds of the tape, and `StateT` keeps track of the `ProgState`,
1912+
which contains the current tape with position and the values in all of the
1913+
registers.
1914+
1915+
We write an action to execute a single command:
1916+
1917+
```haskell
1918+
stepTape :: TapeProg ()
1919+
stepTape = use (psTape . tFocus) >>= \case
1920+
OSnd x -> do
1921+
lift . lift . sndMachine =<< addrVal x
1922+
advance 1
1923+
OBin f x y -> do
1924+
yVal <- addrVal y
1925+
psRegs . at x . non 0 %= (`f` yVal)
1926+
advance 1
1927+
ORcv x -> do
1928+
y <- lift . lift . rcvMachine
1929+
=<< use (psRegs . at x . non 0)
1930+
psRegs . at x . non 0 .= y
1931+
advance 1
1932+
OJgz x y -> do
1933+
xVal <- addrVal x
1934+
moveAmt <- if xVal > 0
1935+
then addrVal y
1936+
else return 1
1937+
advance moveAmt
1938+
where
1939+
addrVal (Left r) = use (psRegs . at r . non 0)
1940+
addrVal (Right x) = return x
1941+
advance n = do
1942+
Just t' <- move n <$> use psTape
1943+
psTape .= t'
1944+
```
1945+
1946+
Sorry for the gratuitous usage of `lens`! It's just so convenient for a
1947+
`State` context :) `use` is basically a way to *get* a specific part of our
1948+
state (`psTape . tFocus` gets us the focus of our state's tape). `%=` allows
1949+
us to modify values in our state with a given function. `.=` allows us to set
1950+
values in our state to a given value.
1951+
1952+
`psRegs . at x . non 0` is an interesting lens (that we can give to `use` or
1953+
`%=`), and does most of our heavy lifting in managing our registers. This gets
1954+
the value in the `_psRegs` register of our state, at the *key* `x`, *but*
1955+
treating it as 0 if the key is not found.
1956+
1957+
So, something like:
1958+
1959+
```haskell
1960+
psRegs . at x . non 0 .= y
1961+
```
1962+
1963+
Will set the register map's key `x` to be `y`. (Also an interesting benefit:
1964+
if `y` is 0, it will delete the key `x` from the map for us)
1965+
1966+
And, something like:
1967+
1968+
```haskell
1969+
psRegs . at x . non 0 %= (`f` yVal)
1970+
```
1971+
1972+
Will modify the register map's key `x` value with the function ``(`f` yVal)``.
1973+
1974+
```haskell
1975+
use (psRegs . at r . non 0)
1976+
```
1977+
1978+
Will give us the current register's key `r` value, giving us 0 if it does not
1979+
exist.
1980+
1981+
Knowing this, you should be able to see most of the logic going on here. I had
1982+
a bit of fun with the definition of `advance`. `move n` is from our `Tape`
1983+
API, and returns `Nothing` if you move out of the tape bounds. Pattern
1984+
matching on `Just` lets us trigger the "failure" case if the pattern match
1985+
fails, which for `MaybeT m` is `MaybeT (return Nothing)` -- a "`Maybe`
1986+
failure".
1987+
1988+
Now, `stepTape` is an action (in `State` and `Maybe`) that uses an underlying
1989+
`Machine` monad to step our tape one single step. We can "run" it purely to
1990+
get the underlying `Machine` action using:
1991+
1992+
```haskell
1993+
execTapeProg :: TapeProg a -> ProgState -> Machine ProgState
1994+
execTapeProg tp ps = flip execStateT ps . runMaybeT $ tp
1995+
```
1996+
1997+
Which will "run" a `TapeProg a`, with a given state, to produce the `Machine`
1998+
action (basically, a tree of nested `CRcv` and `CSnd`).
1999+
2000+
Conceptually, this is similar to how `execStateT :: StateT s IO a -> IO s`
2001+
produces an `IO` action that computes the final state that the `execStateT`
2002+
encodes.
2003+
2004+
We now have an action to take our tape a single step, but our Part 1 program
2005+
actually wants us to repeat the action until we go out of bounds. This looks
2006+
like a job for `many`, from the very popular `Alternative` typeclass (from
2007+
*Control.Applicative*)):
2008+
2009+
```haskell
2010+
many :: MaybeT m a -> MaybeT m [a]
2011+
many :: TapeProg a -> TapeProg [a]
2012+
```
2013+
2014+
`many` essentially repeats an action several times until it fails. For the
2015+
case of `TapeProg`, this means that it repeats an action several times until
2016+
the tape head goes out of bounds:
2017+
2018+
```haskell
2019+
stepTape :: TapeProg ()
2020+
many stepTape :: TapeProg [()]
2021+
```
2022+
17922023
### Day 18 Benchmarks
17932024

17942025
```

‎src/AOC2017/Day18.hs‎

Lines changed: 46 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,12 @@ import Data.Maybe (fromJust, maybeToList)
2424
import qualified Data.Map as M
2525
import qualified Data.Vector.Sized as V
2626

27+
{-
28+
******************
29+
* The Language *
30+
******************
31+
-}
32+
2733
type Addr = Either Char Int
2834

2935
addr :: String -> Addr
@@ -35,56 +41,67 @@ data Op = OSnd Addr
3541
| ORcv Char
3642
| OJgz Addr Addr
3743

38-
instance Show Op where
39-
show _ = "Op"
40-
4144
parseOp :: String -> Op
4245
parseOp inp = case words inp of
4346
"snd":(addr->c):_ -> OSnd c
4447
"set":(x:_):(addr->y):_ -> OBin (const id) x y
45-
"add":(x:_):(addr->y):_ -> OBin (+) x y
46-
"mul":(x:_):(addr->y):_ -> OBin (*) x y
47-
"mod":(x:_):(addr->y):_ -> OBin mod x y
48+
"add":(x:_):(addr->y):_ -> OBin (+) x y
49+
"mul":(x:_):(addr->y):_ -> OBin (*) x y
50+
"mod":(x:_):(addr->y):_ -> OBin mod x y
4851
"rcv":(x:_):_ -> ORcv x
4952
"jgz":(addr->x):(addr->y):_ -> OJgz x y
5053
_ -> error "Bad parse"
5154

5255
parse :: String -> Tape Op
5356
parse = unsafeTape . map parseOp . lines
5457

55-
dataProgState=PS{_psTape::TapeOp
56-
, _psRegs::M.MapCharInt
57-
}
58-
59-
makeClassy ''ProgState
58+
{-
59+
**************************
60+
* The Abstract Machine *
61+
**************************
62+
-}
6063

64+
-- | Abstract data type describing "IO" available to the abstract machine
6165
data Command :: Type -> Type where
6266
CRcv :: Int -> Command Int -- ^ input is current value of buffer
6367
CSnd :: Int -> Command () -- ^ input is thing being sent
6468

69+
type Machine = Prompt Command
70+
71+
rcvMachine :: Int -> Machine Int
72+
rcvMachine = prompt . CRcv
73+
74+
sndMachine :: Int -> Machine ()
75+
sndMachine = prompt . CSnd
76+
77+
data ProgState = PS { _psTape :: Tape Op
78+
, _psRegs :: M.Map Char Int
79+
}
80+
makeClassy ''ProgState
81+
6582
-- | Context in which Tape commands are run. Tape commands have access to
66-
-- an underlying 'Prompt Command' effect monad that allows it to 'Rcv' and
83+
-- an underlying 'Machine' effect monad that allows it to 'Rcv' and
6784
-- 'Snd'.
6885
--
6986
-- Nothing = program terminates by running out of bounds
70-
type TapeProg = MaybeT (StateT ProgState (PromptCommand))
71-
execTapeProg :: TapeProg a -> ProgState -> PromptCommand ProgState
87+
type TapeProg = MaybeT (StateT ProgState Machine)
88+
execTapeProg :: TapeProg a -> ProgState -> Machine ProgState
7289
execTapeProg tp ps = flip execStateT ps . runMaybeT $ tp
7390

7491
-- | Single step through program tape.
7592
stepTape :: TapeProg ()
7693
stepTape = use (psTape . tFocus) >>= \case
7794
OSnd x -> do
78-
lift . lift . prompt .CSnd =<< addrVal x
95+
lift . lift . sndMachine =<< addrVal x
7996
advance 1
8097
OBin f x y -> do
8198
yVal <- addrVal y
8299
psRegs . at x . non 0 %= (`f` yVal)
83100
advance 1
84101
ORcv x -> do
85-
y <- lift . lift . prompt .CRcv
102+
y <- lift . lift . rcvMachine
86103
=<< use (psRegs . at x . non 0)
87-
psRegs . at x .=Just y
104+
psRegs . at x . non 0.= y
88105
advance 1
89106
OJgz x y -> do
90107
xVal <- addrVal x
@@ -99,6 +116,12 @@ stepTape = use (psTape . tFocus) >>= \case
99116
Just t' <- move n <$> use psTape
100117
psTape .= t'
101118

119+
{-
120+
************************
121+
* Context for Part A *
122+
************************
123+
-}
124+
102125
-- | Context in which to interpret Command for Part A
103126
--
104127
-- State parameter is the most recent sent item. Writer parameter is all
@@ -125,6 +148,12 @@ day18a = show
125148
. execTapeProg (many stepTape) -- stepTape until program terminates
126149
. (`PS` M.empty) . parse
127150

151+
{-
152+
************************
153+
* Context for Part B *
154+
************************
155+
-}
156+
128157
-- | Context in which to interpret Command for Part B
129158
--
130159
-- The State parameter is the input buffer, the Writer parameter is the

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /