Created

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

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

View multiplate.hs
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.