1%if false  
2  Copyright (c) 2009, ETH Zurich.
3  All rights reserved.
4  
5  This file is distributed under the terms in the attached LICENSE file.
6  If you do not find this file, copies can be found by writing to:
7  ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
8%endif
9
10%include polycode.fmt
11
12%if false
13
14> module Semantics where
15
16> import Control.Monad
17
18%endif
19
20\section{Plumbing Machinery}
21\label{sec:semantics_machinery}
22
23
24The material presented in this chapter relies on some hairy concepts
25from Category Theory. If you are curious about these things, Edward
26Kmett wrote a nice blog post~\cite{kmett-free-monad} on the
27subject. The first version of FoF, and in particular this file, relied
28on Wouter Swierstra solution to the expression
29problem~\cite{swierstra-expression}. However, the burden of this
30approach on the type-system was unbearable for our users. 
31
32Our motivation is to build a monad in which one can naturally write
33sequential code, just as an imperative language. Each construct of the
34language is defined in @Constructs@ by the |FoFConst|
35data-type. Purposely, this data-type implements a functor. The code
36below generically turn a functor |f| into a |Semantics f|
37monad. Hence, in @Constructs@, we apply this machinery to make a monad
38out of |FoFConst|.
39
40
41\subsection{The Semantics Monad}
42
43
44We build a monad |Semantics f| out of a function |f| thanks to the
45following data-type:
46
47> data Semantics f a = Pure a
48>                    | Impure (f (Semantics f a))
49
50
51First of all, we show that this defines a functor:
52
53> instance Functor f => Functor (Semantics f) where
54>     fmap f (Pure x) = Pure (f x)
55>     fmap f (Impure t) = Impure (fmap (fmap f) t)
56
57We need to (as of GHC 7.10) implement Applicative
58
59> instance (Functor f) => Applicative (Semantics f) where
60>     pure = return
61>     (<*>) = ap
62
63Then, we obtain the monad:
64
65> instance Functor f => Monad (Semantics f) where
66>     return = Pure
67>     (Pure x) >>= f = f x
68>     (Impure t) >>= f = Impure (fmap (>>= f) t)
69
70Terms are embedded into the monad thanks the following function:
71
72> inject :: f (Semantics f a) -> Semantics f a
73> inject x = Impure x
74
75
76
77\subsection{Folding the Free Monad}
78
79
80Finally, once we have built the monad, we will need to manipulate its
81content. For example, we will be willing to evaluate it, or to compile
82it, etc. All these operations can be implemented by folding over the
83monadic code, that is traversing the constructs in their definition
84order and computing an output of type @b@. Note that we have to
85distinguish |Pure| terms, which are simply values, from |Impure| ones,
86which are the embedded constructs.
87
88> foldSemantics :: Functor f => (a -> b) -> (f b -> b) -> Semantics f a -> b
89> foldSemantics pure imp (Pure x) = pure x
90> foldSemantics pure imp (Impure t) = imp $ fmap (foldSemantics pure imp) t
91
92
93\subsection{Sequencing in the Free Monad}
94
95Provided a list of monadic code, we are able to turn them into a
96single monadic code returning a list of terms. This corresponds to the
97|sequence| function in the IO monad:
98
99> sequenceSem ms = foldr k (return []) ms
100>     where k m m' = 
101>               do
102>                 x <- m
103>                 xs <- m'
104>                 return (x : xs)
105