1
1
{-# LANGUAGE CPP,MagicHash,UnboxedTuples #-}
2
+ {-# OPTIONS_GHC -fno-warn-missing-methods #-}
3
+ {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
4
+ {-# OPTIONS_GHC -fno-warn-orphans #-}
2
5
3
6
-- | This module defines the algebraic type-classes used in subhask.
4
7
-- The class hierarchies are significantly more general than those in the standard Prelude.
@@ -51,14 +54,11 @@ module SubHask.Algebra
51
54
, law_Heyting_infleft
52
55
, law_Heyting_infright
53
56
, law_Heyting_distributive
54
- , Boolean ( .. )
57
+ , Boolean
55
58
, law_Boolean_infcomplement
56
59
, law_Boolean_supcomplement
57
60
, law_Boolean_infdistributivity
58
61
, law_Boolean_supdistributivity
59
-
60
- -- , defn_Latticelessthaninf
61
- -- , defn_Latticelessthansup
62
62
, Ord_ (.. )
63
63
, law_Ord_totality
64
64
, law_Ord_min
@@ -73,12 +73,12 @@ module SubHask.Algebra
73
73
, minimum_
74
74
, argmin
75
75
, argmax
76
- -- , argminimum_
77
- -- , argmaximum_
78
76
, Graded (.. )
79
77
, law_Graded_fromEnum
80
78
, law_Graded_pred
81
79
, defn_Graded_predN
80
+ , (>.)
81
+ , (<.)
82
82
, Enum (.. )
83
83
, law_Enum_toEnum
84
84
, law_Enum_succ
@@ -94,6 +94,7 @@ module SubHask.Algebra
94
94
95
95
-- * Set-like
96
96
, Elem
97
+ , infDisjoint
97
98
, SetElem
98
99
, Container (.. )
99
100
, law_Container_preservation
@@ -127,6 +128,7 @@ module SubHask.Algebra
127
128
, defn_Foldable_foldl1'
128
129
129
130
, foldtree1
131
+ , convertUnfoldable
130
132
, length
131
133
, reduce
132
134
, concat
@@ -169,6 +171,8 @@ module SubHask.Algebra
169
171
, Semigroup (.. )
170
172
, law_Semigroup_associativity
171
173
, defn_Semigroup_plusequal
174
+ , associator
175
+ , cycle
172
176
, Actor
173
177
, Action (.. )
174
178
, law_Action_compatibility
@@ -184,7 +188,7 @@ module SubHask.Algebra
184
188
, law_Monoid_leftid
185
189
, law_Monoid_rightid
186
190
, defn_Monoid_isZero
187
- , Abelian ( .. )
191
+ , Abelian
188
192
, law_Abelian_commutative
189
193
, Group (.. )
190
194
, law_Group_leftinverse
@@ -215,7 +219,7 @@ module SubHask.Algebra
215
219
-- , roundUpToNearestBase2
216
220
, fromIntegral
217
221
, Field (.. )
218
- , OrdField ( .. )
222
+ , OrdField
219
223
, RationalField (.. )
220
224
, convertRationalField
221
225
, toFloat
@@ -260,8 +264,12 @@ module SubHask.Algebra
260
264
, defn_FreeModule_dotstardotequal
261
265
, FiniteModule (.. )
262
266
, VectorSpace (.. )
267
+ , Reisz (.. )
263
268
, Banach (.. )
269
+ , law_Banach_distance
270
+ , law_Banach_size
264
271
, Hilbert (.. )
272
+ , squaredInnerProductNorm
265
273
, innerProductDistance
266
274
, innerProductNorm
267
275
, TensorAlgebra (.. )
@@ -281,26 +289,20 @@ import qualified Data.Number.Erf as P
281
289
import qualified Math.Gamma as P
282
290
import qualified Data.List as L
283
291
284
- import Prelude (Ordering (.. ))
285
292
import Control.Monad hiding (liftM )
286
293
import Control.Monad.ST
287
294
import Data.Ratio
288
295
import Data.Typeable
289
- import Test.QuickCheck (Arbitrary ( .. ), frequency )
296
+ import Test.QuickCheck (frequency )
290
297
291
- import Control.Concurrent
292
- import Control.Parallel
293
298
import Control.Parallel.Strategies
294
- import System.IO.Unsafe -- used in the parallel function
295
299
296
300
import GHC.Prim hiding (Any )
297
301
import GHC.Types
298
- import GHC.Magic
299
302
300
303
import SubHask.Internal.Prelude
301
304
import SubHask.Category
302
305
import SubHask.Mutable
303
- import SubHask.SubType
304
306
305
307
306
308
-------------------------------------------------------------------------------
@@ -493,7 +495,7 @@ instance MinBound_ Float where minBound = -1/0 ; {-# INLINE minBound #-
493
495
instance MinBound_ Double where minBound = - 1 / 0 ; {-# INLINE minBound #-}
494
496
-- FIXME: should be a primop for this
495
497
496
- instance MinBound_ b => MinBound_ (a -> b ) where minBound = \ x -> minBound ; {-# INLINE minBound #-}
498
+ instance MinBound_ b => MinBound_ (a -> b ) where minBound = \ _ -> minBound ; {-# INLINE minBound #-}
497
499
498
500
-------------------
499
501
@@ -712,16 +714,16 @@ law_Graded_fromEnum b1 b2
712
714
| otherwise = True
713
715
714
716
law_Graded_pred :: Graded b => b -> b -> Bool
715
- law_Graded_pred b1 b2 = fromEnum (pred b1) == fromEnum b1- 1
717
+ law_Graded_pred b1 _ = fromEnum (pred b1) == fromEnum b1- 1
716
718
|| fromEnum (pred b1) == fromEnum b1
717
719
718
720
defn_Graded_predN :: Graded b => Int -> b -> Bool
719
721
defn_Graded_predN i b
720
722
| i < 0 = true
721
723
| otherwise = go i b == predN i b
722
724
where
723
- go 0 b = b
724
- go i b = go (i- 1 ) $ pred b
725
+ go 0 b' = b'
726
+ go i' b' = go (i' - 1 ) $ pred b'
725
727
726
728
instance Graded Bool where
727
729
{-# INLINE pred #-}
@@ -789,7 +791,7 @@ law_Enum_toEnum :: Enum b => b -> Bool
789
791
law_Enum_toEnum b = toEnum (fromEnum b) == b
790
792
791
793
law_Enum_succ :: Enum b => b -> b -> Bool
792
- law_Enum_succ b1 b2 = fromEnum (succ b1) == fromEnum b1+ 1
794
+ law_Enum_succ b1 _ = fromEnum (succ b1) == fromEnum b1+ 1
793
795
|| fromEnum (succ b1) == fromEnum b1
794
796
795
797
defn_Enum_succN :: Enum b => Int -> b -> Logic b
@@ -903,7 +905,7 @@ instance Bounded Double where maxBound = 1/0 ; {-# INLINE maxBound #-}
903
905
904
906
instance Bounded b => Bounded (a -> b ) where
905
907
{-# INLINE maxBound #-}
906
- maxBound = \ x -> maxBound
908
+ maxBound = \ _ -> maxBound
907
909
908
910
--------------------
909
911
@@ -1145,7 +1147,7 @@ instance Monoid () where
1145
1147
1146
1148
instance Monoid b => Monoid (a -> b ) where
1147
1149
{-# INLINE zero #-}
1148
- zero = \ a -> zero
1150
+ zero = \ _ -> zero
1149
1151
1150
1152
---------------------------------------
1151
1153
@@ -1333,7 +1335,7 @@ instance Rig Rational where one = 1 ; {-# INLINE one #-}
1333
1335
1334
1336
instance Rig b => Rig (a -> b ) where
1335
1337
{-# INLINE one #-}
1336
- one = \ a -> one
1338
+ one = \ _ -> one
1337
1339
1338
1340
---------------------------------------
1339
1341
@@ -1381,7 +1383,7 @@ instance Ring Rational where fromInteger = P.fromInteger ; {-# INLINE fromInt
1381
1383
1382
1384
instance Ring b => Ring (a -> b ) where
1383
1385
{-# INLINE fromInteger #-}
1384
- fromInteger i = \ a -> fromInteger i
1386
+ fromInteger i = \ _ -> fromInteger i
1385
1387
1386
1388
{-# INLINABLE indicator #-}
1387
1389
indicator :: Ring r => Bool -> r
@@ -2009,7 +2011,7 @@ instance
2009
2011
) => FreeModule (a -> b )
2010
2012
where
2011
2013
g .*. f = \ a -> g a .*. f a
2012
- ones = \ a -> ones
2014
+ ones = \ _ -> ones
2013
2015
2014
2016
---------------------------------------
2015
2017
@@ -2162,7 +2164,7 @@ innerProductNorm = undefined -- sqrt . squaredInnerProductNorm
2162
2164
2163
2165
{-# INLINE innerProductDistance #-}
2164
2166
innerProductDistance :: Hilbert v => v -> v -> Scalar v
2165
- innerProductDistance v1 v2 = undefined -- innerProductNorm $ v1-v2
2167
+ innerProductDistance _ _ = undefined -- innerProductNorm $ v1-v2
2166
2168
2167
2169
---------------------------------------
2168
2170
@@ -2332,9 +2334,6 @@ instance CanError Double where
2332
2334
2333
2335
-------------------------------------------------------------------------------
2334
2336
-- set-like
2335
-
2336
- type Item s = Elem s
2337
-
2338
2337
type family Elem s
2339
2338
type family SetElem s t
2340
2339
@@ -2623,11 +2622,11 @@ foldtree1 :: Monoid a => [a] -> a
2623
2622
foldtree1 as = case go as of
2624
2623
[] -> zero
2625
2624
[a] -> a
2626
- as -> foldtree1 as
2625
+ as' -> foldtree1 as'
2627
2626
where
2628
2627
go [] = []
2629
2628
go [a] = [a]
2630
- go (a1: a2: as) = (a1+ a2): go as
2629
+ go (a1: a2: as'' ) = (a1+ a2): go as''
2631
2630
2632
2631
{-# INLINE [1] convertUnfoldable #-}
2633
2632
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
2729
2728
type family Index s
2730
2729
type family SetIndex s a
2731
2730
2732
- -- | FIXME:
2733
- -- This type is a hack designed to work around the lack of injective type families.
2734
- type ValidSetIndex s = SetIndex s (Index s ) ~ s
2735
-
2736
2731
-- | An indexed constructible container associates an 'Index' with each 'Elem'.
2737
2732
-- This class generalizes the map abstract data type.
2738
2733
--
@@ -2945,8 +2940,8 @@ type instance Index [a] = Int
2945
2940
2946
2941
instance ValidEq a => Eq_ [a ] where
2947
2942
(x: xs)== (y: ys) = x== y && xs== ys
2948
- (x : xs )== [] = false
2949
- [] == (y : ts ) = false
2943
+ (_ : _ )== [] = false
2944
+ [] == (_ : _ ) = false
2950
2945
[] == [] = true
2951
2946
2952
2947
instance Eq a => POrd_ [a ] where
@@ -3002,8 +2997,8 @@ instance Foldable [a] where
3002
2997
foldl1' = L. foldl1'
3003
2998
3004
2999
instance ValidLogic a => IxContainer [a ] where
3005
- lookup 0 (x: xs ) = Just x
3006
- lookup i (x : xs) = lookup (i- 1 ) xs
3000
+ lookup 0 (x: _ ) = Just x
3001
+ lookup i (_ : xs) = lookup (i- 1 ) xs
3007
3002
lookup _ [] = Nothing
3008
3003
3009
3004
imap f xs = map (uncurry f) $ P. zip [0 .. ] xs
@@ -3120,7 +3115,7 @@ type instance Elem (Labeled' x y) = Elem x
3120
3115
-----
3121
3116
3122
3117
instance Eq_ x => Eq_ (Labeled' x y ) where
3123
- (Labeled' x1 y1 ) == (Labeled' x2 y2 ) = x1== x2
3118
+ (Labeled' x1 _ ) == (Labeled' x2 _ ) = x1== x2
3124
3119
3125
3120
instance (ClassicalLogic x , Ord_ x ) => POrd_ (Labeled' x y ) where
3126
3121
inf (Labeled' x1 y1) (Labeled' x2 y2) = if x1 < x2
@@ -3142,8 +3137,8 @@ instance Semigroup x => Action (Labeled' x y) where
3142
3137
(Labeled' x y) .+ x' = Labeled' (x'+ x) y
3143
3138
3144
3139
instance Metric x => Metric (Labeled' x y ) where
3145
- distance (Labeled' x1 y1 ) (Labeled' x2 y2 ) = distance x1 x2
3146
- distanceUB (Labeled' x1 y1 ) (Labeled' x2 y2 ) = distanceUB x1 x2
3140
+ distance (Labeled' x1 _ ) (Labeled' x2 _ ) = distance x1 x2
3141
+ distanceUB (Labeled' x1 _ ) (Labeled' x2 _ ) = distanceUB x1 x2
3147
3142
3148
3143
instance Normed x => Normed (Labeled' x y ) where
3149
3144
size (Labeled' x _) = size x
0 commit comments