W tej notatce chciałbym wspomnieć o dość ciekawym tworze, jaką jest monada Tardis. Każdy, kto oglądał dra Who, najpewniej wie, czym Tardis był. Za jaki efekt uboczny odpowiada monada Tardis w Haskellu?
Wyobraźmy sobie sytuację, w której musimy zaimplementować poniższe zadanie:
Dana jest niepusta lista. Napisać funkcję, która podmienia każdy element listy na element maksymalny listy.
Nie jest to problemem, gdybyśmy mieli napisać ten algorytm ot tak:
naive :: (Ord a) => [a] -> [a]
naive xs = let m = foldr1 max xs in replicate (length xs) mCiekawszym problemem jest zaimplementowanie tej funkcji w taki sposób, by można było poznać element maksymalny oraz podmienić elementy listy w jednym przebiegu.
By to zrobić, nasza strategia jest następująca: załóżmy, że doznaliśmy objawienia i element m dostaliśmy z góry. Funkcja pomocnicza będzie podmieniała elementy na m i jednakowo będzie obliczała element maksymalny
listy. Wygląda to tak:
go _ [] = error "non-empty list expected"
go m [x] = (x, [m])
go m (x : xs) = let (n, y : ys) = go m xs in (max n y, m : ys)Szukanie elementu maksymalnego polega na wybranie większej liczby z dwóch: bieżącej, którą podmieniamy, bądź największej w pozostałej części listy pomniejszonej o y. Podmienianie raczej nie pozostawia wątpliwości.
Mając taką funkcję pomocniczą możemy napisać wprost implementację:
doAlgo xs = let (m, ys) = go m xs in ysMożesz się pewnie zastanawiać...
Element, który obliczyliśmy w pierwszym elemencie pary stał się równocześnie argumentem funkcji pomocniczej. Czy to czasami nie jest coś, co się zapętli?
Istotnie, nie. Haskell jest, przede wszystkim, językiem o leniwej semantyce ewaluacji. Znaczy to tyle, że podstawienie m nie jest równoważne jej ewaluacji, wręcz przeciwnie, m jest odwlekane z ewaluacją, do momentu gdy rzeczywiście będzie potrzebna jej wartość. Ponieważ funkcja go jest ufundowana, to mamy gwarancję, że m zostanie obliczone w skończonym czasie.
Należy również zauważyć inną ciekawą rzecz, że leniwa semantyka pozwala nam na poznawanie rzeczy, które de facto pochodzą z przyszłości. Jak to rozumieć? W naiwnym algorytmie najpierw obliczyliśmy m a potem dokonaliśmy podmiany. Tutaj dokonujemy podmiany znając m, które dopiero zostanie obliczone przez ten sam algorytm. Stąd m pochodzi z przyszłości względem operacji podmiany elementów.
W oderwaniu od tamtej historii, by poznać lepszy kontekst samej monady Tardis, porozmawiamy nieco o stanie. W Haskellu obliczenia oparte o jakiś stan s opisujemy jako funkcje typu s -> (a, s). Rozumiemy to jako funkcje, które pobierają stan s i zwracają krotkę, która zawiera rezultat pewnej akcji a, przy kolejnej, potencjalnie zmodyfikowanej, instancji stanu s. Ponieważ sam stan ma monadyczną naturę, twórcy biblioteki mtl i transformers nie omieszkali dodać monady State, która prezentuje się następująco:
newtype State s a = State { runState :: s -> (a, s) }
-- ...
instance Monad (State s) where
st >>= f = State $ \s -> let (a, s') = runState st s
(b, s'') = runState (f a) s'
in (b, s'')
get :: State s s
get = State $ \s -> (s, s)
put :: s -> State s ()
put s = State $ \_ -> ((), s)Jest to dość często wykorzystywana monada w różnych kontekstach, w których kluczowy jest stan. Przykładowym obliczeniem opartym na stanie jest poniższa funkcja:
timesTwo :: Int -> State Int Int
timesTwo x = do
counter <- get
put (counter + 1)
return (2 * x)
getCounter :: State Int Int
getCounter = getInspirując się naszym algorytmem, możemy utworzyć monadę, w której stan jest przetwarzany od ostatniego do pierwszego binda, co za tym idzie, według notacji do taki stan będzie się poruszać do tyłu względem zapisanych tam "instrukcji".
newtype RState s a = RState { runRState :: s -> (a, s) }
evalRState :: RState s a -> s -> a
evalRState rs s = let (a, _) = runRState rs s in a
-- ...
instance Monad (RState s) where
rs >>= f = RState $ \s -> let (a, s'') = runRState rs s'
(b, s') = runRState (f a) s
in (b, s'')
get :: RState s s
get = RState $ \s -> (s, s)
put :: s -> RState s ()
put s = RState $ \_ -> ((), s)
modify :: (s -> s) -> RState s ()
modify f = RState $ \s -> ((), f s)Jak to odnieść do naszego algorytmu? Spróbujmy napisać ten sam algorytm za pomocą tej monady.
doAlgo' :: (Ord a) => [a] -> RState a [a]
doAlgo' [] = return []
doAlgo' (x:xs) = do
m <- get
modify (max x)
ys <- doAlgo' xs
return (m : ys)Analizując stan od dołu do góry otrzymujemy ten sam algorytm co wcześniej. Przedostatnia linia daje nam maksymalny element listy xs, po czym aktualizujemy ten stan za pomocą modify i wyciągamy m, które jest de facto z przyszłości.
Możemy również przyjrzeć się definicji liczb Fibonacciego zapisaną za pomocą RState:
fibs :: RState [Integer] [Integer]
fibs = do
fibs <- get
modify (scanl (+) 0)
put (1 : fibs)
return fibsOtrzymujemy obliczone fibs z przyszłości, dopisując do niego 1 i tym samym otrzymujemy listę [1, 0, 1, 1, 2, 3, 5, ...]. Jak można zauważyć, ta lista jest listą różnic następnego elementu od poprzedniego liczb Fibonacciego. Stąd, by móc odzyskać je z powrotem, liczymy sumy prefiksowe za pomocą scanl (+) 0.
Dziwnie i piękne, prawda?
Tardis jest monadą, która ma dwa stany stan fw, który działa tak samo jak w State i stan bw, który działa jak stan RState. Te stany są od siebie niezależne i można myśleć jak o produkcie dwóch stanów biegnących w dwie różne strony. Oczywiście można się zastanawiać, do czego może być to potrzebne.
Pisząc kompilator dowolnego języka, często natrafiamy na problem, kiedy język pozwala na definiowanie różnych nazw abstrahując od kolejności definicji. Oczywiście, by rozwiązać ten problem, można podjąć się dwóch ścieżek działania:
- Można napisać osobną funkcję do skanowania drzewa syntaktycznego, by uzyskać definicje w tabeli symboli, a później przetwarzać kod;
- Można użyć monady
Tardis.
Oczywiście posłużymy się drugą metodą.
Weźmy na cel prosty assembler, który jest kodem maszyny RAM.
data RamStmt
= RamZero Positive
| RamInc Positive
| RamCpy Positive Positive
| RamJmpEq Positive Positive RamJmpAddr
| RamLabel String
| RamHalt
data RamJmpAddr
= RamLabelAddr String
| RamRawAddr Integer
newtype RamProgram = RamProgram [RamStmt]
instance Show RamStmt where
show (RamZero n) = "ZERO " ++ show n
show (RamInc n) = "INC " ++ show n
show (RamCpy n m) = "CPY " ++ show n ++ " " ++ show m
show (RamJmpEq n m addr) = "JMPEQ " ++ show n ++ " " ++ show m ++ " " ++ show addr
show (RamLabel name) = "LABEL " ++ name
show RamHalt = "HALT"
instance Show RamJmpAddr where
show (RamLabelAddr name) = show name
show (RamRawAddr addr) = show addr
instance Show RamProgram where
show (RamProgram stmts) = go stmts 0
where
go [] _ = ""
go (s:ss) pc = show pc ++ " " ++ show s ++ "\n" ++ go ss (pc + 1)Oczywiście maszyna RAM nie definiuje czegoś takiego jak instrukcja definicji etykiety, jak również nie definiuje adresu docelowego jako etykieta. Naszym zadaniem będzie eliminacja etykiet w docelowym kodzie w jednym przebiegu.
Zacznijmy od monady, która udostępni pozwoli na pozyskanie z przyszłości i w sposób konwencjonalny tabeli etykiet, która będzie zwyczajną mapą z nazw etykiet w konkretne adresy.
import Data.Map (Map)
import qualified Data.Map as Map
type LabelTab = Map String Positive
type Backpatcher a = Tardis LabelTab LabelTab aTeraz napiszemy funkcję, która będzie jednocześnie zarządzać tabelami etykiet oraz będzie podstawiać etykiety na skuteczne adresy. Oczywiście funkcja będzie zarządzać adresem bieżąco przetwarzanej instrukcji.
backpatch :: Positive -> [RamStmt] -> Backpatcher [RamStmt]Przypadek bazowy, gdy mamy pustą listę instrukcji, jest dość prosty:
backpatch _ [] = return []Teraz możemy zająć się przypadkiem, gdy mamy do czynienia z definicją. Generalnie definicje etykiet są globalne a ich kolejność występowania nie ma znaczenia (w przeciwnym wypadku naprawdę trudno byłoby robić if-y albo pętle while). Idea polega na tym, że będziemy aktualizować stan w przyszłość i w przeszłość, stąd że kolejność nie ma żadnego znaczenia.
backpatch pc (RamLabel name : ss) = do
modifyBackwards (Map.insert name pc)
modifyForwards (Map.insert name pc)
backpatch (pc + 1) ssTeraz zajmiemy się instrukcją, która dokonuje skoku warunkowego. Będziemy łączyć obydwie tabele (z przyszłości i przeszłości) i sprawdzać, czy istnieje definicja etykiety w tabeli. Jeśli tak, podmieniamy na skuteczny adres skoku. Jeśli nie --- pozostawiamy w smutku instrukcję, która jest błędna.
backpatch pc (s@(RamJmpEq n m (RamLabelAddr name)) : ss) = do
table <- Map.union <$> getPast <*> getFuture
let s' = case Map.lookup name table of
Just addr -> RamJmpEq n m (RamRawAddr addr)
Nothing -> s
ss' <- backpatch (pc + 1) ss
return (s' : ss')Dla przypadków, kiedy nie mamy do czynienia z etykietami, po prostu pozostawiamy instrukcje w spokoju.
backpatch pc (s : ss) = do
ss' <- backpatch (pc + 1) ss
return (s : ss')Po czym możemy napisać funkcję, która będzie wieńczyć nasze dzieło:
runBackpatch :: RamProgram -> RamProgram
runBackpatch (RamProgram stmts) = RamProgram stmts'
where stmts' = runTardis (backpatch 0 stmts) (Map.empty, Map.empty)Tym sposobem możemy zobaczyć, jak radzi sobie nasze narzędzie:
-- | Short RAM program that does @m[1] <= m[2]@ and returns result to @m[0]@
le :: RamProgram
le = RamProgram
[ RamZero 3
, RamLabel "loop"
, RamJmpEq 1 3 (RamJmpAddr "go_over")
, RamJmpEq 2 3 (RamJmpAddr "done")
, RamInc 3
, RamLabel "go_over"
, RamJmpEq 0 0 (RamJmpAddr "loop")
, RamInc 0
, RamLabel "done"
, RamHalt
]
main = print $ runBackpatch lePo czym naszym oczom ukazuje się:
0 ZERO 3
1 JMPEQ 1 3 5
2 JMPEQ 2 3 6
3 INC 3
4 JMPEQ 0 0 1
5 INC 0
6 HALT
Widzimy, że nie tylko Tardis mógłby się sprawdzać w assemblerach. Można go również wykorzystać w innych językach i definicjach, w których kolejność nie ma znaczenia. To pozwala na pisaniu większości kodu w sposób ograniczający przebiegi kompilatora.