diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,5 +1,8 @@ -*-change-log-*- +0.2.0.1 Adam Gundry May 2016 + * Support building on GHC 8.0 + 0.2.0.0 Adam Gundry December 2015 * Add Data.UnitsOfMeasure.Read module and a Read instance for Quantity * Make it possible to declare derived compound units diff --git a/src/Data/UnitsOfMeasure/Convert.hs b/src/Data/UnitsOfMeasure/Convert.hs --- a/src/Data/UnitsOfMeasure/Convert.hs +++ b/src/Data/UnitsOfMeasure/Convert.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} @@ -9,6 +10,10 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} + +#if __GLASGOW_HASKELL__ > 710 +{-# LANGUAGE UndecidableSuperClasses #-} +#endif {-# OPTIONS_GHC -fplugin Data.UnitsOfMeasure.Plugin #-} diff --git a/src/Data/UnitsOfMeasure/Plugin.hs b/src/Data/UnitsOfMeasure/Plugin.hs --- a/src/Data/UnitsOfMeasure/Plugin.hs +++ b/src/Data/UnitsOfMeasure/Plugin.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ > 710 +{-# LANGUAGE PatternSynonyms #-} +#endif -- | This module defines a typechecker plugin that solves equations -- involving units of measure. To use it, add @@ -23,7 +26,6 @@ import DataCon import Type import TyCon -import TypeRep import TysWiredIn import FastString @@ -40,6 +42,12 @@ import Data.UnitsOfMeasure.Plugin.Unify import TcPluginExtras +#if __GLASGOW_HASKELL__ > 710 +import TyCoRep +#else +import TypeRep +#endif + import GHC.TcPluginM.Extra ( evByFiat, tracePlugin, lookupModule, lookupName ) -- | The plugin that GHC will load when this module is used with the @@ -116,7 +124,6 @@ collectCt ct = collectType ct $ ctEvPred $ ctEvidence ct - collectType _ (TyVarTy _) = [] collectType ct (AppTy f s) = collectType ct f ++ collectType ct s collectType ct (TyConApp tc [a]) | tc == unpackTyCon uds = case maybeConstant =<< normaliseUnit uds a of @@ -125,7 +132,7 @@ collectType ct (TyConApp _ as) = concatMap (collectType ct) as collectType ct (FunTy t v) = collectType ct t ++ collectType ct v collectType ct (ForAllTy _ t) = collectType ct t - collectType _ (LitTy _) = [] + collectType _ _ = [] -- TyVarTy, LitTy from 7.10, plus CastTy and CoercionTy in 8.0 unpackCt (ct,a,xs) = newGivenCt loc (mkEqPred ty1 ty2) (evByFiat "units" ty1 ty2) where @@ -193,6 +200,29 @@ EqPred NomEq t1 t2 -> evByFiat "units" t1 t2 IrredPred t | Just (tc, [t1,t2]) <- splitTyConApp_maybe t - , tc == equivTyCon uds -> evByFiat "units" t1 t2 `EvCast` - TcCoercion (mkUnivCo (fsLit "units") Representational (mkTyConApp eqTyCon [typeKind t1, t1, t2]) t) + , tc == equivTyCon uds -> mkFunnyEqEvidence t t1 t2 _ -> error "evMagic" + +-- | Make up evidence for a fake equality constraint @t1 ~~ t2@ by +-- coercing bogus evidence of type @t1 ~ t2@ (or its heterogeneous +-- variant, in GHC 8.0). +mkFunnyEqEvidence :: Type -> Type -> Type -> EvTerm +#if __GLASGOW_HASKELL__ >= 800 +mkFunnyEqEvidence t t1 t2 = EvDFunApp (dataConWrapId heqDataCon) [typeKind t1, typeKind t2, t1, t2] [evByFiat "units" t1 t2] + `EvCast` mkUnivCo (PluginProv "units") Representational (mkHEqPred t1 t2) t +#else +mkFunnyEqEvidence t t1 t2 = evByFiat "units" t1 t2 + `EvCast` TcCoercion (mkUnivCo (fsLit "units") Representational (mkTyConApp eqTyCon [typeKind t1, t1, t2]) t) +#endif + + +#if __GLASGOW_HASKELL__ >= 800 +pattern FunTy :: Type -> Type -> Type +pattern FunTy t v = ForAllTy (Anon t) v + +mkEqPred :: Type -> Type -> Type +mkEqPred = mkPrimEqPred + +mkHEqPred :: Type -> Type -> Type +mkHEqPred t1 t2 = TyConApp heqTyCon [typeKind t1, typeKind t2, t1, t2] +#endif diff --git a/src/Data/UnitsOfMeasure/Plugin/Convert.hs b/src/Data/UnitsOfMeasure/Plugin/Convert.hs --- a/src/Data/UnitsOfMeasure/Plugin/Convert.hs +++ b/src/Data/UnitsOfMeasure/Plugin/Convert.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Data.UnitsOfMeasure.Plugin.Convert ( UnitDefs(..) , unitKind @@ -8,9 +9,14 @@ import TyCon import Type -import TypeRep import TcType +#if __GLASGOW_HASKELL__ > 710 +import TyCoRep +#else +import TypeRep +#endif + import Data.List import Data.UnitsOfMeasure.Plugin.NormalForm @@ -43,7 +49,7 @@ -- | Try to convert a type to a unit normal form; this does not check -- the type has kind 'Unit', and may fail even if it does. normaliseUnit :: UnitDefs -> Type -> Maybe NormUnit -normaliseUnit uds ty | Just ty1 <- tcView ty = normaliseUnit uds ty1 +normaliseUnit uds ty | Just ty1 <- coreView ty = normaliseUnit uds ty1 normaliseUnit _ (TyVarTy v) = pure $ varUnit v normaliseUnit uds (TyConApp tc tys) | tc == unitOneTyCon uds = pure one @@ -77,3 +83,9 @@ reifyAtom (BaseAtom s) = mkTyConApp (unitBaseTyCon uds) [s] reifyAtom (VarAtom v) = mkTyVarTy v reifyAtom (FamAtom f tys) = mkTyConApp f tys + + +#if __GLASGOW_HASKELL__ > 710 +promoteTyCon :: TyCon -> TyCon +promoteTyCon = id +#endif diff --git a/src/Data/UnitsOfMeasure/Plugin/NormalForm.hs b/src/Data/UnitsOfMeasure/Plugin/NormalForm.hs --- a/src/Data/UnitsOfMeasure/Plugin/NormalForm.hs +++ b/src/Data/UnitsOfMeasure/Plugin/NormalForm.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Data.UnitsOfMeasure.Plugin.NormalForm ( Atom(..) , BaseUnit @@ -189,3 +190,12 @@ substUnit a v u = case Map.lookup (VarAtom a) $ _NormUnit u of Nothing -> u Just i -> (v ^: i) *: leftover a u + + +#if __GLASGOW_HASKELL__ > 710 +tyVarsOfType :: Type -> TyCoVarSet +tyVarsOfType = tyCoVarsOfType + +tyVarsOfTypes :: [Type] -> TyCoVarSet +tyVarsOfTypes = tyCoVarsOfTypes +#endif diff --git a/tests/ErrorTests.hs b/tests/ErrorTests.hs --- a/tests/ErrorTests.hs +++ b/tests/ErrorTests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} @@ -7,6 +8,11 @@ {-# OPTIONS_GHC -fdefer-type-errors #-} {-# OPTIONS_GHC -fplugin Data.UnitsOfMeasure.Plugin #-} + +#if __GLASGOW_HASKELL__ > 710 +{-# OPTIONS_GHC -fno-warn-deferred-type-errors #-} +#endif + module ErrorTests where import Data.UnitsOfMeasure @@ -36,6 +42,8 @@ , "from the context ((One *: a) ~ (a *: One))" ] , [ "Could not deduce: a ~ Base \"kg\"" , "from the context: (One *: a) ~ (a *: One)" ] + , [ "Could not deduce: Base \"kg\" ~ a" + , "from the context: (One *: a) ~ (a *: One)" ] ] @@ -46,6 +54,8 @@ , "from the context ((One *: a) ~ (b *: One))" ] , [ "Could not deduce: a ~ Base \"kg\"" , "from the context: (One *: a) ~ (b *: One)" ] + , [ "Could not deduce: Base \"kg\" ~ a" + , "from the context: (One *: a) ~ (b *: One)" ] ] @@ -55,5 +65,7 @@ given3_errors = [ [ "Could not deduce (a ~ Base \"s\")" , "from the context ((a ^: 2) ~ (b ^: 3))" ] , [ "Could not deduce: a ~ Base \"s\"" + , "from the context: (a ^: 2) ~ (b ^: 3)" ] + , [ "Could not deduce: Base \"s\" ~ a" , "from the context: (a ^: 2) ~ (b ^: 3)" ] ] diff --git a/uom-plugin.cabal b/uom-plugin.cabal --- a/uom-plugin.cabal +++ b/uom-plugin.cabal @@ -1,5 +1,5 @@ name: uom-plugin -version: 0.2.0.0 +version: 0.2.0.1 synopsis: Units of measure as a GHC typechecker plugin category: Type System description: A prototype typechecker plugin for GHC with support for units of measure @@ -10,7 +10,7 @@ homepage: https://github.com/adamgundry/uom-plugin bug-reports: https://github.com/adamgundry/uom-plugin/issues stability: experimental -copyright: Copyright (c) 2014-2015, Adam Gundry +copyright: Copyright (c) 2014-2016, Adam Gundry build-type: Simple cabal-version: >=1.10 description: @@ -44,8 +44,8 @@ other-extensions: TemplateHaskell build-depends: base >=4.7 && <5, deepseq >=1.3 && <1.5, - ghc >= 7.9 && <7.12, - ghc-tcplugins-extra >=0.1 && <0.2, + ghc >= 7.9 && <8.2, + ghc-tcplugins-extra >=0.1 && <0.3, template-haskell >=2.9 && <2.12, containers >=0.5 && <0.6, units-parser >=0.1 && <0.2