diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,2 +1,6 @@ -## 0.1 +## 0.2 *January 19th 2015* +* `newWantedWithProvenance` and `failWithProvancence` no longer available in + GHC 8.0+ + +## 0.1 *June 3rd 2015* * Initial release diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015, Christiaan Baaij +Copyright (c) 2015-2016, University of Twente All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/ghc-tcplugins-extra.cabal b/ghc-tcplugins-extra.cabal --- a/ghc-tcplugins-extra.cabal +++ b/ghc-tcplugins-extra.cabal @@ -1,14 +1,16 @@ name: ghc-tcplugins-extra -version: 0.1 +version: 0.2 synopsis: Utilities for writing GHC type-checker plugins --- description: -homepage: http://www.clash-lang.org/ +description: Utilities for writing GHC type-checker plugins, such as + creating constraints, with a stable API covering multiple + GHC releases. +homepage: http://github.com/clash-lang/ghc-tcplugins-extra bug-reports: http://github.com/clash-lang/ghc-tcplugins-extra/issues license: BSD2 license-file: LICENSE author: Christiaan Baaij maintainer: christiaan.baaij@gmail.com -copyright: Copyright © 2015 University of Twente +copyright: Copyright © 2016 University of Twente category: Type System build-type: Simple extra-source-files: README.md @@ -27,10 +29,14 @@ library exposed-modules: GHC.TcPluginM.Extra - build-depends: base >=4.8 && <4.9, - ghc >=7.10 && <7.12 + build-depends: base >=4.8 && <5, + ghc >=7.10 && <8.2 hs-source-dirs: src default-language: Haskell2010 + other-extensions: CPP + LambdaCase + RecordWildCards + PatternSynonyms if flag(deverror) ghc-options: -Wall -Werror else diff --git a/src/GHC/TcPluginM/Extra.hs b/src/GHC/TcPluginM/Extra.hs --- a/src/GHC/TcPluginM/Extra.hs +++ b/src/GHC/TcPluginM/Extra.hs @@ -1,24 +1,29 @@ +{-| +Copyright : (C) 2015-2016, University of Twente +License : BSD2 (see the file LICENSE) +Maintainer : Christiaan Baaij +-} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE PatternSynonyms #-} {-# OPTIONS_HADDOCK show-extensions #-} -{-| -Copyright : (C) 2015, University of Twente -License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij --} module GHC.TcPluginM.Extra ( -- * Create new constraints newWanted , newGiven , newDerived +#if __GLASGOW_HASKELL__ < 711 , newWantedWithProvenance +#endif -- * Creating evidence , evByFiat +#if __GLASGOW_HASKELL__ < 711 -- * Report contractions , failWithProvenace +#endif -- * Lookup , lookupModule , lookupName @@ -28,10 +33,14 @@ where -- External +#if __GLASGOW_HASKELL__ < 711 import Data.Maybe (mapMaybe) +#endif -- GHC API +#if __GLASGOW_HASKELL__ < 711 import BasicTypes (TopLevelFlag (..)) +#endif import Coercion (Role (..), mkUnivCo) import FastString (FastString, fsLit) import Module (Module, ModuleName) @@ -39,25 +48,49 @@ import OccName (OccName) import Outputable (($$), (<+>), empty, ppr, text) import Panic (panicDoc) +#if __GLASGOW_HASKELL__ >= 711 +import TcEvidence (EvTerm (..)) +#else import TcEvidence (EvTerm (..), TcCoercion (..)) import TcMType (newEvVar) +#endif +#if __GLASGOW_HASKELL__ < 711 import TcPluginM (FindResult (..), TcPluginM, findImportedModule, lookupOrig, tcPluginIO, tcPluginTrace, unsafeTcPluginTcM) -#if __GLASGOW_HASKELL__ >= 711 -import qualified TcPluginM -import HscTypes (FoundHs (..)) -#endif import TcRnTypes (Ct, CtEvidence (..), CtLoc, TcIdBinder (..), TcLclEnv (..), TcPlugin (..), TcPluginResult (..), ctEvId, ctEvLoc, ctLoc, ctLocEnv, mkNonCanonical, setCtLocEnv) +#else +import TcPluginM (FindResult (..), TcPluginM, findImportedModule, lookupOrig, + tcPluginIO, tcPluginTrace) +import qualified TcPluginM +import TcRnTypes (CtEvidence (..), CtLoc, + TcPlugin (..), TcPluginResult (..)) +#endif +#if __GLASGOW_HASKELL__ >= 711 +import TyCoRep (UnivCoProvenance (..)) +import Type (PredType, Type) +#else import Type (EqRel (..), PredTree (..), PredType, Type, classifyPredType) import Var (varType) +#endif -- workaround for https://ghc.haskell.org/trac/ghc/ticket/10301 import Data.IORef (readIORef) import Control.Monad (unless) import StaticFlags (initStaticOpts, v_opt_C_ready) + +#if __GLASGOW_HASKELL__ >= 711 +pattern FoundModule :: Module -> FindResult +pattern FoundModule a <- Found _ a +fr_mod :: a -> a +fr_mod = id +#endif + + +#if __GLASGOW_HASKELL__ < 711 +{-# DEPRECATED newWantedWithProvenance "No longer available in GHC 8.0+" #-} -- | Create a new [W]anted constraint that remembers from which wanted -- constraint it was derived newWantedWithProvenance :: CtEvidence -- ^ Constraint from which the new @@ -71,9 +104,13 @@ env' = env {tcl_bndrs = (TcIdBndr id_ NotTopLevel):tcl_bndrs env} loc' = setCtLocEnv loc env' evVar <- unsafeTcPluginTcM $ newEvVar p - return CtWanted {ctev_pred = p, ctev_evar = evVar, ctev_loc = loc'} + return CtWanted { ctev_pred = p + , ctev_evar = evVar + , ctev_loc = loc'} + newWantedWithProvenance ev _ = panicDoc "newWantedWithProvenance: not a Wanted: " (ppr ev) +#endif -- | Create a new [W]anted constraint. newWanted :: CtLoc -> PredType -> TcPluginM CtEvidence @@ -117,9 +154,20 @@ -> Type -- ^ The LHS of the equivalence relation (~) -> Type -- ^ The RHS of the equivalence relation (~) -> EvTerm -evByFiat name t1 t2 = EvCoercion $ TcCoercion - $ mkUnivCo (fsLit name) Nominal t1 t2 +evByFiat name t1 t2 = EvCoercion +#if __GLASGOW_HASKELL__ < 711 + $ TcCoercion +#endif + $ mkUnivCo +#if __GLASGOW_HASKELL__ >= 711 + (PluginProv name) +#else + (fsLit name) +#endif + Nominal t1 t2 +#if __GLASGOW_HASKELL__ < 711 +{-# DEPRECATED failWithProvenace "No longer available in GHC 8.0+" #-} -- | Mark the given constraint as insoluble. -- -- If the [W]anted constraint was made by 'newWantedWithProvenance', it will @@ -137,6 +185,7 @@ . classifyPredType . snd) $ map (\ev -> (ev,varType ev)) lclbndrs parents = map (\(id_,p) -> mkNonCanonical $ CtWanted p id_ loc) eqBndrs +#endif -- | Find a module lookupModule :: ModuleName -- ^ Name of the module