public
Last active

Using Multiplate with a plate containing a field for each constructor.

  • Download Gist
multiplate.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.