@@ -663,67 +663,70 @@ instance ToChildStart (Closure (Process ())) where
663663instance ToChildStart (Closure (SupervisorPid -> Process (ProcessId , Message ))) where
664664 toChildStart = return . CreateHandle
665665
666+
667+ -- StarterProcess variants of ChildStart
668+
669+ expectTriple :: Process (ProcessId , ChildKey , SendPort ProcessId )
670+ expectTriple = expect
671+
666672instance ToChildStart (Process () ) where
667673 toChildStart proc = do
668- starterPid <- spawnLocal $ do
669- -- note [linking]: the first time we see the supervisor's pid,
670- -- we must link to it, but only once, otherwise we simply waste
671- -- time and resources creating duplicate links
672- (supervisor, _, sendPidPort) <- expectTriple
673- link supervisor
674- spawnIt proc supervisor sendPidPort
675- tcsProcLoop proc
676- return (StarterProcess starterPid)
677-
678- tcsProcLoop :: Process () -> Process ()
679- tcsProcLoop p = forever' $ do
680- (supervisor, _, sendPidPort) <- expectTriple
681- spawnIt p supervisor sendPidPort
682-
683- spawnIt :: Process ()
684- -> ProcessId
685- -> SendPort ProcessId
686- -> Process ()
687- spawnIt proc' supervisor sendPidPort = do
688- supervisedPid <- spawnLocal $ do
689- link supervisor
690- self <- getSelfPid
691- (proc' `catches` [ Handler $ filterInitFailures supervisor self
692- , Handler $ logFailure supervisor self ])
693- `catchesExit` [( \ _ m -> handleMessageIf m (== ExitShutdown )
694- (\ _ -> return () ))]
695- sendChan sendPidPort supervisedPid
674+ starterPid <- spawnLocal $ do
675+ -- note [linking]: the first time we see the supervisor's pid,
676+ -- we must link to it, but only once, otherwise we simply waste
677+ -- time and resources creating duplicate links
678+ (supervisor, _, sendPidPort) <- expectTriple
679+ link supervisor
680+ spawnIt proc supervisor sendPidPort
681+ tcsProcLoop proc
682+ return (StarterProcess starterPid)
683+ where
684+ tcsProcLoop :: Process () -> Process ()
685+ tcsProcLoop p = forever' $ do
686+ (supervisor, _, sendPidPort) <- expectTriple
687+ spawnIt p supervisor sendPidPort
688+
689+ spawnIt :: Process ()
690+ -> ProcessId
691+ -> SendPort ProcessId
692+ -> Process ()
693+ spawnIt proc' supervisor sendPidPort = do
694+ supervisedPid <- spawnLocal $ do
695+ link supervisor
696+ self <- getSelfPid
697+ (proc' `catches` [ Handler $ filterInitFailures supervisor self
698+ , Handler $ logFailure supervisor self ])
699+ `catchesExit` [\ _ m -> handleMessageIf m (== ExitShutdown )
700+ (\ _ -> return () )]
701+ sendChan sendPidPort supervisedPid
696702
697703instance (Resolvable a ) => ToChildStart (SupervisorPid -> Process a ) where
698704 toChildStart proc = do
699- starterPid <- spawnLocal $ do
700- -- see note [linking] in the previous instance (above)
701- (supervisor, _, sendPidPort) <- expectTriple
702- link supervisor
703- injectIt proc supervisor sendPidPort >> injectorLoop proc
704- return $ StarterProcess starterPid
705-
706- injectorLoop :: Resolvable a
707- => (SupervisorPid -> Process a )
708- -> Process ()
709- injectorLoop p = forever' $ do
710- (supervisor, _, sendPidPort) <- expectTriple
711- injectIt p supervisor sendPidPort
712-
713- injectIt :: Resolvable a
714- => (SupervisorPid -> Process a )
715- -> ProcessId
716- -> SendPort ProcessId
717- -> Process ()
718- injectIt proc' supervisor sendPidPort = do
719- addr <- proc' supervisor
720- mPid <- resolve addr
721- case mPid of
722- Nothing -> die " UnresolvableAddress"
723- Just p -> sendChan sendPidPort p
724-
725- expectTriple :: Process (ProcessId , ChildKey , SendPort ProcessId )
726- expectTriple = expect
705+ starterPid <- spawnLocal $ do
706+ -- see note [linking] in the previous instance (above)
707+ (supervisor, _, sendPidPort) <- expectTriple
708+ link supervisor
709+ injectIt proc supervisor sendPidPort >> injectorLoop proc
710+ return $ StarterProcess starterPid
711+ where
712+ injectorLoop :: Resolvable a
713+ => (SupervisorPid -> Process a )
714+ -> Process ()
715+ injectorLoop p = forever' $ do
716+ (supervisor, _, sendPidPort) <- expectTriple
717+ injectIt p supervisor sendPidPort
718+
719+ injectIt :: Resolvable a
720+ => (SupervisorPid -> Process a )
721+ -> ProcessId
722+ -> SendPort ProcessId
723+ -> Process ()
724+ injectIt proc' supervisor sendPidPort = do
725+ addr <- proc' supervisor
726+ mPid <- resolve addr
727+ case mPid of
728+ Nothing -> die " UnresolvableAddress"
729+ Just p -> sendChan sendPidPort p
727730
728731-- internal APIs
729732
0 commit comments