    {-# 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
      Bool
    refcount <- Space -> CompilerM op s Bool
    forall op s. Space -> CompilerM op s Bool
    GC.fatMemory Space
    space
      Bool
    cached <- Maybe VName -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe VName -> Bool)
    -> CompilerM op s (Maybe VName) -> CompilerM op s Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> VName -> CompilerM op s (Maybe VName)
    forall a op s. ToExp a => a -> CompilerM op s (Maybe VName)
    GC.cacheMem VName
    v
      (Type, ValueType) -> CompilerM op s (Type, ValueType)
    forall a. a -> CompilerM op s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        ( Space -> Type
    GC.fatMemType Space
    space,
          if Bool
    refcount Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    cached
            then ValueType
    MemBlock
            else ValueType
    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
      VName
    event <- String -> CompilerM op s VName
    forall (m :: * -> *). MonadFreshNames m => String -> m VName
    newVName String
    "event"
      Exp
    provenance <- CompilerM op s Exp
    forall op s. CompilerM op s Exp
    GC.provenanceExp
      [BlockItem] -> CompilerM op s [BlockItem]
    forall a. a -> CompilerM op s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    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
      VName
    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)
      Name -> CompilerM op s Name
    forall a. a -> CompilerM op s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> CompilerM op s Name) -> Name -> CompilerM op s Name
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    nameFromString (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ VName -> String
    baseString VName
    s' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (VName -> Int
    baseTag VName
    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
      Name
    s' <- String -> CompilerM Multicore s Name
    forall op s. String -> CompilerM op s Name
    multicoreName String
    s
      Definition -> CompilerM Multicore s ()
    forall op s. Definition -> CompilerM op s ()
    GC.libDecl (Definition -> CompilerM Multicore s ())
    -> CompilerM Multicore s Definition -> CompilerM Multicore s ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Name -> CompilerM Multicore s Definition
    f Name
    s'
      Name -> CompilerM Multicore s Name
    forall a. a -> CompilerM Multicore s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Name
    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
        [BlockItem]
    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)|]
            [BlockItem]
    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
            (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 [BlockItem]
    decl_cached
            (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 ([BlockItem] -> CompilerM Multicore s ())
    -> CompilerM Multicore s [BlockItem] -> CompilerM Multicore s ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< CompilerM Multicore s [BlockItem]
    forall op s. CompilerM op s [BlockItem]
    GC.declAllocatedMem
            (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 [BlockItem]
    code'
            [BlockItem]
    free_mem <- CompilerM Multicore s [BlockItem]
    forall op s. CompilerM op s [BlockItem]
    GC.freeAllocatedMem
            Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|cleanup: {$stms:free_cached $items:free_mem}|]
        Definition -> CompilerM Multicore s Definition
    forall a. a -> CompilerM Multicore s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    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)
                         };|]
      Name
    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
    fstruct Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_"
      InitGroup -> CompilerM Multicore s ()
    forall op s. InitGroup -> CompilerM op s ()
    GC.decl [C.cdecl|struct $id:fstruct $id:fstruct';|]
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:fstruct'.ctx = ctx;|]
      [Stm] -> CompilerM Multicore s ()
    forall op s. [Stm] -> CompilerM op s ()
    GC.stms [C.cstms|$stms:(compileSetStructValues fstruct' free_args free_ctypes)|]
      [Stm] -> CompilerM Multicore s ()
    forall op s. [Stm] -> CompilerM op s ()
    GC.stms [C.cstms|$stms:(compileSetRetvalStructValues fstruct' retval_args retval_ctypes)|]
      Name -> CompilerM Multicore s Name
    forall a. a -> CompilerM Multicore s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Name
    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
      [(Type, ValueType)]
    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
      [(Type, ValueType)]
    retval_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]
    retvals
      let free_args :: [VName]
    free_args = (Param -> VName) -> [Param] -> [VName]
    forall a b. (a -> b) -> [a] -> [b]
    map Param -> VName
    paramName [Param]
    params
          retval_args :: [VName]
    retval_args = (Param -> VName) -> [Param] -> [VName]
    forall a b. (a -> b) -> [a] -> [b]
    map Param -> VName
    paramName [Param]
    retvals
          free :: [(VName, (Type, ValueType))]
    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))]
    retval = [VName] -> [(Type, ValueType)] -> [(VName, (Type, ValueType))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [VName]
    retval_args [(Type, ValueType)]
    retval_ctypes

      Exp
    e' <- Exp -> CompilerM Multicore s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp Exp
    e

      let lexical :: Map VName Space
    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

      Name
    fstruct <-
        DefSpecifier s
    -> String
    -> [VName]
    -> [(Type, ValueType)]
    -> [VName]
    -> [(Type, ValueType)]
    -> CompilerM Multicore s Name
    forall s.
    DefSpecifier s
    -> String
    -> [VName]
    -> [(Type, ValueType)]
    -> [VName]
    -> [(Type, ValueType)]
    -> CompilerM Multicore s Name
    prepareTaskStruct DefSpecifier s
    forall s. DefSpecifier s
    multicoreDef String
    "task" [VName]
    free_args [(Type, ValueType)]
    free_ctypes [VName]
    retval_args [(Type, ValueType)]
    retval_ctypes

      Name
    fpar_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 (String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_task") MCCode
    seq_code Name
    fstruct [(VName, (Type, ValueType))]
    free [(VName, (Type, ValueType))]
    retval
      Name -> CompilerM Multicore s ()
    forall op s. Name -> CompilerM op s ()
    addTimingFields Name
    fpar_task

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

      case Scheduling
    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 Maybe ParallelTask
    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
          Name
    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
          Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    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
    ftask_err = Name
    fpar_task Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_err"
          code :: [BlockItem]
    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;
                      }|]

      (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 [BlockItem]
    code
    compileOp (ParLoop String
    s' MCCode
    body [Param]
    free) = do
      [(Type, ValueType)]
    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 :: [VName]
    free_args = (Param -> VName) -> [Param] -> [VName]
    forall a b. (a -> b) -> [a] -> [b]
    map Param -> VName
    paramName [Param]
    free

      let lexical :: Map VName Space
    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

      Name
    fstruct <-
        DefSpecifier s
    -> String
    -> [VName]
    -> [(Type, ValueType)]
    -> [VName]
    -> [(Type, ValueType)]
    -> CompilerM Multicore s Name
    forall s.
    DefSpecifier s
    -> String
    -> [VName]
    -> [(Type, ValueType)]
    -> [VName]
    -> [(Type, ValueType)]
    -> CompilerM Multicore s Name
    prepareTaskStruct DefSpecifier s
    forall s. DefSpecifier s
    multicoreDef (String
    s' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_parloop_struct") [VName]
    free_args [(Type, ValueType)]
    free_ctypes [VName]
    forall a. Monoid a => a
    mempty [(Type, ValueType)]
    forall a. Monoid a => a
    mempty

      Name
    ftask <- DefSpecifier s
    forall s. DefSpecifier s
    multicoreDef (String
    s' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_parloop") ((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
        [BlockItem]
    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;|]

            [BlockItem]
    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

            (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 [BlockItem]
    decl_cached
            (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 ([BlockItem] -> CompilerM Multicore s ())
    -> CompilerM Multicore s [BlockItem] -> CompilerM Multicore s ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< CompilerM Multicore s [BlockItem]
    forall op s. CompilerM op s [BlockItem]
    GC.declAllocatedMem
            [BlockItem]
    free_mem <- CompilerM Multicore s [BlockItem]
    forall op s. CompilerM op s [BlockItem]
    GC.freeAllocatedMem
            (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 [BlockItem]
    body'
            Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|cleanup: {$stms:free_cached $items:free_mem}|]
        Definition -> CompilerM Multicore s Definition
    forall a. a -> CompilerM Multicore s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    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
    ftask Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_task"
      InitGroup -> CompilerM Multicore s ()
    forall op s. InitGroup -> CompilerM op s ()
    GC.decl [C.cdecl|struct scheduler_parloop $id:ftask_name;|]
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:ftask_name.name = $string:(nameToString ftask);|]
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:ftask_name.fn = $id:ftask;|]
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:ftask_name.args = &$id:(fstruct <> "_");|]
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:ftask_name.iterations = iterations;|]
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    GC.stm [C.cstm|$id:ftask_name.info = info;|]

      let ftask_err :: Name
    ftask_err = Name
    ftask Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_err"
          ftask_total :: Name
    ftask_total = Name
    ftask Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> Name
    "_total"
      [BlockItem]
    code' <-
        Name -> [BlockItem] -> CompilerM Multicore s [BlockItem]
    forall op s. Name -> [BlockItem] -> CompilerM op s [BlockItem]
    benchmarkCode
          Name
    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;
                   }|]

      (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 [BlockItem]
    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
      Exp
    from' <- Exp -> CompilerM Multicore s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp Exp
    from
      Exp
    bound' <- Exp -> CompilerM Multicore s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp Exp
    bound
      [BlockItem]
    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
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    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
      Exp
    tar' <- Exp -> CompilerM Multicore s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp Exp
    tar
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    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
      [BlockItem]
    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
      Stm -> CompilerM Multicore s ()
    forall op s. Stm -> CompilerM op s ()
    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
      Exp
    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
      Exp
    val' <- Exp -> CompilerM op s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp Exp
    val
      Type
    cast <- Type -> VName -> CompilerM op s Type
    castf Type
    ty VName
    arr
      Exp
    arr' <- VName -> CompilerM op s Exp
    forall op s. VName -> CompilerM op s Exp
    GC.rawMem VName
    arr
      Stm -> CompilerM op s ()
    forall op s. Stm -> CompilerM op s ()
    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
      Exp
    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
      Exp
    new_val' <- Exp -> CompilerM op s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp Exp
    val
      Type
    cast <- Type -> VName -> CompilerM op s Type
    castf [C.cty|$ty:(GC.primTypeToCType t)|] VName
    arr
      Exp
    arr' <- VName -> CompilerM op s Exp
    forall op s. VName -> CompilerM op s Exp
    GC.rawMem VName
    arr
      Stm -> CompilerM op s ()
    forall op s. Stm -> CompilerM op s ()
    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
      Exp
    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
      Exp
    val' <- Exp -> CompilerM op s Exp
    forall op s. Exp -> CompilerM op s Exp
    GC.compileExp Exp
    val
      Type
    cast <- Type -> VName -> CompilerM op s Type
    castf [C.cty|$ty:(GC.primTypeToCType t)|] VName
    arr
      Stm -> CompilerM op s ()
    forall op s. Stm -> CompilerM op s ()
    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