    -- {-# OPTIONS -fwarn-unused-binds #-}

    {-| The translation of abstract syntax to concrete syntax has two purposes.
        First it allows us to pretty print abstract syntax values without having to
        write a dedicated pretty printer, and second it serves as a sanity check
        for the concrete to abstract translation: translating from concrete to
        abstract and then back again should be (more or less) the identity.
    -}
    module Agda.Syntax.Translation.AbstractToConcrete
        ( ToConcrete(..)
        , toConcreteCtx
        , MonadAbsToCon
        , abstractToConcrete_
        , abstractToConcreteCtx
        , abstractToConcreteHiding
        , abstractToConcreteQName
        , abstractToConcreteScope
        , abstractToConcreteTelescope
        , abstractToConcreteUnqualify
        , RangeAndPragma(..)
        , noTakenNames
        ) where

    import Prelude hiding (null)

    import Control.Monad.Except ( runExceptT )
    import Control.Monad.Reader ( MonadReader(..), asks, ReaderT, runReaderT )
    import Control.Monad.State  ( StateT(..), runStateT )

    import Data.Bifunctor       ( first )
    import qualified Data.Map as Map
    import Data.Maybe
    import Data.Monoid
    import Data.Set (Set)
    import qualified Data.Set as Set
    import Data.Map (Map)
    import qualified Data.Foldable as Fold
    import Data.Void
    import Data.List (sortBy)
    import Data.Semigroup ( sconcat )
    import Data.String

    import Agda.Syntax.Common
    import Agda.Syntax.Common.Pretty
    import Agda.Syntax.Position
    import Agda.Syntax.Literal
    import Agda.Syntax.Info as A
    import qualified Agda.Syntax.Internal as I
    import Agda.Syntax.Fixity
    import Agda.Syntax.Concrete as C
    import Agda.Syntax.Concrete.Pattern as C
    import Agda.Syntax.Concrete.Glyph
    import Agda.Syntax.Abstract as A
    import Agda.Syntax.Abstract.Views as A
    import Agda.Syntax.Abstract.Pattern as A
    import Agda.Syntax.Abstract.PatternSynonyms
    import Agda.Syntax.Scope.Base
    import Agda.Syntax.Scope.Monad ( tryResolveName )

    import Agda.TypeChecking.Monad.State (getScope, getAllPatternSyns)
    import Agda.TypeChecking.Monad.Base as I
    import Agda.TypeChecking.Monad.Context
    import Agda.TypeChecking.Monad.Debug
    import Agda.TypeChecking.Monad.Builtin
    import Agda.TypeChecking.Monad.MetaVars
    import Agda.TypeChecking.Monad.Pure
    import Agda.TypeChecking.Monad.Trace
    import Agda.TypeChecking.Monad.Signature
    import {-# SOURCE #-} Agda.TypeChecking.Records (isRecord)
    import {-# SOURCE #-} Agda.TypeChecking.Pretty (prettyTCM)
    import Agda.Interaction.Options

    import qualified Agda.Utils.AssocList as AssocList
    import Agda.Utils.Either
    import Agda.Utils.Function
    import Agda.Utils.Functor
    import Agda.Utils.Lens
    import Agda.Utils.List
    import Agda.Utils.List1 (List1, pattern (:|), (<|) )
    import Agda.Utils.List2 (List2, pattern List2)
    import qualified Agda.Utils.List1 as List1
    import Agda.Utils.Maybe
    import Agda.Utils.Monad
    import Agda.Utils.Null
    import qualified Agda.Syntax.Common.Aspect as Asp
    import Agda.Utils.Set1 (Set1)
    import qualified Agda.Utils.Set1 as Set1
    import Agda.Utils.Singleton
    import Agda.Utils.Suffix

    import Agda.Utils.Impossible

    ---------------------------------------------------------------------------
    -- * The Interface
    ---------------------------------------------------------------------------

    -- | Preconditions to run the AbstractToConcrete translation.
    --
    type MonadAbsToCon m =
      ( MonadFresh NameId m
      , MonadInteractionPoints m
      , MonadStConcreteNames m
      , HasOptions m
      , PureTCM m
      , IsString (m Doc)
      , Null (m Doc)
      , Semigroup (m Doc)
      )

    abstractToConcreteScope :: (ToConcrete a, MonadAbsToCon m)
      => ScopeInfo -> a -> m (ConOfAbs a)
    abstractToConcreteScope :: forall a (m :: * -> *).
    (ToConcrete a, MonadAbsToCon m) =>
    ScopeInfo -> a -> m (ConOfAbs a)
    abstractToConcreteScope ScopeInfo
    scope a
    a = ReaderT Env m (ConOfAbs a) -> Env -> m (ConOfAbs a)
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (AbsToConT m (ConOfAbs a) -> ReaderT Env m (ConOfAbs a)
    forall (m :: * -> *) a. AbsToConT m a -> ReaderT Env m a
    unAbsToCon (AbsToConT m (ConOfAbs a) -> ReaderT Env m (ConOfAbs a))
    -> AbsToConT m (ConOfAbs a) -> ReaderT Env m (ConOfAbs a)
    forall a b. (a -> b) -> a -> b
    $ a -> AbsToConT m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete a
    a) (Env -> m (ConOfAbs a)) -> m Env -> m (ConOfAbs a)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ScopeInfo -> m Env
    forall (m :: * -> *). MonadAbsToCon m => ScopeInfo -> m Env
    makeEnv ScopeInfo
    scope

    abstractToConcreteCtx :: (ToConcrete a, MonadAbsToCon m)
      => Precedence -> a -> m (ConOfAbs a)
    abstractToConcreteCtx :: forall a (m :: * -> *).
    (ToConcrete a, MonadAbsToCon m) =>
    Precedence -> a -> m (ConOfAbs a)
    abstractToConcreteCtx Precedence
    ctx a
    x = AbsToConT m (ConOfAbs a) -> m (ConOfAbs a)
    forall (m :: * -> *) c. MonadAbsToCon m => AbsToConT m c -> m c
    runAbsToCon (AbsToConT m (ConOfAbs a) -> m (ConOfAbs a))
    -> AbsToConT m (ConOfAbs a) -> m (ConOfAbs a)
    forall a b. (a -> b) -> a -> b
    $ Precedence -> AbsToConT m (ConOfAbs a) -> AbsToConT m (ConOfAbs a)
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    Precedence -> m a -> m a
    withPrecedence Precedence
    ctx (a -> AbsToConT m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete a
    x)

    abstractToConcrete_ :: (ToConcrete a, MonadAbsToCon m)
      => a -> m (ConOfAbs a)
    abstractToConcrete_ :: forall a (m :: * -> *).
    (ToConcrete a, MonadAbsToCon m) =>
    a -> m (ConOfAbs a)
    abstractToConcrete_ = AbsToConT m (ConOfAbs a) -> m (ConOfAbs a)
    forall (m :: * -> *) c. MonadAbsToCon m => AbsToConT m c -> m c
    runAbsToCon (AbsToConT m (ConOfAbs a) -> m (ConOfAbs a))
    -> (a -> AbsToConT m (ConOfAbs a)) -> a -> m (ConOfAbs a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> AbsToConT m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete

    abstractToConcreteHiding :: (LensHiding i, ToConcrete a, MonadAbsToCon m)
      => i -> a -> m (ConOfAbs a)
    abstractToConcreteHiding :: forall i a (m :: * -> *).
    (LensHiding i, ToConcrete a, MonadAbsToCon m) =>
    i -> a -> m (ConOfAbs a)
    abstractToConcreteHiding i
    i = AbsToConT m (ConOfAbs a) -> m (ConOfAbs a)
    forall (m :: * -> *) c. MonadAbsToCon m => AbsToConT m c -> m c
    runAbsToCon (AbsToConT m (ConOfAbs a) -> m (ConOfAbs a))
    -> (a -> AbsToConT m (ConOfAbs a)) -> a -> m (ConOfAbs a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> a -> AbsToConT m (ConOfAbs a)
    forall (m :: * -> *) h a.
    (MonadToConcrete m, LensHiding h, ToConcrete a) =>
    h -> a -> m (ConOfAbs a)
    toConcreteHiding i
    i

    abstractToConcreteTelescope :: MonadAbsToCon m
      => A.Telescope -> m [Maybe C.TypedBinding]
    abstractToConcreteTelescope :: forall (m :: * -> *).
    MonadAbsToCon m =>
    Telescope -> m [Maybe TypedBinding]
    abstractToConcreteTelescope Telescope
    tel = AbsToConT m [Maybe TypedBinding] -> m [Maybe TypedBinding]
    forall (m :: * -> *) c. MonadAbsToCon m => AbsToConT m c -> m c
    runAbsToCon (AbsToConT m [Maybe TypedBinding] -> m [Maybe TypedBinding])
    -> AbsToConT m [Maybe TypedBinding] -> m [Maybe TypedBinding]
    forall a b. (a -> b) -> a -> b
    $ Telescope
    -> (ConOfAbs Telescope -> AbsToConT m [Maybe TypedBinding])
    -> AbsToConT m [Maybe TypedBinding]
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Telescope -> (ConOfAbs Telescope -> m b) -> m b
    bindToConcrete Telescope
    tel [Maybe TypedBinding] -> AbsToConT m [Maybe TypedBinding]
    ConOfAbs Telescope -> AbsToConT m [Maybe TypedBinding]
    forall a. a -> AbsToConT m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    abstractToConcreteQName :: MonadAbsToCon m
      => AllowAmbiguousNames -> A.QName -> m (C.QName)
    abstractToConcreteQName :: forall (m :: * -> *).
    MonadAbsToCon m =>
    AllowAmbiguousNames -> QName -> m QName
    abstractToConcreteQName AllowAmbiguousNames
    amb = AbsToConT m QName -> m QName
    forall (m :: * -> *) c. MonadAbsToCon m => AbsToConT m c -> m c
    runAbsToCon (AbsToConT m QName -> m QName)
    -> (QName -> AbsToConT m QName) -> QName -> m QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AllowAmbiguousNames -> QName -> AbsToConT m QName
    forall (m :: * -> *).
    MonadToConcrete m =>
    AllowAmbiguousNames -> QName -> m QName
    lookupQName AllowAmbiguousNames
    amb

    abstractToConcreteUnqualify :: (ToConcrete a, MonadAbsToCon m)
      => a -> m (ConOfAbs a)
    abstractToConcreteUnqualify :: forall a (m :: * -> *).
    (ToConcrete a, MonadAbsToCon m) =>
    a -> m (ConOfAbs a)
    abstractToConcreteUnqualify = AbsToConT m (ConOfAbs a) -> m (ConOfAbs a)
    forall (m :: * -> *) c. MonadAbsToCon m => AbsToConT m c -> m c
    runAbsToCon (AbsToConT m (ConOfAbs a) -> m (ConOfAbs a))
    -> (a -> AbsToConT m (ConOfAbs a)) -> a -> m (ConOfAbs a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AbsToConT m (ConOfAbs a) -> AbsToConT m (ConOfAbs a)
    forall (m :: * -> *) a. MonadToConcrete m => m a -> m a
    doUnqualifyOutOfScopeNames (AbsToConT m (ConOfAbs a) -> AbsToConT m (ConOfAbs a))
    -> (a -> AbsToConT m (ConOfAbs a)) -> a -> AbsToConT m (ConOfAbs a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> AbsToConT m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete

    ---------------------------------------------------------------------------
    -- * The Monad for the implementation
    ---------------------------------------------------------------------------

    type MonadToConcrete m =
      ( MonadAbsToCon m
      , MonadReader Env m
      )

    newtype AbsToConT m a = AbsToCon { forall (m :: * -> *) a. AbsToConT m a -> ReaderT Env m a
    unAbsToCon :: ReaderT Env m a }
      deriving
        ( (forall a b. (a -> b) -> AbsToConT m a -> AbsToConT m b)
    -> (forall a b. a -> AbsToConT m b -> AbsToConT m a)
    -> Functor (AbsToConT m)
    forall a b. a -> AbsToConT m b -> AbsToConT m a
    forall a b. (a -> b) -> AbsToConT m a -> AbsToConT m b
    forall (m :: * -> *) a b.
    Functor m =>
    a -> AbsToConT m b -> AbsToConT m a
    forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> AbsToConT m a -> AbsToConT m b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> AbsToConT m a -> AbsToConT m b
    fmap :: forall a b. (a -> b) -> AbsToConT m a -> AbsToConT m b
    $c<$ :: forall (m :: * -> *) a b.
    Functor m =>
    a -> AbsToConT m b -> AbsToConT m a
    <$ :: forall a b. a -> AbsToConT m b -> AbsToConT m a
    Functor, Functor (AbsToConT m)
    Functor (AbsToConT m) =>
    (forall a. a -> AbsToConT m a)
    -> (forall a b.
        AbsToConT m (a -> b) -> AbsToConT m a -> AbsToConT m b)
    -> (forall a b c.
        (a -> b -> c) -> AbsToConT m a -> AbsToConT m b -> AbsToConT m c)
    -> (forall a b. AbsToConT m a -> AbsToConT m b -> AbsToConT m b)
    -> (forall a b. AbsToConT m a -> AbsToConT m b -> AbsToConT m a)
    -> Applicative (AbsToConT m)
    forall a. a -> AbsToConT m a
    forall a b. AbsToConT m a -> AbsToConT m b -> AbsToConT m a
    forall a b. AbsToConT m a -> AbsToConT m b -> AbsToConT m b
    forall a b. AbsToConT m (a -> b) -> AbsToConT m a -> AbsToConT m b
    forall a b c.
    (a -> b -> c) -> AbsToConT m a -> AbsToConT m b -> AbsToConT m 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
    forall (m :: * -> *). Applicative m => Functor (AbsToConT m)
    forall (m :: * -> *) a. Applicative m => a -> AbsToConT m a
    forall (m :: * -> *) a b.
    Applicative m =>
    AbsToConT m a -> AbsToConT m b -> AbsToConT m a
    forall (m :: * -> *) a b.
    Applicative m =>
    AbsToConT m a -> AbsToConT m b -> AbsToConT m b
    forall (m :: * -> *) a b.
    Applicative m =>
    AbsToConT m (a -> b) -> AbsToConT m a -> AbsToConT m b
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> c) -> AbsToConT m a -> AbsToConT m b -> AbsToConT m c
    $cpure :: forall (m :: * -> *) a. Applicative m => a -> AbsToConT m a
    pure :: forall a. a -> AbsToConT m a
    $c<*> :: forall (m :: * -> *) a b.
    Applicative m =>
    AbsToConT m (a -> b) -> AbsToConT m a -> AbsToConT m b
    <*> :: forall a b. AbsToConT m (a -> b) -> AbsToConT m a -> AbsToConT m b
    $cliftA2 :: forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> c) -> AbsToConT m a -> AbsToConT m b -> AbsToConT m c
    liftA2 :: forall a b c.
    (a -> b -> c) -> AbsToConT m a -> AbsToConT m b -> AbsToConT m c
    $c*> :: forall (m :: * -> *) a b.
    Applicative m =>
    AbsToConT m a -> AbsToConT m b -> AbsToConT m b
    *> :: forall a b. AbsToConT m a -> AbsToConT m b -> AbsToConT m b
    $c<* :: forall (m :: * -> *) a b.
    Applicative m =>
    AbsToConT m a -> AbsToConT m b -> AbsToConT m a
    <* :: forall a b. AbsToConT m a -> AbsToConT m b -> AbsToConT m a
    Applicative, Applicative (AbsToConT m)
    Applicative (AbsToConT m) =>
    (forall a b.
     AbsToConT m a -> (a -> AbsToConT m b) -> AbsToConT m b)
    -> (forall a b. AbsToConT m a -> AbsToConT m b -> AbsToConT m b)
    -> (forall a. a -> AbsToConT m a)
    -> Monad (AbsToConT m)
    forall a. a -> AbsToConT m a
    forall a b. AbsToConT m a -> AbsToConT m b -> AbsToConT m b
    forall a b. AbsToConT m a -> (a -> AbsToConT m b) -> AbsToConT m b
    forall (m :: * -> *). Monad m => Applicative (AbsToConT m)
    forall (m :: * -> *) a. Monad m => a -> AbsToConT m a
    forall (m :: * -> *) a b.
    Monad m =>
    AbsToConT m a -> AbsToConT m b -> AbsToConT m b
    forall (m :: * -> *) a b.
    Monad m =>
    AbsToConT m a -> (a -> AbsToConT m b) -> AbsToConT m 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 (m :: * -> *) a b.
    Monad m =>
    AbsToConT m a -> (a -> AbsToConT m b) -> AbsToConT m b
    >>= :: forall a b. AbsToConT m a -> (a -> AbsToConT m b) -> AbsToConT m b
    $c>> :: forall (m :: * -> *) a b.
    Monad m =>
    AbsToConT m a -> AbsToConT m b -> AbsToConT m b
    >> :: forall a b. AbsToConT m a -> AbsToConT m b -> AbsToConT m b
    $creturn :: forall (m :: * -> *) a. Monad m => a -> AbsToConT m a
    return :: forall a. a -> AbsToConT m a
    Monad, MonadReader Env
        , Monad (AbsToConT m)
    Functor (AbsToConT m)
    Applicative (AbsToConT m)
    (Functor (AbsToConT m), Applicative (AbsToConT m),
     Monad (AbsToConT m)) =>
    (SomeBuiltin -> AbsToConT m (Maybe (Builtin PrimFun)))
    -> HasBuiltins (AbsToConT m)
    SomeBuiltin -> AbsToConT m (Maybe (Builtin PrimFun))
    forall (m :: * -> *).
    (Functor m, Applicative m, Monad m) =>
    (SomeBuiltin -> m (Maybe (Builtin PrimFun))) -> HasBuiltins m
    forall (m :: * -> *). HasBuiltins m => Monad (AbsToConT m)
    forall (m :: * -> *). HasBuiltins m => Functor (AbsToConT m)
    forall (m :: * -> *). HasBuiltins m => Applicative (AbsToConT m)
    forall (m :: * -> *).
    HasBuiltins m =>
    SomeBuiltin -> AbsToConT m (Maybe (Builtin PrimFun))
    $cgetBuiltinThing :: forall (m :: * -> *).
    HasBuiltins m =>
    SomeBuiltin -> AbsToConT m (Maybe (Builtin PrimFun))
    getBuiltinThing :: SomeBuiltin -> AbsToConT m (Maybe (Builtin PrimFun))
    HasBuiltins
        , Functor (AbsToConT m)
    Applicative (AbsToConT m)
    HasOptions (AbsToConT m)
    MonadTCEnv (AbsToConT m)
    MonadDebug (AbsToConT m)
    (Functor (AbsToConT m), Applicative (AbsToConT m),
     HasOptions (AbsToConT m), MonadDebug (AbsToConT m),
     MonadTCEnv (AbsToConT m)) =>
    (QName -> AbsToConT m Definition)
    -> (QName -> AbsToConT m (Either SigError Definition))
    -> (QName -> AbsToConT m RewriteRules)
    -> HasConstInfo (AbsToConT m)
    QName -> AbsToConT m RewriteRules
    QName -> AbsToConT m (Either SigError Definition)
    QName -> AbsToConT m Definition
    forall (m :: * -> *).
    (Functor m, Applicative m, HasOptions m, MonadDebug m,
     MonadTCEnv m) =>
    (QName -> m Definition)
    -> (QName -> m (Either SigError Definition))
    -> (QName -> m RewriteRules)
    -> HasConstInfo m
    forall (m :: * -> *). HasConstInfo m => Functor (AbsToConT m)
    forall (m :: * -> *). HasConstInfo m => Applicative (AbsToConT m)
    forall (m :: * -> *). HasConstInfo m => HasOptions (AbsToConT m)
    forall (m :: * -> *). HasConstInfo m => MonadTCEnv (AbsToConT m)
    forall (m :: * -> *). HasConstInfo m => MonadDebug (AbsToConT m)
    forall (m :: * -> *).
    HasConstInfo m =>
    QName -> AbsToConT m RewriteRules
    forall (m :: * -> *).
    HasConstInfo m =>
    QName -> AbsToConT m (Either SigError Definition)
    forall (m :: * -> *).
    HasConstInfo m =>
    QName -> AbsToConT m Definition
    $cgetConstInfo :: forall (m :: * -> *).
    HasConstInfo m =>
    QName -> AbsToConT m Definition
    getConstInfo :: QName -> AbsToConT m Definition
    $cgetConstInfo' :: forall (m :: * -> *).
    HasConstInfo m =>
    QName -> AbsToConT m (Either SigError Definition)
    getConstInfo' :: QName -> AbsToConT m (Either SigError Definition)
    $cgetRewriteRulesFor :: forall (m :: * -> *).
    HasConstInfo m =>
    QName -> AbsToConT m RewriteRules
    getRewriteRulesFor :: QName -> AbsToConT m RewriteRules
    HasConstInfo
        , Monad (AbsToConT m)
    Functor (AbsToConT m)
    Applicative (AbsToConT m)
    AbsToConT m PragmaOptions
    AbsToConT m CommandLineOptions
    (Functor (AbsToConT m), Applicative (AbsToConT m),
     Monad (AbsToConT m)) =>
    AbsToConT m PragmaOptions
    -> AbsToConT m CommandLineOptions -> HasOptions (AbsToConT m)
    forall (m :: * -> *).
    (Functor m, Applicative m, Monad m) =>
    m PragmaOptions -> m CommandLineOptions -> HasOptions m
    forall (m :: * -> *). HasOptions m => Monad (AbsToConT m)
    forall (m :: * -> *). HasOptions m => Functor (AbsToConT m)
    forall (m :: * -> *). HasOptions m => Applicative (AbsToConT m)
    forall (m :: * -> *). HasOptions m => AbsToConT m PragmaOptions
    forall (m :: * -> *).
    HasOptions m =>
    AbsToConT m CommandLineOptions
    $cpragmaOptions :: forall (m :: * -> *). HasOptions m => AbsToConT m PragmaOptions
    pragmaOptions :: AbsToConT m PragmaOptions
    $ccommandLineOptions :: forall (m :: * -> *).
    HasOptions m =>
    AbsToConT m CommandLineOptions
    commandLineOptions :: AbsToConT m CommandLineOptions
    HasOptions
        , MonadTCEnv (AbsToConT m)
    MonadTCEnv (AbsToConT m) =>
    (forall a. Name -> Dom Type -> AbsToConT m a -> AbsToConT m a)
    -> (forall a.
        Origin
        -> Name -> Term -> Dom Type -> AbsToConT m a -> AbsToConT m a)
    -> (forall a.
        Substitution
        -> (Context -> Context) -> AbsToConT m a -> AbsToConT m a)
    -> (forall a.
        Range -> ArgName -> (Name -> AbsToConT m a) -> AbsToConT m a)
    -> MonadAddContext (AbsToConT m)
    forall a.
    Range -> ArgName -> (Name -> AbsToConT m a) -> AbsToConT m a
    forall a.
    Origin
    -> Name -> Term -> Dom Type -> AbsToConT m a -> AbsToConT m a
    forall a. Name -> Dom Type -> AbsToConT m a -> AbsToConT m a
    forall a.
    Substitution
    -> (Context -> Context) -> AbsToConT m a -> AbsToConT m a
    forall (m :: * -> *).
    MonadTCEnv m =>
    (forall a. Name -> Dom Type -> m a -> m a)
    -> (forall a. Origin -> Name -> Term -> Dom Type -> m a -> m a)
    -> (forall a. Substitution -> (Context -> Context) -> m a -> m a)
    -> (forall a. Range -> ArgName -> (Name -> m a) -> m a)
    -> MonadAddContext m
    forall (m :: * -> *). MonadAddContext m => MonadTCEnv (AbsToConT m)
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Range -> ArgName -> (Name -> AbsToConT m a) -> AbsToConT m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Origin
    -> Name -> Term -> Dom Type -> AbsToConT m a -> AbsToConT m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Name -> Dom Type -> AbsToConT m a -> AbsToConT m a
    forall (m :: * -> *) a.
    MonadAddContext m =>
    Substitution
    -> (Context -> Context) -> AbsToConT m a -> AbsToConT m a
    $caddCtx :: forall (m :: * -> *) a.
    MonadAddContext m =>
    Name -> Dom Type -> AbsToConT m a -> AbsToConT m a
    addCtx :: forall a. Name -> Dom Type -> AbsToConT m a -> AbsToConT m a
    $caddLetBinding' :: forall (m :: * -> *) a.
    MonadAddContext m =>
    Origin
    -> Name -> Term -> Dom Type -> AbsToConT m a -> AbsToConT m a
    addLetBinding' :: forall a.
    Origin
    -> Name -> Term -> Dom Type -> AbsToConT m a -> AbsToConT m a
    $cupdateContext :: forall (m :: * -> *) a.
    MonadAddContext m =>
    Substitution
    -> (Context -> Context) -> AbsToConT m a -> AbsToConT m a
    updateContext :: forall a.
    Substitution
    -> (Context -> Context) -> AbsToConT m a -> AbsToConT m a
    $cwithFreshName :: forall (m :: * -> *) a.
    MonadAddContext m =>
    Range -> ArgName -> (Name -> AbsToConT m a) -> AbsToConT m a
    withFreshName :: forall a.
    Range -> ArgName -> (Name -> AbsToConT m a) -> AbsToConT m a
    MonadAddContext
        , Monad (AbsToConT m)
    Functor (AbsToConT m)
    Applicative (AbsToConT m)
    AbsToConT m Bool
    AbsToConT m Verbosity
    AbsToConT m ProfileOptions
    (Functor (AbsToConT m), Applicative (AbsToConT m),
     Monad (AbsToConT m)) =>
    (ArgName -> VerboseLevel -> TCM Doc -> AbsToConT m ArgName)
    -> (forall a.
        ArgName
        -> VerboseLevel -> ArgName -> AbsToConT m a -> AbsToConT m a)
    -> (forall a.
        ArgName
        -> VerboseLevel -> ArgName -> AbsToConT m a -> AbsToConT m a)
    -> AbsToConT m Verbosity
    -> AbsToConT m ProfileOptions
    -> AbsToConT m Bool
    -> (forall a. AbsToConT m a -> AbsToConT m a)
    -> MonadDebug (AbsToConT m)
    ArgName -> VerboseLevel -> TCM Doc -> AbsToConT m ArgName
    forall a.
    ArgName
    -> VerboseLevel -> ArgName -> AbsToConT m a -> AbsToConT m a
    forall a. AbsToConT m a -> AbsToConT m a
    forall (m :: * -> *).
    (Functor m, Applicative m, Monad m) =>
    (ArgName -> VerboseLevel -> TCM Doc -> m ArgName)
    -> (forall a. ArgName -> VerboseLevel -> ArgName -> m a -> m a)
    -> (forall a. ArgName -> VerboseLevel -> ArgName -> m a -> m a)
    -> m Verbosity
    -> m ProfileOptions
    -> m Bool
    -> (forall a. m a -> m a)
    -> MonadDebug m
    forall (m :: * -> *). MonadDebug m => Monad (AbsToConT m)
    forall (m :: * -> *). MonadDebug m => Functor (AbsToConT m)
    forall (m :: * -> *). MonadDebug m => Applicative (AbsToConT m)
    forall (m :: * -> *). MonadDebug m => AbsToConT m Bool
    forall (m :: * -> *). MonadDebug m => AbsToConT m Verbosity
    forall (m :: * -> *). MonadDebug m => AbsToConT m ProfileOptions
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> TCM Doc -> AbsToConT m ArgName
    forall (m :: * -> *) a.
    MonadDebug m =>
    ArgName
    -> VerboseLevel -> ArgName -> AbsToConT m a -> AbsToConT m a
    forall (m :: * -> *) a.
    MonadDebug m =>
    AbsToConT m a -> AbsToConT m a
    $cformatDebugMessage :: forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> TCM Doc -> AbsToConT m ArgName
    formatDebugMessage :: ArgName -> VerboseLevel -> TCM Doc -> AbsToConT m ArgName
    $ctraceDebugMessage :: forall (m :: * -> *) a.
    MonadDebug m =>
    ArgName
    -> VerboseLevel -> ArgName -> AbsToConT m a -> AbsToConT m a
    traceDebugMessage :: forall a.
    ArgName
    -> VerboseLevel -> ArgName -> AbsToConT m a -> AbsToConT m a
    $cverboseBracket :: forall (m :: * -> *) a.
    MonadDebug m =>
    ArgName
    -> VerboseLevel -> ArgName -> AbsToConT m a -> AbsToConT m a
    verboseBracket :: forall a.
    ArgName
    -> VerboseLevel -> ArgName -> AbsToConT m a -> AbsToConT m a
    $cgetVerbosity :: forall (m :: * -> *). MonadDebug m => AbsToConT m Verbosity
    getVerbosity :: AbsToConT m Verbosity
    $cgetProfileOptions :: forall (m :: * -> *). MonadDebug m => AbsToConT m ProfileOptions
    getProfileOptions :: AbsToConT m ProfileOptions
    $cisDebugPrinting :: forall (m :: * -> *). MonadDebug m => AbsToConT m Bool
    isDebugPrinting :: AbsToConT m Bool
    $cnowDebugPrinting :: forall (m :: * -> *) a.
    MonadDebug m =>
    AbsToConT m a -> AbsToConT m a
    nowDebugPrinting :: forall a. AbsToConT m a -> AbsToConT m a
    MonadDebug
        , MonadTCEnv (AbsToConT m)
    ReadTCState (AbsToConT m)
    AbsToConT m InteractionId
    (MonadTCEnv (AbsToConT m), ReadTCState (AbsToConT m)) =>
    AbsToConT m InteractionId
    -> ((InteractionPoints -> InteractionPoints) -> AbsToConT m ())
    -> MonadInteractionPoints (AbsToConT m)
    (InteractionPoints -> InteractionPoints) -> AbsToConT m ()
    forall (m :: * -> *).
    (MonadTCEnv m, ReadTCState m) =>
    m InteractionId
    -> ((InteractionPoints -> InteractionPoints) -> m ())
    -> MonadInteractionPoints m
    forall (m :: * -> *).
    MonadInteractionPoints m =>
    MonadTCEnv (AbsToConT m)
    forall (m :: * -> *).
    MonadInteractionPoints m =>
    ReadTCState (AbsToConT m)
    forall (m :: * -> *).
    MonadInteractionPoints m =>
    AbsToConT m InteractionId
    forall (m :: * -> *).
    MonadInteractionPoints m =>
    (InteractionPoints -> InteractionPoints) -> AbsToConT m ()
    $cfreshInteractionId :: forall (m :: * -> *).
    MonadInteractionPoints m =>
    AbsToConT m InteractionId
    freshInteractionId :: AbsToConT m InteractionId
    $cmodifyInteractionPoints :: forall (m :: * -> *).
    MonadInteractionPoints m =>
    (InteractionPoints -> InteractionPoints) -> AbsToConT m ()
    modifyInteractionPoints :: (InteractionPoints -> InteractionPoints) -> AbsToConT m ()
    MonadInteractionPoints
        , Applicative (AbsToConT m)
    HasOptions (AbsToConT m)
    MonadTCEnv (AbsToConT m)
    ReadTCState (AbsToConT m)
    (Applicative (AbsToConT m), MonadTCEnv (AbsToConT m),
     ReadTCState (AbsToConT m), HasOptions (AbsToConT m)) =>
    (forall a. ReduceM a -> AbsToConT m a) -> MonadReduce (AbsToConT m)
    forall a. ReduceM a -> AbsToConT m a
    forall (m :: * -> *).
    (Applicative m, MonadTCEnv m, ReadTCState m, HasOptions m) =>
    (forall a. ReduceM a -> m a) -> MonadReduce m
    forall (m :: * -> *). MonadReduce m => Applicative (AbsToConT m)
    forall (m :: * -> *). MonadReduce m => HasOptions (AbsToConT m)
    forall (m :: * -> *). MonadReduce m => MonadTCEnv (AbsToConT m)
    forall (m :: * -> *). MonadReduce m => ReadTCState (AbsToConT m)
    forall (m :: * -> *) a. MonadReduce m => ReduceM a -> AbsToConT m a
    $cliftReduce :: forall (m :: * -> *) a. MonadReduce m => ReduceM a -> AbsToConT m a
    liftReduce :: forall a. ReduceM a -> AbsToConT m a
    MonadReduce
        , Monad (AbsToConT m)
    AbsToConT m ConcreteNames
    Monad (AbsToConT m) =>
    (forall a. StateT ConcreteNames (AbsToConT m) a -> AbsToConT m a)
    -> AbsToConT m ConcreteNames
    -> ((ConcreteNames -> ConcreteNames) -> AbsToConT m ())
    -> MonadStConcreteNames (AbsToConT m)
    (ConcreteNames -> ConcreteNames) -> AbsToConT m ()
    forall a. StateT ConcreteNames (AbsToConT m) a -> AbsToConT m a
    forall (m :: * -> *).
    Monad m =>
    (forall a. StateT ConcreteNames m a -> m a)
    -> m ConcreteNames
    -> ((ConcreteNames -> ConcreteNames) -> m ())
    -> MonadStConcreteNames m
    forall (m :: * -> *). MonadStConcreteNames m => Monad (AbsToConT m)
    forall (m :: * -> *).
    MonadStConcreteNames m =>
    AbsToConT m ConcreteNames
    forall (m :: * -> *).
    MonadStConcreteNames m =>
    (ConcreteNames -> ConcreteNames) -> AbsToConT m ()
    forall (m :: * -> *) a.
    MonadStConcreteNames m =>
    StateT ConcreteNames (AbsToConT m) a -> AbsToConT m a
    $crunStConcreteNames :: forall (m :: * -> *) a.
    MonadStConcreteNames m =>
    StateT ConcreteNames (AbsToConT m) a -> AbsToConT m a
    runStConcreteNames :: forall a. StateT ConcreteNames (AbsToConT m) a -> AbsToConT m a
    $cuseConcreteNames :: forall (m :: * -> *).
    MonadStConcreteNames m =>
    AbsToConT m ConcreteNames
    useConcreteNames :: AbsToConT m ConcreteNames
    $cmodifyConcreteNames :: forall (m :: * -> *).
    MonadStConcreteNames m =>
    (ConcreteNames -> ConcreteNames) -> AbsToConT m ()
    modifyConcreteNames :: (ConcreteNames -> ConcreteNames) -> AbsToConT m ()
    MonadStConcreteNames
        , Monad (AbsToConT m)
    AbsToConT m TCEnv
    Monad (AbsToConT m) =>
    AbsToConT m TCEnv
    -> (forall a. (TCEnv -> TCEnv) -> AbsToConT m a -> AbsToConT m a)
    -> MonadTCEnv (AbsToConT m)
    forall a. (TCEnv -> TCEnv) -> AbsToConT m a -> AbsToConT m a
    forall (m :: * -> *).
    Monad m =>
    m TCEnv
    -> (forall a. (TCEnv -> TCEnv) -> m a -> m a) -> MonadTCEnv m
    forall (m :: * -> *). MonadTCEnv m => Monad (AbsToConT m)
    forall (m :: * -> *). MonadTCEnv m => AbsToConT m TCEnv
    forall (m :: * -> *) a.
    MonadTCEnv m =>
    (TCEnv -> TCEnv) -> AbsToConT m a -> AbsToConT m a
    $caskTC :: forall (m :: * -> *). MonadTCEnv m => AbsToConT m TCEnv
    askTC :: AbsToConT m TCEnv
    $clocalTC :: forall (m :: * -> *) a.
    MonadTCEnv m =>
    (TCEnv -> TCEnv) -> AbsToConT m a -> AbsToConT m a
    localTC :: forall a. (TCEnv -> TCEnv) -> AbsToConT m a -> AbsToConT m a
    MonadTCEnv
        , MonadTCEnv (AbsToConT m)
    MonadReduce (AbsToConT m)
    ReadTCState (AbsToConT m)
    HasBuiltins (AbsToConT m)
    MonadAddContext (AbsToConT m)
    MonadDebug (AbsToConT m)
    HasConstInfo (AbsToConT m)
    (HasBuiltins (AbsToConT m), HasConstInfo (AbsToConT m),
     MonadAddContext (AbsToConT m), MonadDebug (AbsToConT m),
     MonadReduce (AbsToConT m), MonadTCEnv (AbsToConT m),
     ReadTCState (AbsToConT m)) =>
    PureTCM (AbsToConT m)
    forall (m :: * -> *).
    (HasBuiltins m, HasConstInfo m, MonadAddContext m,
     MonadReduce m) =>
    MonadTCEnv (AbsToConT m)
    forall (m :: * -> *).
    (HasBuiltins m, HasConstInfo m, MonadAddContext m,
     MonadReduce m) =>
    MonadReduce (AbsToConT m)
    forall (m :: * -> *).
    (HasBuiltins m, HasConstInfo m, MonadAddContext m,
     MonadReduce m) =>
    ReadTCState (AbsToConT m)
    forall (m :: * -> *).
    (HasBuiltins m, HasConstInfo m, MonadAddContext m,
     MonadReduce m) =>
    HasBuiltins (AbsToConT m)
    forall (m :: * -> *).
    (HasBuiltins m, HasConstInfo m, MonadAddContext m,
     MonadReduce m) =>
    MonadAddContext (AbsToConT m)
    forall (m :: * -> *).
    (HasBuiltins m, HasConstInfo m, MonadAddContext m,
     MonadReduce m) =>
    MonadDebug (AbsToConT m)
    forall (m :: * -> *).
    (HasBuiltins m, HasConstInfo m, MonadAddContext m,
     MonadReduce m) =>
    HasConstInfo (AbsToConT m)
    forall (m :: * -> *).
    (HasBuiltins m, HasConstInfo m, MonadAddContext m, MonadDebug m,
     MonadReduce m, MonadTCEnv m, ReadTCState m) =>
    PureTCM m
    PureTCM
        , Monad (AbsToConT m)
    AbsToConT m TCState
    Monad (AbsToConT m) =>
    AbsToConT m TCState
    -> (forall a b.
        Lens' TCState a -> (a -> a) -> AbsToConT m b -> AbsToConT m b)
    -> (forall a.
        (TCState -> TCState) -> AbsToConT m a -> AbsToConT m a)
    -> ReadTCState (AbsToConT m)
    forall a. (TCState -> TCState) -> AbsToConT m a -> AbsToConT m a
    forall a b.
    Lens' TCState a -> (a -> a) -> AbsToConT m b -> AbsToConT m b
    forall (m :: * -> *).
    Monad m =>
    m TCState
    -> (forall a b. Lens' TCState a -> (a -> a) -> m b -> m b)
    -> (forall a. (TCState -> TCState) -> m a -> m a)
    -> ReadTCState m
    forall (m :: * -> *). ReadTCState m => Monad (AbsToConT m)
    forall (m :: * -> *). ReadTCState m => AbsToConT m TCState
    forall (m :: * -> *) a.
    ReadTCState m =>
    (TCState -> TCState) -> AbsToConT m a -> AbsToConT m a
    forall (m :: * -> *) a b.
    ReadTCState m =>
    Lens' TCState a -> (a -> a) -> AbsToConT m b -> AbsToConT m b
    $cgetTCState :: forall (m :: * -> *). ReadTCState m => AbsToConT m TCState
    getTCState :: AbsToConT m TCState
    $clocallyTCState :: forall (m :: * -> *) a b.
    ReadTCState m =>
    Lens' TCState a -> (a -> a) -> AbsToConT m b -> AbsToConT m b
    locallyTCState :: forall a b.
    Lens' TCState a -> (a -> a) -> AbsToConT m b -> AbsToConT m b
    $cwithTCState :: forall (m :: * -> *) a.
    ReadTCState m =>
    (TCState -> TCState) -> AbsToConT m a -> AbsToConT m a
    withTCState :: forall a. (TCState -> TCState) -> AbsToConT m a -> AbsToConT m a
    ReadTCState
        )

    deriving instance MonadFresh NameId m => MonadFresh NameId (AbsToConT m)
    deriving instance (Monad m, IsString  (m Doc)) => IsString (AbsToConT m Doc)
    deriving instance (Monad m, Null      (m Doc)) => Null (AbsToConT m Doc)
    deriving instance (Monad m, Semigroup (m Doc)) => Semigroup (AbsToConT m Doc)

    runAbsToCon :: MonadAbsToCon m => AbsToConT m c -> m c
    runAbsToCon :: forall (m :: * -> *) c. MonadAbsToCon m => AbsToConT m c -> m c
    runAbsToCon AbsToConT m c
    m = do
      scope <- m ScopeInfo
    forall (m :: * -> *). ReadTCState m => m ScopeInfo
    getScope
      verboseBracket "toConcrete" 50 "runAbsToCon" $ do
        reportSLn "toConcrete" 50 $ render $ hsep $
          [ "entering AbsToCon with scope:"
          , prettyList_ (map (text . C.nameToRawName . fst) $ scope ^. scopeLocals)
          ]
        x <- runReaderT (unAbsToCon m) =<< makeEnv scope
        reportSLn "toConcrete" 50 $ "leaving AbsToCon"
        return x

    ---------------------------------------------------------------------------
    -- * The Environment
    ---------------------------------------------------------------------------

    data Env = Env
      { Env -> Set Name
    takenVarNames :: Set A.Name
          -- ^ Abstract names currently in scope.
          --   Unlike the 'ScopeInfo', this includes names for hidden arguments
          --   inserted by the system.
      , Env -> Set NameParts
    takenDefNames :: Set C.NameParts
          -- ^ Concrete names of all definitions in scope.
      , Env -> ScopeInfo
    currentScope :: ScopeInfo
      , Env -> Map BuiltinId QName
    builtins     :: Map BuiltinId A.QName
          -- ^ Certain builtins (like `fromNat`) have special printing.
      , Env -> Bool
    preserveIIds :: Bool
          -- ^ Preserve interaction point ids?
      , Env -> Bool
    foldPatternSynonyms :: Bool
      , Env -> Bool
    unqualifyOutOfScopeNames :: Bool
          -- ^ Print out-of-scope names unqualified (`a` instead of `A.B.a`).
      }

    makeEnv :: MonadAbsToCon m => ScopeInfo -> m Env
    makeEnv :: forall (m :: * -> *). MonadAbsToCon m => ScopeInfo -> m Env
    makeEnv ScopeInfo
    scope = do
          -- zero and suc doesn't have to be in scope for natural number literals to work
      let noScopeCheck :: BuiltinId -> Bool
    noScopeCheck BuiltinId
    b = BuiltinId
    b BuiltinId -> [BuiltinId] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [BuiltinId
    builtinZero, BuiltinId
    builtinSuc]
          name :: Term -> Maybe QName
    name (I.Def QName
    q Elims
    _)   = QName -> Maybe QName
    forall a. a -> Maybe a
    Just QName
    q
          name (I.Con ConHead
    q ConInfo
    _ Elims
    _) = QName -> Maybe QName
    forall a. a -> Maybe a
    Just (ConHead -> QName
    I.conName ConHead
    q)
          name Term
    _             = Maybe QName
    forall a. Maybe a
    Nothing
          builtin :: BuiltinId -> m [(BuiltinId, QName)]
    builtin BuiltinId
    b = BuiltinId -> m (Maybe Term)
    forall (m :: * -> *). HasBuiltins m => BuiltinId -> m (Maybe Term)
    getBuiltin' BuiltinId
    b m (Maybe Term)
    -> (Maybe Term -> m [(BuiltinId, QName)]) -> m [(BuiltinId, QName)]
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ case
            Just Term
    v | Just QName
    q <- Term -> Maybe QName
    name Term
    v,
                     BuiltinId -> Bool
    noScopeCheck BuiltinId
    b Bool -> Bool -> Bool
    || QName -> ScopeInfo -> Bool
    isNameInScope QName
    q ScopeInfo
    scope -> [(BuiltinId, QName)] -> m [(BuiltinId, QName)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(BuiltinId
    b, QName
    q)]
            Maybe Term
    _                                                -> [(BuiltinId, QName)] -> m [(BuiltinId, QName)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      ctxVars <- m [Name]
    forall (m :: * -> *). MonadTCEnv m => m [Name]
    getContextNames'
      letVars <- Map.keys <$> asksTC envLetBindings
      let vars = [Name]
    ctxVars [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ [Name]
    letVars

      -- pick concrete names for in-scope names now so we don't
      -- accidentally shadow them
      forM_ (scope ^. scopeLocals) $ \(Name
    y , LocalVar
    x) -> do
        Name -> Name -> m ()
    forall (m :: * -> *).
    MonadStConcreteNames m =>
    Name -> Name -> m ()
    pickConcreteName (LocalVar -> Name
    localVar LocalVar
    x) Name
    y

      builtinList <- concat <$> mapM builtin [ builtinFromNat, builtinFromString, builtinFromNeg, builtinZero, builtinSuc ]
      foldPatSyns <- optPrintPatternSynonyms <$> pragmaOptions
      return $
        Env { takenVarNames = Set.fromList vars
            , takenDefNames = defs
            , currentScope = scope
            , builtins     = Map.fromListWith __IMPOSSIBLE__ builtinList
            , preserveIIds = False
            , foldPatternSynonyms = foldPatSyns
            , unqualifyOutOfScopeNames = False
            }
      where
        defs :: Set NameParts
    defs = [NameParts] -> Set NameParts
    forall a. Ord a => [a] -> Set a
    Set.fromList ([NameParts] -> Set NameParts) -> [NameParts] -> Set NameParts
    forall a b. (a -> b) -> a -> b
    $ ((Name, NonEmpty AbstractName) -> NameParts)
    -> [(Name, NonEmpty AbstractName)] -> [NameParts]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> NameParts
    nameParts (Name -> NameParts)
    -> ((Name, NonEmpty AbstractName) -> Name)
    -> (Name, NonEmpty AbstractName)
    -> NameParts
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, NonEmpty AbstractName) -> Name
    forall a b. (a, b) -> a
    fst) ([(Name, NonEmpty AbstractName)] -> [NameParts])
    -> [(Name, NonEmpty AbstractName)] -> [NameParts]
    forall a b. (a -> b) -> a -> b
    $
            ((Name, NonEmpty AbstractName) -> Bool)
    -> [(Name, NonEmpty AbstractName)]
    -> [(Name, NonEmpty AbstractName)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Name -> NonEmpty AbstractName -> Bool)
    -> (Name, NonEmpty AbstractName) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Name -> NonEmpty AbstractName -> Bool
    forall {t :: * -> *}. Foldable t => Name -> t AbstractName -> Bool
    usefulDef) ([(Name, NonEmpty AbstractName)]
     -> [(Name, NonEmpty AbstractName)])
    -> [(Name, NonEmpty AbstractName)]
    -> [(Name, NonEmpty AbstractName)]
    forall a b. (a -> b) -> a -> b
    $
            Map Name (NonEmpty AbstractName) -> [(Name, NonEmpty AbstractName)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (Map Name (NonEmpty AbstractName)
     -> [(Name, NonEmpty AbstractName)])
    -> Map Name (NonEmpty AbstractName)
    -> [(Name, NonEmpty AbstractName)]
    forall a b. (a -> b) -> a -> b
    $ NameSpace -> Map Name (NonEmpty AbstractName)
    nsNames (NameSpace -> Map Name (NonEmpty AbstractName))
    -> NameSpace -> Map Name (NonEmpty AbstractName)
    forall a b. (a -> b) -> a -> b
    $ ScopeInfo -> NameSpace
    everythingInScope ScopeInfo
    scope

        -- Jesper, 2018-12-10: It's fine to shadow generalizable names as
        -- they will never show up directly in printed terms.
        notGeneralizeName :: AbstractName -> Bool
    notGeneralizeName AbsName{ anameKind :: AbstractName -> KindOfName
    anameKind = KindOfName
    k }  =
          Bool -> Bool
    not (KindOfName
    k KindOfName -> KindOfName -> Bool
    forall a. Eq a => a -> a -> Bool
    == KindOfName
    GeneralizeName Bool -> Bool -> Bool
    || KindOfName
    k KindOfName -> KindOfName -> Bool
    forall a. Eq a => a -> a -> Bool
    == KindOfName
    DisallowedGeneralizeName)

        usefulDef :: Name -> t AbstractName -> Bool
    usefulDef C.NoName{} t AbstractName
    _ = Bool
    False
        usefulDef C.Name{} t AbstractName
    names = (AbstractName -> Bool) -> t AbstractName -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all AbstractName -> Bool
    notGeneralizeName t AbstractName
    names

        nameParts :: Name -> NameParts
    nameParts (C.NoName {}) = NameParts
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        nameParts (C.Name { NameParts
    nameNameParts :: NameParts
    nameNameParts :: Name -> NameParts
    nameNameParts }) = NameParts
    nameNameParts

    -- | Bind a concrete name to an abstract in the translation environment.
    addBinding :: C.Name -> A.Name -> Env -> Env
    addBinding :: Name -> Name -> Env -> Env
    addBinding Name
    y Name
    x Env
    e =
      Env
    e { takenVarNames = Set.insert x $ takenVarNames e
        , currentScope = (`updateScopeLocals` currentScope e) $
            AssocList.insert y (LocalVar x __IMPOSSIBLE__ [])
        }

    ---------------------------------------------------------------------------
    -- * Service functions
    ---------------------------------------------------------------------------

    currentPrecedence :: MonadToConcrete m => m PrecedenceStack
    currentPrecedence :: forall (m :: * -> *). MonadToConcrete m => m PrecedenceStack
    currentPrecedence = (Env -> PrecedenceStack) -> m PrecedenceStack
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ((Env -> PrecedenceStack) -> m PrecedenceStack)
    -> (Env -> PrecedenceStack) -> m PrecedenceStack
    forall a b. (a -> b) -> a -> b
    $ (ScopeInfo -> Lens' ScopeInfo PrecedenceStack -> PrecedenceStack
    forall o i. o -> Lens' o i -> i
    ^. (PrecedenceStack -> f PrecedenceStack) -> ScopeInfo -> f ScopeInfo
    Lens' ScopeInfo PrecedenceStack
    scopePrecedence) (ScopeInfo -> PrecedenceStack)
    -> (Env -> ScopeInfo) -> Env -> PrecedenceStack
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env -> ScopeInfo
    currentScope

    preserveInteractionIds :: MonadToConcrete m => m a -> m a
    preserveInteractionIds :: forall (m :: * -> *) a. MonadToConcrete m => m a -> m a
    preserveInteractionIds = (Env -> Env) -> m a -> m a
    forall a. (Env -> Env) -> m a -> m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ((Env -> Env) -> m a -> m a) -> (Env -> Env) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ \ Env
    e -> Env
    e { preserveIIds = True }

    localPrecedenceStack :: MonadToConcrete m
      => (PrecedenceStack -> PrecedenceStack) -> m a -> m a
    localPrecedenceStack :: forall (m :: * -> *) a.
    MonadToConcrete m =>
    (PrecedenceStack -> PrecedenceStack) -> m a -> m a
    localPrecedenceStack PrecedenceStack -> PrecedenceStack
    f = (Env -> Env) -> m a -> m a
    forall a. (Env -> Env) -> m a -> m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local \ Env
    env ->
      Env
    env{ currentScope = over scopePrecedence f (currentScope env) }

    withPrecedence' :: MonadToConcrete m => PrecedenceStack -> m a -> m a
    withPrecedence' :: forall (m :: * -> *) a.
    MonadToConcrete m =>
    PrecedenceStack -> m a -> m a
    withPrecedence' = (PrecedenceStack -> PrecedenceStack) -> m a -> m a
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    (PrecedenceStack -> PrecedenceStack) -> m a -> m a
    localPrecedenceStack ((PrecedenceStack -> PrecedenceStack) -> m a -> m a)
    -> (PrecedenceStack -> PrecedenceStack -> PrecedenceStack)
    -> PrecedenceStack
    -> m a
    -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrecedenceStack -> PrecedenceStack -> PrecedenceStack
    forall a b. a -> b -> a
    const

    withPrecedence :: MonadToConcrete m => Precedence -> m a -> m a
    withPrecedence :: forall (m :: * -> *) a.
    MonadToConcrete m =>
    Precedence -> m a -> m a
    withPrecedence = (PrecedenceStack -> PrecedenceStack) -> m a -> m a
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    (PrecedenceStack -> PrecedenceStack) -> m a -> m a
    localPrecedenceStack ((PrecedenceStack -> PrecedenceStack) -> m a -> m a)
    -> (Precedence -> PrecedenceStack -> PrecedenceStack)
    -> Precedence
    -> m a
    -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Precedence -> PrecedenceStack -> PrecedenceStack
    pushPrecedence

    withScope :: MonadToConcrete m => ScopeInfo -> m a -> m a
    withScope :: forall (m :: * -> *) a.
    MonadToConcrete m =>
    ScopeInfo -> m a -> m a
    withScope ScopeInfo
    scope = (Env -> Env) -> m a -> m a
    forall a. (Env -> Env) -> m a -> m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ((Env -> Env) -> m a -> m a) -> (Env -> Env) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ \Env
    e -> Env
    e { currentScope = scope }

    noTakenNames :: MonadToConcrete m => m a -> m a
    noTakenNames :: forall (m :: * -> *) a. MonadToConcrete m => m a -> m a
    noTakenNames = (Env -> Env) -> m a -> m a
    forall a. (Env -> Env) -> m a -> m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ((Env -> Env) -> m a -> m a) -> (Env -> Env) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ \Env
    e -> Env
    e { takenVarNames = Set.empty }

    dontFoldPatternSynonyms :: MonadToConcrete m => m a -> m a
    dontFoldPatternSynonyms :: forall (m :: * -> *) a. MonadToConcrete m => m a -> m a
    dontFoldPatternSynonyms = (Env -> Env) -> m a -> m a
    forall a. (Env -> Env) -> m a -> m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ((Env -> Env) -> m a -> m a) -> (Env -> Env) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ \ Env
    e -> Env
    e { foldPatternSynonyms = False }

    doUnqualifyOutOfScopeNames :: MonadToConcrete m => m a -> m a
    doUnqualifyOutOfScopeNames :: forall (m :: * -> *) a. MonadToConcrete m => m a -> m a
    doUnqualifyOutOfScopeNames = (Env -> Env) -> m a -> m a
    forall a. (Env -> Env) -> m a -> m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ((Env -> Env) -> m a -> m a) -> (Env -> Env) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ \ Env
    e -> Env
    e { unqualifyOutOfScopeNames = True }

    -- | Get a function to check if a name refers to a particular builtin function.
    isBuiltinFun :: MonadToConcrete m => m (A.QName -> BuiltinId -> Bool)
    isBuiltinFun :: forall (m :: * -> *).
    MonadToConcrete m =>
    m (QName -> BuiltinId -> Bool)
    isBuiltinFun = (Env -> QName -> BuiltinId -> Bool)
    -> m (QName -> BuiltinId -> Bool)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ((Env -> QName -> BuiltinId -> Bool)
     -> m (QName -> BuiltinId -> Bool))
    -> (Env -> QName -> BuiltinId -> Bool)
    -> m (QName -> BuiltinId -> Bool)
    forall a b. (a -> b) -> a -> b
    $ Map BuiltinId QName -> QName -> BuiltinId -> Bool
    forall {k} {a}. (Ord k, Eq a) => Map k a -> a -> k -> Bool
    is (Map BuiltinId QName -> QName -> BuiltinId -> Bool)
    -> (Env -> Map BuiltinId QName)
    -> Env
    -> QName
    -> BuiltinId
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env -> Map BuiltinId QName
    builtins
      where is :: Map k a -> a -> k -> Bool
    is Map k a
    m a
    q k
    b = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    q Maybe a -> Maybe a -> Bool
    forall a. Eq a => a -> a -> Bool
    == k -> Map k a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup k
    b Map k a
    m

    -- | Resolve a concrete name. If illegally ambiguous fail with the ambiguous names.
    resolveName :: MonadToConcrete m => KindsOfNames -> Maybe (Set1 A.Name) -> C.QName -> m (Either NameResolutionError ResolvedName)
    resolveName :: forall (m :: * -> *).
    MonadToConcrete m =>
    KindsOfNames
    -> Maybe (Set1 Name)
    -> QName
    -> m (Either NameResolutionError ResolvedName)
    resolveName KindsOfNames
    kinds Maybe (Set1 Name)
    candidates QName
    q = ExceptT NameResolutionError m ResolvedName
    -> m (Either NameResolutionError ResolvedName)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT NameResolutionError m ResolvedName
     -> m (Either NameResolutionError ResolvedName))
    -> ExceptT NameResolutionError m ResolvedName
    -> m (Either NameResolutionError ResolvedName)
    forall a b. (a -> b) -> a -> b
    $ KindsOfNames
    -> Maybe (Set1 Name)
    -> QName
    -> ExceptT NameResolutionError m ResolvedName
    forall (m :: * -> *).
    (ReadTCState m, HasBuiltins m, MonadError NameResolutionError m) =>
    KindsOfNames -> Maybe (Set1 Name) -> QName -> m ResolvedName
    tryResolveName KindsOfNames
    kinds Maybe (Set1 Name)
    candidates QName
    q

    -- | Treat illegally ambiguous names as UnknownNames.
    resolveName_ :: MonadToConcrete m => C.QName -> A.Name -> m ResolvedName
    resolveName_ :: forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> Name -> m ResolvedName
    resolveName_ QName
    q Name
    cand = (NameResolutionError -> ResolvedName)
    -> Either NameResolutionError ResolvedName -> ResolvedName
    forall a b. (a -> b) -> Either a b -> b
    fromRight (ResolvedName -> NameResolutionError -> ResolvedName
    forall a b. a -> b -> a
    const ResolvedName
    UnknownName) (Either NameResolutionError ResolvedName -> ResolvedName)
    -> m (Either NameResolutionError ResolvedName) -> m ResolvedName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> KindsOfNames
    -> Maybe (Set1 Name)
    -> QName
    -> m (Either NameResolutionError ResolvedName)
    forall (m :: * -> *).
    MonadToConcrete m =>
    KindsOfNames
    -> Maybe (Set1 Name)
    -> QName
    -> m (Either NameResolutionError ResolvedName)
    resolveName KindsOfNames
    allKindsOfNames (Set1 Name -> Maybe (Set1 Name)
    forall a. a -> Maybe a
    Just (Set1 Name -> Maybe (Set1 Name)) -> Set1 Name -> Maybe (Set1 Name)
    forall a b. (a -> b) -> a -> b
    $ Name -> Set1 Name
    forall el coll. Singleton el coll => el -> coll
    singleton Name
    cand) QName
    q

    ---------------------------------------------------------------------------
    -- ** Dealing with names
    ---------------------------------------------------------------------------

    -- | Names in abstract syntax are fully qualified, but the concrete syntax
    --   requires non-qualified names in places. In theory (if all scopes are
    --   correct), we should get a non-qualified name when translating back to a
    --   concrete name, but I suspect the scope isn't always perfect. In these
    --   cases we just throw away the qualified part. It's just for pretty printing
    --   anyway...
    unsafeQNameToName :: C.QName -> C.Name
    unsafeQNameToName :: QName -> Name
    unsafeQNameToName = QName -> Name
    C.unqualify

    -- | Like 'isRecordConstructor' but does not throw IMPOSSIBLE if the
    -- name is not in scope.
    isExistingRecordConstructor :: MonadToConcrete m => A.QName -> m (Maybe (A.QName, RecordData))
    isExistingRecordConstructor :: forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (Maybe (QName, RecordData))
    isExistingRecordConstructor QName
    c = QName -> m (Either SigError Definition)
    forall (m :: * -> *).
    HasConstInfo m =>
    QName -> m (Either SigError Definition)
    getConstInfo' QName
    c m (Either SigError Definition)
    -> (Either SigError Definition -> m (Maybe (QName, RecordData)))
    -> m (Maybe (QName, RecordData))
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      Left (SigUnknown ArgName
    err)     -> Maybe (QName, RecordData) -> m (Maybe (QName, RecordData))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (QName, RecordData)
    forall a. Maybe a
    Nothing
      Left SigError
    SigCubicalNotErasure -> Maybe (QName, RecordData) -> m (Maybe (QName, RecordData))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (QName, RecordData)
    forall a. Maybe a
    Nothing
      Left SigError
    SigAbstract          -> Maybe (QName, RecordData) -> m (Maybe (QName, RecordData))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (QName, RecordData)
    forall a. Maybe a
    Nothing
      Right Definition
    def                 -> case Definition -> Defn
    theDef (Definition -> Defn) -> Definition -> Defn
    forall a b. (a -> b) -> a -> b
    $ Definition
    def of
        I.Constructor{ conData :: Defn -> QName
    conData = QName
    r } -> (RecordData -> (QName, RecordData))
    -> Maybe RecordData -> Maybe (QName, RecordData)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (QName
    r,) (Maybe RecordData -> Maybe (QName, RecordData))
    -> m (Maybe RecordData) -> m (Maybe (QName, RecordData))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (Maybe RecordData)
    forall (m :: * -> *).
    HasConstInfo m =>
    QName -> m (Maybe RecordData)
    isRecord QName
    r
        Defn
    _                            -> Maybe (QName, RecordData) -> m (Maybe (QName, RecordData))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (QName, RecordData)
    forall a. Maybe a
    Nothing

    lookupQName :: MonadToConcrete m => AllowAmbiguousNames -> A.QName -> m C.QName
    lookupQName :: forall (m :: * -> *).
    MonadToConcrete m =>
    AllowAmbiguousNames -> QName -> m QName
    lookupQName AllowAmbiguousNames
    ambCon QName
    x | Just ArgName
    s <- QName -> Maybe ArgName
    getGeneralizedFieldName QName
    x =
      QName -> m QName
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> QName
    C.QName (Name -> QName) -> Name -> QName
    forall a b. (a -> b) -> a -> b
    $ Range -> NameInScope -> NameParts -> Name
    C.Name Range
    forall a. Range' a
    noRange NameInScope
    C.InScope (NameParts -> Name) -> NameParts -> Name
    forall a b. (a -> b) -> a -> b
    $ ArgName -> NameParts
    C.stringNameParts ArgName
    s)
    lookupQName AllowAmbiguousNames
    ambCon QName
    x = m (Maybe (QName, RecordData)) -> m (Maybe (QName, RecordData))
    forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
    ignoreAbstractMode (QName -> m (Maybe (QName, RecordData))
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (Maybe (QName, RecordData))
    isExistingRecordConstructor QName
    x) m (Maybe (QName, RecordData))
    -> (Maybe (QName, RecordData) -> m QName) -> m QName
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      -- If the QName is the internal name of a record with no named
      -- constructor, we should first concretise the name *of the record*,
      -- since that will *actually* be in scope through a concrete QName.
      Just (QName
    r, RecordData
    def) | Bool -> Bool
    not (RecordData -> Bool
    _recNamedCon RecordData
    def) -> do
        ArgName -> VerboseLevel -> ArgName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> ArgName -> m ()
    reportSLn ArgName
    "scope.inverse" VerboseLevel
    100 (ArgName -> m ()) -> ArgName -> m ()
    forall a b. (a -> b) -> a -> b
    $
          ArgName
    "inverse lookup of record constructor " ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ QName -> ArgName
    forall a. Pretty a => a -> ArgName
    prettyShow QName
    x
        recr <- AllowAmbiguousNames -> QName -> m QName
    forall (m :: * -> *).
    MonadToConcrete m =>
    AllowAmbiguousNames -> QName -> m QName
    lookupQName AllowAmbiguousNames
    ambCon QName
    r
        pure (recr `C.qualify` simpleName "constructor")

      Maybe (QName, RecordData)
    _ -> do
        ys <- (Env -> [QName]) -> m [QName]
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (AllowAmbiguousNames -> QName -> ScopeInfo -> [QName]
    inverseScopeLookupName' AllowAmbiguousNames
    ambCon QName
    x (ScopeInfo -> [QName]) -> (Env -> ScopeInfo) -> Env -> [QName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env -> ScopeInfo
    currentScope)
        reportSLn "scope.inverse" 100 $
          "inverse looking up abstract name " ++ prettyShow x ++ " yields " ++ prettyShow ys
        loop ys

      where
        -- Found concrete name: check that it is not shadowed by a local
        loop :: [QName] -> m QName
    loop (qy :: QName
    qy@Qual{}      : [QName]
    _ ) = QName -> m QName
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    qy -- local names cannot be qualified
        loop (qy :: QName
    qy@(C.QName Name
    y) : [QName]
    ys) = Name -> m (Maybe Name)
    forall (m :: * -> *). MonadToConcrete m => Name -> m (Maybe Name)
    lookupNameInScope Name
    y m (Maybe Name) -> (Maybe Name -> m QName) -> m QName
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Just Name
    x' | Name
    x' Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    /= QName -> Name
    qnameName QName
    x -> [QName] -> m QName
    loop [QName]
    ys
          Maybe Name
    _ -> QName -> m QName
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    qy
        -- Found no concrete name:
        loop [] = case QName -> QName
    qnameToConcrete QName
    x of
          -- The name is qualified: in this case, we are likely dealing with a parameterised
          -- module, and the unqualified name might actually be in scope (see #3209).
          -- To make case splitting more useful in that situation, we unqualify the name
          -- if we are generating clauses for a case split.
          qy :: QName
    qy@Qual{} -> do
              doUnqualify <- (Env -> Bool) -> m Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> Bool
    unqualifyOutOfScopeNames
              return $ setNotInScope $ if doUnqualify then C.QName (unqualify qy) else qy
          -- The name is unqualified: make up a new one
          qy :: QName
    qy@C.QName{} -> Name -> QName
    C.QName (Name -> QName) -> m Name -> m QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> m Name
    forall (m :: * -> *). MonadToConcrete m => Name -> m Name
    chooseName (QName -> Name
    qnameName QName
    x)

    lookupModule :: MonadToConcrete m => A.ModuleName -> m C.QName
    lookupModule :: forall (m :: * -> *). MonadToConcrete m => ModuleName -> m QName
    lookupModule (A.MName []) = QName -> m QName
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> m QName) -> QName -> m QName
    forall a b. (a -> b) -> a -> b
    $ Name -> QName
    C.QName (Name -> QName) -> Name -> QName
    forall a b. (a -> b) -> a -> b
    $ ArgName -> Name
    C.simpleName ArgName
    "-1"
      -- Andreas, 2016-10-10 it can happen that we have an empty module name
      -- for instance when we query the current module inside the
      -- frontmatter or module telescope of the top level module.
      -- In this case, we print it as an invalid module name.
      -- (Should only affect debug printing.)
    lookupModule ModuleName
    x =
        do  scope <- (Env -> ScopeInfo) -> m ScopeInfo
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> ScopeInfo
    currentScope
            case inverseScopeLookupModule x scope of
                (QName
    y : [QName]
    _) -> QName -> m QName
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    y
                []      -> QName -> m QName
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> m QName) -> QName -> m QName
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> QName
    mnameToConcrete ModuleName
    x
                    -- this is what happens for names that are not in scope (private names)

    -- | Is this concrete name currently in use by a particular abstract
    --   name in the current scope?
    lookupNameInScope :: MonadToConcrete m => C.Name -> m (Maybe A.Name)
    lookupNameInScope :: forall (m :: * -> *). MonadToConcrete m => Name -> m (Maybe Name)
    lookupNameInScope Name
    y =
      (Env -> Maybe Name) -> m (Maybe Name)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (((LocalVar -> Name) -> Maybe LocalVar -> Maybe Name
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LocalVar -> Name
    localVar (Maybe LocalVar -> Maybe Name)
    -> ([(Name, LocalVar)] -> Maybe LocalVar)
    -> [(Name, LocalVar)]
    -> Maybe Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> [(Name, LocalVar)] -> Maybe LocalVar
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Name
    y) ([(Name, LocalVar)] -> Maybe Name)
    -> (Env -> [(Name, LocalVar)]) -> Env -> Maybe Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((ScopeInfo
    -> Lens' ScopeInfo [(Name, LocalVar)] -> [(Name, LocalVar)]
    forall o i. o -> Lens' o i -> i
    ^. ([(Name, LocalVar)] -> f [(Name, LocalVar)])
    -> ScopeInfo -> f ScopeInfo
    Lens' ScopeInfo [(Name, LocalVar)]
    scopeLocals) (ScopeInfo -> [(Name, LocalVar)])
    -> (Env -> ScopeInfo) -> Env -> [(Name, LocalVar)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env -> ScopeInfo
    currentScope))

    -- | Have we already committed to a specific concrete name for this
    --   abstract name? If yes, return the concrete name(s).
    hasConcreteNames :: (MonadStConcreteNames m) => A.Name -> m [C.Name]
    hasConcreteNames :: forall (m :: * -> *). MonadStConcreteNames m => Name -> m [Name]
    hasConcreteNames Name
    x = [Name] -> (List1 Name -> [Name]) -> Maybe (List1 Name) -> [Name]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] List1 Name -> [Item (List1 Name)]
    List1 Name -> [Name]
    forall l. IsList l => l -> [Item l]
    List1.toList (Maybe (List1 Name) -> [Name])
    -> (ConcreteNames -> Maybe (List1 Name)) -> ConcreteNames -> [Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> ConcreteNames -> Maybe (List1 Name)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    x (ConcreteNames -> [Name]) -> m ConcreteNames -> m [Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m ConcreteNames
    forall (m :: * -> *). MonadStConcreteNames m => m ConcreteNames
    useConcreteNames

    -- | Commit to a specific concrete name for printing the given
    --   abstract name. If the abstract name already has associated
    ---  concrete name(s), the new name is only used when all previous
    ---  names are shadowed. Precondition: the abstract name should be in
    --   scope.
    pickConcreteName :: (MonadStConcreteNames m) => A.Name -> C.Name -> m ()
    pickConcreteName :: forall (m :: * -> *).
    MonadStConcreteNames m =>
    Name -> Name -> m ()
    pickConcreteName Name
    x Name
    y = (ConcreteNames -> ConcreteNames) -> m ()
    forall (m :: * -> *).
    MonadStConcreteNames m =>
    (ConcreteNames -> ConcreteNames) -> m ()
    modifyConcreteNames ((ConcreteNames -> ConcreteNames) -> m ())
    -> (ConcreteNames -> ConcreteNames) -> m ()
    forall a b. (a -> b) -> a -> b
    $ ((Maybe (List1 Name) -> Maybe (List1 Name))
     -> Name -> ConcreteNames -> ConcreteNames)
    -> Name
    -> (Maybe (List1 Name) -> Maybe (List1 Name))
    -> ConcreteNames
    -> ConcreteNames
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Maybe (List1 Name) -> Maybe (List1 Name))
    -> Name -> ConcreteNames -> ConcreteNames
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    Map.alter Name
    x ((Maybe (List1 Name) -> Maybe (List1 Name))
     -> ConcreteNames -> ConcreteNames)
    -> (Maybe (List1 Name) -> Maybe (List1 Name))
    -> ConcreteNames
    -> ConcreteNames
    forall a b. (a -> b) -> a -> b
    $ List1 Name -> Maybe (List1 Name)
    forall a. a -> Maybe a
    Just (List1 Name -> Maybe (List1 Name))
    -> (Maybe (List1 Name) -> List1 Name)
    -> Maybe (List1 Name)
    -> Maybe (List1 Name)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . \case
        Maybe (List1 Name)
    Nothing -> Name -> List1 Name
    forall el coll. Singleton el coll => el -> coll
    singleton Name
    y
        Just List1 Name
    ys -> [Name] -> Name -> List1 Name
    forall a. [a] -> a -> List1 a
    List1.snoc (List1 Name -> [Item (List1 Name)]
    forall l. IsList l => l -> [Item l]
    List1.toList List1 Name
    ys) Name
    y

    -- | For the given abstract name, return the names that could shadow it.
    shadowingNames :: (ReadTCState m, MonadStConcreteNames m)
                   => A.Name -> m (Set RawName)
    shadowingNames :: forall (m :: * -> *).
    (ReadTCState m, MonadStConcreteNames m) =>
    Name -> m (Set ArgName)
    shadowingNames Name
    x = Maybe (Set1 ArgName) -> Set ArgName
    forall a. Maybe (Set1 a) -> Set a
    Set1.toSet' (Maybe (Set1 ArgName) -> Set ArgName)
    -> (Map Name (Set1 ArgName) -> Maybe (Set1 ArgName))
    -> Map Name (Set1 ArgName)
    -> Set ArgName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Map Name (Set1 ArgName) -> Maybe (Set1 ArgName)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    x (Map Name (Set1 ArgName) -> Set ArgName)
    -> m (Map Name (Set1 ArgName)) -> m (Set ArgName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Lens' TCState (Map Name (Set1 ArgName))
    -> m (Map Name (Set1 ArgName))
    forall (m :: * -> *) a. ReadTCState m => Lens' TCState a -> m a
    useR (Map Name (Set1 ArgName) -> f (Map Name (Set1 ArgName)))
    -> TCState -> f TCState
    Lens' TCState (Map Name (Set1 ArgName))
    stShadowingNames

    toConcreteName :: MonadToConcrete m => A.Name -> m C.Name
    toConcreteName :: forall (m :: * -> *). MonadToConcrete m => Name -> m Name
    toConcreteName Name
    x | Name
    y <- Name -> Name
    nameConcrete Name
    x , Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    y = Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    y
    toConcreteName Name
    x = Name -> m [Name]
    forall (m :: * -> *). MonadStConcreteNames m => Name -> m [Name]
    hasConcreteNames Name
    x m [Name] -> ([Name] -> m Name) -> m Name
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Name] -> m Name
    loop
      where
        -- case: we already have picked some name(s) for x
        loop :: [Name] -> m Name
    loop (Name
    y:[Name]
    ys) = m Bool -> m Name -> m Name -> m Name
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (Name -> Name -> m Bool
    forall (m :: * -> *). MonadToConcrete m => Name -> Name -> m Bool
    isGoodName Name
    x Name
    y) (Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    y) ([Name] -> m Name
    loop [Name]
    ys)

        -- case: we haven't picked a concrete name yet, or all previously
        -- picked names are shadowed, so we pick a new name now
        loop [] = do
          y <- Name -> m Name
    forall (m :: * -> *). MonadToConcrete m => Name -> m Name
    chooseName Name
    x
          pickConcreteName x y
          return y

        -- Is 'y' a good concrete name for abstract name 'x'?
        isGoodName :: MonadToConcrete m => A.Name -> C.Name -> m Bool
        isGoodName :: forall (m :: * -> *). MonadToConcrete m => Name -> Name -> m Bool
    isGoodName Name
    x Name
    y = do
          zs <- (Env -> [Name]) -> m [Name]
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList (Set Name -> [Name]) -> (Env -> Set Name) -> Env -> [Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env -> Set Name
    takenVarNames)
          forallM zs $ \ Name
    z -> Bool -> m Bool
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    z) m Bool -> m Bool -> m Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    `or2M` (Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    notElem Name
    y ([Name] -> Bool) -> m [Name] -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> m [Name]
    forall (m :: * -> *). MonadStConcreteNames m => Name -> m [Name]
    hasConcreteNames Name
    z)

    -- | Choose a new unshadowed name for the given abstract name
    -- | NOTE: See @withName@ in @Agda.Syntax.Translation.ReflectedToAbstract@ for similar logic.
    -- | NOTE: See @freshConcreteName@ in @Agda.Syntax.Scope.Monad@ also for similar logic.
    chooseName :: MonadToConcrete m => A.Name -> m C.Name
    chooseName :: forall (m :: * -> *). MonadToConcrete m => Name -> m Name
    chooseName Name
    x = Name -> m (Maybe Name)
    forall (m :: * -> *). MonadToConcrete m => Name -> m (Maybe Name)
    lookupNameInScope (Name -> Name
    nameConcrete Name
    x) m (Maybe Name) -> (Maybe Name -> m Name) -> m Name
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      -- If the name is currently in scope, we do not rename it
      Just Name
    x' | Name
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    x' -> do
        ArgName -> VerboseLevel -> ArgName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> ArgName -> m ()
    reportSLn ArgName
    "toConcrete.bindName" VerboseLevel
    80 (ArgName -> m ()) -> ArgName -> m ()
    forall a b. (a -> b) -> a -> b
    $
          ArgName
    "name " ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ Name -> ArgName
    C.nameToRawName (Name -> Name
    nameConcrete Name
    x) ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ ArgName
    " already in scope, so not renaming"
        Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> m Name) -> Name -> m Name
    forall a b. (a -> b) -> a -> b
    $ Name -> Name
    nameConcrete Name
    x
      -- Otherwise we pick a name that does not shadow other names
      Maybe Name
    _ -> do
        takenDefs <- (Env -> Set NameParts) -> m (Set NameParts)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> Set NameParts
    takenDefNames
        taken   <- takenNames
        toAvoid <- shadowingNames x
        glyphMode <- optUseUnicode <$> pragmaOptions
        let freshNameMode = case UnicodeOrAscii
    glyphMode of
              UnicodeOrAscii
    UnicodeOk -> FreshNameMode
    A.UnicodeSubscript
              UnicodeOrAscii
    AsciiOnly -> FreshNameMode
    A.AsciiCounter

            shouldAvoid C.NoName {} = Bool
    False
            shouldAvoid name :: Name
    name@C.Name { NameParts
    nameNameParts :: Name -> NameParts
    nameNameParts :: NameParts
    nameNameParts } =
              let raw :: ArgName
    raw = Name -> ArgName
    C.nameToRawName Name
    name in
              NameParts
    nameNameParts NameParts -> Set NameParts -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set NameParts
    takenDefs Bool -> Bool -> Bool
    ||
              ArgName
    raw ArgName -> Set ArgName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set ArgName
    taken Bool -> Bool -> Bool
    ||
              ArgName
    raw ArgName -> Set ArgName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set ArgName
    toAvoid

            y = FreshNameMode -> (Name -> Bool) -> Name -> Name
    firstNonTakenName FreshNameMode
    freshNameMode Name -> Bool
    shouldAvoid (Name -> Name) -> Name -> Name
    forall a b. (a -> b) -> a -> b
    $ Name -> Name
    nameConcrete Name
    x
        reportSLn "toConcrete.bindName" 80 $ render $ vcat
          [ "picking concrete name for:" <+> text (C.nameToRawName $ nameConcrete x)
          , "names already taken:      " <+> prettyList_ (Set.toList taken)
          , "names to avoid:           " <+> prettyList_ (Set.toList toAvoid)
          , "concrete name chosen:     " <+> text (C.nameToRawName y)
          ]
        return y

      where
        takenNames :: MonadToConcrete m => m (Set RawName)
        takenNames :: forall (m :: * -> *). MonadToConcrete m => m (Set ArgName)
    takenNames = do
          ys0 <- Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList (Set Name -> [Name]) -> m (Set Name) -> m [Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Env -> Set Name) -> m (Set Name)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> Set Name
    takenVarNames
          reportSLn "toConcrete.bindName" 90 $ render $ "abstract names of local vars: " <+> prettyList_ (map (C.nameToRawName . nameConcrete) ys0)
          Set.fromList . map C.nameToRawName . concat <$> mapM hasConcreteNames ys0

    -- | Add a abstract name to the scope and produce an available concrete version of it.
    bindName :: MonadToConcrete m => A.Name -> (C.Name -> m a) -> m a
    bindName :: forall (m :: * -> *) a.
    MonadToConcrete m =>
    Name -> (Name -> m a) -> m a
    bindName Name
    x Name -> m a
    ret = do
      y <- Name -> m Name
    forall (m :: * -> *). MonadToConcrete m => Name -> m Name
    toConcreteName Name
    x
      reportSLn "toConcrete.bindName" 30 $ "adding " ++ C.nameToRawName (nameConcrete x) ++ " to the scope under concrete name " ++ C.nameToRawName y
      local (addBinding y x) $ ret y

    -- | Like 'bindName', but do not care whether name is already taken.
    bindName' :: MonadToConcrete m => A.Name -> m a -> m a
    bindName' :: forall (m :: * -> *) a. MonadToConcrete m => Name -> m a -> m a
    bindName' Name
    x m a
    ret = do
      ArgName -> VerboseLevel -> ArgName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> ArgName -> m ()
    reportSLn ArgName
    "toConcrete.bindName" VerboseLevel
    30 (ArgName -> m ()) -> ArgName -> m ()
    forall a b. (a -> b) -> a -> b
    $ ArgName
    "adding " ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ Name -> ArgName
    C.nameToRawName (Name -> Name
    nameConcrete Name
    x) ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ ArgName
    " to the scope with forced name"
      Name -> Name -> m ()
    forall (m :: * -> *).
    MonadStConcreteNames m =>
    Name -> Name -> m ()
    pickConcreteName Name
    x Name
    y
      Bool -> (m a -> m a) -> m a -> m a
    forall b a. IsBool b => b -> (a -> a) -> a -> a
    applyUnless (Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    y) ((Env -> Env) -> m a -> m a
    forall a. (Env -> Env) -> m a -> m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ((Env -> Env) -> m a -> m a) -> (Env -> Env) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ Name -> Name -> Env -> Env
    addBinding Name
    y Name
    x) m a
    ret
      where y :: Name
    y = Name -> Name
    nameConcrete Name
    x

    ---------------------------------------------------------------------------
    -- ** Dealing with precedences
    ---------------------------------------------------------------------------

    -- | General bracketing function.
    bracket' :: MonadToConcrete m
      => (e -> e)
           -- ^ The bracketing function.
      -> (PrecedenceStack -> Bool)
           -- ^ Should we bracket things which have the given precedence?
      -> e
      -> m e
    bracket' :: forall (m :: * -> *) e.
    MonadToConcrete m =>
    (e -> e) -> (PrecedenceStack -> Bool) -> e -> m e
    bracket' e -> e
    paren PrecedenceStack -> Bool
    needParen e
    e =
        do  p <- m PrecedenceStack
    forall (m :: * -> *). MonadToConcrete m => m PrecedenceStack
    currentPrecedence
            return $ if needParen p then paren e else e

    -- | Expression bracketing
    bracket :: MonadToConcrete m => (PrecedenceStack -> Bool) -> m C.Expr -> m C.Expr
    bracket :: forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    par m Expr
    m =
        do  e <- m Expr
    m
            bracket' (Paren (getRange e)) par e

    -- | Pattern bracketing
    bracketP_ :: MonadToConcrete m => (PrecedenceStack -> Bool) -> m C.Pattern -> m C.Pattern
    bracketP_ :: forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Pattern -> m Pattern
    bracketP_ PrecedenceStack -> Bool
    par m Pattern
    m =
        do  e <- m Pattern
    m
            bracket' (ParenP (getRange e)) par e

    -- | Applications where the argument is a lambda without parentheses need
    --   parens more often than other applications.
    isLambda :: NamedArg A.Expr -> Bool
    isLambda :: NamedArg Expr -> Bool
    isLambda NamedArg Expr
    e | NamedArg Expr -> Bool
    forall a. LensHiding a => a -> Bool
    notVisible NamedArg Expr
    e = Bool
    False
    isLambda NamedArg Expr
    e =
      case Expr -> Expr
    unScope (Expr -> Expr) -> Expr -> Expr
    forall a b. (a -> b) -> a -> b
    $ NamedArg Expr -> Expr
    forall a. NamedArg a -> a
    namedArg NamedArg Expr
    e of
        A.Lam{}         -> Bool
    True
        A.AbsurdLam{}   -> Bool
    True
        A.ExtendedLam{} -> Bool
    True
        Expr
    _               -> Bool
    False

    ---------------------------------------------------------------------------
    -- ** Dealing with infix declarations
    ---------------------------------------------------------------------------

    -- | If a name is defined with a fixity that differs from the default, we have
    --   to generate a fixity declaration for that name.
    withInfixDecl :: MonadToConcrete m => DefInfo -> C.Name -> m [C.Declaration] -> m [C.Declaration]
    withInfixDecl :: forall (m :: * -> *).
    MonadToConcrete m =>
    DefInfo -> Name -> m [Declaration] -> m [Declaration]
    withInfixDecl DefInfo
    i Name
    x m [Declaration]
    m = (([Declaration]
    fixDecl [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    synDecl) [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++) ([Declaration] -> [Declaration])
    -> m [Declaration] -> m [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m [Declaration]
    m
      where
      fixDecl :: [Declaration]
    fixDecl = [ Fixity -> List1 Name -> Declaration
    C.Infix (Fixity' -> Fixity
    theFixity (Fixity' -> Fixity) -> Fixity' -> Fixity
    forall a b. (a -> b) -> a -> b
    $ DefInfo -> Fixity'
    forall t. DefInfo' t -> Fixity'
    defFixity DefInfo
    i) (List1 Name -> Declaration) -> List1 Name -> Declaration
    forall a b. (a -> b) -> a -> b
    $ Name -> List1 Name
    forall el coll. Singleton el coll => el -> coll
    singleton Name
    x
                | Fixity' -> Fixity
    theFixity (DefInfo -> Fixity'
    forall t. DefInfo' t -> Fixity'
    defFixity DefInfo
    i) Fixity -> Fixity -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Fixity
    noFixity
                ]
      synDecl :: [Declaration]
    synDecl = [ Name -> Notation -> Declaration
    C.Syntax Name
    x (Notation -> Declaration) -> Notation -> Declaration
    forall a b. (a -> b) -> a -> b
    $ Fixity' -> Notation
    theNotation (Fixity' -> Notation) -> Fixity' -> Notation
    forall a b. (a -> b) -> a -> b
    $ DefInfo -> Fixity'
    forall t. DefInfo' t -> Fixity'
    defFixity DefInfo
    i ]

    ---------------------------------------------------------------------------
    -- ** Dealing with private definitions
    ---------------------------------------------------------------------------

    -- | Add @abstract@, @private@, @instance@ modifiers.
    withAbstractPrivate :: MonadToConcrete m => DefInfo -> m [C.Declaration] -> m [C.Declaration]
    withAbstractPrivate :: forall (m :: * -> *).
    MonadToConcrete m =>
    DefInfo -> m [Declaration] -> m [Declaration]
    withAbstractPrivate DefInfo
    i m [Declaration]
    m =
        Access -> [Declaration] -> [Declaration]
    priv (DefInfo -> Access
    forall t. DefInfo' t -> Access
    defAccess DefInfo
    i)
          ([Declaration] -> [Declaration])
    -> ([Declaration] -> [Declaration])
    -> [Declaration]
    -> [Declaration]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IsAbstract -> [Declaration] -> [Declaration]
    abst (DefInfo -> IsAbstract
    forall t. DefInfo' t -> IsAbstract
    A.defAbstract DefInfo
    i)
          ([Declaration] -> [Declaration])
    -> ([Declaration] -> [Declaration])
    -> [Declaration]
    -> [Declaration]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe KwRange -> [Declaration] -> [Declaration]
    addInstanceB (case DefInfo -> IsInstance
    forall t. DefInfo' t -> IsInstance
    A.defInstance DefInfo
    i of InstanceDef KwRange
    r -> KwRange -> Maybe KwRange
    forall a. a -> Maybe a
    Just KwRange
    r; IsInstance
    NotInstanceDef -> Maybe KwRange
    forall a. Maybe a
    Nothing)
          ([Declaration] -> [Declaration])
    -> m [Declaration] -> m [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m [Declaration]
    m
        where
            priv :: Access -> [Declaration] -> [Declaration]
    priv (PrivateAccess KwRange
    kwr Origin
    UserWritten)
                             [Declaration]
    ds = [ KwRange -> Origin -> [Declaration] -> Declaration
    C.Private KwRange
    kwr Origin
    UserWritten [Declaration]
    ds ]
            priv Access
    _           [Declaration]
    ds = [Declaration]
    ds
            abst :: IsAbstract -> [Declaration] -> [Declaration]
    abst IsAbstract
    AbstractDef [Declaration]
    ds = [ KwRange -> [Declaration] -> Declaration
    C.Abstract KwRange
    forall a. Null a => a
    empty [Declaration]
    ds ]
            abst IsAbstract
    ConcreteDef [Declaration]
    ds = [Declaration]
    ds

    addInstanceB :: Maybe KwRange -> [C.Declaration] -> [C.Declaration]
    addInstanceB :: Maybe KwRange -> [Declaration] -> [Declaration]
    addInstanceB (Just KwRange
    r) [Declaration]
    ds = [ KwRange -> [Declaration] -> Declaration
    C.InstanceB KwRange
    r [Declaration]
    ds ]
    addInstanceB Maybe KwRange
    Nothing  [Declaration]
    ds = [Declaration]
    ds

    ---------------------------------------------------------------------------
    -- * The To Concrete Class
    ---------------------------------------------------------------------------

    class ToConcrete a where
        type ConOfAbs a
        toConcrete :: MonadToConcrete m => a -> m (ConOfAbs a)
        bindToConcrete :: MonadToConcrete m => a -> (ConOfAbs a -> m b) -> m b

        -- Christian Sattler, 2017-08-05:
        -- These default implementations are not valid semantically (at least
        -- the second one). Perhaps they (it) should be removed.
        toConcrete     a
    x     = a -> (ConOfAbs a -> m (ConOfAbs a)) -> m (ConOfAbs a)
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcrete a
    x ConOfAbs a -> m (ConOfAbs a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        bindToConcrete a
    x ConOfAbs a -> m b
    ret = ConOfAbs a -> m b
    ret (ConOfAbs a -> m b) -> m (ConOfAbs a) -> m b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete a
    x

        {-# MINIMAL toConcrete | bindToConcrete #-}

    -- | Translate something in a context of the given precedence.
    toConcreteCtx :: MonadToConcrete m => ToConcrete a => Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx :: forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    p a
    x = Precedence -> m (ConOfAbs a) -> m (ConOfAbs a)
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    Precedence -> m a -> m a
    withPrecedence Precedence
    p (m (ConOfAbs a) -> m (ConOfAbs a))
    -> m (ConOfAbs a) -> m (ConOfAbs a)
    forall a b. (a -> b) -> a -> b
    $ a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete a
    x

    -- | Translate something in a context of the given precedence.
    bindToConcreteCtx :: MonadToConcrete m => ToConcrete a => Precedence -> a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteCtx :: forall (m :: * -> *) a b.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteCtx Precedence
    p a
    x ConOfAbs a -> m b
    ret = Precedence -> m b -> m b
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    Precedence -> m a -> m a
    withPrecedence Precedence
    p (m b -> m b) -> m b -> m b
    forall a b. (a -> b) -> a -> b
    $ a -> (ConOfAbs a -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcrete a
    x ConOfAbs a -> m b
    ret

    -- | Translate something in the top context.
    toConcreteTop :: MonadToConcrete m => ToConcrete a => a -> m (ConOfAbs a)
    toConcreteTop :: forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop = Precedence -> a -> m (ConOfAbs a)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    TopCtx

    -- | Translate something in the top context.
    bindToConcreteTop :: MonadToConcrete m => ToConcrete a => a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteTop :: forall (m :: * -> *) a b.
    (MonadToConcrete m, ToConcrete a) =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteTop = Precedence -> a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) a b.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteCtx Precedence
    TopCtx

    -- | Translate something in a context indicated by 'Hiding' info.
    toConcreteHiding :: MonadToConcrete m => (LensHiding h, ToConcrete a) => h -> a -> m (ConOfAbs a)
    toConcreteHiding :: forall (m :: * -> *) h a.
    (MonadToConcrete m, LensHiding h, ToConcrete a) =>
    h -> a -> m (ConOfAbs a)
    toConcreteHiding h
    h =
      case h -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding h
    h of
        Hiding
    NotHidden  -> a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete
        Hiding
    Hidden     -> a -> m (ConOfAbs a)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop
        Instance{} -> a -> m (ConOfAbs a)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop

    -- | Translate something in a context indicated by 'Hiding' info.
    bindToConcreteHiding :: MonadToConcrete m => (LensHiding h, ToConcrete a) => h -> a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteHiding :: forall (m :: * -> *) h a b.
    (MonadToConcrete m, LensHiding h, ToConcrete a) =>
    h -> a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteHiding h
    h =
      case h -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding h
    h of
        Hiding
    NotHidden  -> a -> (ConOfAbs a -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcrete
        Hiding
    Hidden     -> a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) a b.
    (MonadToConcrete m, ToConcrete a) =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteTop
        Instance{} -> a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) a b.
    (MonadToConcrete m, ToConcrete a) =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteTop

    -- Base type instances ------------------------------------------------------

    instance ToConcrete () where
      type ConOfAbs () = ()
      toConcrete :: forall (m :: * -> *). MonadToConcrete m => () -> m (ConOfAbs ())
    toConcrete = () -> m ()
    () -> m (ConOfAbs ())
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    instance ToConcrete Bool where
      type ConOfAbs Bool = Bool
      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Bool -> m (ConOfAbs Bool)
    toConcrete = Bool -> m Bool
    Bool -> m (ConOfAbs Bool)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    instance ToConcrete Char where
      type ConOfAbs Char = Char
      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Char -> m (ConOfAbs Char)
    toConcrete = Char -> m Char
    Char -> m (ConOfAbs Char)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    -- Functors ---------------------------------------------------------------

    instance ToConcrete a => ToConcrete [a] where
        type ConOfAbs [a] = [ConOfAbs a]

        toConcrete :: forall (m :: * -> *). MonadToConcrete m => [a] -> m (ConOfAbs [a])
    toConcrete     = (a -> m (ConOfAbs a)) -> [a] -> m [ConOfAbs a]
    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 a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete
        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    [a] -> (ConOfAbs [a] -> m b) -> m b
    bindToConcrete []     ConOfAbs [a] -> m b
    ret = ConOfAbs [a] -> m b
    ret []
        bindToConcrete (a
    a:[a]
    as) ConOfAbs [a] -> m b
    ret = NonEmpty a -> (ConOfAbs (NonEmpty a) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    NonEmpty a -> (ConOfAbs (NonEmpty a) -> m b) -> m b
    bindToConcrete (a
    a a -> [a] -> NonEmpty a
    forall a. a -> [a] -> NonEmpty a
    :| [a]
    as) ((ConOfAbs (NonEmpty a) -> m b) -> m b)
    -> (ConOfAbs (NonEmpty a) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ (ConOfAbs a
    c :| [ConOfAbs a]
    cs) -> ConOfAbs [a] -> m b
    ret (ConOfAbs a
    cConOfAbs a -> [ConOfAbs a] -> [ConOfAbs a]
    forall a. a -> [a] -> [a]
    :[ConOfAbs a]
    cs)

    instance ToConcrete a => ToConcrete (List1 a) where
        type ConOfAbs (List1 a) = List1 (ConOfAbs a)

        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    List1 a -> m (ConOfAbs (List1 a))
    toConcrete     = (a -> m (ConOfAbs a)) -> List1 a -> m (NonEmpty (ConOfAbs a))
    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) -> NonEmpty a -> m (NonEmpty b)
    mapM a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete
        -- Andreas, 2017-04-11, Issue #2543
        -- The naive `thread'ing does not work as we have to undo
        -- changes to the Precedence.
        -- bindToConcrete = thread bindToConcrete
        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    List1 a -> (ConOfAbs (List1 a) -> m b) -> m b
    bindToConcrete (a
    a :| [a]
    as) ConOfAbs (List1 a) -> m b
    ret = do
          p <- m PrecedenceStack
    forall (m :: * -> *). MonadToConcrete m => m PrecedenceStack
    currentPrecedence  -- save precedence
          bindToConcrete a $ \ ConOfAbs a
    c ->
            PrecedenceStack -> m b -> m b
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    PrecedenceStack -> m a -> m a
    withPrecedence' PrecedenceStack
    p (m b -> m b) -> m b -> m b
    forall a b. (a -> b) -> a -> b
    $ -- reset precedence
              [a] -> (ConOfAbs [a] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [a] -> (ConOfAbs [a] -> m b) -> m b
    bindToConcrete [a]
    as ((ConOfAbs [a] -> m b) -> m b) -> (ConOfAbs [a] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs [a]
    cs ->
                ConOfAbs (List1 a) -> m b
    ret (ConOfAbs a
    c ConOfAbs a -> [ConOfAbs a] -> NonEmpty (ConOfAbs a)
    forall a. a -> [a] -> NonEmpty a
    :| [ConOfAbs a]
    ConOfAbs [a]
    cs)

    instance ToConcrete a => ToConcrete (Maybe a)  where
        type ConOfAbs (Maybe a) = Maybe (ConOfAbs a)
        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Maybe a -> m (ConOfAbs (Maybe a))
    toConcrete = (a -> m (ConOfAbs a)) -> Maybe a -> m (Maybe (ConOfAbs a))
    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) -> Maybe a -> f (Maybe b)
    traverse a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete
        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    Maybe a -> (ConOfAbs (Maybe a) -> m b) -> m b
    bindToConcrete (Just a
    x) ConOfAbs (Maybe a) -> m b
    ret = a -> (ConOfAbs a -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcrete a
    x ((ConOfAbs a -> m b) -> m b) -> (ConOfAbs a -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Maybe (ConOfAbs a) -> m b
    ConOfAbs (Maybe a) -> m b
    ret (Maybe (ConOfAbs a) -> m b)
    -> (ConOfAbs a -> Maybe (ConOfAbs a)) -> ConOfAbs a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConOfAbs a -> Maybe (ConOfAbs a)
    forall a. a -> Maybe a
    Just
        bindToConcrete Maybe a
    Nothing  ConOfAbs (Maybe a) -> m b
    ret = ConOfAbs (Maybe a) -> m b
    ret Maybe (ConOfAbs a)
    ConOfAbs (Maybe a)
    forall a. Maybe a
    Nothing

    -- Bifunctors etc. --------------------------------------------------------

    instance (ToConcrete a1, ToConcrete a2) => ToConcrete (Either a1 a2) where
        type ConOfAbs (Either a1 a2) = Either (ConOfAbs a1) (ConOfAbs a2)

        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Either a1 a2 -> m (ConOfAbs (Either a1 a2))
    toConcrete = (a1 -> m (ConOfAbs a1))
    -> (a2 -> m (ConOfAbs a2))
    -> Either a1 a2
    -> m (Either (ConOfAbs a1) (ConOfAbs a2))
    forall (f :: * -> *) a c b d.
    Functor f =>
    (a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
    traverseEither a1 -> m (ConOfAbs a1)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a1 -> m (ConOfAbs a1)
    toConcrete a2 -> m (ConOfAbs a2)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a2 -> m (ConOfAbs a2)
    toConcrete
        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    Either a1 a2 -> (ConOfAbs (Either a1 a2) -> m b) -> m b
    bindToConcrete (Left a1
    x) ConOfAbs (Either a1 a2) -> m b
    ret =
            a1 -> (ConOfAbs a1 -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a1 -> (ConOfAbs a1 -> m b) -> m b
    bindToConcrete a1
    x ((ConOfAbs a1 -> m b) -> m b) -> (ConOfAbs a1 -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs a1
    x ->
            ConOfAbs (Either a1 a2) -> m b
    ret (ConOfAbs a1 -> Either (ConOfAbs a1) (ConOfAbs a2)
    forall a b. a -> Either a b
    Left ConOfAbs a1
    x)
        bindToConcrete (Right a2
    y) ConOfAbs (Either a1 a2) -> m b
    ret =
            a2 -> (ConOfAbs a2 -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a2 -> (ConOfAbs a2 -> m b) -> m b
    bindToConcrete a2
    y ((ConOfAbs a2 -> m b) -> m b) -> (ConOfAbs a2 -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs a2
    y ->
            ConOfAbs (Either a1 a2) -> m b
    ret (ConOfAbs a2 -> Either (ConOfAbs a1) (ConOfAbs a2)
    forall a b. b -> Either a b
    Right ConOfAbs a2
    y)

    instance (ToConcrete a1, ToConcrete a2) => ToConcrete (a1, a2) where
        type ConOfAbs (a1, a2) = (ConOfAbs a1, ConOfAbs a2)

        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    (a1, a2) -> m (ConOfAbs (a1, a2))
    toConcrete (a1
    x,a2
    y) = (ConOfAbs a1 -> ConOfAbs a2 -> (ConOfAbs a1, ConOfAbs a2))
    -> m (ConOfAbs a1)
    -> m (ConOfAbs a2)
    -> m (ConOfAbs a1, ConOfAbs a2)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (,) (a1 -> m (ConOfAbs a1)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a1 -> m (ConOfAbs a1)
    toConcrete a1
    x) (a2 -> m (ConOfAbs a2)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a2 -> m (ConOfAbs a2)
    toConcrete a2
    y)
        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    (a1, a2) -> (ConOfAbs (a1, a2) -> m b) -> m b
    bindToConcrete (a1
    x,a2
    y) ConOfAbs (a1, a2) -> m b
    ret =
            a1 -> (ConOfAbs a1 -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a1 -> (ConOfAbs a1 -> m b) -> m b
    bindToConcrete a1
    x ((ConOfAbs a1 -> m b) -> m b) -> (ConOfAbs a1 -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs a1
    x ->
            a2 -> (ConOfAbs a2 -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a2 -> (ConOfAbs a2 -> m b) -> m b
    bindToConcrete a2
    y ((ConOfAbs a2 -> m b) -> m b) -> (ConOfAbs a2 -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs a2
    y ->
            ConOfAbs (a1, a2) -> m b
    ret (ConOfAbs a1
    x,ConOfAbs a2
    y)

    instance (ToConcrete a1, ToConcrete a2, ToConcrete a3) => ToConcrete (a1,a2,a3) where
        type ConOfAbs (a1, a2, a3) = (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3)

        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    (a1, a2, a3) -> m (ConOfAbs (a1, a2, a3))
    toConcrete (a1
    x,a2
    y,a3
    z) = (ConOfAbs a1, (ConOfAbs a2, ConOfAbs a3))
    -> (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3)
    forall {a} {b} {c}. (a, (b, c)) -> (a, b, c)
    reorder ((ConOfAbs a1, (ConOfAbs a2, ConOfAbs a3))
     -> (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3))
    -> m (ConOfAbs a1, (ConOfAbs a2, ConOfAbs a3))
    -> m (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (a1, (a2, a3)) -> m (ConOfAbs (a1, (a2, a3)))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    (a1, (a2, a3)) -> m (ConOfAbs (a1, (a2, a3)))
    toConcrete (a1
    x,(a2
    y,a3
    z))
            where
                reorder :: (a, (b, c)) -> (a, b, c)
    reorder (a
    x,(b
    y,c
    z)) = (a
    x,b
    y,c
    z)

        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    (a1, a2, a3) -> (ConOfAbs (a1, a2, a3) -> m b) -> m b
    bindToConcrete (a1
    x,a2
    y,a3
    z) ConOfAbs (a1, a2, a3) -> m b
    ret = (a1, (a2, a3)) -> (ConOfAbs (a1, (a2, a3)) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    (a1, (a2, a3)) -> (ConOfAbs (a1, (a2, a3)) -> m b) -> m b
    bindToConcrete (a1
    x,(a2
    y,a3
    z)) ((ConOfAbs (a1, (a2, a3)) -> m b) -> m b)
    -> (ConOfAbs (a1, (a2, a3)) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3) -> m b
    ConOfAbs (a1, a2, a3) -> m b
    ret ((ConOfAbs a1, ConOfAbs a2, ConOfAbs a3) -> m b)
    -> ((ConOfAbs a1, (ConOfAbs a2, ConOfAbs a3))
        -> (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3))
    -> (ConOfAbs a1, (ConOfAbs a2, ConOfAbs a3))
    -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ConOfAbs a1, (ConOfAbs a2, ConOfAbs a3))
    -> (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3)
    forall {a} {b} {c}. (a, (b, c)) -> (a, b, c)
    reorder
            where
                reorder :: (a, (b, c)) -> (a, b, c)
    reorder (a
    x,(b
    y,c
    z)) = (a
    x,b
    y,c
    z)

    -- Decorations ------------------------------------------------------------

    instance ToConcrete a => ToConcrete (Arg a) where
        type ConOfAbs (Arg a) = Arg (ConOfAbs a)

        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Arg a -> m (ConOfAbs (Arg a))
    toConcrete (Arg ArgInfo
    i a
    a) = ArgInfo -> ConOfAbs a -> Arg (ConOfAbs a)
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    i (ConOfAbs a -> Arg (ConOfAbs a))
    -> m (ConOfAbs a) -> m (Arg (ConOfAbs a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ArgInfo -> a -> m (ConOfAbs a)
    forall (m :: * -> *) h a.
    (MonadToConcrete m, LensHiding h, ToConcrete a) =>
    h -> a -> m (ConOfAbs a)
    toConcreteHiding ArgInfo
    i a
    a

        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    Arg a -> (ConOfAbs (Arg a) -> m b) -> m b
    bindToConcrete (Arg ArgInfo
    info a
    x) ConOfAbs (Arg a) -> m b
    ret =
          ArgInfo -> a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) h a b.
    (MonadToConcrete m, LensHiding h, ToConcrete a) =>
    h -> a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteHiding ArgInfo
    info a
    x ((ConOfAbs a -> m b) -> m b) -> (ConOfAbs a -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Arg (ConOfAbs a) -> m b
    ConOfAbs (Arg a) -> m b
    ret (Arg (ConOfAbs a) -> m b)
    -> (ConOfAbs a -> Arg (ConOfAbs a)) -> ConOfAbs a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ArgInfo -> ConOfAbs a -> Arg (ConOfAbs a)
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    info

    instance ToConcrete a => ToConcrete (WithHiding a) where
      type ConOfAbs (WithHiding a) = WithHiding (ConOfAbs a)

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    WithHiding a -> m (ConOfAbs (WithHiding a))
    toConcrete     (WithHiding Hiding
    h a
    a) = Hiding -> ConOfAbs a -> WithHiding (ConOfAbs a)
    forall a. Hiding -> a -> WithHiding a
    WithHiding Hiding
    h (ConOfAbs a -> WithHiding (ConOfAbs a))
    -> m (ConOfAbs a) -> m (WithHiding (ConOfAbs a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Hiding -> a -> m (ConOfAbs a)
    forall (m :: * -> *) h a.
    (MonadToConcrete m, LensHiding h, ToConcrete a) =>
    h -> a -> m (ConOfAbs a)
    toConcreteHiding Hiding
    h a
    a
      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    WithHiding a -> (ConOfAbs (WithHiding a) -> m b) -> m b
    bindToConcrete (WithHiding Hiding
    h a
    a) ConOfAbs (WithHiding a) -> m b
    ret = Hiding -> a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) h a b.
    (MonadToConcrete m, LensHiding h, ToConcrete a) =>
    h -> a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteHiding Hiding
    h a
    a ((ConOfAbs a -> m b) -> m b) -> (ConOfAbs a -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs a
    a ->
        ConOfAbs (WithHiding a) -> m b
    ret (ConOfAbs (WithHiding a) -> m b) -> ConOfAbs (WithHiding a) -> m b
    forall a b. (a -> b) -> a -> b
    $ Hiding -> ConOfAbs a -> WithHiding (ConOfAbs a)
    forall a. Hiding -> a -> WithHiding a
    WithHiding Hiding
    h ConOfAbs a
    a

    instance ToConcrete a => ToConcrete (Named name a)  where
        type ConOfAbs (Named name a) = Named name (ConOfAbs a)
        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Named name a -> m (ConOfAbs (Named name a))
    toConcrete = (a -> m (ConOfAbs a))
    -> Named name a -> m (Named name (ConOfAbs a))
    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) -> Named name a -> f (Named name b)
    traverse a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete
        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    Named name a -> (ConOfAbs (Named name a) -> m b) -> m b
    bindToConcrete (Named Maybe name
    n a
    x) ConOfAbs (Named name a) -> m b
    ret = a -> (ConOfAbs a -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcrete a
    x ((ConOfAbs a -> m b) -> m b) -> (ConOfAbs a -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Named name (ConOfAbs a) -> m b
    ConOfAbs (Named name a) -> m b
    ret (Named name (ConOfAbs a) -> m b)
    -> (ConOfAbs a -> Named name (ConOfAbs a)) -> ConOfAbs a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe name -> ConOfAbs a -> Named name (ConOfAbs a)
    forall name a. Maybe name -> a -> Named name a
    Named Maybe name
    n

    instance ToConcrete a => ToConcrete (Ranged a)  where
        type ConOfAbs (Ranged a) = Ranged (ConOfAbs a)
        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Ranged a -> m (ConOfAbs (Ranged a))
    toConcrete = (a -> m (ConOfAbs a)) -> Ranged a -> m (Ranged (ConOfAbs a))
    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) -> Ranged a -> f (Ranged b)
    traverse a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete
        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    Ranged a -> (ConOfAbs (Ranged a) -> m b) -> m b
    bindToConcrete (Ranged Range
    r a
    x) ConOfAbs (Ranged a) -> m b
    ret = a -> (ConOfAbs a -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcrete a
    x ((ConOfAbs a -> m b) -> m b) -> (ConOfAbs a -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Ranged (ConOfAbs a) -> m b
    ConOfAbs (Ranged a) -> m b
    ret (Ranged (ConOfAbs a) -> m b)
    -> (ConOfAbs a -> Ranged (ConOfAbs a)) -> ConOfAbs a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> ConOfAbs a -> Ranged (ConOfAbs a)
    forall a. Range -> a -> Ranged a
    Ranged Range
    r

    -- Christian Sattler, 2017-08-05, fixing #2669
    -- Both methods of ToConcrete (FieldAssignment' a) need
    -- to be implemented, each in terms of the corresponding one of ToConcrete a.
    -- This mirrors the instance ToConcrete (Ranged a).
    -- The default implementations of ToConcrete are not valid semantically.
    instance ToConcrete a => ToConcrete (FieldAssignment' a) where
        type ConOfAbs (FieldAssignment' a) = FieldAssignment' (ConOfAbs a)
        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    FieldAssignment' a -> m (ConOfAbs (FieldAssignment' a))
    toConcrete = (a -> m (ConOfAbs a))
    -> FieldAssignment' a -> m (FieldAssignment' (ConOfAbs a))
    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) -> FieldAssignment' a -> f (FieldAssignment' b)
    traverse a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete

        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    FieldAssignment' a -> (ConOfAbs (FieldAssignment' a) -> m b) -> m b
    bindToConcrete (FieldAssignment Name
    name a
    a) ConOfAbs (FieldAssignment' a) -> m b
    ret =
          a -> (ConOfAbs a -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcrete a
    a ((ConOfAbs a -> m b) -> m b) -> (ConOfAbs a -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ FieldAssignment' (ConOfAbs a) -> m b
    ConOfAbs (FieldAssignment' a) -> m b
    ret (FieldAssignment' (ConOfAbs a) -> m b)
    -> (ConOfAbs a -> FieldAssignment' (ConOfAbs a))
    -> ConOfAbs a
    -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> ConOfAbs a -> FieldAssignment' (ConOfAbs a)
    forall a. Name -> a -> FieldAssignment' a
    FieldAssignment Name
    name

    -- Newtypes ---------------------------------------------------------------

    -- Deriving this requires UndecidableInstances,
    -- as TacticAttribute' is not larger than its expansion (Maybe . Ranged).
    -- (Also the derived instance produce a type error.)
    instance ToConcrete a => ToConcrete (TacticAttribute' a) where
      type ConOfAbs (TacticAttribute' a) = TacticAttribute' (ConOfAbs a)
      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    TacticAttribute' a -> m (ConOfAbs (TacticAttribute' a))
    toConcrete = (a -> m (ConOfAbs a))
    -> TacticAttribute' a -> m (TacticAttribute' (ConOfAbs a))
    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) -> TacticAttribute' a -> f (TacticAttribute' b)
    traverse a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete
      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    TacticAttribute' a -> (ConOfAbs (TacticAttribute' a) -> m b) -> m b
    bindToConcrete (TacticAttribute Maybe (Ranged a)
    a) ConOfAbs (TacticAttribute' a) -> m b
    ret = Maybe (Ranged a) -> (ConOfAbs (Maybe (Ranged a)) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Maybe (Ranged a) -> (ConOfAbs (Maybe (Ranged a)) -> m b) -> m b
    bindToConcrete Maybe (Ranged a)
    a ((ConOfAbs (Maybe (Ranged a)) -> m b) -> m b)
    -> (ConOfAbs (Maybe (Ranged a)) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ TacticAttribute' (ConOfAbs a) -> m b
    ConOfAbs (TacticAttribute' a) -> m b
    ret (TacticAttribute' (ConOfAbs a) -> m b)
    -> (Maybe (Ranged (ConOfAbs a)) -> TacticAttribute' (ConOfAbs a))
    -> Maybe (Ranged (ConOfAbs a))
    -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (Ranged (ConOfAbs a)) -> TacticAttribute' (ConOfAbs a)
    forall a. Maybe (Ranged a) -> TacticAttribute' a
    TacticAttribute

    -- Names ------------------------------------------------------------------

    instance ToConcrete A.Name where
      type ConOfAbs A.Name = C.Name

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Name -> m (ConOfAbs Name)
    toConcrete       = Name -> m Name
    Name -> m (ConOfAbs Name)
    forall (m :: * -> *). MonadToConcrete m => Name -> m Name
    toConcreteName
      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    Name -> (ConOfAbs Name -> m b) -> m b
    bindToConcrete Name
    x = Name -> (Name -> m b) -> m b
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    Name -> (Name -> m a) -> m a
    bindName Name
    x

    instance ToConcrete BindName where
      type ConOfAbs BindName = C.BoundName

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    BindName -> m (ConOfAbs BindName)
    toConcrete       = (Name -> BoundName) -> m Name -> m BoundName
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name -> BoundName
    C.mkBoundName_ (m Name -> m BoundName)
    -> (BindName -> m Name) -> BindName -> m BoundName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> m Name
    forall (m :: * -> *). MonadToConcrete m => Name -> m Name
    toConcreteName (Name -> m Name) -> (BindName -> Name) -> BindName -> m Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BindName -> Name
    unBind
      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    BindName -> (ConOfAbs BindName -> m b) -> m b
    bindToConcrete BindName
    x = Name -> (Name -> m b) -> m b
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    Name -> (Name -> m a) -> m a
    bindName (BindName -> Name
    unBind BindName
    x) ((Name -> m b) -> m b)
    -> ((BoundName -> m b) -> Name -> m b) -> (BoundName -> m b) -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((BoundName -> m b) -> (Name -> BoundName) -> Name -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> BoundName
    C.mkBoundName_)

    instance ToConcrete A.QName where
      type ConOfAbs A.QName = C.QName

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete = AllowAmbiguousNames -> QName -> m QName
    forall (m :: * -> *).
    MonadToConcrete m =>
    AllowAmbiguousNames -> QName -> m QName
    lookupQName AllowAmbiguousNames
    AmbiguousConProjs

    instance ToConcrete A.ModuleName where
      type ConOfAbs A.ModuleName = C.QName
      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    ModuleName -> m (ConOfAbs ModuleName)
    toConcrete = ModuleName -> m QName
    ModuleName -> m (ConOfAbs ModuleName)
    forall (m :: * -> *). MonadToConcrete m => ModuleName -> m QName
    lookupModule

    instance ToConcrete AbstractName where
      type ConOfAbs AbstractName = C.QName
      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    AbstractName -> m (ConOfAbs AbstractName)
    toConcrete = QName -> m QName
    QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete (QName -> m QName)
    -> (AbstractName -> QName) -> AbstractName -> m QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AbstractName -> QName
    anameName

    -- | Assumes name is not 'UnknownName'.
    instance ToConcrete ResolvedName where
      type ConOfAbs ResolvedName = C.QName

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    ResolvedName -> m (ConOfAbs ResolvedName)
    toConcrete = \case
        VarName Name
    x BindingSource
    _          -> Name -> QName
    C.QName (Name -> QName) -> m Name -> m QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> m (ConOfAbs Name)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Name -> m (ConOfAbs Name)
    toConcrete Name
    x
        DefinedName Access
    _ AbstractName
    x Suffix
    s    -> Suffix -> m QName -> m QName
    forall (m :: * -> *). HasOptions m => Suffix -> m QName -> m QName
    addSuffixConcrete Suffix
    s (m QName -> m QName) -> m QName -> m QName
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> m (ConOfAbs AbstractName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    AbstractName -> m (ConOfAbs AbstractName)
    toConcrete AbstractName
    x
        FieldName NonEmpty AbstractName
    xs         -> AbstractName -> m (ConOfAbs AbstractName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    AbstractName -> m (ConOfAbs AbstractName)
    toConcrete (NonEmpty AbstractName -> AbstractName
    forall a. NonEmpty a -> a
    List1.head NonEmpty AbstractName
    xs)
        ConstructorName Set1 Induction
    _ NonEmpty AbstractName
    xs -> AbstractName -> m (ConOfAbs AbstractName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    AbstractName -> m (ConOfAbs AbstractName)
    toConcrete (NonEmpty AbstractName -> AbstractName
    forall a. NonEmpty a -> a
    List1.head NonEmpty AbstractName
    xs)
        PatternSynResName NonEmpty AbstractName
    xs -> AbstractName -> m (ConOfAbs AbstractName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    AbstractName -> m (ConOfAbs AbstractName)
    toConcrete (NonEmpty AbstractName -> AbstractName
    forall a. NonEmpty a -> a
    List1.head NonEmpty AbstractName
    xs)
        ResolvedName
    UnknownName          -> m QName
    m (ConOfAbs ResolvedName)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    addSuffixConcrete :: HasOptions m => A.Suffix -> m C.QName -> m C.QName
    addSuffixConcrete :: forall (m :: * -> *). HasOptions m => Suffix -> m QName -> m QName
    addSuffixConcrete Suffix
    A.NoSuffix m QName
    x = m QName
    x
    addSuffixConcrete (A.Suffix Integer
    i) m QName
    x = do
      glyphMode <- PragmaOptions -> UnicodeOrAscii
    optUseUnicode (PragmaOptions -> UnicodeOrAscii)
    -> m PragmaOptions -> m UnicodeOrAscii
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
      addSuffixConcrete' glyphMode i <$> x

    addSuffixConcrete' :: UnicodeOrAscii -> Integer -> C.QName -> C.QName
    addSuffixConcrete' :: UnicodeOrAscii -> Integer -> QName -> QName
    addSuffixConcrete' UnicodeOrAscii
    glyphMode Integer
    i = Lens' QName (Maybe Suffix) -> LensSet QName (Maybe Suffix)
    forall o i. Lens' o i -> LensSet o i
    set ((Name -> f Name) -> QName -> f QName
    Lens' QName Name
    C.lensQNameName ((Name -> f Name) -> QName -> f QName)
    -> ((Maybe Suffix -> f (Maybe Suffix)) -> Name -> f Name)
    -> (Maybe Suffix -> f (Maybe Suffix))
    -> QName
    -> f QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe Suffix -> f (Maybe Suffix)) -> Name -> f Name
    Lens' Name (Maybe Suffix)
    nameSuffix) Maybe Suffix
    suffix
      where
        suffix :: Maybe Suffix
    suffix = Suffix -> Maybe Suffix
    forall a. a -> Maybe a
    Just (Suffix -> Maybe Suffix) -> Suffix -> Maybe Suffix
    forall a b. (a -> b) -> a -> b
    $ case UnicodeOrAscii
    glyphMode of
          UnicodeOrAscii
    UnicodeOk -> Integer -> Suffix
    Subscript (Integer -> Suffix) -> Integer -> Suffix
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    forall a. Num a => Integer -> a
    fromInteger Integer
    i
          UnicodeOrAscii
    AsciiOnly -> Integer -> Suffix
    Index (Integer -> Suffix) -> Integer -> Suffix
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    forall a. Num a => Integer -> a
    fromInteger Integer
    i

    -- Expression instance ----------------------------------------------------

    instance ToConcrete A.Expr where
        type ConOfAbs A.Expr = C.Expr

        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete (Var Name
    x)             = NameKind -> QName -> Expr
    KnownIdent NameKind
    Asp.Bound (QName -> Expr) -> (Name -> QName) -> Name -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> QName
    C.QName (Name -> Expr) -> m Name -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> m (ConOfAbs Name)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Name -> m (ConOfAbs Name)
    toConcrete Name
    x
        toConcrete (Def' QName
    x Suffix
    suffix)     = NameKind -> QName -> Expr
    KnownIdent NameKind
    Asp.Function (QName -> Expr) -> m QName -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Suffix -> m QName -> m QName
    forall (m :: * -> *). HasOptions m => Suffix -> m QName -> m QName
    addSuffixConcrete Suffix
    suffix (QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x)
        toConcrete (Proj ProjOrigin
    ProjPrefix AmbiguousQName
    p) = NameKind -> QName -> Expr
    KnownIdent NameKind
    Asp.Field (QName -> Expr) -> m QName -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    p)
        toConcrete (Proj ProjOrigin
    _          AmbiguousQName
    p) = KwRange -> Expr -> Expr
    C.Dot KwRange
    forall a. Null a => a
    empty (Expr -> Expr) -> (QName -> Expr) -> QName -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameKind -> QName -> Expr
    KnownIdent NameKind
    Asp.Field (QName -> Expr) -> m QName -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    p)
        toConcrete (A.Macro QName
    x)         = NameKind -> QName -> Expr
    KnownIdent NameKind
    Asp.Macro (QName -> Expr) -> m QName -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        toConcrete e :: Expr
    e@(Con AmbiguousQName
    c)           = Expr -> m Expr -> m Expr
    forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverPatternSyn Expr
    e (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ NameKind -> QName -> Expr
    KnownIdent (Induction -> NameKind
    Asp.Constructor Induction
    Inductive) (QName -> Expr) -> m QName -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    c)
            -- for names we have to use the name from the info, since the abstract
            -- name has been resolved to a fully qualified name (except for
            -- variables)
        toConcrete e :: Expr
    e@(A.Lit ExprInfo
    i (LitQName QName
    x)) = Expr -> m Expr -> m Expr
    forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverPatternSyn Expr
    e (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ do
          x <- AllowAmbiguousNames -> QName -> m QName
    forall (m :: * -> *).
    MonadToConcrete m =>
    AllowAmbiguousNames -> QName -> m QName
    lookupQName AllowAmbiguousNames
    AmbiguousNothing QName
    x
          let r = ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i
          bracket appBrackets $ return $
            C.App r (C.Quote r) (defaultNamedArg $ C.Ident x)
        toConcrete e :: Expr
    e@(A.Lit ExprInfo
    i Literal
    l) = Expr -> m Expr -> m Expr
    forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverPatternSyn Expr
    e (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> m Expr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> m Expr) -> Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Literal -> Expr
    C.Lit (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) Literal
    l

        -- Andreas, 2014-05-17  We print question marks with their
        -- interaction id, in case @metaNumber /= Nothing@
        -- Ulf, 2017-09-20  ... or @preserveIIds == True@.
        toConcrete (A.QuestionMark MetaInfo
    i InteractionId
    ii) = do
          preserve <- (Env -> Bool) -> m Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> Bool
    preserveIIds
          return $ C.QuestionMark (getRange i) $
                     interactionId ii <$ guard (preserve || isJust (metaNumber i))

        toConcrete (A.Underscore MetaInfo
    i) =
          Range -> Maybe ArgName -> Expr
    C.Underscore (MetaInfo -> Range
    forall a. HasRange a => a -> Range
    getRange MetaInfo
    i) (Maybe ArgName -> Expr) -> m (Maybe ArgName) -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
          (NamedMeta -> m ArgName) -> Maybe NamedMeta -> m (Maybe ArgName)
    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) -> Maybe a -> f (Maybe b)
    traverse (Doc -> ArgName
    forall a. Doc a -> ArgName
    render (Doc -> ArgName) -> (NamedMeta -> m Doc) -> NamedMeta -> m ArgName
    forall (m :: * -> *) b c a.
    Functor m =>
    (b -> c) -> (a -> m b) -> a -> m c
    <.> NamedMeta -> m Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => NamedMeta -> m Doc
    prettyTCM)
            (ArgName -> MetaId -> NamedMeta
    NamedMeta (MetaInfo -> ArgName
    metaNameSuggestion MetaInfo
    i) (MetaId -> NamedMeta) -> Maybe MetaId -> Maybe NamedMeta
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MetaInfo -> Maybe MetaId
    metaNumber MetaInfo
    i)

        toConcrete (A.Dot ExprInfo
    i Expr
    e) =
          KwRange -> Expr -> Expr
    C.Dot KwRange
    forall a. Null a => a
    empty (Expr -> Expr) -> m Expr -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    e

        toConcrete e :: Expr
    e@(A.App AppInfo
    i Expr
    e1 NamedArg Expr
    e2) = do
          is <- m (QName -> BuiltinId -> Bool)
    forall (m :: * -> *).
    MonadToConcrete m =>
    m (QName -> BuiltinId -> Bool)
    isBuiltinFun
          -- Special printing of desugared overloaded literals:
          --  fromNat 4        --> 4
          --  fromNeg 4        --> -4
          --  fromString "foo" --> "foo"
          -- Only when the corresponding conversion function is in scope and was
          -- inserted by the system.
          case (getHead e1, namedArg e2) of
            (Just (HdDef QName
    q), l :: Expr
    l@A.Lit{})
              | (BuiltinId -> Bool) -> [BuiltinId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (QName -> BuiltinId -> Bool
    is QName
    q) [BuiltinId
    builtinFromNat, BuiltinId
    builtinFromString], NamedArg Expr -> Bool
    forall a. LensHiding a => a -> Bool
    visible NamedArg Expr
    e2,
                AppInfo -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin AppInfo
    i Origin -> Origin -> Bool
    forall a. Eq a => a -> a -> Bool
    == Origin
    Inserted -> Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    l
            (Just (HdDef QName
    q), A.Lit ExprInfo
    r (LitNat Integer
    n))
              | QName
    q QName -> BuiltinId -> Bool
    `is` BuiltinId
    builtinFromNeg, NamedArg Expr -> Bool
    forall a. LensHiding a => a -> Bool
    visible NamedArg Expr
    e2,
                AppInfo -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin AppInfo
    i Origin -> Origin -> Bool
    forall a. Eq a => a -> a -> Bool
    == Origin
    Inserted -> Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete (ExprInfo -> Literal -> Expr
    A.Lit ExprInfo
    r (Integer -> Literal
    LitNat (-Integer
    n)))
            (Maybe Hd, Expr)
    _ ->
              Expr -> m Expr -> m Expr
    forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverPatternSyn Expr
    e
              (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> m Expr -> m Expr
    forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverOpApp Expr
    e
              (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> m Expr -> m Expr
    forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverNatural Expr
    e
              -- or fallback to App
              (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket (Bool -> PrecedenceStack -> Bool
    appBrackets' (Bool -> PrecedenceStack -> Bool)
    -> Bool -> PrecedenceStack -> Bool
    forall a b. (a -> b) -> a -> b
    $ ParenPreference -> Bool
    preferParenless (AppInfo -> ParenPreference
    appParens AppInfo
    i) Bool -> Bool -> Bool
    && NamedArg Expr -> Bool
    isLambda NamedArg Expr
    e2)
              (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ do e1' <- Precedence -> Expr -> m (ConOfAbs Expr)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    FunctionCtx Expr
    e1
                   e2' <- toConcreteCtx (ArgumentCtx $ appParens i) e2
                   return $ C.App (getRange i) e1' e2'

        toConcrete (A.WithApp ExprInfo
    i Expr
    e List1 Expr
    es) =
          (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    withAppBrackets (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ do
            e <- Precedence -> Expr -> m (ConOfAbs Expr)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    WithFunCtx Expr
    e
            es <- mapM (toConcreteCtx WithArgCtx) es
            return $ C.WithApp (getRange i) e es

        toConcrete (A.AbsurdLam ExprInfo
    i Hiding
    h) =
          (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    lamBrackets (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> m Expr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> m Expr) -> Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Hiding -> Expr
    C.AbsurdLam (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) Hiding
    h
        toConcrete e :: Expr
    e@(A.Lam ExprInfo
    i LamBinding
    _ Expr
    _) =
          Expr -> m Expr -> m Expr
    forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverOpApp Expr
    e (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $   -- recover sections
            [LamBinding] -> (ConOfAbs [LamBinding] -> m Expr) -> m Expr
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [LamBinding] -> (ConOfAbs [LamBinding] -> m b) -> m b
    bindToConcrete ((LamBinding -> LamBinding) -> [LamBinding] -> [LamBinding]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LamBinding -> LamBinding
    makeDomainFree [LamBinding]
    bs) ((ConOfAbs [LamBinding] -> m Expr) -> m Expr)
    -> (ConOfAbs [LamBinding] -> m Expr) -> m Expr
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs [LamBinding]
    bs' -> do
              [LamBinding] -> m Expr -> (List1 LamBinding -> m Expr) -> m Expr
    forall a b. [a] -> b -> (List1 a -> b) -> b
    List1.ifNull ([Maybe LamBinding] -> [LamBinding]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe LamBinding]
    ConOfAbs [LamBinding]
    bs')
                {-then-} (Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    e')
                {-else-} ((List1 LamBinding -> m Expr) -> m Expr)
    -> (List1 LamBinding -> m Expr) -> m Expr
    forall a b. (a -> b) -> a -> b
    $ \ List1 LamBinding
    bs -> (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    lamBrackets (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $
                  Range -> List1 LamBinding -> Expr -> Expr
    C.Lam (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) List1 LamBinding
    bs (Expr -> Expr) -> m Expr -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> m (ConOfAbs Expr)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop Expr
    e'
          where
              ([LamBinding]
    bs, Expr
    e') = Expr -> ([LamBinding], Expr)
    lamView Expr
    e
              -- #3238 GA: We drop the hidden lambda abstractions which have
              -- been inserted by the machine rather than the user. This means
              -- that the result of lamView may actually be an empty list of
              -- binders.
              lamView :: A.Expr -> ([A.LamBinding], A.Expr)
              lamView :: Expr -> ([LamBinding], Expr)
    lamView (A.Lam ExprInfo
    _ b :: LamBinding
    b@(A.DomainFree TacticAttribute
    _ NamedArg Binder
    x) Expr
    e)
                | NamedArg Binder -> Bool
    forall a. (LensHiding a, LensOrigin a) => a -> Bool
    isInsertedHidden NamedArg Binder
    x = Expr -> ([LamBinding], Expr)
    lamView Expr
    e
                | Bool
    otherwise = case Expr -> ([LamBinding], Expr)
    lamView Expr
    e of
                  (bs :: [LamBinding]
    bs@(A.DomainFree{} : [LamBinding]
    _), Expr
    e) -> (LamBinding
    bLamBinding -> [LamBinding] -> [LamBinding]
    forall a. a -> [a] -> [a]
    :[LamBinding]
    bs, Expr
    e)
                  ([LamBinding], Expr)
    _                            -> ([LamBinding
    b] , Expr
    e)
              lamView (A.Lam ExprInfo
    _ b :: LamBinding
    b@(A.DomainFull A.TLet{}) Expr
    e) = case Expr -> ([LamBinding], Expr)
    lamView Expr
    e of
                (bs :: [LamBinding]
    bs@(A.DomainFull TypedBinding
    _ : [LamBinding]
    _), Expr
    e) -> (LamBinding
    bLamBinding -> [LamBinding] -> [LamBinding]
    forall a. a -> [a] -> [a]
    :[LamBinding]
    bs, Expr
    e)
                ([LamBinding], Expr)
    _                            -> ([LamBinding
    b], Expr
    e)
              lamView (A.Lam ExprInfo
    _ (A.DomainFull (A.TBind Range
    r TypedBindingInfo
    t List1 (NamedArg Binder)
    xs Expr
    ty)) Expr
    e) =
                case (NamedArg Binder -> Bool)
    -> List1 (NamedArg Binder) -> [NamedArg Binder]
    forall a. (a -> Bool) -> NonEmpty a -> [a]
    List1.filter (Bool -> Bool
    not (Bool -> Bool)
    -> (NamedArg Binder -> Bool) -> NamedArg Binder -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedArg Binder -> Bool
    forall a. (LensHiding a, LensOrigin a) => a -> Bool
    isInsertedHidden) List1 (NamedArg Binder)
    xs of
                  []    -> Expr -> ([LamBinding], Expr)
    lamView Expr
    e
                  NamedArg Binder
    x:[NamedArg Binder]
    xs' -> let b :: LamBinding
    b = TypedBinding -> LamBinding
    A.DomainFull (Range
    -> TypedBindingInfo
    -> List1 (NamedArg Binder)
    -> Expr
    -> TypedBinding
    A.TBind Range
    r TypedBindingInfo
    t (NamedArg Binder
    x NamedArg Binder -> [NamedArg Binder] -> List1 (NamedArg Binder)
    forall a. a -> [a] -> NonEmpty a
    :| [NamedArg Binder]
    xs') Expr
    ty) in
                    case Expr -> ([LamBinding], Expr)
    lamView Expr
    e of
                      (bs :: [LamBinding]
    bs@(A.DomainFull TypedBinding
    _ : [LamBinding]
    _), Expr
    e) -> (LamBinding
    bLamBinding -> [LamBinding] -> [LamBinding]
    forall a. a -> [a] -> [a]
    :[LamBinding]
    bs, Expr
    e)
                      ([LamBinding], Expr)
    _                            -> ([LamBinding
    b], Expr
    e)
              lamView Expr
    e = ([], Expr
    e)
        toConcrete (A.ExtendedLam ExprInfo
    i DefInfo
    di Erased
    erased QName
    qname List1 Clause
    cs) =
            (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    lamBrackets (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ do
              decls <- NonEmpty (NonEmpty Declaration) -> NonEmpty Declaration
    forall a. Semigroup a => NonEmpty a -> a
    sconcat (NonEmpty (NonEmpty Declaration) -> NonEmpty Declaration)
    -> m (NonEmpty (NonEmpty Declaration)) -> m (NonEmpty Declaration)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> List1 Clause -> m (ConOfAbs (List1 Clause))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    List1 Clause -> m (ConOfAbs (List1 Clause))
    toConcrete List1 Clause
    cs
              puns  <- optHiddenArgumentPuns <$> pragmaOptions
              let -- If --hidden-argument-puns is active, then {x} is
                  -- replaced by {(x)} and ⦃ x ⦄ by ⦃ (x) ⦄.
                  noPun (Named Maybe NamedName
    Nothing p :: Pattern
    p@C.IdentP{}) | Bool
    puns =
                    Maybe NamedName -> Pattern -> Named_ Pattern
    forall name a. Maybe name -> a -> Named name a
    Named Maybe NamedName
    forall a. Maybe a
    Nothing (Range -> Pattern -> Pattern
    C.ParenP Range
    forall a. Range' a
    noRange Pattern
    p)
                  noPun Named_ Pattern
    p = Named_ Pattern
    p

                  namedPat Arg (Named_ Pattern)
    np = case Arg (Named_ Pattern) -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding Arg (Named_ Pattern)
    np of
                     Hiding
    NotHidden  -> Arg (Named_ Pattern) -> Pattern
    forall a. NamedArg a -> a
    namedArg Arg (Named_ Pattern)
    np
                     Hiding
    Hidden     -> Range -> Named_ Pattern -> Pattern
    C.HiddenP Range
    forall a. Range' a
    noRange (Named_ Pattern -> Named_ Pattern
    noPun (Arg (Named_ Pattern) -> Named_ Pattern
    forall e. Arg e -> e
    unArg Arg (Named_ Pattern)
    np))
                     Instance{} -> Range -> Named_ Pattern -> Pattern
    C.InstanceP Range
    forall a. Range' a
    noRange (Named_ Pattern -> Named_ Pattern
    noPun (Arg (Named_ Pattern) -> Named_ Pattern
    forall e. Arg e -> e
    unArg Arg (Named_ Pattern)
    np))
                  -- we know all lhs are of the form `.extlam p1 p2 ... pn`,
                  -- with the name .extlam leftmost. It is our mission to remove it.
              let removeApp :: MonadToConcrete m => C.Pattern -> m [C.Pattern]
                  removeApp (C.RawAppP Range
    _ (List2 Pattern
    _ Pattern
    p [Pattern]
    ps)) = [Pattern] -> m [Pattern]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Pattern] -> m [Pattern]) -> [Pattern] -> m [Pattern]
    forall a b. (a -> b) -> a -> b
    $ Pattern
    pPattern -> [Pattern] -> [Pattern]
    forall a. a -> [a] -> [a]
    :[Pattern]
    ps
                  removeApp (C.AppP (C.IdentP Bool
    _ QName
    _) Arg (Named_ Pattern)
    np) = [Pattern] -> m [Pattern]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Arg (Named_ Pattern) -> Pattern
    namedPat Arg (Named_ Pattern)
    np]
                  removeApp (C.AppP Pattern
    p Arg (Named_ Pattern)
    np)            = Pattern -> m [Pattern]
    forall (m :: * -> *). MonadToConcrete m => Pattern -> m [Pattern]
    removeApp Pattern
    p m [Pattern] -> ([Pattern] -> [Pattern]) -> m [Pattern]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> ([Pattern] -> [Pattern] -> [Pattern]
    forall a. [a] -> [a] -> [a]
    ++ [Arg (Named_ Pattern) -> Pattern
    namedPat Arg (Named_ Pattern)
    np])
                  -- Andreas, 2018-06-18, issue #3136
                  -- Empty pattern list also allowed in extended lambda,
                  -- thus, we might face the unapplied .extendedlambda identifier.
                  removeApp x :: Pattern
    x@C.IdentP{} = [Pattern] -> m [Pattern]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

                  removeApp Pattern
    p = do
                    ArgName -> VerboseLevel -> ArgName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> ArgName -> m ()
    reportSLn ArgName
    "extendedlambda" VerboseLevel
    50 (ArgName -> m ()) -> ArgName -> m ()
    forall a b. (a -> b) -> a -> b
    $ ArgName
    "abstractToConcrete removeApp p = " ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> ArgName
    forall a. Show a => a -> ArgName
    show Pattern
    p
                    [Pattern] -> m [Pattern]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Pattern
    p] -- __IMPOSSIBLE__
                      -- Andreas, this is actually not impossible,
                      -- my strictification exposed this sleeping bug
              let decl2clause (C.FunClause (C.LHS Pattern
    p [] []) RHS
    rhs WhereClause' [Declaration]
    C.NoWhere Catchall
    ca) = do
                    ArgName -> VerboseLevel -> ArgName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> ArgName -> m ()
    reportSLn ArgName
    "extendedlambda" VerboseLevel
    50 (ArgName -> m ()) -> ArgName -> m ()
    forall a b. (a -> b) -> a -> b
    $ ArgName
    "abstractToConcrete extended lambda pattern p = " ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> ArgName
    forall a. Show a => a -> ArgName
    show Pattern
    p
                    ps <- Pattern -> m [Pattern]
    forall (m :: * -> *). MonadToConcrete m => Pattern -> m [Pattern]
    removeApp Pattern
    p
                    reportSLn "extendedlambda" 50 $ "abstractToConcrete extended lambda patterns ps = " ++ prettyShow ps
                    return $ LamClause ps rhs ca
                  decl2clause Declaration
    _ = m LamClause
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              C.ExtendedLam (getRange i) erased <$>
                mapM decl2clause decls

        toConcrete (A.Pi ExprInfo
    _ NonEmpty TypedBinding
    tel1 Expr
    e0) = do
          let (NonEmpty TypedBinding
    tel, Expr
    e) = NonEmpty TypedBinding -> Expr -> (NonEmpty TypedBinding, Expr)
    piTel1 NonEmpty TypedBinding
    tel1 Expr
    e0
          (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    piBrackets (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $
             NonEmpty TypedBinding
    -> (ConOfAbs (NonEmpty TypedBinding) -> m Expr) -> m Expr
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    NonEmpty TypedBinding
    -> (ConOfAbs (NonEmpty TypedBinding) -> m b) -> m b
    bindToConcrete NonEmpty TypedBinding
    tel ((ConOfAbs (NonEmpty TypedBinding) -> m Expr) -> m Expr)
    -> (ConOfAbs (NonEmpty TypedBinding) -> m Expr) -> m Expr
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (NonEmpty TypedBinding)
    tel' ->
               Telescope -> Expr -> Expr
    C.makePi (List1 (Maybe TypedBinding) -> Telescope
    forall a. List1 (Maybe a) -> [a]
    List1.catMaybes List1 (Maybe TypedBinding)
    ConOfAbs (NonEmpty TypedBinding)
    tel') (Expr -> Expr) -> m Expr -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> m (ConOfAbs Expr)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop Expr
    e
          where
            piTel1 :: NonEmpty TypedBinding -> Expr -> (NonEmpty TypedBinding, Expr)
    piTel1 NonEmpty TypedBinding
    tel Expr
    e         = (Telescope -> NonEmpty TypedBinding)
    -> (Telescope, Expr) -> (NonEmpty TypedBinding, Expr)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (NonEmpty TypedBinding -> Telescope -> NonEmpty TypedBinding
    forall a. NonEmpty a -> [a] -> NonEmpty a
    List1.appendList NonEmpty TypedBinding
    tel) ((Telescope, Expr) -> (NonEmpty TypedBinding, Expr))
    -> (Telescope, Expr) -> (NonEmpty TypedBinding, Expr)
    forall a b. (a -> b) -> a -> b
    $ Expr -> (Telescope, Expr)
    piTel Expr
    e
            piTel :: Expr -> (Telescope, Expr)
    piTel (A.Pi ExprInfo
    _ NonEmpty TypedBinding
    tel Expr
    e) = (NonEmpty TypedBinding -> Telescope)
    -> (NonEmpty TypedBinding, Expr) -> (Telescope, Expr)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first NonEmpty TypedBinding -> [Item (NonEmpty TypedBinding)]
    NonEmpty TypedBinding -> Telescope
    forall l. IsList l => l -> [Item l]
    List1.toList ((NonEmpty TypedBinding, Expr) -> (Telescope, Expr))
    -> (NonEmpty TypedBinding, Expr) -> (Telescope, Expr)
    forall a b. (a -> b) -> a -> b
    $ NonEmpty TypedBinding -> Expr -> (NonEmpty TypedBinding, Expr)
    piTel1 NonEmpty TypedBinding
    tel Expr
    e
            piTel Expr
    e              = ([], Expr
    e)

        toConcrete (A.Generalized Set1 QName
    _ Expr
    e) = Expr -> Expr
    C.Generalized (Expr -> Expr) -> m Expr -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    e

        toConcrete (A.Fun ExprInfo
    i Arg Expr
    a Expr
    b) =
            (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    piBrackets
            (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ do a' <- Precedence -> Arg Expr -> m (ConOfAbs (Arg Expr))
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    ctx Arg Expr
    a
                 b' <- toConcreteTop b
                 -- NOTE We set relevance to Relevant in arginfo because we wrap
                 -- with C.Dot or C.DoubleDot using addRel instead.
                 let dom = Relevance -> Arg Expr -> Arg Expr
    forall a. LensRelevance a => Relevance -> a -> a
    setRelevance Relevance
    relevant (Arg Expr -> Arg Expr) -> Arg Expr -> Arg Expr
    forall a b. (a -> b) -> a -> b
    $ Modality -> Arg Expr -> Arg Expr
    forall a. LensModality a => Modality -> a -> a
    setModality (Arg Expr -> Modality
    forall a. LensModality a => a -> Modality
    getModality Arg Expr
    a') (Arg Expr -> Arg Expr) -> Arg Expr -> Arg Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> Arg Expr
    forall a. a -> Arg a
    defaultArg (Expr -> Arg Expr) -> Expr -> Arg Expr
    forall a b. (a -> b) -> a -> b
    $ Arg Expr -> Expr -> Expr
    forall {a}. LensRelevance a => a -> Expr -> Expr
    addRel Arg Expr
    a' (Expr -> Expr) -> Expr -> Expr
    forall a b. (a -> b) -> a -> b
    $ Arg Expr -> Expr
    mkArg Arg Expr
    a'
                 return $ C.Fun (getRange i) dom b'
                 -- Andreas, 2018-06-14, issue #2513
                 -- TODO: print attributes
            where
                ctx :: Precedence
    ctx = if Arg Expr -> Bool
    forall a. LensRelevance a => a -> Bool
    isRelevant Arg Expr
    a then Precedence
    FunctionSpaceDomainCtx else Precedence
    DotPatternCtx
                addRel :: a -> Expr -> Expr
    addRel a
    a Expr
    e =
                  case a -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance a
    a of
                    Irrelevant      {} -> KwRange -> Expr -> Expr
    C.Dot KwRange
    forall a. Null a => a
    empty Expr
    e
                    ShapeIrrelevant {} -> KwRange -> Expr -> Expr
    C.DoubleDot KwRange
    forall a. Null a => a
    empty Expr
    e
                    Relevant        {} -> Expr
    e
                mkArg :: Arg Expr -> Expr
    mkArg (Arg ArgInfo
    info Expr
    e) = case ArgInfo -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding ArgInfo
    info of
                                              Hiding
    Hidden     -> Range -> Named_ Expr -> Expr
    HiddenArg   (Expr -> Range
    forall a. HasRange a => a -> Range
    getRange Expr
    e) (Expr -> Named_ Expr
    forall a name. a -> Named name a
    unnamed Expr
    e)
                                              Instance{} -> Range -> Named_ Expr -> Expr
    InstanceArg (Expr -> Range
    forall a. HasRange a => a -> Range
    getRange Expr
    e) (Expr -> Named_ Expr
    forall a name. a -> Named name a
    unnamed Expr
    e)
                                              Hiding
    NotHidden  -> Expr
    e

        toConcrete (A.Let ExprInfo
    i List1 LetBinding
    ds Expr
    e) =
            (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    lamBrackets
            (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ List1 LetBinding
    -> (ConOfAbs (List1 LetBinding) -> m Expr) -> m Expr
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    List1 LetBinding -> (ConOfAbs (List1 LetBinding) -> m b) -> m b
    bindToConcrete List1 LetBinding
    ds ((ConOfAbs (List1 LetBinding) -> m Expr) -> m Expr)
    -> (ConOfAbs (List1 LetBinding) -> m Expr) -> m Expr
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs (List1 LetBinding)
    ds' -> do
                 e'  <- Expr -> m (ConOfAbs Expr)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop Expr
    e
                 return $ C.mkLet (getRange i) (concat ds') e'

        toConcrete (A.Rec KwRange
    kwr ExprInfo
    i RecordAssigns
    fs) =
          (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    appBrackets (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ do
            KwRange -> Range -> RecordAssignments -> Expr
    C.Rec KwRange
    kwr (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) (RecordAssignments -> Expr)
    -> ([Either FieldAssignment QName] -> RecordAssignments)
    -> [Either FieldAssignment QName]
    -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Either FieldAssignment QName -> RecordAssignment)
    -> [Either FieldAssignment QName] -> RecordAssignments
    forall a b. (a -> b) -> [a] -> [b]
    map ((QName -> ModuleAssignment)
    -> Either FieldAssignment QName -> RecordAssignment
    forall a b.
    (a -> b) -> Either FieldAssignment a -> Either FieldAssignment b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\QName
    x -> QName -> [Expr] -> ImportDirective -> ModuleAssignment
    ModuleAssignment QName
    x [] ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir)) ([Either FieldAssignment QName] -> Expr)
    -> m [Either FieldAssignment QName] -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RecordAssigns -> m (ConOfAbs RecordAssigns)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop RecordAssigns
    fs

        toConcrete (A.RecUpdate KwRange
    kwr ExprInfo
    i Expr
    e Assigns
    fs) =
          (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket PrecedenceStack -> Bool
    appBrackets (m Expr -> m Expr) -> m Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ do
            KwRange -> Range -> Expr -> [FieldAssignment] -> Expr
    C.RecUpdate KwRange
    kwr (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) (Expr -> [FieldAssignment] -> Expr)
    -> m Expr -> m ([FieldAssignment] -> Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    e m ([FieldAssignment] -> Expr) -> m [FieldAssignment] -> m Expr
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Assigns -> m (ConOfAbs Assigns)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop Assigns
    fs

        toConcrete (A.ScopedExpr ScopeInfo
    _ Expr
    e) = Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    e
        toConcrete (A.Quote ExprInfo
    i) = Expr -> m Expr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> m Expr) -> Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Expr
    C.Quote (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i)
        toConcrete (A.QuoteTerm ExprInfo
    i) = Expr -> m Expr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> m Expr) -> Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Expr
    C.QuoteTerm (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i)
        toConcrete (A.Unquote ExprInfo
    i) = Expr -> m Expr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> m Expr) -> Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Expr
    C.Unquote (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i)

        -- Andreas, 2012-04-02: TODO!  print DontCare as irrAxiom
        -- Andreas, 2010-10-05 print irrelevant things as ordinary things
        toConcrete (A.DontCare Expr
    e) = KwRange -> Expr -> Expr
    C.Dot KwRange
    forall a. Null a => a
    empty (Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> Expr -> Expr
    C.Paren Range
    r  (Expr -> Expr) -> m Expr -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    e
           where r :: Range
    r = Expr -> Range
    forall a. HasRange a => a -> Range
    getRange Expr
    e
        toConcrete (A.PatternSyn AmbiguousQName
    n) = QName -> Expr
    C.Ident (QName -> Expr) -> m QName -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    n)

    makeDomainFree :: A.LamBinding -> A.LamBinding
    makeDomainFree :: LamBinding -> LamBinding
    makeDomainFree b :: LamBinding
    b@(A.DomainFull (A.TBind Range
    _ TypedBindingInfo
    tac (NamedArg Binder
    x :| []) Expr
    t)) =
      case Expr -> Expr
    unScope Expr
    t of
        A.Underscore A.MetaInfo{metaNumber :: MetaInfo -> Maybe MetaId
    metaNumber = Maybe MetaId
    Nothing} ->
          TacticAttribute -> NamedArg Binder -> LamBinding
    A.DomainFree (TypedBindingInfo -> TacticAttribute
    tbTacticAttr TypedBindingInfo
    tac) NamedArg Binder
    x
        Expr
    _ -> LamBinding
    b
    makeDomainFree LamBinding
    b = LamBinding
    b

    -- Binder instances -------------------------------------------------------

    -- If there is no label we set it to the bound name, to make renaming the bound
    -- name safe.
    forceNameIfHidden :: NamedArg A.Binder -> NamedArg A.Binder
    forceNameIfHidden :: NamedArg Binder -> NamedArg Binder
    forceNameIfHidden NamedArg Binder
    x
      | Maybe NamedName -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe NamedName -> Bool) -> Maybe NamedName -> Bool
    forall a b. (a -> b) -> a -> b
    $ NamedArg Binder -> Maybe (NameOf (NamedArg Binder))
    forall a. LensNamed a => a -> Maybe (NameOf a)
    getNameOf  NamedArg Binder
    x = NamedArg Binder
    x
      | NamedArg Binder -> Bool
    forall a. LensHiding a => a -> Bool
    visible NamedArg Binder
    x             = NamedArg Binder
    x
      | Bool
    otherwise             = Maybe (NameOf (NamedArg Binder))
    -> NamedArg Binder -> NamedArg Binder
    forall a. LensNamed a => Maybe (NameOf a) -> a -> a
    setNameOf (NamedName -> Maybe NamedName
    forall a. a -> Maybe a
    Just NamedName
    name) NamedArg Binder
    x
      where
        name :: NamedName
    name = Origin -> Ranged ArgName -> NamedName
    forall a. Origin -> a -> WithOrigin a
    WithOrigin Origin
    Inserted
             (Ranged ArgName -> NamedName) -> Ranged ArgName -> NamedName
    forall a b. (a -> b) -> a -> b
    $ Range -> ArgName -> Ranged ArgName
    forall a. Range -> a -> Ranged a
    Ranged (NamedArg Binder -> Range
    forall a. HasRange a => a -> Range
    getRange NamedArg Binder
    x)
             (ArgName -> Ranged ArgName) -> ArgName -> Ranged ArgName
    forall a b. (a -> b) -> a -> b
    $ Name -> ArgName
    C.nameToRawName (Name -> ArgName) -> Name -> ArgName
    forall a b. (a -> b) -> a -> b
    $ Name -> Name
    nameConcrete
             (Name -> Name) -> Name -> Name
    forall a b. (a -> b) -> a -> b
    $ BindName -> Name
    unBind (BindName -> Name) -> BindName -> Name
    forall a b. (a -> b) -> a -> b
    $ Binder -> BindName
    forall a. Binder' a -> a
    A.binderName (Binder -> BindName) -> Binder -> BindName
    forall a b. (a -> b) -> a -> b
    $ NamedArg Binder -> Binder
    forall a. NamedArg a -> a
    namedArg NamedArg Binder
    x

    instance ToConcrete a => ToConcrete (A.Binder' a) where
      type ConOfAbs (A.Binder' a) = C.Binder' (ConOfAbs a)

      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    Binder' a -> (ConOfAbs (Binder' a) -> m b) -> m b
    bindToConcrete (A.Binder Maybe Pattern
    p BinderNameOrigin
    o a
    a) ConOfAbs (Binder' a) -> m b
    ret =
        a -> (ConOfAbs a -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcrete a
    a ((ConOfAbs a -> m b) -> m b) -> (ConOfAbs a -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs a
    a ->
        Maybe Pattern -> (ConOfAbs (Maybe Pattern) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Maybe Pattern -> (ConOfAbs (Maybe Pattern) -> m b) -> m b
    bindToConcrete Maybe Pattern
    p ((ConOfAbs (Maybe Pattern) -> m b) -> m b)
    -> (ConOfAbs (Maybe Pattern) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (Maybe Pattern)
    p ->
        ConOfAbs (Binder' a) -> m b
    ret (ConOfAbs (Binder' a) -> m b) -> ConOfAbs (Binder' a) -> m b
    forall a b. (a -> b) -> a -> b
    $ Maybe Pattern
    -> BinderNameOrigin -> ConOfAbs a -> Binder' (ConOfAbs a)
    forall a. Maybe Pattern -> BinderNameOrigin -> a -> Binder' a
    C.Binder Maybe Pattern
    ConOfAbs (Maybe Pattern)
    p BinderNameOrigin
    o ConOfAbs a
    a

    instance ToConcrete A.LamBinding where
        type ConOfAbs A.LamBinding = Maybe C.LamBinding

        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    LamBinding -> (ConOfAbs LamBinding -> m b) -> m b
    bindToConcrete (A.DomainFree TacticAttribute
    t NamedArg Binder
    x) ConOfAbs LamBinding -> m b
    ret = do
          t <- (Expr -> m Expr) -> TacticAttribute -> m (TacticAttribute' Expr)
    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) -> TacticAttribute' a -> f (TacticAttribute' b)
    traverse Expr -> m Expr
    Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete TacticAttribute
    t
          let setTac BoundName
    x = BoundName
    x { bnameTactic = t }
          bindToConcrete (forceNameIfHidden x) $
            ret . Just . C.DomainFree . updateNamedArg (fmap setTac)
        bindToConcrete (A.DomainFull TypedBinding
    b) ConOfAbs LamBinding -> m b
    ret = TypedBinding -> (ConOfAbs TypedBinding -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    TypedBinding -> (ConOfAbs TypedBinding -> m b) -> m b
    bindToConcrete TypedBinding
    b ((ConOfAbs TypedBinding -> m b) -> m b)
    -> (ConOfAbs TypedBinding -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Maybe LamBinding -> m b
    ConOfAbs LamBinding -> m b
    ret (Maybe LamBinding -> m b)
    -> (Maybe TypedBinding -> Maybe LamBinding)
    -> Maybe TypedBinding
    -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TypedBinding -> LamBinding)
    -> Maybe TypedBinding -> Maybe LamBinding
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TypedBinding -> LamBinding
    forall a. a -> LamBinding' a
    C.DomainFull

    instance ToConcrete A.TypedBinding where
        type ConOfAbs A.TypedBinding = Maybe C.TypedBinding

        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    TypedBinding -> (ConOfAbs TypedBinding -> m b) -> m b
    bindToConcrete (A.TBind Range
    r TypedBindingInfo
    t List1 (NamedArg Binder)
    xs Expr
    e) ConOfAbs TypedBinding -> m b
    ret = do
            tac <- (Expr -> m Expr) -> TacticAttribute -> m (TacticAttribute' Expr)
    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) -> TacticAttribute' a -> f (TacticAttribute' b)
    traverse Expr -> m Expr
    Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete (TypedBindingInfo -> TacticAttribute
    tbTacticAttr TypedBindingInfo
    t)
            bindToConcrete (fmap forceNameIfHidden xs) $ \ ConOfAbs (List1 (NamedArg Binder))
    xs -> do
              e <- Expr -> m (ConOfAbs Expr)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop Expr
    e
              let setTac BoundName
    x = BoundName
    x { bnameTactic = tac , C.bnameIsFinite = tbFinite t }
              ret $ Just $ C.TBind r (fmap (updateNamedArg (fmap setTac)) xs) e
        bindToConcrete (A.TLet Range
    r List1 LetBinding
    lbs) ConOfAbs TypedBinding -> m b
    ret =
            List1 LetBinding -> (ConOfAbs (List1 LetBinding) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    List1 LetBinding -> (ConOfAbs (List1 LetBinding) -> m b) -> m b
    bindToConcrete List1 LetBinding
    lbs ((ConOfAbs (List1 LetBinding) -> m b) -> m b)
    -> (ConOfAbs (List1 LetBinding) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (List1 LetBinding)
    ds -> do
            ConOfAbs TypedBinding -> m b
    ret (ConOfAbs TypedBinding -> m b) -> ConOfAbs TypedBinding -> m b
    forall a b. (a -> b) -> a -> b
    $ Range -> [Declaration] -> Maybe TypedBinding
    forall e. Range -> [Declaration] -> Maybe (TypedBinding' e)
    C.mkTLet Range
    r ([Declaration] -> Maybe TypedBinding)
    -> [Declaration] -> Maybe TypedBinding
    forall a b. (a -> b) -> a -> b
    $ NonEmpty [Declaration] -> [Declaration]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat NonEmpty [Declaration]
    ConOfAbs (List1 LetBinding)
    ds

    instance ToConcrete A.LetBinding where
        type ConOfAbs A.LetBinding = [C.Declaration]

        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    LetBinding -> (ConOfAbs LetBinding -> m b) -> m b
    bindToConcrete (A.LetBind LetInfo
    i ArgInfo
    info BindName
    x Expr
    t Expr
    e) ConOfAbs LetBinding -> m b
    ret =
          BindName -> (ConOfAbs BindName -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    BindName -> (ConOfAbs BindName -> m b) -> m b
    bindToConcrete BindName
    x \ ConOfAbs BindName
    x -> do
            (Expr, RHS) -> m (ConOfAbs (Expr, RHS))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    (Expr, RHS) -> m (ConOfAbs (Expr, RHS))
    toConcrete (Expr
    t, Expr -> Maybe Expr -> RHS
    A.RHS Expr
    e Maybe Expr
    forall a. Maybe a
    Nothing) m (Expr, (RHS, [RewriteEqn], [WithExpr], [Declaration]))
    -> ((Expr, (RHS, [RewriteEqn], [WithExpr], [Declaration])) -> m b)
    -> m b
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
              (Expr
    t, (RHS
    e, [], [], [])) ->
               ConOfAbs LetBinding -> m b
    ret (ConOfAbs LetBinding -> m b) -> ConOfAbs LetBinding -> m b
    forall a b. (a -> b) -> a -> b
    $ Maybe KwRange -> [Declaration] -> [Declaration]
    addInstanceB (if ArgInfo -> Bool
    forall a. LensHiding a => a -> Bool
    isInstance ArgInfo
    info then KwRange -> Maybe KwRange
    forall a. a -> Maybe a
    Just KwRange
    forall a. Null a => a
    empty else Maybe KwRange
    forall a. Maybe a
    Nothing) ([Declaration] -> [Declaration]) -> [Declaration] -> [Declaration]
    forall a b. (a -> b) -> a -> b
    $
                   [ ArgInfo -> TacticAttribute' Expr -> Name -> Expr -> Declaration
    C.TypeSig ArgInfo
    info TacticAttribute' Expr
    forall a. Null a => a
    empty (BoundName -> Name
    C.boundName BoundName
    ConOfAbs BindName
    x) Expr
    t
                   , LHS -> RHS -> WhereClause' [Declaration] -> Catchall -> Declaration
    C.FunClause
                       (Pattern -> [RewriteEqn] -> [WithExpr] -> LHS
    C.LHS (Bool -> QName -> Pattern
    C.IdentP Bool
    True (QName -> Pattern) -> QName -> Pattern
    forall a b. (a -> b) -> a -> b
    $ Name -> QName
    C.QName (Name -> QName) -> Name -> QName
    forall a b. (a -> b) -> a -> b
    $ BoundName -> Name
    C.boundName BoundName
    ConOfAbs BindName
    x) [] [])
                       RHS
    e WhereClause' [Declaration]
    forall decls. WhereClause' decls
    C.NoWhere Catchall
    forall a. Null a => a
    empty
                   ]
              (Expr, (RHS, [RewriteEqn], [WithExpr], [Declaration]))
    _ -> m b
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        bindToConcrete (A.LetAxiom LetInfo
    i ArgInfo
    info BindName
    x Expr
    t) ConOfAbs LetBinding -> m b
    ret = BindName -> (ConOfAbs BindName -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    BindName -> (ConOfAbs BindName -> m b) -> m b
    bindToConcrete BindName
    x \ConOfAbs BindName
    x -> do
          t <- Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    t
          ret $ addInstanceB (if isInstance info then Just empty else Nothing) $
            [ C.TypeSig info empty (C.boundName x) t ]
        -- TODO: bind variables
        bindToConcrete (LetPatBind LetInfo
    i Pattern
    p Expr
    e) ConOfAbs LetBinding -> m b
    ret = do
            p <- Pattern -> m (ConOfAbs Pattern)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m (ConOfAbs Pattern)
    toConcrete Pattern
    p
            e <- toConcrete e
            ret [ C.FunClause (C.LHS p [] []) (C.RHS e) NoWhere empty ]
        bindToConcrete (LetApply ModuleInfo
    i Erased
    erased ModuleName
    x ModuleApplication
    modapp ScopeCopyInfo
    _ ImportDirective
    _) ConOfAbs LetBinding -> m b
    ret = do
          x' <- QName -> Name
    unqualify (QName -> Name) -> m QName -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ModuleName -> m (ConOfAbs ModuleName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    ModuleName -> m (ConOfAbs ModuleName)
    toConcrete ModuleName
    x
          modapp <- toConcrete modapp
          let r = ModuleApplication -> Range
    forall a. HasRange a => a -> Range
    getRange ModuleApplication
    modapp
              open = OpenShortHand -> Maybe OpenShortHand -> OpenShortHand
    forall a. a -> Maybe a -> a
    fromMaybe OpenShortHand
    DontOpen (Maybe OpenShortHand -> OpenShortHand)
    -> Maybe OpenShortHand -> OpenShortHand
    forall a b. (a -> b) -> a -> b
    $ ModuleInfo -> Maybe OpenShortHand
    minfoOpenShort ModuleInfo
    i
              dir  = ImportDirective -> Maybe ImportDirective -> ImportDirective
    forall a. a -> Maybe a -> a
    fromMaybe ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir{ importDirRange = r } (Maybe ImportDirective -> ImportDirective)
    -> Maybe ImportDirective -> ImportDirective
    forall a b. (a -> b) -> a -> b
    $ ModuleInfo -> Maybe ImportDirective
    minfoDirective ModuleInfo
    i
          -- This is no use since toAbstract LetDefs is in localToAbstract.
          local (openModule' x dir id) $
            ret [ C.ModuleMacro (getRange i) erased x' modapp open dir ]
        bindToConcrete (LetOpen ModuleInfo
    i ModuleName
    x ImportDirective
    _) ConOfAbs LetBinding -> m b
    ret = do
          x' <- ModuleName -> m (ConOfAbs ModuleName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    ModuleName -> m (ConOfAbs ModuleName)
    toConcrete ModuleName
    x
          let dir = ImportDirective -> Maybe ImportDirective -> ImportDirective
    forall a. a -> Maybe a -> a
    fromMaybe ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir (Maybe ImportDirective -> ImportDirective)
    -> Maybe ImportDirective -> ImportDirective
    forall a b. (a -> b) -> a -> b
    $ ModuleInfo -> Maybe ImportDirective
    minfoDirective ModuleInfo
    i
          local (openModule' x dir restrictPrivate) $
                ret [ C.Open (getRange i) x' dir ]

    instance ToConcrete A.WhereDeclarations where
      type ConOfAbs A.WhereDeclarations = WhereClause

      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    WhereDeclarations -> (ConOfAbs WhereDeclarations -> m b) -> m b
    bindToConcrete (A.WhereDecls Maybe ModuleName
    _ Bool
    _ Maybe Declaration
    Nothing) ConOfAbs WhereDeclarations -> m b
    ret = ConOfAbs WhereDeclarations -> m b
    ret WhereClause' [Declaration]
    ConOfAbs WhereDeclarations
    forall decls. WhereClause' decls
    C.NoWhere
      bindToConcrete (A.WhereDecls (Just ModuleName
    am) Bool
    False
                        (Just (A.Section Range
    _ Erased
    erased ModuleName
    _ GeneralizeTelescope
    _ [Declaration]
    ds)))
                     ConOfAbs WhereDeclarations -> m b
    ret = do
        ds' <- [Declaration] -> m [Declaration]
    forall (m :: * -> *).
    MonadToConcrete m =>
    [Declaration] -> m [Declaration]
    declsToConcrete [Declaration]
    ds
        cm  <- unqualify <$> lookupModule am
        -- Andreas, 2016-07-08 I put PublicAccess in the following SomeWhere
        -- Should not really matter for printing...
        let wh' = if Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    cm Bool -> Bool -> Bool
    && Bool -> Bool
    not (Erased -> Bool
    isErased Erased
    erased)
                  then Range -> [Declaration] -> WhereClause' [Declaration]
    forall decls. Range -> decls -> WhereClause' decls
    AnyWhere Range
    forall a. Range' a
    noRange [Declaration]
    ds'
                  else Range
    -> Erased
    -> Name
    -> Access
    -> [Declaration]
    -> WhereClause' [Declaration]
    forall decls.
    Range -> Erased -> Name -> Access -> decls -> WhereClause' decls
    SomeWhere Range
    forall a. Range' a
    noRange Erased
    erased Name
    cm Access
    PublicAccess [Declaration]
    ds'
        local (openModule' am defaultImportDir id) $ ret wh'
      bindToConcrete (A.WhereDecls Maybe ModuleName
    _ Bool
    _ (Just Declaration
    d)) ConOfAbs WhereDeclarations -> m b
    ret =
        WhereClause' [Declaration] -> m b
    ConOfAbs WhereDeclarations -> m b
    ret (WhereClause' [Declaration] -> m b)
    -> ([Declaration] -> WhereClause' [Declaration])
    -> [Declaration]
    -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> [Declaration] -> WhereClause' [Declaration]
    forall decls. Range -> decls -> WhereClause' decls
    AnyWhere Range
    forall a. Range' a
    noRange ([Declaration] -> m b) -> m [Declaration] -> m b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Declaration -> m (ConOfAbs Declaration)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Declaration -> m (ConOfAbs Declaration)
    toConcrete Declaration
    d

    mergeSigAndDef :: [C.Declaration] -> [C.Declaration]
    mergeSigAndDef :: [Declaration] -> [Declaration]
    mergeSigAndDef (C.RecordSig Range
    _ Erased
    er Name
    x [LamBinding]
    bs Expr
    e : C.RecordDef Range
    r Name
    y [RecordDirective]
    dir [LamBinding]
    _ [Declaration]
    fs : [Declaration]
    ds)
      | Name
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    y = Range
    -> Erased
    -> Name
    -> [RecordDirective]
    -> [LamBinding]
    -> Expr
    -> [Declaration]
    -> Declaration
    C.Record Range
    r Erased
    er Name
    y [RecordDirective]
    dir [LamBinding]
    bs Expr
    e [Declaration]
    fs Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    : [Declaration] -> [Declaration]
    mergeSigAndDef [Declaration]
    ds
    mergeSigAndDef (C.DataSig Range
    _ Erased
    er Name
    x [LamBinding]
    bs Expr
    e : C.DataDef Range
    r Name
    y [LamBinding]
    _ [Declaration]
    cs : [Declaration]
    ds)
      | Name
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    y = Range
    -> Erased
    -> Name
    -> [LamBinding]
    -> Expr
    -> [Declaration]
    -> Declaration
    C.Data Range
    r Erased
    er Name
    y [LamBinding]
    bs Expr
    e [Declaration]
    cs Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    : [Declaration] -> [Declaration]
    mergeSigAndDef [Declaration]
    ds
    mergeSigAndDef (Declaration
    d : [Declaration]
    ds) = Declaration
    d Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    : [Declaration] -> [Declaration]
    mergeSigAndDef [Declaration]
    ds
    mergeSigAndDef [] = []

    openModule' :: A.ModuleName -> C.ImportDirective -> (Scope -> Scope) -> Env -> Env
    openModule' :: ModuleName -> ImportDirective -> (Scope -> Scope) -> Env -> Env
    openModule' ModuleName
    x ImportDirective
    dir Scope -> Scope
    restrict Env
    env = Env
    env{currentScope = set scopeModules mods' sInfo}
      where sInfo :: ScopeInfo
    sInfo = Env -> ScopeInfo
    currentScope Env
    env
            amod :: ModuleName
    amod  = ScopeInfo
    sInfo ScopeInfo -> Lens' ScopeInfo ModuleName -> ModuleName
    forall o i. o -> Lens' o i -> i
    ^. (ModuleName -> f ModuleName) -> ScopeInfo -> f ScopeInfo
    Lens' ScopeInfo ModuleName
    scopeCurrent
            mods :: Map ModuleName Scope
    mods  = ScopeInfo
    sInfo ScopeInfo
    -> Lens' ScopeInfo (Map ModuleName Scope) -> Map ModuleName Scope
    forall o i. o -> Lens' o i -> i
    ^. (Map ModuleName Scope -> f (Map ModuleName Scope))
    -> ScopeInfo -> f ScopeInfo
    Lens' ScopeInfo (Map ModuleName Scope)
    scopeModules
            news :: Scope
    news  = NameSpaceId -> Scope -> Scope
    setScopeAccess NameSpaceId
    PrivateNS
                    (Scope -> Scope) -> Scope -> Scope
    forall a b. (a -> b) -> a -> b
    $ ImportDirective -> Scope -> Scope
    applyImportDirective ImportDirective
    dir
                    (Scope -> Scope) -> Scope -> Scope
    forall a b. (a -> b) -> a -> b
    $ Scope -> (Scope -> Scope) -> Maybe Scope -> Scope
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Scope
    emptyScope Scope -> Scope
    restrict
                    (Maybe Scope -> Scope) -> Maybe Scope -> Scope
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> Map ModuleName Scope -> Maybe Scope
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ModuleName
    x Map ModuleName Scope
    mods
            mods' :: Map ModuleName Scope
    mods' = (Scope -> Maybe Scope)
    -> ModuleName -> Map ModuleName Scope -> Map ModuleName Scope
    forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
    Map.update (Scope -> Maybe Scope
    forall a. a -> Maybe a
    Just (Scope -> Maybe Scope) -> (Scope -> Scope) -> Scope -> Maybe Scope
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Scope -> Scope -> Scope
    `mergeScope` Scope
    news)) ModuleName
    amod Map ModuleName Scope
    mods

    -- Declaration instances --------------------------------------------------

    declsToConcrete :: MonadToConcrete m => [A.Declaration] -> m [C.Declaration]
    declsToConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    [Declaration] -> m [Declaration]
    declsToConcrete [Declaration]
    ds = [Declaration] -> [Declaration]
    mergeSigAndDef ([Declaration] -> [Declaration])
    -> ([[Declaration]] -> [Declaration])
    -> [[Declaration]]
    -> [Declaration]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Declaration]] -> [Declaration]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Declaration]] -> [Declaration])
    -> m [[Declaration]] -> m [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Declaration] -> m (ConOfAbs [Declaration])
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    [Declaration] -> m (ConOfAbs [Declaration])
    toConcrete [Declaration]
    ds

    instance ToConcrete A.RHS where
        type ConOfAbs A.RHS = (C.RHS, [C.RewriteEqn], [C.WithExpr], [C.Declaration])

        toConcrete :: forall (m :: * -> *). MonadToConcrete m => RHS -> m (ConOfAbs RHS)
    toConcrete (A.RHS Expr
    e (Just Expr
    c)) = (RHS, [RewriteEqn], [WithExpr], [Declaration])
    -> m (RHS, [RewriteEqn], [WithExpr], [Declaration])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> RHS
    forall e. e -> RHS' e
    C.RHS Expr
    c, [], [], [])
        toConcrete (A.RHS Expr
    e Maybe Expr
    Nothing) = do
          e <- Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    e
          return (C.RHS e, [], [], [])
        toConcrete RHS
    A.AbsurdRHS = (RHS, [RewriteEqn], [WithExpr], [Declaration])
    -> m (RHS, [RewriteEqn], [WithExpr], [Declaration])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RHS
    forall e. RHS' e
    C.AbsurdRHS, [], [], [])
        toConcrete (A.WithRHS QName
    _ List1 WithExpr
    es List1 Clause
    cs) = do
          es <- do es <- List1 WithExpr -> m (ConOfAbs (List1 WithExpr))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    List1 WithExpr -> m (ConOfAbs (List1 WithExpr))
    toConcrete List1 WithExpr
    es
                   forM es $ \ (Named Maybe BindName
    n Arg Expr
    e) -> do
                     n <- (BindName -> m BoundName) -> Maybe BindName -> m (Maybe BoundName)
    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) -> Maybe a -> f (Maybe b)
    traverse BindName -> m BoundName
    BindName -> m (ConOfAbs BindName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    BindName -> m (ConOfAbs BindName)
    toConcrete Maybe BindName
    n
                     pure $ Named (C.boundName <$> n) e
          cs <- noTakenNames $ sconcat <$> toConcrete cs
          return (C.AbsurdRHS, [], List1.toList es, List1.toList cs)
        toConcrete (A.RewriteRHS [RewriteEqn]
    xeqs [ProblemEq]
    _spats RHS
    rhs WhereDeclarations
    wh) = do
          wh <- m [Declaration]
    -> (Declaration -> m [Declaration])
    -> Maybe Declaration
    -> m [Declaration]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Declaration] -> m [Declaration]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []) Declaration -> m [Declaration]
    Declaration -> m (ConOfAbs Declaration)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Declaration -> m (ConOfAbs Declaration)
    toConcrete (Maybe Declaration -> m [Declaration])
    -> Maybe Declaration -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $ WhereDeclarations -> Maybe Declaration
    A.whereDecls WhereDeclarations
    wh
          (rhs, eqs', es, whs) <- toConcrete rhs
          unless (null eqs') __IMPOSSIBLE__
          eqs <- toConcrete xeqs
          return (rhs, eqs, es, wh ++ whs)

    instance (ToConcrete p, ToConcrete a) => ToConcrete (RewriteEqn' qn A.BindName p a) where
      type ConOfAbs (RewriteEqn' qn A.BindName p a) = (RewriteEqn' () C.Name (ConOfAbs p) (ConOfAbs a))

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    RewriteEqn' qn BindName p a
    -> m (ConOfAbs (RewriteEqn' qn BindName p a))
    toConcrete = \case
        Rewrite List1 (qn, a)
    es    -> List1 ((), ConOfAbs a)
    -> RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a)
    forall qn nm p e. List1 (qn, e) -> RewriteEqn' qn nm p e
    Rewrite (List1 ((), ConOfAbs a)
     -> RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a))
    -> m (List1 ((), ConOfAbs a))
    -> m (RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((qn, a) -> m ((), ConOfAbs a))
    -> List1 (qn, a) -> m (List1 ((), ConOfAbs a))
    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) -> NonEmpty a -> m (NonEmpty b)
    mapM (((), a) -> m ((), ConOfAbs a)
    ((), a) -> m (ConOfAbs ((), a))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    ((), a) -> m (ConOfAbs ((), a))
    toConcrete (((), a) -> m ((), ConOfAbs a))
    -> ((qn, a) -> ((), a)) -> (qn, a) -> m ((), ConOfAbs a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\ (qn
    _, a
    e) -> ((),a
    e))) List1 (qn, a)
    es
        Invert qn
    qn List1 (Named BindName (p, a))
    pes -> (List1 (Named Name (ConOfAbs p, ConOfAbs a))
     -> ConOfAbs (RewriteEqn' qn BindName p a))
    -> m (List1 (Named Name (ConOfAbs p, ConOfAbs a)))
    -> m (ConOfAbs (RewriteEqn' qn BindName p a))
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (()
    -> List1 (Named Name (ConOfAbs p, ConOfAbs a))
    -> RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a)
    forall qn nm p e.
    qn -> List1 (Named nm (p, e)) -> RewriteEqn' qn nm p e
    Invert ()) (m (List1 (Named Name (ConOfAbs p, ConOfAbs a)))
     -> m (ConOfAbs (RewriteEqn' qn BindName p a)))
    -> m (List1 (Named Name (ConOfAbs p, ConOfAbs a)))
    -> m (ConOfAbs (RewriteEqn' qn BindName p a))
    forall a b. (a -> b) -> a -> b
    $ List1 (Named BindName (p, a))
    -> (Named BindName (p, a)
        -> m (Named Name (ConOfAbs p, ConOfAbs a)))
    -> m (List1 (Named Name (ConOfAbs p, ConOfAbs a)))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM List1 (Named BindName (p, a))
    pes ((Named BindName (p, a) -> m (Named Name (ConOfAbs p, ConOfAbs a)))
     -> m (List1 (Named Name (ConOfAbs p, ConOfAbs a))))
    -> (Named BindName (p, a)
        -> m (Named Name (ConOfAbs p, ConOfAbs a)))
    -> m (List1 (Named Name (ConOfAbs p, ConOfAbs a)))
    forall a b. (a -> b) -> a -> b
    $ \ (Named Maybe BindName
    n (p, a)
    pe) -> do
          pe <- (p, a) -> m (ConOfAbs (p, a))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    (p, a) -> m (ConOfAbs (p, a))
    toConcrete (p, a)
    pe
          n  <- fmap C.boundName <$> toConcrete n
          pure $ Named n pe
        LeftLet List1 (p, a)
    pes -> List1 (ConOfAbs p, ConOfAbs a)
    -> RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a)
    forall qn nm p e. List1 (p, e) -> RewriteEqn' qn nm p e
    LeftLet (List1 (ConOfAbs p, ConOfAbs a)
     -> RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a))
    -> m (List1 (ConOfAbs p, ConOfAbs a))
    -> m (RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((p, a) -> m (ConOfAbs p, ConOfAbs a))
    -> List1 (p, a) -> m (List1 (ConOfAbs p, ConOfAbs a))
    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) -> NonEmpty a -> m (NonEmpty b)
    mapM (p, a) -> m (ConOfAbs p, ConOfAbs a)
    (p, a) -> m (ConOfAbs (p, a))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    (p, a) -> m (ConOfAbs (p, a))
    toConcrete List1 (p, a)
    pes

    instance ToConcrete (Constr A.Constructor) where
      type ConOfAbs (Constr A.Constructor) = C.Declaration

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Constr Declaration -> m (ConOfAbs (Constr Declaration))
    toConcrete (Constr (A.ScopedDecl ScopeInfo
    scope [Declaration
    d])) =
        ScopeInfo
    -> m (ConOfAbs (Constr Declaration))
    -> m (ConOfAbs (Constr Declaration))
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    ScopeInfo -> m a -> m a
    withScope ScopeInfo
    scope (m (ConOfAbs (Constr Declaration))
     -> m (ConOfAbs (Constr Declaration)))
    -> m (ConOfAbs (Constr Declaration))
    -> m (ConOfAbs (Constr Declaration))
    forall a b. (a -> b) -> a -> b
    $ Constr Declaration -> m (ConOfAbs (Constr Declaration))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Constr Declaration -> m (ConOfAbs (Constr Declaration))
    toConcrete (Declaration -> Constr Declaration
    forall a. a -> Constr a
    Constr Declaration
    d)
      toConcrete (Constr (A.Axiom KindOfName
    _ DefInfo
    i ArgInfo
    info Maybe PragmaPolarities
    Nothing QName
    x Expr
    t)) = do
        x' <- QName -> Name
    unsafeQNameToName (QName -> Name) -> m QName -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        t' <- toConcreteTop t
        return $ C.TypeSig info empty x' t'
      toConcrete (Constr (A.Axiom KindOfName
    _ DefInfo
    _ ArgInfo
    _ (Just PragmaPolarities
    _) QName
    _ Expr
    _)) = m Declaration
    m (ConOfAbs (Constr Declaration))
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toConcrete (Constr Declaration
    d) = Declaration -> [Declaration] -> Declaration
    forall a. a -> [a] -> a
    headWithDefault Declaration
    forall a. HasCallStack => a
    __IMPOSSIBLE__ ([Declaration] -> Declaration) -> m [Declaration] -> m Declaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Declaration -> m (ConOfAbs Declaration)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Declaration -> m (ConOfAbs Declaration)
    toConcrete Declaration
    d

    instance (ToConcrete a, ConOfAbs a ~ C.LHS) => ToConcrete (A.Clause' a) where
      type ConOfAbs (A.Clause' a) = List1 C.Declaration

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Clause' a -> m (ConOfAbs (Clause' a))
    toConcrete (A.Clause a
    lhs [ProblemEq]
    _ RHS
    rhs WhereDeclarations
    wh Catchall
    catchall) =
          a
    -> (ConOfAbs a -> m (ConOfAbs (Clause' a)))
    -> m (ConOfAbs (Clause' a))
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    a -> (ConOfAbs a -> m b) -> m b
    bindToConcrete a
    lhs ((ConOfAbs a -> m (ConOfAbs (Clause' a)))
     -> m (ConOfAbs (Clause' a)))
    -> (ConOfAbs a -> m (ConOfAbs (Clause' a)))
    -> m (ConOfAbs (Clause' a))
    forall a b. (a -> b) -> a -> b
    $ \case
              C.LHS Pattern
    p [RewriteEqn]
    _ [WithExpr]
    _ -> do
                WhereDeclarations
    -> (ConOfAbs WhereDeclarations -> m (ConOfAbs (Clause' a)))
    -> m (ConOfAbs (Clause' a))
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    WhereDeclarations -> (ConOfAbs WhereDeclarations -> m b) -> m b
    bindToConcrete WhereDeclarations
    wh ((ConOfAbs WhereDeclarations -> m (ConOfAbs (Clause' a)))
     -> m (ConOfAbs (Clause' a)))
    -> (ConOfAbs WhereDeclarations -> m (ConOfAbs (Clause' a)))
    -> m (ConOfAbs (Clause' a))
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs WhereDeclarations
    wh' -> do
                    (rhs', eqs, with, wcs) <- RHS -> m (ConOfAbs RHS)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    a -> m (ConOfAbs a)
    toConcreteTop RHS
    rhs
                    return $ FunClause (C.LHS p eqs with) rhs' wh' catchall :| wcs

    instance ToConcrete A.ModuleApplication where
      type ConOfAbs A.ModuleApplication = C.ModuleApplication

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    ModuleApplication -> m (ConOfAbs ModuleApplication)
    toConcrete (A.SectionApp Telescope
    tel ModuleName
    y [NamedArg Expr]
    es) = do
        y  <- Precedence -> ModuleName -> m (ConOfAbs ModuleName)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    FunctionCtx ModuleName
    y
        bindToConcrete tel $ \ ConOfAbs Telescope
    tel -> do
          es <- Precedence -> [NamedArg Expr] -> m (ConOfAbs [NamedArg Expr])
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    argumentCtx_ [NamedArg Expr]
    es
          let r = QName -> [NamedArg Expr] -> Range
    forall u t. (HasRange u, HasRange t) => u -> t -> Range
    fuseRange QName
    y [NamedArg Expr]
    es
          return $ C.SectionApp r (catMaybes tel) y $ map unNamedArg es

      toConcrete (A.RecordModuleInstance ModuleName
    recm) = do
        recm <- ModuleName -> m (ConOfAbs ModuleName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    ModuleName -> m (ConOfAbs ModuleName)
    toConcrete ModuleName
    recm
        return $ C.RecordModuleInstance (getRange recm) recm

    instance ToConcrete A.RecordDirectives where
      type ConOfAbs A.RecordDirectives = [C.RecordDirective]

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    RecordDirectives -> m (ConOfAbs RecordDirectives)
    toConcrete RecordDirectives
    dir = RecordDirectives -> [RecordDirective]
    C.ungatherRecordDirectives (RecordDirectives -> [RecordDirective])
    -> m RecordDirectives -> m [RecordDirective]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (RecordConName -> m (Maybe (Name, IsInstance)))
    -> RecordDirectives -> m RecordDirectives
    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) -> RecordDirectives' a -> f (RecordDirectives' b)
    traverse RecordConName -> m (Maybe (Name, IsInstance))
    forall (m :: * -> *).
    MonadToConcrete m =>
    RecordConName -> m (Maybe (Name, IsInstance))
    f RecordDirectives
    dir
        where
          f :: MonadToConcrete m => RecordConName -> m (Maybe (C.Name, IsInstance))
          f :: forall (m :: * -> *).
    MonadToConcrete m =>
    RecordConName -> m (Maybe (Name, IsInstance))
    f (FreshRecCon QName
    _) = Maybe (Name, IsInstance) -> m (Maybe (Name, IsInstance))
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Name, IsInstance)
    forall a. Maybe a
    Nothing
          f (NamedRecCon QName
    nm) = (Name, IsInstance) -> Maybe (Name, IsInstance)
    forall a. a -> Maybe a
    Just ((Name, IsInstance) -> Maybe (Name, IsInstance))
    -> (QName -> (Name, IsInstance))
    -> QName
    -> Maybe (Name, IsInstance)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (, IsInstance
    NotInstanceDef) (Name -> (Name, IsInstance))
    -> (QName -> Name) -> QName -> (Name, IsInstance)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Name
    C.unqualify (QName -> Maybe (Name, IsInstance))
    -> m QName -> m (Maybe (Name, IsInstance))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    nm

    instance ToConcrete A.Declaration where
      type ConOfAbs A.Declaration = [C.Declaration]

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Declaration -> m (ConOfAbs Declaration)
    toConcrete (ScopedDecl ScopeInfo
    scope [Declaration]
    ds) =
        ScopeInfo -> m [Declaration] -> m [Declaration]
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    ScopeInfo -> m a -> m a
    withScope ScopeInfo
    scope ([Declaration] -> m [Declaration]
    forall (m :: * -> *).
    MonadToConcrete m =>
    [Declaration] -> m [Declaration]
    declsToConcrete [Declaration]
    ds)

      toConcrete (A.Axiom KindOfName
    _ DefInfo
    i ArgInfo
    info Maybe PragmaPolarities
    mp QName
    x Expr
    t) = do
        x' <- QName -> Name
    unsafeQNameToName (QName -> Name) -> m QName -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        withAbstractPrivate i $
          withInfixDecl i x'  $ do
          t' <- toConcreteTop t
          return $
            (case mp of
               Maybe PragmaPolarities
    Nothing   -> []
               Just PragmaPolarities
    occs -> [Pragma -> Declaration
    C.Pragma (Range -> Name -> [Ranged Occurrence] -> Pragma
    PolarityPragma Range
    forall a. Range' a
    noRange Name
    x' ([Ranged Occurrence] -> Pragma) -> [Ranged Occurrence] -> Pragma
    forall a b. (a -> b) -> a -> b
    $ PragmaPolarities -> [Item PragmaPolarities]
    forall l. IsList l => l -> [Item l]
    List1.toList PragmaPolarities
    occs)]) ++
            [C.Postulate empty [C.TypeSig info empty x' t']]

      toConcrete (A.Generalize Set QName
    s DefInfo
    i ArgInfo
    j QName
    x Expr
    t) = do
        x' <- QName -> Name
    unsafeQNameToName (QName -> Name) -> m QName -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        tac <- toConcrete (defTactic i)
        withAbstractPrivate i $
          withInfixDecl i x'  $ do
          t' <- toConcreteTop t
          return [C.Generalize empty [C.TypeSig j tac x' $ C.Generalized t']]

      toConcrete (A.Field DefInfo
    i QName
    x Arg Expr
    t) = do
        x' <- QName -> Name
    unsafeQNameToName (QName -> Name) -> m QName -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        tac <- toConcrete (defTactic i)
        withAbstractPrivate i $
          withInfixDecl i x'  $ do
          t' <- toConcreteTop t
          return [C.FieldSig (A.defInstance i) tac x' t']

      toConcrete (A.Primitive DefInfo
    i QName
    x Arg Expr
    t) = do
        x' <- QName -> Name
    unsafeQNameToName (QName -> Name) -> m QName -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        withAbstractPrivate i $
          withInfixDecl i x'  $ do
          t' <- traverse toConcreteTop t
          return [C.Primitive empty [C.TypeSig (argInfo t') empty x' (unArg t')]]
            -- Primitives are always relevant.

      toConcrete (A.FunDef DefInfo
    i QName
    _ [Clause]
    cs) =
        DefInfo -> m [Declaration] -> m [Declaration]
    forall (m :: * -> *).
    MonadToConcrete m =>
    DefInfo -> m [Declaration] -> m [Declaration]
    withAbstractPrivate DefInfo
    i (m [Declaration] -> m [Declaration])
    -> m [Declaration] -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $ [NonEmpty Declaration] -> [Declaration]
    forall a. [List1 a] -> [a]
    List1.concat ([NonEmpty Declaration] -> [Declaration])
    -> m [NonEmpty Declaration] -> m [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Clause] -> m (ConOfAbs [Clause])
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    [Clause] -> m (ConOfAbs [Clause])
    toConcrete [Clause]
    cs

      toConcrete (A.DataSig DefInfo
    i Erased
    erased QName
    x GeneralizeTelescope
    bs Expr
    t) =
        DefInfo -> m [Declaration] -> m [Declaration]
    forall (m :: * -> *).
    MonadToConcrete m =>
    DefInfo -> m [Declaration] -> m [Declaration]
    withAbstractPrivate DefInfo
    i (m [Declaration] -> m [Declaration])
    -> m [Declaration] -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        Telescope
    -> (ConOfAbs Telescope -> m [Declaration]) -> m [Declaration]
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Telescope -> (ConOfAbs Telescope -> m b) -> m b
    bindToConcrete (GeneralizeTelescope -> Telescope
    A.generalizeTel GeneralizeTelescope
    bs) ((ConOfAbs Telescope -> m [Declaration]) -> m [Declaration])
    -> (ConOfAbs Telescope -> m [Declaration]) -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs Telescope
    tel' -> do
          x' <- QName -> Name
    unsafeQNameToName (QName -> Name) -> m QName -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
          t' <- toConcreteTop t
          return [ C.DataSig (getRange i) erased x'
                     (map C.DomainFull $ catMaybes tel') t' ]

      toConcrete (A.DataDef DefInfo
    i QName
    x UniverseCheck
    uc DataDefParams
    bs [Declaration]
    cs) =
        DefInfo -> m [Declaration] -> m [Declaration]
    forall (m :: * -> *).
    MonadToConcrete m =>
    DefInfo -> m [Declaration] -> m [Declaration]
    withAbstractPrivate DefInfo
    i (m [Declaration] -> m [Declaration])
    -> m [Declaration] -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        [LamBinding]
    -> (ConOfAbs [LamBinding] -> m [Declaration]) -> m [Declaration]
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [LamBinding] -> (ConOfAbs [LamBinding] -> m b) -> m b
    bindToConcrete ((LamBinding -> LamBinding) -> [LamBinding] -> [LamBinding]
    forall a b. (a -> b) -> [a] -> [b]
    map LamBinding -> LamBinding
    makeDomainFree ([LamBinding] -> [LamBinding]) -> [LamBinding] -> [LamBinding]
    forall a b. (a -> b) -> a -> b
    $ DataDefParams -> [LamBinding]
    dataDefParams DataDefParams
    bs) ((ConOfAbs [LamBinding] -> m [Declaration]) -> m [Declaration])
    -> (ConOfAbs [LamBinding] -> m [Declaration]) -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs [LamBinding]
    tel' -> do
          (x',cs') <- (QName -> Name) -> (QName, [Declaration]) -> (Name, [Declaration])
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first QName -> Name
    unsafeQNameToName ((QName, [Declaration]) -> (Name, [Declaration]))
    -> m (QName, [Declaration]) -> m (Name, [Declaration])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (QName, [Constr Declaration])
    -> m (ConOfAbs (QName, [Constr Declaration]))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    (QName, [Constr Declaration])
    -> m (ConOfAbs (QName, [Constr Declaration]))
    toConcrete (QName
    x, (Declaration -> Constr Declaration)
    -> [Declaration] -> [Constr Declaration]
    forall a b. (a -> b) -> [a] -> [b]
    map Declaration -> Constr Declaration
    forall a. a -> Constr a
    Constr [Declaration]
    cs)
          return [ C.DataDef (getRange i) x' (catMaybes tel') cs' ]

      toConcrete (A.RecSig DefInfo
    i Erased
    erased QName
    x GeneralizeTelescope
    bs Expr
    t) =
        DefInfo -> m [Declaration] -> m [Declaration]
    forall (m :: * -> *).
    MonadToConcrete m =>
    DefInfo -> m [Declaration] -> m [Declaration]
    withAbstractPrivate DefInfo
    i (m [Declaration] -> m [Declaration])
    -> m [Declaration] -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        Telescope
    -> (ConOfAbs Telescope -> m [Declaration]) -> m [Declaration]
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Telescope -> (ConOfAbs Telescope -> m b) -> m b
    bindToConcrete (GeneralizeTelescope -> Telescope
    A.generalizeTel GeneralizeTelescope
    bs) ((ConOfAbs Telescope -> m [Declaration]) -> m [Declaration])
    -> (ConOfAbs Telescope -> m [Declaration]) -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs Telescope
    tel' -> do
          x' <- QName -> Name
    unsafeQNameToName (QName -> Name) -> m QName -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
          t' <- toConcreteTop t
          return [ C.RecordSig (getRange i) erased x'
                     (map C.DomainFull $ catMaybes tel') t' ]

      toConcrete (A.RecDef  DefInfo
    i QName
    x UniverseCheck
    uc RecordDirectives
    dir DataDefParams
    bs Expr
    t [Declaration]
    cs) =
        DefInfo -> m [Declaration] -> m [Declaration]
    forall (m :: * -> *).
    MonadToConcrete m =>
    DefInfo -> m [Declaration] -> m [Declaration]
    withAbstractPrivate DefInfo
    i (m [Declaration] -> m [Declaration])
    -> m [Declaration] -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        [LamBinding]
    -> (ConOfAbs [LamBinding] -> m [Declaration]) -> m [Declaration]
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [LamBinding] -> (ConOfAbs [LamBinding] -> m b) -> m b
    bindToConcrete ((LamBinding -> LamBinding) -> [LamBinding] -> [LamBinding]
    forall a b. (a -> b) -> [a] -> [b]
    map LamBinding -> LamBinding
    makeDomainFree ([LamBinding] -> [LamBinding]) -> [LamBinding] -> [LamBinding]
    forall a b. (a -> b) -> a -> b
    $ DataDefParams -> [LamBinding]
    dataDefParams DataDefParams
    bs) ((ConOfAbs [LamBinding] -> m [Declaration]) -> m [Declaration])
    -> (ConOfAbs [LamBinding] -> m [Declaration]) -> m [Declaration]
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs [LamBinding]
    tel' -> do
          dirs <- RecordDirectives -> m (ConOfAbs RecordDirectives)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    RecordDirectives -> m (ConOfAbs RecordDirectives)
    toConcrete RecordDirectives
    dir
          (x',cs') <- first unsafeQNameToName <$> toConcrete (x, map Constr cs)
          return [ C.RecordDef (getRange i) x' dirs (catMaybes tel') cs' ]

      toConcrete (A.Mutual MutualInfo
    i [Declaration]
    ds) = Declaration -> [Declaration]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Declaration -> [Declaration])
    -> ([Declaration] -> Declaration) -> [Declaration] -> [Declaration]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KwRange -> [Declaration] -> Declaration
    C.Mutual KwRange
    forall a. Null a => a
    empty ([Declaration] -> [Declaration])
    -> m [Declaration] -> m [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Declaration] -> m [Declaration]
    forall (m :: * -> *).
    MonadToConcrete m =>
    [Declaration] -> m [Declaration]
    declsToConcrete [Declaration]
    ds

      toConcrete (A.Section Range
    i Erased
    erased ModuleName
    x (A.GeneralizeTel Map QName Name
    _ Telescope
    tel) [Declaration]
    ds) = do
        x <- ModuleName -> m (ConOfAbs ModuleName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    ModuleName -> m (ConOfAbs ModuleName)
    toConcrete ModuleName
    x
        bindToConcrete tel $ \ ConOfAbs Telescope
    tel -> do
          ds <- [Declaration] -> m [Declaration]
    forall (m :: * -> *).
    MonadToConcrete m =>
    [Declaration] -> m [Declaration]
    declsToConcrete [Declaration]
    ds
          return [ C.Module (getRange i) erased x (catMaybes tel) ds ]

      toConcrete (A.Apply ModuleInfo
    i Erased
    erased ModuleName
    x ModuleApplication
    modapp ScopeCopyInfo
    _ ImportDirective
    _) = do
        x  <- QName -> Name
    unsafeQNameToName (QName -> Name) -> m QName -> m Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ModuleName -> m (ConOfAbs ModuleName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    ModuleName -> m (ConOfAbs ModuleName)
    toConcrete ModuleName
    x
        modapp <- toConcrete modapp
        let r = ModuleApplication -> Range
    forall a. HasRange a => a -> Range
    getRange ModuleApplication
    modapp
            open = OpenShortHand -> Maybe OpenShortHand -> OpenShortHand
    forall a. a -> Maybe a -> a
    fromMaybe OpenShortHand
    DontOpen (Maybe OpenShortHand -> OpenShortHand)
    -> Maybe OpenShortHand -> OpenShortHand
    forall a b. (a -> b) -> a -> b
    $ ModuleInfo -> Maybe OpenShortHand
    minfoOpenShort ModuleInfo
    i
            dir  = ImportDirective -> Maybe ImportDirective -> ImportDirective
    forall a. a -> Maybe a -> a
    fromMaybe ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir{ importDirRange = r } (Maybe ImportDirective -> ImportDirective)
    -> Maybe ImportDirective -> ImportDirective
    forall a b. (a -> b) -> a -> b
    $ ModuleInfo -> Maybe ImportDirective
    minfoDirective ModuleInfo
    i
        return [ C.ModuleMacro (getRange i) erased x modapp open dir ]

      toConcrete (A.Import ModuleInfo
    i ModuleName
    x ImportDirective
    _) = do
        x <- ModuleName -> m (ConOfAbs ModuleName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    ModuleName -> m (ConOfAbs ModuleName)
    toConcrete ModuleName
    x
        let open = OpenShortHand -> Maybe OpenShortHand -> OpenShortHand
    forall a. a -> Maybe a -> a
    fromMaybe OpenShortHand
    DontOpen (Maybe OpenShortHand -> OpenShortHand)
    -> Maybe OpenShortHand -> OpenShortHand
    forall a b. (a -> b) -> a -> b
    $ ModuleInfo -> Maybe OpenShortHand
    minfoOpenShort ModuleInfo
    i
            dir  = ImportDirective -> Maybe ImportDirective -> ImportDirective
    forall a. a -> Maybe a -> a
    fromMaybe ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir (Maybe ImportDirective -> ImportDirective)
    -> Maybe ImportDirective -> ImportDirective
    forall a b. (a -> b) -> a -> b
    $ ModuleInfo -> Maybe ImportDirective
    minfoDirective ModuleInfo
    i
        return [ C.Import (getRange i) x Nothing open dir]

      toConcrete (A.Pragma Range
    i Pragma
    p)     = do
        p <- RangeAndPragma -> m (ConOfAbs RangeAndPragma)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    RangeAndPragma -> m (ConOfAbs RangeAndPragma)
    toConcrete (RangeAndPragma -> m (ConOfAbs RangeAndPragma))
    -> RangeAndPragma -> m (ConOfAbs RangeAndPragma)
    forall a b. (a -> b) -> a -> b
    $ Range -> Pragma -> RangeAndPragma
    RangeAndPragma (Range -> Range
    forall a. HasRange a => a -> Range
    getRange Range
    i) Pragma
    p
        return [C.Pragma p]

      toConcrete (A.Open ModuleInfo
    i ModuleName
    x ImportDirective
    _) = do
        x <- ModuleName -> m (ConOfAbs ModuleName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    ModuleName -> m (ConOfAbs ModuleName)
    toConcrete ModuleName
    x
        return [C.Open (getRange i) x defaultImportDir]

      toConcrete (A.PatternSynDef QName
    x [WithHiding BindName]
    xs Pattern' Void
    p) = QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x m QName -> (QName -> m [Declaration]) -> m [Declaration]
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        C.QName Name
    x -> [WithHiding Name]
    -> (ConOfAbs [WithHiding Name] -> m [Declaration])
    -> m [Declaration]
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [WithHiding Name] -> (ConOfAbs [WithHiding Name] -> m b) -> m b
    bindToConcrete ((WithHiding BindName -> WithHiding Name)
    -> [WithHiding BindName] -> [WithHiding Name]
    forall a b. (a -> b) -> [a] -> [b]
    map ((BindName -> Name) -> WithHiding BindName -> WithHiding Name
    forall a b. (a -> b) -> WithHiding a -> WithHiding b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BindName -> Name
    A.unBind) [WithHiding BindName]
    xs) \ ConOfAbs [WithHiding Name]
    xs ->
          Declaration -> [Declaration]
    forall el coll. Singleton el coll => el -> coll
    singleton (Declaration -> [Declaration])
    -> (Pattern -> Declaration) -> Pattern -> [Declaration]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> Name -> [WithHiding Name] -> Pattern -> Declaration
    C.PatternSyn (Name -> Range
    forall a. HasRange a => a -> Range
    getRange Name
    x) Name
    x [WithHiding Name]
    ConOfAbs [WithHiding Name]
    xs (Pattern -> [Declaration]) -> m Pattern -> m [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
            m Pattern -> m Pattern
    forall (m :: * -> *) a. MonadToConcrete m => m a -> m a
    dontFoldPatternSynonyms (m Pattern -> m Pattern) -> m Pattern -> m Pattern
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m (ConOfAbs Pattern)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m (ConOfAbs Pattern)
    toConcrete (Pattern' Void -> Pattern
    forall (f :: * -> *) a. Functor f => f Void -> f a
    vacuous Pattern' Void
    p :: A.Pattern)
        QName
    _ -> m [Declaration]
    forall a. HasCallStack => a
    __IMPOSSIBLE__

      toConcrete (A.UnquoteDecl MutualInfo
    _ [DefInfo]
    i [QName]
    xs Expr
    e) = do
        let unqual :: QName -> m Name
    unqual (C.QName Name
    x) = Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    x
            unqual QName
    _           = m Name
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        xs <- (QName -> m Name) -> [QName] -> m [Name]
    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 (QName -> m Name
    forall {m :: * -> *}. Monad m => QName -> m Name
    unqual (QName -> m Name) -> (QName -> m QName) -> QName -> m Name
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< QName -> m QName
    QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete) [QName]
    xs
        (:[]) . C.UnquoteDecl (getRange i) xs <$> toConcrete e

      toConcrete (A.UnquoteDef [DefInfo]
    i [QName]
    xs Expr
    e) = do
        let unqual :: QName -> m Name
    unqual (C.QName Name
    x) = Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    x
            unqual QName
    _           = m Name
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        xs <- (QName -> m Name) -> [QName] -> m [Name]
    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 (QName -> m Name
    forall {m :: * -> *}. Monad m => QName -> m Name
    unqual (QName -> m Name) -> (QName -> m QName) -> QName -> m Name
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< QName -> m QName
    QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete) [QName]
    xs
        (:[]) . C.UnquoteDef (getRange i) xs <$> toConcrete e

      toConcrete (A.UnquoteData [DefInfo]
    i QName
    xs UniverseCheck
    uc [DefInfo]
    j [QName]
    cs Expr
    e) = m [Declaration]
    m (ConOfAbs Declaration)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toConcrete (A.UnfoldingDecl Range
    r [QName]
    ns) = [Declaration] -> m [Declaration]
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []

    data RangeAndPragma = RangeAndPragma Range A.Pragma

    instance ToConcrete RangeAndPragma where
      type ConOfAbs RangeAndPragma = C.Pragma

      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    RangeAndPragma -> m (ConOfAbs RangeAndPragma)
    toConcrete (RangeAndPragma Range
    r Pragma
    p) = case Pragma
    p of
        A.OptionsPragma [ArgName]
    xs  -> Pragma -> m Pragma
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pragma -> m Pragma) -> Pragma -> m Pragma
    forall a b. (a -> b) -> a -> b
    $ Range -> [ArgName] -> Pragma
    C.OptionsPragma Range
    r [ArgName]
    xs
        A.BuiltinPragma Ranged ArgName
    b ResolvedName
    x       -> Range -> Ranged ArgName -> QName -> Pragma
    C.BuiltinPragma Range
    r Ranged ArgName
    b (QName -> Pragma) -> m QName -> m Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ResolvedName -> m (ConOfAbs ResolvedName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    ResolvedName -> m (ConOfAbs ResolvedName)
    toConcrete ResolvedName
    x
        A.BuiltinNoDefPragma Ranged ArgName
    b KindOfName
    _kind QName
    x -> Range -> Ranged ArgName -> QName -> Pragma
    C.BuiltinPragma Range
    r Ranged ArgName
    b (QName -> Pragma) -> m QName -> m Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        A.RewritePragma Range
    r' [QName]
    x      -> Range -> Range -> [QName] -> Pragma
    C.RewritePragma Range
    r Range
    r' ([QName] -> Pragma) -> m [QName] -> m Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [QName] -> m (ConOfAbs [QName])
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    [QName] -> m (ConOfAbs [QName])
    toConcrete [QName]
    x
        A.CompilePragma Ranged BackendName
    b QName
    x ArgName
    s -> do
          x <- QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
          return $ C.CompilePragma r b x s
        A.StaticPragma QName
    x -> Range -> QName -> Pragma
    C.StaticPragma Range
    r (QName -> Pragma) -> m QName -> m Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        A.InjectivePragma QName
    x -> Range -> QName -> Pragma
    C.InjectivePragma Range
    r (QName -> Pragma) -> m QName -> m Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        A.InjectiveForInferencePragma QName
    x -> Range -> QName -> Pragma
    C.InjectiveForInferencePragma Range
    r (QName -> Pragma) -> m QName -> m Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        A.InlinePragma Bool
    b QName
    x -> Range -> Bool -> QName -> Pragma
    C.InlinePragma Range
    r Bool
    b (QName -> Pragma) -> m QName -> m Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        A.NotProjectionLikePragma QName
    q -> Range -> QName -> Pragma
    C.NotProjectionLikePragma Range
    r (QName -> Pragma) -> m QName -> m Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    q
        A.OverlapPragma QName
    q OverlapMode
    i -> Range -> [QName] -> OverlapMode -> Pragma
    C.OverlapPragma Range
    r ([QName] -> OverlapMode -> Pragma)
    -> m [QName] -> m (OverlapMode -> Pragma)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((QName -> [QName]) -> m QName -> m [QName]
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap QName -> [QName]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    q)) m (OverlapMode -> Pragma) -> m OverlapMode -> m Pragma
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> OverlapMode -> m OverlapMode
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure OverlapMode
    i
        A.EtaPragma QName
    x    -> Range -> QName -> Pragma
    C.EtaPragma    Range
    r (QName -> Pragma) -> m QName -> m Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        A.DisplayPragma QName
    f [NamedArg Pattern]
    ps Expr
    rhs ->
          Range -> Pattern -> Expr -> Pragma
    C.DisplayPragma Range
    r (Pattern -> Expr -> Pragma) -> m Pattern -> m (Expr -> Pragma)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pattern -> m (ConOfAbs Pattern)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m (ConOfAbs Pattern)
    toConcrete (PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.DefP (Range -> PatInfo
    PatRange Range
    forall a. Range' a
    noRange) (QName -> AmbiguousQName
    unambiguous QName
    f) [NamedArg Pattern]
    ps) m (Expr -> Pragma) -> m Expr -> m Pragma
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete Expr
    rhs

    -- Left hand sides --------------------------------------------------------

    instance ToConcrete A.SpineLHS where
      type ConOfAbs A.SpineLHS = C.LHS

      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    SpineLHS -> (ConOfAbs SpineLHS -> m b) -> m b
    bindToConcrete SpineLHS
    lhs = LHS -> (ConOfAbs LHS -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    LHS -> (ConOfAbs LHS -> m b) -> m b
    bindToConcrete (SpineLHS -> LHS
    forall a b. LHSToSpine a b => b -> a
    A.spineToLhs SpineLHS
    lhs :: A.LHS)

    instance ToConcrete A.LHS where
        type ConOfAbs A.LHS = C.LHS

        bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    LHS -> (ConOfAbs LHS -> m b) -> m b
    bindToConcrete (A.LHS LHSInfo
    i LHSCore
    lhscore) ConOfAbs LHS -> m b
    ret = do
          Precedence -> LHSCore -> (ConOfAbs LHSCore -> m b) -> m b
    forall (m :: * -> *) a b.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> (ConOfAbs a -> m b) -> m b
    bindToConcreteCtx Precedence
    TopCtx LHSCore
    lhscore ((ConOfAbs LHSCore -> m b) -> m b)
    -> (ConOfAbs LHSCore -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs LHSCore
    lhs ->
              ConOfAbs LHS -> m b
    ret (ConOfAbs LHS -> m b) -> ConOfAbs LHS -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> [RewriteEqn] -> [WithExpr] -> LHS
    C.LHS (ExpandedEllipsis -> Pattern -> Pattern
    reintroduceEllipsis (LHSInfo -> ExpandedEllipsis
    lhsEllipsis LHSInfo
    i) Pattern
    ConOfAbs LHSCore
    lhs) [] []

    instance ToConcrete A.LHSCore where
      type ConOfAbs A.LHSCore = C.Pattern
      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    LHSCore -> (ConOfAbs LHSCore -> m b) -> m b
    bindToConcrete = Pattern -> (Pattern -> m b) -> m b
    Pattern -> (ConOfAbs Pattern -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Pattern -> (ConOfAbs Pattern -> m b) -> m b
    bindToConcrete (Pattern -> (Pattern -> m b) -> m b)
    -> (LHSCore -> Pattern) -> LHSCore -> (Pattern -> m b) -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHSCore -> Pattern
    lhsCoreToPattern

    appBracketsArgs :: [arg] -> PrecedenceStack -> Bool
    appBracketsArgs :: forall arg. [arg] -> PrecedenceStack -> Bool
    appBracketsArgs []    PrecedenceStack
    _   = Bool
    False
    appBracketsArgs (arg
    _:[arg]
    _) PrecedenceStack
    ctx = PrecedenceStack -> Bool
    appBrackets PrecedenceStack
    ctx

    -- Auxiliary wrappers for processing the bindings in patterns in the right order.
    newtype UserPattern a  = UserPattern a
    newtype SplitPattern a = SplitPattern a
    newtype BindingPattern = BindingPat A.Pattern
    newtype FreshenName = FreshenName BindName

    instance ToConcrete FreshenName where
      type ConOfAbs FreshenName = A.Name
      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    FreshenName -> (ConOfAbs FreshenName -> m b) -> m b
    bindToConcrete (FreshenName BindName{ unBind :: BindName -> Name
    unBind = Name
    x }) ConOfAbs FreshenName -> m b
    ret = Name -> (ConOfAbs Name -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Name -> (ConOfAbs Name -> m b) -> m b
    bindToConcrete Name
    x ((ConOfAbs Name -> m b) -> m b) -> (ConOfAbs Name -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs Name
    y -> ConOfAbs FreshenName -> m b
    ret Name
    x { nameConcrete = y }

    -- Pass 1: (Issue #2729)
    -- Takes care of binding the originally user-written pattern variables, but doesn't actually
    -- translate anything to Concrete.
    instance ToConcrete (UserPattern A.Pattern) where
      type ConOfAbs (UserPattern A.Pattern) = A.Pattern

      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    UserPattern Pattern
    -> (ConOfAbs (UserPattern Pattern) -> m b) -> m b
    bindToConcrete (UserPattern Pattern
    p) ConOfAbs (UserPattern Pattern) -> m b
    ret = do
        ArgName -> VerboseLevel -> ArgName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> ArgName -> m ()
    reportSLn ArgName
    "toConcrete.pat" VerboseLevel
    100 (ArgName -> m ()) -> ArgName -> m ()
    forall a b. (a -> b) -> a -> b
    $ ArgName
    "binding pattern (pass 1)" ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> ArgName
    forall a. Show a => a -> ArgName
    show Pattern
    p
        case Pattern
    p of
          A.VarP BindName
    bx -> do
            let x :: Name
    x = BindName -> Name
    unBind BindName
    bx
            case Name -> NameInScope
    forall a. LensInScope a => a -> NameInScope
    isInScope Name
    x of
              NameInScope
    InScope            -> Name -> m b -> m b
    forall (m :: * -> *) a. MonadToConcrete m => Name -> m a -> m a
    bindName' Name
    x (m b -> m b) -> m b -> m b
    forall a b. (a -> b) -> a -> b
    $ ConOfAbs (UserPattern Pattern) -> m b
    ret (ConOfAbs (UserPattern Pattern) -> m b)
    -> ConOfAbs (UserPattern Pattern) -> m b
    forall a b. (a -> b) -> a -> b
    $ BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP BindName
    bx
              NameInScope
    C.NotInScope       -> Name -> (Name -> m b) -> m b
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    Name -> (Name -> m a) -> m a
    bindName Name
    x ((Name -> m b) -> m b) -> (Name -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \Name
    y ->
                                    ConOfAbs (UserPattern Pattern) -> m b
    ret (ConOfAbs (UserPattern Pattern) -> m b)
    -> ConOfAbs (UserPattern Pattern) -> m b
    forall a b. (a -> b) -> a -> b
    $ BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP (BindName -> Pattern) -> BindName -> Pattern
    forall a b. (a -> b) -> a -> b
    $ Name -> BindName
    mkBindName (Name -> BindName) -> Name -> BindName
    forall a b. (a -> b) -> a -> b
    $ Name
    x { nameConcrete = y }
          A.WildP{}              -> ConOfAbs (UserPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.ProjP{}              -> ConOfAbs (UserPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.AbsurdP{}            -> ConOfAbs (UserPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.LitP{}               -> ConOfAbs (UserPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.DotP{}               -> ConOfAbs (UserPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.EqualP{}             -> ConOfAbs (UserPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          -- Andreas, 2017-09-03, issue #2729:
          -- Do not go into patterns generated by case-split here!
          -- They are treated in a second pass.
          A.ConP ConPatInfo
    i AmbiguousQName
    c [NamedArg Pattern]
    args
            | ConPatInfo -> ConInfo
    conPatOrigin ConPatInfo
    i ConInfo -> ConInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConInfo
    ConOSplit -> ConOfAbs (UserPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
            | Bool
    otherwise          -> [UserPattern (NamedArg Pattern)]
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [UserPattern (NamedArg Pattern)]
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b
    bindToConcrete ((NamedArg Pattern -> UserPattern (NamedArg Pattern))
    -> [NamedArg Pattern] -> [UserPattern (NamedArg Pattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> UserPattern (NamedArg Pattern)
    forall a. a -> UserPattern a
    UserPattern [NamedArg Pattern]
    args) ((ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b)
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (UserPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConPatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. ConPatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.ConP ConPatInfo
    i AmbiguousQName
    c
          A.DefP PatInfo
    i AmbiguousQName
    f [NamedArg Pattern]
    args        -> [UserPattern (NamedArg Pattern)]
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [UserPattern (NamedArg Pattern)]
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b
    bindToConcrete ((NamedArg Pattern -> UserPattern (NamedArg Pattern))
    -> [NamedArg Pattern] -> [UserPattern (NamedArg Pattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> UserPattern (NamedArg Pattern)
    forall a. a -> UserPattern a
    UserPattern [NamedArg Pattern]
    args) ((ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b)
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (UserPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.DefP PatInfo
    i AmbiguousQName
    f
          A.PatternSynP PatInfo
    i AmbiguousQName
    f [NamedArg Pattern]
    args -> [UserPattern (NamedArg Pattern)]
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [UserPattern (NamedArg Pattern)]
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b
    bindToConcrete ((NamedArg Pattern -> UserPattern (NamedArg Pattern))
    -> [NamedArg Pattern] -> [UserPattern (NamedArg Pattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> UserPattern (NamedArg Pattern)
    forall a. a -> UserPattern a
    UserPattern [NamedArg Pattern]
    args) ((ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b)
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (UserPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.PatternSynP PatInfo
    i AmbiguousQName
    f
          A.RecP KwRange
    kwr ConPatInfo
    i [FieldAssignment' Pattern]
    args
            | ConPatInfo -> ConInfo
    conPatOrigin ConPatInfo
    i ConInfo -> ConInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConInfo
    ConOSplit -> ConOfAbs (UserPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
            | Bool
    otherwise          -> [FieldAssignment' (UserPattern Pattern)]
    -> (ConOfAbs [FieldAssignment' (UserPattern Pattern)] -> m b)
    -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [FieldAssignment' (UserPattern Pattern)]
    -> (ConOfAbs [FieldAssignment' (UserPattern Pattern)] -> m b)
    -> m b
    bindToConcrete (((FieldAssignment' Pattern
     -> FieldAssignment' (UserPattern Pattern))
    -> [FieldAssignment' Pattern]
    -> [FieldAssignment' (UserPattern Pattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((FieldAssignment' Pattern
      -> FieldAssignment' (UserPattern Pattern))
     -> [FieldAssignment' Pattern]
     -> [FieldAssignment' (UserPattern Pattern)])
    -> ((Pattern -> UserPattern Pattern)
        -> FieldAssignment' Pattern
        -> FieldAssignment' (UserPattern Pattern))
    -> (Pattern -> UserPattern Pattern)
    -> [FieldAssignment' Pattern]
    -> [FieldAssignment' (UserPattern Pattern)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> UserPattern Pattern)
    -> FieldAssignment' Pattern
    -> FieldAssignment' (UserPattern Pattern)
    forall a b. (a -> b) -> FieldAssignment' a -> FieldAssignment' b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) Pattern -> UserPattern Pattern
    forall a. a -> UserPattern a
    UserPattern [FieldAssignment' Pattern]
    args) ((ConOfAbs [FieldAssignment' (UserPattern Pattern)] -> m b) -> m b)
    -> (ConOfAbs [FieldAssignment' (UserPattern Pattern)] -> m b)
    -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (UserPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([FieldAssignment' Pattern] -> Pattern)
    -> [FieldAssignment' Pattern]
    -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KwRange -> ConPatInfo -> [FieldAssignment' Pattern] -> Pattern
    forall e.
    KwRange
    -> ConPatInfo -> [FieldAssignment' (Pattern' e)] -> Pattern' e
    A.RecP KwRange
    kwr ConPatInfo
    i
          A.AsP PatInfo
    i BindName
    x Pattern
    p            -> Name -> m b -> m b
    forall (m :: * -> *) a. MonadToConcrete m => Name -> m a -> m a
    bindName' (BindName -> Name
    unBind BindName
    x) (m b -> m b) -> m b -> m b
    forall a b. (a -> b) -> a -> b
    $
                                    UserPattern Pattern
    -> (ConOfAbs (UserPattern Pattern) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    UserPattern Pattern
    -> (ConOfAbs (UserPattern Pattern) -> m b) -> m b
    bindToConcrete (Pattern -> UserPattern Pattern
    forall a. a -> UserPattern a
    UserPattern Pattern
    p) ((ConOfAbs (UserPattern Pattern) -> m b) -> m b)
    -> (ConOfAbs (UserPattern Pattern) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (UserPattern Pattern)
    p ->
                                    ConOfAbs (UserPattern Pattern) -> m b
    ret (PatInfo -> BindName -> Pattern -> Pattern
    forall e. PatInfo -> BindName -> Pattern' e -> Pattern' e
    A.AsP PatInfo
    i BindName
    x Pattern
    ConOfAbs (UserPattern Pattern)
    p)
          A.WithP PatInfo
    i Pattern
    p            -> UserPattern Pattern
    -> (ConOfAbs (UserPattern Pattern) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    UserPattern Pattern
    -> (ConOfAbs (UserPattern Pattern) -> m b) -> m b
    bindToConcrete (Pattern -> UserPattern Pattern
    forall a. a -> UserPattern a
    UserPattern Pattern
    p) ((ConOfAbs (UserPattern Pattern) -> m b) -> m b)
    -> (ConOfAbs (UserPattern Pattern) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (UserPattern Pattern) -> m b
    ret (Pattern -> m b) -> (Pattern -> Pattern) -> Pattern -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> Pattern -> Pattern
    forall e. PatInfo -> Pattern' e -> Pattern' e
    A.WithP PatInfo
    i

    instance ToConcrete (UserPattern (NamedArg A.Pattern)) where
      type ConOfAbs (UserPattern (NamedArg A.Pattern)) = NamedArg A.Pattern

      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    UserPattern (NamedArg Pattern)
    -> (ConOfAbs (UserPattern (NamedArg Pattern)) -> m b) -> m b
    bindToConcrete (UserPattern NamedArg Pattern
    np) ConOfAbs (UserPattern (NamedArg Pattern)) -> m b
    ret =
        case NamedArg Pattern -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin NamedArg Pattern
    np of
          Origin
    CaseSplit -> ConOfAbs (UserPattern (NamedArg Pattern)) -> m b
    ret NamedArg Pattern
    ConOfAbs (UserPattern (NamedArg Pattern))
    np
          Origin
    _         -> Arg (Named NamedName (UserPattern Pattern))
    -> (ConOfAbs (Arg (Named NamedName (UserPattern Pattern))) -> m b)
    -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Arg (Named NamedName (UserPattern Pattern))
    -> (ConOfAbs (Arg (Named NamedName (UserPattern Pattern))) -> m b)
    -> m b
    bindToConcrete ((Named NamedName Pattern -> Named NamedName (UserPattern Pattern))
    -> NamedArg Pattern -> Arg (Named NamedName (UserPattern Pattern))
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Pattern -> UserPattern Pattern)
    -> Named NamedName Pattern -> Named NamedName (UserPattern Pattern)
    forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pattern -> UserPattern Pattern
    forall a. a -> UserPattern a
    UserPattern) NamedArg Pattern
    np) ConOfAbs (Arg (Named NamedName (UserPattern Pattern))) -> m b
    ConOfAbs (UserPattern (NamedArg Pattern)) -> m b
    ret

    -- Pass 2a: locate case-split pattern.  Don't bind anything!
    instance ToConcrete (SplitPattern A.Pattern) where
      type ConOfAbs (SplitPattern A.Pattern) = A.Pattern

      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    bindToConcrete (SplitPattern Pattern
    p) ConOfAbs (SplitPattern Pattern) -> m b
    ret = do
        ArgName -> VerboseLevel -> ArgName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> ArgName -> m ()
    reportSLn ArgName
    "toConcrete.pat" VerboseLevel
    100 (ArgName -> m ()) -> ArgName -> m ()
    forall a b. (a -> b) -> a -> b
    $ ArgName
    "binding pattern (pass 2a)" ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> ArgName
    forall a. Show a => a -> ArgName
    show Pattern
    p
        case Pattern
    p of
          A.VarP BindName
    x               -> ConOfAbs (SplitPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.WildP{}              -> ConOfAbs (SplitPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.ProjP{}              -> ConOfAbs (SplitPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.AbsurdP{}            -> ConOfAbs (SplitPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.LitP{}               -> ConOfAbs (SplitPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.DotP{}               -> ConOfAbs (SplitPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.EqualP{}             -> ConOfAbs (SplitPattern Pattern) -> m b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          -- Andreas, 2017-09-03, issue #2729:
          -- For patterns generated by case-split here, switch to freshening & binding.
          A.ConP ConPatInfo
    i AmbiguousQName
    c [NamedArg Pattern]
    args
            | ConPatInfo -> ConInfo
    conPatOrigin ConPatInfo
    i ConInfo -> ConInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConInfo
    ConOSplit
                                 -> [Arg (Named NamedName BindingPattern)]
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [Arg (Named NamedName BindingPattern)]
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    bindToConcrete (((NamedArg Pattern -> Arg (Named NamedName BindingPattern))
    -> [NamedArg Pattern] -> [Arg (Named NamedName BindingPattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((NamedArg Pattern -> Arg (Named NamedName BindingPattern))
     -> [NamedArg Pattern] -> [Arg (Named NamedName BindingPattern)])
    -> ((Pattern -> BindingPattern)
        -> NamedArg Pattern -> Arg (Named NamedName BindingPattern))
    -> (Pattern -> BindingPattern)
    -> [NamedArg Pattern]
    -> [Arg (Named NamedName BindingPattern)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Named NamedName Pattern -> Named NamedName BindingPattern)
    -> NamedArg Pattern -> Arg (Named NamedName BindingPattern)
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName Pattern -> Named NamedName BindingPattern)
     -> NamedArg Pattern -> Arg (Named NamedName BindingPattern))
    -> ((Pattern -> BindingPattern)
        -> Named NamedName Pattern -> Named NamedName BindingPattern)
    -> (Pattern -> BindingPattern)
    -> NamedArg Pattern
    -> Arg (Named NamedName BindingPattern)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> BindingPattern)
    -> Named NamedName Pattern -> Named NamedName BindingPattern
    forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) Pattern -> BindingPattern
    BindingPat [NamedArg Pattern]
    args) ((ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b)
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (SplitPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConPatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. ConPatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.ConP ConPatInfo
    i AmbiguousQName
    c
            | Bool
    otherwise          -> [SplitPattern (NamedArg Pattern)]
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [SplitPattern (NamedArg Pattern)]
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b
    bindToConcrete ((NamedArg Pattern -> SplitPattern (NamedArg Pattern))
    -> [NamedArg Pattern] -> [SplitPattern (NamedArg Pattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> SplitPattern (NamedArg Pattern)
    forall a. a -> SplitPattern a
    SplitPattern [NamedArg Pattern]
    args) ((ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b)
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (SplitPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConPatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. ConPatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.ConP ConPatInfo
    i AmbiguousQName
    c
          A.DefP PatInfo
    i AmbiguousQName
    f [NamedArg Pattern]
    args        -> [SplitPattern (NamedArg Pattern)]
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [SplitPattern (NamedArg Pattern)]
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b
    bindToConcrete ((NamedArg Pattern -> SplitPattern (NamedArg Pattern))
    -> [NamedArg Pattern] -> [SplitPattern (NamedArg Pattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> SplitPattern (NamedArg Pattern)
    forall a. a -> SplitPattern a
    SplitPattern [NamedArg Pattern]
    args) ((ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b)
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (SplitPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.DefP PatInfo
    i AmbiguousQName
    f
          A.PatternSynP PatInfo
    i AmbiguousQName
    f [NamedArg Pattern]
    args -> [SplitPattern (NamedArg Pattern)]
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [SplitPattern (NamedArg Pattern)]
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b
    bindToConcrete ((NamedArg Pattern -> SplitPattern (NamedArg Pattern))
    -> [NamedArg Pattern] -> [SplitPattern (NamedArg Pattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg Pattern -> SplitPattern (NamedArg Pattern)
    forall a. a -> SplitPattern a
    SplitPattern [NamedArg Pattern]
    args) ((ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b)
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (SplitPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.PatternSynP PatInfo
    i AmbiguousQName
    f
          A.RecP KwRange
    kwr ConPatInfo
    i [FieldAssignment' Pattern]
    args
            | ConPatInfo -> ConInfo
    conPatOrigin ConPatInfo
    i ConInfo -> ConInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConInfo
    ConOSplit
                                 -> [FieldAssignment' BindingPattern]
    -> (ConOfAbs [FieldAssignment' BindingPattern] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [FieldAssignment' BindingPattern]
    -> (ConOfAbs [FieldAssignment' BindingPattern] -> m b) -> m b
    bindToConcrete (((FieldAssignment' Pattern -> FieldAssignment' BindingPattern)
    -> [FieldAssignment' Pattern] -> [FieldAssignment' BindingPattern]
    forall a b. (a -> b) -> [a] -> [b]
    map ((FieldAssignment' Pattern -> FieldAssignment' BindingPattern)
     -> [FieldAssignment' Pattern] -> [FieldAssignment' BindingPattern])
    -> ((Pattern -> BindingPattern)
        -> FieldAssignment' Pattern -> FieldAssignment' BindingPattern)
    -> (Pattern -> BindingPattern)
    -> [FieldAssignment' Pattern]
    -> [FieldAssignment' BindingPattern]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> BindingPattern)
    -> FieldAssignment' Pattern -> FieldAssignment' BindingPattern
    forall a b. (a -> b) -> FieldAssignment' a -> FieldAssignment' b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) Pattern -> BindingPattern
    BindingPat [FieldAssignment' Pattern]
    args) ((ConOfAbs [FieldAssignment' BindingPattern] -> m b) -> m b)
    -> (ConOfAbs [FieldAssignment' BindingPattern] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (SplitPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([FieldAssignment' Pattern] -> Pattern)
    -> [FieldAssignment' Pattern]
    -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KwRange -> ConPatInfo -> [FieldAssignment' Pattern] -> Pattern
    forall e.
    KwRange
    -> ConPatInfo -> [FieldAssignment' (Pattern' e)] -> Pattern' e
    A.RecP KwRange
    kwr ConPatInfo
    i
            | Bool
    otherwise          -> [FieldAssignment' (SplitPattern Pattern)]
    -> (ConOfAbs [FieldAssignment' (SplitPattern Pattern)] -> m b)
    -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [FieldAssignment' (SplitPattern Pattern)]
    -> (ConOfAbs [FieldAssignment' (SplitPattern Pattern)] -> m b)
    -> m b
    bindToConcrete (((FieldAssignment' Pattern
     -> FieldAssignment' (SplitPattern Pattern))
    -> [FieldAssignment' Pattern]
    -> [FieldAssignment' (SplitPattern Pattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((FieldAssignment' Pattern
      -> FieldAssignment' (SplitPattern Pattern))
     -> [FieldAssignment' Pattern]
     -> [FieldAssignment' (SplitPattern Pattern)])
    -> ((Pattern -> SplitPattern Pattern)
        -> FieldAssignment' Pattern
        -> FieldAssignment' (SplitPattern Pattern))
    -> (Pattern -> SplitPattern Pattern)
    -> [FieldAssignment' Pattern]
    -> [FieldAssignment' (SplitPattern Pattern)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> SplitPattern Pattern)
    -> FieldAssignment' Pattern
    -> FieldAssignment' (SplitPattern Pattern)
    forall a b. (a -> b) -> FieldAssignment' a -> FieldAssignment' b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) Pattern -> SplitPattern Pattern
    forall a. a -> SplitPattern a
    SplitPattern [FieldAssignment' Pattern]
    args) ((ConOfAbs [FieldAssignment' (SplitPattern Pattern)] -> m b)
     -> m b)
    -> (ConOfAbs [FieldAssignment' (SplitPattern Pattern)] -> m b)
    -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (SplitPattern Pattern) -> m b
    ret (Pattern -> m b)
    -> ([FieldAssignment' Pattern] -> Pattern)
    -> [FieldAssignment' Pattern]
    -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KwRange -> ConPatInfo -> [FieldAssignment' Pattern] -> Pattern
    forall e.
    KwRange
    -> ConPatInfo -> [FieldAssignment' (Pattern' e)] -> Pattern' e
    A.RecP KwRange
    kwr ConPatInfo
    i
          A.AsP PatInfo
    i BindName
    x Pattern
    p            -> SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    bindToConcrete (Pattern -> SplitPattern Pattern
    forall a. a -> SplitPattern a
    SplitPattern Pattern
    p)  ((ConOfAbs (SplitPattern Pattern) -> m b) -> m b)
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (SplitPattern Pattern)
    p ->
                                    ConOfAbs (SplitPattern Pattern) -> m b
    ret (PatInfo -> BindName -> Pattern -> Pattern
    forall e. PatInfo -> BindName -> Pattern' e -> Pattern' e
    A.AsP PatInfo
    i BindName
    x Pattern
    ConOfAbs (SplitPattern Pattern)
    p)
          A.WithP PatInfo
    i Pattern
    p            -> SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    bindToConcrete (Pattern -> SplitPattern Pattern
    forall a. a -> SplitPattern a
    SplitPattern Pattern
    p) ((ConOfAbs (SplitPattern Pattern) -> m b) -> m b)
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs (SplitPattern Pattern) -> m b
    ret (Pattern -> m b) -> (Pattern -> Pattern) -> Pattern -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> Pattern -> Pattern
    forall e. PatInfo -> Pattern' e -> Pattern' e
    A.WithP PatInfo
    i

    instance ToConcrete (SplitPattern (NamedArg A.Pattern)) where
      type ConOfAbs (SplitPattern (NamedArg A.Pattern)) = NamedArg A.Pattern
      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    SplitPattern (NamedArg Pattern)
    -> (ConOfAbs (SplitPattern (NamedArg Pattern)) -> m b) -> m b
    bindToConcrete (SplitPattern NamedArg Pattern
    np) ConOfAbs (SplitPattern (NamedArg Pattern)) -> m b
    ret =
        case NamedArg Pattern -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin NamedArg Pattern
    np of
          Origin
    CaseSplit -> Arg (Named NamedName BindingPattern)
    -> (ConOfAbs (Arg (Named NamedName BindingPattern)) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Arg (Named NamedName BindingPattern)
    -> (ConOfAbs (Arg (Named NamedName BindingPattern)) -> m b) -> m b
    bindToConcrete ((Named NamedName Pattern -> Named NamedName BindingPattern)
    -> NamedArg Pattern -> Arg (Named NamedName BindingPattern)
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Pattern -> BindingPattern)
    -> Named NamedName Pattern -> Named NamedName BindingPattern
    forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pattern -> BindingPattern
    BindingPat  ) NamedArg Pattern
    np) ConOfAbs (Arg (Named NamedName BindingPattern)) -> m b
    ConOfAbs (SplitPattern (NamedArg Pattern)) -> m b
    ret
          Origin
    _         -> Arg (Named NamedName (SplitPattern Pattern))
    -> (ConOfAbs (Arg (Named NamedName (SplitPattern Pattern))) -> m b)
    -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    Arg (Named NamedName (SplitPattern Pattern))
    -> (ConOfAbs (Arg (Named NamedName (SplitPattern Pattern))) -> m b)
    -> m b
    bindToConcrete ((Named NamedName Pattern -> Named NamedName (SplitPattern Pattern))
    -> NamedArg Pattern -> Arg (Named NamedName (SplitPattern Pattern))
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Pattern -> SplitPattern Pattern)
    -> Named NamedName Pattern
    -> Named NamedName (SplitPattern Pattern)
    forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pattern -> SplitPattern Pattern
    forall a. a -> SplitPattern a
    SplitPattern) NamedArg Pattern
    np) ConOfAbs (Arg (Named NamedName (SplitPattern Pattern))) -> m b
    ConOfAbs (SplitPattern (NamedArg Pattern)) -> m b
    ret

    -- Pass 2b:
    -- Takes care of freshening and binding pattern variables introduced by case split.
    -- Still does not translate anything to Concrete.
    instance ToConcrete BindingPattern where
      type ConOfAbs BindingPattern = A.Pattern
      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    BindingPattern -> (ConOfAbs BindingPattern -> m b) -> m b
    bindToConcrete (BindingPat Pattern
    p) ConOfAbs BindingPattern -> m b
    ret = do
        ArgName -> VerboseLevel -> ArgName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> ArgName -> m ()
    reportSLn ArgName
    "toConcrete.pat" VerboseLevel
    100 (ArgName -> m ()) -> ArgName -> m ()
    forall a b. (a -> b) -> a -> b
    $ ArgName
    "binding pattern (pass 2b)" ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> ArgName
    forall a. Show a => a -> ArgName
    show Pattern
    p
        case Pattern
    p of
          A.VarP BindName
    x               -> FreshenName -> (ConOfAbs FreshenName -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    FreshenName -> (ConOfAbs FreshenName -> m b) -> m b
    bindToConcrete (BindName -> FreshenName
    FreshenName BindName
    x) ((ConOfAbs FreshenName -> m b) -> m b)
    -> (ConOfAbs FreshenName -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs BindingPattern -> m b
    ret (Pattern -> m b) -> (Name -> Pattern) -> Name -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP (BindName -> Pattern) -> (Name -> BindName) -> Name -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> BindName
    mkBindName
          A.WildP{}              -> ConOfAbs BindingPattern -> m b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.ProjP{}              -> ConOfAbs BindingPattern -> m b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.AbsurdP{}            -> ConOfAbs BindingPattern -> m b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.LitP{}               -> ConOfAbs BindingPattern -> m b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.DotP{}               -> ConOfAbs BindingPattern -> m b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.EqualP{}             -> ConOfAbs BindingPattern -> m b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.ConP ConPatInfo
    i AmbiguousQName
    c [NamedArg Pattern]
    args        -> [Arg (Named NamedName BindingPattern)]
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [Arg (Named NamedName BindingPattern)]
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    bindToConcrete ((NamedArg Pattern -> Arg (Named NamedName BindingPattern))
    -> [NamedArg Pattern] -> [Arg (Named NamedName BindingPattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Pattern -> BindingPattern)
    -> NamedArg Pattern -> Arg (Named NamedName BindingPattern)
    forall a b. (a -> b) -> NamedArg a -> NamedArg b
    updateNamedArg Pattern -> BindingPattern
    BindingPat) [NamedArg Pattern]
    args) ((ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b)
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs BindingPattern -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConPatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. ConPatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.ConP ConPatInfo
    i AmbiguousQName
    c
          A.DefP PatInfo
    i AmbiguousQName
    f [NamedArg Pattern]
    args        -> [Arg (Named NamedName BindingPattern)]
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [Arg (Named NamedName BindingPattern)]
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    bindToConcrete ((NamedArg Pattern -> Arg (Named NamedName BindingPattern))
    -> [NamedArg Pattern] -> [Arg (Named NamedName BindingPattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Pattern -> BindingPattern)
    -> NamedArg Pattern -> Arg (Named NamedName BindingPattern)
    forall a b. (a -> b) -> NamedArg a -> NamedArg b
    updateNamedArg Pattern -> BindingPattern
    BindingPat) [NamedArg Pattern]
    args) ((ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b)
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs BindingPattern -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.DefP PatInfo
    i AmbiguousQName
    f
          A.PatternSynP PatInfo
    i AmbiguousQName
    f [NamedArg Pattern]
    args -> [Arg (Named NamedName BindingPattern)]
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [Arg (Named NamedName BindingPattern)]
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    bindToConcrete ((NamedArg Pattern -> Arg (Named NamedName BindingPattern))
    -> [NamedArg Pattern] -> [Arg (Named NamedName BindingPattern)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Pattern -> BindingPattern)
    -> NamedArg Pattern -> Arg (Named NamedName BindingPattern)
    forall a b. (a -> b) -> NamedArg a -> NamedArg b
    updateNamedArg Pattern -> BindingPattern
    BindingPat) [NamedArg Pattern]
    args) ((ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b)
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs BindingPattern -> m b
    ret (Pattern -> m b)
    -> ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.PatternSynP PatInfo
    i AmbiguousQName
    f
          A.RecP KwRange
    kwr ConPatInfo
    i [FieldAssignment' Pattern]
    args      -> [FieldAssignment' BindingPattern]
    -> (ConOfAbs [FieldAssignment' BindingPattern] -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    [FieldAssignment' BindingPattern]
    -> (ConOfAbs [FieldAssignment' BindingPattern] -> m b) -> m b
    bindToConcrete (((FieldAssignment' Pattern -> FieldAssignment' BindingPattern)
    -> [FieldAssignment' Pattern] -> [FieldAssignment' BindingPattern]
    forall a b. (a -> b) -> [a] -> [b]
    map ((FieldAssignment' Pattern -> FieldAssignment' BindingPattern)
     -> [FieldAssignment' Pattern] -> [FieldAssignment' BindingPattern])
    -> ((Pattern -> BindingPattern)
        -> FieldAssignment' Pattern -> FieldAssignment' BindingPattern)
    -> (Pattern -> BindingPattern)
    -> [FieldAssignment' Pattern]
    -> [FieldAssignment' BindingPattern]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> BindingPattern)
    -> FieldAssignment' Pattern -> FieldAssignment' BindingPattern
    forall a b. (a -> b) -> FieldAssignment' a -> FieldAssignment' b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap)        Pattern -> BindingPattern
    BindingPat  [FieldAssignment' Pattern]
    args) ((ConOfAbs [FieldAssignment' BindingPattern] -> m b) -> m b)
    -> (ConOfAbs [FieldAssignment' BindingPattern] -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs BindingPattern -> m b
    ret (Pattern -> m b)
    -> ([FieldAssignment' Pattern] -> Pattern)
    -> [FieldAssignment' Pattern]
    -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KwRange -> ConPatInfo -> [FieldAssignment' Pattern] -> Pattern
    forall e.
    KwRange
    -> ConPatInfo -> [FieldAssignment' (Pattern' e)] -> Pattern' e
    A.RecP KwRange
    kwr ConPatInfo
    i
          A.AsP PatInfo
    i BindName
    x Pattern
    p            -> FreshenName -> (ConOfAbs FreshenName -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    FreshenName -> (ConOfAbs FreshenName -> m b) -> m b
    bindToConcrete (BindName -> FreshenName
    FreshenName BindName
    x) ((ConOfAbs FreshenName -> m b) -> m b)
    -> (ConOfAbs FreshenName -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs FreshenName
    x ->
                                    BindingPattern -> (ConOfAbs BindingPattern -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    BindingPattern -> (ConOfAbs BindingPattern -> m b) -> m b
    bindToConcrete (Pattern -> BindingPattern
    BindingPat Pattern
    p)  ((ConOfAbs BindingPattern -> m b) -> m b)
    -> (ConOfAbs BindingPattern -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs BindingPattern
    p ->
                                    ConOfAbs BindingPattern -> m b
    ret (PatInfo -> BindName -> Pattern -> Pattern
    forall e. PatInfo -> BindName -> Pattern' e -> Pattern' e
    A.AsP PatInfo
    i (Name -> BindName
    mkBindName Name
    ConOfAbs FreshenName
    x) Pattern
    ConOfAbs BindingPattern
    p)
          A.WithP PatInfo
    i Pattern
    p            -> BindingPattern -> (ConOfAbs BindingPattern -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    BindingPattern -> (ConOfAbs BindingPattern -> m b) -> m b
    bindToConcrete (Pattern -> BindingPattern
    BindingPat Pattern
    p) ((ConOfAbs BindingPattern -> m b) -> m b)
    -> (ConOfAbs BindingPattern -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m b
    ConOfAbs BindingPattern -> m b
    ret (Pattern -> m b) -> (Pattern -> Pattern) -> Pattern -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> Pattern -> Pattern
    forall e. PatInfo -> Pattern' e -> Pattern' e
    A.WithP PatInfo
    i

    instance ToConcrete A.Pattern where
      type ConOfAbs A.Pattern = C.Pattern

      bindToConcrete :: forall (m :: * -> *) b.
    MonadToConcrete m =>
    Pattern -> (ConOfAbs Pattern -> m b) -> m b
    bindToConcrete Pattern
    p ConOfAbs Pattern -> m b
    ret = do
        prec <- m PrecedenceStack
    forall (m :: * -> *). MonadToConcrete m => m PrecedenceStack
    currentPrecedence
        bindToConcrete (UserPattern p) $ \ ConOfAbs (UserPattern Pattern)
    p -> do
          SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    forall a (m :: * -> *) b.
    (ToConcrete a, MonadToConcrete m) =>
    a -> (ConOfAbs a -> m b) -> m b
    forall (m :: * -> *) b.
    MonadToConcrete m =>
    SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    bindToConcrete (Pattern -> SplitPattern Pattern
    forall a. a -> SplitPattern a
    SplitPattern Pattern
    ConOfAbs (UserPattern Pattern)
    p) ((ConOfAbs (SplitPattern Pattern) -> m b) -> m b)
    -> (ConOfAbs (SplitPattern Pattern) -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (SplitPattern Pattern)
    p -> do
            Pattern -> m b
    ConOfAbs Pattern -> m b
    ret (Pattern -> m b) -> m Pattern -> m b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do PrecedenceStack -> m Pattern -> m Pattern
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    PrecedenceStack -> m a -> m a
    withPrecedence' PrecedenceStack
    prec (m Pattern -> m Pattern) -> m Pattern -> m Pattern
    forall a b. (a -> b) -> a -> b
    $ Pattern -> m (ConOfAbs Pattern)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m (ConOfAbs Pattern)
    toConcrete Pattern
    ConOfAbs (SplitPattern Pattern)
    p
      toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m (ConOfAbs Pattern)
    toConcrete Pattern
    p =
        case Pattern
    p of
          A.VarP BindName
    x ->
            Bool -> QName -> Pattern
    C.IdentP Bool
    True (QName -> Pattern) -> (BoundName -> QName) -> BoundName -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> QName
    C.QName (Name -> QName) -> (BoundName -> Name) -> BoundName -> QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BoundName -> Name
    C.boundName (BoundName -> Pattern) -> m BoundName -> m Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BindName -> m (ConOfAbs BindName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    BindName -> m (ConOfAbs BindName)
    toConcrete BindName
    x

          A.WildP PatInfo
    i ->
            Pattern -> m Pattern
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> m Pattern) -> Pattern -> m Pattern
    forall a b. (a -> b) -> a -> b
    $ Range -> Pattern
    C.WildP (PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i)

          A.ConP ConPatInfo
    i AmbiguousQName
    c [NamedArg Pattern]
    args  -> QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> m Pattern
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> m Pattern
    tryOp (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    c) (ConPatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. ConPatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.ConP ConPatInfo
    i AmbiguousQName
    c) [NamedArg Pattern]
    args

          A.ProjP PatInfo
    i ProjOrigin
    ProjPrefix AmbiguousQName
    p -> Bool -> QName -> Pattern
    C.IdentP Bool
    True (QName -> Pattern) -> m QName -> m Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    p)
          A.ProjP PatInfo
    i ProjOrigin
    _          AmbiguousQName
    p -> KwRange -> Range -> Expr -> Pattern
    C.DotP KwRange
    forall a. Null a => a
    empty Range
    forall a. Range' a
    noRange (Expr -> Pattern) -> (QName -> Expr) -> QName -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Expr
    C.Ident (QName -> Pattern) -> m QName -> m Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    p)

          A.DefP PatInfo
    i AmbiguousQName
    x [NamedArg Pattern]
    args -> QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> m Pattern
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> m Pattern
    tryOp (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    x) (PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.DefP PatInfo
    i AmbiguousQName
    x)  [NamedArg Pattern]
    args

          A.AsP PatInfo
    i BindName
    x Pattern
    p -> do
            (x, p) <- Precedence
    -> (BindName, Pattern) -> m (ConOfAbs (BindName, Pattern))
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    argumentCtx_ (BindName
    x, Pattern
    p)
            return $ C.AsP (getRange i) (C.boundName x) p

          A.AbsurdP PatInfo
    i ->
            Pattern -> m Pattern
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> m Pattern) -> Pattern -> m Pattern
    forall a b. (a -> b) -> a -> b
    $ Range -> Pattern
    C.AbsurdP (PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i)

          A.LitP PatInfo
    i (LitQName QName
    x) -> do
            x <- AllowAmbiguousNames -> QName -> m QName
    forall (m :: * -> *).
    MonadToConcrete m =>
    AllowAmbiguousNames -> QName -> m QName
    lookupQName AllowAmbiguousNames
    AmbiguousNothing QName
    x
            bracketP_ appBrackets $ return $
              C.AppP (C.QuoteP (getRange i))
                (defaultNamedArg (C.IdentP True x))
          A.LitP PatInfo
    i Literal
    l ->
            Pattern -> m Pattern
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> m Pattern) -> Pattern -> m Pattern
    forall a b. (a -> b) -> a -> b
    $ Range -> Literal -> Pattern
    C.LitP (PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i) Literal
    l

          -- Andreas, 2018-06-19, issue #3130
          -- Print .p as .(p) if p is a projection
          -- to avoid confusion with projection pattern.
          A.DotP PatInfo
    i e :: Expr
    e@A.Proj{} -> KwRange -> Range -> Expr -> Pattern
    C.DotP KwRange
    forall a. Null a => a
    empty Range
    r (Expr -> Pattern) -> (Expr -> Expr) -> Expr -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> Expr -> Expr
    C.Paren Range
    r (Expr -> Pattern) -> m Expr -> m Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Precedence -> Expr -> m (ConOfAbs Expr)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    TopCtx Expr
    e
            where r :: Range
    r = PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i

          -- gallais, 2019-02-12, issue #3491
          -- Print p as .(p) if p is a variable but there is a projection of the
          -- same name in scope.
          A.DotP PatInfo
    i e :: Expr
    e@(A.Var Name
    v) -> do
            let r :: Range
    r = PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i
            -- Erase @v@ to a concrete name and resolve it back to check whether
            -- we have a conflicting field name.
            cn <- Name -> m Name
    forall (m :: * -> *). MonadToConcrete m => Name -> m Name
    toConcreteName Name
    v
            resolveName (someKindsOfNames [FldName]) Nothing (C.QName cn) >>= \ case
              -- If we do then we print .(v) rather than .v
              Right FieldName{} -> do
                ArgName -> VerboseLevel -> ArgName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    ArgName -> VerboseLevel -> ArgName -> m ()
    reportSLn ArgName
    "print.dotted" VerboseLevel
    50 (ArgName -> m ()) -> ArgName -> m ()
    forall a b. (a -> b) -> a -> b
    $ ArgName
    "Wrapping ambiguous name " ArgName -> ArgName -> ArgName
    forall a. [a] -> [a] -> [a]
    ++ Name -> ArgName
    forall a. Pretty a => a -> ArgName
    prettyShow (Name -> Name
    nameConcrete Name
    v)
                KwRange -> Range -> Expr -> Pattern
    C.DotP KwRange
    forall a. Null a => a
    empty Range
    r (Expr -> Pattern) -> (Expr -> Expr) -> Expr -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> Expr -> Expr
    C.Paren Range
    r (Expr -> Pattern) -> m Expr -> m Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Expr -> m (ConOfAbs Expr)
    toConcrete (Name -> Expr
    A.Var Name
    v)
              Right ResolvedName
    _ -> PatInfo -> Expr -> m Pattern
    forall (m :: * -> *).
    MonadToConcrete m =>
    PatInfo -> Expr -> m Pattern
    printDotDefault PatInfo
    i Expr
    e
              Left NameResolutionError
    _ -> m Pattern
    forall a. HasCallStack => a
    __IMPOSSIBLE__

          A.DotP PatInfo
    i Expr
    e -> PatInfo -> Expr -> m Pattern
    forall (m :: * -> *).
    MonadToConcrete m =>
    PatInfo -> Expr -> m Pattern
    printDotDefault PatInfo
    i Expr
    e

          A.EqualP PatInfo
    i List1 (Expr, Expr)
    es -> do
            Range -> List1 (Expr, Expr) -> Pattern
    C.EqualP (PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i) (List1 (Expr, Expr) -> Pattern)
    -> m (List1 (Expr, Expr)) -> m Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> List1 (Expr, Expr) -> m (ConOfAbs (List1 (Expr, Expr)))
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    List1 (Expr, Expr) -> m (ConOfAbs (List1 (Expr, Expr)))
    toConcrete List1 (Expr, Expr)
    es

          A.PatternSynP PatInfo
    i AmbiguousQName
    n [NamedArg Pattern]
    args -> QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> m Pattern
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> m Pattern
    tryOp (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    n) (PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.PatternSynP PatInfo
    i AmbiguousQName
    n) [NamedArg Pattern]
    args

          A.RecP KwRange
    kwr ConPatInfo
    i [FieldAssignment' Pattern]
    as ->
            KwRange -> Range -> [FieldAssignment' Pattern] -> Pattern
    C.RecP KwRange
    kwr (ConPatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ConPatInfo
    i) ([FieldAssignment' Pattern] -> Pattern)
    -> m [FieldAssignment' Pattern] -> m Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FieldAssignment' Pattern -> m (FieldAssignment' Pattern))
    -> [FieldAssignment' Pattern] -> m [FieldAssignment' Pattern]
    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 ((Pattern -> m Pattern)
    -> FieldAssignment' Pattern -> m (FieldAssignment' Pattern)
    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) -> FieldAssignment' a -> f (FieldAssignment' b)
    traverse Pattern -> m Pattern
    Pattern -> m (ConOfAbs Pattern)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m (ConOfAbs Pattern)
    toConcrete) [FieldAssignment' Pattern]
    as

          A.WithP PatInfo
    i Pattern
    p -> Range -> Pattern -> Pattern
    C.WithP (PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i) (Pattern -> Pattern) -> m Pattern -> m Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Precedence -> Pattern -> m (ConOfAbs Pattern)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    WithArgCtx Pattern
    p

        where

        printDotDefault :: MonadToConcrete m => PatInfo -> A.Expr -> m C.Pattern
        printDotDefault :: forall (m :: * -> *).
    MonadToConcrete m =>
    PatInfo -> Expr -> m Pattern
    printDotDefault PatInfo
    i Expr
    e = do
          c <- Precedence -> Expr -> m (ConOfAbs Expr)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    DotPatternCtx Expr
    e
          let r = PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i
          case c of
            -- Andreas, 2016-02-04 print ._ pattern as _ pattern,
            -- following the fusing of WildP and ImplicitP.
            C.Underscore{} -> Pattern -> m Pattern
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> m Pattern) -> Pattern -> m Pattern
    forall a b. (a -> b) -> a -> b
    $ Range -> Pattern
    C.WildP Range
    r
            Expr
    _ -> Pattern -> m Pattern
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> m Pattern) -> Pattern -> m Pattern
    forall a b. (a -> b) -> a -> b
    $ KwRange -> Range -> Expr -> Pattern
    C.DotP KwRange
    forall a. Null a => a
    empty Range
    r Expr
    c

        tryOp :: MonadToConcrete m => A.QName -> (A.Patterns -> A.Pattern) -> A.Patterns -> m C.Pattern
        tryOp :: forall (m :: * -> *).
    MonadToConcrete m =>
    QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> m Pattern
    tryOp QName
    x [NamedArg Pattern] -> Pattern
    f [NamedArg Pattern]
    args = do
          -- Andreas, 2016-02-04, Issue #1792
          -- To prevent failing of tryToRecoverOpAppP for overapplied operators,
          -- we take off the exceeding arguments first
          -- and apply them pointwise with C.AppP later.
          let ([NamedArg Pattern]
    args1, [NamedArg Pattern]
    args2) = VerboseLevel
    -> [NamedArg Pattern] -> ([NamedArg Pattern], [NamedArg Pattern])
    forall a. VerboseLevel -> [a] -> ([a], [a])
    splitAt (QName -> VerboseLevel
    forall a. NumHoles a => a -> VerboseLevel
    numHoles QName
    x) [NamedArg Pattern]
    args
          let funCtx :: m (Maybe Pattern) -> m (Maybe Pattern)
    funCtx = Bool
    -> (m (Maybe Pattern) -> m (Maybe Pattern))
    -> m (Maybe Pattern)
    -> m (Maybe Pattern)
    forall b a. IsBool b => b -> (a -> a) -> a -> a
    applyUnless ([NamedArg Pattern] -> Bool
    forall a. Null a => a -> Bool
    null [NamedArg Pattern]
    args2) (Precedence -> m (Maybe Pattern) -> m (Maybe Pattern)
    forall (m :: * -> *) a.
    MonadToConcrete m =>
    Precedence -> m a -> m a
    withPrecedence Precedence
    FunctionCtx)
          Pattern -> m Pattern -> m Pattern
    forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m Pattern -> m Pattern
    tryToRecoverPatternSynP ([NamedArg Pattern] -> Pattern
    f [NamedArg Pattern]
    args) (m Pattern -> m Pattern) -> m Pattern -> m Pattern
    forall a b. (a -> b) -> a -> b
    $ m (Maybe Pattern) -> m (Maybe Pattern)
    funCtx (Pattern -> m (Maybe Pattern)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m (Maybe Pattern)
    tryToRecoverOpAppP (Pattern -> m (Maybe Pattern)) -> Pattern -> m (Maybe Pattern)
    forall a b. (a -> b) -> a -> b
    $ [NamedArg Pattern] -> Pattern
    f [NamedArg Pattern]
    args1) m (Maybe Pattern) -> (Maybe Pattern -> m Pattern) -> m Pattern
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Just Pattern
    c  -> [NamedArg Pattern] -> Pattern -> m Pattern
    forall {arg} {m :: * -> *}.
    (ConOfAbs arg ~ Arg (Named_ Pattern), MonadFresh NameId m,
     MonadInteractionPoints m, MonadStConcreteNames m, PureTCM m,
     IsString (m Doc), Null (m Doc), Semigroup (m Doc),
     MonadReader Env m, ToConcrete arg) =>
    [arg] -> Pattern -> m Pattern
    applyTo [NamedArg Pattern]
    args2 Pattern
    c
            Maybe Pattern
    Nothing -> [NamedArg Pattern] -> Pattern -> m Pattern
    forall {arg} {m :: * -> *}.
    (ConOfAbs arg ~ Arg (Named_ Pattern), MonadFresh NameId m,
     MonadInteractionPoints m, MonadStConcreteNames m, PureTCM m,
     IsString (m Doc), Null (m Doc), Semigroup (m Doc),
     MonadReader Env m, ToConcrete arg) =>
    [arg] -> Pattern -> m Pattern
    applyTo [NamedArg Pattern]
    args (Pattern -> m Pattern) -> (QName -> Pattern) -> QName -> m Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> QName -> Pattern
    C.IdentP Bool
    True (QName -> m Pattern) -> m QName -> m Pattern
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete QName
    x
        -- Note: applyTo [] c = return c
        applyTo :: [arg] -> Pattern -> m Pattern
    applyTo [arg]
    args Pattern
    c = (PrecedenceStack -> Bool) -> m Pattern -> m Pattern
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Pattern -> m Pattern
    bracketP_ ([arg] -> PrecedenceStack -> Bool
    forall arg. [arg] -> PrecedenceStack -> Bool
    appBracketsArgs [arg]
    args) (m Pattern -> m Pattern) -> m Pattern -> m Pattern
    forall a b. (a -> b) -> a -> b
    $ do
          (Pattern -> Arg (Named_ Pattern) -> Pattern)
    -> Pattern -> [Arg (Named_ Pattern)] -> Pattern
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Pattern -> Arg (Named_ Pattern) -> Pattern
    C.AppP Pattern
    c ([Arg (Named_ Pattern)] -> Pattern)
    -> m [Arg (Named_ Pattern)] -> m Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            ((Arg (Named_ Pattern) -> m (Arg (Named_ Pattern)))
    -> [Arg (Named_ Pattern)] -> m [Arg (Named_ Pattern)]
    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 Arg (Named_ Pattern) -> m (Arg (Named_ Pattern))
    forall (m :: * -> *).
    MonadToConcrete m =>
    Arg (Named_ Pattern) -> m (Arg (Named_ Pattern))
    avoidPun ([Arg (Named_ Pattern)] -> m [Arg (Named_ Pattern)])
    -> m [Arg (Named_ Pattern)] -> m [Arg (Named_ Pattern)]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Precedence -> [arg] -> m (ConOfAbs [arg])
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    argumentCtx_ [arg]
    args)

        -- If --hidden-argument-puns is active, then {x} is replaced by
        -- {(x)} and ⦃ x ⦄ by ⦃ (x) ⦄.
        avoidPun :: MonadToConcrete m => NamedArg C.Pattern -> m (NamedArg C.Pattern)
        avoidPun :: forall (m :: * -> *).
    MonadToConcrete m =>
    Arg (Named_ Pattern) -> m (Arg (Named_ Pattern))
    avoidPun Arg (Named_ Pattern)
    arg =
          m Bool
    -> m (Arg (Named_ Pattern))
    -> m (Arg (Named_ Pattern))
    -> m (Arg (Named_ Pattern))
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (PragmaOptions -> Bool
    optHiddenArgumentPuns (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions)
              (Arg (Named_ Pattern) -> m (Arg (Named_ Pattern))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Arg (Named_ Pattern) -> m (Arg (Named_ Pattern)))
    -> Arg (Named_ Pattern) -> m (Arg (Named_ Pattern))
    forall a b. (a -> b) -> a -> b
    $ case Arg (Named_ Pattern)
    arg of
                 Arg ArgInfo
    i (Named Maybe NamedName
    Nothing x :: Pattern
    x@C.IdentP{}) | ArgInfo -> Bool
    forall a. LensHiding a => a -> Bool
    notVisible ArgInfo
    i ->
                   ArgInfo -> Named_ Pattern -> Arg (Named_ Pattern)
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    i (Maybe NamedName -> Pattern -> Named_ Pattern
    forall name a. Maybe name -> a -> Named name a
    Named Maybe NamedName
    forall a. Maybe a
    Nothing (Range -> Pattern -> Pattern
    C.ParenP Range
    forall a. Range' a
    noRange Pattern
    x))
                 Arg (Named_ Pattern)
    arg -> Arg (Named_ Pattern)
    arg)
              (Arg (Named_ Pattern) -> m (Arg (Named_ Pattern))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Arg (Named_ Pattern)
    arg)

    -- Helpers for recovering natural number literals

    tryToRecoverNatural :: MonadToConcrete m => A.Expr -> m C.Expr -> m C.Expr
    tryToRecoverNatural :: forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverNatural Expr
    e m Expr
    def = do
      is <- m (QName -> BuiltinId -> Bool)
    forall (m :: * -> *).
    MonadToConcrete m =>
    m (QName -> BuiltinId -> Bool)
    isBuiltinFun
      caseMaybe (recoverNatural is e) def $ return . C.Lit noRange . LitNat

    recoverNatural :: (A.QName -> BuiltinId -> Bool) -> A.Expr -> Maybe Integer
    recoverNatural :: (QName -> BuiltinId -> Bool) -> Expr -> Maybe Integer
    recoverNatural QName -> BuiltinId -> Bool
    is Expr
    e = (QName -> Bool)
    -> (QName -> Bool) -> Integer -> Expr -> Maybe Integer
    explore (QName -> BuiltinId -> Bool
    `is` BuiltinId
    builtinZero) (QName -> BuiltinId -> Bool
    `is` BuiltinId
    builtinSuc) Integer
    0 Expr
    e
      where
        explore :: (A.QName -> Bool) -> (A.QName -> Bool) -> Integer -> A.Expr -> Maybe Integer
        explore :: (QName -> Bool)
    -> (QName -> Bool) -> Integer -> Expr -> Maybe Integer
    explore QName -> Bool
    isZero QName -> Bool
    isSuc Integer
    k (A.App AppInfo
    _ (A.Con AmbiguousQName
    c) NamedArg Expr
    t) | Just QName
    f <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    c, QName -> Bool
    isSuc QName
    f
                                                    = ((QName -> Bool)
    -> (QName -> Bool) -> Integer -> Expr -> Maybe Integer
    explore QName -> Bool
    isZero QName -> Bool
    isSuc (Integer -> Expr -> Maybe Integer)
    -> Integer -> Expr -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $! Integer
    k Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    1) (NamedArg Expr -> Expr
    forall a. NamedArg a -> a
    namedArg NamedArg Expr
    t)
        explore QName -> Bool
    isZero QName -> Bool
    isSuc Integer
    k (A.Con AmbiguousQName
    c) | Just QName
    x <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    c, QName -> Bool
    isZero QName
    x = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    k
        explore QName -> Bool
    isZero QName -> Bool
    isSuc Integer
    k (A.Lit ExprInfo
    _ (LitNat Integer
    l)) = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer
    k Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    l)
        explore QName -> Bool
    _ QName -> Bool
    _ Integer
    _ Expr
    _                             = Maybe Integer
    forall a. Maybe a
    Nothing

    -- Helpers for recovering C.OpApp ------------------------------------------

    data Hd = HdVar A.Name | HdCon A.QName | HdDef A.QName | HdSyn A.QName

    data MaybeSection a
      = YesSection
      | NoSection a
      deriving (MaybeSection a -> MaybeSection a -> Bool
    (MaybeSection a -> MaybeSection a -> Bool)
    -> (MaybeSection a -> MaybeSection a -> Bool)
    -> Eq (MaybeSection a)
    forall a. Eq a => MaybeSection a -> MaybeSection a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => MaybeSection a -> MaybeSection a -> Bool
    == :: MaybeSection a -> MaybeSection a -> Bool
    $c/= :: forall a. Eq a => MaybeSection a -> MaybeSection a -> Bool
    /= :: MaybeSection a -> MaybeSection a -> Bool
    Eq, VerboseLevel -> MaybeSection a -> ArgName -> ArgName
    [MaybeSection a] -> ArgName -> ArgName
    MaybeSection a -> ArgName
    (VerboseLevel -> MaybeSection a -> ArgName -> ArgName)
    -> (MaybeSection a -> ArgName)
    -> ([MaybeSection a] -> ArgName -> ArgName)
    -> Show (MaybeSection a)
    forall a.
    Show a =>
    VerboseLevel -> MaybeSection a -> ArgName -> ArgName
    forall a. Show a => [MaybeSection a] -> ArgName -> ArgName
    forall a. Show a => MaybeSection a -> ArgName
    forall a.
    (VerboseLevel -> a -> ArgName -> ArgName)
    -> (a -> ArgName) -> ([a] -> ArgName -> ArgName) -> Show a
    $cshowsPrec :: forall a.
    Show a =>
    VerboseLevel -> MaybeSection a -> ArgName -> ArgName
    showsPrec :: VerboseLevel -> MaybeSection a -> ArgName -> ArgName
    $cshow :: forall a. Show a => MaybeSection a -> ArgName
    show :: MaybeSection a -> ArgName
    $cshowList :: forall a. Show a => [MaybeSection a] -> ArgName -> ArgName
    showList :: [MaybeSection a] -> ArgName -> ArgName
    Show, (forall a b. (a -> b) -> MaybeSection a -> MaybeSection b)
    -> (forall a b. a -> MaybeSection b -> MaybeSection a)
    -> Functor MaybeSection
    forall a b. a -> MaybeSection b -> MaybeSection a
    forall a b. (a -> b) -> MaybeSection a -> MaybeSection 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) -> MaybeSection a -> MaybeSection b
    fmap :: forall a b. (a -> b) -> MaybeSection a -> MaybeSection b
    $c<$ :: forall a b. a -> MaybeSection b -> MaybeSection a
    <$ :: forall a b. a -> MaybeSection b -> MaybeSection a
    Functor, (forall m. Monoid m => MaybeSection m -> m)
    -> (forall m a. Monoid m => (a -> m) -> MaybeSection a -> m)
    -> (forall m a. Monoid m => (a -> m) -> MaybeSection a -> m)
    -> (forall a b. (a -> b -> b) -> b -> MaybeSection a -> b)
    -> (forall a b. (a -> b -> b) -> b -> MaybeSection a -> b)
    -> (forall b a. (b -> a -> b) -> b -> MaybeSection a -> b)
    -> (forall b a. (b -> a -> b) -> b -> MaybeSection a -> b)
    -> (forall a. (a -> a -> a) -> MaybeSection a -> a)
    -> (forall a. (a -> a -> a) -> MaybeSection a -> a)
    -> (forall a. MaybeSection a -> [a])
    -> (forall a. MaybeSection a -> Bool)
    -> (forall a. MaybeSection a -> VerboseLevel)
    -> (forall a. Eq a => a -> MaybeSection a -> Bool)
    -> (forall a. Ord a => MaybeSection a -> a)
    -> (forall a. Ord a => MaybeSection a -> a)
    -> (forall a. Num a => MaybeSection a -> a)
    -> (forall a. Num a => MaybeSection a -> a)
    -> Foldable MaybeSection
    forall a. Eq a => a -> MaybeSection a -> Bool
    forall a. Num a => MaybeSection a -> a
    forall a. Ord a => MaybeSection a -> a
    forall m. Monoid m => MaybeSection m -> m
    forall a. MaybeSection a -> Bool
    forall a. MaybeSection a -> VerboseLevel
    forall a. MaybeSection a -> [a]
    forall a. (a -> a -> a) -> MaybeSection a -> a
    forall m a. Monoid m => (a -> m) -> MaybeSection a -> m
    forall b a. (b -> a -> b) -> b -> MaybeSection a -> b
    forall a b. (a -> b -> b) -> b -> MaybeSection a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> VerboseLevel)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    $cfold :: forall m. Monoid m => MaybeSection m -> m
    fold :: forall m. Monoid m => MaybeSection m -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> MaybeSection a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> MaybeSection a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> MaybeSection a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> MaybeSection a -> m
    $cfoldr :: forall a b. (a -> b -> b) -> b -> MaybeSection a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> MaybeSection a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> MaybeSection a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> MaybeSection a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> MaybeSection a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> MaybeSection a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> MaybeSection a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> MaybeSection a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> MaybeSection a -> a
    foldr1 :: forall a. (a -> a -> a) -> MaybeSection a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> MaybeSection a -> a
    foldl1 :: forall a. (a -> a -> a) -> MaybeSection a -> a
    $ctoList :: forall a. MaybeSection a -> [a]
    toList :: forall a. MaybeSection a -> [a]
    $cnull :: forall a. MaybeSection a -> Bool
    null :: forall a. MaybeSection a -> Bool
    $clength :: forall a. MaybeSection a -> VerboseLevel
    length :: forall a. MaybeSection a -> VerboseLevel
    $celem :: forall a. Eq a => a -> MaybeSection a -> Bool
    elem :: forall a. Eq a => a -> MaybeSection a -> Bool
    $cmaximum :: forall a. Ord a => MaybeSection a -> a
    maximum :: forall a. Ord a => MaybeSection a -> a
    $cminimum :: forall a. Ord a => MaybeSection a -> a
    minimum :: forall a. Ord a => MaybeSection a -> a
    $csum :: forall a. Num a => MaybeSection a -> a
    sum :: forall a. Num a => MaybeSection a -> a
    $cproduct :: forall a. Num a => MaybeSection a -> a
    product :: forall a. Num a => MaybeSection a -> a
    Foldable, Functor MaybeSection
    Foldable MaybeSection
    (Functor MaybeSection, Foldable MaybeSection) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> MaybeSection a -> f (MaybeSection b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        MaybeSection (f a) -> f (MaybeSection a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> MaybeSection a -> m (MaybeSection b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        MaybeSection (m a) -> m (MaybeSection a))
    -> Traversable MaybeSection
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a.
    Monad m =>
    MaybeSection (m a) -> m (MaybeSection a)
    forall (f :: * -> *) a.
    Applicative f =>
    MaybeSection (f a) -> f (MaybeSection a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MaybeSection a -> m (MaybeSection b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MaybeSection a -> f (MaybeSection b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MaybeSection a -> f (MaybeSection b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MaybeSection a -> f (MaybeSection b)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    MaybeSection (f a) -> f (MaybeSection a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    MaybeSection (f a) -> f (MaybeSection a)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MaybeSection a -> m (MaybeSection b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MaybeSection a -> m (MaybeSection b)
    $csequence :: forall (m :: * -> *) a.
    Monad m =>
    MaybeSection (m a) -> m (MaybeSection a)
    sequence :: forall (m :: * -> *) a.
    Monad m =>
    MaybeSection (m a) -> m (MaybeSection a)
    Traversable)

    fromNoSection :: a -> MaybeSection a -> a
    fromNoSection :: forall a. a -> MaybeSection a -> a
    fromNoSection a
    fallback = \case
      MaybeSection a
    YesSection  -> a
    fallback
      NoSection a
    x -> a
    x

    instance HasRange a => HasRange (MaybeSection a) where
      getRange :: MaybeSection a -> Range
    getRange = \case
        MaybeSection a
    YesSection  -> Range
    forall a. Range' a
    noRange
        NoSection a
    a -> a -> Range
    forall a. HasRange a => a -> Range
    getRange a
    a

    getHead :: A.Expr -> Maybe Hd
    getHead :: Expr -> Maybe Hd
    getHead (Var Name
    x)          = Hd -> Maybe Hd
    forall a. a -> Maybe a
    Just (Name -> Hd
    HdVar Name
    x)
    getHead (Def QName
    f)          = Hd -> Maybe Hd
    forall a. a -> Maybe a
    Just (QName -> Hd
    HdDef QName
    f)
    getHead (Proj ProjOrigin
    o AmbiguousQName
    f)       = Hd -> Maybe Hd
    forall a. a -> Maybe a
    Just (QName -> Hd
    HdDef (QName -> Hd) -> QName -> Hd
    forall a b. (a -> b) -> a -> b
    $ AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    f)
    getHead (Con AmbiguousQName
    c)          = Hd -> Maybe Hd
    forall a. a -> Maybe a
    Just (QName -> Hd
    HdCon (QName -> Hd) -> QName -> Hd
    forall a b. (a -> b) -> a -> b
    $ AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    c)
    getHead (A.PatternSyn AmbiguousQName
    n) = Hd -> Maybe Hd
    forall a. a -> Maybe a
    Just (QName -> Hd
    HdSyn (QName -> Hd) -> QName -> Hd
    forall a b. (a -> b) -> a -> b
    $ AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    n)
    getHead Expr
    _                = Maybe Hd
    forall a. Maybe a
    Nothing

    cOpApp :: Asp.NameKind -> Range -> C.QName -> A.Name -> List1 (MaybeSection C.Expr) -> C.Expr
    cOpApp :: NameKind
    -> Range -> QName -> Name -> List1 (MaybeSection Expr) -> Expr
    cOpApp NameKind
    nk Range
    r QName
    x Name
    n List1 (MaybeSection Expr)
    es =
      NameKind -> Range -> QName -> Set1 Name -> OpAppArgs -> Expr
    C.KnownOpApp NameKind
    nk Range
    r QName
    x (Name -> Set1 Name
    forall el coll. Singleton el coll => el -> coll
    singleton Name
    n) (OpAppArgs -> Expr) -> OpAppArgs -> Expr
    forall a b. (a -> b) -> a -> b
    $
      ((MaybeSection Expr, PositionInName)
     -> NamedArg (MaybePlaceholder (OpApp Expr)))
    -> NonEmpty (MaybeSection Expr, PositionInName) -> OpAppArgs
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (MaybePlaceholder (OpApp Expr)
    -> NamedArg (MaybePlaceholder (OpApp Expr))
    forall a. a -> NamedArg a
    defaultNamedArg (MaybePlaceholder (OpApp Expr)
     -> NamedArg (MaybePlaceholder (OpApp Expr)))
    -> ((MaybeSection Expr, PositionInName)
        -> MaybePlaceholder (OpApp Expr))
    -> (MaybeSection Expr, PositionInName)
    -> NamedArg (MaybePlaceholder (OpApp Expr))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (MaybeSection Expr, PositionInName)
    -> MaybePlaceholder (OpApp Expr)
    forall {e}.
    (MaybeSection e, PositionInName) -> MaybePlaceholder (OpApp e)
    placeholder) (NonEmpty (MaybeSection Expr, PositionInName) -> OpAppArgs)
    -> NonEmpty (MaybeSection Expr, PositionInName) -> OpAppArgs
    forall a b. (a -> b) -> a -> b
    $
      List1 (MaybeSection Expr)
    -> NonEmpty PositionInName
    -> NonEmpty (MaybeSection Expr, PositionInName)
    forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
    List1.zip List1 (MaybeSection Expr)
    es NonEmpty PositionInName
    positions
      where
        x0 :: Name
    x0 = QName -> Name
    C.unqualify QName
    x
        positions :: NonEmpty PositionInName
    positions | Name -> Bool
    isPrefix  Name
    x0 =              (PositionInName -> MaybeSection Expr -> PositionInName
    forall a b. a -> b -> a
    const PositionInName
    Middle (MaybeSection Expr -> PositionInName)
    -> [MaybeSection Expr] -> [PositionInName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> VerboseLevel -> List1 (MaybeSection Expr) -> [MaybeSection Expr]
    forall a. VerboseLevel -> NonEmpty a -> [a]
    List1.drop VerboseLevel
    1 List1 (MaybeSection Expr)
    es) [PositionInName] -> PositionInName -> NonEmpty PositionInName
    forall a. [a] -> a -> List1 a
    `List1.snoc` PositionInName
    End
                  | Name -> Bool
    isPostfix Name
    x0 = PositionInName
    Beginning PositionInName -> [PositionInName] -> NonEmpty PositionInName
    forall a. a -> [a] -> NonEmpty a
    :| (PositionInName -> MaybeSection Expr -> PositionInName
    forall a b. a -> b -> a
    const PositionInName
    Middle (MaybeSection Expr -> PositionInName)
    -> [MaybeSection Expr] -> [PositionInName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> VerboseLevel -> List1 (MaybeSection Expr) -> [MaybeSection Expr]
    forall a. VerboseLevel -> NonEmpty a -> [a]
    List1.drop VerboseLevel
    1 List1 (MaybeSection Expr)
    es)
                  | Name -> Bool
    isInfix Name
    x0   = PositionInName
    Beginning PositionInName -> [PositionInName] -> NonEmpty PositionInName
    forall a. a -> [a] -> NonEmpty a
    :| (PositionInName -> MaybeSection Expr -> PositionInName
    forall a b. a -> b -> a
    const PositionInName
    Middle (MaybeSection Expr -> PositionInName)
    -> [MaybeSection Expr] -> [PositionInName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> VerboseLevel -> List1 (MaybeSection Expr) -> [MaybeSection Expr]
    forall a. VerboseLevel -> NonEmpty a -> [a]
    List1.drop VerboseLevel
    2 List1 (MaybeSection Expr)
    es) [PositionInName] -> [PositionInName] -> [PositionInName]
    forall a. [a] -> [a] -> [a]
    ++ [ PositionInName
    End ]
                  | Bool
    otherwise    =               PositionInName -> MaybeSection Expr -> PositionInName
    forall a b. a -> b -> a
    const PositionInName
    Middle (MaybeSection Expr -> PositionInName)
    -> List1 (MaybeSection Expr) -> NonEmpty PositionInName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> List1 (MaybeSection Expr)
    es
        placeholder :: (MaybeSection e, PositionInName) -> MaybePlaceholder (OpApp e)
    placeholder (MaybeSection e
    YesSection , PositionInName
    pos ) = PositionInName -> MaybePlaceholder (OpApp e)
    forall e. PositionInName -> MaybePlaceholder e
    Placeholder PositionInName
    pos
        placeholder (NoSection e
    e, PositionInName
    _pos) = OpApp e -> MaybePlaceholder (OpApp e)
    forall e. e -> MaybePlaceholder e
    noPlaceholder (e -> OpApp e
    forall e. e -> OpApp e
    Ordinary e
    e)

    tryToRecoverOpApp :: MonadToConcrete m => A.Expr -> m C.Expr -> m C.Expr
    tryToRecoverOpApp :: forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverOpApp Expr
    e m Expr
    def = m Expr -> m (Maybe Expr) -> m Expr
    forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
    fromMaybeM m Expr
    def (m (Maybe Expr) -> m Expr) -> m (Maybe Expr) -> m Expr
    forall a b. (a -> b) -> a -> b
    $
      ((PrecedenceStack -> Bool) -> m Expr -> m Expr)
    -> (Expr -> Bool)
    -> (NameKind
        -> Range -> QName -> Name -> List1 (MaybeSection Expr) -> Expr)
    -> (Expr -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Expr))]))
    -> Expr
    -> m (Maybe Expr)
    forall a c (m :: * -> *).
    (ToConcrete a, c ~ ConOfAbs a, HasRange c, MonadToConcrete m) =>
    ((PrecedenceStack -> Bool) -> m c -> m c)
    -> (a -> Bool)
    -> (NameKind
        -> Range -> QName -> Name -> List1 (MaybeSection c) -> c)
    -> (a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))]))
    -> a
    -> m (Maybe c)
    recoverOpApp (PrecedenceStack -> Bool) -> m Expr -> m Expr
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Expr -> m Expr
    bracket (NamedArg Expr -> Bool
    isLambda (NamedArg Expr -> Bool) -> (Expr -> NamedArg Expr) -> Expr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Expr -> NamedArg Expr
    forall a. a -> NamedArg a
    defaultNamedArg) NameKind
    -> Range -> QName -> Name -> List1 (MaybeSection Expr) -> Expr
    cOpApp Expr -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Expr))])
    view Expr
    e
      where
        view :: A.Expr -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, A.Expr))])
        view :: Expr -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Expr))])
    view Expr
    e
            -- Do we have a series of inserted lambdas?
          | Just xs :: [Binder]
    xs@(Binder
    _:[Binder]
    _) <- (LamBinding -> Maybe Binder) -> [LamBinding] -> Maybe [Binder]
    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) -> [a] -> f [b]
    traverse LamBinding -> Maybe Binder
    insertedName [LamBinding]
    bs =
            (,) (Hd
     -> [NamedArg (MaybeSection (AppInfo, Expr))]
     -> (Hd, [NamedArg (MaybeSection (AppInfo, Expr))]))
    -> Maybe Hd
    -> Maybe
         ([NamedArg (MaybeSection (AppInfo, Expr))]
          -> (Hd, [NamedArg (MaybeSection (AppInfo, Expr))]))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> Maybe Hd
    getHead Expr
    hd Maybe
      ([NamedArg (MaybeSection (AppInfo, Expr))]
       -> (Hd, [NamedArg (MaybeSection (AppInfo, Expr))]))
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Expr))])
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Name]
    -> [Arg (Named_ (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    sectionArgs ((Binder -> Name) -> [Binder] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (BindName -> Name
    unBind (BindName -> Name) -> (Binder -> BindName) -> Binder -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Binder -> BindName
    forall a. Binder' a -> a
    A.binderName) [Binder]
    xs) [Arg (Named_ (AppInfo, Expr))]
    args
          where
            LamView     [LamBinding]
    bs Expr
    body = Expr -> LamView
    A.lamView Expr
    e
            Application Expr
    hd [Arg (Named_ (AppInfo, Expr))]
    args = Expr -> AppView' (AppInfo, Expr)
    A.appView' Expr
    body

            -- Only inserted domain-free visible lambdas come from sections.
            insertedName :: LamBinding -> Maybe Binder
    insertedName (A.DomainFree TacticAttribute
    _ NamedArg Binder
    x)
              | NamedArg Binder -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin NamedArg Binder
    x Origin -> Origin -> Bool
    forall a. Eq a => a -> a -> Bool
    == Origin
    Inserted Bool -> Bool -> Bool
    && NamedArg Binder -> Bool
    forall a. LensHiding a => a -> Bool
    visible NamedArg Binder
    x = Binder -> Maybe Binder
    forall a. a -> Maybe a
    Just (Binder -> Maybe Binder) -> Binder -> Maybe Binder
    forall a b. (a -> b) -> a -> b
    $ NamedArg Binder -> Binder
    forall a. NamedArg a -> a
    namedArg NamedArg Binder
    x
            insertedName LamBinding
    _ = Maybe Binder
    forall a. Maybe a
    Nothing

            -- Build section arguments. Need to check that:
            -- lambda bound variables appear in the right order and only as
            -- top-level arguments.
            sectionArgs :: [A.Name] -> [NamedArg (AppInfo, A.Expr)] -> Maybe [NamedArg (MaybeSection (AppInfo, A.Expr))]
            sectionArgs :: [Name]
    -> [Arg (Named_ (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    sectionArgs [Name]
    xs = [Name]
    -> [Arg (Named_ (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    go [Name]
    xs
              where
                noXs :: Arg (Named_ (AppInfo, Expr)) -> Bool
    noXs = All -> Bool
    getAll (All -> Bool)
    -> (Arg (Named_ (AppInfo, Expr)) -> All)
    -> Arg (Named_ (AppInfo, Expr))
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Expr -> All) -> Expr -> All
    forall m. FoldExprFn m Expr
    forall a m. ExprLike a => FoldExprFn m a
    foldExpr (\ case A.Var Name
    x -> Bool -> All
    All (Name
    x Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Name]
    xs)
                                                 Expr
    _       -> Bool -> All
    All Bool
    True) (Expr -> All)
    -> (Arg (Named_ (AppInfo, Expr)) -> Expr)
    -> Arg (Named_ (AppInfo, Expr))
    -> All
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AppInfo, Expr) -> Expr
    forall a b. (a, b) -> b
    snd ((AppInfo, Expr) -> Expr)
    -> (Arg (Named_ (AppInfo, Expr)) -> (AppInfo, Expr))
    -> Arg (Named_ (AppInfo, Expr))
    -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg (Named_ (AppInfo, Expr)) -> (AppInfo, Expr)
    forall a. NamedArg a -> a
    namedArg
                go :: [Name]
    -> [Arg (Named_ (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    go [] [] = [NamedArg (MaybeSection (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                go (Name
    y : [Name]
    ys) (Arg (Named_ (AppInfo, Expr))
    arg : [Arg (Named_ (AppInfo, Expr))]
    args)
                  | Arg (Named_ (AppInfo, Expr)) -> Bool
    forall a. LensHiding a => a -> Bool
    visible Arg (Named_ (AppInfo, Expr))
    arg
                  , A.Var Name
    y' <- (AppInfo, Expr) -> Expr
    forall a b. (a, b) -> b
    snd ((AppInfo, Expr) -> Expr) -> (AppInfo, Expr) -> Expr
    forall a b. (a -> b) -> a -> b
    $ Arg (Named_ (AppInfo, Expr)) -> (AppInfo, Expr)
    forall a. NamedArg a -> a
    namedArg Arg (Named_ (AppInfo, Expr))
    arg
                  , Name
    y Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    y' = ((Named_ (AppInfo, Expr)
     -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> Arg (Named_ (AppInfo, Expr))
    -> NamedArg (MaybeSection (AppInfo, Expr))
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (MaybeSection (AppInfo, Expr)
    forall a. MaybeSection a
    YesSection MaybeSection (AppInfo, Expr)
    -> Named_ (AppInfo, Expr)
    -> Named NamedName (MaybeSection (AppInfo, Expr))
    forall a b. a -> Named NamedName b -> Named NamedName a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$) Arg (Named_ (AppInfo, Expr))
    arg NamedArg (MaybeSection (AppInfo, Expr))
    -> [NamedArg (MaybeSection (AppInfo, Expr))]
    -> [NamedArg (MaybeSection (AppInfo, Expr))]
    forall a. a -> [a] -> [a]
    :) ([NamedArg (MaybeSection (AppInfo, Expr))]
     -> [NamedArg (MaybeSection (AppInfo, Expr))])
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Name]
    -> [Arg (Named_ (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    go [Name]
    ys [Arg (Named_ (AppInfo, Expr))]
    args
                go [Name]
    ys (Arg (Named_ (AppInfo, Expr))
    arg : [Arg (Named_ (AppInfo, Expr))]
    args)
                  | Arg (Named_ (AppInfo, Expr)) -> Bool
    forall a. LensHiding a => a -> Bool
    visible Arg (Named_ (AppInfo, Expr))
    arg, Arg (Named_ (AppInfo, Expr)) -> Bool
    noXs Arg (Named_ (AppInfo, Expr))
    arg = (((Named_ (AppInfo, Expr)
     -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> Arg (Named_ (AppInfo, Expr))
    -> NamedArg (MaybeSection (AppInfo, Expr))
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named_ (AppInfo, Expr)
      -> Named NamedName (MaybeSection (AppInfo, Expr)))
     -> Arg (Named_ (AppInfo, Expr))
     -> NamedArg (MaybeSection (AppInfo, Expr)))
    -> (((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
        -> Named_ (AppInfo, Expr)
        -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> Arg (Named_ (AppInfo, Expr))
    -> NamedArg (MaybeSection (AppInfo, Expr))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> Named_ (AppInfo, Expr)
    -> Named NamedName (MaybeSection (AppInfo, Expr))
    forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) (AppInfo, Expr) -> MaybeSection (AppInfo, Expr)
    forall a. a -> MaybeSection a
    NoSection Arg (Named_ (AppInfo, Expr))
    arg NamedArg (MaybeSection (AppInfo, Expr))
    -> [NamedArg (MaybeSection (AppInfo, Expr))]
    -> [NamedArg (MaybeSection (AppInfo, Expr))]
    forall a. a -> [a] -> [a]
    :) ([NamedArg (MaybeSection (AppInfo, Expr))]
     -> [NamedArg (MaybeSection (AppInfo, Expr))])
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Name]
    -> [Arg (Named_ (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    go [Name]
    ys [Arg (Named_ (AppInfo, Expr))]
    args
                go [Name]
    _ [Arg (Named_ (AppInfo, Expr))]
    _ = Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    forall a. Maybe a
    Nothing

        view Expr
    e = (, ((Arg (Named_ (AppInfo, Expr))
     -> NamedArg (MaybeSection (AppInfo, Expr)))
    -> [Arg (Named_ (AppInfo, Expr))]
    -> [NamedArg (MaybeSection (AppInfo, Expr))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg (Named_ (AppInfo, Expr))
      -> NamedArg (MaybeSection (AppInfo, Expr)))
     -> [Arg (Named_ (AppInfo, Expr))]
     -> [NamedArg (MaybeSection (AppInfo, Expr))])
    -> (((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
        -> Arg (Named_ (AppInfo, Expr))
        -> NamedArg (MaybeSection (AppInfo, Expr)))
    -> ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> [Arg (Named_ (AppInfo, Expr))]
    -> [NamedArg (MaybeSection (AppInfo, Expr))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Named_ (AppInfo, Expr)
     -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> Arg (Named_ (AppInfo, Expr))
    -> NamedArg (MaybeSection (AppInfo, Expr))
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named_ (AppInfo, Expr)
      -> Named NamedName (MaybeSection (AppInfo, Expr)))
     -> Arg (Named_ (AppInfo, Expr))
     -> NamedArg (MaybeSection (AppInfo, Expr)))
    -> (((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
        -> Named_ (AppInfo, Expr)
        -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> Arg (Named_ (AppInfo, Expr))
    -> NamedArg (MaybeSection (AppInfo, Expr))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> Named_ (AppInfo, Expr)
    -> Named NamedName (MaybeSection (AppInfo, Expr))
    forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) (AppInfo, Expr) -> MaybeSection (AppInfo, Expr)
    forall a. a -> MaybeSection a
    NoSection [Arg (Named_ (AppInfo, Expr))]
    args) (Hd -> (Hd, [NamedArg (MaybeSection (AppInfo, Expr))]))
    -> Maybe Hd
    -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Expr))])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> Maybe Hd
    getHead Expr
    hd
          where Application Expr
    hd [Arg (Named_ (AppInfo, Expr))]
    args = Expr -> AppView' (AppInfo, Expr)
    A.appView' Expr
    e

    tryToRecoverOpAppP :: MonadToConcrete m => A.Pattern -> m (Maybe C.Pattern)
    tryToRecoverOpAppP :: forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m (Maybe Pattern)
    tryToRecoverOpAppP Pattern
    p = do
      res <- ((PrecedenceStack -> Bool) -> m Pattern -> m Pattern)
    -> (Pattern -> Bool)
    -> (NameKind
        -> Range
        -> QName
        -> Name
        -> List1 (MaybeSection Pattern)
        -> Pattern)
    -> (Pattern
        -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))]))
    -> Pattern
    -> m (Maybe Pattern)
    forall a c (m :: * -> *).
    (ToConcrete a, c ~ ConOfAbs a, HasRange c, MonadToConcrete m) =>
    ((PrecedenceStack -> Bool) -> m c -> m c)
    -> (a -> Bool)
    -> (NameKind
        -> Range -> QName -> Name -> List1 (MaybeSection c) -> c)
    -> (a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))]))
    -> a
    -> m (Maybe c)
    recoverOpApp (PrecedenceStack -> Bool) -> m Pattern -> m Pattern
    forall (m :: * -> *).
    MonadToConcrete m =>
    (PrecedenceStack -> Bool) -> m Pattern -> m Pattern
    bracketP_ (Bool -> Pattern -> Bool
    forall a b. a -> b -> a
    const Bool
    False) ((Range -> QName -> Name -> List1 (MaybeSection Pattern) -> Pattern)
    -> NameKind
    -> Range
    -> QName
    -> Name
    -> List1 (MaybeSection Pattern)
    -> Pattern
    forall a b. a -> b -> a
    const Range -> QName -> Name -> List1 (MaybeSection Pattern) -> Pattern
    opApp) Pattern -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    view Pattern
    p
      reportS "print.op" 90
        [ "tryToRecoverOpApp"
        , "in:  " ++ show p
        , "out: " ++ show res
        ]
      return res
      where
        opApp :: Range -> QName -> Name -> List1 (MaybeSection Pattern) -> Pattern
    opApp Range
    r QName
    x Name
    n List1 (MaybeSection Pattern)
    ps = Range
    -> QName -> Set1 Name -> List1 (Arg (Named_ Pattern)) -> Pattern
    C.OpAppP Range
    r QName
    x (Name -> Set1 Name
    forall el coll. Singleton el coll => el -> coll
    singleton Name
    n) (List1 (Arg (Named_ Pattern)) -> Pattern)
    -> List1 (Arg (Named_ Pattern)) -> Pattern
    forall a b. (a -> b) -> a -> b
    $
          (MaybeSection Pattern -> Arg (Named_ Pattern))
    -> List1 (MaybeSection Pattern) -> List1 (Arg (Named_ Pattern))
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Pattern -> Arg (Named_ Pattern)
    forall a. a -> NamedArg a
    defaultNamedArg (Pattern -> Arg (Named_ Pattern))
    -> (MaybeSection Pattern -> Pattern)
    -> MaybeSection Pattern
    -> Arg (Named_ Pattern)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pattern -> MaybeSection Pattern -> Pattern
    forall a. a -> MaybeSection a -> a
    fromNoSection Pattern
    forall a. HasCallStack => a
    __IMPOSSIBLE__) (List1 (MaybeSection Pattern) -> List1 (Arg (Named_ Pattern)))
    -> List1 (MaybeSection Pattern) -> List1 (Arg (Named_ Pattern))
    forall a b. (a -> b) -> a -> b
    $
          -- `view` does not generate any `Nothing`s
          List1 (MaybeSection Pattern)
    ps

        appInfo :: AppInfo
    appInfo = AppInfo
    defaultAppInfo_

        view :: A.Pattern -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, A.Pattern))])
        view :: Pattern -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    view = \case
          ConP ConPatInfo
    _        AmbiguousQName
    cs [NamedArg Pattern]
    ps -> (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    forall a. a -> Maybe a
    Just (QName -> Hd
    HdCon (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    cs), ((NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> [NamedArg Pattern]
    -> [NamedArg (MaybeSection (AppInfo, Pattern))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
     -> [NamedArg Pattern]
     -> [NamedArg (MaybeSection (AppInfo, Pattern))])
    -> ((Pattern -> MaybeSection (AppInfo, Pattern))
        -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> (Pattern -> MaybeSection (AppInfo, Pattern))
    -> [NamedArg Pattern]
    -> [NamedArg (MaybeSection (AppInfo, Pattern))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Named NamedName Pattern
     -> Named_ (MaybeSection (AppInfo, Pattern)))
    -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern))
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName Pattern
      -> Named_ (MaybeSection (AppInfo, Pattern)))
     -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> ((Pattern -> MaybeSection (AppInfo, Pattern))
        -> Named NamedName Pattern
        -> Named_ (MaybeSection (AppInfo, Pattern)))
    -> (Pattern -> MaybeSection (AppInfo, Pattern))
    -> NamedArg Pattern
    -> NamedArg (MaybeSection (AppInfo, Pattern))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> MaybeSection (AppInfo, Pattern))
    -> Named NamedName Pattern
    -> Named_ (MaybeSection (AppInfo, Pattern))
    forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) ((AppInfo, Pattern) -> MaybeSection (AppInfo, Pattern)
    forall a. a -> MaybeSection a
    NoSection ((AppInfo, Pattern) -> MaybeSection (AppInfo, Pattern))
    -> (Pattern -> (AppInfo, Pattern))
    -> Pattern
    -> MaybeSection (AppInfo, Pattern)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AppInfo
    appInfo,)) [NamedArg Pattern]
    ps)
          DefP PatInfo
    _        AmbiguousQName
    fs [NamedArg Pattern]
    ps -> (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    forall a. a -> Maybe a
    Just (QName -> Hd
    HdDef (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    fs), ((NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> [NamedArg Pattern]
    -> [NamedArg (MaybeSection (AppInfo, Pattern))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
     -> [NamedArg Pattern]
     -> [NamedArg (MaybeSection (AppInfo, Pattern))])
    -> ((Pattern -> MaybeSection (AppInfo, Pattern))
        -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> (Pattern -> MaybeSection (AppInfo, Pattern))
    -> [NamedArg Pattern]
    -> [NamedArg (MaybeSection (AppInfo, Pattern))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Named NamedName Pattern
     -> Named_ (MaybeSection (AppInfo, Pattern)))
    -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern))
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName Pattern
      -> Named_ (MaybeSection (AppInfo, Pattern)))
     -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> ((Pattern -> MaybeSection (AppInfo, Pattern))
        -> Named NamedName Pattern
        -> Named_ (MaybeSection (AppInfo, Pattern)))
    -> (Pattern -> MaybeSection (AppInfo, Pattern))
    -> NamedArg Pattern
    -> NamedArg (MaybeSection (AppInfo, Pattern))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> MaybeSection (AppInfo, Pattern))
    -> Named NamedName Pattern
    -> Named_ (MaybeSection (AppInfo, Pattern))
    forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) ((AppInfo, Pattern) -> MaybeSection (AppInfo, Pattern)
    forall a. a -> MaybeSection a
    NoSection ((AppInfo, Pattern) -> MaybeSection (AppInfo, Pattern))
    -> (Pattern -> (AppInfo, Pattern))
    -> Pattern
    -> MaybeSection (AppInfo, Pattern)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AppInfo
    appInfo,)) [NamedArg Pattern]
    ps)
          PatternSynP PatInfo
    _ AmbiguousQName
    ns [NamedArg Pattern]
    ps -> (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    forall a. a -> Maybe a
    Just (QName -> Hd
    HdSyn (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    ns), ((NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> [NamedArg Pattern]
    -> [NamedArg (MaybeSection (AppInfo, Pattern))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
     -> [NamedArg Pattern]
     -> [NamedArg (MaybeSection (AppInfo, Pattern))])
    -> ((Pattern -> MaybeSection (AppInfo, Pattern))
        -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> (Pattern -> MaybeSection (AppInfo, Pattern))
    -> [NamedArg Pattern]
    -> [NamedArg (MaybeSection (AppInfo, Pattern))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Named NamedName Pattern
     -> Named_ (MaybeSection (AppInfo, Pattern)))
    -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern))
    forall a b. (a -> b) -> Arg a -> Arg b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName Pattern
      -> Named_ (MaybeSection (AppInfo, Pattern)))
     -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> ((Pattern -> MaybeSection (AppInfo, Pattern))
        -> Named NamedName Pattern
        -> Named_ (MaybeSection (AppInfo, Pattern)))
    -> (Pattern -> MaybeSection (AppInfo, Pattern))
    -> NamedArg Pattern
    -> NamedArg (MaybeSection (AppInfo, Pattern))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> MaybeSection (AppInfo, Pattern))
    -> Named NamedName Pattern
    -> Named_ (MaybeSection (AppInfo, Pattern))
    forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) ((AppInfo, Pattern) -> MaybeSection (AppInfo, Pattern)
    forall a. a -> MaybeSection a
    NoSection ((AppInfo, Pattern) -> MaybeSection (AppInfo, Pattern))
    -> (Pattern -> (AppInfo, Pattern))
    -> Pattern
    -> MaybeSection (AppInfo, Pattern)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AppInfo
    appInfo,)) [NamedArg Pattern]
    ps)
          Pattern
    _                   -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    forall a. Maybe a
    Nothing
          -- ProjP _ _ d   -> Just (HdDef (headAmbQ d), [])   -- ? Andreas, 2016-04-21

    recoverOpApp :: forall a c m. (ToConcrete a, c ~ ConOfAbs a, HasRange c, MonadToConcrete m)
      => ((PrecedenceStack -> Bool) -> m c -> m c)
      -> (a -> Bool)  -- ^ Check for lambdas
      -> (Asp.NameKind -> Range -> C.QName -> A.Name -> List1 (MaybeSection c) -> c)  -- ^ @opApp@
      -> (a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))]))
      -> a
      -> m (Maybe c)
    recoverOpApp :: forall a c (m :: * -> *).
    (ToConcrete a, c ~ ConOfAbs a, HasRange c, MonadToConcrete m) =>
    ((PrecedenceStack -> Bool) -> m c -> m c)
    -> (a -> Bool)
    -> (NameKind
        -> Range -> QName -> Name -> List1 (MaybeSection c) -> c)
    -> (a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))]))
    -> a
    -> m (Maybe c)
    recoverOpApp (PrecedenceStack -> Bool) -> m c -> m c
    bracket a -> Bool
    isLam NameKind -> Range -> QName -> Name -> List1 (MaybeSection c) -> c
    opApp a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))])
    view a
    e = case a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))])
    view a
    e of
      Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))])
    Nothing -> m (Maybe c)
    forall {a}. m (Maybe a)
    mDefault
      Just (Hd
    hd, [NamedArg (MaybeSection (AppInfo, a))]
    args)
        | (NamedArg (MaybeSection (AppInfo, a)) -> Bool)
    -> [NamedArg (MaybeSection (AppInfo, a))] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all NamedArg (MaybeSection (AppInfo, a)) -> Bool
    forall a. LensHiding a => a -> Bool
    visible [NamedArg (MaybeSection (AppInfo, a))]
    args    -> do
          let  args' :: [MaybeSection (AppInfo, a)]
    args' = (NamedArg (MaybeSection (AppInfo, a)) -> MaybeSection (AppInfo, a))
    -> [NamedArg (MaybeSection (AppInfo, a))]
    -> [MaybeSection (AppInfo, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedArg (MaybeSection (AppInfo, a)) -> MaybeSection (AppInfo, a)
    forall a. NamedArg a -> a
    namedArg [NamedArg (MaybeSection (AppInfo, a))]
    args
          case Hd
    hd of
            HdVar  Name
    n
              | Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    n    -> m (Maybe c)
    forall {a}. m (Maybe a)
    mDefault
              | Bool
    otherwise     -> Either Name QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
    MonadToConcrete m =>
    Either Name QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
    doQNameHelper (Name -> Either Name QName
    forall a b. a -> Either a b
    Left Name
    n) [MaybeSection (AppInfo, a)]
    args'
            HdDef QName
    qn
              | QName -> Bool
    isExtendedLambdaName QName
    qn
                              -> m (Maybe c)
    forall {a}. m (Maybe a)
    mDefault
              | Bool
    otherwise     -> Either Name QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
    MonadToConcrete m =>
    Either Name QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
    doQNameHelper (QName -> Either Name QName
    forall a b. b -> Either a b
    Right QName
    qn) [MaybeSection (AppInfo, a)]
    args'
            -- HdDef qn          -> doQNameHelper (Right qn) args'
            HdCon QName
    qn          -> Either Name QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
    MonadToConcrete m =>
    Either Name QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
    doQNameHelper (QName -> Either Name QName
    forall a b. b -> Either a b
    Right QName
    qn) [MaybeSection (AppInfo, a)]
    args'
            HdSyn QName
    qn          -> Either Name QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
    MonadToConcrete m =>
    Either Name QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
    doQNameHelper (QName -> Either Name QName
    forall a b. b -> Either a b
    Right QName
    qn) [MaybeSection (AppInfo, a)]
    args'
        | Bool
    otherwise           -> m (Maybe c)
    forall {a}. m (Maybe a)
    mDefault
      where
      mDefault :: m (Maybe a)
    mDefault = Maybe a -> m (Maybe a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing

      skipParens :: MaybeSection (AppInfo, a) -> Bool
      skipParens :: MaybeSection (AppInfo, a) -> Bool
    skipParens = \case
         MaybeSection (AppInfo, a)
    YesSection       -> Bool
    False
         NoSection (AppInfo
    i, a
    e) -> a -> Bool
    isLam a
    e Bool -> Bool -> Bool
    && ParenPreference -> Bool
    preferParenless (AppInfo -> ParenPreference
    appParens AppInfo
    i)

      doQNameHelper :: MonadToConcrete m => Either A.Name A.QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
      doQNameHelper :: MonadToConcrete m =>
    Either Name QName -> [MaybeSection (AppInfo, a)] -> m (Maybe c)
    doQNameHelper Either Name QName
    n [MaybeSection (AppInfo, a)]
    args = do
        x <- (Name -> m QName)
    -> (QName -> m QName) -> Either Name QName -> m QName
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Name -> QName
    C.QName (Name -> QName) -> (Name -> m Name) -> Name -> m QName
    forall (m :: * -> *) b c a.
    Functor m =>
    (b -> c) -> (a -> m b) -> a -> m c
    <.> Name -> m Name
    Name -> m (ConOfAbs Name)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    Name -> m (ConOfAbs Name)
    toConcrete) QName -> m QName
    QName -> m (ConOfAbs QName)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *).
    MonadToConcrete m =>
    QName -> m (ConOfAbs QName)
    toConcrete Either Name QName
    n
        let n' = (Name -> Name) -> (QName -> Name) -> Either Name QName -> Name
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Name -> Name
    forall a. a -> a
    id QName -> Name
    A.qnameName Either Name QName
    n
        -- #1346: The fixity of the abstract name is not necessarily correct, it depends on which
        -- concrete name we choose! Make sure to resolve ambiguities with n'.
        (fx, nk) <- resolveName_ x n' <&> \ case
          VarName Name
    y BindingSource
    _                -> (Name
    y Name -> Lens' Name Fixity -> Fixity
    forall o i. o -> Lens' o i -> i
    ^. (Fixity -> f Fixity) -> Name -> f Name
    forall a. LensFixity a => Lens' a Fixity
    Lens' Name Fixity
    lensFixity, NameKind
    Asp.Bound)
          DefinedName Access
    _ AbstractName
    q Suffix
    _          -> (AbstractName
    q AbstractName -> Lens' AbstractName Fixity -> Fixity
    forall o i. o -> Lens' o i -> i
    ^. (Fixity -> f Fixity) -> AbstractName -> f AbstractName
    forall a. LensFixity a => Lens' a Fixity
    Lens' AbstractName Fixity
    lensFixity, NameKind
    Asp.Function)
          FieldName (AbstractName
    q :| [AbstractName]
    _)         -> (AbstractName
    q AbstractName -> Lens' AbstractName Fixity -> Fixity
    forall o i. o -> Lens' o i -> i
    ^. (Fixity -> f Fixity) -> AbstractName -> f AbstractName
    forall a. LensFixity a => Lens' a Fixity
    Lens' AbstractName Fixity
    lensFixity, NameKind
    Asp.Field)
          ConstructorName Set1 Induction
    _ (AbstractName
    q :| [AbstractName]
    _) -> (AbstractName
    q AbstractName -> Lens' AbstractName Fixity -> Fixity
    forall o i. o -> Lens' o i -> i
    ^. (Fixity -> f Fixity) -> AbstractName -> f AbstractName
    forall a. LensFixity a => Lens' a Fixity
    Lens' AbstractName Fixity
    lensFixity, Induction -> NameKind
    Asp.Constructor Induction
    Asp.Inductive)
          PatternSynResName (AbstractName
    q :| [AbstractName]
    _) -> (AbstractName
    q AbstractName -> Lens' AbstractName Fixity -> Fixity
    forall o i. o -> Lens' o i -> i
    ^. (Fixity -> f Fixity) -> AbstractName -> f AbstractName
    forall a. LensFixity a => Lens' a Fixity
    Lens' AbstractName Fixity
    lensFixity, Induction -> NameKind
    Asp.Constructor Induction
    Asp.Inductive)
          ResolvedName
    UnknownName                -> (Fixity
    noFixity, NameKind
    Asp.Bound)
        List1.ifNull args {-then-} mDefault {-else-} $ \ List1 (MaybeSection (AppInfo, a))
    as ->
          MonadToConcrete m =>
    NameKind
    -> Fixity
    -> QName
    -> Name
    -> List1 (MaybeSection (AppInfo, a))
    -> NameParts
    -> m (Maybe c)
    NameKind
    -> Fixity
    -> QName
    -> Name
    -> List1 (MaybeSection (AppInfo, a))
    -> NameParts
    -> m (Maybe c)
    doQName NameKind
    nk Fixity
    fx QName
    x Name
    n' List1 (MaybeSection (AppInfo, a))
    as (Name -> NameParts
    C.nameParts (Name -> NameParts) -> Name -> NameParts
    forall a b. (a -> b) -> a -> b
    $ QName -> Name
    C.unqualify QName
    x)

      doQName :: MonadToConcrete m => Asp.NameKind -> Fixity -> C.QName -> A.Name -> List1 (MaybeSection (AppInfo, a)) -> NameParts -> m (Maybe c)

      -- fall-back (wrong number of arguments or no holes)
      doQName :: MonadToConcrete m =>
    NameKind
    -> Fixity
    -> QName
    -> Name
    -> List1 (MaybeSection (AppInfo, a))
    -> NameParts
    -> m (Maybe c)
    doQName NameKind
    nk Fixity
    _ QName
    x Name
    _ List1 (MaybeSection (AppInfo, a))
    as NameParts
    xs
        | List1 (MaybeSection (AppInfo, a)) -> VerboseLevel
    forall a. NonEmpty a -> VerboseLevel
    forall (t :: * -> *) a. Foldable t => t a -> VerboseLevel
    length List1 (MaybeSection (AppInfo, a))
    as VerboseLevel -> VerboseLevel -> Bool
    forall a. Eq a => a -> a -> Bool
    /= QName -> VerboseLevel
    forall a. NumHoles a => a -> VerboseLevel
    numHoles QName
    x = m (Maybe c)
    forall {a}. m (Maybe a)
    mDefault

      -- binary case
      doQName NameKind
    nk Fixity
    fixity QName
    x Name
    n (MaybeSection (AppInfo, a)
    a1 :| [MaybeSection (AppInfo, a)]
    as) NameParts
    xs
        | NamePart
    Hole <- NameParts -> NamePart
    forall a. NonEmpty a -> a
    List1.head NameParts
    xs
        , NamePart
    Hole <- NameParts -> NamePart
    forall a. NonEmpty a -> a
    List1.last NameParts
    xs = do
            let ([MaybeSection (AppInfo, a)]
    as', MaybeSection (AppInfo, a)
    an) = [MaybeSection (AppInfo, a)]
    -> ([MaybeSection (AppInfo, a)], MaybeSection (AppInfo, a))
    -> (List1 (MaybeSection (AppInfo, a))
        -> ([MaybeSection (AppInfo, a)], MaybeSection (AppInfo, a)))
    -> ([MaybeSection (AppInfo, a)], MaybeSection (AppInfo, a))
    forall a b. [a] -> b -> (List1 a -> b) -> b
    List1.ifNull [MaybeSection (AppInfo, a)]
    as {-then-} ([MaybeSection (AppInfo, a)], MaybeSection (AppInfo, a))
    forall a. HasCallStack => a
    __IMPOSSIBLE__ {-else-} List1 (MaybeSection (AppInfo, a))
    -> ([MaybeSection (AppInfo, a)], MaybeSection (AppInfo, a))
    forall a. List1 a -> ([a], a)
    List1.initLast
            c -> Maybe c
    forall a. a -> Maybe a
    Just (c -> Maybe c) -> m c -> m (Maybe c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
              (PrecedenceStack -> Bool) -> m c -> m c
    bracket (Bool -> Fixity -> PrecedenceStack -> Bool
    opBrackets' (MaybeSection (AppInfo, a) -> Bool
    skipParens MaybeSection (AppInfo, a)
    an) Fixity
    fixity) (m c -> m c) -> m c -> m c
    forall a b. (a -> b) -> a -> b
    $ do
                e1 <- ((AppInfo, a) -> m c)
    -> MaybeSection (AppInfo, a) -> m (MaybeSection c)
    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) -> MaybeSection a -> f (MaybeSection b)
    traverse (Precedence -> a -> m (ConOfAbs a)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx (Fixity -> Precedence
    LeftOperandCtx Fixity
    fixity) (a -> m c) -> ((AppInfo, a) -> a) -> (AppInfo, a) -> m c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AppInfo, a) -> a
    forall a b. (a, b) -> b
    snd) MaybeSection (AppInfo, a)
    a1
                es <- (mapM . traverse) (toConcreteCtx InsideOperandCtx . snd) as'
                en <- traverse (uncurry $ toConcreteCtx . RightOperandCtx fixity . appParens) an
                return $ opApp nk (getRange (e1, en)) x n (e1 :| es ++ [en])

      -- prefix
      doQName NameKind
    nk Fixity
    fixity QName
    x Name
    n List1 (MaybeSection (AppInfo, a))
    as NameParts
    xs
        | NamePart
    Hole <- NameParts -> NamePart
    forall a. NonEmpty a -> a
    List1.last NameParts
    xs = do
            let ([MaybeSection (AppInfo, a)]
    as', MaybeSection (AppInfo, a)
    an) = List1 (MaybeSection (AppInfo, a))
    -> ([MaybeSection (AppInfo, a)], MaybeSection (AppInfo, a))
    forall a. List1 a -> ([a], a)
    List1.initLast List1 (MaybeSection (AppInfo, a))
    as
            c -> Maybe c
    forall a. a -> Maybe a
    Just (c -> Maybe c) -> m c -> m (Maybe c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
              (PrecedenceStack -> Bool) -> m c -> m c
    bracket (Bool -> Fixity -> PrecedenceStack -> Bool
    opBrackets' (MaybeSection (AppInfo, a) -> Bool
    skipParens MaybeSection (AppInfo, a)
    an) Fixity
    fixity) (m c -> m c) -> m c -> m c
    forall a b. (a -> b) -> a -> b
    $ do
                es <- ((MaybeSection (AppInfo, a) -> m (MaybeSection c))
    -> [MaybeSection (AppInfo, a)] -> m [MaybeSection c]
    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 ((MaybeSection (AppInfo, a) -> m (MaybeSection c))
     -> [MaybeSection (AppInfo, a)] -> m [MaybeSection c])
    -> (((AppInfo, a) -> m c)
        -> MaybeSection (AppInfo, a) -> m (MaybeSection c))
    -> ((AppInfo, a) -> m c)
    -> [MaybeSection (AppInfo, a)]
    -> m [MaybeSection c]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, a) -> m c)
    -> MaybeSection (AppInfo, a) -> m (MaybeSection c)
    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) -> MaybeSection a -> f (MaybeSection b)
    traverse) (Precedence -> a -> m (ConOfAbs a)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    InsideOperandCtx (a -> m c) -> ((AppInfo, a) -> a) -> (AppInfo, a) -> m c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AppInfo, a) -> a
    forall a b. (a, b) -> b
    snd) [MaybeSection (AppInfo, a)]
    as'
                en <- traverse (\ (AppInfo
    i, a
    e) -> Precedence -> a -> m (ConOfAbs a)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx (Fixity -> ParenPreference -> Precedence
    RightOperandCtx Fixity
    fixity (ParenPreference -> Precedence) -> ParenPreference -> Precedence
    forall a b. (a -> b) -> a -> b
    $ AppInfo -> ParenPreference
    appParens AppInfo
    i) a
    e) an
                return $ opApp nk (getRange (n, en)) x n (List1.snoc es en)

      -- postfix
      doQName NameKind
    nk Fixity
    fixity QName
    x Name
    n List1 (MaybeSection (AppInfo, a))
    as NameParts
    xs
        | NamePart
    Hole <- NameParts -> NamePart
    forall a. NonEmpty a -> a
    List1.head NameParts
    xs = do
            let a1 :: MaybeSection (AppInfo, a)
    a1  = List1 (MaybeSection (AppInfo, a)) -> MaybeSection (AppInfo, a)
    forall a. NonEmpty a -> a
    List1.head List1 (MaybeSection (AppInfo, a))
    as
                as' :: [MaybeSection (AppInfo, a)]
    as' = List1 (MaybeSection (AppInfo, a)) -> [MaybeSection (AppInfo, a)]
    forall a. NonEmpty a -> [a]
    List1.tail List1 (MaybeSection (AppInfo, a))
    as
            e1 <- ((AppInfo, a) -> m c)
    -> MaybeSection (AppInfo, a) -> m (MaybeSection c)
    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) -> MaybeSection a -> f (MaybeSection b)
    traverse (Precedence -> a -> m (ConOfAbs a)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx (Fixity -> Precedence
    LeftOperandCtx Fixity
    fixity) (a -> m c) -> ((AppInfo, a) -> a) -> (AppInfo, a) -> m c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AppInfo, a) -> a
    forall a b. (a, b) -> b
    snd) MaybeSection (AppInfo, a)
    a1
            es <- (mapM . traverse) (toConcreteCtx InsideOperandCtx . snd) as'
            Just <$> do
              bracket (opBrackets fixity) $
                return $ opApp nk (getRange (e1, n)) x n (e1 :| es)

      -- roundfix
      doQName NameKind
    nk Fixity
    _ QName
    x Name
    n List1 (MaybeSection (AppInfo, a))
    as NameParts
    _ = do
        es <- ((MaybeSection (AppInfo, a) -> m (MaybeSection c))
    -> List1 (MaybeSection (AppInfo, a)) -> m (List1 (MaybeSection c))
    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) -> NonEmpty a -> m (NonEmpty b)
    mapM ((MaybeSection (AppInfo, a) -> m (MaybeSection c))
     -> List1 (MaybeSection (AppInfo, a)) -> m (List1 (MaybeSection c)))
    -> (((AppInfo, a) -> m c)
        -> MaybeSection (AppInfo, a) -> m (MaybeSection c))
    -> ((AppInfo, a) -> m c)
    -> List1 (MaybeSection (AppInfo, a))
    -> m (List1 (MaybeSection c))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, a) -> m c)
    -> MaybeSection (AppInfo, a) -> m (MaybeSection c)
    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) -> MaybeSection a -> f (MaybeSection b)
    traverse) (Precedence -> a -> m (ConOfAbs a)
    forall (m :: * -> *) a.
    (MonadToConcrete m, ToConcrete a) =>
    Precedence -> a -> m (ConOfAbs a)
    toConcreteCtx Precedence
    InsideOperandCtx (a -> m c) -> ((AppInfo, a) -> a) -> (AppInfo, a) -> m c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AppInfo, a) -> a
    forall a b. (a, b) -> b
    snd) List1 (MaybeSection (AppInfo, a))
    as
        Just <$> do
          bracket roundFixBrackets $
            return $ opApp nk (getRange x) x n es

    -- Recovering pattern synonyms --------------------------------------------

    -- | Recover pattern synonyms for expressions.
    tryToRecoverPatternSyn :: MonadToConcrete m => A.Expr -> m C.Expr -> m C.Expr
    tryToRecoverPatternSyn :: forall (m :: * -> *). MonadToConcrete m => Expr -> m Expr -> m Expr
    tryToRecoverPatternSyn Expr
    e m Expr
    fallback
      | Expr -> Bool
    userWritten Expr
    e = m Expr
    fallback
      | Expr -> Bool
    litOrCon Expr
    e    = (QName -> [NamedArg Expr] -> Expr)
    -> (PatternSynDefn -> Expr -> Maybe [WithHiding Expr])
    -> Expr
    -> m (ConOfAbs Expr)
    -> m (ConOfAbs Expr)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    (QName -> [NamedArg a] -> a)
    -> (PatternSynDefn -> a -> Maybe [WithHiding a])
    -> a
    -> m (ConOfAbs a)
    -> m (ConOfAbs a)
    recoverPatternSyn QName -> [NamedArg Expr] -> Expr
    apply PatternSynDefn -> Expr -> Maybe [WithHiding Expr]
    matchPatternSyn Expr
    e m Expr
    m (ConOfAbs Expr)
    fallback
      | Bool
    otherwise     = m Expr
    fallback
      where
        userWritten :: Expr -> Bool
    userWritten (A.App AppInfo
    info Expr
    _ NamedArg Expr
    _) = AppInfo -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin AppInfo
    info Origin -> Origin -> Bool
    forall a. Eq a => a -> a -> Bool
    == Origin
    UserWritten
        userWritten Expr
    _                = Bool
    False  -- this means we always use pattern synonyms for nullary constructors

        -- Only literals or constructors can head pattern synonym definitions
        litOrCon :: Expr -> Bool
    litOrCon Expr
    e =
          case Expr -> AppView
    A.appView Expr
    e of
            Application Con{}   [NamedArg Expr]
    _ -> Bool
    True
            Application A.Lit{} [NamedArg Expr]
    _ -> Bool
    True
            AppView
    _                     -> Bool
    False

        apply :: QName -> [NamedArg Expr] -> Expr
    apply QName
    c [NamedArg Expr]
    args = AppView -> Expr
    A.unAppView (AppView -> Expr) -> AppView -> Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> [NamedArg Expr] -> AppView
    forall arg. Expr -> [NamedArg arg] -> AppView' arg
    Application (AmbiguousQName -> Expr
    A.PatternSyn (AmbiguousQName -> Expr) -> AmbiguousQName -> Expr
    forall a b. (a -> b) -> a -> b
    $ QName -> AmbiguousQName
    unambiguous QName
    c) [NamedArg Expr]
    args

    -- | Recover pattern synonyms in patterns.
    tryToRecoverPatternSynP :: MonadToConcrete m => A.Pattern -> m C.Pattern -> m C.Pattern
    tryToRecoverPatternSynP :: forall (m :: * -> *).
    MonadToConcrete m =>
    Pattern -> m Pattern -> m Pattern
    tryToRecoverPatternSynP = (QName -> [NamedArg Pattern] -> Pattern)
    -> (PatternSynDefn -> Pattern -> Maybe [WithHiding Pattern])
    -> Pattern
    -> m (ConOfAbs Pattern)
    -> m (ConOfAbs Pattern)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    (QName -> [NamedArg a] -> a)
    -> (PatternSynDefn -> a -> Maybe [WithHiding a])
    -> a
    -> m (ConOfAbs a)
    -> m (ConOfAbs a)
    recoverPatternSyn QName -> [NamedArg Pattern] -> Pattern
    forall {e}. QName -> NAPs e -> Pattern' e
    apply PatternSynDefn -> Pattern -> Maybe [WithHiding Pattern]
    forall e.
    PatternSynDefn -> Pattern' e -> Maybe [WithHiding (Pattern' e)]
    matchPatternSynP
      where apply :: QName -> NAPs e -> Pattern' e
    apply QName
    c NAPs e
    args = PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    PatternSynP PatInfo
    patNoRange (QName -> AmbiguousQName
    unambiguous QName
    c) NAPs e
    args

    -- | General pattern synonym recovery parameterised over expression type.
    recoverPatternSyn :: forall a m. (ToConcrete a, MonadToConcrete m)
      => (A.QName -> [NamedArg a] -> a)                 -- applySyn
      -> (PatternSynDefn -> a -> Maybe [WithHiding a])  -- match
      -> a                                              -- expressions
      -> m (ConOfAbs a)                       -- fallback
      -> m (ConOfAbs a)
    recoverPatternSyn :: forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    (QName -> [NamedArg a] -> a)
    -> (PatternSynDefn -> a -> Maybe [WithHiding a])
    -> a
    -> m (ConOfAbs a)
    -> m (ConOfAbs a)
    recoverPatternSyn QName -> [NamedArg a] -> a
    applySyn PatternSynDefn -> a -> Maybe [WithHiding a]
    match a
    e m (ConOfAbs a)
    fallback = do
      doFold <- (Env -> Bool) -> m Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> Bool
    foldPatternSynonyms
      if not doFold then fallback else do
        psyns  <- getAllPatternSyns
        scope  <- getScope
        reportSLn "toConcrete.patsyn" 100 $ render $ hsep $
          [ "Scope when attempting to recover pattern synonyms:"
          , pretty scope
          ]
        let isConP ConP{} = Bool
    True    -- #2828: only fold pattern synonyms with
            isConP Pattern' e
    _      = Bool
    False   --        constructor rhs
            cands = [ (QName
    q, [WithHiding a]
    args, Pattern' Void -> VerboseLevel
    score Pattern' Void
    rhs)
                    | (QName
    q, psyndef :: PatternSynDefn
    psyndef@([WithHiding Name]
    _, Pattern' Void
    rhs)) <- [(QName, PatternSynDefn)] -> [(QName, PatternSynDefn)]
    forall a. [a] -> [a]
    reverse ([(QName, PatternSynDefn)] -> [(QName, PatternSynDefn)])
    -> [(QName, PatternSynDefn)] -> [(QName, PatternSynDefn)]
    forall a b. (a -> b) -> a -> b
    $ PatternSynDefns -> [(QName, PatternSynDefn)]
    forall k a. Map k a -> [(k, a)]
    Map.toList PatternSynDefns
    psyns
                    , Pattern' Void -> Bool
    forall {e}. Pattern' e -> Bool
    isConP Pattern' Void
    rhs
                    , Just [WithHiding a]
    args <- [PatternSynDefn -> a -> Maybe [WithHiding a]
    match PatternSynDefn
    psyndef a
    e]
                    -- #3879: only fold pattern synonyms with an unqualified concrete name in scope
                    -- Note that we only need to consider the head of the inverse lookup result: they
                    -- are already sorted from shortest to longest!
                    , C.QName{} <- Maybe QName -> [QName]
    forall a. Maybe a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    Fold.toList (Maybe QName -> [QName]) -> Maybe QName -> [QName]
    forall a b. (a -> b) -> a -> b
    $ [QName] -> Maybe QName
    forall a. [a] -> Maybe a
    listToMaybe ([QName] -> Maybe QName) -> [QName] -> Maybe QName
    forall a b. (a -> b) -> a -> b
    $ QName -> ScopeInfo -> [QName]
    inverseScopeLookupName QName
    q ScopeInfo
    scope
                    ]
            cmp (a
    _, b
    _, a
    x) (a
    _, b
    _, a
    y) = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    y a
    x
        reportSLn "toConcrete.patsyn" 50 $ render $ hsep $
          [ "Found pattern synonym candidates:"
          , prettyList_ $ map (\ (QName
    q,[WithHiding a]
    _,VerboseLevel
    _) -> QName
    q) cands
          ]
        case sortBy cmp cands of
          (QName
    q, [WithHiding a]
    args, VerboseLevel
    _) : [(QName, [WithHiding a], VerboseLevel)]
    _ -> a -> m (ConOfAbs a)
    forall a (m :: * -> *).
    (ToConcrete a, MonadToConcrete m) =>
    a -> m (ConOfAbs a)
    forall (m :: * -> *). MonadToConcrete m => a -> m (ConOfAbs a)
    toConcrete (a -> m (ConOfAbs a)) -> a -> m (ConOfAbs a)
    forall a b. (a -> b) -> a -> b
    $ QName -> [NamedArg a] -> a
    applySyn QName
    q ([NamedArg a] -> a) -> [NamedArg a] -> a
    forall a b. (a -> b) -> a -> b
    $
            [WithHiding a] -> (WithHiding a -> NamedArg a) -> [NamedArg a]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    for [WithHiding a]
    args ((WithHiding a -> NamedArg a) -> [NamedArg a])
    -> (WithHiding a -> NamedArg a) -> [NamedArg a]
    forall a b. (a -> b) -> a -> b
    $ \ (WithHiding Hiding
    h a
    arg) -> Hiding -> NamedArg a -> NamedArg a
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    h (NamedArg a -> NamedArg a) -> NamedArg a -> NamedArg a
    forall a b. (a -> b) -> a -> b
    $ a -> NamedArg a
    forall a. a -> NamedArg a
    defaultNamedArg a
    arg
          [] -> m (ConOfAbs a)
    fallback
      where
        -- Heuristic to pick the best pattern synonym: the one that folds the most
        -- constructors.
        score :: Pattern' Void -> Int
        score :: Pattern' Void -> VerboseLevel
    score = Sum VerboseLevel -> VerboseLevel
    forall a. Sum a -> a
    getSum (Sum VerboseLevel -> VerboseLevel)
    -> (Pattern' Void -> Sum VerboseLevel)
    -> Pattern' Void
    -> VerboseLevel
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern' (ADotT (Pattern' Void)) -> Sum VerboseLevel)
    -> Pattern' Void -> Sum VerboseLevel
    forall p m.
    (APatternLike p, Monoid m) =>
    (Pattern' (ADotT p) -> m) -> p -> m
    foldAPattern Pattern' Void -> Sum VerboseLevel
    Pattern' (ADotT (Pattern' Void)) -> Sum VerboseLevel
    forall {a} {e}. Num a => Pattern' e -> a
    con
          where con :: Pattern' e -> a
    con ConP{} = a
    1
                con Pattern' e
    _      = a
    0

    -- Some instances that are related to interaction with users -----------

    instance ToConcrete InteractionId where
        type ConOfAbs InteractionId = C.Expr
        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    InteractionId -> m (ConOfAbs InteractionId)
    toConcrete (InteractionId VerboseLevel
    i) = Expr -> m Expr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> m Expr) -> Expr -> m Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Maybe VerboseLevel -> Expr
    C.QuestionMark Range
    forall a. Range' a
    noRange (VerboseLevel -> Maybe VerboseLevel
    forall a. a -> Maybe a
    Just VerboseLevel
    i)

    instance ToConcrete NamedMeta where
        type ConOfAbs NamedMeta = C.Expr
        toConcrete :: forall (m :: * -> *).
    MonadToConcrete m =>
    NamedMeta -> m (ConOfAbs NamedMeta)
    toConcrete NamedMeta
    i =
          Range -> Maybe ArgName -> Expr
    C.Underscore Range
    forall a. Range' a
    noRange (Maybe ArgName -> Expr) -> (Doc -> Maybe ArgName) -> Doc -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ArgName -> Maybe ArgName
    forall a. a -> Maybe a
    Just (ArgName -> Maybe ArgName)
    -> (Doc -> ArgName) -> Doc -> Maybe ArgName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> ArgName
    forall a. Doc a -> ArgName
    render (Doc -> Expr) -> m Doc -> m Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamedMeta -> m Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    forall (m :: * -> *). MonadPretty m => NamedMeta -> m Doc
    prettyTCM NamedMeta
    i