module Language.HERMIT.Plugin
(
HermitPass
, hermitPlugin
) where
import GhcPlugins
import Data.List
import System.IO
import Data.Char (isDigit)
import Data.Default
type HermitPass = [CommandLineOption] -> ModGuts -> CoreM ModGuts
data Options = Options { pass :: Int }
instance Default Options where
def = Options { pass = 0 }
parse :: [String] -> Options -> Options
parse (('-':'p':n):rest) o | all isDigit n = parse rest $ o { pass = read n }
parse (_:rest) o = parse rest o
parse [] o = o
hermitPlugin :: HermitPass -> Plugin
hermitPlugin hp = defaultPlugin { installCoreToDos = install }
where
install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install opts todos = do
reinitializeGlobals
liftIO $ hSetBuffering stdout NoBuffering
dynFlags <- getDynFlags
let (m_opts, h_opts) = partition (isInfixOf ":") opts
hermit_opts = parse h_opts def
myPass = CoreDoPluginPass "HERMIT" $ modFilter dynFlags hp m_opts
allPasses = insertAt (pass hermit_opts) myPass todos
return allPasses
modFilter :: DynFlags -> HermitPass -> HermitPass
modFilter dynFlags hp opts guts | null modOpts && not (null opts) = return guts
| otherwise = hp modOpts guts
where modOpts = filterOpts dynFlags opts guts
filterOpts :: DynFlags -> [CommandLineOption] -> ModGuts -> [CommandLineOption]
filterOpts dynFlags opts guts = [ drop len nm | nm <- opts, modName `isPrefixOf` nm ]
where modName = showPpr dynFlags $ mg_module guts
len = length modName + 1
insertAt :: Int -> a -> [a] -> [a]
insertAt n x xs = pre ++ (x : suf)
where (pre,suf) = splitAt n xs