From 7328cb277fd52f700d61b7e79ffb058e58d161f1 Mon Sep 17 00:00:00 2001 From: Judah Jacobson Date: Tue, 8 Aug 2017 09:48:59 -0700 Subject: [PATCH] Fix the build with ghc-8.2.1. (#147) - Avoid using a deprecated Cabal function - Use newer versions of proto-lens packages in stack.yaml - Work around a new type-level warning that affects `OneOf/TensorTypes`. --- stack.yaml | 3 ++- tensorflow-core-ops/Setup.hs | 10 +++++++++- tensorflow/src/TensorFlow/Types.hs | 32 ++++++++++++++++++++++++++---- 3 files changed, 39 insertions(+), 6 deletions(-) diff --git a/stack.yaml b/stack.yaml index 42229dd..e4fc748 100644 --- a/stack.yaml +++ b/stack.yaml @@ -20,7 +20,8 @@ extra-deps: - proto-lens-protobuf-types-0.2.2.0 - proto-lens-0.2.2.0 - proto-lens-descriptors-0.2.2.0 -- proto-lens-protoc-0.2.2.1 +- proto-lens-protoc-0.2.2.3 +- lens-labels-0.1.0.2 # For Mac OS X, whose linker doesn't use this path by default # unless you run `xcode-select --install`. diff --git a/tensorflow-core-ops/Setup.hs b/tensorflow-core-ops/Setup.hs index 6ab910b..efc0dce 100644 --- a/tensorflow-core-ops/Setup.hs +++ b/tensorflow-core-ops/Setup.hs @@ -11,6 +11,7 @@ -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -- See the License for the specific language governing permissions and -- limitations under the License. +{-# LANGUAGE CPP #-} -- | Generates the wrappers for Ops shipped with tensorflow. module Main where @@ -20,7 +21,7 @@ import Distribution.PackageDescription , libBuildInfo , hsSourceDirs ) -import Distribution.Simple.BuildPaths (autogenModulesDir) +import qualified Distribution.Simple.BuildPaths as BuildPaths import Distribution.Simple.LocalBuildInfo (LocalBuildInfo) import Distribution.Simple ( defaultMainWithHooks @@ -91,3 +92,10 @@ blackList = [ -- Requires the "func" type: "SymbolicGradient" ] + +autogenModulesDir :: LocalBuildInfo -> FilePath +#if MIN_VERSION_Cabal(2,0,0) +autogenModulesDir = BuildPaths.autogenPackageModulesDir +#else +autogenModulesDir = BuildPaths.autogenModulesDir +#endif diff --git a/tensorflow/src/TensorFlow/Types.hs b/tensorflow/src/TensorFlow/Types.hs index 689dad3..60cf697 100644 --- a/tensorflow/src/TensorFlow/Types.hs +++ b/tensorflow/src/TensorFlow/Types.hs @@ -19,6 +19,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -453,10 +454,10 @@ infixr 5 /:/ -- -- using an enumeration of all the possible 'TensorType's. type OneOf ts a - -- Assert `TensorTypes ts` to make error messages a little better. - = (TensorType a, TensorTypes ts, NoneOf (AllTensorTypes \\ ts) a) + -- Assert `TensorTypes' ts` to make error messages a little better. + = (TensorType a, TensorTypes' ts, NoneOf (AllTensorTypes \\ ts) a) -type OneOfs ts as = (TensorTypes as, TensorTypes ts, +type OneOfs ts as = (TensorTypes as, TensorTypes' ts, NoneOfs (AllTensorTypes \\ ts) as) type family NoneOfs ts as :: Constraint where @@ -486,6 +487,29 @@ instance TensorTypes '[] where instance (TensorType t, TensorTypes ts) => TensorTypes (t ': ts) where tensorTypes = TensorTypeProxy :/ tensorTypes +-- | A simpler version of the 'TensorTypes' class, that doesn't run +-- afoul of @-Wsimplifiable-class-constraints@. +-- +-- In more detail: the constraint @OneOf '[Double, Float] a@ leads +-- to the constraint @TensorTypes' '[Double, Float]@, as a safety-check +-- to give better error messages. However, if @TensorTypes'@ were a class, +-- then GHC 8.2.1 would complain with the above warning unless @NoMonoBinds@ +-- were enabled. So instead, we use a separate type family for this purpose. +-- For more details: https://ghc.haskell.org/trac/ghc/ticket/11948 +type family TensorTypes' (ts :: [*]) :: Constraint where + -- Specialize this type family when `ts` is a long list, to avoid deeply + -- nested tuples of constraints. Works around a bug in ghc-8.0: + -- https://ghc.haskell.org/trac/ghc/ticket/12175 + TensorTypes' (t1 ': t2 ': t3 ': t4 ': ts) + = (TensorType t1, TensorType t2, TensorType t3, TensorType t4 + , TensorTypes' ts) + TensorTypes' (t1 ': t2 ': t3 ': ts) + = (TensorType t1, TensorType t2, TensorType t3, TensorTypes' ts) + TensorTypes' (t1 ': t2 ': ts) + = (TensorType t1, TensorType t2, TensorTypes' ts) + TensorTypes' (t ': ts) = (TensorType t, TensorTypes' ts) + TensorTypes' '[] = () + -- | A constraint checking that two types are different. type family a /= b :: Constraint where a /= a = TypeError a ~ ExcludedCase @@ -529,7 +553,7 @@ type family as \\ bs where -- Assumes that @a@ and each of the elements of @ts@ are 'TensorType's. type family NoneOf ts a :: Constraint where -- Specialize this type family when `ts` is a long list, to avoid deeply - -- nested tuples of constraints. Works around a bug in ghc-8: + -- nested tuples of constraints. Works around a bug in ghc-8.0: -- https://ghc.haskell.org/trac/ghc/ticket/12175 NoneOf (t1 ': t2 ': t3 ': t4 ': ts) a = (a /= t1, a /= t2, a /= t3, a /= t4, NoneOf ts a)