Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

getting to -Wall #48

Merged
merged 1 commit into from
Jun 19, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions src/SubHask.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,15 +3,15 @@
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
) where

import SubHask.Algebra
import SubHask.Category
import SubHask.Compatibility.Base
import SubHask.Compatibility.Base()
import SubHask.Internal.Prelude
import SubHask.Monad
import SubHask.SubType
79 changes: 37 additions & 42 deletions src/SubHask/Algebra.hs
Original file line number Diff line number Diff line change
@@ -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.
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -94,6 +94,7 @@ module SubHask.Algebra

-- * Set-like
, Elem
, infDisjoint
, SetElem
, Container (..)
, law_Container_preservation
Expand Down Expand Up @@ -127,6 +128,7 @@ module SubHask.Algebra
, defn_Foldable_foldl1'

, foldtree1
, convertUnfoldable
, length
, reduce
, concat
Expand Down Expand Up @@ -169,6 +171,8 @@ module SubHask.Algebra
, Semigroup (..)
, law_Semigroup_associativity
, defn_Semigroup_plusequal
, associator
, cycle
, Actor
, Action (..)
, law_Action_compatibility
Expand All @@ -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
Expand Down Expand Up @@ -215,7 +219,7 @@ module SubHask.Algebra
-- , roundUpToNearestBase2
, fromIntegral
, Field(..)
, OrdField(..)
, OrdField
, RationalField(..)
, convertRationalField
, toFloat
Expand Down Expand Up @@ -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 (..)
Expand All @@ -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


-------------------------------------------------------------------------------
Expand Down Expand Up @@ -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 #-}

-------------------

Expand Down Expand Up @@ -712,16 +714,16 @@ 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
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 #-}
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

--------------------

Expand Down Expand Up @@ -1145,7 +1147,7 @@ instance Monoid () where

instance Monoid b => Monoid (a -> b) where
{-# INLINE zero #-}
zero = \a -> zero
zero = \_ -> zero

---------------------------------------

Expand Down Expand Up @@ -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

---------------------------------------

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -2009,7 +2011,7 @@ instance
) => FreeModule (a -> b)
where
g .*. f = \a -> g a .*. f a
ones = \a -> ones
ones = \_ -> ones

---------------------------------------

Expand Down Expand Up @@ -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

---------------------------------------

Expand Down Expand Up @@ -2332,9 +2334,6 @@ instance CanError Double where

-------------------------------------------------------------------------------
-- set-like

type Item s = Elem s

type family Elem s
type family SetElem s t

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
--
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
Loading