diff --git a/patches/futhark-0.22.3.patch b/patches/futhark-0.22.4.patch similarity index 98% rename from patches/futhark-0.22.3.patch rename to patches/futhark-0.22.4.patch index 94571dfce08597aa1411eca7fb8cadb586464d42..61549342451dd519978121147f11c7263d60ff84 100644 --- a/patches/futhark-0.22.3.patch +++ b/patches/futhark-0.22.4.patch @@ -12,10 +12,10 @@ index f0cf5bc..bcddcc6 100644 tell $ buildFGBody body pure body diff --git a/src/Futhark/IR/SOACS/Simplify.hs b/src/Futhark/IR/SOACS/Simplify.hs -index b497fb0..706aa5f 100644 +index adcd8d6..528a2b2 100644 --- a/src/Futhark/IR/SOACS/Simplify.hs +++ b/src/Futhark/IR/SOACS/Simplify.hs -@@ -757,7 +757,7 @@ arrayOps = mconcat . map onStm . stmsToList . bodyStms +@@ -759,7 +759,7 @@ arrayOps = mconcat . map onStm . stmsToList . bodyStms tell $ arrayOps $ lambdaBody lam pure lam walker = @@ -24,7 +24,7 @@ index b497fb0..706aa5f 100644 { walkOnBody = const $ modify . (<>) . arrayOps, walkOnOp = modify . (<>) . onOp } -@@ -780,7 +780,7 @@ replaceArrayOps substs (Body _ stms res) = +@@ -784,7 +784,7 @@ replaceArrayOps substs (Body _ stms res) = fromArrayOp op' onExp _ cs e = (cs, mapExp mapper e) mapper = @@ -53,7 +53,7 @@ index b1cab74..0960106 100644 instance Bitraversable TypeBase where bitraverse f g (Array t shape u) = Array t <$> f shape <*> g u diff --git a/src/Futhark/Optimise/CSE.hs b/src/Futhark/Optimise/CSE.hs -index 397728a..b4a00ad 100644 +index 65dc1fd..699971d 100644 --- a/src/Futhark/Optimise/CSE.hs +++ b/src/Futhark/Optimise/CSE.hs @@ -176,7 +176,7 @@ cseInLambda lam = do @@ -197,7 +197,7 @@ index 56534e5..771e2ee 100644 } diff --git a/src/Futhark/Optimise/Simplify/Rules.hs b/src/Futhark/Optimise/Simplify/Rules.hs -index 8b3964a..6369b74 100644 +index 0bed9c5..c3fba24 100644 --- a/src/Futhark/Optimise/Simplify/Rules.hs +++ b/src/Futhark/Optimise/Simplify/Rules.hs @@ -196,7 +196,7 @@ withAccTopDown vtable (Let pat aux (WithAcc inputs lam)) = Simplify . auxing aux diff --git a/patches/posix-api-0.3.5.0.patch b/patches/posix-api-0.3.5.0.patch deleted file mode 100644 index 6c31d6d1b73750044f6595d05298e62924b9281e..0000000000000000000000000000000000000000 --- a/patches/posix-api-0.3.5.0.patch +++ /dev/null @@ -1,96 +0,0 @@ -diff --git a/posix-api.cabal b/posix-api.cabal -index 2daa9d3..b48bfc8 100644 ---- a/posix-api.cabal -+++ b/posix-api.cabal -@@ -73,7 +73,7 @@ extra-source-files: - - flag assertions - manual: True -- description: Extra run-time invariant checking -+ description: Extra run-time invariant checking - default: False - - library -@@ -111,6 +111,7 @@ library - , primitive-offset >= 0.2 && <0.3 - , primitive-unlifted >= 0.1 && <0.2 - , run-st >= 0.1.1 && <0.2 -+ , ghc-prim - hs-source-dirs: src - if flag(assertions) - hs-source-dirs: src-assertions -diff --git a/src/Linux/Socket.hs b/src/Linux/Socket.hs -index 1784486..90b28d7 100644 ---- a/src/Linux/Socket.hs -+++ b/src/Linux/Socket.hs -@@ -5,6 +5,8 @@ - {-# language UnboxedTuples #-} - {-# language UnliftedFFITypes #-} - -+{-# options_ghc -Wno-dodgy-imports #-} -+ - module Linux.Socket - ( -- * Functions - uninterruptibleReceiveMultipleMessageA -@@ -55,7 +57,7 @@ import Data.Primitive.Unlifted.Array (MutableUnliftedArray(..),UnliftedArray) - import Data.Word (Word8) - import Foreign.C.Error (Errno,getErrno) - import Foreign.C.Types (CInt(..),CSize(..),CUInt(..)) --import GHC.Exts (Ptr(..),RealWorld,MutableByteArray#,Addr#,MutableArrayArray#,Int(I#)) -+import GHC.Exts (Ptr(..),RealWorld,MutableByteArray#,Addr#,MutableArrayArray#(..),Int(I#)) - import GHC.Exts (shrinkMutableByteArray#,touch#,nullAddr#) - import GHC.IO (IO(..)) - import Linux.Socket.Types (SocketFlags(..)) -diff --git a/src/Posix/Socket.hs b/src/Posix/Socket.hs -index 973f763..c77c1da 100644 ---- a/src/Posix/Socket.hs -+++ b/src/Posix/Socket.hs -@@ -1,4 +1,5 @@ - {-# language BangPatterns #-} -+{-# language CPP #-} - {-# language DataKinds #-} - {-# language DuplicateRecordFields #-} - {-# language GADTSyntax #-} -@@ -11,6 +12,8 @@ - {-# language UnboxedTuples #-} - {-# language UnliftedFFITypes #-} - -+{-# options_ghc -Wno-dodgy-imports #-} -+ - -- | Types and functions related to the POSIX sockets API. - -- Unusual characteristics: - -- -@@ -215,8 +218,13 @@ import Foreign.C.String (CString) - import Foreign.C.Types (CInt(..),CSize(..)) - import Foreign.Ptr (nullPtr) - import GHC.Exts (Ptr,RealWorld,ByteArray#,MutableByteArray#) --import GHC.Exts (Addr#,TYPE,RuntimeRep(UnliftedRep)) --import GHC.Exts (ArrayArray#,MutableArrayArray#,Int(I#)) -+import GHC.Exts (Addr#,TYPE) -+#if MIN_VERSION_ghc_prim(0,8,0) -+import GHC.Types (UnliftedRep) -+#else -+import GHC.Exts (RuntimeRep(UnliftedRep)) -+#endif -+import GHC.Exts (ArrayArray#(..),MutableArrayArray#(..),Int(I#)) - import GHC.Exts (shrinkMutableByteArray#,touch#) - import Posix.Socket.Types (Family(..),Protocol(..),Type(..),SocketAddress(..)) - import Posix.Socket.Types (SocketAddressInternet(..)) -@@ -770,7 +778,7 @@ writeVector fd buffers = do - touchLifted newBufs - pure r - --data UList (a :: TYPE 'UnliftedRep) where -+data UList (a :: TYPE UnliftedRep) where - UNil :: UList a - UCons :: a -> UList a -> UList a - -@@ -824,7 +832,7 @@ uninterruptibleSendMessageB :: - -> CSize -- ^ Length in bytes (payload A) - -> MessageFlags 'Send -- ^ Flags - -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer --uninterruptibleSendMessageB fd -+uninterruptibleSendMessageB fd - (MutableByteArrayOffset{array,offset}) lenB - (Addr addr) lenA flags = - c_unsafe_sendmsg_b fd (unMba array) offset lenB addr lenA flags diff --git a/patches/posix-api-0.4.0.0.patch b/patches/posix-api-0.4.0.0.patch new file mode 100644 index 0000000000000000000000000000000000000000..43486170d821280410ac9233cc9062c6ec631871 --- /dev/null +++ b/patches/posix-api-0.4.0.0.patch @@ -0,0 +1,31 @@ +diff --git a/src/Linux/Socket.hs b/src/Linux/Socket.hs +index 1784486..6b3011c 100644 +--- a/src/Linux/Socket.hs ++++ b/src/Linux/Socket.hs +@@ -55,7 +55,7 @@ import Data.Primitive.Unlifted.Array (MutableUnliftedArray(..),UnliftedArray) + import Data.Word (Word8) + import Foreign.C.Error (Errno,getErrno) + import Foreign.C.Types (CInt(..),CSize(..),CUInt(..)) +-import GHC.Exts (Ptr(..),RealWorld,MutableByteArray#,Addr#,MutableArrayArray#,Int(I#)) ++import GHC.Exts (Ptr(..),RealWorld,MutableByteArray#,Addr#,MutableArrayArray#(..),Int(I#)) + import GHC.Exts (shrinkMutableByteArray#,touch#,nullAddr#) + import GHC.IO (IO(..)) + import Linux.Socket.Types (SocketFlags(..)) +@@ -115,7 +115,7 @@ foreign import ccall unsafe "HaskellPosix.h recvmmsg_sockaddr_discard" + -- (e.g. with @SOCK_NONBLOCK@): + -- + -- > uninterruptibleSocket internet (applySocketFlags (closeOnExec <> nonblocking) stream) defaultProtocol +--- ++-- + applySocketFlags :: SocketFlags -> Type -> Type + applySocketFlags (SocketFlags s) (Type t) = Type (s .|. t) + +@@ -181,7 +181,7 @@ uninterruptibleReceiveMultipleMessageA !s !msgSize !msgCount !flags = do + -- * The message data of each message. + -- + -- The @sockaddr@s bytearray and the unlifted array of messages are +--- guaranteed to have the same number of elements. ++-- guaranteed to have the same number of elements. + uninterruptibleReceiveMultipleMessageB :: + Fd -- ^ Socket + -> CInt -- ^ Expected @sockaddr@ size