Rename literal constructors
[ghc.git] / testsuite / tests / plugins / HomePackagePlugin.hs
1 module HomePackagePlugin where
2
3 import GhcPlugins
4
5 plugin :: Plugin
6 plugin = defaultPlugin {
7 installCoreToDos = install
8 }
9
10 install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
11 install _options todos = do
12 return $ (CoreDoPluginPass "String replacement" $ bindsOnlyPass stringReplacementPass) : todos
13
14 stringReplacementPass :: [CoreBind] -> CoreM [CoreBind]
15 stringReplacementPass binds = return $ map replaceInBind binds
16
17 replaceInBind :: CoreBind -> CoreBind
18 replaceInBind (NonRec b e) = NonRec b (replaceInExpr e)
19 replaceInBind (Rec bes) = Rec [(b, replaceInExpr e) | (b, e) <- bes]
20
21 replaceInExpr :: CoreExpr -> CoreExpr
22 replaceInExpr (Var x) = Var x
23 replaceInExpr (Lit (LitString _)) = mkStringLit "Hello From The Plugin" -- The payload
24 replaceInExpr (Lit l) = Lit l
25 replaceInExpr (Lam b e) = Lam b (replaceInExpr e)
26 replaceInExpr (App e1 e2) = App (replaceInExpr e1) (replaceInExpr e2)
27 replaceInExpr (Let bi e) = Let (replaceInBind bi) (replaceInExpr e)
28 replaceInExpr (Tick t e) = Tick t (replaceInExpr e)
29 replaceInExpr (Cast e co) = Cast (replaceInExpr e) co
30 replaceInExpr (Case e b ty alts) = Case (replaceInExpr e) b ty (map replaceInAlt alts)
31 replaceInExpr (Type ty) = Type ty
32
33 replaceInAlt :: CoreAlt -> CoreAlt
34 replaceInAlt (ac, bs, e) = (ac, bs, replaceInExpr e)