Getting Rewrite Rules from ModGuts
Bill Hallahan
william.hallahan at yale.edu
Fri Apr 12 03:02:45 UTC 2019
Hi,
I'm trying to use the GHC API (8.2.2) to extract the rewrite rules from a module, but have run into some difficulties. I've written the following code (all code is also attached as files):
module Main where
import GHC
import GHC.Paths
import HscTypes
main :: IO ()
main = do
loadProj "Test.hs"
loadProj :: FilePath -> IO ()
loadProj src = do
modgutss <- runGhc (Just libdir) $ do
flags <- getSessionDynFlags
_ <- setSessionDynFlags flags
target <- guessTarget src Nothing
_ <- setTargets [target]
_ <- load LoadAllTargets
mod_graph <- getModuleGraph
parsed_mods <- mapM parseModule mod_graph
typed_mods <- mapM typecheckModule parsed_mods
desug_mods <- mapM desugarModule typed_mods
return $ map coreModule desug_mods
let rules = map (\mg -> ( moduleNameString . moduleName $ mg_module mg
, length $ mg_rules mg)
) modgutss
print $ rules
return ()
It loads Test.hs (see below my signature) which contains a single rewrite rule. Then, it obtains the ModGuts, and prints a tuple of the name of the module, and the length of the rule list. I would expect this to be ("Test", 1), but, in fact, what gets printed is ("Test", 0). For some reason, the ModGuts does not have the rewrite rule from the file.
I'm guessing I'm misunderstanding something about how the GHC API works. If anyone has any advice about how to fix this code to load rewrite rules (or even where to begin looking) I would appreciate it!
Thanks,
Bill Hallahan
Test.hs:
module Test where
import Prelude hiding (map)
map :: (a -> b) -> [a] -> [b]
map f (x:xs) = f x:map f xs
map _ [] = []
{-# NOINLINE [0] map #-}
{-# RULES
"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
#-}
-------------- next part --------------
A non-text attachment was scrubbed...
Name: Main.hs
Type: application/octet-stream
Size: 822 bytes
Desc: not available
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20190411/d0775bd5/attachment.obj>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: Test.hs
Type: application/octet-stream
Size: 224 bytes
Desc: not available
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20190411/d0775bd5/attachment-0001.obj>
More information about the ghc-devs
mailing list