summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/plugins/HomePackagePlugin.hs
blob: 3a5318a2b72ea7c2da123cccb8e38be19fab0db7 (plain)
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
module HomePackagePlugin where

import GhcPlugins

plugin :: Plugin
plugin = defaultPlugin {
        installCoreToDos = install
    }

install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _options todos = do
    return $ (CoreDoPluginPass "String replacement" $ bindsOnlyPass stringReplacementPass) : todos

stringReplacementPass :: [CoreBind] -> CoreM [CoreBind]
stringReplacementPass binds = return $ map replaceInBind binds

replaceInBind :: CoreBind -> CoreBind
replaceInBind (NonRec b e) = NonRec b (replaceInExpr e)
replaceInBind (Rec bes) = Rec [(b, replaceInExpr e) | (b, e) <- bes]

replaceInExpr :: CoreExpr -> CoreExpr
replaceInExpr (Var x) = Var x
replaceInExpr (Lit (MachStr _)) = mkStringLit "Hello From The Plugin" -- The payload
replaceInExpr (Lit l) = Lit l
replaceInExpr (Lam b e) = Lam b (replaceInExpr e)
replaceInExpr (App e1 e2) = App (replaceInExpr e1) (replaceInExpr e2)
replaceInExpr (Let bi e) = Let (replaceInBind bi) (replaceInExpr e)
replaceInExpr (Note no e) = Note no (replaceInExpr e)
replaceInExpr (Cast e co) = Cast (replaceInExpr e) co
replaceInExpr (Case e b ty alts) = Case (replaceInExpr e) b ty (map replaceInAlt alts)
replaceInExpr (Type ty) = Type ty

replaceInAlt :: CoreAlt -> CoreAlt
replaceInAlt (ac, bs, e) = (ac, bs, replaceInExpr e)