Commit 80c304b8 authored by Ryan Scott's avatar Ryan Scott
Browse files

Merge branch '2021-04-28' into 'master'

Migrate basement et. al to latest Hackage versions

See merge request ghc/head.hackage!155
parents 5d876673 d1d81d1e
......@@ -398,32 +398,6 @@ index f304a86..9a48c3c 100644
-- Int64 ----------------------------------------------------------------------
diff --git a/Basement/Block/Base.hs b/Basement/Block/Base.hs
index 2780529..77d1978 100644
--- a/Basement/Block/Base.hs
+++ b/Basement/Block/Base.hs
@@ -36,7 +36,7 @@ module Basement.Block.Base
, unsafeRecast
) where
-import GHC.Prim
+import GHC.Exts
import GHC.Types
import GHC.ST
import GHC.IO
diff --git a/Basement/BoxedArray.hs b/Basement/BoxedArray.hs
index e73a0c4..a4fa1c5 100644
--- a/Basement/BoxedArray.hs
+++ b/Basement/BoxedArray.hs
@@ -74,7 +74,7 @@ module Basement.BoxedArray
, builderBuild_
) where
-import GHC.Prim
+import GHC.Exts
import GHC.Types
import GHC.ST
import Data.Proxy
diff --git a/Basement/Cast.hs b/Basement/Cast.hs
index ecccba1..e8e9de2 100644
--- a/Basement/Cast.hs
......@@ -465,19 +439,6 @@ index ecccba1..e8e9de2 100644
instance Cast Word64 Int64 where
cast = word64ToInt64
instance Cast Word Int where
diff --git a/Basement/FinalPtr.hs b/Basement/FinalPtr.hs
index 1b3582c..ec77d94 100644
--- a/Basement/FinalPtr.hs
+++ b/Basement/FinalPtr.hs
@@ -25,7 +25,7 @@ module Basement.FinalPtr
) where
import GHC.Ptr
-import GHC.ForeignPtr
+import GHC.ForeignPtr (ForeignPtr, castForeignPtr, touchForeignPtr, unsafeForeignPtrToPtr)
import GHC.IO
import Basement.Monad
import Basement.Compat.Primitive
diff --git a/Basement/From.hs b/Basement/From.hs
index 4f51154..53c0653 100644
--- a/Basement/From.hs
......@@ -909,24 +870,11 @@ index aff92b1..ed99b1d 100644
integralDownsizeCheck = integralDownsizeBounded integralDownsize
instance IntegralDownsize Integer Int8 where
diff --git a/Basement/Monad.hs b/Basement/Monad.hs
index 6433f60..806819d 100644
--- a/Basement/Monad.hs
+++ b/Basement/Monad.hs
@@ -33,7 +33,7 @@ import GHC.ST
import GHC.STRef
import GHC.IORef
import GHC.IO
-import GHC.Prim
+import GHC.Exts
import Basement.Compat.Base (Exception, (.), ($), Applicative, Monad)
-- | Primitive monad that can handle mutation.
diff --git a/Basement/Numerical/Additive.hs b/Basement/Numerical/Additive.hs
index c21d77a..22af1e0 100644
index 7973887..1fd2091 100644
--- a/Basement/Numerical/Additive.hs
+++ b/Basement/Numerical/Additive.hs
@@ -19,6 +19,7 @@ import GHC.Prim
@@ -21,6 +21,7 @@ import GHC.Prim
import GHC.Int
import GHC.Word
import Basement.Bounded
......@@ -934,7 +882,7 @@ index c21d77a..22af1e0 100644
import Basement.Nat
import Basement.Types.Word128 (Word128)
import Basement.Types.Word256 (Word256)
@@ -63,15 +64,15 @@ instance Additive Int where
@@ -65,15 +66,15 @@ instance Additive Int where
scale = scaleNum
instance Additive Int8 where
azero = 0
......@@ -953,7 +901,7 @@ index c21d77a..22af1e0 100644
scale = scaleNum
instance Additive Int64 where
azero = 0
@@ -91,15 +92,15 @@ instance Additive Natural where
@@ -93,15 +94,15 @@ instance Additive Natural where
scale = scaleNum
instance Additive Word8 where
azero = 0
......@@ -994,7 +942,7 @@ index a86d195..9fc0005 100644
word64ToWord32s :: Word64 -> Word32x2
word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord# w64))
diff --git a/Basement/String.hs b/Basement/String.hs
index e097e7b..607806a 100644
index 980434f..4d2edce 100644
--- a/Basement/String.hs
+++ b/Basement/String.hs
@@ -129,6 +129,7 @@ import qualified Basement.Alg.UTF8 as UTF8
......@@ -1541,7 +1489,7 @@ index 6d59102..ffeef82 100644
data Table = Table { unTable :: !Addr# }
diff --git a/basement.cabal b/basement.cabal
index ad166c6..c09b557 100644
index 89b2794..05b8d9b 100644
--- a/basement.cabal
+++ b/basement.cabal
@@ -136,6 +136,8 @@ library
......
diff --git a/Foundation/Conduit/Internal.hs b/Foundation/Conduit/Internal.hs
index 9c22ee1..04a46e3 100644
--- a/Foundation/Conduit/Internal.hs
+++ b/Foundation/Conduit/Internal.hs
@@ -126,7 +126,7 @@ instance MonadThrow m => MonadThrow (Conduit i o m) where
instance MonadCatch m => MonadCatch (Conduit i o m) where
catch (Conduit c0) onExc = Conduit $ \rest -> let
go (PipeM m) =
- PipeM $ catch (liftM go m) (return . flip unConduit rest . onExc)
+ PipeM $ catch (liftM go m) (return . (\x -> unConduit x rest) . onExc)
go (Done r) = rest r
go (Await p c) = Await (go . p) (go . c)
go (Yield p m o) = Yield (go p) m o
diff --git a/Imports.hs b/Imports.hs
index 45bb5fb..f7d6c9e 100644
index 407a131..307d9a2 100644
--- a/Imports.hs
+++ b/Imports.hs
@@ -19,7 +19,7 @@ import Data.Bits hiding (Bits)
@@ -22,7 +22,7 @@ import Data.Bits hiding (Bits)
import Data.ByteString.Internal (ByteString(..))
import Data.Foldable
import Data.Int
......
diff --git a/src/Test/Inspection/Core.hs b/src/Test/Inspection/Core.hs
index 7816010..45ec4b6 100644
index e745975..244362d 100644
--- a/src/Test/Inspection/Core.hs
+++ b/src/Test/Inspection/Core.hs
@@ -44,6 +44,10 @@ import DataCon
......@@ -27,7 +27,30 @@ index 7816010..45ec4b6 100644
-- | Pretty-print a slice
pprSlice :: Slice -> SDoc
@@ -211,14 +220,22 @@ eqSlice it slice1 slice2
@@ -155,7 +164,9 @@ eqSlice it slice1 slice2
essentiallyVar (App e a) | it, isTyCoArg a = essentiallyVar e
essentiallyVar (Lam v e) | it, isTyCoVar v = essentiallyVar e
essentiallyVar (Cast e _) | it = essentiallyVar e
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+ essentiallyVar (Case s _ _ [Alt _ _ e]) | it, isUnsafeEqualityProof s = essentiallyVar e
+#elif MIN_VERSION_ghc(9,0,0)
essentiallyVar (Case s _ _ [(_, _, e)]) | it, isUnsafeEqualityProof s = essentiallyVar e
#endif
essentiallyVar (Var v) = Just v
@@ -171,7 +182,10 @@ eqSlice it slice1 slice2
go env (Cast e1 _) e2 | it = go env e1 e2
go env e1 (Cast e2 _) | it = go env e1 e2
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+ go env (Case s _ _ [Alt _ _ e1]) e2 | it, isUnsafeEqualityProof s = go env e1 e2
+ go env e1 (Case s _ _ [Alt _ _ e2]) | it, isUnsafeEqualityProof s = go env e1 e2
+#elif MIN_VERSION_ghc(9,0,0)
go env (Case s _ _ [(_, _, e1)]) e2 | it, isUnsafeEqualityProof s = go env e1 e2
go env e1 (Case s _ _ [(_, _, e2)]) | it, isUnsafeEqualityProof s = go env e1 e2
#endif
@@ -218,14 +232,22 @@ eqSlice it slice1 slice2
go _ _ _ = guard False
-----------
......@@ -52,7 +75,7 @@ index 7816010..45ec4b6 100644
-- | Returns @True@ if the given core expression mentions no type constructor
@@ -250,7 +267,12 @@ allTyCons ignore slice =
@@ -257,7 +279,12 @@ allTyCons ignore slice =
goB (b, e) = goV b ++ go e
......@@ -66,7 +89,7 @@ index 7816010..45ec4b6 100644
goT (TyVarTy _) = []
goT (AppTy t1 t2) = goT t1 ++ goT t2
@@ -296,7 +318,12 @@ freeOfTerm slice needles = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ]
@@ -303,7 +330,12 @@ freeOfTerm slice needles = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ]
goB (_, e) = go e
......@@ -80,7 +103,7 @@ index 7816010..45ec4b6 100644
goAltCon (DataAlt dc) | isNeedle (dataConName dc) = False
goAltCon _ = True
@@ -343,7 +370,12 @@ doesNotAllocate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go (idArity v
@@ -350,7 +382,12 @@ doesNotAllocate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go (idArity v
-- A let binding allocates if any variable is not a join point and not
-- unlifted
......@@ -95,10 +118,10 @@ index 7816010..45ec4b6 100644
doesNotContainTypeClasses :: Slice -> [Name] -> Maybe (Var, CoreExpr, [TyCon])
doesNotContainTypeClasses slice tcNs
diff --git a/src/Test/Inspection/Plugin.hs b/src/Test/Inspection/Plugin.hs
index e84a26c..bd953af 100644
index ee16f46..60e7158 100644
--- a/src/Test/Inspection/Plugin.hs
+++ b/src/Test/Inspection/Plugin.hs
@@ -12,7 +12,7 @@ import System.Exit
@@ -17,7 +17,7 @@ import System.Exit
import Data.Either
import Data.Maybe
import Data.Bifunctor
......@@ -107,7 +130,7 @@ index e84a26c..bd953af 100644
import qualified Data.Map.Strict as M
import qualified Language.Haskell.TH.Syntax as TH
@@ -24,6 +24,14 @@ import GhcPlugins hiding (SrcLoc)
@@ -29,6 +29,14 @@ import GhcPlugins hiding (SrcLoc)
import Outputable
#endif
......@@ -122,7 +145,7 @@ index e84a26c..bd953af 100644
import Test.Inspection (Obligation(..), Property(..), Result(..))
import Test.Inspection.Core
@@ -313,9 +321,13 @@ proofPass upon_failure report guts = do
@@ -319,9 +327,13 @@ proofPass upon_failure report guts = do
(True, SkipO0) -> pure guts
(_ , _ ) -> do
when noopt $ do
......
diff --git a/src/Proto3/Wire/Decode.hs b/src/Proto3/Wire/Decode.hs
index dd47743..2f7cbed 100644
--- a/src/Proto3/Wire/Decode.hs
+++ b/src/Proto3/Wire/Decode.hs
@@ -199,7 +199,7 @@ gwireType 2 = return LengthDelimited
gwireType wt = Left $ "wireType got unknown wire type: " ++ show wt
safeSplit :: Int -> B.ByteString -> Either String (B.ByteString, B.ByteString)
-safeSplit !i! b | B.length b < i = Left "failed to parse varint128: not enough bytes"
+safeSplit !i !b | B.length b < i = Left "failed to parse varint128: not enough bytes"
| otherwise = Right $ B.splitAt i b
takeWT :: WireType -> B.ByteString -> Either String (ParsedField, B.ByteString)
diff --git a/src/Proto3/Wire/Reverse/Prim.hs b/src/Proto3/Wire/Reverse/Prim.hs
index 3113baa..31deb68 100644
--- a/src/Proto3/Wire/Reverse/Prim.hs
......
......@@ -52,7 +52,7 @@ index 25cf498..2783c2e 100644
!(Table addr) = table
table :: Table
diff --git a/warp.cabal b/warp.cabal
index 43ab944..98cf4b9 100644
index d08caba..366c806 100644
--- a/warp.cabal
+++ b/warp.cabal
@@ -74,6 +74,7 @@ Library
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment