    {-# LANGUAGE QuasiQuotes #-}

    -- | C code generator.  This module can convert a correct ImpCode
    -- program to an equivalent C program.
    module Futhark.CodeGen.Backends.MulticoreC
      ( compileProg,
        GC.CParts (..),
        GC.asLibrary,
        GC.asExecutable,
        GC.asServer,
        operations,
        cliOptions,
        compileOp,
        ValueType (..),
        paramToCType,
        prepareTaskStruct,
        closureFreeStructField,
        generateParLoopFn,
        addTimingFields,
        functionTiming,
        functionIterations,
        multicoreDef,
        multicoreName,
        DefSpecifier,
        atomicOps,
      )
    where

    import Control.Monad
    import Data.Loc
    import Data.Map qualified as M
    import Data.Maybe
    import Data.Text qualified as T
    import Futhark.CodeGen.Backends.GenericC qualified as GC
    import Futhark.CodeGen.Backends.GenericC.Options
    import Futhark.CodeGen.Backends.MulticoreC.Boilerplate (generateBoilerplate)
    import Futhark.CodeGen.Backends.SimpleRep
    import Futhark.CodeGen.ImpCode.Multicore hiding (ValueType)
    import Futhark.CodeGen.ImpGen.Multicore qualified as ImpGen
    import Futhark.IR.MCMem (MCMem, Prog)
    import Futhark.MonadFreshNames
    import Language.C.Quote.OpenCL qualified as C
    import Language.C.Syntax qualified as C

    -- | Compile the program to ImpCode with multicore operations.
    compileProg ::
      (MonadFreshNames m) => T.Text -> Prog MCMem -> m (ImpGen.Warnings, GC.CParts)
    compileProg :: forall (m :: * -> *).
    MonadFreshNames m =>
    Text -> Prog MCMem -> m (Warnings, CParts)
    compileProg Text
    version =
      (Definitions Multicore -> m CParts)
    -> (Warnings, Definitions Multicore) -> m (Warnings, CParts)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> (Warnings, a) -> f (Warnings, b)
    traverse
        ( Text
    -> Text
    -> ParamMap
    -> Operations Multicore ()
    -> CompilerM Multicore () ()
    -> Text
    -> (Space, [Space])
    -> [Option]
    -> Definitions Multicore
    -> m CParts
    forall (m :: * -> *) op.
    MonadFreshNames m =>
    Text
    -> Text
    -> ParamMap
    -> Operations op ()
    -> CompilerM op () ()
    -> Text
    -> (Space, [Space])
    -> [Option]
    -> Definitions op
    -> m CParts
    GC.compileProg
            Text
    "multicore"
            Text
    version
            ParamMap
    forall a. Monoid a => a
    mempty
            Operations Multicore ()
    forall s. Operations Multicore s
    operations
            CompilerM Multicore () ()
    forall op s. CompilerM op s ()
    generateBoilerplate
            Text
    "#include <pthread.h>\n"
            (Space
    DefaultSpace, [Space
    DefaultSpace])
            [Option]
    cliOptions
        )
        ((Warnings, Definitions Multicore) -> m (Warnings, CParts))
    -> (Prog MCMem -> m (Warnings, Definitions Multicore))
    -> Prog MCMem
    -> m (Warnings, CParts)
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Prog MCMem -> m (Warnings, Definitions Multicore)
    forall (m :: * -> *).
    MonadFreshNames m =>
    Prog MCMem -> m (Warnings, Definitions Multicore)
    ImpGen.compileProg

    -- | Multicore-related command line options.
    cliOptions :: [Option]
    cliOptions :: [Option]
    cliOptions =
      [ Option
          { optionLongName :: String
    optionLongName = String
    "num-threads",
            optionShortName :: Maybe Char
    optionShortName = Maybe Char
    forall a. Maybe a
    Nothing,
            optionArgument :: OptionArgument
    optionArgument = String -> OptionArgument
    RequiredArgument String
    "INT",
            optionAction :: Stm
    optionAction = [C.cstm|futhark_context_config_set_num_threads(cfg, atoi(optarg));|],
            optionDescription :: String
    optionDescription = String
    "Set number of threads used for execution."
          }
      ]

    -- | Operations for generating multicore code.
    operations :: GC.Operations Multicore s
    operations :: forall s. Operations Multicore s
    operations =
      Operations Multicore s
    forall op s. Operations op s
    GC.defaultOperations
        { GC.opsCompiler = compileOp,
          GC.opsCritical =
            -- The thread entering an API function is always considered
            -- the "first worker" - note that this might differ from the
            -- thread that created the context!  This likely only matters
            -- for entry points, since they are the only API functions
            -- that contain parallel operations.
            ( [C.citems|worker_local = &ctx->scheduler.workers[0];|],
              []
            )
        }

    closureFreeStructField :: VName -> Name
    closureFreeStructField :: VName -> Name
    closureFreeStructField VName
    v =
      String -> Name
    nameFromString String
    "free_" Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> String -> Name
    nameFromString (VName -> String
    forall a. Pretty a => a -> String
    prettyString VName
    v)

    closureRetvalStructField :: VName -> Name
    closureRetvalStructField :: VName -> Name
    closureRetvalStructField VName
    v =
      String -> Name
    nameFromString String
    "retval_" Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> String -> Name
    nameFromString (VName -> String
    forall a. Pretty a => a -> String
    prettyString VName
    v)

    data ValueType = Prim PrimType | MemBlock | RawMem

    compileFreeStructFields :: [VName] -> [(C.Type, ValueType)] -> [C.FieldGroup]
    compileFreeStructFields :: [VName] -> [(Type, ValueType)] -> [FieldGroup]
    compileFreeStructFields = (VName -> (Type, ValueType) -> FieldGroup)
    -> [VName] -> [(Type, ValueType)] -> [FieldGroup]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith VName -> (Type, ValueType) -> FieldGroup
    field
      where
        field :: VName -> (Type, ValueType) -> FieldGroup
    field VName
    name (Type
    ty, Prim PrimType
    _) =
          [C.csdecl|$ty:ty $id:(closureFreeStructField name);|]
        field VName
    name (Type
    _, ValueType
    _) =
          [C.csdecl|$ty:defaultMemBlockType $id:(closureFreeStructField name);|]

    compileRetvalStructFields :: [VName] -> [(C.Type, ValueType)] -> [C.FieldGroup]
    compileRetvalStructFields :: [VName] -> [(Type, ValueType)] -> [FieldGroup]
    compileRetvalStructFields = (VName -> (Type, ValueType) -> FieldGroup)
    -> [VName] -> [(Type, ValueType)] -> [FieldGroup]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith VName -> (Type, ValueType) -> FieldGroup
    field
      where
        field :: VName -> (Type, ValueType) -> FieldGroup
    field VName
    name (Type
    ty, Prim PrimType
    _) =
          [C.csdecl|$ty:ty *$id:(closureRetvalStructField name);|]
        field VName
    name (Type
    _, ValueType
    _) =
          [C.csdecl|$ty:defaultMemBlockType $id:(closureRetvalStructField name);|]

    compileSetStructValues ::
      (C.ToIdent a) =>
      a ->
      [VName] ->
      [(C.Type, ValueType)] ->
      [C.Stm]
    compileSetStructValues :: forall a. ToIdent a => a -> [VName] -> [(Type, ValueType)] -> [Stm]
    compileSetStructValues a
    struct = (VName -> (Type, ValueType) -> Stm)
    -> [VName] -> [(Type, ValueType)] -> [Stm]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith VName -> (Type, ValueType) -> Stm
    forall {a}. VName -> (a, ValueType) -> Stm
    field
      where
        field :: VName -> (a, ValueType) -> Stm
    field VName
    name (a
    _, Prim PrimType
    pt) =
          [C.cstm|$id:struct.$id:(closureFreeStructField name)=$exp:(toStorage pt (C.toExp name noLoc));|]
        field VName
    name (a
    _, ValueType
    MemBlock) =
          [C.cstm|$id:struct.$id:(closureFreeStructField name)=$id:name.mem;|]
        field VName
    name (a
    _, ValueType
    RawMem) =
          [C.cstm|$id:struct.$id:(closureFreeStructField name)=$id:name;|]

    compileSetRetvalStructValues ::
      (C.ToIdent a) =>
      a ->
      [VName] ->
      [(C.Type, ValueType)] ->
      [C.Stm]
    compileSetRetvalStructValues :: forall a. ToIdent a => a -> [VName] -> [(Type, ValueType)] -> [Stm]
    compileSetRetvalStructValues a
    struct [VName]
    vnames [(Type, ValueType)]
    we = [[Stm]] -> [Stm]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Stm]] -> [Stm]) -> [[Stm]] -> [Stm]
    forall a b. (a -> b) -> a -> b
    $ (VName -> (Type, ValueType) -> [Stm])
    -> [VName] -> [(Type, ValueType)] -> [[Stm]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith VName -> (Type, ValueType) -> [Stm]
    field [VName]
    vnames [(Type, ValueType)]
    we
      where
        field :: VName -> (Type, ValueType) -> [Stm]
    field VName
    name (Type
    ct, Prim PrimType
    _) =
          [C.cstms|$id:struct.$id:(closureRetvalStructField name)=(($ty:ct*)&$id:name);
                   $escstm:("#if defined(ISPC)")
                   $id:struct.$id:(closureRetvalStructField name)+= programIndex;
                   $escstm:("#endif")|]
        field VName
    name (Type
    _, ValueType
    MemBlock) =
          [C.cstms|$id:struct.$id:(closureRetvalStructField name)=$id:name.mem;|]
        field VName
    name (Type
    _, ValueType
    RawMem) =
          [C.cstms|$id:struct.$id:(closureRetvalStructField name)=$id:name;|]

    compileGetRetvalStructVals :: (C.ToIdent a) => a -> [VName] -> [(C.Type, ValueType)] -> [C.InitGroup]
    compileGetRetvalStructVals :: forall a.
    ToIdent a =>
    a -> [VName] -> [(Type, ValueType)] -> [InitGroup]
    compileGetRetvalStructVals a
    struct = (VName -> (Type, ValueType) -> InitGroup)
    -> [VName] -> [(Type, ValueType)] -> [InitGroup]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith VName -> (Type, ValueType) -> InitGroup
    field
      where
        field :: VName -> (Type, ValueType) -> InitGroup
    field VName
    name (Type
    ty, Prim PrimType
    pt) =
          let inner :: Exp
    inner = [C.cexp|*$id:struct->$id:(closureRetvalStructField name)|]
           in [C.cdecl|$ty:ty $id:name = $exp:(fromStorage pt inner);|]
        field VName
    name (Type
    ty, ValueType
    _) =
          [C.cdecl|$ty:ty $id:name =
                     {.desc = $string:(prettyString name),
                     .mem = $id:struct->$id:(closureRetvalStructField name),
                     .size = 0, .references = NULL};|]

    compileGetStructVals ::
      (C.ToIdent a) =>
      a ->
      [VName] ->
      [(C.Type, ValueType)] ->
      [C.InitGroup]
    compileGetStructVals :: forall a.
    ToIdent a =>
    a -> [VName] -> [(Type, ValueType)] -> [InitGroup]
    compileGetStructVals a
    struct = (VName -> (Type, ValueType) -> InitGroup)
    -> [VName] -> [(Type, ValueType)] -> [InitGroup]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith VName -> (Type, ValueType) -> InitGroup
    field
      where
        field :: VName -> (Type, ValueType) -> InitGroup
    field VName
    name (Type
    ty, Prim PrimType
    pt) =
          let inner :: Exp
    inner = [C.cexp|$id:struct->$id:(closureFreeStructField name)|]
           in [C.cdecl|$ty:ty $id:name = $exp:(fromStorage pt inner);|]
        field VName
    name (Type
    ty, ValueType
    _) =
          [C.cdecl|$ty:ty $id:name =
                     {.desc = $string:(prettyString name),
                      .mem = $id:struct->$id:(closureFreeStructField name),
                      .size = 0, .references = NULL};|]

    compileWriteBackResVals :: (C.ToIdent a) => a -> [VName] -> [(C.Type, ValueType)] -> [C.Stm]
    compileWriteBackResVals :: forall a. ToIdent a => a -> [VName] -> [(Type, ValueType)] -> [Stm]
    compileWriteBackResVals a
    struct = (VName -> (Type, ValueType) -> Stm)
    -> [VName] -> [(Type, ValueType)] -> [Stm]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith VName -> (Type, ValueType) -> Stm
    forall {a}. VName -> (a, ValueType) -> Stm
    field
      where
        field :: VName -> (a, ValueType) -> Stm
    field VName
    name (a
    _, Prim PrimType
    pt) =
          [C.cstm|*$id:struct->$id:(closureRetvalStructField name) = $exp:(toStorage pt (C.toExp name noLoc));|]
        field VName
    name (a
    _, ValueType
    _) =
          [C.cstm|$id:struct->$id:(closureRetvalStructField name) = $id:name.mem;|]

    paramToCType :: Param -> GC.CompilerM op s (C.Type, ValueType)
    paramToCType :: forall op s. Param -> CompilerM op s (Type, ValueType)
    paramToCType (ScalarParam VName
    _ PrimType
    pt) = do
      let t :: Type
    t = PrimType -> Type
    primStorageType PrimType
    pt
      (Type, ValueType) -> CompilerM op s (Type, ValueType)
    forall a. a -> CompilerM op s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Type
    t, PrimType -> ValueType
    Prim PrimType
    pt)
    paramToCType (MemParam VName
    name Space
    space') = VName -> Space -> CompilerM op s (Type, ValueType)
    forall op s. VName -> Space -> CompilerM op s (Type, ValueType)
    mcMemToCType VName
    name Space
    space'

    mcMemToCType :: VName -> Space -> GC.CompilerM op s (C.Type, ValueType)
    mcMemToCType :: forall op s. VName -> Space -> CompilerM op s (Type, ValueType)
    mcMemToCType VName
    v Space
    space = do
      refcount <- Space -> CompilerM op s Bool
    forall op s. Space -> CompilerM op s Bool
    GC.fatMemory Space
    space
      cached <- isJust <$> GC.cacheMem v
      pure
        ( GC.fatMemType space,
          if refcount && not cached
            then MemBlock
            else RawMem
        )

    benchmarkCode :: Name -> [C.BlockItem] -> GC.CompilerM op s [C.BlockItem]
    benchmarkCode :: forall op s. Name -> [BlockItem] -> CompilerM op s [BlockItem]
    benchmarkCode Name
    name [BlockItem]
    code = do
      event <- String -> CompilerM op s VName
    forall (m :: * -> *). MonadFreshNames m => String -> m VName
    newVName String
    "event"
      provenance <- GC.provenanceExp
      pure
        [C.citems|
         struct mc_event* $id:event = mc_event_new(ctx);
         if ($id:event != NULL) {
           $id:event->bef = get_wall_time();
         }
         $items:code
         if ($id:event != NULL) {
           $id:event->aft = get_wall_time();
           lock_lock(&ctx->event_list_lock);
           add_event(ctx,
                     $string:(nameToString name),
                     $exp:provenance,
                     NULL,
                     $id:event,
                     (typename event_report_fn)mc_event_report);
           lock_unlock(&ctx->event_list_lock);
         }|]

    functionTiming :: Name -> C.Id
    functionTiming :: Name -> Id
    functionTiming = (Name -> SrcLoc -> Id
    forall a. ToIdent a => a -> SrcLoc -> Id
    `C.toIdent` SrcLoc
    forall a. Monoid a => a
    mempty) (Name -> Id) -> (Name -> Name) -> Name -> Id
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_total_time")

    functionIterations :: Name -> C.Id
    functionIterations :: Name -> Id
    functionIterations = (Name -> SrcLoc -> Id
    forall a. ToIdent a => a -> SrcLoc -> Id
    `C.toIdent` SrcLoc
    forall a. Monoid a => a
    mempty) (Name -> Id) -> (Name -> Name) -> Name -> Id
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_total_iter")

    addTimingFields :: Name -> GC.CompilerM op s ()
    addTimingFields :: forall op s. Name -> CompilerM op s ()
    addTimingFields Name
    name = do
      Id -> Type -> Maybe Exp -> CompilerM op s ()
    forall op s. Id -> Type -> Maybe Exp -> CompilerM op s ()
    GC.contextField (Name -> Id
    functionTiming Name
    name) [C.cty|typename int64_t|] (Maybe Exp -> CompilerM op s ()) -> Maybe Exp -> CompilerM op s ()
    forall a b. (a -> b) -> a -> b
    $ Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just [C.cexp|0|]
      Id -> Type -> Maybe Exp -> CompilerM op s ()
    forall op s. Id -> Type -> Maybe Exp -> CompilerM op s ()
    GC.contextField (Name -> Id
    functionIterations Name
    name) [C.cty|typename int64_t|] (Maybe Exp -> CompilerM op s ()) -> Maybe Exp -> CompilerM op s ()
    forall a b. (a -> b) -> a -> b
    $ Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just [C.cexp|0|]

    multicoreName :: String -> GC.CompilerM op s Name
    multicoreName :: forall op s. String -> CompilerM op s Name
    multicoreName String
    s = do
      s' <- String -> CompilerM op s VName
    forall (m :: * -> *). MonadFreshNames m => String -> m VName
    newVName (String
    "futhark_mc_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s)
      pure $ nameFromString $ baseString s' ++ "_" ++ show (baseTag s')

    type DefSpecifier s = String -> (Name -> GC.CompilerM Multicore s C.Definition) -> GC.CompilerM Multicore s Name

    multicoreDef :: DefSpecifier s
    multicoreDef :: forall s. DefSpecifier s
    multicoreDef String
    s Name -> CompilerM Multicore s Definition
    f = do
      s' <- String -> CompilerM Multicore s Name
    forall op s. String -> CompilerM op s Name
    multicoreName String
    s
      GC.libDecl =<< f s'
      pure s'

    generateParLoopFn ::
      (C.ToIdent a) =>
      M.Map VName Space ->
      String ->
      MCCode ->
      a ->
      [(VName, (C.Type, ValueType))] ->
      [(VName, (C.Type, ValueType))] ->
      GC.CompilerM Multicore s Name
    generateParLoopFn :: forall a s.
    ToIdent a =>
    Map VName Space
    -> String
    -> MCCode
    -> a
    -> [(VName, (Type, ValueType))]
    -> [(VName, (Type, ValueType))]
    -> CompilerM Multicore s Name
    generateParLoopFn Map VName Space
    lexical String
    basename MCCode
    code a
    fstruct [(VName, (Type, ValueType))]
    free [(VName, (Type, ValueType))]
    retval = do
      let ([VName]
    fargs, [(Type, ValueType)]
    fctypes) = [(VName, (Type, ValueType))] -> ([VName], [(Type, ValueType)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(VName, (Type, ValueType))]
    free
      let ([VName]
    retval_args, [(Type, ValueType)]
    retval_ctypes) = [(VName, (Type, ValueType))] -> ([VName], [(Type, ValueType)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(VName, (Type, ValueType))]
    retval
      DefSpecifier s
    forall s. DefSpecifier s
    multicoreDef String
    basename ((Name -> CompilerM Multicore s Definition)
     -> CompilerM Multicore s Name)
    -> (Name -> CompilerM Multicore s Definition)
    -> CompilerM Multicore s Name
    forall a b. (a -> b) -> a -> b
    $ \Name
    s -> do
        fbody <- Name -> [BlockItem] -> CompilerM Multicore s [BlockItem]
    forall op s. Name -> [BlockItem] -> CompilerM op s [BlockItem]
    benchmarkCode Name
    s ([BlockItem] -> CompilerM Multicore s [BlockItem])
    -> (CompilerM Multicore s [BlockItem]
        -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s [BlockItem]
    -> CompilerM Multicore s [BlockItem]
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< CompilerM Multicore s [BlockItem]
    -> CompilerM Multicore s [BlockItem]
    forall op s a. CompilerM op s a -> CompilerM op s a
    GC.inNewFunction (CompilerM Multicore s [BlockItem]
     -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s [BlockItem]
    -> CompilerM Multicore s [BlockItem]
    forall a b. (a -> b) -> a -> b
    $
          Map VName Space
    -> ([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s [BlockItem]
    forall op s a.
    Map VName Space
    -> ([BlockItem] -> [Stm] -> CompilerM op s a) -> CompilerM op s a
    GC.cachingMemory Map VName Space
    lexical (([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
     -> CompilerM Multicore s [BlockItem])
    -> ([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s [BlockItem]
    forall a b. (a -> b) -> a -> b
    $ \[BlockItem]
    decl_cached [Stm]
    free_cached -> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
    GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall a b. (a -> b) -> a -> b
    $ do
            (BlockItem -> CompilerM Multicore s ())
    -> [BlockItem] -> CompilerM Multicore s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ BlockItem -> CompilerM Multicore s ()
    forall op s. BlockItem -> CompilerM op s ()
    GC.item [C.citems|$decls:(compileGetStructVals fstruct fargs fctypes)|]
            (BlockItem -> CompilerM Multicore s ())
    -> [BlockItem] -> CompilerM Multicore s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ BlockItem -> CompilerM Multicore s ()
    forall op s. BlockItem -> CompilerM op s ()
    GC.item [C.citems|$decls:(compileGetRetvalStructVals fstruct retval_args retval_ctypes)|]
            code' <- CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
    GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall a b. (a -> b) -> a -> b
    $ MCCode -> CompilerM Multicore s ()
    forall op s. Code op -> CompilerM op s ()
    GC.compileCode MCCode
    code
            mapM_ GC.item decl_cached
            mapM_ GC.item =<< GC.declAllocatedMem
            mapM_ GC.item code'
            free_mem <- GC.freeAllocatedMem
            GC.stm [C.cstm|cleanup: {$stms:free_cached $items:free_mem}|]
        pure
          [C.cedecl|int $id:s(void *args, typename int64_t iterations, int tid, struct scheduler_info info) {
                               int err = 0;
                               int subtask_id = tid;
                               struct $id:fstruct *$id:fstruct = (struct $id:fstruct*) args;
                               struct futhark_context *ctx = $id:fstruct->ctx;
                               $items:fbody
                               if (err == 0) {
                                 $stms:(compileWriteBackResVals fstruct retval_args retval_ctypes)
                               }
                               return err;
                          }|]

    prepareTaskStruct ::
      DefSpecifier s ->
      String ->
      [VName] ->
      [(C.Type, ValueType)] ->
      [VName] ->
      [(C.Type, ValueType)] ->
      GC.CompilerM Multicore s Name
    prepareTaskStruct :: forall s.
    DefSpecifier s
    -> String
    -> [VName]
    -> [(Type, ValueType)]
    -> [VName]
    -> [(Type, ValueType)]
    -> CompilerM Multicore s Name
    prepareTaskStruct DefSpecifier s
    def String
    name [VName]
    free_args [(Type, ValueType)]
    free_ctypes [VName]
    retval_args [(Type, ValueType)]
    retval_ctypes = do
      let makeStruct :: a -> f Definition
    makeStruct a
    s =
            Definition -> f Definition
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
              [C.cedecl|struct $id:s {
                           struct futhark_context *ctx;
                           $sdecls:(compileFreeStructFields free_args free_ctypes)
                           $sdecls:(compileRetvalStructFields retval_args retval_ctypes)
                         };|]
      fstruct <- DefSpecifier s
    def String
    name Name -> CompilerM Multicore s Definition
    forall {f :: * -> *} {a}.
    (Applicative f, ToIdent a) =>
    a -> f Definition
    makeStruct
      let fstruct' = Name
    fstruct Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_"
      GC.decl [C.cdecl|struct $id:fstruct $id:fstruct';|]
      GC.stm [C.cstm|$id:fstruct'.ctx = ctx;|]
      GC.stms [C.cstms|$stms:(compileSetStructValues fstruct' free_args free_ctypes)|]
      GC.stms [C.cstms|$stms:(compileSetRetvalStructValues fstruct' retval_args retval_ctypes)|]
      pure fstruct

    -- Generate a segop function for top_level and potentially nested SegOp code
    compileOp :: GC.OpCompiler Multicore s
    compileOp :: forall s. OpCompiler Multicore s
    compileOp (GetLoopBounds VName
    start VName
    end) = do
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:start = start;|]
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:end = end;|]
    compileOp (GetTaskId VName
    v) =
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:v = subtask_id;|]
    compileOp (GetNumTasks VName
    v) =
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:v = info.nsubtasks;|]
    compileOp (SegOp String
    name [Param]
    params ParallelTask
    seq_task Maybe ParallelTask
    par_task [Param]
    retvals (SchedulerInfo Exp
    e Scheduling
    sched)) = do
      let (ParallelTask MCCode
    seq_code) = ParallelTask
    seq_task
      free_ctypes <- (Param -> CompilerM Multicore s (Type, ValueType))
    -> [Param] -> CompilerM Multicore s [(Type, ValueType)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Param -> CompilerM Multicore s (Type, ValueType)
    forall op s. Param -> CompilerM op s (Type, ValueType)
    paramToCType [Param]
    params
      retval_ctypes <- mapM paramToCType retvals
      let free_args = (Param -> VName) -> [Param] -> [VName]
    forall a b. (a -> b) -> [a] -> [b]
    map Param -> VName
    paramName [Param]
    params
          retval_args = (Param -> VName) -> [Param] -> [VName]
    forall a b. (a -> b) -> [a] -> [b]
    map Param -> VName
    paramName [Param]
    retvals
          free = [VName] -> [(Type, ValueType)] -> [(VName, (Type, ValueType))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [VName]
    free_args [(Type, ValueType)]
    free_ctypes
          retval = [VName] -> [(Type, ValueType)] -> [(VName, (Type, ValueType))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [VName]
    retval_args [(Type, ValueType)]
    retval_ctypes

      e' <- GC.compileExp e

      let lexical = KernelHandling -> Function Multicore -> Map VName Space
    lexicalMemoryUsageMC KernelHandling
    TraverseKernels (Function Multicore -> Map VName Space)
    -> Function Multicore -> Map VName Space
    forall a b. (a -> b) -> a -> b
    $ Maybe EntryPoint
    -> [Param] -> [Param] -> MCCode -> Function Multicore
    forall a.
    Maybe EntryPoint -> [Param] -> [Param] -> Code a -> FunctionT a
    Function Maybe EntryPoint
    forall a. Maybe a
    Nothing [] [Param]
    params MCCode
    seq_code

      fstruct <-
        prepareTaskStruct multicoreDef "task" free_args free_ctypes retval_args retval_ctypes

      fpar_task <- generateParLoopFn lexical (name ++ "_task") seq_code fstruct free retval
      addTimingFields fpar_task

      let ftask_name = Name
    fstruct Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_task"
      GC.decl [C.cdecl|struct scheduler_segop $id:ftask_name;|]
      GC.stm [C.cstm|$id:ftask_name.args = &$id:(fstruct <> "_");|]
      GC.stm [C.cstm|$id:ftask_name.top_level_fn = $id:fpar_task;|]
      GC.stm [C.cstm|$id:ftask_name.name = $string:(nameToString fpar_task);|]
      GC.stm [C.cstm|$id:ftask_name.iterations = $exp:e';|]
      -- Create the timing fields for the task
      GC.stm [C.cstm|$id:ftask_name.task_time = &ctx->program->$id:(functionTiming fpar_task);|]
      GC.stm [C.cstm|$id:ftask_name.task_iter = &ctx->program->$id:(functionIterations fpar_task);|]

      case sched of
        Scheduling
    Dynamic -> Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:ftask_name.sched = DYNAMIC;|]
        Scheduling
    Static -> Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:ftask_name.sched = STATIC;|]

      -- Generate the nested segop function if available
      case par_task of
        Just (ParallelTask MCCode
    nested_code) -> do
          let lexical_nested :: Map VName Space
    lexical_nested = KernelHandling -> Function Multicore -> Map VName Space
    lexicalMemoryUsageMC KernelHandling
    TraverseKernels (Function Multicore -> Map VName Space)
    -> Function Multicore -> Map VName Space
    forall a b. (a -> b) -> a -> b
    $ Maybe EntryPoint
    -> [Param] -> [Param] -> MCCode -> Function Multicore
    forall a.
    Maybe EntryPoint -> [Param] -> [Param] -> Code a -> FunctionT a
    Function Maybe EntryPoint
    forall a. Maybe a
    Nothing [] [Param]
    params MCCode
    nested_code
          fnpar_task <- Map VName Space
    -> String
    -> MCCode
    -> Name
    -> [(VName, (Type, ValueType))]
    -> [(VName, (Type, ValueType))]
    -> CompilerM Multicore s Name
    forall a s.
    ToIdent a =>
    Map VName Space
    -> String
    -> MCCode
    -> a
    -> [(VName, (Type, ValueType))]
    -> [(VName, (Type, ValueType))]
    -> CompilerM Multicore s Name
    generateParLoopFn Map VName Space
    lexical_nested (String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_nested_task") MCCode
    nested_code Name
    fstruct [(VName, (Type, ValueType))]
    free [(VName, (Type, ValueType))]
    retval
          GC.stm [C.cstm|$id:ftask_name.nested_fn = $id:fnpar_task;|]
        Maybe ParallelTask
    Nothing ->
          Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:ftask_name.nested_fn=NULL;|]

      let ftask_err = Name
    fpar_task Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_err"
          code =
            [C.citems|int $id:ftask_err = scheduler_prepare_task(&ctx->scheduler, &$id:ftask_name);
                      if ($id:ftask_err != 0) {
                        err = $id:ftask_err;
                        goto cleanup;
                      }|]

      mapM_ GC.item code
    compileOp (ParLoop String
    s' MCCode
    body [Param]
    free) = do
      free_ctypes <- (Param -> CompilerM Multicore s (Type, ValueType))
    -> [Param] -> CompilerM Multicore s [(Type, ValueType)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Param -> CompilerM Multicore s (Type, ValueType)
    forall op s. Param -> CompilerM op s (Type, ValueType)
    paramToCType [Param]
    free
      let free_args = (Param -> VName) -> [Param] -> [VName]
    forall a b. (a -> b) -> [a] -> [b]
    map Param -> VName
    paramName [Param]
    free

      let lexical = KernelHandling -> Function Multicore -> Map VName Space
    lexicalMemoryUsageMC KernelHandling
    TraverseKernels (Function Multicore -> Map VName Space)
    -> Function Multicore -> Map VName Space
    forall a b. (a -> b) -> a -> b
    $ Maybe EntryPoint
    -> [Param] -> [Param] -> MCCode -> Function Multicore
    forall a.
    Maybe EntryPoint -> [Param] -> [Param] -> Code a -> FunctionT a
    Function Maybe EntryPoint
    forall a. Maybe a
    Nothing [] [Param]
    free MCCode
    body

      fstruct <-
        prepareTaskStruct multicoreDef (s' ++ "_parloop_struct") free_args free_ctypes mempty mempty

      ftask <- multicoreDef (s' ++ "_parloop") $ \Name
    s -> do
        fbody <- Name -> [BlockItem] -> CompilerM Multicore s [BlockItem]
    forall op s. Name -> [BlockItem] -> CompilerM op s [BlockItem]
    benchmarkCode Name
    s ([BlockItem] -> CompilerM Multicore s [BlockItem])
    -> (CompilerM Multicore s [BlockItem]
        -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s [BlockItem]
    -> CompilerM Multicore s [BlockItem]
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< CompilerM Multicore s [BlockItem]
    -> CompilerM Multicore s [BlockItem]
    forall op s a. CompilerM op s a -> CompilerM op s a
    GC.inNewFunction (CompilerM Multicore s [BlockItem]
     -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s [BlockItem]
    -> CompilerM Multicore s [BlockItem]
    forall a b. (a -> b) -> a -> b
    $
          Map VName Space
    -> ([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s [BlockItem]
    forall op s a.
    Map VName Space
    -> ([BlockItem] -> [Stm] -> CompilerM op s a) -> CompilerM op s a
    GC.cachingMemory Map VName Space
    lexical (([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
     -> CompilerM Multicore s [BlockItem])
    -> ([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s [BlockItem]
    forall a b. (a -> b) -> a -> b
    $ \[BlockItem]
    decl_cached [Stm]
    free_cached -> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
    GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall a b. (a -> b) -> a -> b
    $ do
            [BlockItem] -> CompilerM Multicore s ()
    forall op s. [BlockItem] -> CompilerM op s ()
    GC.items [C.citems|$decls:(compileGetStructVals fstruct free_args free_ctypes)|]

            InitGroup -> CompilerM Multicore s ()
    forall op s. InitGroup -> CompilerM op s ()
    GC.decl [C.cdecl|typename int64_t iterations = end-start;|]

            body' <- CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
    GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall a b. (a -> b) -> a -> b
    $ MCCode -> CompilerM Multicore s ()
    forall op s. Code op -> CompilerM op s ()
    GC.compileCode MCCode
    body

            mapM_ GC.item decl_cached
            mapM_ GC.item =<< GC.declAllocatedMem
            free_mem <- GC.freeAllocatedMem
            mapM_ GC.item body'
            GC.stm [C.cstm|cleanup: {$stms:free_cached $items:free_mem}|]
        pure
          [C.cedecl|static int $id:s(void *args,
                                     typename int64_t start,
                                     typename int64_t end,
                                     int subtask_id,
                                     int tid) {
                           (void)subtask_id;
                           (void)tid;
                           int err = 0;
                           struct $id:fstruct *$id:fstruct = (struct $id:fstruct*) args;
                           struct futhark_context *ctx = $id:fstruct->ctx;
                           $items:fbody
                           return err;
                    }|]

      let ftask_name = Name
    ftask Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_task"
      GC.decl [C.cdecl|struct scheduler_parloop $id:ftask_name;|]
      GC.stm [C.cstm|$id:ftask_name.name = $string:(nameToString ftask);|]
      GC.stm [C.cstm|$id:ftask_name.fn = $id:ftask;|]
      GC.stm [C.cstm|$id:ftask_name.args = &$id:(fstruct <> "_");|]
      GC.stm [C.cstm|$id:ftask_name.iterations = iterations;|]
      GC.stm [C.cstm|$id:ftask_name.info = info;|]

      let ftask_err = Name
    ftask Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_err"
          ftask_total = Name
    ftask Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_total"
      code' <-
        benchmarkCode
          ftask_total
          [C.citems|int $id:ftask_err = scheduler_execute_task(&ctx->scheduler,
                                                               &$id:ftask_name);
                   if ($id:ftask_err != 0) {
                     err = $id:ftask_err;
                     goto cleanup;
                   }|]

      mapM_ GC.item code'
    compileOp (Atomic AtomicOp
    aop) =
      AtomicOp
    -> (Type -> VName -> CompilerM Multicore s Type)
    -> CompilerM Multicore s ()
    forall op s.
    AtomicOp
    -> (Type -> VName -> CompilerM op s Type) -> CompilerM op s ()
    atomicOps AtomicOp
    aop (\Type
    ty VName
    _ -> Type -> CompilerM Multicore s Type
    forall a. a -> CompilerM Multicore s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [C.cty|$ty:ty*|])
    compileOp (ISPCKernel MCCode
    body [Param]
    _) =
      MCCode -> CompilerM Multicore s ()
    forall s. MCCode -> CompilerM Multicore s ()
    scopedBlock MCCode
    body
    compileOp (ForEach VName
    i Exp
    from Exp
    bound MCCode
    body) = do
      let i' :: SrcLoc -> Id
    i' = VName -> SrcLoc -> Id
    forall a. ToIdent a => a -> SrcLoc -> Id
    C.toIdent VName
    i
          t :: Type
    t = PrimType -> Type
    primTypeToCType (PrimType -> Type) -> PrimType -> Type
    forall a b. (a -> b) -> a -> b
    $ Exp -> PrimType
    forall v. PrimExp v -> PrimType
    primExpType Exp
    bound
      from' <- Exp -> CompilerM Multicore s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp Exp
    from
      bound' <- GC.compileExp bound
      body' <- GC.collect $ GC.compileCode body
      GC.stm
        [C.cstm|for ($ty:t $id:i' = $exp:from'; $id:i' < $exp:bound'; $id:i'++) {
                $items:body'
              }|]
    compileOp (ForEachActive VName
    i MCCode
    body) = do
      InitGroup -> CompilerM Multicore s ()
    forall op s. InitGroup -> CompilerM op s ()
    GC.decl [C.cdecl|typename int64_t $id:i = 0;|]
      MCCode -> CompilerM Multicore s ()
    forall s. MCCode -> CompilerM Multicore s ()
    scopedBlock MCCode
    body
    compileOp (ExtractLane VName
    dest Exp
    tar Exp
    _) = do
      tar' <- Exp -> CompilerM Multicore s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp Exp
    tar
      GC.stm [C.cstm|$id:dest = $exp:tar';|]

    scopedBlock :: MCCode -> GC.CompilerM Multicore s ()
    scopedBlock :: forall s. MCCode -> CompilerM Multicore s ()
    scopedBlock MCCode
    code = do
      inner <- CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
    GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
    -> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
    forall a b. (a -> b) -> a -> b
    $ MCCode -> CompilerM Multicore s ()
    forall op s. Code op -> CompilerM op s ()
    GC.compileCode MCCode
    code
      GC.stm [C.cstm|{$items:inner}|]

    doAtomic ::
      (C.ToIdent a1) =>
      a1 ->
      VName ->
      Count u (TExp Int32) ->
      Exp ->
      String ->
      C.Type ->
      (C.Type -> VName -> GC.CompilerM op s C.Type) ->
      GC.CompilerM op s ()
    doAtomic :: forall {k} a1 (u :: k) op s.
    ToIdent a1 =>
    a1
    -> VName
    -> Count u (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    doAtomic a1
    old VName
    arr Count u (TExp Int32)
    ind Exp
    val String
    op Type
    ty Type -> VName -> CompilerM op s Type
    castf = do
      ind' <- Exp -> CompilerM op s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp (Exp -> CompilerM op s Exp) -> Exp -> CompilerM op s Exp
    forall a b. (a -> b) -> a -> b
    $ TExp Int32 -> Exp
    forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
    untyped (TExp Int32 -> Exp) -> TExp Int32 -> Exp
    forall a b. (a -> b) -> a -> b
    $ Count u (TExp Int32) -> TExp Int32
    forall {k} (u :: k) e. Count u e -> e
    unCount Count u (TExp Int32)
    ind
      val' <- GC.compileExp val
      cast <- castf ty arr
      arr' <- GC.rawMem arr
      GC.stm [C.cstm|$id:old = $id:op(&(($ty:cast)$exp:arr')[$exp:ind'], ($ty:ty) $exp:val', __ATOMIC_RELAXED);|]

    atomicOps :: AtomicOp -> (C.Type -> VName -> GC.CompilerM op s C.Type) -> GC.CompilerM op s ()
    atomicOps :: forall op s.
    AtomicOp
    -> (Type -> VName -> CompilerM op s Type) -> CompilerM op s ()
    atomicOps (AtomicCmpXchg PrimType
    t VName
    old VName
    arr Count Elements (TExp Int32)
    ind VName
    res Exp
    val) Type -> VName -> CompilerM op s Type
    castf = do
      ind' <- Exp -> CompilerM op s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp (Exp -> CompilerM op s Exp) -> Exp -> CompilerM op s Exp
    forall a b. (a -> b) -> a -> b
    $ TExp Int32 -> Exp
    forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
    untyped (TExp Int32 -> Exp) -> TExp Int32 -> Exp
    forall a b. (a -> b) -> a -> b
    $ Count Elements (TExp Int32) -> TExp Int32
    forall {k} (u :: k) e. Count u e -> e
    unCount Count Elements (TExp Int32)
    ind
      new_val' <- GC.compileExp val
      cast <- castf [C.cty|$ty:(GC.primTypeToCType t)|] arr
      arr' <- GC.rawMem arr
      GC.stm
        [C.cstm|$id:res = $id:op(&(($ty:cast)$exp:arr')[$exp:ind'],
                     &$id:old,
                     $exp:new_val',
                     0, __ATOMIC_SEQ_CST, __ATOMIC_RELAXED);|]
      where
        op :: String
        op :: String
    op = String
    "__atomic_compare_exchange_n"
    atomicOps (AtomicXchg PrimType
    t VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val) Type -> VName -> CompilerM op s Type
    castf = do
      ind' <- Exp -> CompilerM op s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp (Exp -> CompilerM op s Exp) -> Exp -> CompilerM op s Exp
    forall a b. (a -> b) -> a -> b
    $ TExp Int32 -> Exp
    forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
    untyped (TExp Int32 -> Exp) -> TExp Int32 -> Exp
    forall a b. (a -> b) -> a -> b
    $ Count Elements (TExp Int32) -> TExp Int32
    forall {k} (u :: k) e. Count u e -> e
    unCount Count Elements (TExp Int32)
    ind
      val' <- GC.compileExp val
      cast <- castf [C.cty|$ty:(GC.primTypeToCType t)|] arr
      GC.stm [C.cstm|$id:old = $id:op(&(($ty:cast)$id:arr.mem)[$exp:ind'], $exp:val', __ATOMIC_SEQ_CST);|]
      where
        op :: String
        op :: String
    op = String
    "__atomic_exchange_n"
    atomicOps (AtomicAdd IntType
    t VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val) Type -> VName -> CompilerM op s Type
    castf =
      VName
    -> VName
    -> Count Elements (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    forall {k} a1 (u :: k) op s.
    ToIdent a1 =>
    a1
    -> VName
    -> Count u (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    doAtomic VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val String
    "__atomic_fetch_add" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
    castf
    atomicOps (AtomicSub IntType
    t VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val) Type -> VName -> CompilerM op s Type
    castf =
      VName
    -> VName
    -> Count Elements (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    forall {k} a1 (u :: k) op s.
    ToIdent a1 =>
    a1
    -> VName
    -> Count u (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    doAtomic VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val String
    "__atomic_fetch_sub" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
    castf
    atomicOps (AtomicAnd IntType
    t VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val) Type -> VName -> CompilerM op s Type
    castf =
      VName
    -> VName
    -> Count Elements (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    forall {k} a1 (u :: k) op s.
    ToIdent a1 =>
    a1
    -> VName
    -> Count u (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    doAtomic VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val String
    "__atomic_fetch_and" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
    castf
    atomicOps (AtomicOr IntType
    t VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val) Type -> VName -> CompilerM op s Type
    castf =
      VName
    -> VName
    -> Count Elements (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    forall {k} a1 (u :: k) op s.
    ToIdent a1 =>
    a1
    -> VName
    -> Count u (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    doAtomic VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val String
    "__atomic_fetch_or" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
    castf
    atomicOps (AtomicXor IntType
    t VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val) Type -> VName -> CompilerM op s Type
    castf =
      VName
    -> VName
    -> Count Elements (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    forall {k} a1 (u :: k) op s.
    ToIdent a1 =>
    a1
    -> VName
    -> Count u (TExp Int32)
    -> Exp
    -> String
    -> Type
    -> (Type -> VName -> CompilerM op s Type)
    -> CompilerM op s ()
    doAtomic VName
    old VName
    arr Count Elements (TExp Int32)
    ind Exp
    val String
    "__atomic_fetch_xor" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
    castf