Sync.hs

{-# LANGUAGE TypeFamilies #-}

{-|
The synchronization-schedule vocabulary.

The per-pass 'PassSync' handed to a 'Fragr.Execute.QueueBackend', its
'Wait' / 'SyncEvent' / 'Transfer' pieces, and the whole 'Compiled' result
stored on the graph.
-}
module Fragr.Sync
  ( PassSync (..)
  , Wait (..)
  , SyncEvent (..)
  , Transfer (..)
  , transferId
  , Compiled (..)
  ) where

import Data.IntMap.Strict (IntMap)
import Data.Text (Text)
import Data.Word (Word64)
import Type.Reflection

import Fragr.Resource (Access, Resource (..))
import Fragr.Types (EventId, Handle, QueueId, handleId)

{- |
The synchronization schedule computed for one surviving pass. It is a
purely descriptive object: the library hands it to a 'Fragr.Execute.QueueBackend', which
maps it onto real primitives (timeline semaphores, events, queue-family
ownership transfers). See "Fragr" for the module-level notes on how it is
derived.
-}
data PassSync = PassSync
  { passId :: Int
  , name :: Text
  , queue :: QueueId
  -- ^ the queue this pass is submitted to
  , waits :: [Wait]
  {- ^ for each foreign queue this pass depends on — producers of its reads,
  readers of versions it renames, the sibling pass acquiring ownership for
  its family — the timeline value to wait for before this pass may run
  (deduplicated by per-queue watermark)
  -}
  , signal :: Word64
  -- ^ the value this pass signals on its own queue's timeline once done
  , waitEvents :: [SyncEvent]
  -- ^ split-barrier events this pass waits on before running
  , signalEvents :: [SyncEvent]
  -- ^ split-barrier events this pass signals after running
  , acquires :: [Transfer]
  -- ^ resources whose ownership this pass acquires from another queue
  , releases :: [Transfer]
  -- ^ outputs consumed on another queue, handed off to it
  }
  deriving stock (Eq, Show)

{- |
One cross-queue timeline wait, with the accesses it protects: the waiting
pass's own reads behind each data edge from that queue, and its renaming
writes behind each anti-edge. A backend derives its wait scope (e.g. a
Vulkan @waitDstStageMask@) from the covered flags. An access declared
without flags covers 'Nothing' and carries no scope information: the
backend over-synchronizes (full scope) for it — here and in every other
@covers@ / @flags@ of the schedule.
-}
data Wait = Wait
  { queue :: QueueId
  , value :: Word64
  , covers :: [Access]
  }
  deriving stock (Eq, Show)

{- |
One split-barrier event endpoint, with the accesses it orders on its own
pass: the producing accesses on a 'signalEvents' entry (source scope), the
consuming accesses on a 'waitEvents' entry (destination scope).
-}
data SyncEvent = SyncEvent
  { event :: EventId
  , covers :: [Access]
  }
  deriving stock (Eq, Ord, Show)

{- |
One cross-queue ownership transfer. @peer@ is the other side — the
destination queue on a 'releases' entry, the source queue on an 'acquires'
entry. @flags@ are the /consuming/ access's, so both sides know the target
state to transition into; a handle consumed under several distinct flags
appears once per flags value, so a backend emitting one release / acquire
barrier per resource merges those entries itself.
-}
data Transfer = forall r. (Resource r) => Transfer
  { handle :: Handle r
  , peer :: QueueId
  , flags :: Maybe (Flags r)
  }

-- | The node id behind the transfer's handle, to key per-resource state by.
transferId :: Transfer -> Int
transferId Transfer{handle} = handleId handle

instance Eq Transfer where
  a == b = compare a b == EQ

-- Node id first, like 'Access': equal ids imply one resource type.
instance Ord Transfer where
  compare (Transfer (h1 :: Handle r1) p1 f1) (Transfer (h2 :: Handle r2) p2 f2) =
    compare (handleId h1) (handleId h2) <> compare p1 p2 <> case eqTypeRep (typeRep @r1) (typeRep @r2) of
      Just HRefl -> compare f1 f2
      Nothing -> compare (SomeTypeRep (typeRep @r1)) (SomeTypeRep (typeRep @r2))

instance Show Transfer where
  showsPrec d (Transfer h p f) =
    showParen (d > 10) $
      showString "Transfer {handle = "
        . shows h
        . showString ", peer = "
        . shows p
        . showString ", flags = "
        . shows f
        . showString "}"

data Compiled = Compiled
  { passRefs :: IntMap Int
  -- ^ pass id -> number of its writes still referenced
  , nodeRefs :: IntMap Int
  -- ^ node id -> number of surviving declared readers
  , passSync :: IntMap PassSync
  -- ^ pass id -> its sync schedule (only for passes that execute)
  , passLevel :: IntMap Int
  -- ^ pass id -> its dependency level (only for passes that execute)
  , passAnti :: IntMap [Int]
  {- ^ pass id -> the executing passes that rename a resource it reads, and
  so must run after it (write-after-read)
  -}
  , entryRetire :: IntMap [(QueueId, Word64)]
  {- ^ transient entry id -> per-queue timeline value that must be reached
  before the resource may be reclaimed
  -}
  , retireAfter :: IntMap [Int]
  {- ^ pass id -> transient entries whose last executing user it is,
  reclaimed right after the pass runs (side-effecting zero-ref passes count
  as users too)
  -}
  }