ghc-srcspan-plugin 0.2.0.0 → 0.2.1.0

raw patch · 3 files changed

+37/−23 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ghc-srcspan-plugin.cabal +3/−3
• src/GHC/Plugins/ErrorLoc.hs +7/−18
• src/GHC/Plugins/SrcSpan.hs +27/−2

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                ghc-srcspan-plugin-version:             0.2.0.0+version:             0.2.1.0 synopsis:            Generic GHC Plugin for annotating Haskell code with source                      location data. description:         This package provides a generic Core-to-Core pass for@@ -17,7 +17,7 @@ license:             BSD3 license-file:        LICENSE author:              Eric Seidel-maintainer:          eseidel@galois.com+maintainer:          eric@seidel.io copyright:           Copyright (c) 2014, Galois Inc. category:            Language build-type:          Simple@@ -25,7 +25,7 @@  source-repository    head   type:     git-  location: https://github.com/GaloisInc/ghc-srcspan-plugin+  location: https://github.com/gridaphobe/ghc-srcspan-plugin  library   exposed-modules:     GHC.Plugins.SrcSpan,

@@ -14,25 +14,14 @@   reinitializeGlobals    hsc_env <- getHscEnv-  Just errorAtName <- liftIO $ lookupRdrNameInModuleForPlugins hsc_env-                               (mkModuleName "GHC.Plugins.ErrorLoc")-                               (mkVarUnqual $ fsLit "errorAt")-  errorAtVar <- lookupId errorAtName--  Just undefAtName <- liftIO $ lookupRdrNameInModuleForPlugins hsc_env-                               (mkModuleName "GHC.Plugins.ErrorLoc")-                               (mkVarUnqual $ fsLit "undefinedAt")-  undefAtVar <- lookupId undefAtName--  Just fmjstName <- liftIO $ lookupRdrNameInModuleForPlugins hsc_env-                             (mkModuleName "Data.Maybe")-                             (mkVarUnqual $ fsLit "fromJust")-  fmjstVar <- lookupId fmjstName+  errLocM <- lookupModule (mkModuleName "GHC.Plugins.ErrorLoc") Nothing+  +  errorAtVar <- lookupId =<< lookupName errLocM (mkVarOcc "errorAt")+  undefAtVar <- lookupId =<< lookupName errLocM (mkVarOcc "undefinedAt")+  fmjstAtVar <- lookupId =<< lookupName errLocM (mkVarOcc "fromJustAt") -  Just fmjstAtName <- liftIO $ lookupRdrNameInModuleForPlugins hsc_env-                               (mkModuleName "GHC.Plugins.ErrorLoc")-                               (mkVarUnqual $ fsLit "fromJustAt")-  fmjstAtVar <- lookupId fmjstAtName+  maybeM   <- lookupModule (mkModuleName "Data.Maybe") Nothing+  fmjstVar <- lookupId =<< lookupName maybeM (mkVarOcc "fromJust")    let subst = [ (eRROR_ID, errorAtVar), (uNDEFINED_ID, undefAtVar)               , (fmjstVar, fmjstAtVar)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}@@ -38,15 +39,20 @@ -- plugin will prevent this if you pass @True@ instead of @False@ to 'mkPass', -- but be warned, this will likely break __any__ FFI code your module uses. -module GHC.Plugins.SrcSpan (mkPass) where+module GHC.Plugins.SrcSpan (mkPass, lookupModule, lookupName) where  import           Control.Exception import           Control.Monad-import           CostCentre import qualified Data.Array        as Array import           Data.IntMap       (IntMap) import qualified Data.IntMap       as IntMap++import           CostCentre+import           Finder import           GhcPlugins+import           IfaceEnv+import           TcRnMonad+ import           Trace.Hpc.Mix import           Trace.Hpc.Util @@ -95,6 +101,9 @@ tickSpan _   _  (ProfNote cc _ _) = cc_loc cc tickSpan hpc _  (HpcTick _ i)     = IntMap.findWithDefault noSrcSpan i hpc tickSpan _   bk (Breakpoint i _)  = IntMap.findWithDefault noSrcSpan i bk+#if __GLASGOW_HASKELL__ >= 710+tickSpan _   _  (SourceNote s _)  = RealSrcSpan s+#endif   addLocationsBind :: (Tickish Var -> SrcSpan)@@ -135,5 +144,21 @@     = (c, xs,) `liftM` go ss expr  +--------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------- secondM :: Monad m => (b -> m c) -> (a, b) -> m (a, c) secondM f (a, b) = (a,) `liftM` f b++lookupModule :: ModuleName -> Maybe FastString -> CoreM Module+lookupModule mod_nm pkg = do+    hsc_env <- getHscEnv+    found_module <- liftIO $ findImportedModule hsc_env mod_nm pkg+    case found_module of+      Found _ md -> return md+      _          -> error $ "Unable to resolve module looked up by plugin: " ++ moduleNameString mod_nm++lookupName :: Module -> OccName -> CoreM Name+lookupName md occ = do+  hsc_env <- getHscEnv+  liftIO $ initTcForLookup hsc_env $ lookupOrig md occ