Plugins05_Helper.hs 1.28 KB
Newer Older
batterseapower's avatar
batterseapower committed
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 Plugins05_Helper where

import GHCPlugins

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

install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _options todos = do
    return $ (CoreDoPluginPass "String replacement" $ BindsToBindsPluginPass 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)