Getting Rewrite Rules from ModGuts
Brandon Allbery
allbery.b at gmail.com
Fri Apr 12 03:06:08 UTC 2019
You might need to enable optimization for RULES to get picked up at all.
On Thu, Apr 11, 2019 at 11:03 PM Bill Hallahan <william.hallahan at yale.edu>
wrote:
> 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
> #-}
> _______________________________________________
> ghc-devs mailing list
> ghc-devs at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>
--
brandon s allbery kf8nh
allbery.b at gmail.com
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20190411/513ea339/attachment.html>
More information about the ghc-devs
mailing list