<div dir="ltr"><div>Hello all,</div><div><br></div><div>I recently read the article "Understanding F-algebras"[1], which goes over the usage of F-algebras for e.g. evaluating ASTs. This article goes over how</div><div><br></div><div><br></div><div>1. Data.Fix creates the initial F-algebra over a functor f.</div><div><br></div><div>2. We can express our AST as a non-recursive functor instead of a recursive type</div><div><br></div><div>3. We can express our evaluator as an Algebra (of the type `f a -> a`, where f is the type of our AST and `a` is the Algebra's carrier type, i.e. our result type)</div><div><br></div><div>4. We can express terms in our language as members of the type `Fix AST` (i.e. the initial F-algebra over our AST).</div><div><br></div><div>5. By using a catamorphism over our evaluator algebra, we can easily construct an efficient evaluator.</div><div><br></div><div><br></div><div>As a brief example of these principles, see the following program (using DeriveFunctor):</div><div><br></div><div>data AST a = Lit Int | Add a a deriving Functor</div><div>-- data Fix f = Fix (f (Fix f)) -- defined in Data.Fix</div><div>type AST' = Fix AST</div><div>program :: AST'</div><div>program = Fix $ Add (Fix $ Lit 5) (Fix $ Lit 4)</div><div>alg :: AST Int -> Int</div><div>alg (Lit i) = i</div><div>alg (Add l r) = l + r</div><div>eval :: AST' -> Int</div><div>eval = Data.Fix.cata alg</div><div>main = print $ eval program</div><div><br></div><div>This is super cool!</div><div><br></div><div>One thing that stood out to me is that there are a number of similarities here with the usage of the Free Monad. In particular, see "Why free monads matter" [2]. This article is doing basically the exact same thing. You express your AST as a non-recursive functor parametrized over the type of subterms. However, instead of making your terms of type `Fix AST`, they are of type `Free AST a`.</div><div><br></div><div>Now, the recursive constructor for Free is almost identical to the constructor for Fix, except of course the additional type parameter `a`. However, both types are of the form `data T = R (f T)`. Free simply has the additional `Pure` constructor as well.</div><div><br></div><div>So obviously, there is some sort of relationship here. However, I don't have a good enough grasp on these concepts for the relationship to make itself fully apparent. Some things I've noticed:</div><div><br></div><div>Operations on `Fix AST` terminate because the AST type has leaf constructors without recursion. So a catamorphism over an evaluation algebra can plausibly terminate because eventually it will hit a leaf node and the evaluation will stop. On the other hand, operations on `Free AST a` can also terminate because you might run into a `Pure` constructor. The difference being that `Pure` is a part of the wrapper type (Free) and not the wrapped type (AST). </div><div><br></div><div>A practical question I have is: Can we use the Free Monad to write AST terms using `do` notation (useful for DSLs) and then use the elegant catamorphism evaluator trick (or something similar) to evaluate our ASTs? Or does evaluating the Free Monad require something more general due to the Pure constructor? It looks like `Control.Monad.Free.iter` might be equivalent to `Data.Fix.cata`, but I'm not sure. It looks like a rough translation works in this case:</div><div><br></div><div>data AST a = Add a a deriving Functor -- No more "Const"</div><div>type AST' a = Free AST a</div><div>program :: AST' Int</div><div>program = Free $ Add (Pure 5) (Pure 4)</div><div>alg :: AST Int -> Int</div><div>alg (Add l r) = l + r</div><div>eval :: AST' Int -> Int</div><div>eval = Control.Monad.Free.iter alg</div><div>main = print $ eval program</div><div><br></div><div>So, intuitively, it seems like Free lets us do basically the same thing as Fix but with the evaluation result present as the last argument of the expression type.</div><div><br></div><div>Sorry for being a bit rambly, and I may also be completely off base here, so correct me if I'm not making any sense. </div><div><br></div><div>Cheers,</div><div>Will</div><div><br></div><div>[1] <a href="https://www.schoolofhaskell.com/user/bartosz/understanding-algebras">https://www.schoolofhaskell.com/user/bartosz/understanding-algebras</a></div><div><br></div><div>[2] <a href="http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html">http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html</a></div></div>