    -- | Definition of the core compiler driver building blocks.  The
    -- spine of the compiler is the 'FutharkM' monad, although note that
    -- individual passes are pure functions, and do not use the 'FutharkM'
    -- monad (see "Futhark.Pass").
    --
    -- Running the compiler involves producing an initial IR program (see
    -- "Futhark.Compiler.Program"), running a 'Pipeline' to produce a
    -- final program (still in IR), then running an 'Action', which is
    -- usually a code generator.
    module Futhark.Pipeline
      ( Pipeline,
        PipelineConfig (..),
        Action (..),
        FutharkM,
        runFutharkM,
        Verbosity (..),
        module Futhark.Error,
        onePass,
        passes,
        condPipeline,
        runPipeline,
      )
    where

    import Control.Category
    import Control.Exception (SomeException, catch, throwIO)
    import Control.Monad
    import Control.Monad.Except
    import Control.Monad.Reader
    import Control.Monad.State
    import Control.Parallel
    import Data.Text qualified as T
    import Data.Text.IO qualified as T
    import Data.Time.Clock
    import Futhark.Analysis.Alias qualified as Alias
    import Futhark.Compiler.Config (Verbosity (..))
    import Futhark.Error
    import Futhark.IR (PrettyRep, Prog)
    import Futhark.IR.TypeCheck
    import Futhark.MonadFreshNames
    import Futhark.Pass
    import Futhark.Util.Log
    import Futhark.Util.Pretty (prettyText)
    import System.IO
    import Text.Printf
    import Prelude hiding (id, (.))

    newtype FutharkEnv = FutharkEnv {FutharkEnv -> Verbosity
    futharkVerbose :: Verbosity}

    data FutharkState = FutharkState
      { FutharkState -> UTCTime
    futharkPrevLog :: UTCTime,
        FutharkState -> VNameSource
    futharkNameSource :: VNameSource
      }

    -- | The main Futhark compiler driver monad - basically some state
    -- tracking on top if 'IO'.
    newtype FutharkM a = FutharkM (ExceptT CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a)
      deriving
        ( Functor FutharkM
    Functor FutharkM =>
    (forall a. a -> FutharkM a)
    -> (forall a b. FutharkM (a -> b) -> FutharkM a -> FutharkM b)
    -> (forall a b c.
        (a -> b -> c) -> FutharkM a -> FutharkM b -> FutharkM c)
    -> (forall a b. FutharkM a -> FutharkM b -> FutharkM b)
    -> (forall a b. FutharkM a -> FutharkM b -> FutharkM a)
    -> Applicative FutharkM
    forall a. a -> FutharkM a
    forall a b. FutharkM a -> FutharkM b -> FutharkM a
    forall a b. FutharkM a -> FutharkM b -> FutharkM b
    forall a b. FutharkM (a -> b) -> FutharkM a -> FutharkM b
    forall a b c.
    (a -> b -> c) -> FutharkM a -> FutharkM b -> FutharkM c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> FutharkM a
    pure :: forall a. a -> FutharkM a
    $c<*> :: forall a b. FutharkM (a -> b) -> FutharkM a -> FutharkM b
    <*> :: forall a b. FutharkM (a -> b) -> FutharkM a -> FutharkM b
    $cliftA2 :: forall a b c.
    (a -> b -> c) -> FutharkM a -> FutharkM b -> FutharkM c
    liftA2 :: forall a b c.
    (a -> b -> c) -> FutharkM a -> FutharkM b -> FutharkM c
    $c*> :: forall a b. FutharkM a -> FutharkM b -> FutharkM b
    *> :: forall a b. FutharkM a -> FutharkM b -> FutharkM b
    $c<* :: forall a b. FutharkM a -> FutharkM b -> FutharkM a
    <* :: forall a b. FutharkM a -> FutharkM b -> FutharkM a
    Applicative,
          (forall a b. (a -> b) -> FutharkM a -> FutharkM b)
    -> (forall a b. a -> FutharkM b -> FutharkM a) -> Functor FutharkM
    forall a b. a -> FutharkM b -> FutharkM a
    forall a b. (a -> b) -> FutharkM a -> FutharkM b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> FutharkM a -> FutharkM b
    fmap :: forall a b. (a -> b) -> FutharkM a -> FutharkM b
    $c<$ :: forall a b. a -> FutharkM b -> FutharkM a
    <$ :: forall a b. a -> FutharkM b -> FutharkM a
    Functor,
          Applicative FutharkM
    Applicative FutharkM =>
    (forall a b. FutharkM a -> (a -> FutharkM b) -> FutharkM b)
    -> (forall a b. FutharkM a -> FutharkM b -> FutharkM b)
    -> (forall a. a -> FutharkM a)
    -> Monad FutharkM
    forall a. a -> FutharkM a
    forall a b. FutharkM a -> FutharkM b -> FutharkM b
    forall a b. FutharkM a -> (a -> FutharkM b) -> FutharkM b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. FutharkM a -> (a -> FutharkM b) -> FutharkM b
    >>= :: forall a b. FutharkM a -> (a -> FutharkM b) -> FutharkM b
    $c>> :: forall a b. FutharkM a -> FutharkM b -> FutharkM b
    >> :: forall a b. FutharkM a -> FutharkM b -> FutharkM b
    $creturn :: forall a. a -> FutharkM a
    return :: forall a. a -> FutharkM a
    Monad,
          MonadError CompilerError,
          MonadState FutharkState,
          MonadReader FutharkEnv,
          Monad FutharkM
    Monad FutharkM =>
    (forall a. IO a -> FutharkM a) -> MonadIO FutharkM
    forall a. IO a -> FutharkM a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> FutharkM a
    liftIO :: forall a. IO a -> FutharkM a
    MonadIO
        )

    instance MonadFreshNames FutharkM where
      getNameSource :: FutharkM VNameSource
    getNameSource = (FutharkState -> VNameSource) -> FutharkM VNameSource
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FutharkState -> VNameSource
    futharkNameSource
      putNameSource :: VNameSource -> FutharkM ()
    putNameSource VNameSource
    src = (FutharkState -> FutharkState) -> FutharkM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((FutharkState -> FutharkState) -> FutharkM ())
    -> (FutharkState -> FutharkState) -> FutharkM ()
    forall a b. (a -> b) -> a -> b
    $ \FutharkState
    s -> FutharkState
    s {futharkNameSource = src}

    instance MonadLogger FutharkM where
      addLog :: Log -> FutharkM ()
    addLog = (Text -> FutharkM ()) -> [Text] -> FutharkM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Text -> FutharkM ()
    forall {m :: * -> *}.
    (MonadReader FutharkEnv m, MonadState FutharkState m, MonadIO m) =>
    Text -> m ()
    perLine ([Text] -> FutharkM ()) -> (Log -> [Text]) -> Log -> FutharkM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Text -> [Text]
    T.lines (Text -> [Text]) -> (Log -> Text) -> Log -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Log -> Text
    toText
        where
          perLine :: Text -> m ()
    perLine Text
    msg = do
            verb <- (FutharkEnv -> Bool) -> m Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ((FutharkEnv -> Bool) -> m Bool) -> (FutharkEnv -> Bool) -> m Bool
    forall a b. (a -> b) -> a -> b
    $ (Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    Verbose) (Verbosity -> Bool)
    -> (FutharkEnv -> Verbosity) -> FutharkEnv -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . FutharkEnv -> Verbosity
    futharkVerbose
            prev <- gets futharkPrevLog
            now <- liftIO getCurrentTime
            let delta :: Double
                delta = Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational (Rational -> Double) -> Rational -> Double
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> Rational
    forall a. Real a => a -> Rational
    toRational (UTCTime
    now UTCTime -> UTCTime -> NominalDiffTime
    `diffUTCTime` UTCTime
    prev)
                prefix = String -> Double -> String
    forall r. PrintfType r => String -> r
    printf String
    "[  +%7.3f] " Double
    delta
            modify $ \FutharkState
    s -> FutharkState
    s {futharkPrevLog = now}
            when verb $ liftIO $ T.hPutStrLn stderr $ T.pack prefix <> msg

    runFutharkM' ::
      FutharkM a ->
      FutharkState ->
      FutharkEnv ->
      IO (Either CompilerError a, FutharkState)
    runFutharkM' :: forall a.
    FutharkM a
    -> FutharkState
    -> FutharkEnv
    -> IO (Either CompilerError a, FutharkState)
    runFutharkM' (FutharkM ExceptT
      CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    m) FutharkState
    s =
      ReaderT FutharkEnv IO (Either CompilerError a, FutharkState)
    -> FutharkEnv -> IO (Either CompilerError a, FutharkState)
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (StateT
      FutharkState (ReaderT FutharkEnv IO) (Either CompilerError a)
    -> FutharkState
    -> ReaderT FutharkEnv IO (Either CompilerError a, FutharkState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (ExceptT
      CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    -> StateT
         FutharkState (ReaderT FutharkEnv IO) (Either CompilerError a)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT ExceptT
      CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    m) FutharkState
    s)

    -- | Run a 'FutharkM' action.
    runFutharkM :: FutharkM a -> Verbosity -> IO (Either CompilerError a)
    runFutharkM :: forall a. FutharkM a -> Verbosity -> IO (Either CompilerError a)
    runFutharkM FutharkM a
    m Verbosity
    verbose = do
      s <- UTCTime -> VNameSource -> FutharkState
    FutharkState (UTCTime -> VNameSource -> FutharkState)
    -> IO UTCTime -> IO (VNameSource -> FutharkState)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO UTCTime
    getCurrentTime IO (VNameSource -> FutharkState)
    -> IO VNameSource -> IO FutharkState
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> VNameSource -> IO VNameSource
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure VNameSource
    blankNameSource
      fst <$> runFutharkM' m s (FutharkEnv verbose)

    catchIO :: FutharkM a -> (SomeException -> FutharkM a) -> FutharkM a
    catchIO :: forall a. FutharkM a -> (SomeException -> FutharkM a) -> FutharkM a
    catchIO FutharkM a
    m SomeException -> FutharkM a
    f = ExceptT
      CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    -> FutharkM a
    forall a.
    ExceptT
      CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    -> FutharkM a
    FutharkM (ExceptT
       CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
     -> FutharkM a)
    -> ExceptT
         CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    -> FutharkM a
    forall a b. (a -> b) -> a -> b
    $ do
      s <- ExceptT
      CompilerError
      (StateT FutharkState (ReaderT FutharkEnv IO))
      FutharkState
    forall s (m :: * -> *). MonadState s m => m s
    get
      env <- ask
      (x, s') <-
        liftIO $
          runFutharkM' m s env `catch` \SomeException
    e ->
            FutharkM a
    -> FutharkState
    -> FutharkEnv
    -> IO (Either CompilerError a, FutharkState)
    forall a.
    FutharkM a
    -> FutharkState
    -> FutharkEnv
    -> IO (Either CompilerError a, FutharkState)
    runFutharkM' (SomeException -> FutharkM a
    f SomeException
    e) FutharkState
    s FutharkEnv
    env
      put s'
      case x of
        Left CompilerError
    e -> CompilerError
    -> ExceptT
         CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    forall a.
    CompilerError
    -> ExceptT
         CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError CompilerError
    e
        Right a
    x' -> a
    -> ExceptT
         CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    forall a.
    a
    -> ExceptT
         CompilerError (StateT FutharkState (ReaderT FutharkEnv IO)) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    x'

    -- | A compilation always ends with some kind of action.
    data Action rep = Action
      { forall rep. Action rep -> String
    actionName :: String,
        forall rep. Action rep -> String
    actionDescription :: String,
        forall rep. Action rep -> Prog rep -> FutharkM ()
    actionProcedure :: Prog rep -> FutharkM ()
      }

    -- | Configuration object for running a compiler pipeline.
    data PipelineConfig = PipelineConfig
      { PipelineConfig -> Bool
    pipelineVerbose :: Bool,
        PipelineConfig -> Bool
    pipelineValidate :: Bool
      }

    -- | A compiler pipeline is conceptually a function from programs to
    -- programs, where the actual representation may change.  Pipelines
    -- can be composed using their 'Category' instance.
    newtype Pipeline fromrep torep = Pipeline
      { forall fromrep torep.
    Pipeline fromrep torep
    -> forall a.
       PipelineConfig
       -> Prog fromrep
       -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a)
    unPipeline ::
          forall a.
          PipelineConfig ->
          Prog fromrep ->
          FutharkM ((Prog torep -> FutharkM a) -> FutharkM a)
      }

    instance Category Pipeline where
      id :: forall a. Pipeline a a
    id = (forall a.
     PipelineConfig
     -> Prog a -> FutharkM ((Prog a -> FutharkM a) -> FutharkM a))
    -> Pipeline a a
    forall fromrep torep.
    (forall a.
     PipelineConfig
     -> Prog fromrep
     -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a))
    -> Pipeline fromrep torep
    Pipeline ((forall a.
      PipelineConfig
      -> Prog a -> FutharkM ((Prog a -> FutharkM a) -> FutharkM a))
     -> Pipeline a a)
    -> (forall a.
        PipelineConfig
        -> Prog a -> FutharkM ((Prog a -> FutharkM a) -> FutharkM a))
    -> Pipeline a a
    forall a b. (a -> b) -> a -> b
    $ \PipelineConfig
    _ Prog a
    prog -> ((Prog a -> FutharkM a) -> FutharkM a)
    -> FutharkM ((Prog a -> FutharkM a) -> FutharkM a)
    forall a. a -> FutharkM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (((Prog a -> FutharkM a) -> FutharkM a)
     -> FutharkM ((Prog a -> FutharkM a) -> FutharkM a))
    -> ((Prog a -> FutharkM a) -> FutharkM a)
    -> FutharkM ((Prog a -> FutharkM a) -> FutharkM a)
    forall a b. (a -> b) -> a -> b
    $ \Prog a -> FutharkM a
    c -> Prog a -> FutharkM a
    c Prog a
    prog
      Pipeline b c
    p2 . :: forall b c a. Pipeline b c -> Pipeline a b -> Pipeline a c
    . Pipeline a b
    p1 = (forall a.
     PipelineConfig
     -> Prog a -> FutharkM ((Prog c -> FutharkM a) -> FutharkM a))
    -> Pipeline a c
    forall fromrep torep.
    (forall a.
     PipelineConfig
     -> Prog fromrep
     -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a))
    -> Pipeline fromrep torep
    Pipeline PipelineConfig
    -> Prog a -> FutharkM ((Prog c -> FutharkM a) -> FutharkM a)
    forall a.
    PipelineConfig
    -> Prog a -> FutharkM ((Prog c -> FutharkM a) -> FutharkM a)
    perform
        where
          perform :: PipelineConfig
    -> Prog a -> FutharkM ((Prog c -> FutharkM a) -> FutharkM a)
    perform PipelineConfig
    cfg Prog a
    prog = do
            rc <- Pipeline a b
    -> forall a.
       PipelineConfig
       -> Prog a -> FutharkM ((Prog b -> FutharkM a) -> FutharkM a)
    forall fromrep torep.
    Pipeline fromrep torep
    -> forall a.
       PipelineConfig
       -> Prog fromrep
       -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a)
    unPipeline Pipeline a b
    p1 PipelineConfig
    cfg Prog a
    prog
            rc $ unPipeline p2 cfg

    -- | Run the pipeline on the given program.
    runPipeline ::
      Pipeline fromrep torep ->
      PipelineConfig ->
      Prog fromrep ->
      FutharkM (Prog torep)
    runPipeline :: forall fromrep torep.
    Pipeline fromrep torep
    -> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
    runPipeline Pipeline fromrep torep
    p PipelineConfig
    cfg Prog fromrep
    prog = do
      rc <- Pipeline fromrep torep
    -> forall a.
       PipelineConfig
       -> Prog fromrep
       -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a)
    forall fromrep torep.
    Pipeline fromrep torep
    -> forall a.
       PipelineConfig
       -> Prog fromrep
       -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a)
    unPipeline Pipeline fromrep torep
    p PipelineConfig
    cfg Prog fromrep
    prog
      rc pure

    -- | Construct a pipeline from a single compiler pass.
    onePass ::
      (Checkable torep) =>
      Pass fromrep torep ->
      Pipeline fromrep torep
    onePass :: forall torep fromrep.
    Checkable torep =>
    Pass fromrep torep -> Pipeline fromrep torep
    onePass Pass fromrep torep
    pass = (forall a.
     PipelineConfig
     -> Prog fromrep
     -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a))
    -> Pipeline fromrep torep
    forall fromrep torep.
    (forall a.
     PipelineConfig
     -> Prog fromrep
     -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a))
    -> Pipeline fromrep torep
    Pipeline PipelineConfig
    -> Prog fromrep
    -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a)
    forall a.
    PipelineConfig
    -> Prog fromrep
    -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a)
    perform
      where
        perform :: PipelineConfig
    -> Prog fromrep
    -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a)
    perform PipelineConfig
    cfg Prog fromrep
    prog = do
          Bool -> FutharkM () -> FutharkM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (PipelineConfig -> Bool
    pipelineVerbose PipelineConfig
    cfg) (FutharkM () -> FutharkM ())
    -> (Text -> FutharkM ()) -> Text -> FutharkM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Text -> FutharkM ()
    forall a. ToLog a => a -> FutharkM ()
    forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
    logMsg (Text -> FutharkM ()) -> Text -> FutharkM ()
    forall a b. (a -> b) -> a -> b
    $
            Text
    "Running pass: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Pass fromrep torep -> String
    forall fromrep torep. Pass fromrep torep -> String
    passName Pass fromrep torep
    pass)
          prog' <- Pass fromrep torep -> Prog fromrep -> FutharkM (Prog torep)
    forall fromrep torep.
    Pass fromrep torep -> Prog fromrep -> FutharkM (Prog torep)
    runPass Pass fromrep torep
    pass Prog fromrep
    prog
          -- Spark validation in a separate task and speculatively execute
          -- next pass.  If the next pass throws an exception, we better
          -- be ready to catch it and check if it might be because the
          -- program was actually ill-typed.
          let check =
                if PipelineConfig -> Bool
    pipelineValidate PipelineConfig
    cfg
                  then Prog torep -> Either (Prog (Aliases torep), TypeError torep) ()
    forall {rep}.
    Checkable rep =>
    Prog rep -> Either (Prog (Aliases rep), TypeError rep) ()
    validate Prog torep
    prog'
                  else () -> Either (Prog (Aliases torep), TypeError torep) ()
    forall a b. b -> Either a b
    Right ()
          par check $ pure $ \Prog torep -> FutharkM a
    c ->
            (Either (Prog (Aliases torep), TypeError torep) ()
    -> (a -> FutharkM a) -> a -> FutharkM a
    forall {rep} {a} {b} {t} {a}.
    (PrettyRep rep, Show a) =>
    Either (Prog rep, a) b -> (t -> FutharkM a) -> t -> FutharkM a
    errorOnError Either (Prog (Aliases torep), TypeError torep) ()
    check a -> FutharkM a
    forall a. a -> FutharkM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a -> FutharkM a) -> FutharkM a -> FutharkM a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Prog torep -> FutharkM a
    c Prog torep
    prog')
              FutharkM a -> (SomeException -> FutharkM a) -> FutharkM a
    forall a. FutharkM a -> (SomeException -> FutharkM a) -> FutharkM a
    `catchIO` Either (Prog (Aliases torep), TypeError torep) ()
    -> (SomeException -> FutharkM a) -> SomeException -> FutharkM a
    forall {rep} {a} {b} {t} {a}.
    (PrettyRep rep, Show a) =>
    Either (Prog rep, a) b -> (t -> FutharkM a) -> t -> FutharkM a
    errorOnError Either (Prog (Aliases torep), TypeError torep) ()
    check (IO a -> FutharkM a
    forall a. IO a -> FutharkM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> FutharkM a)
    -> (SomeException -> IO a) -> SomeException -> FutharkM a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . SomeException -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO)
        validate :: Prog rep -> Either (Prog (Aliases rep), TypeError rep) ()
    validate Prog rep
    prog =
          let prog' :: Prog (Aliases rep)
    prog' = Prog rep -> Prog (Aliases rep)
    forall rep. AliasableRep rep => Prog rep -> Prog (Aliases rep)
    Alias.aliasAnalysis Prog rep
    prog
           in case Prog (Aliases rep) -> Either (TypeError rep) ()
    forall rep.
    Checkable rep =>
    Prog (Aliases rep) -> Either (TypeError rep) ()
    checkProg Prog (Aliases rep)
    prog' of
                Left TypeError rep
    err -> (Prog (Aliases rep), TypeError rep)
    -> Either (Prog (Aliases rep), TypeError rep) ()
    forall a b. a -> Either a b
    Left (Prog (Aliases rep)
    prog', TypeError rep
    err)
                Right () -> () -> Either (Prog (Aliases rep), TypeError rep) ()
    forall a b. b -> Either a b
    Right ()
        errorOnError :: Either (Prog rep, a) b -> (t -> FutharkM a) -> t -> FutharkM a
    errorOnError (Left (Prog rep
    prog, a
    err)) t -> FutharkM a
    _ t
    _ =
          Pass fromrep torep -> Prog rep -> String -> FutharkM a
    forall rep fromrep torep a.
    PrettyRep rep =>
    Pass fromrep torep -> Prog rep -> String -> FutharkM a
    validationError Pass fromrep torep
    pass Prog rep
    prog (String -> FutharkM a) -> String -> FutharkM a
    forall a b. (a -> b) -> a -> b
    $ a -> String
    forall a. Show a => a -> String
    show a
    err
        errorOnError Either (Prog rep, a) b
    _ t -> FutharkM a
    c t
    x = t -> FutharkM a
    c t
    x

    -- | Conditionally run pipeline if predicate is true.
    condPipeline ::
      (Prog rep -> Bool) -> Pipeline rep rep -> Pipeline rep rep
    condPipeline :: forall rep.
    (Prog rep -> Bool) -> Pipeline rep rep -> Pipeline rep rep
    condPipeline Prog rep -> Bool
    cond (Pipeline forall a.
    PipelineConfig
    -> Prog rep -> FutharkM ((Prog rep -> FutharkM a) -> FutharkM a)
    f) =
      (forall a.
     PipelineConfig
     -> Prog rep -> FutharkM ((Prog rep -> FutharkM a) -> FutharkM a))
    -> Pipeline rep rep
    forall fromrep torep.
    (forall a.
     PipelineConfig
     -> Prog fromrep
     -> FutharkM ((Prog torep -> FutharkM a) -> FutharkM a))
    -> Pipeline fromrep torep
    Pipeline ((forall a.
      PipelineConfig
      -> Prog rep -> FutharkM ((Prog rep -> FutharkM a) -> FutharkM a))
     -> Pipeline rep rep)
    -> (forall a.
        PipelineConfig
        -> Prog rep -> FutharkM ((Prog rep -> FutharkM a) -> FutharkM a))
    -> Pipeline rep rep
    forall a b. (a -> b) -> a -> b
    $ \PipelineConfig
    cfg Prog rep
    prog ->
        if Prog rep -> Bool
    cond Prog rep
    prog
          then PipelineConfig
    -> Prog rep -> FutharkM ((Prog rep -> FutharkM a) -> FutharkM a)
    forall a.
    PipelineConfig
    -> Prog rep -> FutharkM ((Prog rep -> FutharkM a) -> FutharkM a)
    f PipelineConfig
    cfg Prog rep
    prog
          else ((Prog rep -> FutharkM a) -> FutharkM a)
    -> FutharkM ((Prog rep -> FutharkM a) -> FutharkM a)
    forall a. a -> FutharkM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (((Prog rep -> FutharkM a) -> FutharkM a)
     -> FutharkM ((Prog rep -> FutharkM a) -> FutharkM a))
    -> ((Prog rep -> FutharkM a) -> FutharkM a)
    -> FutharkM ((Prog rep -> FutharkM a) -> FutharkM a)
    forall a b. (a -> b) -> a -> b
    $ \Prog rep -> FutharkM a
    c -> Prog rep -> FutharkM a
    c Prog rep
    prog

    -- | Create a pipeline from a list of passes.
    passes ::
      (Checkable rep) =>
      [Pass rep rep] ->
      Pipeline rep rep
    passes :: forall rep. Checkable rep => [Pass rep rep] -> Pipeline rep rep
    passes = (Pipeline rep rep -> Pipeline rep rep -> Pipeline rep rep)
    -> Pipeline rep rep -> [Pipeline rep rep] -> Pipeline rep rep
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Pipeline rep rep -> Pipeline rep rep -> Pipeline rep rep
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    (>>>) Pipeline rep rep
    forall a. Pipeline a a
    forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id ([Pipeline rep rep] -> Pipeline rep rep)
    -> ([Pass rep rep] -> [Pipeline rep rep])
    -> [Pass rep rep]
    -> Pipeline rep rep
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Pass rep rep -> Pipeline rep rep)
    -> [Pass rep rep] -> [Pipeline rep rep]
    forall a b. (a -> b) -> [a] -> [b]
    map Pass rep rep -> Pipeline rep rep
    forall torep fromrep.
    Checkable torep =>
    Pass fromrep torep -> Pipeline fromrep torep
    onePass

    validationError ::
      (PrettyRep rep) =>
      Pass fromrep torep ->
      Prog rep ->
      String ->
      FutharkM a
    validationError :: forall rep fromrep torep a.
    PrettyRep rep =>
    Pass fromrep torep -> Prog rep -> String -> FutharkM a
    validationError Pass fromrep torep
    pass Prog rep
    prog String
    err =
      CompilerError -> FutharkM a
    forall a. CompilerError -> FutharkM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (CompilerError -> FutharkM a) -> CompilerError -> FutharkM a
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> ErrorClass -> CompilerError
    InternalError Text
    msg (Prog rep -> Text
    forall a. Pretty a => a -> Text
    prettyText Prog rep
    prog) ErrorClass
    CompilerBug
      where
        msg :: Text
    msg = Text
    "Type error after pass '" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Pass fromrep torep -> String
    forall fromrep torep. Pass fromrep torep -> String
    passName Pass fromrep torep
    pass) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "':\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack String
    err

    runPass ::
      Pass fromrep torep ->
      Prog fromrep ->
      FutharkM (Prog torep)
    runPass :: forall fromrep torep.
    Pass fromrep torep -> Prog fromrep -> FutharkM (Prog torep)
    runPass Pass fromrep torep
    pass Prog fromrep
    prog = do
      (prog', logged) <- PassM (Prog torep) -> FutharkM (Prog torep, Log)
    forall (m :: * -> *) a. MonadFreshNames m => PassM a -> m (a, Log)
    runPassM (Pass fromrep torep -> Prog fromrep -> PassM (Prog torep)
    forall fromrep torep.
    Pass fromrep torep -> Prog fromrep -> PassM (Prog torep)
    passFunction Pass fromrep torep
    pass Prog fromrep
    prog)
      verb <- asks $ (>= VeryVerbose) . futharkVerbose
      when verb $ addLog logged
      pure prog'