summaryrefslogtreecommitdiff
path: root/testsuite/tests/plugins/HomePackagePlugin.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/plugins/HomePackagePlugin.hs')
-rw-r--r--testsuite/tests/plugins/HomePackagePlugin.hs34
1 files changed, 34 insertions, 0 deletions
diff --git a/testsuite/tests/plugins/HomePackagePlugin.hs b/testsuite/tests/plugins/HomePackagePlugin.hs
new file mode 100644
index 0000000000..3a5318a2b7
--- /dev/null
+++ b/testsuite/tests/plugins/HomePackagePlugin.hs
@@ -0,0 +1,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) \ No newline at end of file