ghc-simple 0.3 → 0.4

raw patch · 5 files changed

+121/−29 lines, 5 filesdep ~basedep ~binarydep ~ghcPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, binary, ghc

API changes (from Hackage documentation)

Files

• ghc-simple.cabal +4/−4
• src/Language/Haskell/GHC/Simple.hs +31/−2
• src/Language/Haskell/GHC/Simple/Impl.hs +23/−13
• src/Language/Haskell/GHC/Simple/PrimIface.hs +61/−8
• src/Language/Haskell/GHC/Simple/Types.hs +2/−2

@@ -1,5 +1,5 @@ name:                ghc-simple-version:             0.3+version:             0.4 synopsis:            Simplified interface to the GHC API. description:         The GHC API is a great tool for working with Haskell code.                      Unfortunately, it's also fairly opaque and hard to get@@ -31,13 +31,13 @@   other-extensions:     CPP, PatternGuards, FlexibleInstances   build-depends:-    ghc          >=7.8  && <7.11,-    base         >=4.7  && <4.9,+    ghc          >=7.8  && <8.1,+    base         >=4.7  && <5,     ghc-paths    >=0.1  && <0.2,     directory    >=1.2  && <1.3,     filepath     >=1.3  && <1.5,     bytestring   >=0.10 && <0.11,-    binary       >=0.6  && <0.8+    binary       >=0.6  && <0.9   hs-source-dirs:     src   default-language:

@@ -139,20 +139,43 @@     finaldfs <- getSessionDynFlags     return (finaldfs, map unLoc files2)   where+#if __GLASGOW_HASKELL__ >= 800+#define LOG(dfs,sev,span,sty,msg) (deflog dfs reason sev span sty msg)+    logger deflog warns dfs reason severity srcspan style msg+#else+#define LOG(dfs,sev,span,sty,msg) (deflog dfs sev span sty msg)     logger deflog warns dfs severity srcspan style msg+#endif       | cfgUseGhcErrorLogger cfg = do+#if __GLASGOW_HASKELL__ >= 800+        logger' deflog warns dfs reason severity srcspan style msg+#else         logger' deflog warns dfs severity srcspan style msg+#endif         -- Messages other than warnings and errors are already logged by GHC         -- by default.         case severity of-          SevWarning -> deflog dfs severity srcspan style msg-          SevError   -> deflog dfs severity srcspan style msg+          SevWarning -> LOG(dfs, severity, srcspan, style, msg)+          SevError   -> LOG(dfs, severity, srcspan, style, msg)           _          -> return ()       | otherwise = do+#if __GLASGOW_HASKELL__ >= 800+        logger' deflog warns dfs reason severity srcspan style msg+#else         logger' deflog warns dfs severity srcspan style msg+#endif      -- Collect warnings and supress errors, since we're collecting those     -- separately.+#if __GLASGOW_HASKELL__ >= 800+    logger' _ w dfs _ SevWarning srcspan _style msg = do+      liftIO $ atomicModifyIORef' w $ \ws ->+        (Warning srcspan (showSDoc dfs msg) : ws, ())+    logger' _ _ _ _ SevError _ _ _ = do+      return ()+    logger' output _ dfs reason sev srcspan style msg = do+      output dfs reason sev srcspan style msg+#else     logger' _ w dfs SevWarning srcspan _style msg = do       liftIO $ atomicModifyIORef' w $ \ws ->         (Warning srcspan (showSDoc dfs msg) : ws, ())@@ -160,6 +183,7 @@       return ()     logger' output _ dfs sev srcspan style msg = do       output dfs sev srcspan style msg+#endif      setPrimIface dfs nfo strs = do       void $ setSessionDynFlags dfs {@@ -324,8 +348,13 @@ fromErrMsg :: DynFlags -> ErrMsg -> Error fromErrMsg dfs e = Error {     errorSpan      = errMsgSpan e,+#if __GLASGOW_HASKELL__ >= 800+    errorMessage   = showSDocForUser dfs ctx (pprLocErrMsg e),+    errorExtraInfo = ""+#else     errorMessage   = showSDocForUser dfs ctx (errMsgShortDoc e),     errorExtraInfo = showSDocForUser dfs ctx (errMsgExtraInfo e)+#endif   }   where     ctx = errMsgContext e

@@ -21,10 +21,12 @@ import CoreToStg import SimplStg import DriverPipeline-#if __GLASGOW_HASKELL__ < 710-import qualified Module as M (modulePackageId, packageIdString, PackageId)-#else+#if __GLASGOW_HASKELL__ >= 800+import qualified Module as M (moduleUnitId, unitIdString, UnitId)+#elif __GLASGOW_HASKELL__ >= 710 import qualified Module as M (modulePackageKey, packageKeyString, PackageKey)+#else+import qualified Module as M (modulePackageId, packageIdString, PackageId) #endif  import Control.Monad@@ -50,18 +52,24 @@ -- | String representation of a package ID/key. pkgKeyString :: PkgKey -> String -#if __GLASGOW_HASKELL__ < 710--- | Synonym for 'M.PackageId', to bridge a slight incompatibility between---   GHC 7.8 and 7.10.-type PkgKey = M.PackageId-modulePkgKey = M.modulePackageId-pkgKeyString = M.packageIdString-#else+#if __GLASGOW_HASKELL__ >= 800+-- | Synonym for 'M.UnitId', to bridge a slight incompatibility between+--   GHC 7.8/7.10/8.0.+type PkgKey = M.UnitId+modulePkgKey = M.moduleUnitId+pkgKeyString = M.unitIdString+#elif __GLASGOW_HASKELL__ >= 710 -- | Synonym for 'M.PackageKey', to bridge a slight incompatibility between --   GHC 7.8 and 7.10. type PkgKey = M.PackageKey modulePkgKey = M.modulePackageKey pkgKeyString = M.packageKeyString+#else+-- | Synonym for 'M.PackageId', to bridge a slight incompatibility between+--   GHC 7.8 and 7.10.+type PkgKey = M.PackageId+modulePkgKey = M.modulePackageId+pkgKeyString = M.packageIdString #endif  -- | Build a 'ModMetadata' out of a 'ModSummary'.@@ -92,8 +100,10 @@ -- | Prepare a core module for code generation. prepareCore :: HscEnv -> DynFlags -> ModSummary -> CgGuts -> IO CoreProgram prepareCore env dfs _ms p = do-#if __GLASGOW_HASKELL__ < 710-  liftIO $ corePrepPgm dfs env (cg_binds p) (cg_tycons p)-#else+#if __GLASGOW_HASKELL__ >= 800+  liftIO $ corePrepPgm env (ms_mod _ms) (ms_location _ms) (cg_binds p) (cg_tycons p)+#elif __GLASGOW_HASKELL__ >= 710   liftIO $ corePrepPgm env (ms_location _ms) (cg_binds p) (cg_tycons p)+#else+  liftIO $ corePrepPgm dfs env (cg_binds p) (cg_tycons p) #endif

@@ -25,7 +25,13 @@     primIface, fixPrimopTypes   ) where import IfaceEnv (initNameCache)-import PrelInfo (wiredInThings, primOpRules, ghcPrimIds)+import PrelInfo (primOpRules, ghcPrimIds)+#if __GLASGOW_HASKELL__ < 800+import PrelInfo (wiredInThings)+#else+import PrelInfo (wiredInIds, primOpId)+import TcTypeNats (typeNatTyCons)+#endif import PrimOp hiding (primOpSig) import IdInfo import Rules@@ -63,21 +69,34 @@         mi_fix_fn = mkIfaceFixCache fixies     }   where-    fixies = (getOccName seqId, Fixity 0 InfixR) :+    fixies = (getOccName seqId, fixity "seq" 0 InfixR) :              [(primOpOcc op, f)              | op <- allThePrimOps              , Just f <- [primOpFixity op]]+#if __GLASGOW_HASKELL__ >= 800+    fixity = Fixity+#else+    fixity _ = Fixity+#endif  exports :: (PrimOp -> PrimOpInfo)         -> (PrimOp -> Arity -> StrictSig)         -> [IfaceExport] exports nfo str = concat [-    map (Avail . idName) ghcPrimIds,-    map (Avail . idName . (fixPrimOp nfo str)) allThePrimOps,-    [ AvailTC n [n]+    map avail ghcPrimIds,+    map (avail . (fixPrimOp nfo str)) allThePrimOps,+    [ availTC n     | tc <- funTyCon : coercibleTyCon : primTyCons, let n = tyConName tc]   ]-+  where+#if __GLASGOW_HASKELL__ >= 800+    avail = Avail NotPatSyn . idName+    availTC n = AvailTC n [n] []+#else+    avail = Avail . idName+    availTC n = AvailTC n [n]+#endif+           -- | Fix primop types in the name cache. fixPrimopTypes :: (PrimOp -> PrimOpInfo)                -> (PrimOp -> Arity -> StrictSig)@@ -95,6 +114,27 @@         map (getName . AnId . fixPrimOp nfo str) allThePrimOps       ] +#if __GLASGOW_HASKELL__ >= 800+-- This list is used only to initialise HscMain.knownKeyNames+-- to ensure that when you say "Prelude.map" in your source code, you+-- get a Name with the correct known key (See Note [Known-key names])+wiredInThings+  = concat+    [           -- Wired in TyCons and their implicit Ids+          tycon_things+        , concatMap implicitTyThings tycon_things++                -- Wired in Ids+        , map AnId wiredInIds++                -- PrimOps+        , map (AnId . primOpId) allThePrimOps+    ]+  where+    tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons+                                    ++ typeNatTyCons)+#endif+ -- | Primitive operation signature: constists of the op's type, arity and --   strictness annotations. data PrimOpSig = PrimOpSig {@@ -130,7 +170,11 @@                 Type    | GenPrimOp   OccName         -- string :: \/a1..an . T1 -> .. -> Tk -> T+#if __GLASGOW_HASKELL__ >= 800+                [TyBinder]+#else                 [TyVar]+#endif                 [Type]                 Type @@ -147,12 +191,17 @@     unique = mkPrimOpIdUnique $ primOpTag op     nfo    = flip setCallArityInfo (opArity sig) $              noCafIdInfo `setStrictnessInfo` opStrictness sig-                         `setSpecInfo` si+                         `setRuleInfo` ri                          `setArityInfo` opArity sig                          `setInlinePragInfo` neverInlinePragma-    si     = mkSpecInfo $ case primOpRules name op of+    ri     = mkRuleInfo $ case primOpRules name op of                             Just r -> [r]                             _      -> []+#if __GLASGOW_HASKELL__ < 800+    mkRuleInfo = mkSpecInfo+    infixl 1 `setRuleInfo`+    setRuleInfo = setSpecInfo+#endif  -- | Create a 'PrimOpInfo' for dyadic, monadic and compare primops. --   Needed by GHC-generated primop info includes.@@ -163,5 +212,9 @@  -- | Create a general 'PrimOpInfo'. Needed by GHC-generated primop info --   includes.+#if __GLASGOW_HASKELL__ >= 800+mkGenPrimOp :: FastString -> [TyBinder] -> [Type] -> Type -> PrimOpInfo+#else mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo+#endif mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty

@@ -220,5 +220,5 @@  -- | Does the given 'CompResult' represent a successful compilation? compSuccess :: CompResult a -> Bool-compSuccess (Success {}) = True-compSuccess _            = False+compSuccess Success{} = True+compSuccess _         = False