mirror of
https://github.com/Lysxia/generic-random.git
synced 2024-10-26 09:41:05 +03:00
Update for GHC 8
This commit is contained in:
parent
f080d7047e
commit
6bbaf6ba8f
@ -18,6 +18,10 @@ matrix:
|
||||
compiler: ": #GHC 7.10.3"
|
||||
addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3,libgsl0-dev,liblapack-dev,libatlas-base-dev], sources: [hvr-ghc]}}
|
||||
|
||||
- env: CABALVER=1.24 GHCVER=8.0.1
|
||||
compiler: ": #GHC 8.0.1"
|
||||
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1,libgsl0-dev,liblapack-dev,libatlas-base-dev], sources: [hvr-ghc]}}
|
||||
|
||||
before_install:
|
||||
- unset CC
|
||||
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
|
||||
|
@ -12,7 +12,7 @@ import Test.QuickCheck
|
||||
newtype F = F (Bool -> Bool)
|
||||
|
||||
instance Data F where
|
||||
gunfold = undefined
|
||||
gunfold _ _ = undefined
|
||||
toConstr = undefined
|
||||
dataTypeOf = undefined
|
||||
|
||||
|
@ -18,7 +18,6 @@ import Data.Monoid
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.Vector.Storable as S
|
||||
import GHC.Generics ( Generic )
|
||||
import GHC.Stack ( CallStack, showCallStack )
|
||||
import Numeric.AD
|
||||
import Data.Random.Generics.Internal.Types
|
||||
import Data.Random.Generics.Internal.Solver
|
||||
@ -363,6 +362,7 @@ makeOracle dd0 t size' =
|
||||
-- Equations defining C_i(x) for all types with indices i
|
||||
phis :: Num a => V.Vector (a -> V.Vector a -> a)
|
||||
phis = V.fromList [ phi dd c (types #! c) | c <- listCs dd ]
|
||||
eval' :: Double -> Maybe (S.Vector Double)
|
||||
eval' x = fixedPoint defSolveArgs phi' (S.replicate m 0)
|
||||
where
|
||||
phi' :: (Mode a, Scalar a ~ Double) => V.Vector a -> V.Vector a
|
||||
@ -510,11 +510,9 @@ frequencyWith randomR as = randomR total >>= select as
|
||||
select _ _ = (snd . head) as
|
||||
-- That should not happen in theory, but floating point might be funny.
|
||||
|
||||
(#!) :: (?loc :: CallStack, Eq k, Hashable k)
|
||||
(#!) :: (Eq k, Hashable k)
|
||||
=> HashMap k v -> k -> v
|
||||
h #! k = HashMap.lookupDefault (e ?loc) k h
|
||||
where
|
||||
e loc = error ("HashMap.(!): key not found\n" ++ showCallStack loc)
|
||||
(#!) = (HashMap.!)
|
||||
|
||||
-- | @partitions k n@: lists of non-negative integers of length @n@ with sum
|
||||
-- less than or equal to @k@.
|
||||
|
@ -7,7 +7,6 @@ import Control.Monad.Trans
|
||||
import Data.Coerce
|
||||
import Data.Data
|
||||
import Data.Function
|
||||
import GHC.Stack ( CallStack, showCallStack )
|
||||
import Test.QuickCheck
|
||||
|
||||
data SomeData m where
|
||||
@ -46,36 +45,35 @@ coerceAliases = coerce
|
||||
|
||||
-- | > composeCast f g = f . g
|
||||
composeCastM :: forall a b c d m
|
||||
. (?loc :: CallStack, Typeable b, Typeable c)
|
||||
. (Typeable b, Typeable c)
|
||||
=> (m c -> d) -> (a -> m b) -> (a -> d)
|
||||
composeCastM f g | Just Refl <- eqT :: Maybe (b :~: c) = f . g
|
||||
composeCastM _ _ = castError ([] :: [b]) ([] :: [c])
|
||||
|
||||
castM :: forall a b m
|
||||
. (?loc :: CallStack, Typeable a, Typeable b)
|
||||
. (Typeable a, Typeable b)
|
||||
=> m a -> m b
|
||||
castM a | Just Refl <- eqT :: Maybe (a :~: b) = a
|
||||
castM a = let x = castError a x in x
|
||||
|
||||
unSomeData :: (?loc :: CallStack, Typeable a) => SomeData m -> m a
|
||||
unSomeData :: Typeable a => SomeData m -> m a
|
||||
unSomeData (SomeData a) = castM a
|
||||
|
||||
applyCast :: (Typeable a, Data b) => (m a -> m b) -> SomeData m -> SomeData m
|
||||
applyCast f = SomeData . f . unSomeData
|
||||
|
||||
castError :: (?loc :: CallStack, Typeable a, Typeable b)
|
||||
castError :: (Typeable a, Typeable b)
|
||||
=> proxy a -> proxy' b -> c
|
||||
castError a b = error $ unlines
|
||||
[ "Error trying to cast"
|
||||
, " " ++ show (typeRep a)
|
||||
, "to"
|
||||
, " " ++ show (typeRep b)
|
||||
, showCallStack ?loc
|
||||
]
|
||||
|
||||
withProxy :: (?loc :: CallStack) => (a -> b) -> proxy a -> b
|
||||
withProxy :: (a -> b) -> proxy a -> b
|
||||
withProxy f _ =
|
||||
f (error $ "This should not be evaluated\n" ++ showCallStack ?loc)
|
||||
f (error "This should not be evaluated\n")
|
||||
|
||||
reproxy :: proxy a -> Proxy a
|
||||
reproxy _ = Proxy
|
||||
|
Loading…
Reference in New Issue
Block a user