[Git][ghc/ghc][wip/coreField] Add plugin pass for modifying the PartialModIface to be written

[Josh Meredith]

Josh Meredith pushed to branch wip/coreField at Glasgow Haskell Compiler / GHC


Commits:
8f62b31f by Josh Meredith at 2020-06-11T01:43:24+10:00
Add plugin pass for modifying the PartialModIface to be written

- - - - -


2 changed files:

- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Iface/Make.hs


Changes:

=====================================
compiler/GHC/Driver/Plugins.hs
=====================================
@@ -123,6 +123,7 @@ data Plugin = Plugin {
     -- the loading of the plugin interface. Tools that rely on information from
     -- modules other than the currently compiled one should implement this
     -- function.
+  , interfaceWriteAction :: [CommandLineOption] -> HscEnv -> ModDetails -> ModGuts -> PartialModIface -> IO PartialModIface
   }
 
 -- Note [Source plugins]
@@ -215,6 +216,7 @@ defaultPlugin = Plugin {
       , typeCheckResultAction = \_ _ -> return
       , spliceRunAction       = \_ -> return
       , interfaceLoadAction   = \_ -> return
+      , interfaceWriteAction  = \_ _ _ _ -> return
     }
 
 


=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -67,7 +67,7 @@ import Data.Function
 import Data.List ( findIndex, mapAccumL, sortBy )
 import Data.Ord
 import Data.IORef
-import GHC.Driver.Plugins (LoadedPlugin(..))
+import GHC.Driver.Plugins
 
 import Control.Monad
 
@@ -99,30 +99,31 @@ mkPartialIface hsc_env mod_details
               , mg_decl_docs    = decl_docs
               , mg_arg_docs     = arg_docs
               }
-  | gopt Opt_WriteCoreField dflags = do
-    fields <- writeFieldWith "ghc/core" write (mi_ext_fields iface)
-    forM_ (mg_binds guts) go
-    return iface{mi_ext_fields = fields}
-  | otherwise = return iface
+  = withPlugins dflags (\p opts -> interfaceWriteAction p opts hsc_env mod_details guts) iface
+  -- | gopt Opt_WriteCoreField dflags = do
+  --   fields <- writeFieldWith "ghc/core" write (mi_ext_fields iface)
+  --   forM_ (mg_binds guts) go
+  --   return iface{mi_ext_fields = fields}
+  -- | otherwise = return iface
   where
     dflags = hsc_dflags hsc_env
-    write bh = putWithUserData (const $ return ()) bh (toIfaceModGuts guts)
+    -- write bh = putWithUserData (const $ return ()) bh (toIfaceModGuts guts)
     iface = mkIface_ hsc_env this_mod hsc_src used_th deps rdr_env fix_env warns hpc_info self_trust
              safe_mode usages doc_hdr decl_docs arg_docs mod_details
 
-    go (NonRec iden rhs) = go2 iden rhs
-    go (Rec    binds ) = print (length binds) >> mapM_ (uncurry go2) binds
-    go2 iden rhs = do
-      let n = idName iden
-      putStrLn "------------------------------------"
-      putStrLn (nameStableString n)
-      putStrLn $ showSDoc dflags (ppr n)
-      print (isInternalName n, isExternalName n, isSystemName n, isWiredInName n)
-      putStrLn "-------"
-      putStrLn $ showSDoc dflags (ppr rhs)
-      putStrLn "-------"
-      putStrLn (showSDoc dflags (ppr (toIfaceExpr rhs)))
-      putStrLn "------------------------------------"
+    -- go (NonRec iden rhs) = go2 iden rhs
+    -- go (Rec    binds ) = print (length binds) >> mapM_ (uncurry go2) binds
+    -- go2 iden rhs = do
+    --   let n = idName iden
+    --   putStrLn "------------------------------------"
+    --   putStrLn (nameStableString n)
+    --   putStrLn $ showSDoc dflags (ppr n)
+    --   print (isInternalName n, isExternalName n, isSystemName n, isWiredInName n)
+    --   putStrLn "-------"
+    --   putStrLn $ showSDoc dflags (ppr rhs)
+    --   putStrLn "-------"
+    --   putStrLn (showSDoc dflags (ppr (toIfaceExpr rhs)))
+    --   putStrLn "------------------------------------"
 
 
 -- | Fully instantiate a interface



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f62b31f133cba62e4863a032e0ce9456b9b9543

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f62b31f133cba62e4863a032e0ce9456b9b9543
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200610/05044167/attachment-0001.html>