deque-blog

type Algebra f = f (Fix f) -> Fix f

comp :: Algebra f -> Algebra f -> Algebra f
comp f g = f . unFix . g

compAll :: Foldable t => t (Algebra f) -> Algebra f
compAll fs = foldr1 comp fs

deque-blog

optimize :: Expr -> Expr
optimize = cata (optimizeMul `comp` optimizeAdd)

deque-blog

replaceKnownVars :: Env -> ExprR Expr -> Expr
replaceKnownVars env = go where
  go e@(Var v) =
    case Map.lookup v env of
      Just val -> cst val
      Nothing -> Fix e
  go e = Fix e

deque-blog

partial :: Env -> Expr -> Expr
partial env = cata (compAll [optimizeMul, optimizeAdd, replaceKnownVars env])

eval :: Env -> Expr -> Int
eval env expr =
  case partial env expr of
    (Fix (Cst n)) -> n
    e -> error $ "Missing vars: " ++ show (dependencies e)

deque-blog

import Control.Monad.Cont

cataCps :: (Traversable f) => (f a -> a) -> Fix f -> a
cataCps algebra expr = runCont (recur algebra expr) id

recur :: (Traversable f) => (f a -> a) -> Fix f -> Cont a a
recur algebra (Fix expr) = do
  sub <- sequence $ fmap (recur algebra) expr
  return (algebra sub)

deque-blog

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}

data OpType = Add | Mul deriving (Show, Eq, Ord)

data ExprR r
  = Cst Int
  | Var Id
  | Op OpType [r]
  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)

deque-blog

[:add 1 2
 [:mul 0 "x" "y"]
 [:mul 1 "y" 2]
 [:add 0 "x"]]

deque-blog

(defn cst [n] n)
(defn sym [s] s)
(defn add [& args] (into [:add] args))
(defn mul [& args] (into [:mul] args))

deque-blog

(defn rator [e] (first e))
(defn rands [e] (rest e))

(defn cst? [n] (number? n))
(defn sym? [v] (string? v))
(defn op?  [e] (vector? e))
(defn add? [e] (and (op? e) (= (rator e) :add)))
(defn mul? [e] (and (op? e) (= (rator e) :mul)))

deque-blog

(def expr
  (add
    (cst 1) (cst 2)
    (mul (cst 0) (sym "x") (sym "y"))
    (mul (cst 1) (sym "y") (cst 2))
    (add (cst 0) (sym "x"))))