From 28eb148efbf2870c46f01d5ea5a2bed2968d25ee Mon Sep 17 00:00:00 2001 From: tonyday567 Date: Sat, 18 Jun 2016 17:11:03 +1000 Subject: [PATCH] getting to -Wall --- src/SubHask.hs | 4 +- src/SubHask/Algebra.hs | 79 ++++++------- src/SubHask/Algebra/Array.hs | 118 +++++++++---------- src/SubHask/Algebra/Container.hs | 34 +++--- src/SubHask/Algebra/Group.hs | 2 - src/SubHask/Algebra/Logic.hs | 3 - src/SubHask/Algebra/Matrix.hs | 7 +- src/SubHask/Algebra/Metric.hs | 6 +- src/SubHask/Algebra/Ord.hs | 15 +-- src/SubHask/Algebra/Parallel.hs | 21 ++-- src/SubHask/Algebra/Ring.hs | 3 +- src/SubHask/Algebra/Vector.hs | 132 +++++++++++----------- src/SubHask/Algebra/Vector/FFI.hs | 7 +- src/SubHask/Category.hs | 26 ++--- src/SubHask/Category/Finite.hs | 10 +- src/SubHask/Category/Polynomial.hs | 13 +-- src/SubHask/Category/Product.hs | 7 -- src/SubHask/Category/Slice.hs | 5 - src/SubHask/Category/Trans/Bijective.hs | 5 +- src/SubHask/Category/Trans/Constrained.hs | 1 - src/SubHask/Category/Trans/Derivative.hs | 31 +++-- src/SubHask/Category/Trans/Monotonic.hs | 8 +- src/SubHask/Compatibility/Base.hs | 29 ++--- src/SubHask/Compatibility/BloomFilter.hs | 6 +- src/SubHask/Compatibility/ByteString.hs | 14 +-- src/SubHask/Compatibility/Cassava.hs | 2 + src/SubHask/Compatibility/Containers.hs | 26 ++--- src/SubHask/Internal/Prelude.hs | 5 +- src/SubHask/Monad.hs | 2 +- src/SubHask/Mutable.hs | 1 - src/SubHask/SubType.hs | 26 ++--- src/SubHask/TemplateHaskell/Base.hs | 25 ++-- src/SubHask/TemplateHaskell/Common.hs | 5 +- src/SubHask/TemplateHaskell/Deriving.hs | 48 ++++---- src/SubHask/TemplateHaskell/Mutable.hs | 11 +- src/SubHask/TemplateHaskell/Test.hs | 16 ++- subhask.cabal | 1 + 37 files changed, 348 insertions(+), 406 deletions(-) diff --git a/src/SubHask.hs b/src/SubHask.hs index ef9117c..999ee6a 100644 --- a/src/SubHask.hs +++ b/src/SubHask.hs @@ -3,7 +3,7 @@ module SubHask ( module SubHask.Algebra , module SubHask.Category - , module SubHask.Compatibility.Base + -- , module SubHask.Compatibility.Base , module SubHask.Internal.Prelude , module SubHask.Monad , module SubHask.SubType @@ -11,7 +11,7 @@ module SubHask import SubHask.Algebra import SubHask.Category -import SubHask.Compatibility.Base +import SubHask.Compatibility.Base() import SubHask.Internal.Prelude import SubHask.Monad import SubHask.SubType diff --git a/src/SubHask/Algebra.hs b/src/SubHask/Algebra.hs index 9ed2b18..4d3026f 100644 --- a/src/SubHask/Algebra.hs +++ b/src/SubHask/Algebra.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP,MagicHash,UnboxedTuples #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | This module defines the algebraic type-classes used in subhask. -- The class hierarchies are significantly more general than those in the standard Prelude. @@ -51,14 +54,11 @@ module SubHask.Algebra , law_Heyting_infleft , law_Heyting_infright , law_Heyting_distributive - , Boolean (..) + , Boolean , law_Boolean_infcomplement , law_Boolean_supcomplement , law_Boolean_infdistributivity , law_Boolean_supdistributivity - --- , defn_Latticelessthaninf --- , defn_Latticelessthansup , Ord_ (..) , law_Ord_totality , law_Ord_min @@ -73,12 +73,12 @@ module SubHask.Algebra , minimum_ , argmin , argmax --- , argminimum_ --- , argmaximum_ , Graded (..) , law_Graded_fromEnum , law_Graded_pred , defn_Graded_predN + , (>.) + , (<.) , Enum (..) , law_Enum_toEnum , law_Enum_succ @@ -94,6 +94,7 @@ module SubHask.Algebra -- * Set-like , Elem + , infDisjoint , SetElem , Container (..) , law_Container_preservation @@ -127,6 +128,7 @@ module SubHask.Algebra , defn_Foldable_foldl1' , foldtree1 + , convertUnfoldable , length , reduce , concat @@ -169,6 +171,8 @@ module SubHask.Algebra , Semigroup (..) , law_Semigroup_associativity , defn_Semigroup_plusequal + , associator + , cycle , Actor , Action (..) , law_Action_compatibility @@ -184,7 +188,7 @@ module SubHask.Algebra , law_Monoid_leftid , law_Monoid_rightid , defn_Monoid_isZero - , Abelian (..) + , Abelian , law_Abelian_commutative , Group (..) , law_Group_leftinverse @@ -215,7 +219,7 @@ module SubHask.Algebra -- , roundUpToNearestBase2 , fromIntegral , Field(..) - , OrdField(..) + , OrdField , RationalField(..) , convertRationalField , toFloat @@ -260,8 +264,12 @@ module SubHask.Algebra , defn_FreeModule_dotstardotequal , FiniteModule (..) , VectorSpace (..) + , Reisz (..) , Banach (..) + , law_Banach_distance + , law_Banach_size , Hilbert (..) + , squaredInnerProductNorm , innerProductDistance , innerProductNorm , TensorAlgebra (..) @@ -281,26 +289,20 @@ import qualified Data.Number.Erf as P import qualified Math.Gamma as P import qualified Data.List as L -import Prelude (Ordering (..)) import Control.Monad hiding (liftM) import Control.Monad.ST import Data.Ratio import Data.Typeable -import Test.QuickCheck (Arbitrary (..), frequency) +import Test.QuickCheck (frequency) -import Control.Concurrent -import Control.Parallel import Control.Parallel.Strategies -import System.IO.Unsafe -- used in the parallel function import GHC.Prim hiding (Any) import GHC.Types -import GHC.Magic import SubHask.Internal.Prelude import SubHask.Category import SubHask.Mutable -import SubHask.SubType ------------------------------------------------------------------------------- @@ -493,7 +495,7 @@ instance MinBound_ Float where minBound = -1/0 ; {-# INLINE minBound #- instance MinBound_ Double where minBound = -1/0 ; {-# INLINE minBound #-} -- FIXME: should be a primop for this -instance MinBound_ b => MinBound_ (a -> b) where minBound = \x -> minBound ; {-# INLINE minBound #-} +instance MinBound_ b => MinBound_ (a -> b) where minBound = \_ -> minBound ; {-# INLINE minBound #-} ------------------- @@ -712,7 +714,7 @@ law_Graded_fromEnum b1 b2 | otherwise = True law_Graded_pred :: Graded b => b -> b -> Bool -law_Graded_pred b1 b2 = fromEnum (pred b1) == fromEnum b1-1 +law_Graded_pred b1 _ = fromEnum (pred b1) == fromEnum b1-1 || fromEnum (pred b1) == fromEnum b1 defn_Graded_predN :: Graded b => Int -> b -> Bool @@ -720,8 +722,8 @@ defn_Graded_predN i b | i < 0 = true | otherwise = go i b == predN i b where - go 0 b = b - go i b = go (i-1) $ pred b + go 0 b' = b' + go i' b' = go (i'-1) $ pred b' instance Graded Bool where {-# INLINE pred #-} @@ -789,7 +791,7 @@ law_Enum_toEnum :: Enum b => b -> Bool law_Enum_toEnum b = toEnum (fromEnum b) == b law_Enum_succ :: Enum b => b -> b -> Bool -law_Enum_succ b1 b2 = fromEnum (succ b1) == fromEnum b1+1 +law_Enum_succ b1 _ = fromEnum (succ b1) == fromEnum b1+1 || fromEnum (succ b1) == fromEnum b1 defn_Enum_succN :: Enum b => Int -> b -> Logic b @@ -903,7 +905,7 @@ instance Bounded Double where maxBound = 1/0 ; {-# INLINE maxBound #-} instance Bounded b => Bounded (a -> b) where {-# INLINE maxBound #-} - maxBound = \x -> maxBound + maxBound = \_ -> maxBound -------------------- @@ -1145,7 +1147,7 @@ instance Monoid () where instance Monoid b => Monoid (a -> b) where {-# INLINE zero #-} - zero = \a -> zero + zero = \_ -> zero --------------------------------------- @@ -1333,7 +1335,7 @@ instance Rig Rational where one = 1 ; {-# INLINE one #-} instance Rig b => Rig (a -> b) where {-# INLINE one #-} - one = \a -> one + one = \_ -> one --------------------------------------- @@ -1381,7 +1383,7 @@ instance Ring Rational where fromInteger = P.fromInteger ; {-# INLINE fromInt instance Ring b => Ring (a -> b) where {-# INLINE fromInteger #-} - fromInteger i = \a -> fromInteger i + fromInteger i = \_ -> fromInteger i {-# INLINABLE indicator #-} indicator :: Ring r => Bool -> r @@ -2009,7 +2011,7 @@ instance ) => FreeModule (a -> b) where g .*. f = \a -> g a .*. f a - ones = \a -> ones + ones = \_ -> ones --------------------------------------- @@ -2162,7 +2164,7 @@ innerProductNorm = undefined -- sqrt . squaredInnerProductNorm {-# INLINE innerProductDistance #-} innerProductDistance :: Hilbert v => v -> v -> Scalar v -innerProductDistance v1 v2 = undefined --innerProductNorm $ v1-v2 +innerProductDistance _ _ = undefined --innerProductNorm $ v1-v2 --------------------------------------- @@ -2332,9 +2334,6 @@ instance CanError Double where ------------------------------------------------------------------------------- -- set-like - -type Item s = Elem s - type family Elem s type family SetElem s t @@ -2623,11 +2622,11 @@ foldtree1 :: Monoid a => [a] -> a foldtree1 as = case go as of [] -> zero [a] -> a - as -> foldtree1 as + as' -> foldtree1 as' where go [] = [] go [a] = [a] - go (a1:a2:as) = (a1+a2):go as + go (a1:a2:as'') = (a1+a2):go as'' {-# INLINE[1] convertUnfoldable #-} convertUnfoldable :: (Monoid t, Foldable s, Constructible t, Elem s ~ Elem t) => s -> t @@ -2729,10 +2728,6 @@ class (Boolean (Logic s), Boolean s, Container s) => Topology s where type family Index s type family SetIndex s a --- | FIXME: --- This type is a hack designed to work around the lack of injective type families. -type ValidSetIndex s = SetIndex s (Index s) ~ s - -- | An indexed constructible container associates an 'Index' with each 'Elem'. -- This class generalizes the map abstract data type. -- @@ -2945,8 +2940,8 @@ type instance Index [a] = Int instance ValidEq a => Eq_ [a] where (x:xs)==(y:ys) = x==y && xs==ys - (x:xs)==[] = false - [] ==(y:ts) = false + (_:_)==[] = false + [] ==(_:_) = false [] ==[] = true instance Eq a => POrd_ [a] where @@ -3002,8 +2997,8 @@ instance Foldable [a] where foldl1' = L.foldl1' instance ValidLogic a => IxContainer [a] where - lookup 0 (x:xs) = Just x - lookup i (x:xs) = lookup (i-1) xs + lookup 0 (x:_) = Just x + lookup i (_:xs) = lookup (i-1) xs lookup _ [] = Nothing imap f xs = map (uncurry f) $ P.zip [0..] xs @@ -3120,7 +3115,7 @@ type instance Elem (Labeled' x y) = Elem x ----- instance Eq_ x => Eq_ (Labeled' x y) where - (Labeled' x1 y1) == (Labeled' x2 y2) = x1==x2 + (Labeled' x1 _) == (Labeled' x2 _) = x1==x2 instance (ClassicalLogic x, Ord_ x) => POrd_ (Labeled' x y) where inf (Labeled' x1 y1) (Labeled' x2 y2) = if x1 < x2 @@ -3142,8 +3137,8 @@ instance Semigroup x => Action (Labeled' x y) where (Labeled' x y) .+ x' = Labeled' (x'+x) y instance Metric x => Metric (Labeled' x y) where - distance (Labeled' x1 y1) (Labeled' x2 y2) = distance x1 x2 - distanceUB (Labeled' x1 y1) (Labeled' x2 y2) = distanceUB x1 x2 + distance (Labeled' x1 _) (Labeled' x2 _) = distance x1 x2 + distanceUB (Labeled' x1 _) (Labeled' x2 _) = distanceUB x1 x2 instance Normed x => Normed (Labeled' x y) where size (Labeled' x _) = size x diff --git a/src/SubHask/Algebra/Array.hs b/src/SubHask/Algebra/Array.hs index 84788ec..719b416 100644 --- a/src/SubHask/Algebra/Array.hs +++ b/src/SubHask/Algebra/Array.hs @@ -1,4 +1,8 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + module SubHask.Algebra.Array ( BArray (..) , UArray (..) @@ -8,11 +12,8 @@ module SubHask.Algebra.Array import Control.Monad import Control.Monad.Primitive -import Unsafe.Coerce import Data.Primitive as Prim -import Data.Primitive.ByteArray import qualified Data.Vector as V -import qualified Data.Vector as VM import qualified Data.Vector.Unboxed as VU import qualified Data.Vector.Unboxed.Mutable as VUM import qualified Data.Vector.Generic as VG @@ -24,7 +25,6 @@ import SubHask.Algebra.Parallel import SubHask.Algebra.Vector import SubHask.Category import SubHask.Internal.Prelude -import SubHask.Compatibility.Base ------------------------------------------------------------------------------- -- boxed arrays @@ -149,7 +149,7 @@ instance ValidLogic e => Partitionable (BArray e) where -- unboxed arrays data UArray e - = UArray {-#UNPACK#-}!(VU.Vector e) + = UArray !(VU.Vector e) -- | UArray_Zero type instance Index (UArray e) = Int @@ -235,20 +235,20 @@ instance {-# INLINABLE fromList1N #-} fromList1N n x xs = unsafeInlineIO $ do - marr <- safeNewByteArray (n*size*rbytes) 16 - let mv = UArray_MUVector marr 0 n size + marr <- safeNewByteArray (n*size'*rbytes) 16 + let mv = UArray_MUVector marr 0 n size' let go [] (-1) = return () - go (x:xs) i = do - VGM.unsafeWrite mv i x - go xs (i-1) + go (x':xs') i = do + VGM.unsafeWrite mv i x' + go xs' (i-1) go (P.reverse $ x:xs) (n-1) v <- VG.basicUnsafeFreeze mv return $ UArray v where rbytes=Prim.sizeOf (undefined::r) - size=roundUpToNearest 4 $ dim x + size'=roundUpToNearest 4 $ dim x instance Unboxable e => Container (UArray e) where elem e (UArray v) = elem e $ VG.toList v @@ -339,21 +339,21 @@ instance basicLength (UArray_UVector _ _ n _) = n {-# INLINABLE basicUnsafeSlice #-} - basicUnsafeSlice i len' (UArray_UVector arr off n size) = UArray_UVector arr (off+i*size) len' size + basicUnsafeSlice i len' (UArray_UVector arr off _ size') = UArray_UVector arr (off+i*size') len' size' {-# INLINABLE basicUnsafeFreeze #-} - basicUnsafeFreeze (UArray_MUVector marr off n size) = do + basicUnsafeFreeze (UArray_MUVector marr off n size') = do arr <- unsafeFreezeByteArray marr - return $ UArray_UVector arr off n size + return $ UArray_UVector arr off n size' {-# INLINABLE basicUnsafeThaw #-} - basicUnsafeThaw (UArray_UVector arr off n size)= do + basicUnsafeThaw (UArray_UVector arr off n size')= do marr <- unsafeThawByteArray arr - return $ UArray_MUVector marr off n size + return $ UArray_MUVector marr off n size' {-# INLINABLE basicUnsafeIndexM #-} - basicUnsafeIndexM (UArray_UVector arr off n size) i = - return $ UVector_Dynamic arr (off+i*size) size + basicUnsafeIndexM (UArray_UVector arr off _ size') i = + return $ UVector_Dynamic arr (off+i*size') size' data instance VUM.MVector s (UVector (n::Symbol) elem) = UArray_MUVector {-#UNPACK#-}!(MutableByteArray s) @@ -373,41 +373,41 @@ instance basicLength (UArray_MUVector _ _ n _) = n {-# INLINABLE basicUnsafeSlice #-} - basicUnsafeSlice i lenM' (UArray_MUVector marr off n size) - = UArray_MUVector marr (off+i*size) lenM' size + basicUnsafeSlice i lenM' (UArray_MUVector marr off _ size') + = UArray_MUVector marr (off+i*size') lenM' size' {-# INLINABLE basicOverlaps #-} - basicOverlaps (UArray_MUVector marr1 off1 n1 size) (UArray_MUVector marr2 off2 n2 _) + basicOverlaps (UArray_MUVector marr1 _ _ _) (UArray_MUVector marr2 _ _ _) = sameMutableByteArray marr1 marr2 {-# INLINABLE basicUnsafeNew #-} basicUnsafeNew 0 = do marr <- newByteArray 0 return $ UArray_MUVector marr 0 0 0 - basicUnsafeNew n = error "basicUnsafeNew not supported on UArray_MUVector with nonzero size" + basicUnsafeNew _ = error "basicUnsafeNew not supported on UArray_MUVector with nonzero size" {-# INLINABLE basicUnsafeRead #-} - basicUnsafeRead mv@(UArray_MUVector marr off n size) i = do + basicUnsafeRead (UArray_MUVector marr off _ size') i = do let b=Prim.sizeOf (undefined::elem) - marr' <- safeNewByteArray (size*b) 16 - copyMutableByteArray marr' 0 marr ((off+i*size)*b) (size*b) + marr' <- safeNewByteArray (size'*b) 16 + copyMutableByteArray marr' 0 marr ((off+i*size')*b) (size'*b) arr <- unsafeFreezeByteArray marr' - return $ UVector_Dynamic arr 0 size + return $ UVector_Dynamic arr 0 size' {-# INLINABLE basicUnsafeWrite #-} - basicUnsafeWrite mv@(UArray_MUVector marr1 off1 _ size) loc v@(UVector_Dynamic arr2 off2 _) = - copyByteArray marr1 ((off1+size*loc)*b) arr2 (off2*b) (size*b) + basicUnsafeWrite (UArray_MUVector marr1 off1 _ size1) loc (UVector_Dynamic arr2 off2 _) = + copyByteArray marr1 ((off1+size1*loc)*b) arr2 (off2*b) (size1*b) where b=Prim.sizeOf (undefined::elem) {-# INLINABLE basicUnsafeCopy #-} - basicUnsafeCopy (UArray_MUVector marr1 off1 n1 size1) (UArray_MUVector marr2 off2 n2 size2) = + basicUnsafeCopy (UArray_MUVector marr1 off1 _ size1) (UArray_MUVector marr2 off2 n2 _) = copyMutableByteArray marr1 (off1*b) marr2 (off2*b) (n2*b) where b = size1*Prim.sizeOf (undefined::elem) {-# INLINABLE basicUnsafeMove #-} - basicUnsafeMove (UArray_MUVector marr1 off1 n1 size1) (UArray_MUVector marr2 off2 n2 size2) = + basicUnsafeMove (UArray_MUVector marr1 off1 _ size1) (UArray_MUVector marr2 off2 n2 _) = moveByteArray marr1 (off1*b) marr2 (off2*b) (n2*b) where b = size1*Prim.sizeOf (undefined::elem) @@ -443,28 +443,28 @@ instance basicLength (UArray_Labeled'_MUVector _ _ n _) = n {-# INLINABLE basicUnsafeSlice #-} - basicUnsafeSlice i lenM' (UArray_Labeled'_MUVector marr off n size) - = UArray_Labeled'_MUVector marr (off+i*(size+ysize)) lenM' size + basicUnsafeSlice i lenM' (UArray_Labeled'_MUVector marr off _ size') + = UArray_Labeled'_MUVector marr (off+i*(size'+ysize)) lenM' size' where ysize=roundUpToNearest 4 $ Prim.sizeOf (undefined::y) `quot` Prim.sizeOf (undefined::elem) {-# INLINABLE basicOverlaps #-} - basicOverlaps (UArray_Labeled'_MUVector marr1 off1 n1 size) (UArray_Labeled'_MUVector marr2 off2 n2 _) + basicOverlaps (UArray_Labeled'_MUVector marr1 _ _ _) (UArray_Labeled'_MUVector marr2 _ _ _) = sameMutableByteArray marr1 marr2 {-# INLINABLE basicUnsafeNew #-} basicUnsafeNew 0 = do marr <- newByteArray 0 return $ UArray_Labeled'_MUVector marr 0 0 0 - basicUnsafeNew n = error "basicUnsafeNew not supported on UArray_MUVector with nonzero size" + basicUnsafeNew _ = error "basicUnsafeNew not supported on UArray_MUVector with nonzero size" {-# INLINABLE basicUnsafeRead #-} - basicUnsafeRead mv@(UArray_Labeled'_MUVector marr off n size) i = do - marr' <- safeNewByteArray (size*b) 16 - copyMutableByteArray marr' 0 marr ((off+i*(size+ysize))*b) (size*b) + basicUnsafeRead (UArray_Labeled'_MUVector marr off _ size') i = do + marr' <- safeNewByteArray (size'*b) 16 + copyMutableByteArray marr' 0 marr ((off+i*(size'+ysize))*b) (size'*b) arr <- unsafeFreezeByteArray marr' - let x=UVector_Dynamic arr 0 size - y <- readByteArray marr $ (off+i*(size+ysize)+size) `quot` ysizereal + let x=UVector_Dynamic arr 0 size' + y <- readByteArray marr $ (off+i*(size'+ysize)+size') `quot` ysizereal return $ Labeled' x y where b=Prim.sizeOf (undefined::elem) @@ -473,12 +473,12 @@ instance {-# INLINABLE basicUnsafeWrite #-} basicUnsafeWrite - (UArray_Labeled'_MUVector marr1 off1 _ size) + (UArray_Labeled'_MUVector marr1 off1 _ size') i (Labeled' (UVector_Dynamic arr2 off2 _) y) = do - copyByteArray marr1 ((off1+i*(size+ysize))*b) arr2 (off2*b) (size*b) - writeByteArray marr1 ((off1+i*(size+ysize)+size) `quot` ysizereal) y + copyByteArray marr1 ((off1+i*(size'+ysize))*b) arr2 (off2*b) (size'*b) + writeByteArray marr1 ((off1+i*(size'+ysize)+size') `quot` ysizereal) y where b=Prim.sizeOf (undefined::elem) ysizereal = Prim.sizeOf (undefined::y) `quot` Prim.sizeOf (undefined::elem) @@ -486,8 +486,8 @@ instance {-# INLINABLE basicUnsafeCopy #-} basicUnsafeCopy - (UArray_Labeled'_MUVector marr1 off1 n1 size1) - (UArray_Labeled'_MUVector marr2 off2 n2 size2) + (UArray_Labeled'_MUVector marr1 off1 _ size1) + (UArray_Labeled'_MUVector marr2 off2 n2 _) = copyMutableByteArray marr1 (off1*b) marr2 (off2*b) (n2*b) where b = (size1+ysize)*Prim.sizeOf (undefined::elem) @@ -495,8 +495,8 @@ instance {-# INLINABLE basicUnsafeMove #-} basicUnsafeMove - (UArray_Labeled'_MUVector marr1 off1 n1 size1) - (UArray_Labeled'_MUVector marr2 off2 n2 size2) + (UArray_Labeled'_MUVector marr1 off1 _ size1) + (UArray_Labeled'_MUVector marr2 off2 n2 _) = moveByteArray marr1 (off1*b) marr2 (off2*b) (n2*b) where b = (size1+ysize)*Prim.sizeOf (undefined::elem) @@ -520,29 +520,29 @@ instance basicLength (UArray_Labeled'_UVector _ _ n _) = n {-# INLINABLE basicUnsafeSlice #-} - basicUnsafeSlice i len' (UArray_Labeled'_UVector arr off n size) - = UArray_Labeled'_UVector arr (off+i*(size+ysize)) len' size + basicUnsafeSlice i len' (UArray_Labeled'_UVector arr off _ size') + = UArray_Labeled'_UVector arr (off+i*(size'+ysize)) len' size' where ysize=roundUpToNearest 4 $ Prim.sizeOf (undefined::y) `quot` Prim.sizeOf (undefined::elem) {-# INLINABLE basicUnsafeFreeze #-} - basicUnsafeFreeze (UArray_Labeled'_MUVector marr off n size) = do + basicUnsafeFreeze (UArray_Labeled'_MUVector marr off n size') = do arr <- unsafeFreezeByteArray marr - return $ UArray_Labeled'_UVector arr off n size + return $ UArray_Labeled'_UVector arr off n size' {-# INLINABLE basicUnsafeThaw #-} - basicUnsafeThaw (UArray_Labeled'_UVector arr off n size)= do + basicUnsafeThaw (UArray_Labeled'_UVector arr off n size')= do marr <- unsafeThawByteArray arr - return $ UArray_Labeled'_MUVector marr off n size + return $ UArray_Labeled'_MUVector marr off n size' {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (UArray_Labeled'_UVector arr off n size) i = + basicUnsafeIndexM (UArray_Labeled'_UVector arr off _ size') i = -- trace ("off'="+show off') $ return $ Labeled' x y where - off' = off+i*(size+ysize) - x = UVector_Dynamic arr off' size - y = indexByteArray arr $ (off'+size) `quot` ysizereal + off' = off+i*(size'+ysize) + x = UVector_Dynamic arr off' size' + y = indexByteArray arr $ (off'+size') `quot` ysizereal ysizereal = Prim.sizeOf (undefined::y) `quot` Prim.sizeOf (undefined::elem) ysize=roundUpToNearest 4 $ ysizereal @@ -570,9 +570,9 @@ instance let mv = UArray_Labeled'_MUVector marr 0 n xsize let go [] (-1) = return () - go (x:xs) i = do - VGM.unsafeWrite mv i x - go xs (i-1) + go (x':xs') i = do + VGM.unsafeWrite mv i x' + go xs' (i-1) go (P.reverse $ x:xs) (n-1) v <- VG.basicUnsafeFreeze mv diff --git a/src/SubHask/Algebra/Container.hs b/src/SubHask/Algebra/Container.hs index 4f0930f..f91f93b 100644 --- a/src/SubHask/Algebra/Container.hs +++ b/src/SubHask/Algebra/Container.hs @@ -4,20 +4,12 @@ module SubHask.Algebra.Container where -import GHC.Prim import Control.Monad -import GHC.TypeLits import qualified Prelude as P import Prelude (tail,head,last) -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set - import SubHask.Algebra -import SubHask.Algebra.Ord import SubHask.Category -import SubHask.Compatibility.Base -import SubHask.SubType import SubHask.Internal.Prelude import SubHask.TemplateHaskell.Deriving @@ -139,9 +131,9 @@ instance go (toList xs) (toList ys) 0 where go [] [] i = i - go xs [] i = i + fromIntegral (size xs) - go [] ys i = i + fromIntegral (size ys) - go (x:xs) (y:ys) i = go xs ys $ i + if x==y + go xs' [] i = i + fromIntegral (size xs') + go [] ys' i = i + fromIntegral (size ys') + go (x:xs') (y:ys') i = go xs' ys' $ i + if x==y then 0 else 1 @@ -149,16 +141,16 @@ instance distanceUB (Hamming xs) (Hamming ys) dist = go (toList xs) (toList ys) 0 where - go xs ys tot = if tot > dist + go xs' ys' tot = if tot > dist then tot - else go_ xs ys tot + else go_ xs' ys' tot where - go_ (x:xs) (y:ys) i = go xs ys $ i + if x==y + go_ (x:xs'') (y:ys'') i = go xs'' ys'' $ i + if x==y then 0 else 1 go_ [] [] i = i - go_ xs [] i = i + fromIntegral (size xs) - go_ [] ys i = i + fromIntegral (size ys) + go_ xs'' [] i = i + fromIntegral (size xs'') + go_ [] ys'' i = i + fromIntegral (size ys'') ---------------------------------------- @@ -205,14 +197,14 @@ dist a b mainDiag = oneDiag a b (head uppers) (-1 : head lowers) uppers = eachDiag a b (mainDiag : uppers) -- upper diagonals lowers = eachDiag b a (mainDiag : lowers) -- lower diagonals - eachDiag a [] diags = [] - eachDiag a (bch:bs) (lastDiag:diags) = oneDiag a bs nextDiag lastDiag : eachDiag a bs diags + eachDiag _ (_:bs) (lastDiag:diags) = oneDiag a bs nextDiag lastDiag : eachDiag a bs diags where nextDiag = head (tail diags) - oneDiag a b diagAbove diagBelow = thisdiag + eachDiag _ _ _ = [] + oneDiag _ _ diagAbove diagBelow = thisdiag where - doDiag [] b nw n w = [] - doDiag a [] nw n w = [] + doDiag [] _ _ _ _ = [] + doDiag _ [] _ _ _ = [] doDiag (ach:as) (bch:bs) nw n w = me : (doDiag as bs me (tail n) (tail w)) where me = if ach == bch then nw else 1 + min3 (head w) nw (head n) diff --git a/src/SubHask/Algebra/Group.hs b/src/SubHask/Algebra/Group.hs index bb631c4..11eb171 100644 --- a/src/SubHask/Algebra/Group.hs +++ b/src/SubHask/Algebra/Group.hs @@ -11,8 +11,6 @@ import qualified Prelude as P import SubHask.Algebra import SubHask.Category -import SubHask.Mutable -import SubHask.SubType import SubHask.Internal.Prelude import SubHask.TemplateHaskell.Deriving diff --git a/src/SubHask/Algebra/Logic.hs b/src/SubHask/Algebra/Logic.hs index b4ce5ed..af897c3 100644 --- a/src/SubHask/Algebra/Logic.hs +++ b/src/SubHask/Algebra/Logic.hs @@ -2,13 +2,10 @@ module SubHask.Algebra.Logic where import Control.Monad -import qualified Prelude as P import Test.QuickCheck.Gen (suchThat,oneof) import SubHask.Algebra import SubHask.Category -import SubHask.Compatibility.Base -import SubHask.SubType import SubHask.Internal.Prelude import SubHask.TemplateHaskell.Deriving diff --git a/src/SubHask/Algebra/Matrix.hs b/src/SubHask/Algebra/Matrix.hs index 58a11ae..ec407a2 100644 --- a/src/SubHask/Algebra/Matrix.hs +++ b/src/SubHask/Algebra/Matrix.hs @@ -1,7 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} -{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-} -{-# LANGUAGE OverloadedStrings #-} module SubHask.Algebra.Matrix ( Matrix (..) @@ -261,11 +258,11 @@ data Matrix' vect r (a::Symbol) (b::Symbol) where Id :: (ValidMatrix vect r) => - {-#UNPACK#-}!(Scalar r) -> Matrix' vect r (a::Symbol) (a::Symbol) + !(Scalar r) -> Matrix' vect r (a::Symbol) (a::Symbol) Mat :: (ValidMatrix vect r) => - {-#UNPACK#-}!(Matrix vect r (a::Symbol) (b::Symbol)) + !(Matrix vect r (a::Symbol) (b::Symbol)) -> Matrix' vect r (a::Symbol) (b::Symbol) type instance Scalar (Matrix' vect r (a::Symbol) (b::Symbol)) = Scalar r diff --git a/src/SubHask/Algebra/Metric.hs b/src/SubHask/Algebra/Metric.hs index 06e4b21..6ed849d 100644 --- a/src/SubHask/Algebra/Metric.hs +++ b/src/SubHask/Algebra/Metric.hs @@ -4,10 +4,9 @@ module SubHask.Algebra.Metric import SubHask.Category import SubHask.Algebra -import SubHask.Algebra.Ord import SubHask.Internal.Prelude import Control.Monad - +import GHC.Classes (Ord) import qualified Data.List as L import System.IO @@ -24,6 +23,8 @@ printTriDistances m1 m2 m3 = do -- A metric is a tree metric iff two of these perfect matchings have the same weight. -- This is called the 4 points condition. -- printQuadDistances :: (Ord (Scalar m), Show (Scalar m), Metric m) => m -> m -> m -> m -> IO () +printQuadDistances :: (GHC.Classes.Ord (Scalar t), Show (Scalar t), Metric t) => + t -> t -> t -> t -> IO () printQuadDistances m1 m2 m3 m4 = do forM_ xs $ \(match,dist) -> do putStrLn $ match ++ " = " ++ show dist @@ -41,6 +42,7 @@ printQuadDistances m1 m2 m3 m4 = do ] , distance n1 n2 + distance n3 n4 ) + mkMatching _ = undefined -------------------------------------------------------------------------------- diff --git a/src/SubHask/Algebra/Ord.hs b/src/SubHask/Algebra/Ord.hs index ec2b564..620e4c7 100644 --- a/src/SubHask/Algebra/Ord.hs +++ b/src/SubHask/Algebra/Ord.hs @@ -9,13 +9,10 @@ import qualified GHC.Arr as Arr import Data.Array.ST hiding (freeze,thaw) import Control.Monad import Control.Monad.Random -import Control.Monad.ST import Prelude (take) import SubHask.Algebra import SubHask.Category -import SubHask.Mutable -import SubHask.SubType import SubHask.Internal.Prelude import SubHask.TemplateHaskell.Deriving @@ -55,12 +52,12 @@ shuffle xs = do let l = length xs rands <- take l `liftM` getRandomRs (0, l-1) let ar = runSTArray ( do - ar <- Arr.thawSTArray (Arr.listArray (0, l-1) xs) + ar' <- Arr.thawSTArray (Arr.listArray (0, l-1) xs) forM_ (L.zip [0..(l-1)] rands) $ \(i, j) -> do - vi <- Arr.readSTArray ar i - vj <- Arr.readSTArray ar j - Arr.writeSTArray ar j vi - Arr.writeSTArray ar i vj - return ar + vi <- Arr.readSTArray ar' i + vj <- Arr.readSTArray ar' j + Arr.writeSTArray ar' j vi + Arr.writeSTArray ar' i vj + return ar' ) return (Arr.elems ar) diff --git a/src/SubHask/Algebra/Parallel.hs b/src/SubHask/Algebra/Parallel.hs index 4cf3c58..7f25298 100644 --- a/src/SubHask/Algebra/Parallel.hs +++ b/src/SubHask/Algebra/Parallel.hs @@ -2,6 +2,7 @@ -- And if you believe that @NC /= P@, then every parallel algorithm is induced by a monoid in this manner. module SubHask.Algebra.Parallel ( parallel + , parallelN , disableMultithreading , Partitionable (..) , law_Partitionable_length @@ -164,11 +165,11 @@ parfoldtree1 :: Monoid a => [a] -> a parfoldtree1 as = case go as of [] -> zero [a] -> a - as -> parfoldtree1 as + as' -> parfoldtree1 as' where go [] = [] go [a] = [a] - go (a1:a2:as) = par a12 $ a12:go as + go (a1:a2:as'') = par a12 $ a12:go as'' where a12=a1+a2 @@ -184,22 +185,22 @@ partitionBlocked_list :: Int -> [a] -> [[a]] partitionBlocked_list n xs = go xs where go [] = [] - go xs = a:go b + go xs' = a:go b where - (a,b) = P.splitAt len xs + (a,b) = P.splitAt len xs' - size = length xs - len = size `div` n - + if size `rem` n == 0 then 0 else 1 + size' = length xs + len = size' `div` n + + if size' `rem` n == 0 then 0 else 1 -- | This is an alternative definition for list partitioning. -- It should be faster on large lists because it only requires one traversal. -- But it also breaks parallelism for non-commutative operations. {-# INLINABLE partitionInterleaved_list #-} partitionInterleaved_list :: Int -> [a] -> [[a]] -partitionInterleaved_list n xs = [map snd $ P.filter (\(i,x)->i `mod` n==j) ixs | j<-[0..n-1]] +partitionInterleaved_list n xs = [map snd $ P.filter (\(i,_)->i `mod` n==j) ixs | j<-[0..n-1]] where ixs = addIndex 0 xs - addIndex i [] = [] - addIndex i (x:xs) = (i,x):(addIndex (i+1) xs) + addIndex _ [] = [] + addIndex i (x:xs') = (i,x):(addIndex (i+1) xs') diff --git a/src/SubHask/Algebra/Ring.hs b/src/SubHask/Algebra/Ring.hs index a38490a..ee051b8 100644 --- a/src/SubHask/Algebra/Ring.hs +++ b/src/SubHask/Algebra/Ring.hs @@ -1,9 +1,10 @@ +{-# OPTIONS_GHC -fno-warn-missing-methods #-} + module SubHask.Algebra.Ring where import SubHask.Algebra import SubHask.Category -import SubHask.Internal.Prelude -------------------------------------------------------------------------------- diff --git a/src/SubHask/Algebra/Vector.hs b/src/SubHask/Algebra/Vector.hs index eb0e7cf..fc52b28 100644 --- a/src/SubHask/Algebra/Vector.hs +++ b/src/SubHask/Algebra/Vector.hs @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -fno-warn-missing-methods #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + -- | Dense vectors and linear algebra operations. -- -- NOTE: @@ -33,34 +36,23 @@ import qualified Prelude as P import Control.Monad.Primitive import Control.Monad import Data.Primitive hiding (sizeOf) -import Debug.Trace import qualified Data.Primitive as Prim import Foreign.Ptr import Foreign.ForeignPtr import Foreign.Marshal.Utils import Test.QuickCheck.Gen (frequency) -import qualified Data.Vector.Generic as VG -import qualified Data.Vector.Generic.Mutable as VGM import qualified Data.Vector.Unboxed as VU -import qualified Data.Vector.Unboxed.Mutable as VUM import qualified Data.Vector.Storable as VS import qualified Numeric.LinearAlgebra as HM -import qualified Numeric.LinearAlgebra.HMatrix as HM -import qualified Numeric.LinearAlgebra.Data as HM -import qualified Prelude as P import SubHask.Algebra import SubHask.Category -import SubHask.Compatibility.Base import SubHask.Internal.Prelude import SubHask.SubType import Data.Csv (FromRecord,FromField,parseRecord) -import System.IO.Unsafe -import Unsafe.Coerce - -------------------------------------------------------------------------------- -- rewrite rules for faster static parameters -- @@ -133,7 +125,7 @@ instance (Show r, Monoid r, Prim r) => CoArbitrary (UVector (n::Symbol) r) where coarbitrary = coarbitraryShow instance (NFData r, Prim r) => NFData (UVector (n::Symbol) r) where - rnf (UVector_Dynamic arr off n) = seq arr () + rnf (UVector_Dynamic arr _ _) = seq arr () instance (FromField r, ValidUVector n r, IsScalar r, FreeModule r) => FromRecord (UVector (n::Symbol) r) where parseRecord r = do @@ -160,8 +152,8 @@ instance Prim r => IsMutable (UVector (n::Symbol) r) where let b = (extendDimensions n)*Prim.sizeOf (undefined::r) if n==0 then do - ref <- newPrimRef $ UVector_Dynamic arr1 off1 n - return $ Mutable_UVector ref + ref' <- newPrimRef $ UVector_Dynamic arr1 off1 n + return $ Mutable_UVector ref' else unsafePrimToPrim $ do marr2 <- safeNewByteArray b 16 copyByteArray marr2 0 arr1 off1 b @@ -169,8 +161,8 @@ instance Prim r => IsMutable (UVector (n::Symbol) r) where ref2 <- newPrimRef (UVector_Dynamic arr2 0 n) return $ Mutable_UVector ref2 - write (Mutable_UVector ref) (UVector_Dynamic arr2 off2 n2) = do - (UVector_Dynamic arr1 off1 n1) <- readPrimRef ref + write (Mutable_UVector ref') (UVector_Dynamic arr2 off2 n2) = do + (UVector_Dynamic arr1 off1 n1) <- readPrimRef ref' unsafePrimToPrim $ if -- both ptrs null: do nothing | n1==0 && n2==0 -> return () @@ -180,11 +172,11 @@ instance Prim r => IsMutable (UVector (n::Symbol) r) where marr1' <- safeNewByteArray b 16 copyByteArray marr1' 0 arr2 off2 b arr1' <- unsafeFreezeByteArray marr1' - unsafePrimToPrim $ writePrimRef ref (UVector_Dynamic arr1' 0 n2) + unsafePrimToPrim $ writePrimRef ref' (UVector_Dynamic arr1' 0 n2) -- only arr2 null: make arr1 null | n2==0 -> do - writePrimRef ref (UVector_Dynamic arr2 0 n1) + writePrimRef ref' (UVector_Dynamic arr2 0 n1) -- both ptrs valid: perform a normal copy | otherwise -> do @@ -207,7 +199,7 @@ safeNewByteArray b 16 = do return marr {-# INLINE binopDynUV #-} -binopDynUV :: forall a b n m. +binopDynUV :: forall a n. ( Prim a , Monoid a ) => (a -> a -> a) -> UVector (n::Symbol) a -> UVector (n::Symbol) a -> UVector (n::Symbol) a @@ -225,13 +217,13 @@ binopDynUV f v1@(UVector_Dynamic arr1 off1 n1) v2@(UVector_Dynamic arr2 off2 n2) where go _ (-1) = return () go marr3 i = do - let v1 = indexByteArray arr1 (off1+i) - v2 = indexByteArray arr2 (off2+i) - writeByteArray marr3 i (f v1 v2) + let v1' = indexByteArray arr1 (off1+i) + v2' = indexByteArray arr2 (off2+i) + writeByteArray marr3 i (f v1' v2') go marr3 (i-1) {-# INLINE monopDynUV #-} -monopDynUV :: forall a b n m. +monopDynUV :: forall a n. ( Prim a ) => (a -> a) -> UVector (n::Symbol) a -> UVector (n::Symbol) a monopDynUV f v@(UVector_Dynamic arr1 off1 n) = if n==0 @@ -291,7 +283,7 @@ instance (VectorSpace r, ValidUVector n r) => VectorSpace (UVector (n::Symbol) r instance (Monoid r, ValidLogic r, Prim r, IsScalar r) => IxContainer (UVector (n::Symbol) r) where {-# INLINE (!) #-} - (!) (UVector_Dynamic arr off n) i = indexByteArray arr (off+i) + (!) (UVector_Dynamic arr off _) i = indexByteArray arr (off+i) {-# INLINABLE toIxList #-} toIxList (UVector_Dynamic arr off n) = P.zip [0..] $ go (n-1) [] @@ -314,10 +306,10 @@ instance (FreeModule r, ValidUVector n r, ValidLogic r, IsScalar r) => FiniteMod where n = length xs - go marr [] (-1) = return () - go marr (x:xs) i = do + go _ [] (-1) = return () + go marr (x:xs') i = do writeByteArray marr i x - go marr xs (i-1) + go marr xs' (i-1) ---------------------------------------- -- comparison @@ -337,10 +329,10 @@ instance (Eq r, Monoid r, Prim r) => Eq_ (UVector (n::Symbol) r) where | otherwise -> go (n1-1) where go (-1) = true - go i = v1==v2 && go (i-1) + go i = v1'==v2' && go (i-1) where - v1 = indexByteArray arr1 (off1+i) :: r - v2 = indexByteArray arr2 (off2+i) :: r + v1' = indexByteArray arr1 (off1+i) :: r + v2' = indexByteArray arr2 (off2+i) :: r ---------------------------------------- -- distances @@ -357,7 +349,7 @@ instance where {-# INLINE[2] distance #-} - distance v1@(UVector_Dynamic arr1 off1 n1) v2@(UVector_Dynamic arr2 off2 n2) + distance v1@(UVector_Dynamic _ _ n1) v2@(UVector_Dynamic _ _ n2) = if | isZero n1 -> size v2 | isZero n2 -> size v1 @@ -377,7 +369,7 @@ instance else goEach (tot + (v1!i-v2!i).*.(v1!i-v2!i)) (i-1) {-# INLINE[2] distanceUB #-} - distanceUB v1@(UVector_Dynamic arr1 off1 n1) v2@(UVector_Dynamic arr2 off2 n2) ub + distanceUB v1@(UVector_Dynamic _ _ n1) v2@(UVector_Dynamic _ _ n2) ub = if | isZero n1 -> size v2 | isZero n2 -> size v1 @@ -402,7 +394,7 @@ instance instance (VectorSpace r, Prim r, IsScalar r, ExpField r) => Normed (UVector (n::Symbol) r) where {-# INLINE size #-} - size v@(UVector_Dynamic arr off n) = if isZero n + size v@(UVector_Dynamic _ off n) = if isZero n then 0 else sqrt $ go 0 (off+n-1) where @@ -457,8 +449,8 @@ instance else goEach (tot+(v1!i * v2!i)) (i-1) instance MatrixField r => ToFromVector (UVector (n::Symbol) r) where - toVector (UVector_Dynamic fp off n) = undefined - fromVector v = UVector_Dynamic fp off n + toVector (UVector_Dynamic _ _ _) = undefined + fromVector _ = UVector_Dynamic fp off n where (fp,off,n) = undefined -- VS.unsafeToForeignPtr v @@ -501,7 +493,7 @@ isNull :: ForeignPtr a -> Bool isNull fp = unsafeInlineIO $ withForeignPtr fp $ \p -> (return $ p P.== nullPtr) -- | allocates a ForeignPtr that is filled with n "zero"s -zerofp :: forall n r. (Storable r, Monoid r) => Int -> IO (ForeignPtr r) +zerofp :: forall r. (Storable r, Monoid r) => Int -> IO (ForeignPtr r) zerofp n = do fp <- mallocForeignPtrBytes b withForeignPtr fp $ \p -> go p (n-1) @@ -557,7 +549,7 @@ instance (Arbitrary r, ValidSVector n r, FreeModule r, IsScalar r) => Arbitrary ] instance (NFData r, ValidSVector n r) => NFData (SVector (n::Symbol) r) where - rnf (SVector_Dynamic fp off n) = seq fp () + rnf (SVector_Dynamic fp _ _) = seq fp () instance (FromField r, ValidSVector n r, IsScalar r, FreeModule r) => FromRecord (SVector (n::Symbol) r) where parseRecord r = do @@ -590,8 +582,8 @@ instance (ValidSVector n r) => IsMutable (SVector (n::Symbol) r) where ref2 <- newPrimRef (SVector_Dynamic fp2 0 n) return $ Mutable_SVector ref2 - write (Mutable_SVector ref) (SVector_Dynamic fp2 off2 n2) = do - (SVector_Dynamic fp1 off1 n1) <- readPrimRef ref + write (Mutable_SVector ref) (SVector_Dynamic fp2 _ n2) = do + (SVector_Dynamic fp1 _ n1) <- readPrimRef ref unsafePrimToPrim $ if -- both ptrs null: do nothing | isNull fp1 && isNull fp2 -> return () @@ -617,11 +609,11 @@ instance (ValidSVector n r) => IsMutable (SVector (n::Symbol) r) where -- algebra {-# INLINE binopDyn #-} -binopDyn :: forall a b n m. +binopDyn :: forall a n. ( Storable a , Monoid a ) => (a -> a -> a) -> SVector (n::Symbol) a -> SVector (n::Symbol) a -> SVector (n::Symbol) a -binopDyn f v1@(SVector_Dynamic fp1 off1 n1) v2@(SVector_Dynamic fp2 off2 n2) = if +binopDyn f v1@(SVector_Dynamic fp1 off1 n1) v2@(SVector_Dynamic fp2 off2 _) = if | isNull fp1 && isNull fp2 -> v1 | isNull fp1 -> monopDyn (f zero) v2 | isNull fp2 -> monopDyn (\a -> f a zero) v1 @@ -637,13 +629,13 @@ binopDyn f v1@(SVector_Dynamic fp1 off1 n1) v2@(SVector_Dynamic fp2 off2 n2) = i where go _ _ _ (-1) = return () go p1 p2 p3 i = do - v1 <- peekElemOff p1 i - v2 <- peekElemOff p2 i - pokeElemOff p3 i (f v1 v2) + v1' <- peekElemOff p1 i + v2' <- peekElemOff p2 i + pokeElemOff p3 i (f v1' v2') go p1 p2 p3 (i-1) {-# INLINE monopDyn #-} -monopDyn :: forall a b n m. +monopDyn :: forall a n. ( Storable a ) => (a -> a) -> SVector (n::Symbol) a -> SVector (n::Symbol) a monopDyn f v@(SVector_Dynamic fp1 off1 n) = if isNull fp1 @@ -674,9 +666,9 @@ binopDynM :: forall a b n m. binopDynM f (Mutable_SVector ref) (SVector_Dynamic fp2 off2 n2) = do (SVector_Dynamic fp1 off1 n1) <- readPrimRef ref - let runop fp1 fp2 n = unsafePrimToPrim $ - withForeignPtr fp1 $ \p1 -> - withForeignPtr fp2 $ \p2 -> + let runop fp1' fp2' n = unsafePrimToPrim $ + withForeignPtr fp1' $ \p1 -> + withForeignPtr fp2' $ \p2 -> go (plusPtr p1 off1) (plusPtr p2 off2) (n-1) unsafePrimToPrim $ if @@ -708,7 +700,7 @@ binopDynM f (Mutable_SVector ref) (SVector_Dynamic fp2 off2 n2) = do go p1 p2 (i-1) {-# INLINE monopDynM #-} -monopDynM :: forall a b n m. +monopDynM :: forall a n m. ( PrimMonad m , Storable a ) => (a -> a) -> Mutable m (SVector (n::Symbol) a) -> m () @@ -778,7 +770,7 @@ instance where {-# INLINE (!) #-} - (!) (SVector_Dynamic fp off n) i = unsafeInlineIO $ withForeignPtr fp $ \p -> peekElemOff p (off+i) + (!) (SVector_Dynamic fp off _) i = unsafeInlineIO $ withForeignPtr fp $ \p -> peekElemOff p (off+i) {-# INLINABLE toIxList #-} toIxList v = P.zip [0..] $ go (dim v-1) [] @@ -805,10 +797,10 @@ instance (FreeModule r, ValidLogic r, ValidSVector n r, IsScalar r) => FiniteMod where n = length xs - go p [] (-1) = return () - go p (x:xs) i = do + go _ [] (-1) = return () + go p (x:xs') i = do pokeElemOff p i x - go p xs (i-1) + go p xs' (i-1) ---------------------------------------- -- comparison @@ -825,7 +817,7 @@ instance (Eq r, Monoid r, ValidSVector n r) => Eq_ (SVector (n::Symbol) r) where outer (plusPtr p1 off1) (plusPtr p2 off2) (n1-1) where checkZero :: Ptr r -> Int -> IO Bool - checkZero p (-1) = return true + checkZero _ (-1) = return true checkZero p i = do x <- peekElemOff p i if isZero x @@ -1020,11 +1012,11 @@ instance (KnownNat n, ValidSVector n r) => IsMutable (SVector (n::Nat) r) where -- algebra {-# INLINE binopStatic #-} -binopStatic :: forall a b n m. +binopStatic :: forall a n. ( Storable a , KnownNat n ) => (a -> a -> a) -> SVector n a -> SVector n a -> SVector n a -binopStatic f v1@(SVector_Nat fp1) v2@(SVector_Nat fp2) = unsafeInlineIO $ do +binopStatic f (SVector_Nat fp1) (SVector_Nat fp2) = unsafeInlineIO $ do fp3 <- mallocForeignPtrBytes b withForeignPtr fp1 $ \p1 -> withForeignPtr fp2 $ \p2 -> @@ -1044,11 +1036,11 @@ binopStatic f v1@(SVector_Nat fp1) v2@(SVector_Nat fp2) = unsafeInlineIO $ do go p1 p2 p3 (i-1) {-# INLINE monopStatic #-} -monopStatic :: forall a b n m. +monopStatic :: forall a n. ( Storable a , KnownNat n ) => (a -> a) -> SVector n a -> SVector n a -monopStatic f v@(SVector_Nat fp1) = unsafeInlineIO $ do +monopStatic f (SVector_Nat fp1) = unsafeInlineIO $ do fp2 <- mallocForeignPtrBytes b withForeignPtr fp1 $ \p1 -> withForeignPtr fp2 $ \p2 -> @@ -1088,7 +1080,7 @@ binopStaticM f (Mutable_SVector_Nat fp1) (SVector_Nat fp2) = unsafePrimToPrim $ go p1 p2 (i-1) {-# INLINE monopStaticM #-} -monopStaticM :: forall a b n m. +monopStaticM :: forall a n m. ( PrimMonad m , Storable a , KnownNat n @@ -1184,7 +1176,7 @@ instance where {-# INLINE dim #-} - dim v = nat2int (Proxy::Proxy n) + dim _ = nat2int (Proxy::Proxy n) {-# INLINABLE unsafeToModule #-} unsafeToModule xs = if n /= length xs @@ -1197,10 +1189,10 @@ instance where n = nat2int (Proxy::Proxy n) - go p [] (-1) = return () - go p (x:xs) i = do + go _ [] (-1) = return () + go p (x:xs') i = do pokeElemOff p i x - go p xs (i-1) + go p xs' (i-1) ---------------------------------------- @@ -1302,7 +1294,6 @@ instance instance ( KnownNat n , VectorSpace r - , ValidSVector n r , IsScalar r , ExpField r , Real r @@ -1363,7 +1354,7 @@ instance (KnownNat n, MatrixField r) => ToFromVector (SVector (n::Nat) r) where n = nat2int (Proxy::Proxy n) fromVector v = SVector_Nat fp where - (fp,off,n) = VS.unsafeToForeignPtr v + (fp,_,_) = VS.unsafeToForeignPtr v apMat_ :: ( Scalar a~Scalar b @@ -1382,7 +1373,7 @@ data a +> b where Id_ :: ( VectorSpace b - ) => {-#UNPACK#-}!(Scalar b) -> b +> b + ) => !(Scalar b) -> b +> b Mat_ :: ( MatrixField (Scalar b) @@ -1435,11 +1426,11 @@ instance Category (+>) where Zero . (Id_ _ ) = Zero Zero . (Mat_ _ ) = Zero - (Id_ r ) . Zero = Zero + (Id_ _ ) . Zero = Zero (Id_ r1) . (Id_ r2) = Id_ (r1*r2) (Id_ r ) . (Mat_ m ) = Mat_ $ HM.scale r m - (Mat_ m1) . Zero = Zero + (Mat_ _) . Zero = Zero (Mat_ m ) . (Id_ r ) = Mat_ $ HM.scale r m (Mat_ m1) . (Mat_ m2) = Mat_ $ m1 HM.<> m2 @@ -1460,6 +1451,7 @@ instance Dagger (+>) where trans (Mat_ m) = Mat_ $ HM.tr' m instance Groupoid (+>) where + inverse Zero = undefined inverse (Id_ r) = Id_ $ reciprocal r inverse (Mat_ m) = Mat_ $ HM.inv m @@ -1468,6 +1460,7 @@ instance Groupoid (+>) where -- FIXME: what's the norm of a tensor? instance MatrixField r => Normed (SVector m r +> SVector n r) where + size Zero = zero size (Id_ r) = r size (Mat_ m) = HM.det m @@ -1518,6 +1511,8 @@ instance (VectorSpace a, VectorSpace b) => FreeModule (a +> b) where instance (VectorSpace a, VectorSpace b) => VectorSpace (a +> b) where Zero ./. _ = Zero + (Id_ _) ./. Zero = undefined + (Mat_ _) ./. Zero = undefined (Id_ r1) ./. (Id_ r2) = Id_ $ r1/r2 (Id_ r ) ./. (Mat_ m ) = Mat_ $ (HM.scale r (HM.ident (HM.rows m))) P./ m (Mat_ m ) ./. (Id_ r ) = Mat_ $ m P./ HM.scale r (HM.ident (HM.rows m)) @@ -1540,6 +1535,7 @@ instance VectorSpace a => Ring (a +> a) where instance VectorSpace a => Field (a +> a) where fromRational r = Id_ $ fromRational r + reciprocal Zero = undefined reciprocal (Id_ r ) = Id_ $ reciprocal r reciprocal (Mat_ m) = Mat_ $ HM.inv m diff --git a/src/SubHask/Algebra/Vector/FFI.hs b/src/SubHask/Algebra/Vector/FFI.hs index 177c45a..48dc277 100644 --- a/src/SubHask/Algebra/Vector/FFI.hs +++ b/src/SubHask/Algebra/Vector/FFI.hs @@ -1,4 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface #-} +{-# OPTIONS_GHC -fno-warn-auto-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Importing this module will activate RULES that use the FFI for vector ops. module SubHask.Algebra.Vector.FFI @@ -12,15 +14,10 @@ module SubHask.Algebra.Vector.FFI ) where -import qualified Prelude as P import Control.Monad.Primitive import Data.Primitive.ByteArray -import Foreign.C.Types import Foreign.Ptr import Foreign.ForeignPtr -import Foreign.Marshal.Utils - -import System.IO.Unsafe import Unsafe.Coerce import SubHask.Algebra diff --git a/src/SubHask/Category.hs b/src/SubHask/Category.hs index 215c5a6..92483c2 100644 --- a/src/SubHask/Category.hs +++ b/src/SubHask/Category.hs @@ -1,4 +1,6 @@ {-# LANGUAGE NoAutoDeriveTypeable #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-} + -- | SubHask supports two ways to encode categories in Haskell. -- -- **Method 1** @@ -49,6 +51,7 @@ module SubHask.Category Category (..) , (<<<) , (>>>) + , Cat -- * Hask , Hask @@ -62,15 +65,15 @@ module SubHask.Category , snd -- * Special types of categories - , Concrete (..) + , Concrete , Monoidal (..) --- , (><) + -- FIXME: conflict with SubHask.Algebra + -- , (><) , Braided (..) - , Symmetric (..) + , Symmetric , Cartesian (..) , const , const2 --- , duplicate , Closed (..) , Groupoid (..) @@ -88,9 +91,6 @@ import SubHask.Internal.Prelude import SubHask.SubType import qualified Prelude as P --- required for compilation because these are defined properly in the Algebra.hs file -import GHC.Exts (fromListN,fromString) - ------------------------------------------------------------------------------- -- | This 'Category' class modifies the one in the Haskell standard to include the 'ValidCategory' type constraint. @@ -241,7 +241,7 @@ withCategory _ f = embedType2 f -- | FIXME: This would be a useful function to have, but I'm not sure how to implement it yet! embed2 :: (subcat <: cat) => subcat a (subcat a b) -> cat a (cat a b) -embed2 f = undefined +embed2 _ = undefined ------------------------------------------------------------------------------- @@ -332,12 +332,12 @@ class Symmetric cat => Cartesian cat where -- | "fst" specialized to Hask to aid with type inference -- FIXME: this will not be needed with injective types fst :: (a,b) -> a -fst (a,b) = a +fst (a,_) = a -- | "snd" specialized to Hask to aid with type inference -- FIXME: this will not be needed with injective types snd :: (a,b) -> b -snd (a,b) = b +snd (_,b) = b -- | Creates an arrow that ignores its first parameter. const :: @@ -358,9 +358,9 @@ const2 :: const2 a b = initial a . terminal b instance Cartesian ((->) :: * -> * -> *) where - fst_ (a,b) = a - snd_ (a,b) = b - terminal a _ = () + fst_ (a,_) = a + snd_ (_,b) = b + terminal _ _ = () initial a _ = a -- | Closed monoidal categories allow currying, and closed braided categories allow flipping. diff --git a/src/SubHask/Category/Finite.hs b/src/SubHask/Category/Finite.hs index c62eb06..df6f784 100644 --- a/src/SubHask/Category/Finite.hs +++ b/src/SubHask/Category/Finite.hs @@ -29,8 +29,6 @@ module SubHask.Category.Finite ) where -import Control.Monad -import GHC.Prim import GHC.TypeLits import Data.Proxy import qualified Data.Map as Map @@ -41,7 +39,6 @@ import SubHask.Algebra import SubHask.Algebra.Group import SubHask.Category import SubHask.Internal.Prelude -import SubHask.SubType import SubHask.TemplateHaskell.Deriving ------------------------------------------------------------------------------- @@ -62,7 +59,7 @@ instance KnownNat n => FiniteType (Z n) where enumerate = [ mkQuotient i | i <- [0..n - 1] ] where n = natVal (Proxy :: Proxy n) - getOrder z = natVal (Proxy :: Proxy n) + getOrder _ = natVal (Proxy :: Proxy n) -- | The 'ZIndex' class is a newtype wrapper around the natural numbers 'Z'. -- @@ -96,7 +93,7 @@ instance Category SparseFunction where (SparseFunction f1).(SparseFunction f2) = SparseFunction (Map.map (\a -> find a f1) f2) where - find k map = case Map.lookup k map of + find k map' = case Map.lookup k map' of Just v -> v Nothing -> swapZIndex k @@ -119,6 +116,7 @@ list2sparseFunction :: ) => [Z (Order a)] -> SparseFunction a b list2sparseFunction xs = SparseFunction $ Map.fromList $ go xs where + go [] = undefined go (y:[]) = [(ZIndex y, ZIndex $ P.head xs)] go (y1:y2:ys) = (ZIndex y1,ZIndex y2):go (y2:ys) @@ -145,7 +143,7 @@ instance Category SparseFunctionMonoid where (SparseFunctionMonoid f1).(SparseFunctionMonoid f2) = SparseFunctionMonoid (Map.map (\a -> find a f1) f2) where - find k map = case Map.lookup k map of + find k map' = case Map.lookup k map' of Just v -> v Nothing -> index zero diff --git a/src/SubHask/Category/Polynomial.hs b/src/SubHask/Category/Polynomial.hs index 854dca4..d2f5da4 100644 --- a/src/SubHask/Category/Polynomial.hs +++ b/src/SubHask/Category/Polynomial.hs @@ -7,12 +7,8 @@ import qualified Prelude as P import SubHask.Internal.Prelude import SubHask.Category import SubHask.Algebra -import SubHask.Monad import SubHask.SubType -------------------------------------------------------------------------------- - - -- | The type of polynomials over an arbitrary ring. -- -- See for more detail. @@ -25,7 +21,7 @@ type Polynomial a = Polynomial_ a a -- Can/Should we generalize this to allow polynomials between types? -- data Polynomial_ a b where - Polynomial_ :: (ValidLogic a, Ring a, a~b) => {-#UNPACK#-}![a] -> Polynomial_ a b + Polynomial_ :: (ValidLogic a, Ring a, a~b) => ![a] -> Polynomial_ a b mkMutable [t| forall a b. Polynomial_ a b |] @@ -98,7 +94,7 @@ instance (Ring r, Abelian r) => Abelian (Polynomial_ r r) instance (ValidLogic r, Ring r) => Rg (Polynomial_ r r) where (Polynomial_ p1)*(Polynomial_ p2) = Polynomial_ $ P.foldl (sumList (+)) [] $ go p1 zero where - go [] i = [] + go [] _ = [] go (x:xs) i = (P.replicate i zero ++ P.map (*x) p2):go xs (i+one) instance (ValidLogic r, Ring r) => Rig (Polynomial_ r r) where @@ -116,8 +112,9 @@ instance IsScalar r => FreeModule (Polynomial_ r r) where (Polynomial_ xs) .*. (Polynomial_ ys) = Polynomial_ $ P.zipWith (*) xs ys ones = Polynomial_ $ P.repeat one -sumList f [] ys = ys -sumList f xs [] = xs +sumList :: (t -> t -> t) -> [t] -> [t] -> [t] +sumList _ [] ys = ys +sumList _ xs [] = xs sumList f (x:xs) (y:ys) = f x y:sumList f xs ys instance Category Polynomial_ where diff --git a/src/SubHask/Category/Product.hs b/src/SubHask/Category/Product.hs index cbd2ef9..ea8a3c5 100644 --- a/src/SubHask/Category/Product.hs +++ b/src/SubHask/Category/Product.hs @@ -1,14 +1,7 @@ module SubHask.Category.Product where -import GHC.Prim -import qualified Prelude as P - import SubHask.Category -import SubHask.Internal.Prelude -import GHC.Exts - -------------------------------------------------------------------------------- data (><) cat1 cat2 a b = Product (cat1 a b, cat2 a b) diff --git a/src/SubHask/Category/Slice.hs b/src/SubHask/Category/Slice.hs index c07e1de..4b6d3bd 100644 --- a/src/SubHask/Category/Slice.hs +++ b/src/SubHask/Category/Slice.hs @@ -1,12 +1,7 @@ module SubHask.Category.Slice where -import GHC.Prim -import qualified Prelude as P - import SubHask.Category -import SubHask.Algebra -import SubHask.Internal.Prelude data Comma cat1 cat2 cat3 a b = Comma (cat1 a b) (cat2 a b) diff --git a/src/SubHask/Category/Trans/Bijective.hs b/src/SubHask/Category/Trans/Bijective.hs index 95e6a4c..9989a8c 100644 --- a/src/SubHask/Category/Trans/Bijective.hs +++ b/src/SubHask/Category/Trans/Bijective.hs @@ -13,13 +13,14 @@ module SubHask.Category.Trans.Bijective , BijectiveT , proveBijective , unsafeProveBijective + , unInjectiveT + , unSurjectiveT + , unBijectiveT ) where import SubHask.Category -import SubHask.Algebra import SubHask.SubType -import SubHask.Internal.Prelude -- | Injective (one-to-one) functions map every input to a unique output. See -- for more detail. diff --git a/src/SubHask/Category/Trans/Constrained.hs b/src/SubHask/Category/Trans/Constrained.hs index 2cbe08e..27ee8b9 100644 --- a/src/SubHask/Category/Trans/Constrained.hs +++ b/src/SubHask/Category/Trans/Constrained.hs @@ -12,7 +12,6 @@ module SubHask.Category.Trans.Constrained where import GHC.Prim -import qualified Prelude as P import SubHask.Algebra import SubHask.Category diff --git a/src/SubHask/Category/Trans/Derivative.hs b/src/SubHask/Category/Trans/Derivative.hs index ab469a4..33ad606 100644 --- a/src/SubHask/Category/Trans/Derivative.hs +++ b/src/SubHask/Category/Trans/Derivative.hs @@ -1,5 +1,5 @@ {-# LANGUAGE IncoherentInstances #-} - +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- | This module provides a category transformer for automatic differentiation. -- -- There are many alternative notions of a generalized derivative. @@ -21,15 +21,11 @@ module SubHask.Category.Trans.Derivative where import SubHask.Algebra -import SubHask.Algebra.Vector import SubHask.Category import SubHask.SubType import SubHask.Internal.Prelude -import qualified Prelude as P - -------------------------------------------------------------------------------- - -- | This is essentially just a translation of the "Numeric.AD.Forward.Forward" type -- for use with the SubHask numeric hierarchy. -- @@ -104,33 +100,47 @@ instance Diff 0 <: (->) where where unDiff0 :: Diff 0 a b -> a -> b unDiff0 (Diff0 f) = f + unDiff0 (Diffn _ _) = undefined instance Diff n <: (->) where embedType_ = Embed2 unDiffn where unDiffn :: Diff n a b -> a -> b - unDiffn (Diffn f f') = f + unDiffn (Diffn f _) = f + unDiffn (Diff0 _) = undefined + -- -- FIXME: these subtyping instance should be made more generic -- the problem is that type families aren't currently powerful enough -- instance Sup (Diff 0) (Diff 1) (Diff 0) instance Sup (Diff 1) (Diff 0) (Diff 0) -instance Diff 1 <: Diff 0 where embedType_ = Embed2 m2n where m2n (Diffn f f') = Diff0 f +instance Diff 1 <: Diff 0 + where embedType_ = Embed2 m2n + where m2n (Diffn f _) = Diff0 f + m2n (Diff0 _) = undefined instance Sup (Diff 0) (Diff 2) (Diff 0) instance Sup (Diff 2) (Diff 0) (Diff 0) -instance Diff 2 <: Diff 0 where embedType_ = Embed2 m2n where m2n (Diffn f f') = Diff0 f +instance Diff 2 <: Diff 0 + where embedType_ = Embed2 m2n + where m2n (Diffn f _) = Diff0 f + m2n (Diff0 _) = undefined instance Sup (Diff 1) (Diff 2) (Diff 1) instance Sup (Diff 2) (Diff 1) (Diff 1) -instance Diff 2 <: Diff 1 where embedType_ = Embed2 m2n where m2n (Diffn f f') = Diffn f (embedType2 f') +instance Diff 2 <: Diff 1 + where embedType_ = Embed2 m2n + where m2n (Diffn f f') = Diffn f (embedType2 f') + m2n (Diff0 _) = undefined --------- instance (1 <= n) => C (Diff n) where type D (Diff n) = Diff (n-1) - derivative (Diffn f f') = f' + derivative (Diffn _ f') = f' + -- doesn't work, hence no non-ehaustive pattern ghc option + -- derivative (Diff0 _) = undefined unsafeProveC0 :: (a -> b) -> Diff 0 a b unsafeProveC0 f = Diff0 f @@ -167,6 +177,7 @@ mkMutable [t| forall n a b. Diff n a b |] instance Semigroup b => Semigroup (Diff 0 a b) where (Diff0 f1 )+(Diff0 f2 ) = Diff0 (f1+f2) + _ + _ = undefined instance (Semigroup b, Semigroup (a> Semigroup (Diff 1 a b) where (Diffn f1 f1')+(Diffn f2 f2') = Diffn (f1+f2) (f1'+f2') diff --git a/src/SubHask/Category/Trans/Monotonic.hs b/src/SubHask/Category/Trans/Monotonic.hs index 988204f..c0e8998 100644 --- a/src/SubHask/Category/Trans/Monotonic.hs +++ b/src/SubHask/Category/Trans/Monotonic.hs @@ -1,5 +1,5 @@ module SubHask.Category.Trans.Monotonic - ( Mon (..) + ( Mon , unsafeProveMon -- * The MonT transformer @@ -9,15 +9,9 @@ module SubHask.Category.Trans.Monotonic ) where -import GHC.Prim -import Data.Proxy -import qualified Prelude as P - -import SubHask.Internal.Prelude import SubHask.Category import SubHask.Algebra import SubHask.SubType -import SubHask.Category.Trans.Constrained data IncreasingT cat (a :: *) (b :: *) where IncreasingT :: (Ord_ a, Ord_ b) => cat a b -> IncreasingT cat a b diff --git a/src/SubHask/Compatibility/Base.hs b/src/SubHask/Compatibility/Base.hs index d29d2ee..eae4733 100644 --- a/src/SubHask/Compatibility/Base.hs +++ b/src/SubHask/Compatibility/Base.hs @@ -1,4 +1,8 @@ {-# LANGUAGE NoRebindableSyntax #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-} -- | This file contains a LOT of instance declarations for making Base code compatible with SubHask type classes. -- There's very little code in here though. @@ -9,37 +13,20 @@ module SubHask.Compatibility.Base import Data.Typeable import qualified Prelude as Base -import qualified Control.Applicative as Base import qualified Control.Monad as Base -import Language.Haskell.TH -import Control.Arrow import Control.Monad.Identity (Identity(..)) -import Control.Monad.Reader (Reader,ReaderT) -import Control.Monad.State.Strict (State,StateT) -import Control.Monad.Trans -import Control.Monad.ST (ST) -import GHC.Conc.Sync -import GHC.GHCi -import Text.ParserCombinators.ReadP -import Text.ParserCombinators.ReadPrec - -import Control.Monad.Random +import Control.Monad.Reader (ReaderT) +import Control.Monad.State.Strict (StateT) import SubHask.Algebra import SubHask.Category import SubHask.Monad import SubHask.Internal.Prelude import SubHask.TemplateHaskell.Base -import SubHask.TemplateHaskell.Deriving - -------------------------------------------------------------------------------- -- bug fixes - --- required for GHCI to work because NoIO does not have a Base.Functor instance -instance Functor Hask NoIO where fmap = Base.liftM - -- these definitions are required for the corresponding types to be in scope in the TH code below; -- pretty sure this is a GHC bug dummy1 = undefined :: Identity a @@ -98,11 +85,11 @@ instance Base.Applicative Maybe' instance Base.Monad Maybe' where return = Just' - Nothing' >>= f = Nothing' + Nothing' >>= _ = Nothing' (Just' a) >>= f = f a instance Functor Hask Maybe' where - fmap f Nothing' = Nothing' + fmap _ Nothing' = Nothing' fmap f (Just' a) = Just' $ f a instance Then Maybe' where diff --git a/src/SubHask/Compatibility/BloomFilter.hs b/src/SubHask/Compatibility/BloomFilter.hs index 80945b1..b837221 100644 --- a/src/SubHask/Compatibility/BloomFilter.hs +++ b/src/SubHask/Compatibility/BloomFilter.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-missing-methods #-} + module SubHask.Compatibility.BloomFilter ( BloomFilter ) @@ -19,13 +21,11 @@ type instance Logic (BloomFilter n a) = Bool type instance Elem (BloomFilter n a) = a type instance SetElem (BloomFilter n a) b = BloomFilter n b -hash = undefined - instance KnownNat n => Semigroup (BloomFilter n a) -- FIXME: need access to the underlying representation of BF.Bloom to implement instance KnownNat n => Monoid (BloomFilter n a) where - zero = BloomFilter (BF.empty hash n) + zero = BloomFilter (BF.empty undefined n) where n = fromInteger $ natVal (Proxy::Proxy n) diff --git a/src/SubHask/Compatibility/ByteString.hs b/src/SubHask/Compatibility/ByteString.hs index 80e16fe..6d16b2c 100644 --- a/src/SubHask/Compatibility/ByteString.hs +++ b/src/SubHask/Compatibility/ByteString.hs @@ -60,7 +60,7 @@ instance Normed (ByteString Char) where instance Foldable (ByteString Char) where uncons (BSLC xs) = case BS.uncons xs of Nothing -> Nothing - Just (x,xs) -> Just (x,BSLC xs) + Just (x,xs') -> Just (x,BSLC xs') toList (BSLC xs) = BS.unpack xs @@ -74,16 +74,16 @@ instance Foldable (ByteString Char) where instance Partitionable (ByteString Char) where partition n (BSLC xs) = go xs where - go xs = if BS.null xs + go xs' = if BS.null xs' then [] else BSLC a:go b where - (a,b) = BS.splitAt len xs + (a,b) = BS.splitAt len xs' n' = P.fromIntegral $ toInteger n - size = BS.length xs - len = size `P.div` n' - P.+ if size `P.rem` n' P.== (P.fromInteger 0) then P.fromInteger 0 else P.fromInteger 1 + size' = BS.length xs + len = size' `P.div` n' + P.+ if size' `P.rem` n' P.== (P.fromInteger 0) then P.fromInteger 0 else P.fromInteger 1 -- | -- @@ -104,7 +104,7 @@ instance (a~ByteString Char, Partitionable a) => Partitionable (PartitionOnNewli where go [] = [] go [x] = [x] - go (x1:x2:xs) = (x1+BSLC a):go (BSLC b:xs) + go (x1:x2:xs') = (x1+BSLC a):go (BSLC b:xs') where (a,b) = BS.break (=='\n') $ unBSLC x2 diff --git a/src/SubHask/Compatibility/Cassava.hs b/src/SubHask/Compatibility/Cassava.hs index c6aa548..c6a34ab 100644 --- a/src/SubHask/Compatibility/Cassava.hs +++ b/src/SubHask/Compatibility/Cassava.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + module SubHask.Compatibility.Cassava ( decode_ , decode diff --git a/src/SubHask/Compatibility/Containers.hs b/src/SubHask/Compatibility/Containers.hs index 13435e6..b0dfbc0 100644 --- a/src/SubHask/Compatibility/Containers.hs +++ b/src/SubHask/Compatibility/Containers.hs @@ -19,10 +19,9 @@ import SubHask.Algebra.Parallel import SubHask.Category import SubHask.Category.Trans.Constrained import SubHask.Category.Trans.Monotonic -import SubHask.Compatibility.Base +import SubHask.Compatibility.Base() import SubHask.Internal.Prelude import SubHask.Monad -import SubHask.TemplateHaskell.Deriving ------------------------------------------------------------------------------- -- | This is a thin wrapper around Data.Sequence @@ -116,20 +115,21 @@ instance (ValidEq a) => Partitionable (Seq a) where partition n (Seq xs) = go xs where go :: Seq.Seq a -> [Seq a] - go xs = if Seq.null xs + go xs' = if Seq.null xs' then [] else Seq a:go b where - (a,b) = Seq.splitAt len xs + (a,b) = Seq.splitAt len xs' - size = Seq.length xs - len = size `div` n - + if size `rem` n == 0 then 0 else 1 + size' = Seq.length xs + len = size' `div` n + + if size' `rem` n == 0 then 0 else 1 {-# INLINABLE partitionInterleaved #-} partitionInterleaved n xs = foldl' go (P.replicate n empty) xs where go (r:rs) x = rs+[r`snoc`x] + go [] _ = undefined ------------------------------------------------------------------------------- -- | This is a thin wrapper around Data.Map @@ -495,10 +495,10 @@ instance Ord a => Foldable (Set a) where {-# INLINE foldl' #-} {-# INLINE foldr #-} {-# INLINE foldr' #-} - foldl f a (Set s) = Set.foldl (\a (WithPreludeOrd e) -> f a e) a s - foldl' f a (Set s) = Set.foldl' (\a (WithPreludeOrd e) -> f a e) a s - foldr f a (Set s) = Set.foldr (\(WithPreludeOrd e) a -> f e a) a s - foldr' f a (Set s) = Set.foldr' (\(WithPreludeOrd e) a -> f e a) a s + foldl f a (Set s) = Set.foldl (\a' (WithPreludeOrd e) -> f a' e) a s + foldl' f a (Set s) = Set.foldl' (\a' (WithPreludeOrd e) -> f a' e) a s + foldr f a (Set s) = Set.foldr (\(WithPreludeOrd e) a' -> f e a') a s + foldr' f a (Set s) = Set.foldr' (\(WithPreludeOrd e) a' -> f e a') a s -- | -- @@ -584,6 +584,4 @@ instance Monad Mon LexSet where join = unsafeProveMon $ \(LexSet s) -> foldl1' (+) s instance Then LexSet where - (LexSet a)>>(LexSet b) = LexSet b - - + (LexSet _)>>(LexSet b) = LexSet b diff --git a/src/SubHask/Internal/Prelude.hs b/src/SubHask/Internal/Prelude.hs index 290987a..2742f48 100644 --- a/src/SubHask/Internal/Prelude.hs +++ b/src/SubHask/Internal/Prelude.hs @@ -59,12 +59,9 @@ module SubHask.Internal.Prelude import Control.DeepSeq import Control.Monad.ST -import Data.Foldable -import Data.List (foldl, foldl', foldr, foldl1, foldl1', foldr1, map, (++), intersectBy, unionBy ) import Data.Maybe import Data.Typeable import Data.Proxy -import Data.Traversable import GHC.TypeLits import GHC.Exts import GHC.Int @@ -73,7 +70,7 @@ import Test.QuickCheck.Arbitrary import Foreign.Storable {-# INLINE ifThenElse #-} --- ifThenElse a b c = if a then b else c +ifThenElse :: Bool -> a -> a -> a ifThenElse a b c = case a of True -> b False -> c diff --git a/src/SubHask/Monad.hs b/src/SubHask/Monad.hs index bac5f3f..e8c4e8c 100644 --- a/src/SubHask/Monad.hs +++ b/src/SubHask/Monad.hs @@ -2,7 +2,6 @@ module SubHask.Monad where -import qualified Prelude as P import Prelude (replicate, zipWith, unzip) import SubHask.Algebra @@ -90,6 +89,7 @@ class (Then m, Functor cat m) => Monad cat m where (>=>) :: cat a (m b) -> cat b (m c) -> cat a (m c) (>=>) = flip (<=<) +fail :: String -> a fail = error -------------------------------------------------------------------------------- diff --git a/src/SubHask/Mutable.hs b/src/SubHask/Mutable.hs index 9ec6df7..5f0618f 100644 --- a/src/SubHask/Mutable.hs +++ b/src/SubHask/Mutable.hs @@ -35,7 +35,6 @@ import Prelude (($),(.)) import Control.Monad import Control.Monad.Primitive import Control.Monad.ST -import Data.Primitive import Data.PrimRef import System.IO.Unsafe diff --git a/src/SubHask/SubType.hs b/src/SubHask/SubType.hs index 7c5bbfc..2bb098e 100644 --- a/src/SubHask/SubType.hs +++ b/src/SubHask/SubType.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoAutoDeriveTypeable #-} -- can't derive typeable of data families +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- | This module defines the subtyping mechanisms used in subhask. module SubHask.SubType @@ -10,28 +11,25 @@ module SubHask.SubType , embedType , embedType1 , embedType2 + , apEmbedType1 + , apEmbedType2 -- * Template Haskell , mkSubtype , mkSubtypeInstance + + , law_Subtype_f1 + , law_Subtype_f2 ) where import Control.Monad import Language.Haskell.TH -import Language.Haskell.TH.Quote import SubHask.Internal.Prelude import Prelude ------------------------------------------------------------------------------- --- common helper functions - -toRational :: (a <: Rational) => a -> Rational -toRational = embedType - -------------------------------------------------------------------------------- - -- | Subtypes are partially ordered. -- Unfortunately, there's no way to use the machinery of the "POrd"/"Lattice" classes. -- The "Sup" type family is a promotion of the "sup" function to the type level. @@ -117,16 +115,16 @@ law_Subtype_f2 _ b f a1 a2 = embedType (f a1 a2) == f (embedType a1) (embedType ------------------- type family a == b :: Bool where - a == a = True - a == b = False + a == a = 'True + a == b = 'False type family If (a::Bool) (b::k) (c::k) :: k where - If True b c = b - If False b c = c + If 'True b c = b + If 'False b c = c type family When (a::Bool) (b::Constraint) :: Constraint where - When True b = b - When False b = () + When 'True b = b + When 'False b = () ------------------- diff --git a/src/SubHask/TemplateHaskell/Base.hs b/src/SubHask/TemplateHaskell/Base.hs index 1e771c3..7d716ff 100644 --- a/src/SubHask/TemplateHaskell/Base.hs +++ b/src/SubHask/TemplateHaskell/Base.hs @@ -1,4 +1,6 @@ {-# LANGUAGE NoRebindableSyntax #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | This file contains the template haskell code for deriving SubHask class instances from Base instances. -- All of the standard instances are created in "SubHask.Compatibility.Base". @@ -17,10 +19,8 @@ module SubHask.TemplateHaskell.Base where import qualified Prelude as Base -import qualified Control.Applicative as Base import qualified Control.Monad as Base import Language.Haskell.TH -import System.IO import SubHask.Category import SubHask.Algebra @@ -78,8 +78,8 @@ runIfNotInstance n t q = do else trace ("deriving instance: "++show n++" / "++show t) $ q where alreadyInstance :: Name -> Type -> Q Bool - alreadyInstance n t = do - info <- reify n + alreadyInstance n' _ = do + info <- reify n' Base.return $ case info of ClassI _ xs -> or $ map (genericTypeEq t.rmInstanceD) xs @@ -96,7 +96,7 @@ runIfNotInstance n t q = do genericTypeEq _ _ = false - rmInstanceD (InstanceD _ (AppT _ t) _) = t + rmInstanceD (InstanceD _ (AppT _ t') _) = t' -------------------------------------------------------------------------------- -- comparison hierarchy @@ -142,11 +142,11 @@ mkPreludeFunctor ctx qt = do -- | Create an "Applicative" instance from a "Prelude.Applicative" instance. mkPreludeApplicative :: Cxt -> Q Type -> Q [Dec] -mkPreludeApplicative cxt qt = do +mkPreludeApplicative cxt' qt = do t <- qt runIfNotInstance ''Applicative t $ Base.return [ InstanceD - cxt + cxt' ( AppT ( AppT ( ConT $ mkName "Applicative" ) @@ -164,7 +164,7 @@ mkPreludeApplicative cxt qt = do -- FIXME: -- Monad transformers still require their parameter monad to be an instance of "Prelude.Monad". mkPreludeMonad :: Cxt -> Q Type -> Q [Dec] -mkPreludeMonad cxt qt = do +mkPreludeMonad cxt' qt = do t <- qt -- can't call -- > runIfNotInstance ''Monad t $ @@ -173,7 +173,7 @@ mkPreludeMonad cxt qt = do then Base.return [] else Base.return [ InstanceD - cxt + cxt' ( AppT ( ConT $ mkName "Then" ) t @@ -181,8 +181,7 @@ mkPreludeMonad cxt qt = do [ FunD ( mkName ">>" ) [ Clause [] (NormalB $ VarE $ mkName "Base.>>") [] ] ] , InstanceD --- ( ClassP ''Functor [ ConT ''Hask , t ] : cxt ) - ( AppT (AppT (ConT ''Functor) (ConT ''Hask)) t : cxt ) + ( AppT (AppT (ConT ''Functor) (ConT ''Hask)) t : cxt' ) ( AppT ( AppT ( ConT $ mkName "Monad" ) @@ -201,10 +200,10 @@ mkPreludeMonad cxt qt = do where -- | This helper function "filters out" monads for which we can't automatically derive an implementation. -- This failure can be due to missing Functor instances or weird type errors. - cannotDeriveMonad t = elem (show $ getName t) badmonad + cannotDeriveMonad t' = elem (show $ getName t') badmonad where getName :: Type -> Name - getName t = case t of + getName t'' = case t'' of (ConT t) -> t ListT -> mkName "[]" (SigT t _) -> getName t diff --git a/src/SubHask/TemplateHaskell/Common.hs b/src/SubHask/TemplateHaskell/Common.hs index 096cdac..7eb2d95 100644 --- a/src/SubHask/TemplateHaskell/Common.hs +++ b/src/SubHask/TemplateHaskell/Common.hs @@ -2,9 +2,7 @@ module SubHask.TemplateHaskell.Common where import Prelude -import Data.List (init,last,nub,intersperse) import Language.Haskell.TH.Syntax -import Control.Monad bndr2type :: TyVarBndr -> Type bndr2type (PlainTV n) = VarT n @@ -19,7 +17,8 @@ apply2varlist :: Type -> [TyVarBndr] -> Type apply2varlist contype xs = go $ reverse xs where go (x:[]) = AppT contype (mkVar x) - go (x:xs) = AppT (go xs) (mkVar x) + go (x:xs') = AppT (go xs') (mkVar x) + go [] = undefined mkVar (PlainTV n) = VarT n mkVar (KindedTV n _) = VarT n diff --git a/src/SubHask/TemplateHaskell/Deriving.hs b/src/SubHask/TemplateHaskell/Deriving.hs index 97ca7fe..80e0a59 100644 --- a/src/SubHask/TemplateHaskell/Deriving.hs +++ b/src/SubHask/TemplateHaskell/Deriving.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + -- | -- -- FIXME: doesn't handle multiparameter classes like Integral and Vector @@ -20,6 +22,9 @@ module SubHask.TemplateHaskell.Deriving , BasicType , helper_liftM , helper_id + + -- ** misc + , substituteNewtype ) where @@ -27,11 +32,10 @@ import SubHask.Internal.Prelude import SubHask.TemplateHaskell.Common import SubHask.TemplateHaskell.Mutable import Prelude -import Data.List (init,last,nub,intersperse) +import Data.List (nub) import Language.Haskell.TH.Syntax import Control.Monad -import Debug.Trace -- | This class provides an artificial hierarchy that defines all the classes that a "well behaved" data type should implement. @@ -62,7 +66,7 @@ listSuperClasses className = do TyConI (TySynD _ bndrs t) -> liftM concat $ mapM (go $ bndrs2var bndrs) $ tuple2list t - info -> error $ "type "++nameBase className++" not a unary class\n\ninfo="++show info + info' -> error $ "type "++nameBase className++" not a unary class\n\ninfo="++show info' where bndrs2var bndrs = case bndrs of @@ -72,7 +76,7 @@ listSuperClasses className = do go var (AppT (ConT name) (VarT var')) = if var==var' then listSuperClasses name else return [] -- class depends on another type tested elsewhere - go var _ = return [] + go _ _ = return [] tuple2list :: Type -> [Type] tuple2list (AppT (AppT (TupleT 2) t1) t2) = [t1,t2] @@ -145,7 +149,7 @@ deriveSingleInstance typename classname = if show classname == "SubHask.Mutable. ClassI (ClassD _ _ _ _ _) [InstanceD _ (AppT (ConT _) (VarT _)) _] -> return [] -- otherwise, create the instance - ClassI classd@(ClassD ctx classname [bndr] [] decs) _ -> do + ClassI (ClassD ctx _ [bndr] [] decs) _ -> do let varname = case bndr of PlainTV v -> v KindedTV v StarT -> v @@ -212,26 +216,26 @@ substituteVarE varname vartype = go go zzz = error $ "substituteVarE: zzz="++show zzz returnType2newtypeApplicator :: Name -> Name -> Type -> Exp -> Q Exp -returnType2newtypeApplicator conname varname t exp = do +returnType2newtypeApplicator conname varname t exp' = do ret <- go t - return $ AppE ret exp + return $ AppE ret exp' where - id = return $ VarE $ mkName "helper_id" + id' = return $ VarE $ mkName "helper_id" go (VarT v) = if v==varname then return $ ConE conname - else id - go (ConT c) = id + else id' + go (ConT _) = id' -- | FIXME: The cases below do not cover all the possible functions we might want to derive - go (TupleT 0) = id - go t@(AppT (ConT c) t2) = do + go (TupleT 0) = id' + go (AppT (ConT c) t2) = do info <- reify c case info of TyConI (TySynD _ _ _) -> expandTySyn t >>= go - FamilyI (FamilyD TypeFam _ _ _) _ -> id + FamilyI (FamilyD TypeFam _ _ _) _ -> id' TyConI (NewtypeD _ _ _ _ _) -> liftM (AppE (VarE $ mkName "helper_liftM")) $ go t2 TyConI (DataD _ _ _ _ _) -> liftM (AppE (VarE $ mkName "helper_liftM")) $ go t2 qqq -> error $ "returnType2newtypeApplicator: qqq="++show qqq @@ -250,9 +254,9 @@ returnType2newtypeApplicator conname varname t exp = do ) -- FIXME: this is a particularly fragile deriving clause only designed for the mutable operators - go (AppT (VarT m) (TupleT 0)) = id + go (AppT (VarT _) (TupleT 0)) = id' - go xxx = error $ "returnType2newtypeApplicator:\n xxx="++show xxx++"\n t="++show t++"\n exp="++show exp + go xxx = error $ "returnType2newtypeApplicator:\n xxx="++show xxx++"\n t="++show t++"\n exp="++ show exp' isNewtypeInstance :: Name -> Name -> Q Bool isNewtypeInstance typename classname = do @@ -265,7 +269,7 @@ isNewtypeInstance typename classname = do substituteNewtype :: Name -> Name -> Name -> Type -> Type -substituteNewtype conname varname newvar = go +substituteNewtype conname varname _ = go where go (VarT v) = if varname==v then AppT (ConT conname) (VarT varname) @@ -280,13 +284,13 @@ typeL2patL conname varname xs = map go $ zip (map (\a -> mkName [a]) ['a'..]) xs go (newvar,VarT v) = if v==varname then ConP conname [VarP newvar] else VarP newvar - go (newvar,AppT (AppT (ConT c) _) v) = if nameBase c=="Mutable" + go (newvar,AppT (AppT (ConT c) _) _) = if nameBase c=="Mutable" then ConP (mkName $ "Mutable_"++nameBase conname) [VarP newvar] else VarP newvar - go (newvar,AppT (ConT _) (VarT v)) = VarP newvar - go (newvar,AppT ListT (VarT v)) = VarP newvar - go (newvar,AppT ListT (AppT (ConT _) (VarT v))) = VarP newvar - go (newvar,ConT c) = VarP newvar + go (newvar,AppT (ConT _) (VarT _)) = VarP newvar + go (newvar,AppT ListT (VarT _)) = VarP newvar + go (newvar,AppT ListT (AppT (ConT _) (VarT _))) = VarP newvar + go (newvar,ConT _) = VarP newvar go (newvar,_) = VarP newvar typeL2expL :: [Type] -> [Exp] @@ -301,7 +305,7 @@ list2exp :: [Exp] -> Exp list2exp xs = go $ reverse xs where go (x:[]) = x - go (x:xs) = AppE (go xs) x + go (x:xs') = AppE (go xs') x -- | Generate an Eq_ instance from the Prelude's Eq instance. -- This requires that Logic t = Bool, so we also generate this type instance. diff --git a/src/SubHask/TemplateHaskell/Mutable.hs b/src/SubHask/TemplateHaskell/Mutable.hs index 807854f..55e115c 100644 --- a/src/SubHask/TemplateHaskell/Mutable.hs +++ b/src/SubHask/TemplateHaskell/Mutable.hs @@ -9,7 +9,6 @@ module SubHask.TemplateHaskell.Mutable import SubHask.TemplateHaskell.Common import Prelude -import Control.Monad import Language.Haskell.TH showtype :: Type -> String @@ -60,7 +59,7 @@ mkMutableNewtype typename = do nameexists <- lookupValueName (show mutname) return $ case nameexists of - Just x -> [] + Just _ -> [] Nothing -> [ NewtypeInstD [ ] @@ -121,13 +120,13 @@ mkMutableNewtype typename = do mkMutablePrimRef :: Q Type -> Q [Dec] mkMutablePrimRef qt = do _t <- qt - let (cxt,t) = case _t of - (ForallT _ cxt t) -> (cxt,t) + let (cxt',t) = case _t of + (ForallT _ cxt'' t') -> (cxt'',t') _ -> ([],_t) return $ [ NewtypeInstD - cxt + cxt' ( mkName $ "Mutable" ) [ VarT (mkName "m"), t ] ( NormalC @@ -138,7 +137,7 @@ mkMutablePrimRef qt = do ) [ ] , InstanceD - cxt + cxt' ( AppT ( ConT $ mkName "IsMutable" ) t ) [ FunD (mkName "freeze") [ Clause diff --git a/src/SubHask/TemplateHaskell/Test.hs b/src/SubHask/TemplateHaskell/Test.hs index fd671b0..0ebb24f 100644 --- a/src/SubHask/TemplateHaskell/Test.hs +++ b/src/SubHask/TemplateHaskell/Test.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + module SubHask.TemplateHaskell.Test where @@ -5,12 +7,8 @@ import Prelude import Control.Monad import qualified Data.Map as Map -import Debug.Trace import Language.Haskell.TH -import GHC.Exts - -import SubHask.Internal.Prelude import SubHask.TemplateHaskell.Deriving -- | Ideally, this map would be generated automatically via template haskell. @@ -220,7 +218,7 @@ mkClassTests className = do info <- reify className typeTests <- case info of ClassI _ xs -> go xs - otherwise -> error "mkClassTests called on something not a class" + _ -> error "mkClassTests called on something not a class" return $ AppE ( AppE ( VarE $ mkName "testGroup" ) @@ -229,7 +227,7 @@ mkClassTests className = do ( typeTests ) where go [] = return $ ConE $ mkName "[]" - go ((InstanceD ctx (AppT _ t) _):xs) = case t of + go ((InstanceD _ (AppT _ t) _):xs) = case t of (ConT a) -> do tests <- mkSpecializedClassTest (ConT a) className next <- go xs @@ -239,7 +237,7 @@ mkClassTests className = do ( tests ) ) ( next ) - otherwise -> go xs + _ -> go xs -- | Given a type and a class, searches "testMap" for all tests for the class; @@ -281,7 +279,7 @@ specializeType specializeType t n = case t of VarT _ -> n AppT t1 t2 -> AppT (specializeType t1 n) (specializeType t2 n) - ForallT xs ctx t -> {-ForallT xs ctx $-} specializeType t n + ForallT _ _ t' -> {-ForallT xs ctx $-} specializeType t' n -- ForallT xs ctx t -> ForallT xs (specializeType ctx n) $ specializeType t n x -> x @@ -293,7 +291,7 @@ specializeLaw typeName lawName = do lawInfo <- reify lawName let newType = case lawInfo of VarI _ t _ _ -> specializeType t typeName - otherwise -> error "mkTest lawName not a function" + _ -> error "mkTest lawName not a function" return $ SigE (VarE lawName) newType -- | creates an expression of the form: diff --git a/subhask.cabal b/subhask.cabal index d34e659..66d7c85 100644 --- a/subhask.cabal +++ b/subhask.cabal @@ -112,6 +112,7 @@ library ghc-options: -funbox-strict-fields + -Wall build-depends: -- haskell language