Skip to content
Snippets Groups Projects
Commit 54b647a1 authored by Ryan Scott's avatar Ryan Scott
Browse files

Migrate futhark, posix-api patches to latest Hackage versions

parent 5f8d2a6a
No related branches found
No related tags found
1 merge request!254Adapt to Bifunctor gaining a quantified superclass in more libraries
......@@ -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/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/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
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment