From 27618bf836c7b8367536b097cb240a7466fc1368 Mon Sep 17 00:00:00 2001 From: David Simmons-Duffin Date: Mon, 25 Mar 2024 15:01:42 -0700 Subject: [PATCH] Added default language; had to remove weird 'in do' style in a few places --- distributed-process.cabal | 88 ++++++++++--------- .../Process/Internal/Primitives.hs | 8 +- .../Distributed/Process/UnsafePrimitives.hs | 11 +-- stack-ghc-9.8.2.yaml | 6 +- 4 files changed, 58 insertions(+), 55 deletions(-) diff --git a/distributed-process.cabal b/distributed-process.cabal index 3f225ad4..0a449126 100644 --- a/distributed-process.cabal +++ b/distributed-process.cabal @@ -1,6 +1,6 @@ Name: distributed-process Version: 0.7.5 -Cabal-Version: >=1.8 +Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 License-File: LICENSE @@ -83,6 +83,7 @@ Library Control.Distributed.Process.Management.Internal.Trace.Remote, Control.Distributed.Process.Management.Internal.Trace.Types, Control.Distributed.Process.Management.Internal.Trace.Tracer + default-language: Haskell2010 ghc-options: -Wall HS-Source-Dirs: src other-extensions: BangPatterns @@ -118,51 +119,56 @@ Library -- Tests are in distributed-process-test package, for convenience. benchmark distributed-process-throughput - Type: exitcode-stdio-1.0 - Build-Depends: base >= 4.9 && < 5, - distributed-process, - network-transport-tcp >= 0.3 && <= 0.81, - bytestring >= 0.9 && < 0.13, - binary >= 0.6.3 && < 0.10 - Main-Is: benchmarks/Throughput.hs - ghc-options: -Wall + Type: exitcode-stdio-1.0 + Build-Depends: base >= 4.9 && < 5, + distributed-process, + network-transport-tcp >= 0.3 && <= 0.81, + bytestring >= 0.9 && < 0.13, + binary >= 0.6.3 && < 0.10 + Main-Is: benchmarks/Throughput.hs + default-language: Haskell2010 + ghc-options: -Wall benchmark distributed-process-latency - Type: exitcode-stdio-1.0 - Build-Depends: base >= 4.9 && < 5, - distributed-process, - network-transport-tcp >= 0.3 && <= 0.81, - bytestring >= 0.9 && < 0.13, - binary >= 0.6.3 && < 0.10 - Main-Is: benchmarks/Latency.hs - ghc-options: -Wall + Type: exitcode-stdio-1.0 + Build-Depends: base >= 4.9 && < 5, + distributed-process, + network-transport-tcp >= 0.3 && <= 0.81, + bytestring >= 0.9 && < 0.13, + binary >= 0.6.3 && < 0.10 + Main-Is: benchmarks/Latency.hs + default-language: Haskell2010 + ghc-options: -Wall benchmark distributed-process-channels - Type: exitcode-stdio-1.0 - Build-Depends: base >= 4.9 && < 5, - distributed-process, - network-transport-tcp >= 0.3 && <= 0.81, - bytestring >= 0.9 && < 0.13, - binary >= 0.6.3 && < 0.10 - Main-Is: benchmarks/Channels.hs - ghc-options: -Wall + Type: exitcode-stdio-1.0 + Build-Depends: base >= 4.9 && < 5, + distributed-process, + network-transport-tcp >= 0.3 && <= 0.81, + bytestring >= 0.9 && < 0.13, + binary >= 0.6.3 && < 0.10 + Main-Is: benchmarks/Channels.hs + default-language: Haskell2010 + ghc-options: -Wall benchmark distributed-process-spawns - Type: exitcode-stdio-1.0 - Build-Depends: base >= 4.9 && < 5, - distributed-process, - network-transport-tcp >= 0.3 && <= 0.81, - bytestring >= 0.9 && < 0.13, - binary >= 0.6.3 && < 0.10 - Main-Is: benchmarks/Spawns.hs - ghc-options: -Wall + Type: exitcode-stdio-1.0 + Build-Depends: base >= 4.9 && < 5, + distributed-process, + network-transport-tcp >= 0.3 && <= 0.81, + bytestring >= 0.9 && < 0.13, + binary >= 0.6.3 && < 0.10 + Main-Is: benchmarks/Spawns.hs + default-language: Haskell2010 + ghc-options: -Wall benchmark distributed-process-ring - Type: exitcode-stdio-1.0 - Build-Depends: base >= 4.9 && < 5, - distributed-process, - network-transport-tcp >= 0.3 && <= 0.81, - bytestring >= 0.9 && < 0.13, - binary >= 0.6.3 && < 0.10 - Main-Is: benchmarks/ProcessRing.hs - ghc-options: -Wall -threaded -O2 -rtsopts + Type: exitcode-stdio-1.0 + Build-Depends: base >= 4.9 && < 5, + distributed-process, + network-transport-tcp >= 0.3 && <= 0.81, + bytestring >= 0.9 && < 0.13, + binary >= 0.6.3 && < 0.10 + Main-Is: benchmarks/ProcessRing.hs + default-language: Haskell2010 + ghc-options: -Wall -threaded -O2 -rtsopts diff --git a/src/Control/Distributed/Process/Internal/Primitives.hs b/src/Control/Distributed/Process/Internal/Primitives.hs index 84b0f237..40423c9a 100644 --- a/src/Control/Distributed/Process/Internal/Primitives.hs +++ b/src/Control/Distributed/Process/Internal/Primitives.hs @@ -253,7 +253,7 @@ send them msg = do let us = processId proc node = processNode proc nodeId = localNodeId node - destNode = (processNodeId them) in do + destNode = (processNodeId them) liftIO $ traceEvent (localEventBus node) (MxSent them us (createUnencodedMessage msg)) if destNode == nodeId @@ -344,7 +344,7 @@ sendChan (SendPort cid) msg = do let node = processNode proc pid = processId proc us = localNodeId node - them = processNodeId (sendPortProcessId cid) in do + them = processNodeId (sendPortProcessId cid) liftIO $ traceEvent (localEventBus node) (MxSentToPort pid cid $ wrapMessage msg) case them == us of True -> sendChanLocal cid msg @@ -493,7 +493,7 @@ forward msg them = do let node = processNode proc us = processId proc nid = localNodeId node - destNode = (processNodeId them) in do + destNode = (processNodeId them) liftIO $ traceEvent (localEventBus node) (MxSent them us msg) if destNode == nid then sendCtrlMsg Nothing (LocalSend them msg) @@ -514,7 +514,7 @@ uforward msg them = do let node = processNode proc us = processId proc nid = localNodeId node - destNode = (processNodeId them) in do + destNode = (processNodeId them) liftIO $ traceEvent (localEventBus node) (MxSent them us msg) if destNode == nid then sendCtrlMsg Nothing (LocalSend them msg) diff --git a/src/Control/Distributed/Process/UnsafePrimitives.hs b/src/Control/Distributed/Process/UnsafePrimitives.hs index 22d8ead0..e4590e98 100644 --- a/src/Control/Distributed/Process/UnsafePrimitives.hs +++ b/src/Control/Distributed/Process/UnsafePrimitives.hs @@ -178,11 +178,12 @@ usend them msg = do sendChan :: Serializable a => SendPort a -> a -> Process () sendChan (SendPort cid) msg = do proc <- ask - let node = processNode proc - pid = processId proc - us = localNodeId node - them = processNodeId (sendPortProcessId cid) - msg' = wrapMessage msg in do + let + node = processNode proc + pid = processId proc + us = localNodeId node + them = processNodeId (sendPortProcessId cid) + msg' = wrapMessage msg liftIO $ traceEvent (localEventBus node) (MxSentToPort pid cid msg') if them == us then unsafeSendChanLocal cid msg' -- NB: we wrap to P.Message !!! diff --git a/stack-ghc-9.8.2.yaml b/stack-ghc-9.8.2.yaml index 0b9cb107..4fde3770 100644 --- a/stack-ghc-9.8.2.yaml +++ b/stack-ghc-9.8.2.yaml @@ -5,15 +5,11 @@ packages: - distributed-process-tests/ extra-deps: -# network-transport-inmemory has revisions on hackage that bump -# dependencies like containers and bytestring. Explicit sha256 hashes -# seem to be needed to get the right revisions (4/30/23). - distributed-static-0.3.10 - rematch-0.2.0.0 - network-transport-0.5.7 - network-transport-tcp-0.8.2 -- git: https://github.com/haskell-distributed/network-transport-inmemory.git - commit: 7a98331e092eff11f2c19daad2e364f794d90b91 +- network-transport-inmemory-0.5.3 flags: distributed-process-tests: