Create a gist now

Instantly share code, notes, and snippets.

Using Multiplate with a plate containing a field for each constructor.
import Control.Applicative
import Data.Generics.Multiplate
import Data.Functor.Constant
import Data.Functor.Identity
data Expr = Con Int
| Add Expr Expr
| Mul Expr Expr
| EVar Var
| Let Decl Expr
deriving (Eq, Show)
data Decl = Var := Expr
| Seq Decl Decl
deriving (Eq, Show)
type Var = String
data Plate f = Plate
{ con :: Int -> f Expr
, add :: Expr -> Expr -> f Expr
, mul :: Expr -> Expr -> f Expr
, evar :: Var -> f Expr
, lett :: Decl -> Expr -> f Expr
, asgn :: Var -> Expr -> f Decl
, seqq :: Decl -> Decl -> f Decl
}
expr :: Plate f -> Expr -> f Expr
expr plate (Con i) = con plate i
expr plate (Add e1 e2) = add plate e1 e2
expr plate (Mul e1 e2) = mul plate e1 e2
expr plate (EVar v) = evar plate v
expr plate (Let d e) = lett plate d e
decl :: Plate f -> Decl -> f Decl
decl plate (v := e) = asgn plate v e
decl plate (Seq d1 d2) = seqq plate d1 d2
instance Multiplate Plate where
multiplate plate = Plate
(\i -> pure (Con i))
(\e1 e2 -> Add <$> expr plate e1 <*> expr plate e2)
(\e1 e2 -> Mul <$> expr plate e1 <*> expr plate e2)
(\v -> pure (EVar v))
(\d e -> Let <$> decl plate d <*> expr plate e)
(\v e -> (:=) <$> pure v <*> expr plate e)
(\d1 d2 -> Seq <$> decl plate d1 <*> decl plate d2)
mkPlate build = Plate
(\i -> build expr (Con i))
(\e1 e2 -> build expr (Add e1 e2))
(\e1 e2 -> build expr (Mul e1 e2))
(\v -> build expr (EVar v))
(\d e -> build expr (Let d e))
(\v e -> build decl (v := e))
(\d1 d2 -> build decl (Seq d1 d2))
getVariablesPlate :: Plate (Constant [Var])
getVariablesPlate = purePlate { evar = \v -> Constant [v] }
variablesPlate :: Plate (Constant [Var])
variablesPlate = preorderFold getVariablesPlate
ex1 :: Expr
ex1 = Let ("x" := Con 42) (Add (EVar "x") (EVar "x"))
testVars :: [Var]
testVars = foldFor expr variablesPlate ex1
doConstFold :: Plate Identity
doConstFold = purePlate { add = addCons, mul = mulCons }
where
addCons (Con x) (Con y) = pure $ Con (x + y)
addCons x y = pure $ Add x y
mulCons (Con x) (Con y) = pure $ Con (x * y)
mulCons x y = pure $ Mul x y
constFoldPlate :: Plate Identity
constFoldPlate = mapFamily doConstFold
decl1 :: Decl
decl1 = "x" := (Add (Mul (Con 42) (Con 68)) (Con 7))
testCF :: Decl
testCF = traverseFor decl constFoldPlate decl1
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment