Permalink
Browse files

First steps towards extracting static

This makes 'static' a separate module. Lots of cleaning up still to do, but
first I'd like to try and remove the unsafe stuff from Dynamic and properly
support polymorphic types.
  • Loading branch information...
1 parent ae6097e commit 7b5c530d29ebb532c4a093074f359fb50f9cbfb8 @edsko edsko committed Aug 9, 2012
Showing with 727 additions and 870 deletions.
  1. +7 −8 distributed-process/distributed-process.cabal
  2. +37 −18 distributed-process/src/Control/Distributed/Process.hs
  3. +78 −28 distributed-process/src/Control/Distributed/Process/Closure.hs
  4. +0 −330 distributed-process/src/Control/Distributed/Process/Internal/Closure/CP.hs
  5. +6 −1 distributed-process/src/Control/Distributed/Process/Internal/Closure/MkClosure.hs
  6. +0 −34 distributed-process/src/Control/Distributed/Process/Internal/Closure/Resolution.hs
  7. +0 −190 distributed-process/src/Control/Distributed/Process/Internal/Closure/Static.hs
  8. +22 −20 distributed-process/src/Control/Distributed/Process/Internal/Closure/TH.hs
  9. +0 −112 distributed-process/src/Control/Distributed/Process/Internal/Dynamic.hs
  10. +9 −4 distributed-process/src/Control/Distributed/Process/Internal/Primitives.hs
  11. +6 −107 distributed-process/src/Control/Distributed/Process/Internal/Types.hs
  12. +15 −11 distributed-process/src/Control/Distributed/Process/Node.hs
  13. +6 −0 distributed-process/src/Control/Distributed/Process/Serializable.hs
  14. +6 −6 distributed-process/tests/TestClosure.hs
  15. +30 −0 distributed-static/LICENSE
  16. +2 −0 distributed-static/Setup.hs
  17. +29 −0 distributed-static/distributed-static.cabal
  18. +352 −0 distributed-static/src/Control/Distributed/Static.hs
  19. +121 −0 distributed-static/src/Control/Distributed/Static/Internal/Dynamic.hs
  20. +1 −1 ...trol/Distributed/Process → distributed-static/src/Control/Distributed/Static}/Internal/TypeRep.hs
@@ -43,21 +43,18 @@ Library
time >= 1.2 && < 1.5,
template-haskell >= 2.6 && < 2.8,
random >= 1.0 && < 1.1,
- ghc-prim >= 0.2 && < 0.3
+ ghc-prim >= 0.2 && < 0.3,
+ distributed-static >= 0.1 && < 0.2
Exposed-modules: Control.Distributed.Process,
Control.Distributed.Process.Serializable,
Control.Distributed.Process.Closure,
Control.Distributed.Process.Node,
Control.Distributed.Process.Internal.Primitives,
Control.Distributed.Process.Internal.CQueue,
- Control.Distributed.Process.Internal.Dynamic,
- Control.Distributed.Process.Internal.TypeRep,
Control.Distributed.Process.Internal.Types,
- Control.Distributed.Process.Internal.Closure.Static,
Control.Distributed.Process.Internal.Closure.MkClosure,
- Control.Distributed.Process.Internal.Closure.CP,
Control.Distributed.Process.Internal.Closure.TH,
- Control.Distributed.Process.Internal.Closure.Resolution,
+ Control.Distributed.Process.Internal.Closure.BuiltIn,
Control.Distributed.Process.Internal.Node
Extensions: RankNTypes,
ScopedTypeVariables,
@@ -90,7 +87,8 @@ Test-Suite TestCH
template-haskell >= 2.6 && < 2.8,
random >= 1.0 && < 1.1,
ghc-prim >= 0.2 && < 0.3,
- ansi-terminal >= 0.5 && < 0.6
+ ansi-terminal >= 0.5 && < 0.6,
+ distributed-static >= 0.1 && < 0.2
Extensions: RankNTypes,
ScopedTypeVariables,
FlexibleInstances,
@@ -122,7 +120,8 @@ Test-Suite TestClosure
template-haskell >= 2.6 && < 2.8,
random >= 1.0 && < 1.1,
ghc-prim >= 0.2 && < 0.3,
- ansi-terminal >= 0.5 && < 0.6
+ ansi-terminal >= 0.5 && < 0.6,
+ distributed-static >= 0.1 && < 0.2
Other-modules: TestAuxiliary
Extensions: RankNTypes,
ScopedTypeVariables,
@@ -100,7 +100,6 @@ module Control.Distributed.Process
, spawnChannelLocal
) where
-
#if ! MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#endif
@@ -109,13 +108,15 @@ import Data.Typeable (Typeable)
import Control.Monad.IO.Class (liftIO)
import Control.Applicative ((<$>))
import Control.Monad.Reader (ask)
+import Control.Distributed.Static
+ ( Closure(..)
+ , Static
+ , RemoteTable
+ )
import Control.Distributed.Process.Internal.Types
- ( RemoteTable
- , NodeId(..)
+ ( NodeId(..)
, ProcessId(..)
, Process(..)
- , Closure(..)
- , Static
, MonitorRef(..)
, ProcessMonitorNotification(..)
, NodeMonitorNotification(..)
@@ -126,17 +127,32 @@ import Control.Distributed.Process.Internal.Types
, DiedReason(..)
, SpawnRef(..)
, DidSpawn(..)
- , Closure(..)
, SendPort(..)
, ReceivePort(..)
- , SerializableDict(..)
, SendPortId(..)
, WhereIsReply(..)
, LocalProcess(processNode)
)
+import Control.Distributed.Process.Serializable (SerializableDict)
+import Control.Distributed.Process.Internal.Closure.BuiltIn
+ ( sdictUnit
+ , sdictSendPort
+ , idCP
+ , seqCP
+ , bindCP
+ , splitCP
+ , cpLink
+ , cpUnlink
+ , cpExpect
+ , cpSend
+ , cpNewChan
+ )
+import Control.Distributed.Static (closureCompose, sndStatic, staticClosure)
+
+{-
import Control.Distributed.Process.Internal.Closure.CP
- ( cpSeq
- , cpBind
+ (
+ , bindCP
, cpSend
, cpExpect
, cpLink
@@ -145,10 +161,13 @@ import Control.Distributed.Process.Internal.Closure.CP
, cpCancelL
, cpSplit
)
+-}
+{-
import Control.Distributed.Process.Internal.Closure.Static
( sdictUnit
, sdictSendPort
)
+-}
import Control.Distributed.Process.Internal.Primitives
( -- Basic messaging
send
@@ -289,9 +308,9 @@ spawn nid proc = do
-- that was already set up
mRef <- monitorNode nid
sRef <- spawnAsync nid $ cpLink us
- `cpSeq` cpExpect sdictUnit
- `cpSeq` cpUnlink us
- `cpSeq` proc
+ `seqCP` cpExpect sdictUnit
+ `seqCP` cpUnlink us
+ `seqCP` proc
mPid <- receiveWait
[ matchIf (\(DidSpawn ref _) -> ref == sRef)
(\(DidSpawn _ pid) -> return $ Just pid)
@@ -333,7 +352,7 @@ spawnMonitor nid proc = do
call :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (Process a) -> Process a
call dict nid proc = do
us <- getSelfPid
- (_, mRef) <- spawnMonitor nid (proc `cpBind` cpSend dict us)
+ (_, mRef) <- spawnMonitor nid (proc `bindCP` cpSend dict us)
-- We are guaranteed to receive the reply before the monitor notification
-- (if a reply is sent at all)
-- NOTE: This might not be true if we switch to unreliable delivery.
@@ -353,7 +372,7 @@ spawnSupervised :: NodeId
-> Process (ProcessId, MonitorRef)
spawnSupervised nid proc = do
us <- getSelfPid
- them <- spawn nid (cpLink us `cpSeq` proc)
+ them <- spawn nid (cpLink us `seqCP` proc)
ref <- monitor them
return (them, ref)
@@ -370,10 +389,10 @@ spawnChannel dict nid proc = do
where
go :: ProcessId -> Closure (Process ())
go pid = cpNewChan dict
- `cpBind`
- (cpSend (sdictSendPort dict) pid `cpSplit` proc)
- `cpBind`
- cpCancelL
+ `bindCP`
+ (cpSend (sdictSendPort dict) pid `splitCP` proc)
+ `bindCP`
+ (idCP `closureCompose` staticClosure sndStatic)
--------------------------------------------------------------------------------
-- Local versions of spawn --
@@ -228,60 +228,105 @@ module Control.Distributed.Process.Closure
-- * Primitive operations on static values
, staticApply
, staticDuplicate
- -- * Static functionals
- , staticConst
- , staticFlip
- , staticFst
- , staticSnd
+ -- * Static values
+ , idStatic
+ , composeStatic
+ , constStatic
+ , flipStatic
+ , fstStatic
+ , sndStatic
+ , firstStatic
+ , secondStatic
+ , splitStatic
+ , unitStatic
+ -- * Combinators on static values
, staticCompose
- , staticFirst
- , staticSecond
- , staticSplit
- -- * Static constants
- , staticUnit
- -- * Creating closures
- , staticDecode
- , staticClosure
- , toClosure
-- * Serialization dictionaries (and their static versions)
, SerializableDict(..)
, sdictUnit
, sdictProcessId
, sdictSendPort
+ -- * Creating closures
+ , staticDecode
+ , staticClosure
+-- , toClosure
-- * Definition of CP and the generalized arrow combinators
, CP
- , cpIntro
- , cpElim
- , cpId
- , cpComp
- , cpFirst
- , cpSecond
- , cpSplit
- , cpCancelL
- , cpCancelR
+ , idCP
+ , splitCP
-- * Closure versions of CH primitives
, cpLink
, cpUnlink
, cpSend
, cpExpect
, cpNewChan
-- * @Closure (Process a)@ as a not-quite-monad
- , cpReturn
- , cpBind
- , cpSeq
+ , returnCP
+ , bindCP
+ , seqCP
) where
+import Control.Distributed.Process.Serializable (SerializableDict(..))
+
+import Control.Distributed.Static
+ ( -- Introducing static values
+ staticApply
+ , staticDuplicate
+ -- Static values
+ , idStatic
+ , composeStatic
+ , constStatic
+ , flipStatic
+ , fstStatic
+ , sndStatic
+ , firstStatic
+ , secondStatic
+ , splitStatic
+ , unitStatic
+ -- Combinators on static values
+ , staticCompose
+ , staticClosure
+ , closureSplit
+ )
+
+
+{-
import Control.Distributed.Process.Internal.Types
- ( SerializableDict(..)
- , staticApply
+ ( staticApply
, staticDuplicate
)
+-}
+
import Control.Distributed.Process.Internal.Closure.TH
( remotable
, mkStatic
, functionSDict
, functionTDict
)
+import Control.Distributed.Process.Internal.Closure.BuiltIn
+ ( -- Remote table
+ remoteTable
+ -- Static dictionaries and associated operations
+ , staticDecode
+ , sdictUnit
+ , sdictProcessId
+ , sdictSendPort
+ -- The CP type and associated combinators
+ , CP
+ , splitCP
+ , idCP
+ , returnCP
+ , seqCP
+ , bindCP
+ -- CP versions of Cloud Haskell primitives
+ , cpLink
+ , cpUnlink
+ , cpSend
+ , cpExpect
+ , cpNewChan
+ )
+
+{-
import Control.Distributed.Process.Internal.Closure.Static
( -- Static functionals
staticConst
@@ -303,7 +348,11 @@ import Control.Distributed.Process.Internal.Closure.Static
, sdictProcessId
, sdictSendPort
)
+-}
+
import Control.Distributed.Process.Internal.Closure.MkClosure (mkClosure)
+
+{-
import Control.Distributed.Process.Internal.Closure.CP
( -- Definition of CP and the generalized arrow combinators
CP
@@ -327,3 +376,4 @@ import Control.Distributed.Process.Internal.Closure.CP
, cpBind
, cpSeq
)
+-}
Oops, something went wrong.

0 comments on commit 7b5c530

Please sign in to comment.