    {-# LANGUAGE CPP          #-}

    -- {-# 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
        , abstractToConcrete_
        , abstractToConcreteScope
        , abstractToConcreteHiding
        , runAbsToCon
        , RangeAndPragma(..)
        , abstractToConcreteCtx
        , withScope
        , preserveInteractionIds
        , MonadAbsToCon, AbsToCon, Env
        , noTakenNames
        , lookupQName
        ) where

    import Prelude hiding (null)

    import Control.Arrow        ( (&&&), first )
    import Control.Monad        ( (<=<), forM, forM_, guard, liftM2 )
    import Control.Monad.Except ( runExceptT )
    import Control.Monad.Reader ( MonadReader(..), asks, runReaderT )
    import Control.Monad.State  ( StateT(..), runStateT )

    import qualified Control.Monad.Fail as Fail

    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.List.NonEmpty (NonEmpty(..))
    import qualified Data.List.NonEmpty as NonEmpty

    import Agda.Syntax.Common
    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
    import Agda.TypeChecking.Monad.Debug
    import Agda.TypeChecking.Monad.Builtin
    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.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 Agda.Utils.Pretty
    import Agda.Utils.Singleton
    import Agda.Utils.Suffix

    import Agda.Utils.Impossible

    -- 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 Name
    takenDefNames :: Set C.Name
                      -- ^ Concrete names of all definitions in scope
                   , Env -> ScopeInfo
    currentScope :: ScopeInfo
                   , Env -> Map RawName QName
    builtins     :: Map String A.QName
                      -- ^ Certain builtins (like `fromNat`) have special printing
                   , Env -> Bool
    preserveIIds :: Bool
                      -- ^ Preserve interaction point ids
                   , Env -> Bool
    foldPatternSynonyms :: Bool
                   }

    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 :: RawName -> Bool
    noScopeCheck RawName
    b = RawName
    b RawName -> [RawName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [RawName
    builtinZero, RawName
    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 :: RawName -> m [(RawName, QName)]
    builtin RawName
    b = RawName -> m (Maybe Term)
    forall (m :: * -> *). HasBuiltins m => RawName -> m (Maybe Term)
    getBuiltin' RawName
    b m (Maybe Term)
    -> (Maybe Term -> m [(RawName, QName)]) -> m [(RawName, QName)]
    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,
                     RawName -> Bool
    noScopeCheck RawName
    b Bool -> Bool -> Bool
    || QName -> ScopeInfo -> Bool
    isNameInScope QName
    q ScopeInfo
    scope -> [(RawName, QName)] -> m [(RawName, QName)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(RawName
    b, QName
    q)]
            Maybe Term
    _                                                -> [(RawName, QName)] -> m [(RawName, QName)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      [Name]
    ctxVars <- (Dom' Term (Name, Type) -> Name)
    -> [Dom' Term (Name, Type)] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Name, Type) -> Name
    forall a b. (a, b) -> a
    fst ((Name, Type) -> Name)
    -> (Dom' Term (Name, Type) -> (Name, Type))
    -> Dom' Term (Name, Type)
    -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dom' Term (Name, Type) -> (Name, Type)
    forall t e. Dom' t e -> e
    I.unDom) ([Dom' Term (Name, Type)] -> [Name])
    -> m [Dom' Term (Name, Type)] -> m [Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TCEnv -> [Dom' Term (Name, Type)]) -> m [Dom' Term (Name, Type)]
    forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
    asksTC TCEnv -> [Dom' Term (Name, Type)]
    envContext
      [Name]
    letVars <- Map Name (Open (Term, Dom Type)) -> [Name]
    forall k a. Map k a -> [k]
    Map.keys (Map Name (Open (Term, Dom Type)) -> [Name])
    -> m (Map Name (Open (Term, Dom Type))) -> m [Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TCEnv -> Map Name (Open (Term, Dom Type)))
    -> m (Map Name (Open (Term, Dom Type)))
    forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
    asksTC TCEnv -> Map Name (Open (Term, Dom Type))
    envLetBindings
      let vars :: [Name]
    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
      [(Name, LocalVar)] -> ((Name, LocalVar) -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (ScopeInfo
    scope ScopeInfo
    -> Lens' [(Name, LocalVar)] ScopeInfo -> [(Name, LocalVar)]
    forall o i. o -> Lens' i o -> i
    ^. Lens' [(Name, LocalVar)] ScopeInfo
    scopeLocals) (((Name, LocalVar) -> m ()) -> m ())
    -> ((Name, LocalVar) -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \(Name
    y , LocalVar
    x) -> do
        Name -> Name -> m ()
    forall (m :: * -> *).
    MonadStConcreteNames m =>
    Name -> Name -> m ()
    pickConcreteName (LocalVar -> Name
    localVar LocalVar
    x) Name
    y

      [(RawName, QName)]
    builtinList <- [[(RawName, QName)]] -> [(RawName, QName)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(RawName, QName)]] -> [(RawName, QName)])
    -> m [[(RawName, QName)]] -> m [(RawName, QName)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (RawName -> m [(RawName, QName)])
    -> [RawName] -> m [[(RawName, QName)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM RawName -> m [(RawName, QName)]
    builtin [ RawName
    builtinFromNat, RawName
    builtinFromString, RawName
    builtinFromNeg, RawName
    builtinZero, RawName
    builtinSuc ]
      Bool
    foldPatSyns <- PragmaOptions -> Bool
    optPrintPatternSynonyms (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
      Env -> m Env
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Env -> m Env) -> Env -> m Env
    forall a b. (a -> b) -> a -> b
    $
        Env :: Set Name
    -> Set Name
    -> ScopeInfo
    -> Map RawName QName
    -> Bool
    -> Bool
    -> Env
    Env { takenVarNames :: Set Name
    takenVarNames = [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList [Name]
    vars
            , takenDefNames :: Set Name
    takenDefNames = Set Name
    defs
            , currentScope :: ScopeInfo
    currentScope = ScopeInfo
    scope
            , builtins :: Map RawName QName
    builtins     = (QName -> QName -> QName)
    -> [(RawName, QName)] -> Map RawName QName
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith QName -> QName -> QName
    forall a. HasCallStack => a
    __IMPOSSIBLE__ [(RawName, QName)]
    builtinList
            , preserveIIds :: Bool
    preserveIIds = Bool
    False
            , foldPatternSynonyms :: Bool
    foldPatternSynonyms = Bool
    foldPatSyns
            }
      where
        -- 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)

        defs :: Set Name
    defs = Map Name [AbstractName] -> Set Name
    forall k a. Map k a -> Set k
    Map.keysSet (Map Name [AbstractName] -> Set Name)
    -> Map Name [AbstractName] -> Set Name
    forall a b. (a -> b) -> a -> b
    $
               ([AbstractName] -> Bool)
    -> Map Name [AbstractName] -> Map Name [AbstractName]
    forall a k. (a -> Bool) -> Map k a -> Map k a
    Map.filter ((AbstractName -> Bool) -> [AbstractName] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all AbstractName -> Bool
    notGeneralizeName) (Map Name [AbstractName] -> Map Name [AbstractName])
    -> Map Name [AbstractName] -> Map Name [AbstractName]
    forall a b. (a -> b) -> a -> b
    $
               NameSpace -> Map Name [AbstractName]
    nsNames (NameSpace -> Map Name [AbstractName])
    -> NameSpace -> Map Name [AbstractName]
    forall a b. (a -> b) -> a -> b
    $ ScopeInfo -> NameSpace
    everythingInScope ScopeInfo
    scope

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

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

    withPrecedence' :: PrecedenceStack -> AbsToCon a -> AbsToCon a
    withPrecedence' :: forall a. PrecedenceStack -> AbsToCon a -> AbsToCon a
    withPrecedence' PrecedenceStack
    ps = (Env -> Env) -> AbsToCon a -> AbsToCon a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ((Env -> Env) -> AbsToCon a -> AbsToCon a)
    -> (Env -> Env) -> AbsToCon a -> AbsToCon a
    forall a b. (a -> b) -> a -> b
    $ \Env
    e ->
      Env
    e { currentScope :: ScopeInfo
    currentScope = Lens' PrecedenceStack ScopeInfo
    -> LensSet PrecedenceStack ScopeInfo
    forall i o. Lens' i o -> LensSet i o
    set Lens' PrecedenceStack ScopeInfo
    scopePrecedence PrecedenceStack
    ps (Env -> ScopeInfo
    currentScope Env
    e) }

    withPrecedence :: Precedence -> AbsToCon a -> AbsToCon a
    withPrecedence :: forall a. Precedence -> AbsToCon a -> AbsToCon a
    withPrecedence Precedence
    p AbsToCon a
    ret = do
      PrecedenceStack
    ps <- AbsToCon PrecedenceStack
    currentPrecedence
      PrecedenceStack -> AbsToCon a -> AbsToCon a
    forall a. PrecedenceStack -> AbsToCon a -> AbsToCon a
    withPrecedence' (Precedence -> PrecedenceStack -> PrecedenceStack
    pushPrecedence Precedence
    p PrecedenceStack
    ps) AbsToCon a
    ret

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

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

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

    -- | 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 Name
    takenVarNames = Name -> Set Name -> Set Name
    forall a. Ord a => a -> Set a -> Set a
    Set.insert Name
    x (Set Name -> Set Name) -> Set Name -> Set Name
    forall a b. (a -> b) -> a -> b
    $ Env -> Set Name
    takenVarNames Env
    e
        , currentScope :: ScopeInfo
    currentScope = (([(Name, LocalVar)] -> [(Name, LocalVar)])
    -> ScopeInfo -> ScopeInfo
    `updateScopeLocals` Env -> ScopeInfo
    currentScope Env
    e) (([(Name, LocalVar)] -> [(Name, LocalVar)]) -> ScopeInfo)
    -> ([(Name, LocalVar)] -> [(Name, LocalVar)]) -> ScopeInfo
    forall a b. (a -> b) -> a -> b
    $
            Name -> LocalVar -> [(Name, LocalVar)] -> [(Name, LocalVar)]
    forall k v. k -> v -> AssocList k v -> AssocList k v
    AssocList.insert Name
    y (Name -> BindingSource -> [AbstractName] -> LocalVar
    LocalVar Name
    x BindingSource
    forall a. HasCallStack => a
    __IMPOSSIBLE__ [])
        }

    -- | Get a function to check if a name refers to a particular builtin function.
    isBuiltinFun :: AbsToCon (A.QName -> String -> Bool)
    isBuiltinFun :: AbsToCon (QName -> RawName -> Bool)
    isBuiltinFun = (Env -> QName -> RawName -> Bool)
    -> AbsToCon (QName -> RawName -> Bool)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ((Env -> QName -> RawName -> Bool)
     -> AbsToCon (QName -> RawName -> Bool))
    -> (Env -> QName -> RawName -> Bool)
    -> AbsToCon (QName -> RawName -> Bool)
    forall a b. (a -> b) -> a -> b
    $ Map RawName QName -> QName -> RawName -> Bool
    forall {k} {a}. (Ord k, Eq a) => Map k a -> a -> k -> Bool
    is (Map RawName QName -> QName -> RawName -> Bool)
    -> (Env -> Map RawName QName) -> Env -> QName -> RawName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env -> Map RawName 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 :: KindsOfNames -> Maybe (Set A.Name) -> C.QName -> AbsToCon (Either (NonEmpty A.QName) ResolvedName)
    resolveName :: KindsOfNames
    -> Maybe (Set Name)
    -> QName
    -> AbsToCon (Either (NonEmpty QName) ResolvedName)
    resolveName KindsOfNames
    kinds Maybe (Set Name)
    candidates QName
    q = ExceptT (NonEmpty QName) AbsToCon ResolvedName
    -> AbsToCon (Either (NonEmpty QName) ResolvedName)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT (NonEmpty QName) AbsToCon ResolvedName
     -> AbsToCon (Either (NonEmpty QName) ResolvedName))
    -> ExceptT (NonEmpty QName) AbsToCon ResolvedName
    -> AbsToCon (Either (NonEmpty QName) ResolvedName)
    forall a b. (a -> b) -> a -> b
    $ KindsOfNames
    -> Maybe (Set Name)
    -> QName
    -> ExceptT (NonEmpty QName) AbsToCon ResolvedName
    forall (m :: * -> *).
    (ReadTCState m, HasBuiltins m, MonadError (NonEmpty QName) m) =>
    KindsOfNames -> Maybe (Set Name) -> QName -> m ResolvedName
    tryResolveName KindsOfNames
    kinds Maybe (Set Name)
    candidates QName
    q

    -- | Treat illegally ambiguous names as UnknownNames.
    resolveName_ :: C.QName -> [A.Name] -> AbsToCon ResolvedName
    resolveName_ :: QName -> [Name] -> AbsToCon ResolvedName
    resolveName_ QName
    q [Name]
    cands = (NonEmpty QName -> ResolvedName)
    -> Either (NonEmpty QName) ResolvedName -> ResolvedName
    forall a b. (a -> b) -> Either a b -> b
    fromRight (ResolvedName -> NonEmpty QName -> ResolvedName
    forall a b. a -> b -> a
    const ResolvedName
    UnknownName) (Either (NonEmpty QName) ResolvedName -> ResolvedName)
    -> AbsToCon (Either (NonEmpty QName) ResolvedName)
    -> AbsToCon ResolvedName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> KindsOfNames
    -> Maybe (Set Name)
    -> QName
    -> AbsToCon (Either (NonEmpty QName) ResolvedName)
    resolveName KindsOfNames
    allKindsOfNames (Set Name -> Maybe (Set Name)
    forall a. a -> Maybe a
    Just (Set Name -> Maybe (Set Name)) -> Set Name -> Maybe (Set Name)
    forall a b. (a -> b) -> a -> b
    $ [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList [Name]
    cands) QName
    q

    -- The Monad --------------------------------------------------------------

    -- | We need:
    --   - Read access to the AbsToCon environment
    --   - Read access to the TC environment
    --   - Read access to the TC state
    --   - Read and write access to the stConcreteNames part of the TC state
    --   - Read access to the options
    --   - Permission to print debug messages
    type MonadAbsToCon m =
      ( MonadTCEnv m
      , ReadTCState m
      , MonadStConcreteNames m
      , HasOptions m
      , HasBuiltins m
      , MonadDebug m
      )

    newtype AbsToCon a = AbsToCon
      { forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon :: forall m.
          ( MonadReader Env m
          , MonadAbsToCon m
          ) => m a
      }

    -- TODO: Is there some way to automatically derive these boilerplate
    -- instances?  GeneralizedNewtypeDeriving fails us here.
    instance Functor AbsToCon where
      fmap :: forall a b. (a -> b) -> AbsToCon a -> AbsToCon b
    fmap a -> b
    f AbsToCon a
    x = (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m b)
    -> AbsToCon b
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m b)
     -> AbsToCon b)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ a -> b
    f (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon a
    x

    instance Applicative AbsToCon where
      pure :: forall a. a -> AbsToCon a
    pure a
    x = (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m a)
     -> AbsToCon a)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m a)
    -> AbsToCon a
    forall a b. (a -> b) -> a -> b
    $ a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    x
      AbsToCon (a -> b)
    f <*> :: forall a b. AbsToCon (a -> b) -> AbsToCon a -> AbsToCon b
    <*> AbsToCon a
    m = (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m b)
    -> AbsToCon b
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m b)
     -> AbsToCon b)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ AbsToCon (a -> b)
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m (a -> b)
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon (a -> b)
    f m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon a
    m

    instance Monad AbsToCon where
      -- ASR (2021-02-07). The eta-expansion @\m' -> unAbsToCon m'@ is
      -- required by GHC >= 9.0.1 (see Issue #4955).
      AbsToCon a
    m >>= :: forall a b. AbsToCon a -> (a -> AbsToCon b) -> AbsToCon b
    >>= a -> AbsToCon b
    f = (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m b)
    -> AbsToCon b
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m b)
     -> AbsToCon b)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon a
    m m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\AbsToCon b
    m' -> AbsToCon b
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m b
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon b
    m')(AbsToCon b -> m b) -> (a -> AbsToCon b) -> a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> AbsToCon b
    f
    #if __GLASGOW_HASKELL__ < 808
      fail = Fail.fail
    #endif

    instance Fail.MonadFail AbsToCon where
      fail :: forall a. RawName -> AbsToCon a
    fail = RawName -> AbsToCon a
    forall a. HasCallStack => RawName -> a
    error

    instance MonadReader Env AbsToCon where
      ask :: AbsToCon Env
    ask = (forall (m :: * -> *).
     (MonadReader Env m, MonadAbsToCon m) =>
     m Env)
    -> AbsToCon Env
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon forall r (m :: * -> *). MonadReader r m => m r
    forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m Env
    ask
      local :: forall a. (Env -> Env) -> AbsToCon a -> AbsToCon a
    local Env -> Env
    f AbsToCon a
    m = (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m a)
     -> AbsToCon a)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m a)
    -> AbsToCon a
    forall a b. (a -> b) -> a -> b
    $ (Env -> Env) -> m a -> m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local Env -> Env
    f (m a -> m a) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon a
    m

    instance MonadTCEnv AbsToCon where
      askTC :: AbsToCon TCEnv
    askTC = (forall (m :: * -> *).
     (MonadReader Env m, MonadAbsToCon m) =>
     m TCEnv)
    -> AbsToCon TCEnv
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon forall (m :: * -> *).
    (MonadReader Env m, MonadAbsToCon m) =>
    m TCEnv
    forall (m :: * -> *). MonadTCEnv m => m TCEnv
    askTC
      localTC :: forall a. (TCEnv -> TCEnv) -> AbsToCon a -> AbsToCon a
    localTC TCEnv -> TCEnv
    f AbsToCon a
    m = (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m a)
     -> AbsToCon a)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m a)
    -> AbsToCon a
    forall a b. (a -> b) -> a -> b
    $ (TCEnv -> TCEnv) -> m a -> m a
    forall (m :: * -> *) a.
    MonadTCEnv m =>
    (TCEnv -> TCEnv) -> m a -> m a
    localTC TCEnv -> TCEnv
    f (m a -> m a) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon a
    m

    instance ReadTCState AbsToCon where
      getTCState :: AbsToCon TCState
    getTCState = (forall (m :: * -> *).
     (MonadReader Env m, MonadAbsToCon m) =>
     m TCState)
    -> AbsToCon TCState
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon forall (m :: * -> *).
    (MonadReader Env m, MonadAbsToCon m) =>
    m TCState
    forall (m :: * -> *). ReadTCState m => m TCState
    getTCState
      locallyTCState :: forall a b. Lens' a TCState -> (a -> a) -> AbsToCon b -> AbsToCon b
    locallyTCState Lens' a TCState
    l a -> a
    f AbsToCon b
    m = (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m b)
    -> AbsToCon b
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m b)
     -> AbsToCon b)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Lens' a TCState -> (a -> a) -> m b -> m b
    forall (m :: * -> *) a b.
    ReadTCState m =>
    Lens' a TCState -> (a -> a) -> m b -> m b
    locallyTCState Lens' a TCState
    l a -> a
    f (m b -> m b) -> m b -> m b
    forall a b. (a -> b) -> a -> b
    $ AbsToCon b
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m b
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon b
    m

    instance MonadStConcreteNames AbsToCon where
      -- ASR (2021-02-07). The eta-expansion @\m' -> unAbsToCon m'@ is
      -- required by GHC >= 9.0.1 (see Issue #4955).
      runStConcreteNames :: forall a. StateT ConcreteNames AbsToCon a -> AbsToCon a
    runStConcreteNames StateT ConcreteNames AbsToCon a
    m =
        (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m a)
     -> AbsToCon a)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m a)
    -> AbsToCon a
    forall a b. (a -> b) -> a -> b
    $ StateT ConcreteNames m a -> m a
    forall (m :: * -> *) a.
    MonadStConcreteNames m =>
    StateT ConcreteNames m a -> m a
    runStConcreteNames (StateT ConcreteNames m a -> m a)
    -> StateT ConcreteNames m a -> m a
    forall a b. (a -> b) -> a -> b
    $ (ConcreteNames -> m (a, ConcreteNames)) -> StateT ConcreteNames m a
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
    StateT ((ConcreteNames -> m (a, ConcreteNames))
     -> StateT ConcreteNames m a)
    -> (ConcreteNames -> m (a, ConcreteNames))
    -> StateT ConcreteNames m a
    forall a b. (a -> b) -> a -> b
    $ (\AbsToCon (a, ConcreteNames)
    m' -> AbsToCon (a, ConcreteNames)
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m (a, ConcreteNames)
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon (a, ConcreteNames)
    m') (AbsToCon (a, ConcreteNames) -> m (a, ConcreteNames))
    -> (ConcreteNames -> AbsToCon (a, ConcreteNames))
    -> ConcreteNames
    -> m (a, ConcreteNames)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT ConcreteNames AbsToCon a
    -> ConcreteNames -> AbsToCon (a, ConcreteNames)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT StateT ConcreteNames AbsToCon a
    m

    instance HasBuiltins AbsToCon where
      getBuiltinThing :: RawName -> AbsToCon (Maybe (Builtin PrimFun))
    getBuiltinThing RawName
    x = (forall (m :: * -> *).
     (MonadReader Env m, MonadAbsToCon m) =>
     m (Maybe (Builtin PrimFun)))
    -> AbsToCon (Maybe (Builtin PrimFun))
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m (Maybe (Builtin PrimFun)))
     -> AbsToCon (Maybe (Builtin PrimFun)))
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m (Maybe (Builtin PrimFun)))
    -> AbsToCon (Maybe (Builtin PrimFun))
    forall a b. (a -> b) -> a -> b
    $ RawName -> m (Maybe (Builtin PrimFun))
    forall (m :: * -> *).
    HasBuiltins m =>
    RawName -> m (Maybe (Builtin PrimFun))
    getBuiltinThing RawName
    x

    instance HasOptions AbsToCon where
      pragmaOptions :: AbsToCon PragmaOptions
    pragmaOptions = (forall (m :: * -> *).
     (MonadReader Env m, MonadAbsToCon m) =>
     m PragmaOptions)
    -> AbsToCon PragmaOptions
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon forall (m :: * -> *).
    (MonadReader Env m, MonadAbsToCon m) =>
    m PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
      commandLineOptions :: AbsToCon CommandLineOptions
    commandLineOptions = (forall (m :: * -> *).
     (MonadReader Env m, MonadAbsToCon m) =>
     m CommandLineOptions)
    -> AbsToCon CommandLineOptions
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon forall (m :: * -> *).
    (MonadReader Env m, MonadAbsToCon m) =>
    m CommandLineOptions
    forall (m :: * -> *). HasOptions m => m CommandLineOptions
    commandLineOptions

    instance MonadDebug AbsToCon where
      formatDebugMessage :: RawName -> VerboseLevel -> TCM Doc -> AbsToCon RawName
    formatDebugMessage RawName
    k VerboseLevel
    n TCM Doc
    s      = (forall (m :: * -> *).
     (MonadReader Env m, MonadAbsToCon m) =>
     m RawName)
    -> AbsToCon RawName
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m RawName)
     -> AbsToCon RawName)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m RawName)
    -> AbsToCon RawName
    forall a b. (a -> b) -> a -> b
    $ RawName -> VerboseLevel -> TCM Doc -> m RawName
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> TCM Doc -> m RawName
    formatDebugMessage RawName
    k VerboseLevel
    n TCM Doc
    s
      traceDebugMessage :: forall a.
    RawName -> VerboseLevel -> RawName -> AbsToCon a -> AbsToCon a
    traceDebugMessage  RawName
    k VerboseLevel
    n RawName
    s AbsToCon a
    cont = (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m a)
     -> AbsToCon a)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m a)
    -> AbsToCon a
    forall a b. (a -> b) -> a -> b
    $ RawName -> VerboseLevel -> RawName -> m a -> m a
    forall (m :: * -> *) a.
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m a -> m a
    traceDebugMessage  RawName
    k VerboseLevel
    n RawName
    s (m a -> m a) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon a
    cont  -- can't eta-reduce!
      verboseBracket :: forall a.
    RawName -> VerboseLevel -> RawName -> AbsToCon a -> AbsToCon a
    verboseBracket     RawName
    k VerboseLevel
    n RawName
    s AbsToCon a
    cont = (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    forall a.
    (forall (m :: * -> *). (MonadReader Env m, MonadAbsToCon m) => m a)
    -> AbsToCon a
    AbsToCon ((forall (m :: * -> *).
      (MonadReader Env m, MonadAbsToCon m) =>
      m a)
     -> AbsToCon a)
    -> (forall (m :: * -> *).
        (MonadReader Env m, MonadAbsToCon m) =>
        m a)
    -> AbsToCon a
    forall a b. (a -> b) -> a -> b
    $ RawName -> VerboseLevel -> RawName -> m a -> m a
    forall (m :: * -> *) a.
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m a -> m a
    verboseBracket     RawName
    k VerboseLevel
    n RawName
    s (m a -> m a) -> m a -> m a
    forall a b. (a -> b) -> a -> b
    $ AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon a
    cont  -- because of GHC-9.0

      getVerbosity :: AbsToCon Verbosity
    getVerbosity     = AbsToCon Verbosity
    forall (m :: * -> *). HasOptions m => m Verbosity
    defaultGetVerbosity
      isDebugPrinting :: AbsToCon Bool
    isDebugPrinting  = AbsToCon Bool
    forall (m :: * -> *). MonadTCEnv m => m Bool
    defaultIsDebugPrinting
      nowDebugPrinting :: forall a. AbsToCon a -> AbsToCon a
    nowDebugPrinting = AbsToCon a -> AbsToCon a
    forall (m :: * -> *) a. MonadTCEnv m => m a -> m a
    defaultNowDebugPrinting

    runAbsToCon :: MonadAbsToCon m => AbsToCon c -> m c
    runAbsToCon :: forall (m :: * -> *) c. MonadAbsToCon m => AbsToCon c -> m c
    runAbsToCon AbsToCon c
    m = do
      ScopeInfo
    scope <- m ScopeInfo
    forall (m :: * -> *). ReadTCState m => m ScopeInfo
    getScope
      RawName -> VerboseLevel -> RawName -> m c -> m c
    forall (m :: * -> *) a.
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m a -> m a
    verboseBracket RawName
    "toConcrete" VerboseLevel
    50 RawName
    "runAbsToCon" (m c -> m c) -> m c -> m c
    forall a b. (a -> b) -> a -> b
    $ do
        RawName -> VerboseLevel -> RawName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete" VerboseLevel
    50 (RawName -> m ()) -> RawName -> m ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> RawName
    render (Doc -> RawName) -> Doc -> RawName
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    hsep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $
          [ Doc
    "entering AbsToCon with scope:"
          , [Doc] -> Doc
    forall a. Pretty a => [a] -> Doc
    prettyList_ (((Name, LocalVar) -> Doc) -> [(Name, LocalVar)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (RawName -> Doc
    text (RawName -> Doc)
    -> ((Name, LocalVar) -> RawName) -> (Name, LocalVar) -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> RawName
    C.nameToRawName (Name -> RawName)
    -> ((Name, LocalVar) -> Name) -> (Name, LocalVar) -> RawName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, LocalVar) -> Name
    forall a b. (a, b) -> a
    fst) ([(Name, LocalVar)] -> [Doc]) -> [(Name, LocalVar)] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ ScopeInfo
    scope ScopeInfo
    -> Lens' [(Name, LocalVar)] ScopeInfo -> [(Name, LocalVar)]
    forall o i. o -> Lens' i o -> i
    ^. Lens' [(Name, LocalVar)] ScopeInfo
    scopeLocals)
          ]
        c
    x <- ReaderT Env m c -> Env -> m c
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (AbsToCon c
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m c
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon AbsToCon c
    m) (Env -> m c) -> m Env -> m c
    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
        RawName -> VerboseLevel -> RawName -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete" VerboseLevel
    50 (RawName -> m ()) -> RawName -> m ()
    forall a b. (a -> b) -> a -> b
    $ RawName
    "leaving AbsToCon"
        c -> m c
    forall (m :: * -> *) a. Monad m => a -> m a
    return c
    x

    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 (AbsToCon (ConOfAbs a) -> ReaderT Env m (ConOfAbs a)
    forall a.
    AbsToCon a
    -> forall (m :: * -> *).
       (MonadReader Env m, MonadAbsToCon m) =>
       m a
    unAbsToCon (AbsToCon (ConOfAbs a) -> ReaderT Env m (ConOfAbs a))
    -> AbsToCon (ConOfAbs a) -> ReaderT Env m (ConOfAbs a)
    forall a b. (a -> b) -> a -> b
    $ a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (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 = AbsToCon (ConOfAbs a) -> m (ConOfAbs a)
    forall (m :: * -> *) c. MonadAbsToCon m => AbsToCon c -> m c
    runAbsToCon (AbsToCon (ConOfAbs a) -> m (ConOfAbs a))
    -> AbsToCon (ConOfAbs a) -> m (ConOfAbs a)
    forall a b. (a -> b) -> a -> b
    $ Precedence -> AbsToCon (ConOfAbs a) -> AbsToCon (ConOfAbs a)
    forall a. Precedence -> AbsToCon a -> AbsToCon a
    withPrecedence Precedence
    ctx (a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (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_ = AbsToCon (ConOfAbs a) -> m (ConOfAbs a)
    forall (m :: * -> *) c. MonadAbsToCon m => AbsToCon c -> m c
    runAbsToCon (AbsToCon (ConOfAbs a) -> m (ConOfAbs a))
    -> (a -> AbsToCon (ConOfAbs a)) -> a -> m (ConOfAbs a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (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 = AbsToCon (ConOfAbs a) -> m (ConOfAbs a)
    forall (m :: * -> *) c. MonadAbsToCon m => AbsToCon c -> m c
    runAbsToCon (AbsToCon (ConOfAbs a) -> m (ConOfAbs a))
    -> (a -> AbsToCon (ConOfAbs a)) -> a -> m (ConOfAbs a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> a -> AbsToCon (ConOfAbs a)
    forall h a.
    (LensHiding h, ToConcrete a) =>
    h -> a -> AbsToCon (ConOfAbs a)
    toConcreteHiding i
    i

    -- 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

    lookupQName :: AllowAmbiguousNames -> A.QName -> AbsToCon C.QName
    lookupQName :: AllowAmbiguousNames -> QName -> AbsToCon QName
    lookupQName AllowAmbiguousNames
    ambCon QName
    x | Just RawName
    s <- QName -> Maybe RawName
    getGeneralizedFieldName QName
    x =
      QName -> AbsToCon QName
    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
    $ RawName -> NameParts
    C.stringNameParts RawName
    s)
    lookupQName AllowAmbiguousNames
    ambCon QName
    x = do
      [QName]
    ys <- (Env -> [QName]) -> AbsToCon [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)
      RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "scope.inverse" VerboseLevel
    100 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $
        RawName
    "inverse looking up abstract name " RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ QName -> RawName
    forall a. Pretty a => a -> RawName
    prettyShow QName
    x RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ RawName
    " yields " RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ [QName] -> RawName
    forall a. Pretty a => a -> RawName
    prettyShow [QName]
    ys
      [QName] -> AbsToCon QName
    loop [QName]
    ys

      where
        -- Found concrete name: check that it is not shadowed by a local
        loop :: [QName] -> AbsToCon QName
    loop (qy :: QName
    qy@Qual{}      : [QName]
    _ ) = QName -> AbsToCon QName
    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 -> AbsToCon (Maybe Name)
    lookupNameInScope Name
    y AbsToCon (Maybe Name)
    -> (Maybe Name -> AbsToCon QName) -> AbsToCon QName
    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] -> AbsToCon QName
    loop [QName]
    ys
          Maybe Name
    _ -> QName -> AbsToCon QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    qy
        -- Found no concrete name: make up a new one
        loop [] = case QName -> QName
    qnameToConcrete QName
    x of
          qy :: QName
    qy@Qual{}    -> QName -> AbsToCon QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> AbsToCon QName) -> QName -> AbsToCon QName
    forall a b. (a -> b) -> a -> b
    $ QName -> QName
    forall a. LensInScope a => a -> a
    setNotInScope QName
    qy
          qy :: QName
    qy@C.QName{} -> Name -> QName
    C.QName (Name -> QName) -> AbsToCon Name -> AbsToCon QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> AbsToCon Name
    chooseName (QName -> Name
    qnameName QName
    x)

    lookupModule :: A.ModuleName -> AbsToCon C.QName
    lookupModule :: ModuleName -> AbsToCon QName
    lookupModule (A.MName []) = QName -> AbsToCon QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> AbsToCon QName) -> QName -> AbsToCon QName
    forall a b. (a -> b) -> a -> b
    $ Name -> QName
    C.QName (Name -> QName) -> Name -> QName
    forall a b. (a -> b) -> a -> b
    $ RawName -> Name
    C.simpleName RawName
    "-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  ScopeInfo
    scope <- (Env -> ScopeInfo) -> AbsToCon ScopeInfo
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> ScopeInfo
    currentScope
            case ModuleName -> ScopeInfo -> [QName]
    inverseScopeLookupModule ModuleName
    x ScopeInfo
    scope of
                (QName
    y : [QName]
    _) -> QName -> AbsToCon QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    y
                []      -> QName -> AbsToCon QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> AbsToCon QName) -> QName -> AbsToCon 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 :: C.Name -> AbsToCon (Maybe A.Name)
    lookupNameInScope :: Name -> AbsToCon (Maybe Name)
    lookupNameInScope Name
    y =
      (Env -> Maybe Name) -> AbsToCon (Maybe Name)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (((LocalVar -> Name) -> Maybe LocalVar -> Maybe Name
    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' [(Name, LocalVar)] ScopeInfo -> [(Name, LocalVar)]
    forall o i. o -> Lens' i o -> i
    ^. Lens' [(Name, LocalVar)] ScopeInfo
    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] -> Name -> ConcreteNames -> [Name]
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault [] 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 [Name] -> Maybe [Name])
     -> Name -> ConcreteNames -> ConcreteNames)
    -> Name
    -> (Maybe [Name] -> Maybe [Name])
    -> ConcreteNames
    -> ConcreteNames
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Maybe [Name] -> Maybe [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 [Name] -> Maybe [Name]) -> ConcreteNames -> ConcreteNames)
    -> (Maybe [Name] -> Maybe [Name]) -> ConcreteNames -> ConcreteNames
    forall a b. (a -> b) -> a -> b
    $ \case
        Maybe [Name]
    Nothing   -> [Name] -> Maybe [Name]
    forall a. a -> Maybe a
    Just ([Name] -> Maybe [Name]) -> [Name] -> Maybe [Name]
    forall a b. (a -> b) -> a -> b
    $ [Name
    y]
        (Just [Name]
    ys) -> [Name] -> Maybe [Name]
    forall a. a -> Maybe a
    Just ([Name] -> Maybe [Name]) -> [Name] -> Maybe [Name]
    forall a b. (a -> b) -> a -> b
    $ [Name]
    ys [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ [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 RawName)
    shadowingNames Name
    x = [RawName] -> Set RawName
    forall a. Ord a => [a] -> Set a
    Set.fromList ([RawName] -> Set RawName)
    -> (Map Name [RawName] -> [RawName])
    -> Map Name [RawName]
    -> Set RawName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [RawName] -> Name -> Map Name [RawName] -> [RawName]
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault [] Name
    x (Map Name [RawName] -> Set RawName)
    -> m (Map Name [RawName]) -> m (Set RawName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Lens' (Map Name [RawName]) TCState -> m (Map Name [RawName])
    forall (m :: * -> *) a. ReadTCState m => Lens' a TCState -> m a
    useR Lens' (Map Name [RawName]) TCState
    stShadowingNames

    toConcreteName :: A.Name -> AbsToCon C.Name
    toConcreteName :: Name -> AbsToCon Name
    toConcreteName Name
    x | Name
    y <- Name -> Name
    nameConcrete Name
    x , Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    y = Name -> AbsToCon Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    y
    toConcreteName Name
    x = ([Name] -> Name -> ConcreteNames -> [Name]
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault [] Name
    x (ConcreteNames -> [Name])
    -> AbsToCon ConcreteNames -> AbsToCon [Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> AbsToCon ConcreteNames
    forall (m :: * -> *). MonadStConcreteNames m => m ConcreteNames
    useConcreteNames) AbsToCon [Name] -> ([Name] -> AbsToCon Name) -> AbsToCon Name
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Name] -> AbsToCon Name
    loop
      where
        -- case: we already have picked some name(s) for x
        loop :: [Name] -> AbsToCon Name
    loop (Name
    y:[Name]
    ys) = AbsToCon Bool -> AbsToCon Name -> AbsToCon Name -> AbsToCon Name
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (Name -> Name -> AbsToCon Bool
    isGoodName Name
    x Name
    y) (Name -> AbsToCon Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    y) ([Name] -> AbsToCon 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
          Name
    y <- Name -> AbsToCon Name
    chooseName Name
    x
          Name -> Name -> AbsToCon ()
    forall (m :: * -> *).
    MonadStConcreteNames m =>
    Name -> Name -> m ()
    pickConcreteName Name
    x Name
    y
          Name -> AbsToCon Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    y

        -- Is 'y' a good concrete name for abstract name 'x'?
        isGoodName :: A.Name -> C.Name -> AbsToCon Bool
        isGoodName :: Name -> Name -> AbsToCon Bool
    isGoodName Name
    x Name
    y = do
          [Name]
    zs <- (Env -> [Name]) -> AbsToCon [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)
          [Name] -> (Name -> AbsToCon Bool) -> AbsToCon Bool
    forall (f :: * -> *) (m :: * -> *) a.
    (Functor f, Foldable f, Monad m) =>
    f a -> (a -> m Bool) -> m Bool
    allM [Name]
    zs ((Name -> AbsToCon Bool) -> AbsToCon Bool)
    -> (Name -> AbsToCon Bool) -> AbsToCon Bool
    forall a b. (a -> b) -> a -> b
    $ \Name
    z -> if Name
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    z then Bool -> AbsToCon Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True else do
            [Name]
    czs <- Name -> AbsToCon [Name]
    forall (m :: * -> *). MonadStConcreteNames m => Name -> m [Name]
    hasConcreteNames Name
    z
            Bool -> AbsToCon Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> AbsToCon Bool) -> Bool -> AbsToCon Bool
    forall a b. (a -> b) -> a -> b
    $ Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    notElem Name
    y [Name]
    czs

    -- | 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 :: A.Name -> AbsToCon C.Name
    chooseName :: Name -> AbsToCon Name
    chooseName Name
    x = Name -> AbsToCon (Maybe Name)
    lookupNameInScope (Name -> Name
    nameConcrete Name
    x) AbsToCon (Maybe Name)
    -> (Maybe Name -> AbsToCon Name) -> AbsToCon Name
    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
        RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete.bindName" VerboseLevel
    80 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $
          RawName
    "name " RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ Name -> RawName
    C.nameToRawName (Name -> Name
    nameConcrete Name
    x) RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ RawName
    " already in scope, so not renaming"
        Name -> AbsToCon Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> AbsToCon Name) -> Name -> AbsToCon 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
        Set RawName
    taken   <- AbsToCon (Set RawName)
    takenNames
        Set RawName
    toAvoid <- Name -> AbsToCon (Set RawName)
    forall (m :: * -> *).
    (ReadTCState m, MonadStConcreteNames m) =>
    Name -> m (Set RawName)
    shadowingNames Name
    x
        UnicodeOrAscii
    glyphMode <- PragmaOptions -> UnicodeOrAscii
    optUseUnicode (PragmaOptions -> UnicodeOrAscii)
    -> AbsToCon PragmaOptions -> AbsToCon UnicodeOrAscii
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> AbsToCon PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
        let freshNameMode :: FreshNameMode
    freshNameMode = case UnicodeOrAscii
    glyphMode of
              UnicodeOrAscii
    UnicodeOk -> FreshNameMode
    A.UnicodeSubscript
              UnicodeOrAscii
    AsciiOnly -> FreshNameMode
    A.AsciiCounter
        let shouldAvoid :: Name -> Bool
    shouldAvoid = (RawName -> Set RawName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` (Set RawName
    taken Set RawName -> Set RawName -> Set RawName
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set RawName
    toAvoid)) (RawName -> Bool) -> (Name -> RawName) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> RawName
    C.nameToRawName
            y :: Name
    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
        RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete.bindName" VerboseLevel
    80 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> RawName
    render (Doc -> RawName) -> Doc -> RawName
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat
          [ Doc
    "picking concrete name for:" Doc -> Doc -> Doc
    <+> RawName -> Doc
    text (Name -> RawName
    C.nameToRawName (Name -> RawName) -> Name -> RawName
    forall a b. (a -> b) -> a -> b
    $ Name -> Name
    nameConcrete Name
    x)
          , Doc
    "names already taken:      " Doc -> Doc -> Doc
    <+> [RawName] -> Doc
    forall a. Pretty a => [a] -> Doc
    prettyList_ (Set RawName -> [RawName]
    forall a. Set a -> [a]
    Set.toList Set RawName
    taken)
          , Doc
    "names to avoid:           " Doc -> Doc -> Doc
    <+> [RawName] -> Doc
    forall a. Pretty a => [a] -> Doc
    prettyList_ (Set RawName -> [RawName]
    forall a. Set a -> [a]
    Set.toList Set RawName
    toAvoid)
          , Doc
    "concrete name chosen:     " Doc -> Doc -> Doc
    <+> RawName -> Doc
    text (Name -> RawName
    C.nameToRawName Name
    y)
          ]
        Name -> AbsToCon Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    y

      where
        takenNames :: AbsToCon (Set RawName)
        takenNames :: AbsToCon (Set RawName)
    takenNames = do
          Set Name
    xs <- (Env -> Set Name) -> AbsToCon (Set Name)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> Set Name
    takenDefNames
          Set Name
    ys0 <- (Env -> Set Name) -> AbsToCon (Set Name)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> Set Name
    takenVarNames
          RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete.bindName" VerboseLevel
    90 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> RawName
    render (Doc -> RawName) -> Doc -> RawName
    forall a b. (a -> b) -> a -> b
    $ Doc
    "abstract names of local vars: " Doc -> Doc -> Doc
    <+> [RawName] -> Doc
    forall a. Pretty a => [a] -> Doc
    prettyList_ ((Name -> RawName) -> [Name] -> [RawName]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> RawName
    C.nameToRawName (Name -> RawName) -> (Name -> Name) -> Name -> RawName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Name
    nameConcrete) ([Name] -> [RawName]) -> [Name] -> [RawName]
    forall a b. (a -> b) -> a -> b
    $ Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList Set Name
    ys0)
          Set Name
    ys <- [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList ([Name] -> Set Name)
    -> ([[Name]] -> [Name]) -> [[Name]] -> Set Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Name]] -> [Name]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Name]] -> Set Name) -> AbsToCon [[Name]] -> AbsToCon (Set Name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name -> AbsToCon [Name]) -> [Name] -> AbsToCon [[Name]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Name -> AbsToCon [Name]
    forall (m :: * -> *). MonadStConcreteNames m => Name -> m [Name]
    hasConcreteNames (Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList Set Name
    ys0)
          Set RawName -> AbsToCon (Set RawName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Set RawName -> AbsToCon (Set RawName))
    -> Set RawName -> AbsToCon (Set RawName)
    forall a b. (a -> b) -> a -> b
    $ (Name -> RawName) -> Set Name -> Set RawName
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    Set.map Name -> RawName
    C.nameToRawName (Set Name -> Set RawName) -> Set Name -> Set RawName
    forall a b. (a -> b) -> a -> b
    $ Set Name
    xs Set Name -> Set Name -> Set Name
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set Name
    ys

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

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

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

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

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

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

    {- UNUSED
    -- | Pattern bracketing
    bracketP :: (PrecedenceStack -> Bool) -> (C.Pattern -> AbsToCon a)
                                     -> ((C.Pattern -> AbsToCon a) -> AbsToCon a)
                                     -> AbsToCon a
    bracketP par ret m = m $ \p -> do
        p <- bracket' (ParenP $ getRange p) par p
        ret p
    -}

    -- | 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 :: DefInfo -> C.Name -> AbsToCon [C.Declaration] -> AbsToCon [C.Declaration]
    withInfixDecl :: DefInfo -> Name -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    withInfixDecl DefInfo
    i Name
    x AbsToCon [Declaration]
    m = (([Declaration]
    fixDecl [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    synDecl) [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++) ([Declaration] -> [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> AbsToCon [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 :: DefInfo -> AbsToCon [C.Declaration] -> AbsToCon [C.Declaration]
    withAbstractPrivate :: DefInfo -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    withAbstractPrivate DefInfo
    i AbsToCon [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 Range -> [Declaration] -> [Declaration]
    addInstanceB (case DefInfo -> IsInstance
    forall t. DefInfo' t -> IsInstance
    A.defInstance DefInfo
    i of InstanceDef Range
    r -> Range -> Maybe Range
    forall a. a -> Maybe a
    Just Range
    r; IsInstance
    NotInstanceDef -> Maybe Range
    forall a. Maybe a
    Nothing)
          ([Declaration] -> [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> AbsToCon [Declaration]
    m
        where
            priv :: Access -> [Declaration] -> [Declaration]
    priv (PrivateAccess Origin
    UserWritten)
                             [Declaration]
    ds = [ Range -> Origin -> [Declaration] -> Declaration
    C.Private  ([Declaration] -> Range
    forall a. HasRange a => a -> Range
    getRange [Declaration]
    ds) Origin
    UserWritten [Declaration]
    ds ]
            priv Access
    _           [Declaration]
    ds = [Declaration]
    ds
            abst :: IsAbstract -> [Declaration] -> [Declaration]
    abst IsAbstract
    AbstractDef [Declaration]
    ds = [ Range -> [Declaration] -> Declaration
    C.Abstract ([Declaration] -> Range
    forall a. HasRange a => a -> Range
    getRange [Declaration]
    ds) [Declaration]
    ds ]
            abst IsAbstract
    ConcreteDef [Declaration]
    ds = [Declaration]
    ds

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

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

    class ToConcrete a where
        type ConOfAbs a
        toConcrete :: a -> AbsToCon (ConOfAbs a)
        bindToConcrete :: a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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 -> AbsToCon (ConOfAbs a)) -> AbsToCon (ConOfAbs a)
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete a
    x ConOfAbs a -> AbsToCon (ConOfAbs a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        bindToConcrete a
    x ConOfAbs a -> AbsToCon b
    ret = ConOfAbs a -> AbsToCon b
    ret (ConOfAbs a -> AbsToCon b) -> AbsToCon (ConOfAbs a) -> AbsToCon b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete a
    x

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

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

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

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

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

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

    -- General instances ------------------------------------------------------

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

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

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

        toConcrete :: [a] -> AbsToCon (ConOfAbs [a])
    toConcrete     = (a -> AbsToCon (ConOfAbs a)) -> [a] -> AbsToCon [ConOfAbs a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete
        bindToConcrete :: forall b. [a] -> (ConOfAbs [a] -> AbsToCon b) -> AbsToCon b
    bindToConcrete []     ConOfAbs [a] -> AbsToCon b
    ret = ConOfAbs [a] -> AbsToCon b
    ret []
        bindToConcrete (a
    a:[a]
    as) ConOfAbs [a] -> AbsToCon b
    ret = NonEmpty a -> (ConOfAbs (NonEmpty a) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (a
    aa -> [a] -> NonEmpty a
    forall a. a -> [a] -> NonEmpty a
    :|[a]
    as) ((ConOfAbs (NonEmpty a) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (NonEmpty a) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ (ConOfAbs a
    c:|[ConOfAbs a]
    cs) -> ConOfAbs [a] -> AbsToCon 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 :: List1 a -> AbsToCon (ConOfAbs (List1 a))
    toConcrete     = (a -> AbsToCon (ConOfAbs a))
    -> List1 a -> AbsToCon (NonEmpty (ConOfAbs a))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (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 b.
    List1 a -> (ConOfAbs (List1 a) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (a
    a :| [a]
    as) ConOfAbs (List1 a) -> AbsToCon b
    ret = do
          PrecedenceStack
    p <- AbsToCon PrecedenceStack
    currentPrecedence  -- save precedence
          a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete a
    a ((ConOfAbs a -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs a
    c ->
            PrecedenceStack -> AbsToCon b -> AbsToCon b
    forall a. PrecedenceStack -> AbsToCon a -> AbsToCon a
    withPrecedence' PrecedenceStack
    p (AbsToCon b -> AbsToCon b) -> AbsToCon b -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ -- reset precedence
              [a] -> (ConOfAbs [a] -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete [a]
    as ((ConOfAbs [a] -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs [a] -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs [a]
    cs ->
                ConOfAbs (List1 a) -> AbsToCon 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 a1, ToConcrete a2) => ToConcrete (Either a1 a2) where
        type ConOfAbs (Either a1 a2) = Either (ConOfAbs a1) (ConOfAbs a2)

        toConcrete :: Either a1 a2 -> AbsToCon (ConOfAbs (Either a1 a2))
    toConcrete = (a1 -> AbsToCon (ConOfAbs a1))
    -> (a2 -> AbsToCon (ConOfAbs a2))
    -> Either a1 a2
    -> AbsToCon (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 -> AbsToCon (ConOfAbs a1)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete a2 -> AbsToCon (ConOfAbs a2)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete
        bindToConcrete :: forall b.
    Either a1 a2
    -> (ConOfAbs (Either a1 a2) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Left a1
    x) ConOfAbs (Either a1 a2) -> AbsToCon b
    ret =
            a1 -> (ConOfAbs a1 -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete a1
    x ((ConOfAbs a1 -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a1 -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs a1
    x ->
            ConOfAbs (Either a1 a2) -> AbsToCon 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) -> AbsToCon b
    ret =
            a2 -> (ConOfAbs a2 -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete a2
    y ((ConOfAbs a2 -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a2 -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs a2
    y ->
            ConOfAbs (Either a1 a2) -> AbsToCon 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 :: (a1, a2) -> AbsToCon (ConOfAbs (a1, a2))
    toConcrete (a1
    x,a2
    y) = (ConOfAbs a1 -> ConOfAbs a2 -> (ConOfAbs a1, ConOfAbs a2))
    -> AbsToCon (ConOfAbs a1)
    -> AbsToCon (ConOfAbs a2)
    -> AbsToCon (ConOfAbs a1, ConOfAbs a2)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (,) (a1 -> AbsToCon (ConOfAbs a1)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete a1
    x) (a2 -> AbsToCon (ConOfAbs a2)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete a2
    y)
        bindToConcrete :: forall b.
    (a1, a2) -> (ConOfAbs (a1, a2) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (a1
    x,a2
    y) ConOfAbs (a1, a2) -> AbsToCon b
    ret =
            a1 -> (ConOfAbs a1 -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete a1
    x ((ConOfAbs a1 -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a1 -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs a1
    x ->
            a2 -> (ConOfAbs a2 -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete a2
    y ((ConOfAbs a2 -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a2 -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs a2
    y ->
            ConOfAbs (a1, a2) -> AbsToCon 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 :: (a1, a2, a3) -> AbsToCon (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))
    -> AbsToCon (ConOfAbs a1, (ConOfAbs a2, ConOfAbs a3))
    -> AbsToCon (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (a1, (a2, a3)) -> AbsToCon (ConOfAbs (a1, (a2, a3)))
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    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 b.
    (a1, a2, a3) -> (ConOfAbs (a1, a2, a3) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (a1
    x,a2
    y,a3
    z) ConOfAbs (a1, a2, a3) -> AbsToCon b
    ret = (a1, (a2, a3))
    -> (ConOfAbs (a1, (a2, a3)) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (a1
    x,(a2
    y,a3
    z)) ((ConOfAbs (a1, (a2, a3)) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (a1, (a2, a3)) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3) -> AbsToCon b
    ConOfAbs (a1, a2, a3) -> AbsToCon b
    ret ((ConOfAbs a1, ConOfAbs a2, ConOfAbs a3) -> AbsToCon b)
    -> ((ConOfAbs a1, (ConOfAbs a2, ConOfAbs a3))
        -> (ConOfAbs a1, ConOfAbs a2, ConOfAbs a3))
    -> (ConOfAbs a1, (ConOfAbs a2, ConOfAbs a3))
    -> AbsToCon 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)

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

        toConcrete :: Arg a -> AbsToCon (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))
    -> AbsToCon (ConOfAbs a) -> AbsToCon (Arg (ConOfAbs a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ArgInfo -> a -> AbsToCon (ConOfAbs a)
    forall h a.
    (LensHiding h, ToConcrete a) =>
    h -> a -> AbsToCon (ConOfAbs a)
    toConcreteHiding ArgInfo
    i a
    a

        bindToConcrete :: forall b. Arg a -> (ConOfAbs (Arg a) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Arg ArgInfo
    info a
    x) ConOfAbs (Arg a) -> AbsToCon b
    ret =
          ArgInfo -> a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall h a b.
    (LensHiding h, ToConcrete a) =>
    h -> a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcreteHiding ArgInfo
    info a
    x ((ConOfAbs a -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Arg (ConOfAbs a) -> AbsToCon b
    ConOfAbs (Arg a) -> AbsToCon b
    ret (Arg (ConOfAbs a) -> AbsToCon b)
    -> (ConOfAbs a -> Arg (ConOfAbs a)) -> ConOfAbs a -> AbsToCon 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 :: WithHiding a -> AbsToCon (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))
    -> AbsToCon (ConOfAbs a) -> AbsToCon (WithHiding (ConOfAbs a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Hiding -> a -> AbsToCon (ConOfAbs a)
    forall h a.
    (LensHiding h, ToConcrete a) =>
    h -> a -> AbsToCon (ConOfAbs a)
    toConcreteHiding Hiding
    h a
    a
      bindToConcrete :: forall b.
    WithHiding a
    -> (ConOfAbs (WithHiding a) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (WithHiding Hiding
    h a
    a) ConOfAbs (WithHiding a) -> AbsToCon b
    ret = Hiding -> a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall h a b.
    (LensHiding h, ToConcrete a) =>
    h -> a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcreteHiding Hiding
    h a
    a ((ConOfAbs a -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs a
    a ->
        ConOfAbs (WithHiding a) -> AbsToCon b
    ret (ConOfAbs (WithHiding a) -> AbsToCon b)
    -> ConOfAbs (WithHiding a) -> AbsToCon 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 :: Named name a -> AbsToCon (ConOfAbs (Named name a))
    toConcrete (Named Maybe name
    n a
    x) = Maybe name -> ConOfAbs a -> Named name (ConOfAbs a)
    forall name a. Maybe name -> a -> Named name a
    Named Maybe name
    n (ConOfAbs a -> Named name (ConOfAbs a))
    -> AbsToCon (ConOfAbs a) -> AbsToCon (Named name (ConOfAbs a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete a
    x
        bindToConcrete :: forall b.
    Named name a
    -> (ConOfAbs (Named name a) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Named Maybe name
    n a
    x) ConOfAbs (Named name a) -> AbsToCon b
    ret = a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete a
    x ((ConOfAbs a -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Named name (ConOfAbs a) -> AbsToCon b
    ConOfAbs (Named name a) -> AbsToCon b
    ret (Named name (ConOfAbs a) -> AbsToCon b)
    -> (ConOfAbs a -> Named name (ConOfAbs a))
    -> ConOfAbs a
    -> AbsToCon 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

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

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

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

    instance ToConcrete BindName where
      type ConOfAbs BindName = C.BoundName

      toConcrete :: BindName -> AbsToCon (ConOfAbs BindName)
    toConcrete       = (Name -> BoundName) -> AbsToCon Name -> AbsToCon BoundName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name -> BoundName
    C.mkBoundName_ (AbsToCon Name -> AbsToCon BoundName)
    -> (BindName -> AbsToCon Name) -> BindName -> AbsToCon BoundName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> AbsToCon Name
    toConcreteName (Name -> AbsToCon Name)
    -> (BindName -> Name) -> BindName -> AbsToCon Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BindName -> Name
    unBind
      bindToConcrete :: forall b.
    BindName -> (ConOfAbs BindName -> AbsToCon b) -> AbsToCon b
    bindToConcrete BindName
    x = Name -> (Name -> AbsToCon b) -> AbsToCon b
    forall a. Name -> (Name -> AbsToCon a) -> AbsToCon a
    bindName (BindName -> Name
    unBind BindName
    x) ((Name -> AbsToCon b) -> AbsToCon b)
    -> ((BoundName -> AbsToCon b) -> Name -> AbsToCon b)
    -> (BoundName -> AbsToCon b)
    -> AbsToCon b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((BoundName -> AbsToCon b)
    -> (Name -> BoundName) -> Name -> AbsToCon 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 :: QName -> AbsToCon (ConOfAbs QName)
    toConcrete = AllowAmbiguousNames -> QName -> AbsToCon QName
    lookupQName AllowAmbiguousNames
    AmbiguousConProjs

    instance ToConcrete A.ModuleName where
      type ConOfAbs A.ModuleName = C.QName
      toConcrete :: ModuleName -> AbsToCon (ConOfAbs ModuleName)
    toConcrete = ModuleName -> AbsToCon QName
    ModuleName -> AbsToCon (ConOfAbs ModuleName)
    lookupModule

    instance ToConcrete AbstractName where
      type ConOfAbs AbstractName = C.QName
      toConcrete :: AbstractName -> AbsToCon (ConOfAbs AbstractName)
    toConcrete = QName -> AbsToCon QName
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (QName -> AbsToCon QName)
    -> (AbstractName -> QName) -> AbstractName -> AbsToCon 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 :: ResolvedName -> AbsToCon (ConOfAbs ResolvedName)
    toConcrete = \case
        VarName Name
    x BindingSource
    _          -> Name -> QName
    C.QName (Name -> QName) -> AbsToCon Name -> AbsToCon QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> AbsToCon (ConOfAbs Name)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Name
    x
        DefinedName Access
    _ AbstractName
    x Suffix
    s    -> Suffix -> AbsToCon QName -> AbsToCon QName
    forall (m :: * -> *). HasOptions m => Suffix -> m QName -> m QName
    addSuffixConcrete Suffix
    s (AbsToCon QName -> AbsToCon QName)
    -> AbsToCon QName -> AbsToCon QName
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> AbsToCon (ConOfAbs AbstractName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete AbstractName
    x
        FieldName List1 AbstractName
    xs         -> AbstractName -> AbsToCon (ConOfAbs AbstractName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (List1 AbstractName -> AbstractName
    forall a. NonEmpty a -> a
    NonEmpty.head List1 AbstractName
    xs)
        ConstructorName Set Induction
    _ List1 AbstractName
    xs -> AbstractName -> AbsToCon (ConOfAbs AbstractName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (List1 AbstractName -> AbstractName
    forall a. NonEmpty a -> a
    NonEmpty.head List1 AbstractName
    xs)
        PatternSynResName List1 AbstractName
    xs -> AbstractName -> AbsToCon (ConOfAbs AbstractName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (List1 AbstractName -> AbstractName
    forall a. NonEmpty a -> a
    NonEmpty.head List1 AbstractName
    xs)
        ResolvedName
    UnknownName          -> AbsToCon (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
      UnicodeOrAscii
    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
      UnicodeOrAscii -> Integer -> QName -> QName
    addSuffixConcrete' UnicodeOrAscii
    glyphMode Integer
    i (QName -> QName) -> m QName -> m QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m QName
    x

    addSuffixConcrete' :: UnicodeOrAscii -> Integer -> C.QName -> C.QName
    addSuffixConcrete' :: UnicodeOrAscii -> Integer -> QName -> QName
    addSuffixConcrete' UnicodeOrAscii
    glyphMode Integer
    i = Lens' (Maybe Suffix) QName -> LensSet (Maybe Suffix) QName
    forall i o. Lens' i o -> LensSet i o
    set ((Name -> f Name) -> QName -> f QName
    Lens' Name QName
    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' (Maybe Suffix) Name
    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 :: Expr -> AbsToCon (ConOfAbs Expr)
    toConcrete (Var Name
    x)             = QName -> Expr
    Ident (QName -> Expr) -> (Name -> QName) -> Name -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> QName
    C.QName (Name -> Expr) -> AbsToCon Name -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> AbsToCon (ConOfAbs Name)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Name
    x
        toConcrete (Def' QName
    x Suffix
    suffix)     = QName -> Expr
    Ident (QName -> Expr) -> AbsToCon QName -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Suffix -> AbsToCon QName -> AbsToCon QName
    forall (m :: * -> *). HasOptions m => Suffix -> m QName -> m QName
    addSuffixConcrete Suffix
    suffix (QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x)
        toConcrete (Proj ProjOrigin
    ProjPrefix AmbiguousQName
    p) = QName -> Expr
    Ident (QName -> Expr) -> AbsToCon QName -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    p)
        toConcrete (Proj ProjOrigin
    _          AmbiguousQName
    p) = Range -> Expr -> Expr
    C.Dot Range
    forall a. Range' a
    noRange (Expr -> Expr) -> (QName -> Expr) -> QName -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Expr
    Ident (QName -> Expr) -> AbsToCon QName -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    p)
        toConcrete (A.Macro QName
    x)         = QName -> Expr
    Ident (QName -> Expr) -> AbsToCon QName -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        toConcrete e :: Expr
    e@(Con AmbiguousQName
    c)           = Expr -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverPatternSyn Expr
    e (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ QName -> Expr
    Ident (QName -> Expr) -> AbsToCon QName -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    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 -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverPatternSyn Expr
    e (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ do
          QName
    x <- AllowAmbiguousNames -> QName -> AbsToCon QName
    lookupQName AllowAmbiguousNames
    AmbiguousNothing QName
    x
          let r :: Range
    r = ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i
          (PrecedenceStack -> Bool) -> AbsToCon Expr -> AbsToCon Expr
    bracket PrecedenceStack -> Bool
    appBrackets (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $
            Range -> Expr -> NamedArg Expr -> Expr
    C.App Range
    r (Range -> Expr
    C.Quote Range
    r) (Expr -> NamedArg Expr
    forall a. a -> NamedArg a
    defaultNamedArg (Expr -> NamedArg Expr) -> Expr -> NamedArg Expr
    forall a b. (a -> b) -> a -> b
    $ QName -> Expr
    C.Ident QName
    x)
        toConcrete e :: Expr
    e@(A.Lit ExprInfo
    i Literal
    l) = Expr -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverPatternSyn Expr
    e (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon 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
          Bool
    preserve <- (Env -> Bool) -> AbsToCon Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> Bool
    preserveIIds
          Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Maybe VerboseLevel -> Expr
    C.QuestionMark (MetaInfo -> Range
    forall a. HasRange a => a -> Range
    getRange MetaInfo
    i) (Maybe VerboseLevel -> Expr) -> Maybe VerboseLevel -> Expr
    forall a b. (a -> b) -> a -> b
    $
                     InteractionId -> VerboseLevel
    interactionId InteractionId
    ii VerboseLevel -> Maybe () -> Maybe VerboseLevel
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool
    preserve Bool -> Bool -> Bool
    || Maybe MetaId -> Bool
    forall a. Maybe a -> Bool
    isJust (MetaInfo -> Maybe MetaId
    metaNumber MetaInfo
    i))

        toConcrete (A.Underscore MetaInfo
    i)     = Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $
          Range -> Maybe RawName -> Expr
    C.Underscore (MetaInfo -> Range
    forall a. HasRange a => a -> Range
    getRange MetaInfo
    i) (Maybe RawName -> Expr) -> Maybe RawName -> Expr
    forall a b. (a -> b) -> a -> b
    $
            NamedMeta -> RawName
    forall a. Pretty a => a -> RawName
    prettyShow (NamedMeta -> RawName)
    -> (MetaId -> NamedMeta) -> MetaId -> RawName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RawName -> MetaId -> NamedMeta
    NamedMeta (MetaInfo -> RawName
    metaNameSuggestion MetaInfo
    i) (MetaId -> NamedMeta) -> (MetaId -> MetaId) -> MetaId -> NamedMeta
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VerboseLevel -> MetaId
    MetaId (VerboseLevel -> MetaId)
    -> (MetaId -> VerboseLevel) -> MetaId -> MetaId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MetaId -> VerboseLevel
    metaId (MetaId -> RawName) -> Maybe MetaId -> Maybe RawName
    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) =
          Range -> Expr -> Expr
    C.Dot (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) (Expr -> Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Expr
    e

        toConcrete e :: Expr
    e@(A.App AppInfo
    i Expr
    e1 NamedArg Expr
    e2) = do
          QName -> RawName -> Bool
    is <- AbsToCon (QName -> RawName -> 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 (Expr -> Maybe Hd
    getHead Expr
    e1, NamedArg Expr -> Expr
    forall a. NamedArg a -> a
    namedArg NamedArg Expr
    e2) of
            (Just (HdDef QName
    q), l :: Expr
    l@A.Lit{})
              | (RawName -> Bool) -> [RawName] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (QName -> RawName -> Bool
    is QName
    q) [RawName
    builtinFromNat, RawName
    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 -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Expr
    l
            (Just (HdDef QName
    q), A.Lit ExprInfo
    r (LitNat Integer
    n))
              | QName
    q QName -> RawName -> Bool
    `is` RawName
    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 -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (ExprInfo -> Literal -> Expr
    A.Lit ExprInfo
    r (Integer -> Literal
    LitNat (-Integer
    n)))
            (Maybe Hd, Expr)
    _ ->
              Expr -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverPatternSyn Expr
    e
              (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverOpApp Expr
    e
              (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverNatural Expr
    e
              -- or fallback to App
              (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ (PrecedenceStack -> Bool) -> AbsToCon Expr -> AbsToCon 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)
              (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ do Expr
    e1' <- Precedence -> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    FunctionCtx Expr
    e1
                   NamedArg Expr
    e2' <- Precedence -> NamedArg Expr -> AbsToCon (ConOfAbs (NamedArg Expr))
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx (ParenPreference -> Precedence
    ArgumentCtx (ParenPreference -> Precedence) -> ParenPreference -> Precedence
    forall a b. (a -> b) -> a -> b
    $ AppInfo -> ParenPreference
    appParens AppInfo
    i) NamedArg Expr
    e2
                   Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Expr -> NamedArg Expr -> Expr
    C.App (AppInfo -> Range
    forall a. HasRange a => a -> Range
    getRange AppInfo
    i) Expr
    e1' NamedArg Expr
    e2'

        toConcrete (A.WithApp ExprInfo
    i Expr
    e [Expr]
    es) =
          (PrecedenceStack -> Bool) -> AbsToCon Expr -> AbsToCon Expr
    bracket PrecedenceStack -> Bool
    withAppBrackets (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ do
            Expr
    e <- Precedence -> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    WithFunCtx Expr
    e
            [Expr]
    es <- (Expr -> AbsToCon Expr) -> [Expr] -> AbsToCon [Expr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Precedence -> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    WithArgCtx) [Expr]
    es
            Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Expr -> [Expr] -> Expr
    C.WithApp (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) Expr
    e [Expr]
    es

        toConcrete (A.AbsurdLam ExprInfo
    i Hiding
    h) =
          (PrecedenceStack -> Bool) -> AbsToCon Expr -> AbsToCon Expr
    bracket PrecedenceStack -> Bool
    lamBrackets (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon 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 -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverOpApp Expr
    e (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $   -- recover sections
            [LamBinding]
    -> (ConOfAbs [LamBinding] -> AbsToCon Expr) -> AbsToCon Expr
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete ((LamBinding -> LamBinding) -> [LamBinding] -> [LamBinding]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LamBinding -> LamBinding
    makeDomainFree [LamBinding]
    bs) ((ConOfAbs [LamBinding] -> AbsToCon Expr) -> AbsToCon Expr)
    -> (ConOfAbs [LamBinding] -> AbsToCon Expr) -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs [LamBinding]
    bs' -> do
              [LamBinding]
    -> AbsToCon Expr
    -> (List1 LamBinding -> AbsToCon Expr)
    -> AbsToCon 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 -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Expr
    e')
                {-else-} ((List1 LamBinding -> AbsToCon Expr) -> AbsToCon Expr)
    -> (List1 LamBinding -> AbsToCon Expr) -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ \ List1 LamBinding
    bs -> (PrecedenceStack -> Bool) -> AbsToCon Expr -> AbsToCon Expr
    bracket PrecedenceStack -> Bool
    lamBrackets (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon 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) -> AbsToCon Expr -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (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 TacticAttr
    _ 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 TacticAttr
    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
    -> TacticAttr -> List1 (NamedArg Binder) -> Expr -> TypedBinding
    A.TBind Range
    r TacticAttr
    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) -> AbsToCon Expr -> AbsToCon Expr
    bracket PrecedenceStack -> Bool
    lamBrackets (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ do
              [Declaration]
    decls <- NonEmpty [Declaration] -> [Declaration]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (NonEmpty [Declaration] -> [Declaration])
    -> AbsToCon (NonEmpty [Declaration]) -> AbsToCon [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> List1 Clause -> AbsToCon (ConOfAbs (List1 Clause))
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete List1 Clause
    cs
              let namedPat :: NamedArg Pattern -> Pattern
    namedPat NamedArg Pattern
    np = case NamedArg Pattern -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding NamedArg Pattern
    np of
                     Hiding
    NotHidden  -> NamedArg Pattern -> Pattern
    forall a. NamedArg a -> a
    namedArg NamedArg Pattern
    np
                     Hiding
    Hidden     -> Range -> Named_ Pattern -> Pattern
    C.HiddenP Range
    forall a. Range' a
    noRange (NamedArg Pattern -> Named_ Pattern
    forall e. Arg e -> e
    unArg NamedArg Pattern
    np)
                     Instance{} -> Range -> Named_ Pattern -> Pattern
    C.InstanceP Range
    forall a. Range' a
    noRange (NamedArg Pattern -> Named_ Pattern
    forall e. Arg e -> e
    unArg NamedArg 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 :: C.Pattern -> AbsToCon [C.Pattern]
                  removeApp :: Pattern -> AbsToCon [Pattern]
    removeApp (C.RawAppP Range
    _ (List2 Pattern
    _ Pattern
    p [Pattern]
    ps)) = [Pattern] -> AbsToCon [Pattern]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Pattern] -> AbsToCon [Pattern])
    -> [Pattern] -> AbsToCon [Pattern]
    forall a b. (a -> b) -> a -> b
    $ Pattern
    pPattern -> [Pattern] -> [Pattern]
    forall a. a -> [a] -> [a]
    :[Pattern]
    ps
                  removeApp (C.AppP (C.IdentP QName
    _) NamedArg Pattern
    np) = [Pattern] -> AbsToCon [Pattern]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [NamedArg Pattern -> Pattern
    namedPat NamedArg Pattern
    np]
                  removeApp (C.AppP Pattern
    p NamedArg Pattern
    np)            = Pattern -> AbsToCon [Pattern]
    removeApp Pattern
    p AbsToCon [Pattern]
    -> ([Pattern] -> [Pattern]) -> AbsToCon [Pattern]
    forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    <&> ([Pattern] -> [Pattern] -> [Pattern]
    forall a. [a] -> [a] -> [a]
    ++ [NamedArg Pattern -> Pattern
    namedPat NamedArg 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] -> AbsToCon [Pattern]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

                  removeApp Pattern
    p = do
                    RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "extendedlambda" VerboseLevel
    50 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ RawName
    "abstractToConcrete removeApp p = " RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> RawName
    forall a. Show a => a -> RawName
    show Pattern
    p
                    [Pattern] -> AbsToCon [Pattern]
    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 :: Declaration -> AbsToCon LamClause
    decl2clause (C.FunClause (C.LHS Pattern
    p [] []) RHS
    rhs WhereClause' [Declaration]
    C.NoWhere Bool
    ca) = do
                    RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "extendedlambda" VerboseLevel
    50 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ RawName
    "abstractToConcrete extended lambda pattern p = " RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> RawName
    forall a. Show a => a -> RawName
    show Pattern
    p
                    [Pattern]
    ps <- Pattern -> AbsToCon [Pattern]
    removeApp Pattern
    p
                    RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "extendedlambda" VerboseLevel
    50 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ RawName
    "abstractToConcrete extended lambda patterns ps = " RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ [Pattern] -> RawName
    forall a. Pretty a => a -> RawName
    prettyShow [Pattern]
    ps
                    LamClause -> AbsToCon LamClause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LamClause -> AbsToCon LamClause)
    -> LamClause -> AbsToCon LamClause
    forall a b. (a -> b) -> a -> b
    $ [Pattern] -> RHS -> Bool -> LamClause
    LamClause [Pattern]
    ps RHS
    rhs Bool
    ca
                  decl2clause Declaration
    _ = AbsToCon LamClause
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              Range -> Erased -> List1 LamClause -> Expr
    C.ExtendedLam (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) Erased
    erased (List1 LamClause -> Expr)
    -> ([LamClause] -> List1 LamClause) -> [LamClause] -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [LamClause] -> List1 LamClause
    forall a. [a] -> NonEmpty a
    List1.fromList ([LamClause] -> Expr) -> AbsToCon [LamClause] -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                (Declaration -> AbsToCon LamClause)
    -> [Declaration] -> AbsToCon [LamClause]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Declaration -> AbsToCon LamClause
    decl2clause [Declaration]
    decls
                -- TODO List1: can we demonstrate non-emptiness?

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

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

        toConcrete (A.Fun ExprInfo
    i Arg Expr
    a Expr
    b) =
            (PrecedenceStack -> Bool) -> AbsToCon Expr -> AbsToCon Expr
    bracket PrecedenceStack -> Bool
    piBrackets
            (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ do Arg Expr
    a' <- Precedence -> Arg Expr -> AbsToCon (ConOfAbs (Arg Expr))
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    ctx Arg Expr
    a
                 Expr
    b' <- Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcreteTop Expr
    b
                 let dom :: Arg Expr
    dom = Quantity -> Arg Expr -> Arg Expr
    forall a. LensQuantity a => Quantity -> a -> a
    setQuantity (Arg Expr -> Quantity
    forall a. LensQuantity a => a -> Quantity
    getQuantity 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, HasRange 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'
                 Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Arg Expr -> Expr -> Expr
    C.Fun (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) Arg Expr
    dom Expr
    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
                               Relevance
    Irrelevant -> Range -> Expr -> Expr
    C.Dot (a -> Range
    forall a. HasRange a => a -> Range
    getRange a
    a) Expr
    e
                               Relevance
    NonStrict  -> Range -> Expr -> Expr
    C.DoubleDot (a -> Range
    forall a. HasRange a => a -> Range
    getRange a
    a) Expr
    e
                               Relevance
    _          -> 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) -> AbsToCon Expr -> AbsToCon Expr
    bracket PrecedenceStack -> Bool
    lamBrackets
            (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ List1 LetBinding
    -> (ConOfAbs (List1 LetBinding) -> AbsToCon Expr) -> AbsToCon Expr
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete List1 LetBinding
    ds ((ConOfAbs (List1 LetBinding) -> AbsToCon Expr) -> AbsToCon Expr)
    -> (ConOfAbs (List1 LetBinding) -> AbsToCon Expr) -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ \ConOfAbs (List1 LetBinding)
    ds' -> do
                 Expr
    e'  <- Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcreteTop Expr
    e
                 Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> [Declaration] -> Expr -> Expr
    C.mkLet (ExprInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ExprInfo
    i) (NonEmpty [Declaration] -> [Declaration]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat NonEmpty [Declaration]
    ConOfAbs (List1 LetBinding)
    ds') Expr
    e'

        toConcrete (A.Rec ExprInfo
    i RecordAssigns
    fs) =
          (PrecedenceStack -> Bool) -> AbsToCon Expr -> AbsToCon Expr
    bracket PrecedenceStack -> Bool
    appBrackets (AbsToCon Expr -> AbsToCon Expr) -> AbsToCon Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ do
            Range -> RecordAssignments -> Expr
    C.Rec (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
     -> Either FieldAssignment ModuleAssignment)
    -> [Either FieldAssignment QName] -> RecordAssignments
    forall a b. (a -> b) -> [a] -> [b]
    map ((QName -> ModuleAssignment)
    -> Either FieldAssignment QName
    -> Either FieldAssignment ModuleAssignment
    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)
    -> AbsToCon [Either FieldAssignment QName] -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RecordAssigns -> AbsToCon (ConOfAbs RecordAssigns)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcreteTop RecordAssigns
    fs

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

        toConcrete (A.ETel Telescope
    tel) = Telescope -> Expr
    C.ETel (Telescope -> Expr)
    -> ([Maybe TypedBinding] -> Telescope)
    -> [Maybe TypedBinding]
    -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe TypedBinding] -> Telescope
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe TypedBinding] -> Expr)
    -> AbsToCon [Maybe TypedBinding] -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Telescope -> AbsToCon (ConOfAbs Telescope)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Telescope
    tel

        toConcrete (A.ScopedExpr ScopeInfo
    _ Expr
    e) = Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Expr
    e
        toConcrete (A.Quote ExprInfo
    i) = Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon 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 -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon 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 -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon 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) = Range -> Expr -> Expr
    C.Dot Range
    r (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) -> AbsToCon Expr -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    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) -> AbsToCon QName -> AbsToCon Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    n)

    makeDomainFree :: A.LamBinding -> A.LamBinding
    makeDomainFree :: LamBinding -> LamBinding
    makeDomainFree b :: LamBinding
    b@(A.DomainFull (A.TBind Range
    _ TacticAttr
    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} ->
          TacticAttr -> NamedArg Binder -> LamBinding
    A.DomainFree TacticAttr
    tac NamedArg Binder
    x
        Expr
    _ -> LamBinding
    b
    makeDomainFree LamBinding
    b = LamBinding
    b

    -- Christian Sattler, 2017-08-05, fixing #2669
    -- Both methods of ToConcrete (FieldAssignment' a) (FieldAssignment' c) need
    -- to be implemented, each in terms of the corresponding one of ToConcrete a c.
    -- This mirrors the instance ToConcrete (Arg a) (Arg c).
    -- The default implementations of ToConcrete are not valid semantically.
    instance ToConcrete a => ToConcrete (FieldAssignment' a) where
        type ConOfAbs (FieldAssignment' a) = FieldAssignment' (ConOfAbs a)
        toConcrete :: FieldAssignment' a -> AbsToCon (ConOfAbs (FieldAssignment' a))
    toConcrete = (a -> AbsToCon (ConOfAbs a))
    -> FieldAssignment' a -> AbsToCon (FieldAssignment' (ConOfAbs a))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete

        bindToConcrete :: forall b.
    FieldAssignment' a
    -> (ConOfAbs (FieldAssignment' a) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (FieldAssignment Name
    name a
    a) ConOfAbs (FieldAssignment' a) -> AbsToCon b
    ret =
          a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete a
    a ((ConOfAbs a -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ FieldAssignment' (ConOfAbs a) -> AbsToCon b
    ConOfAbs (FieldAssignment' a) -> AbsToCon b
    ret (FieldAssignment' (ConOfAbs a) -> AbsToCon b)
    -> (ConOfAbs a -> FieldAssignment' (ConOfAbs a))
    -> ConOfAbs a
    -> AbsToCon 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

    -- 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 RawName -> NamedName
    forall a. Origin -> a -> WithOrigin a
    WithOrigin Origin
    Inserted
             (Ranged RawName -> NamedName) -> Ranged RawName -> NamedName
    forall a b. (a -> b) -> a -> b
    $ Range -> RawName -> Ranged RawName
    forall a. Range -> a -> Ranged a
    Ranged (NamedArg Binder -> Range
    forall a. HasRange a => a -> Range
    getRange NamedArg Binder
    x)
             (RawName -> Ranged RawName) -> RawName -> Ranged RawName
    forall a b. (a -> b) -> a -> b
    $ Name -> RawName
    C.nameToRawName (Name -> RawName) -> Name -> RawName
    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 b.
    Binder' a -> (ConOfAbs (Binder' a) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (A.Binder Maybe Pattern
    p a
    a) ConOfAbs (Binder' a) -> AbsToCon b
    ret =
        a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete a
    a ((ConOfAbs a -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs a
    a ->
        Maybe Pattern
    -> (ConOfAbs (Maybe Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete Maybe Pattern
    p ((ConOfAbs (Maybe Pattern) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (Maybe Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (Maybe Pattern)
    p ->
        ConOfAbs (Binder' a) -> AbsToCon b
    ret (ConOfAbs (Binder' a) -> AbsToCon b)
    -> ConOfAbs (Binder' a) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Maybe Pattern -> ConOfAbs a -> Binder' (ConOfAbs a)
    forall a. Maybe Pattern -> a -> Binder' a
    C.Binder Maybe Pattern
    ConOfAbs (Maybe Pattern)
    p ConOfAbs a
    a

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

        bindToConcrete :: forall b.
    LamBinding -> (ConOfAbs LamBinding -> AbsToCon b) -> AbsToCon b
    bindToConcrete (A.DomainFree TacticAttr
    t NamedArg Binder
    x) ConOfAbs LamBinding -> AbsToCon b
    ret = do
          Maybe Expr
    t <- (Expr -> AbsToCon Expr) -> TacticAttr -> AbsToCon (Maybe Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Expr -> AbsToCon Expr
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete TacticAttr
    t
          let setTac :: BoundName -> BoundName
    setTac BoundName
    x = BoundName
    x { bnameTactic :: Maybe Expr
    bnameTactic = Maybe Expr
    t }
          NamedArg Binder
    -> (ConOfAbs (NamedArg Binder) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (NamedArg Binder -> NamedArg Binder
    forceNameIfHidden NamedArg Binder
    x) ((ConOfAbs (NamedArg Binder) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (NamedArg Binder) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $
            Maybe LamBinding -> AbsToCon b
    ConOfAbs LamBinding -> AbsToCon b
    ret (Maybe LamBinding -> AbsToCon b)
    -> (NamedArg (Binder' BoundName) -> Maybe LamBinding)
    -> NamedArg (Binder' BoundName)
    -> AbsToCon b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LamBinding -> Maybe LamBinding
    forall a. a -> Maybe a
    Just (LamBinding -> Maybe LamBinding)
    -> (NamedArg (Binder' BoundName) -> LamBinding)
    -> NamedArg (Binder' BoundName)
    -> Maybe LamBinding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedArg (Binder' BoundName) -> LamBinding
    forall a. NamedArg (Binder' BoundName) -> LamBinding' a
    C.DomainFree (NamedArg (Binder' BoundName) -> LamBinding)
    -> (NamedArg (Binder' BoundName) -> NamedArg (Binder' BoundName))
    -> NamedArg (Binder' BoundName)
    -> LamBinding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Binder' BoundName -> Binder' BoundName)
    -> NamedArg (Binder' BoundName) -> NamedArg (Binder' BoundName)
    forall a b. (a -> b) -> NamedArg a -> NamedArg b
    updateNamedArg ((BoundName -> BoundName) -> Binder' BoundName -> Binder' BoundName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BoundName -> BoundName
    setTac)
        bindToConcrete (A.DomainFull TypedBinding
    b) ConOfAbs LamBinding -> AbsToCon b
    ret = TypedBinding -> (ConOfAbs TypedBinding -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete TypedBinding
    b ((ConOfAbs TypedBinding -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs TypedBinding -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Maybe LamBinding -> AbsToCon b
    ConOfAbs LamBinding -> AbsToCon b
    ret (Maybe LamBinding -> AbsToCon b)
    -> (Maybe TypedBinding -> Maybe LamBinding)
    -> Maybe TypedBinding
    -> AbsToCon b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TypedBinding -> LamBinding)
    -> Maybe TypedBinding -> Maybe LamBinding
    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 b.
    TypedBinding -> (ConOfAbs TypedBinding -> AbsToCon b) -> AbsToCon b
    bindToConcrete (A.TBind Range
    r TacticAttr
    t List1 (NamedArg Binder)
    xs Expr
    e) ConOfAbs TypedBinding -> AbsToCon b
    ret = do
            Maybe Expr
    t <- (Expr -> AbsToCon Expr) -> TacticAttr -> AbsToCon (Maybe Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Expr -> AbsToCon Expr
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete TacticAttr
    t
            List1 (NamedArg Binder)
    -> (ConOfAbs (List1 (NamedArg Binder)) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete ((NamedArg Binder -> NamedArg Binder)
    -> List1 (NamedArg Binder) -> List1 (NamedArg Binder)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap NamedArg Binder -> NamedArg Binder
    forceNameIfHidden List1 (NamedArg Binder)
    xs) ((ConOfAbs (List1 (NamedArg Binder)) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (List1 (NamedArg Binder)) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (List1 (NamedArg Binder))
    xs -> do
              Expr
    e <- Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcreteTop Expr
    e
              let setTac :: BoundName -> BoundName
    setTac BoundName
    x = BoundName
    x { bnameTactic :: Maybe Expr
    bnameTactic = Maybe Expr
    t }
              ConOfAbs TypedBinding -> AbsToCon b
    ret (ConOfAbs TypedBinding -> AbsToCon b)
    -> ConOfAbs TypedBinding -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ TypedBinding -> Maybe TypedBinding
    forall a. a -> Maybe a
    Just (TypedBinding -> Maybe TypedBinding)
    -> TypedBinding -> Maybe TypedBinding
    forall a b. (a -> b) -> a -> b
    $ Range
    -> List1 (NamedArg (Binder' BoundName)) -> Expr -> TypedBinding
    forall e.
    Range
    -> List1 (NamedArg (Binder' BoundName)) -> e -> TypedBinding' e
    C.TBind Range
    r ((NamedArg (Binder' BoundName) -> NamedArg (Binder' BoundName))
    -> List1 (NamedArg (Binder' BoundName))
    -> List1 (NamedArg (Binder' BoundName))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Binder' BoundName -> Binder' BoundName)
    -> NamedArg (Binder' BoundName) -> NamedArg (Binder' BoundName)
    forall a b. (a -> b) -> NamedArg a -> NamedArg b
    updateNamedArg ((BoundName -> BoundName) -> Binder' BoundName -> Binder' BoundName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BoundName -> BoundName
    setTac)) List1 (NamedArg (Binder' BoundName))
    ConOfAbs (List1 (NamedArg Binder))
    xs) Expr
    e
        bindToConcrete (A.TLet Range
    r List1 LetBinding
    lbs) ConOfAbs TypedBinding -> AbsToCon b
    ret =
            List1 LetBinding
    -> (ConOfAbs (List1 LetBinding) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete List1 LetBinding
    lbs ((ConOfAbs (List1 LetBinding) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (List1 LetBinding) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (List1 LetBinding)
    ds -> do
            ConOfAbs TypedBinding -> AbsToCon b
    ret (ConOfAbs TypedBinding -> AbsToCon b)
    -> ConOfAbs TypedBinding -> AbsToCon 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 b.
    LetBinding -> (ConOfAbs LetBinding -> AbsToCon b) -> AbsToCon b
    bindToConcrete (A.LetBind LetInfo
    i ArgInfo
    info BindName
    x Expr
    t Expr
    e) ConOfAbs LetBinding -> AbsToCon b
    ret =
            BindName -> (ConOfAbs BindName -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete BindName
    x ((ConOfAbs BindName -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs BindName -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs BindName
    x ->
            do (Expr
    t, (RHS
    e, [], [], [])) <- (Expr, RHS) -> AbsToCon (ConOfAbs (Expr, RHS))
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (Expr
    t, Expr -> Maybe Expr -> RHS
    A.RHS Expr
    e Maybe Expr
    forall a. Maybe a
    Nothing)
               ConOfAbs LetBinding -> AbsToCon b
    ret (ConOfAbs LetBinding -> AbsToCon b)
    -> ConOfAbs LetBinding -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Maybe Range -> [Declaration] -> [Declaration]
    addInstanceB (if ArgInfo -> Bool
    forall a. LensHiding a => a -> Bool
    isInstance ArgInfo
    info then Range -> Maybe Range
    forall a. a -> Maybe a
    Just Range
    forall a. Range' a
    noRange else Maybe Range
    forall a. Maybe a
    Nothing) ([Declaration] -> [Declaration]) -> [Declaration] -> [Declaration]
    forall a b. (a -> b) -> a -> b
    $
                   [ ArgInfo -> Maybe Expr -> Name -> Expr -> Declaration
    C.TypeSig ArgInfo
    info Maybe Expr
    forall a. Maybe a
    Nothing (BoundName -> Name
    C.boundName BoundName
    ConOfAbs BindName
    x) Expr
    t
                   , LHS -> RHS -> WhereClause' [Declaration] -> Bool -> Declaration
    C.FunClause (Pattern -> [RewriteEqn] -> [WithExpr] -> LHS
    C.LHS (QName -> Pattern
    C.IdentP (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 Bool
    False
                   ]
        -- TODO: bind variables
        bindToConcrete (LetPatBind LetInfo
    i Pattern
    p Expr
    e) ConOfAbs LetBinding -> AbsToCon b
    ret = do
            Pattern
    p <- Pattern -> AbsToCon (ConOfAbs Pattern)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Pattern
    p
            Expr
    e <- Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Expr
    e
            ConOfAbs LetBinding -> AbsToCon b
    ret [ LHS -> RHS -> WhereClause' [Declaration] -> Bool -> Declaration
    C.FunClause (Pattern -> [RewriteEqn] -> [WithExpr] -> LHS
    C.LHS Pattern
    p [] []) (Expr -> RHS
    forall e. e -> RHS' e
    C.RHS Expr
    e) WhereClause' [Declaration]
    forall decls. WhereClause' decls
    NoWhere Bool
    False ]
        bindToConcrete (LetApply ModuleInfo
    i ModuleName
    x ModuleApplication
    modapp ScopeCopyInfo
    _ ImportDirective
    _) ConOfAbs LetBinding -> AbsToCon b
    ret = do
          Name
    x' <- QName -> Name
    unqualify (QName -> Name) -> AbsToCon QName -> AbsToCon Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ModuleName -> AbsToCon (ConOfAbs ModuleName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete ModuleName
    x
          ModuleApplication
    modapp <- ModuleApplication -> AbsToCon (ConOfAbs ModuleApplication)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete ModuleApplication
    modapp
          let r :: Range
    r = ModuleApplication -> Range
    forall a. HasRange a => a -> Range
    getRange ModuleApplication
    modapp
              open :: OpenShortHand
    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
    dir  = ImportDirective -> Maybe ImportDirective -> ImportDirective
    forall a. a -> Maybe a -> a
    fromMaybe ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir{ importDirRange :: Range
    importDirRange = Range
    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.
          (Env -> Env) -> AbsToCon b -> AbsToCon b
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (ModuleName -> ImportDirective -> (Scope -> Scope) -> Env -> Env
    openModule' ModuleName
    x ImportDirective
    dir Scope -> Scope
    forall a. a -> a
    id) (AbsToCon b -> AbsToCon b) -> AbsToCon b -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $
            ConOfAbs LetBinding -> AbsToCon b
    ret [ Range
    -> Name
    -> ModuleApplication
    -> OpenShortHand
    -> ImportDirective
    -> Declaration
    C.ModuleMacro (ModuleInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ModuleInfo
    i) Name
    x' ModuleApplication
    modapp OpenShortHand
    open ImportDirective
    dir ]
        bindToConcrete (LetOpen ModuleInfo
    i ModuleName
    x ImportDirective
    _) ConOfAbs LetBinding -> AbsToCon b
    ret = do
          QName
    x' <- ModuleName -> AbsToCon (ConOfAbs ModuleName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete ModuleName
    x
          let dir :: ImportDirective
    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
          (Env -> Env) -> AbsToCon b -> AbsToCon b
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (ModuleName -> ImportDirective -> (Scope -> Scope) -> Env -> Env
    openModule' ModuleName
    x ImportDirective
    dir Scope -> Scope
    restrictPrivate) (AbsToCon b -> AbsToCon b) -> AbsToCon b -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $
                ConOfAbs LetBinding -> AbsToCon b
    ret [ Range -> QName -> ImportDirective -> Declaration
    C.Open (ModuleInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ModuleInfo
    i) QName
    x' ImportDirective
    dir ]
        bindToConcrete (LetDeclaredVariable BindName
    _) ConOfAbs LetBinding -> AbsToCon b
    ret =
          -- Note that the range of the declaration site is dropped.
          ConOfAbs LetBinding -> AbsToCon b
    ret []

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

      bindToConcrete :: forall b.
    WhereDeclarations
    -> (ConOfAbs WhereDeclarations -> AbsToCon b) -> AbsToCon b
    bindToConcrete (A.WhereDecls Maybe ModuleName
    _ Maybe Declaration
    Nothing) ConOfAbs WhereDeclarations -> AbsToCon b
    ret = ConOfAbs WhereDeclarations -> AbsToCon b
    ret ConOfAbs WhereDeclarations
    forall decls. WhereClause' decls
    C.NoWhere
      bindToConcrete (A.WhereDecls (Just ModuleName
    am) (Just (A.Section Range
    _ ModuleName
    _ GeneralizeTelescope
    _ [Declaration]
    ds))) ConOfAbs WhereDeclarations -> AbsToCon b
    ret = do
        [Declaration]
    ds' <- [Declaration] -> AbsToCon [Declaration]
    declsToConcrete [Declaration]
    ds
        Name
    cm  <- QName -> Name
    unqualify (QName -> Name) -> AbsToCon QName -> AbsToCon Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ModuleName -> AbsToCon QName
    lookupModule ModuleName
    am
        -- Andreas, 2016-07-08 I put PublicAccess in the following SomeWhere
        -- Should not really matter for printing...
        let wh' :: WhereClause' [Declaration]
    wh' = (if Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    cm then Range -> [Declaration] -> WhereClause' [Declaration]
    forall decls. Range -> decls -> WhereClause' decls
    AnyWhere Range
    forall a. Range' a
    noRange else Range
    -> Name -> Access -> [Declaration] -> WhereClause' [Declaration]
    forall decls.
    Range -> Name -> Access -> decls -> WhereClause' decls
    SomeWhere Range
    forall a. Range' a
    noRange Name
    cm Access
    PublicAccess) ([Declaration] -> WhereClause' [Declaration])
    -> [Declaration] -> WhereClause' [Declaration]
    forall a b. (a -> b) -> a -> b
    $ [Declaration]
    ds'
        (Env -> Env) -> AbsToCon b -> AbsToCon b
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (ModuleName -> ImportDirective -> (Scope -> Scope) -> Env -> Env
    openModule' ModuleName
    am ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir Scope -> Scope
    forall a. a -> a
    id) (AbsToCon b -> AbsToCon b) -> AbsToCon b -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ ConOfAbs WhereDeclarations -> AbsToCon b
    ret WhereClause' [Declaration]
    ConOfAbs WhereDeclarations
    wh'
      bindToConcrete (A.WhereDecls Maybe ModuleName
    _ (Just Declaration
    d)) ConOfAbs WhereDeclarations -> AbsToCon b
    ret =
        WhereClause' [Declaration] -> AbsToCon b
    ConOfAbs WhereDeclarations -> AbsToCon b
    ret (WhereClause' [Declaration] -> AbsToCon b)
    -> ([Declaration] -> WhereClause' [Declaration])
    -> [Declaration]
    -> AbsToCon 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] -> AbsToCon b)
    -> AbsToCon [Declaration] -> AbsToCon b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Declaration -> AbsToCon (ConOfAbs Declaration)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Declaration
    d

    mergeSigAndDef :: [C.Declaration] -> [C.Declaration]
    mergeSigAndDef :: [Declaration] -> [Declaration]
    mergeSigAndDef (C.RecordSig Range
    _ Name
    x [LamBinding]
    bs Expr
    e : C.RecordDef Range
    r Name
    y RecordDirectives
    dir [LamBinding]
    _ [Declaration]
    fs : [Declaration]
    ds)
      | Name
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    y = Range
    -> Name
    -> RecordDirectives
    -> [LamBinding]
    -> Expr
    -> [Declaration]
    -> Declaration
    C.Record Range
    r Name
    y RecordDirectives
    dir [LamBinding]
    bs Expr
    e [Declaration]
    fs Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    : [Declaration] -> [Declaration]
    mergeSigAndDef [Declaration]
    ds
    mergeSigAndDef (C.DataSig Range
    _ 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
    -> Name -> [LamBinding] -> Expr -> [Declaration] -> Declaration
    C.Data Range
    r 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 :: ScopeInfo
    currentScope = Lens' (Map ModuleName Scope) ScopeInfo
    -> LensSet (Map ModuleName Scope) ScopeInfo
    forall i o. Lens' i o -> LensSet i o
    set Lens' (Map ModuleName Scope) ScopeInfo
    scopeModules Map ModuleName Scope
    mods' ScopeInfo
    sInfo}
      where sInfo :: ScopeInfo
    sInfo = Env -> ScopeInfo
    currentScope Env
    env
            amod :: ModuleName
    amod  = ScopeInfo
    sInfo ScopeInfo -> Lens' ModuleName ScopeInfo -> ModuleName
    forall o i. o -> Lens' i o -> i
    ^. Lens' ModuleName ScopeInfo
    scopeCurrent
            mods :: Map ModuleName Scope
    mods  = ScopeInfo
    sInfo ScopeInfo
    -> Lens' (Map ModuleName Scope) ScopeInfo -> Map ModuleName Scope
    forall o i. o -> Lens' i o -> i
    ^. Lens' (Map ModuleName Scope) ScopeInfo
    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 :: [A.Declaration] -> AbsToCon [C.Declaration]
    declsToConcrete :: [Declaration] -> AbsToCon [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])
    -> AbsToCon [[Declaration]] -> AbsToCon [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Declaration] -> AbsToCon (ConOfAbs [Declaration])
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete [Declaration]
    ds

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

        toConcrete :: RHS -> AbsToCon (ConOfAbs RHS)
    toConcrete (A.RHS Expr
    e (Just Expr
    c)) = (RHS, [RewriteEqn], [WithExpr], [Declaration])
    -> AbsToCon (RHS, [RewriteEqn], [WithExpr], [Declaration])
    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
          Expr
    e <- Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Expr
    e
          (RHS, [RewriteEqn], [WithExpr], [Declaration])
    -> AbsToCon (RHS, [RewriteEqn], [WithExpr], [Declaration])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> RHS
    forall e. e -> RHS' e
    C.RHS Expr
    e, [], [], [])
        toConcrete RHS
    A.AbsurdRHS = (RHS, [RewriteEqn], [WithExpr], [Declaration])
    -> AbsToCon (RHS, [RewriteEqn], [WithExpr], [Declaration])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RHS
    forall e. RHS' e
    C.AbsurdRHS, [], [], [])
        toConcrete (A.WithRHS QName
    _ [WithExpr]
    es [Clause]
    cs) = do
          [WithExpr]
    es <- do [Named BindName (Arg Expr)]
    es <- [WithExpr] -> AbsToCon (ConOfAbs [WithExpr])
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete [WithExpr]
    es
                   [Named BindName (Arg Expr)]
    -> (Named BindName (Arg Expr) -> AbsToCon WithExpr)
    -> AbsToCon [WithExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Named BindName (Arg Expr)]
    es ((Named BindName (Arg Expr) -> AbsToCon WithExpr)
     -> AbsToCon [WithExpr])
    -> (Named BindName (Arg Expr) -> AbsToCon WithExpr)
    -> AbsToCon [WithExpr]
    forall a b. (a -> b) -> a -> b
    $ \ (Named Maybe BindName
    n Arg Expr
    e) -> do
                     Maybe BoundName
    n <- (BindName -> AbsToCon BoundName)
    -> Maybe BindName -> AbsToCon (Maybe BoundName)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse BindName -> AbsToCon BoundName
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Maybe BindName
    n
                     WithExpr -> AbsToCon WithExpr
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (WithExpr -> AbsToCon WithExpr) -> WithExpr -> AbsToCon WithExpr
    forall a b. (a -> b) -> a -> b
    $ Maybe Name -> Arg Expr -> WithExpr
    forall name a. Maybe name -> a -> Named name a
    Named (BoundName -> Name
    C.boundName (BoundName -> Name) -> Maybe BoundName -> Maybe Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe BoundName
    n) Arg Expr
    e
          [Declaration]
    cs <- AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall a. AbsToCon a -> AbsToCon a
    noTakenNames (AbsToCon [Declaration] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $ [[Declaration]] -> [Declaration]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Declaration]] -> [Declaration])
    -> AbsToCon [[Declaration]] -> AbsToCon [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Clause] -> AbsToCon (ConOfAbs [Clause])
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete [Clause]
    cs
          (RHS, [RewriteEqn], [WithExpr], [Declaration])
    -> AbsToCon (RHS, [RewriteEqn], [WithExpr], [Declaration])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RHS
    forall e. RHS' e
    C.AbsurdRHS, [], [WithExpr]
    es, [Declaration]
    cs)
        toConcrete (A.RewriteRHS [RewriteEqn]
    xeqs [ProblemEq]
    _spats RHS
    rhs WhereDeclarations
    wh) = do
          [Declaration]
    wh <- AbsToCon [Declaration]
    -> (Declaration -> AbsToCon [Declaration])
    -> Maybe Declaration
    -> AbsToCon [Declaration]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Declaration] -> AbsToCon [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []) Declaration -> AbsToCon [Declaration]
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (Maybe Declaration -> AbsToCon [Declaration])
    -> Maybe Declaration -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $ WhereDeclarations -> Maybe Declaration
    A.whereDecls WhereDeclarations
    wh
          (RHS
    rhs, [RewriteEqn]
    eqs', [WithExpr]
    es, [Declaration]
    whs) <- RHS -> AbsToCon (ConOfAbs RHS)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete RHS
    rhs
          Bool -> AbsToCon () -> AbsToCon ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([RewriteEqn] -> Bool
    forall a. Null a => a -> Bool
    null [RewriteEqn]
    eqs') AbsToCon ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          [RewriteEqn]
    eqs <- [RewriteEqn] -> AbsToCon (ConOfAbs [RewriteEqn])
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete [RewriteEqn]
    xeqs
          (RHS, [RewriteEqn], [WithExpr], [Declaration])
    -> AbsToCon (RHS, [RewriteEqn], [WithExpr], [Declaration])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RHS
    rhs, [RewriteEqn]
    eqs, [WithExpr]
    es, [Declaration]
    wh [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    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 :: RewriteEqn' qn BindName p a
    -> AbsToCon (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))
    -> AbsToCon (List1 ((), ConOfAbs a))
    -> AbsToCon (RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((qn, a) -> AbsToCon ((), ConOfAbs a))
    -> List1 (qn, a) -> AbsToCon (List1 ((), ConOfAbs a))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (((), a) -> AbsToCon ((), ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (((), a) -> AbsToCon ((), ConOfAbs a))
    -> ((qn, a) -> ((), a)) -> (qn, a) -> AbsToCon ((), 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))
     -> RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a))
    -> AbsToCon (List1 (Named Name (ConOfAbs p, ConOfAbs a)))
    -> AbsToCon (RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a))
    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 ()) (AbsToCon (List1 (Named Name (ConOfAbs p, ConOfAbs a)))
     -> AbsToCon (RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a)))
    -> AbsToCon (List1 (Named Name (ConOfAbs p, ConOfAbs a)))
    -> AbsToCon (RewriteEqn' () Name (ConOfAbs p) (ConOfAbs a))
    forall a b. (a -> b) -> a -> b
    $ List1 (Named BindName (p, a))
    -> (Named BindName (p, a)
        -> AbsToCon (Named Name (ConOfAbs p, ConOfAbs a)))
    -> AbsToCon (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)
      -> AbsToCon (Named Name (ConOfAbs p, ConOfAbs a)))
     -> AbsToCon (List1 (Named Name (ConOfAbs p, ConOfAbs a))))
    -> (Named BindName (p, a)
        -> AbsToCon (Named Name (ConOfAbs p, ConOfAbs a)))
    -> AbsToCon (List1 (Named Name (ConOfAbs p, ConOfAbs a)))
    forall a b. (a -> b) -> a -> b
    $ \ (Named Maybe BindName
    n (p, a)
    pe) -> do
          (ConOfAbs p, ConOfAbs a)
    pe <- (p, a) -> AbsToCon (ConOfAbs (p, a))
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (p, a)
    pe
          Maybe Name
    n  <- Maybe BindName -> AbsToCon (ConOfAbs (Maybe BindName))
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Maybe BindName
    n
          Named Name (ConOfAbs p, ConOfAbs a)
    -> AbsToCon (Named Name (ConOfAbs p, ConOfAbs a))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Named Name (ConOfAbs p, ConOfAbs a)
     -> AbsToCon (Named Name (ConOfAbs p, ConOfAbs a)))
    -> Named Name (ConOfAbs p, ConOfAbs a)
    -> AbsToCon (Named Name (ConOfAbs p, ConOfAbs a))
    forall a b. (a -> b) -> a -> b
    $ Maybe Name
    -> (ConOfAbs p, ConOfAbs a) -> Named Name (ConOfAbs p, ConOfAbs a)
    forall name a. Maybe name -> a -> Named name a
    Named Maybe Name
    n (ConOfAbs p, ConOfAbs a)
    pe

    instance ToConcrete (Maybe A.BindName) where
      type ConOfAbs (Maybe A.BindName) = Maybe C.Name
      toConcrete :: Maybe BindName -> AbsToCon (ConOfAbs (Maybe BindName))
    toConcrete = (BindName -> AbsToCon Name)
    -> Maybe BindName -> AbsToCon (Maybe Name)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (BoundName -> Name
    C.boundName (BoundName -> Name)
    -> (BindName -> AbsToCon BoundName) -> BindName -> AbsToCon Name
    forall (m :: * -> *) b c a.
    Functor m =>
    (b -> c) -> (a -> m b) -> a -> m c
    <.> BindName -> AbsToCon BoundName
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete)

    instance ToConcrete (Maybe A.QName) where
      type ConOfAbs (Maybe A.QName) = Maybe C.Name

      toConcrete :: Maybe QName -> AbsToCon (ConOfAbs (Maybe QName))
    toConcrete = (QName -> AbsToCon Name) -> Maybe QName -> AbsToCon (Maybe Name)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Name -> AbsToCon Name
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (Name -> AbsToCon Name)
    -> (QName -> Name) -> QName -> AbsToCon Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Name
    qnameName)

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

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

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

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

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

      toConcrete :: ModuleApplication -> AbsToCon (ConOfAbs ModuleApplication)
    toConcrete (A.SectionApp Telescope
    tel ModuleName
    y [NamedArg Expr]
    es) = do
        QName
    y  <- Precedence -> ModuleName -> AbsToCon (ConOfAbs ModuleName)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    FunctionCtx ModuleName
    y
        Telescope
    -> (ConOfAbs Telescope -> AbsToCon ModuleApplication)
    -> AbsToCon ModuleApplication
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete Telescope
    tel ((ConOfAbs Telescope -> AbsToCon ModuleApplication)
     -> AbsToCon ModuleApplication)
    -> (ConOfAbs Telescope -> AbsToCon ModuleApplication)
    -> AbsToCon ModuleApplication
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs Telescope
    tel -> do
          [NamedArg Expr]
    es <- Precedence
    -> [NamedArg Expr] -> AbsToCon (ConOfAbs [NamedArg Expr])
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    argumentCtx_ [NamedArg Expr]
    es
          let r :: Range
    r = QName -> [NamedArg Expr] -> Range
    forall u t. (HasRange u, HasRange t) => u -> t -> Range
    fuseRange QName
    y [NamedArg Expr]
    es
          ModuleApplication -> AbsToCon ModuleApplication
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleApplication -> AbsToCon ModuleApplication)
    -> ModuleApplication -> AbsToCon ModuleApplication
    forall a b. (a -> b) -> a -> b
    $ Range -> Telescope -> Expr -> ModuleApplication
    C.SectionApp Range
    r ([Maybe TypedBinding] -> Telescope
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe TypedBinding]
    ConOfAbs Telescope
    tel) ((Expr -> NamedArg Expr -> Expr) -> Expr -> [NamedArg Expr] -> Expr
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (Range -> Expr -> NamedArg Expr -> Expr
    C.App Range
    r) (QName -> Expr
    C.Ident QName
    y) [NamedArg Expr]
    es)

      toConcrete (A.RecordModuleInstance ModuleName
    recm) = do
        QName
    recm <- ModuleName -> AbsToCon (ConOfAbs ModuleName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete ModuleName
    recm
        ModuleApplication -> AbsToCon ModuleApplication
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleApplication -> AbsToCon ModuleApplication)
    -> ModuleApplication -> AbsToCon ModuleApplication
    forall a b. (a -> b) -> a -> b
    $ Range -> QName -> ModuleApplication
    C.RecordModuleInstance (QName -> Range
    forall a. HasRange a => a -> Range
    getRange QName
    recm) QName
    recm

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

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

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

      toConcrete (A.Generalize Set QName
    s DefInfo
    i ArgInfo
    j QName
    x Expr
    t) = do
        Name
    x' <- QName -> Name
    unsafeQNameToName (QName -> Name) -> AbsToCon QName -> AbsToCon Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        Maybe Expr
    tac <- (Expr -> AbsToCon Expr) -> TacticAttr -> AbsToCon (Maybe Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Expr -> AbsToCon Expr
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (DefInfo -> TacticAttr
    forall t. DefInfo' t -> Maybe t
    defTactic DefInfo
    i)
        DefInfo -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    withAbstractPrivate DefInfo
    i (AbsToCon [Declaration] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $
          DefInfo -> Name -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    withInfixDecl DefInfo
    i Name
    x'  (AbsToCon [Declaration] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $ do
          Expr
    t' <- Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcreteTop Expr
    t
          [Declaration] -> AbsToCon [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Range -> [Declaration] -> Declaration
    C.Generalize (DefInfo -> Range
    forall a. HasRange a => a -> Range
    getRange DefInfo
    i) [ArgInfo -> Maybe Expr -> Name -> Expr -> Declaration
    C.TypeSig ArgInfo
    j Maybe Expr
    tac Name
    x' (Expr -> Declaration) -> Expr -> Declaration
    forall a b. (a -> b) -> a -> b
    $ Expr -> Expr
    C.Generalized Expr
    t']]

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

      toConcrete (A.Primitive DefInfo
    i QName
    x Arg Expr
    t) = do
        Name
    x' <- QName -> Name
    unsafeQNameToName (QName -> Name) -> AbsToCon QName -> AbsToCon Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        DefInfo -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    withAbstractPrivate DefInfo
    i (AbsToCon [Declaration] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $
          DefInfo -> Name -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    withInfixDecl DefInfo
    i Name
    x'  (AbsToCon [Declaration] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $ do
          Arg Expr
    t' <- (Expr -> AbsToCon Expr) -> Arg Expr -> AbsToCon (Arg Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Expr -> AbsToCon Expr
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcreteTop Arg Expr
    t
          [Declaration] -> AbsToCon [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Range -> [Declaration] -> Declaration
    C.Primitive (DefInfo -> Range
    forall a. HasRange a => a -> Range
    getRange DefInfo
    i) [ArgInfo -> Maybe Expr -> Name -> Expr -> Declaration
    C.TypeSig (Arg Expr -> ArgInfo
    forall e. Arg e -> ArgInfo
    argInfo Arg Expr
    t') Maybe Expr
    forall a. Maybe a
    Nothing Name
    x' (Arg Expr -> Expr
    forall e. Arg e -> e
    unArg Arg Expr
    t')]]
            -- Primitives are always relevant.

      toConcrete (A.FunDef DefInfo
    i QName
    _ Delayed
    _ [Clause]
    cs) =
        DefInfo -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    withAbstractPrivate DefInfo
    i (AbsToCon [Declaration] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $ [[Declaration]] -> [Declaration]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Declaration]] -> [Declaration])
    -> AbsToCon [[Declaration]] -> AbsToCon [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Clause] -> AbsToCon (ConOfAbs [Clause])
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete [Clause]
    cs

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

      toConcrete (A.DataDef DefInfo
    i QName
    x UniverseCheck
    uc DataDefParams
    bs [Declaration]
    cs) =
        DefInfo -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    withAbstractPrivate DefInfo
    i (AbsToCon [Declaration] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        [LamBinding]
    -> (ConOfAbs [LamBinding] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration]
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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] -> AbsToCon [Declaration])
     -> AbsToCon [Declaration])
    -> (ConOfAbs [LamBinding] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs [LamBinding]
    tel' -> do
          (Name
    x',[Declaration]
    cs') <- (QName -> Name) -> (QName, [Declaration]) -> (Name, [Declaration])
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first QName -> Name
    unsafeQNameToName ((QName, [Declaration]) -> (Name, [Declaration]))
    -> AbsToCon (QName, [Declaration])
    -> AbsToCon (Name, [Declaration])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (QName, [Constr Declaration])
    -> AbsToCon (ConOfAbs (QName, [Constr Declaration]))
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    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)
          [Declaration] -> AbsToCon [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Range -> Name -> [LamBinding] -> [Declaration] -> Declaration
    C.DataDef (DefInfo -> Range
    forall a. HasRange a => a -> Range
    getRange DefInfo
    i) Name
    x' ([Maybe LamBinding] -> [LamBinding]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe LamBinding]
    ConOfAbs [LamBinding]
    tel') [Declaration]
    cs' ]

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

      toConcrete (A.RecDef  DefInfo
    i QName
    x UniverseCheck
    uc RecordDirectives
    dir DataDefParams
    bs Expr
    t [Declaration]
    cs) =
        DefInfo -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    withAbstractPrivate DefInfo
    i (AbsToCon [Declaration] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration] -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        [LamBinding]
    -> (ConOfAbs [LamBinding] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration]
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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] -> AbsToCon [Declaration])
     -> AbsToCon [Declaration])
    -> (ConOfAbs [LamBinding] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs [LamBinding]
    tel' -> do
          (Name
    x',[Declaration]
    cs') <- (QName -> Name) -> (QName, [Declaration]) -> (Name, [Declaration])
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first QName -> Name
    unsafeQNameToName ((QName, [Declaration]) -> (Name, [Declaration]))
    -> AbsToCon (QName, [Declaration])
    -> AbsToCon (Name, [Declaration])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (QName, [Constr Declaration])
    -> AbsToCon (ConOfAbs (QName, [Constr Declaration]))
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    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)
          [Declaration] -> AbsToCon [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Range
    -> Name
    -> RecordDirectives
    -> [LamBinding]
    -> [Declaration]
    -> Declaration
    C.RecordDef (DefInfo -> Range
    forall a. HasRange a => a -> Range
    getRange DefInfo
    i) Name
    x' (RecordDirectives
    dir { recConstructor :: Maybe (Name, IsInstance)
    recConstructor = Maybe (Name, IsInstance)
    forall a. Maybe a
    Nothing }) ([Maybe LamBinding] -> [LamBinding]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe LamBinding]
    ConOfAbs [LamBinding]
    tel') [Declaration]
    cs' ]

      toConcrete (A.Mutual MutualInfo
    i [Declaration]
    ds) = [Declaration] -> AbsToCon [Declaration]
    declsToConcrete [Declaration]
    ds

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

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

      toConcrete (A.Import ModuleInfo
    i ModuleName
    x ImportDirective
    _) = do
        QName
    x <- ModuleName -> AbsToCon (ConOfAbs ModuleName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete ModuleName
    x
        let open :: OpenShortHand
    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
    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
        [Declaration] -> AbsToCon [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Range
    -> QName
    -> Maybe AsName
    -> OpenShortHand
    -> ImportDirective
    -> Declaration
    C.Import (ModuleInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ModuleInfo
    i) QName
    x Maybe AsName
    forall a. Maybe a
    Nothing OpenShortHand
    open ImportDirective
    dir]

      toConcrete (A.Pragma Range
    i Pragma
    p)     = do
        Pragma
    p <- RangeAndPragma -> AbsToCon (ConOfAbs RangeAndPragma)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (RangeAndPragma -> AbsToCon (ConOfAbs RangeAndPragma))
    -> RangeAndPragma -> AbsToCon (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
        [Declaration] -> AbsToCon [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Pragma -> Declaration
    C.Pragma Pragma
    p]

      toConcrete (A.Open ModuleInfo
    i ModuleName
    x ImportDirective
    _) = do
        QName
    x <- ModuleName -> AbsToCon (ConOfAbs ModuleName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete ModuleName
    x
        [Declaration] -> AbsToCon [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Range -> QName -> ImportDirective -> Declaration
    C.Open (ModuleInfo -> Range
    forall a. HasRange a => a -> Range
    getRange ModuleInfo
    i) QName
    x ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir]

      toConcrete (A.PatternSynDef QName
    x [Arg BindName]
    xs Pattern' Void
    p) = do
        C.QName Name
    x <- QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        [Arg Name]
    -> (ConOfAbs [Arg Name] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration]
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete ((Arg BindName -> Arg Name) -> [Arg BindName] -> [Arg Name]
    forall a b. (a -> b) -> [a] -> [b]
    map ((BindName -> Name) -> Arg BindName -> Arg Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BindName -> Name
    A.unBind) [Arg BindName]
    xs) ((ConOfAbs [Arg Name] -> AbsToCon [Declaration])
     -> AbsToCon [Declaration])
    -> (ConOfAbs [Arg Name] -> AbsToCon [Declaration])
    -> AbsToCon [Declaration]
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs [Arg 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 -> [Arg Name] -> Pattern -> Declaration
    C.PatternSyn (Name -> Range
    forall a. HasRange a => a -> Range
    getRange Name
    x) Name
    x [Arg Name]
    ConOfAbs [Arg Name]
    xs (Pattern -> [Declaration])
    -> AbsToCon Pattern -> AbsToCon [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
            AbsToCon Pattern -> AbsToCon Pattern
    forall a. AbsToCon a -> AbsToCon a
    dontFoldPatternSynonyms (AbsToCon Pattern -> AbsToCon Pattern)
    -> AbsToCon Pattern -> AbsToCon Pattern
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon (ConOfAbs Pattern)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (Pattern' Void -> Pattern
    forall (f :: * -> *) a. Functor f => f Void -> f a
    vacuous Pattern' Void
    p :: A.Pattern)

      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 (m :: * -> *) a. Monad m => a -> m a
    return Name
    x
            unqual QName
    _           = m Name
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        [Name]
    xs <- (QName -> AbsToCon Name) -> [QName] -> AbsToCon [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (QName -> AbsToCon Name
    forall {m :: * -> *}. Monad m => QName -> m Name
    unqual (QName -> AbsToCon Name)
    -> (QName -> AbsToCon QName) -> QName -> AbsToCon Name
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< QName -> AbsToCon QName
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete) [QName]
    xs
        (Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    :[]) (Declaration -> [Declaration])
    -> (Expr -> Declaration) -> Expr -> [Declaration]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> [Name] -> Expr -> Declaration
    C.UnquoteDecl ([DefInfo] -> Range
    forall a. HasRange a => a -> Range
    getRange [DefInfo]
    i) [Name]
    xs (Expr -> [Declaration]) -> AbsToCon Expr -> AbsToCon [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Expr
    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 (m :: * -> *) a. Monad m => a -> m a
    return Name
    x
            unqual QName
    _           = m Name
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        [Name]
    xs <- (QName -> AbsToCon Name) -> [QName] -> AbsToCon [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (QName -> AbsToCon Name
    forall {m :: * -> *}. Monad m => QName -> m Name
    unqual (QName -> AbsToCon Name)
    -> (QName -> AbsToCon QName) -> QName -> AbsToCon Name
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< QName -> AbsToCon QName
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete) [QName]
    xs
        (Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    :[]) (Declaration -> [Declaration])
    -> (Expr -> Declaration) -> Expr -> [Declaration]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> [Name] -> Expr -> Declaration
    C.UnquoteDef ([DefInfo] -> Range
    forall a. HasRange a => a -> Range
    getRange [DefInfo]
    i) [Name]
    xs (Expr -> [Declaration]) -> AbsToCon Expr -> AbsToCon [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Expr
    e

    data RangeAndPragma = RangeAndPragma Range A.Pragma

    instance ToConcrete RangeAndPragma where
      type ConOfAbs RangeAndPragma = C.Pragma

      toConcrete :: RangeAndPragma -> AbsToCon (ConOfAbs RangeAndPragma)
    toConcrete (RangeAndPragma Range
    r Pragma
    p) = case Pragma
    p of
        A.OptionsPragma [RawName]
    xs  -> Pragma -> AbsToCon Pragma
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pragma -> AbsToCon Pragma) -> Pragma -> AbsToCon Pragma
    forall a b. (a -> b) -> a -> b
    $ Range -> [RawName] -> Pragma
    C.OptionsPragma Range
    r [RawName]
    xs
        A.BuiltinPragma Ranged RawName
    b ResolvedName
    x       -> Range -> Ranged RawName -> QName -> Pragma
    C.BuiltinPragma Range
    r Ranged RawName
    b (QName -> Pragma) -> AbsToCon QName -> AbsToCon Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ResolvedName -> AbsToCon (ConOfAbs ResolvedName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete ResolvedName
    x
        A.BuiltinNoDefPragma Ranged RawName
    b KindOfName
    _kind QName
    x -> Range -> Ranged RawName -> QName -> Pragma
    C.BuiltinPragma Range
    r Ranged RawName
    b (QName -> Pragma) -> AbsToCon QName -> AbsToCon Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        A.RewritePragma Range
    r' [QName]
    x      -> Range -> Range -> [QName] -> Pragma
    C.RewritePragma Range
    r Range
    r' ([QName] -> Pragma) -> AbsToCon [QName] -> AbsToCon Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [QName] -> AbsToCon (ConOfAbs [QName])
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete [QName]
    x
        A.CompilePragma Ranged RawName
    b QName
    x RawName
    s -> do
          QName
    x <- QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
          Pragma -> AbsToCon Pragma
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pragma -> AbsToCon Pragma) -> Pragma -> AbsToCon Pragma
    forall a b. (a -> b) -> a -> b
    $ Range -> Ranged RawName -> QName -> RawName -> Pragma
    C.CompilePragma Range
    r Ranged RawName
    b QName
    x RawName
    s
        A.StaticPragma QName
    x -> Range -> QName -> Pragma
    C.StaticPragma Range
    r (QName -> Pragma) -> AbsToCon QName -> AbsToCon Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        A.InjectivePragma QName
    x -> Range -> QName -> Pragma
    C.InjectivePragma Range
    r (QName -> Pragma) -> AbsToCon QName -> AbsToCon Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        A.InlinePragma Bool
    b QName
    x -> Range -> Bool -> QName -> Pragma
    C.InlinePragma Range
    r Bool
    b (QName -> Pragma) -> AbsToCon QName -> AbsToCon Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        A.EtaPragma QName
    x    -> Range -> QName -> Pragma
    C.EtaPragma    Range
    r (QName -> Pragma) -> AbsToCon QName -> AbsToCon Pragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        A.DisplayPragma QName
    f [NamedArg Pattern]
    ps Expr
    rhs ->
          Range -> Pattern -> Expr -> Pragma
    C.DisplayPragma Range
    r (Pattern -> Expr -> Pragma)
    -> AbsToCon Pattern -> AbsToCon (Expr -> Pragma)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pattern -> AbsToCon (ConOfAbs Pattern)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    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) AbsToCon (Expr -> Pragma) -> AbsToCon Expr -> AbsToCon Pragma
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Expr
    rhs

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

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

      bindToConcrete :: forall b.
    SpineLHS -> (ConOfAbs SpineLHS -> AbsToCon b) -> AbsToCon b
    bindToConcrete SpineLHS
    lhs = LHS -> (ConOfAbs LHS -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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 b. LHS -> (ConOfAbs LHS -> AbsToCon b) -> AbsToCon b
    bindToConcrete (A.LHS LHSInfo
    i LHSCore
    lhscore) ConOfAbs LHS -> AbsToCon b
    ret = do
          Precedence
    -> LHSCore -> (ConOfAbs LHSCore -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    Precedence -> a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcreteCtx Precedence
    TopCtx LHSCore
    lhscore ((ConOfAbs LHSCore -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs LHSCore -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs LHSCore
    lhs ->
              ConOfAbs LHS -> AbsToCon b
    ret (ConOfAbs LHS -> AbsToCon b) -> ConOfAbs LHS -> AbsToCon 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 b. LHSCore -> (ConOfAbs LHSCore -> AbsToCon b) -> AbsToCon b
    bindToConcrete = Pattern -> (Pattern -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> (Pattern -> AbsToCon b) -> AbsToCon b)
    -> (LHSCore -> Pattern)
    -> LHSCore
    -> (Pattern -> AbsToCon b)
    -> AbsToCon 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 b.
    FreshenName -> (ConOfAbs FreshenName -> AbsToCon b) -> AbsToCon b
    bindToConcrete (FreshenName BindName{ unBind :: BindName -> Name
    unBind = Name
    x }) ConOfAbs FreshenName -> AbsToCon b
    ret = Name -> (ConOfAbs Name -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete Name
    x ((ConOfAbs Name -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs Name -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs Name
    y -> ConOfAbs FreshenName -> AbsToCon b
    ret Name
    x { nameConcrete :: Name
    nameConcrete = Name
    ConOfAbs Name
    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 b.
    UserPattern Pattern
    -> (ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (UserPattern Pattern
    p) ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret = do
        RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete.pat" VerboseLevel
    100 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ RawName
    "binding pattern (pass 1)" RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> RawName
    forall a. Show a => a -> RawName
    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 -> AbsToCon b -> AbsToCon b
    forall a. Name -> AbsToCon a -> AbsToCon a
    bindName' Name
    x (AbsToCon b -> AbsToCon b) -> AbsToCon b -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret (ConOfAbs (UserPattern Pattern) -> AbsToCon b)
    -> ConOfAbs (UserPattern Pattern) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ BindName -> Pattern
    forall e. BindName -> Pattern' e
    A.VarP BindName
    bx
              NameInScope
    C.NotInScope       -> Name -> (Name -> AbsToCon b) -> AbsToCon b
    forall a. Name -> (Name -> AbsToCon a) -> AbsToCon a
    bindName Name
    x ((Name -> AbsToCon b) -> AbsToCon b)
    -> (Name -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \Name
    y ->
                                    ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret (ConOfAbs (UserPattern Pattern) -> AbsToCon b)
    -> ConOfAbs (UserPattern Pattern) -> AbsToCon 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 :: Name
    nameConcrete = Name
    y }
          A.WildP{}              -> ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.ProjP{}              -> ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.AbsurdP{}            -> ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.LitP{}               -> ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.DotP{}               -> ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
          A.EqualP{}             -> ConOfAbs (UserPattern Pattern) -> AbsToCon 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) -> AbsToCon b
    ret Pattern
    ConOfAbs (UserPattern Pattern)
    p
            | Bool
    otherwise          -> [UserPattern (NamedArg Pattern)]
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [UserPattern (NamedArg Pattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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 PatInfo
    i [FieldAssignment' Pattern]
    args          -> [FieldAssignment' (UserPattern Pattern)]
    -> (ConOfAbs [FieldAssignment' (UserPattern Pattern)]
        -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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 (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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [FieldAssignment' (UserPattern Pattern)]
        -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([FieldAssignment' Pattern] -> Pattern)
    -> [FieldAssignment' Pattern]
    -> AbsToCon b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> [FieldAssignment' Pattern] -> Pattern
    forall e. PatInfo -> [FieldAssignment' (Pattern' e)] -> Pattern' e
    A.RecP PatInfo
    i
          A.AsP PatInfo
    i BindName
    x Pattern
    p            -> Name -> AbsToCon b -> AbsToCon b
    forall a. Name -> AbsToCon a -> AbsToCon a
    bindName' (BindName -> Name
    unBind BindName
    x) (AbsToCon b -> AbsToCon b) -> AbsToCon b -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $
                                    UserPattern Pattern
    -> (ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> UserPattern Pattern
    forall a. a -> UserPattern a
    UserPattern Pattern
    p) ((ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (UserPattern Pattern)
    p ->
                                    ConOfAbs (UserPattern Pattern) -> AbsToCon 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) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> UserPattern Pattern
    forall a. a -> UserPattern a
    UserPattern Pattern
    p) ((ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> (Pattern -> Pattern) -> Pattern -> AbsToCon 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
          A.AnnP PatInfo
    i Expr
    a Pattern
    p           -> UserPattern Pattern
    -> (ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> UserPattern Pattern
    forall a. a -> UserPattern a
    UserPattern Pattern
    p) ((ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (UserPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> (Pattern -> Pattern) -> Pattern -> AbsToCon b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> Expr -> Pattern -> Pattern
    forall e. PatInfo -> e -> Pattern' e -> Pattern' e
    A.AnnP PatInfo
    i Expr
    a

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

      bindToConcrete :: forall b.
    UserPattern (NamedArg Pattern)
    -> (ConOfAbs (UserPattern (NamedArg Pattern)) -> AbsToCon b)
    -> AbsToCon b
    bindToConcrete (UserPattern NamedArg Pattern
    np) ConOfAbs (UserPattern (NamedArg Pattern)) -> AbsToCon b
    ret =
        case NamedArg Pattern -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin NamedArg Pattern
    np of
          Origin
    CaseSplit -> ConOfAbs (UserPattern (NamedArg Pattern)) -> AbsToCon b
    ret NamedArg Pattern
    ConOfAbs (UserPattern (NamedArg Pattern))
    np
          Origin
    _         -> Arg (Named NamedName (UserPattern Pattern))
    -> (ConOfAbs (Arg (Named NamedName (UserPattern Pattern)))
        -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete ((Named NamedName Pattern -> Named NamedName (UserPattern Pattern))
    -> NamedArg Pattern -> Arg (Named NamedName (UserPattern Pattern))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Pattern -> UserPattern Pattern)
    -> Named NamedName Pattern -> Named NamedName (UserPattern Pattern)
    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)))
    -> AbsToCon b
    ConOfAbs (UserPattern (NamedArg Pattern)) -> AbsToCon 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 b.
    SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b
    bindToConcrete (SplitPattern Pattern
    p) ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret = do
        RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete.pat" VerboseLevel
    100 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ RawName
    "binding pattern (pass 2a)" RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> RawName
    forall a. Show a => a -> RawName
    show Pattern
    p
        case Pattern
    p of
          A.VarP BindName
    x               -> ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.WildP{}              -> ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.ProjP{}              -> ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.AbsurdP{}            -> ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.LitP{}               -> ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.DotP{}               -> ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret Pattern
    ConOfAbs (SplitPattern Pattern)
    p
          A.EqualP{}             -> ConOfAbs (SplitPattern Pattern) -> AbsToCon 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)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) Pattern -> BindingPattern
    BindingPat [NamedArg Pattern]
    args) ((ConOfAbs [Arg (Named NamedName BindingPattern)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [SplitPattern (NamedArg Pattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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 PatInfo
    i [FieldAssignment' Pattern]
    args          -> [FieldAssignment' (SplitPattern Pattern)]
    -> (ConOfAbs [FieldAssignment' (SplitPattern Pattern)]
        -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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 (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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [FieldAssignment' (SplitPattern Pattern)]
        -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([FieldAssignment' Pattern] -> Pattern)
    -> [FieldAssignment' Pattern]
    -> AbsToCon b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> [FieldAssignment' Pattern] -> Pattern
    forall e. PatInfo -> [FieldAssignment' (Pattern' e)] -> Pattern' e
    A.RecP PatInfo
    i
          A.AsP PatInfo
    i BindName
    x Pattern
    p            -> SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> SplitPattern Pattern
    forall a. a -> SplitPattern a
    SplitPattern Pattern
    p)  ((ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (SplitPattern Pattern)
    p ->
                                    ConOfAbs (SplitPattern Pattern) -> AbsToCon 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) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> SplitPattern Pattern
    forall a. a -> SplitPattern a
    SplitPattern Pattern
    p) ((ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> (Pattern -> Pattern) -> Pattern -> AbsToCon 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
          A.AnnP PatInfo
    i Expr
    a Pattern
    p           -> SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> SplitPattern Pattern
    forall a. a -> SplitPattern a
    SplitPattern Pattern
    p) ((ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs (SplitPattern Pattern) -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> (Pattern -> Pattern) -> Pattern -> AbsToCon b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> Expr -> Pattern -> Pattern
    forall e. PatInfo -> e -> Pattern' e -> Pattern' e
    A.AnnP PatInfo
    i Expr
    a

    instance ToConcrete (SplitPattern (NamedArg A.Pattern)) where
      type ConOfAbs (SplitPattern (NamedArg A.Pattern)) = NamedArg A.Pattern
      bindToConcrete :: forall b.
    SplitPattern (NamedArg Pattern)
    -> (ConOfAbs (SplitPattern (NamedArg Pattern)) -> AbsToCon b)
    -> AbsToCon b
    bindToConcrete (SplitPattern NamedArg Pattern
    np) ConOfAbs (SplitPattern (NamedArg Pattern)) -> AbsToCon 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)) -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete ((Named NamedName Pattern -> Named NamedName BindingPattern)
    -> NamedArg Pattern -> Arg (Named NamedName BindingPattern)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Pattern -> BindingPattern)
    -> Named NamedName Pattern -> Named NamedName BindingPattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pattern -> BindingPattern
    BindingPat  ) NamedArg Pattern
    np) ConOfAbs (Arg (Named NamedName BindingPattern)) -> AbsToCon b
    ConOfAbs (SplitPattern (NamedArg Pattern)) -> AbsToCon b
    ret
          Origin
    _         -> Arg (Named NamedName (SplitPattern Pattern))
    -> (ConOfAbs (Arg (Named NamedName (SplitPattern Pattern)))
        -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete ((Named NamedName Pattern -> Named NamedName (SplitPattern Pattern))
    -> NamedArg Pattern -> Arg (Named NamedName (SplitPattern Pattern))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Pattern -> SplitPattern Pattern)
    -> Named NamedName Pattern
    -> Named NamedName (SplitPattern Pattern)
    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)))
    -> AbsToCon b
    ConOfAbs (SplitPattern (NamedArg Pattern)) -> AbsToCon 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 b.
    BindingPattern
    -> (ConOfAbs BindingPattern -> AbsToCon b) -> AbsToCon b
    bindToConcrete (BindingPat Pattern
    p) ConOfAbs BindingPattern -> AbsToCon b
    ret = do
        RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete.pat" VerboseLevel
    100 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ RawName
    "binding pattern (pass 2b)" RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> RawName
    forall a. Show a => a -> RawName
    show Pattern
    p
        case Pattern
    p of
          A.VarP BindName
    x               -> FreshenName -> (ConOfAbs FreshenName -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (BindName -> FreshenName
    FreshenName BindName
    x) ((ConOfAbs FreshenName -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs FreshenName -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs BindingPattern -> AbsToCon b
    ret (Pattern -> AbsToCon b) -> (Name -> Pattern) -> Name -> AbsToCon 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 -> AbsToCon b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.ProjP{}              -> ConOfAbs BindingPattern -> AbsToCon b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.AbsurdP{}            -> ConOfAbs BindingPattern -> AbsToCon b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.LitP{}               -> ConOfAbs BindingPattern -> AbsToCon b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.DotP{}               -> ConOfAbs BindingPattern -> AbsToCon b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.EqualP{}             -> ConOfAbs BindingPattern -> AbsToCon b
    ret Pattern
    ConOfAbs BindingPattern
    p
          A.ConP ConPatInfo
    i AmbiguousQName
    c [NamedArg Pattern]
    args        -> [Arg (Named NamedName BindingPattern)]
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs BindingPattern -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs BindingPattern -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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)] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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)] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [Arg (Named NamedName BindingPattern)] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs BindingPattern -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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 PatInfo
    i [FieldAssignment' Pattern]
    args          -> [FieldAssignment' BindingPattern]
    -> (ConOfAbs [FieldAssignment' BindingPattern] -> AbsToCon b)
    -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap)        Pattern -> BindingPattern
    BindingPat [FieldAssignment' Pattern]
    args) ((ConOfAbs [FieldAssignment' BindingPattern] -> AbsToCon b)
     -> AbsToCon b)
    -> (ConOfAbs [FieldAssignment' BindingPattern] -> AbsToCon b)
    -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs BindingPattern -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> ([FieldAssignment' Pattern] -> Pattern)
    -> [FieldAssignment' Pattern]
    -> AbsToCon b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> [FieldAssignment' Pattern] -> Pattern
    forall e. PatInfo -> [FieldAssignment' (Pattern' e)] -> Pattern' e
    A.RecP PatInfo
    i
          A.AsP PatInfo
    i BindName
    x Pattern
    p            -> FreshenName -> (ConOfAbs FreshenName -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (BindName -> FreshenName
    FreshenName BindName
    x) ((ConOfAbs FreshenName -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs FreshenName -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs FreshenName
    x ->
                                    BindingPattern
    -> (ConOfAbs BindingPattern -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> BindingPattern
    BindingPat Pattern
    p)  ((ConOfAbs BindingPattern -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs BindingPattern -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs BindingPattern
    p ->
                                    ConOfAbs BindingPattern -> AbsToCon 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 -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> BindingPattern
    BindingPat Pattern
    p) ((ConOfAbs BindingPattern -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs BindingPattern -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs BindingPattern -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> (Pattern -> Pattern) -> Pattern -> AbsToCon 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
          A.AnnP PatInfo
    i Expr
    a Pattern
    p           -> BindingPattern
    -> (ConOfAbs BindingPattern -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> BindingPattern
    BindingPat Pattern
    p) ((ConOfAbs BindingPattern -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs BindingPattern -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon b
    ConOfAbs BindingPattern -> AbsToCon b
    ret (Pattern -> AbsToCon b)
    -> (Pattern -> Pattern) -> Pattern -> AbsToCon b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatInfo -> Expr -> Pattern -> Pattern
    forall e. PatInfo -> e -> Pattern' e -> Pattern' e
    A.AnnP PatInfo
    i Expr
    a

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

      bindToConcrete :: forall b. Pattern -> (ConOfAbs Pattern -> AbsToCon b) -> AbsToCon b
    bindToConcrete Pattern
    p ConOfAbs Pattern -> AbsToCon b
    ret = do
        PrecedenceStack
    prec <- AbsToCon PrecedenceStack
    currentPrecedence
        UserPattern Pattern
    -> (ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> UserPattern Pattern
    forall a. a -> UserPattern a
    UserPattern Pattern
    p) ((ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (UserPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (UserPattern Pattern)
    p -> do
          SplitPattern Pattern
    -> (ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b.
    ToConcrete a =>
    a -> (ConOfAbs a -> AbsToCon b) -> AbsToCon b
    bindToConcrete (Pattern -> SplitPattern Pattern
    forall a. a -> SplitPattern a
    SplitPattern Pattern
    ConOfAbs (UserPattern Pattern)
    p) ((ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b)
    -> (ConOfAbs (SplitPattern Pattern) -> AbsToCon b) -> AbsToCon b
    forall a b. (a -> b) -> a -> b
    $ \ ConOfAbs (SplitPattern Pattern)
    p -> do
            Pattern -> AbsToCon b
    ConOfAbs Pattern -> AbsToCon b
    ret (Pattern -> AbsToCon b) -> AbsToCon Pattern -> AbsToCon b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do PrecedenceStack -> AbsToCon Pattern -> AbsToCon Pattern
    forall a. PrecedenceStack -> AbsToCon a -> AbsToCon a
    withPrecedence' PrecedenceStack
    prec (AbsToCon Pattern -> AbsToCon Pattern)
    -> AbsToCon Pattern -> AbsToCon Pattern
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon (ConOfAbs Pattern)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Pattern
    ConOfAbs (SplitPattern Pattern)
    p
      toConcrete :: Pattern -> AbsToCon (ConOfAbs Pattern)
    toConcrete Pattern
    p =
        case Pattern
    p of
          A.VarP BindName
    x ->
            QName -> Pattern
    C.IdentP (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) -> AbsToCon BoundName -> AbsToCon Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BindName -> AbsToCon (ConOfAbs BindName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete BindName
    x

          A.WildP PatInfo
    i ->
            Pattern -> AbsToCon Pattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> AbsToCon Pattern) -> Pattern -> AbsToCon 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]
    -> AbsToCon 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 -> QName -> Pattern
    C.IdentP (QName -> Pattern) -> AbsToCon QName -> AbsToCon Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    p)
          A.ProjP PatInfo
    i ProjOrigin
    _          AmbiguousQName
    p -> Range -> Expr -> Pattern
    C.DotP 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) -> AbsToCon QName -> AbsToCon Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (AmbiguousQName -> QName
    headAmbQ AmbiguousQName
    p)

          A.DefP PatInfo
    i AmbiguousQName
    x [NamedArg Pattern]
    args -> QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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
            (BoundName
    x, Pattern
    p) <- Precedence
    -> (BindName, Pattern) -> AbsToCon (ConOfAbs (BindName, Pattern))
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    argumentCtx_ (BindName
    x, Pattern
    p)
            Pattern -> AbsToCon Pattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> AbsToCon Pattern) -> Pattern -> AbsToCon Pattern
    forall a b. (a -> b) -> a -> b
    $ Range -> Name -> Pattern -> Pattern
    C.AsP (PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i) (BoundName -> Name
    C.boundName BoundName
    x) Pattern
    p

          A.AbsurdP PatInfo
    i ->
            Pattern -> AbsToCon Pattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> AbsToCon Pattern) -> Pattern -> AbsToCon 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
            QName
    x <- AllowAmbiguousNames -> QName -> AbsToCon QName
    lookupQName AllowAmbiguousNames
    AmbiguousNothing QName
    x
            (PrecedenceStack -> Bool) -> AbsToCon Pattern -> AbsToCon Pattern
    bracketP_ PrecedenceStack -> Bool
    appBrackets (AbsToCon Pattern -> AbsToCon Pattern)
    -> AbsToCon Pattern -> AbsToCon Pattern
    forall a b. (a -> b) -> a -> b
    $ Pattern -> AbsToCon Pattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> AbsToCon Pattern) -> Pattern -> AbsToCon Pattern
    forall a b. (a -> b) -> a -> b
    $ Pattern -> NamedArg Pattern -> Pattern
    C.AppP (Range -> Pattern
    C.QuoteP (PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i)) (Pattern -> NamedArg Pattern
    forall a. a -> NamedArg a
    defaultNamedArg (QName -> Pattern
    C.IdentP QName
    x))
          A.LitP PatInfo
    i Literal
    l ->
            Pattern -> AbsToCon Pattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> AbsToCon Pattern) -> Pattern -> AbsToCon 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{} -> Range -> Expr -> Pattern
    C.DotP 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) -> AbsToCon Expr -> AbsToCon Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Precedence -> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (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.
            Name
    cn <- Name -> AbsToCon Name
    toConcreteName Name
    v
            KindsOfNames
    -> Maybe (Set Name)
    -> QName
    -> AbsToCon (Either (NonEmpty QName) ResolvedName)
    resolveName ([KindOfName] -> KindsOfNames
    someKindsOfNames [KindOfName
    FldName]) Maybe (Set Name)
    forall a. Maybe a
    Nothing (Name -> QName
    C.QName Name
    cn) AbsToCon (Either (NonEmpty QName) ResolvedName)
    -> (Either (NonEmpty QName) ResolvedName -> AbsToCon Pattern)
    -> AbsToCon Pattern
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ case
              -- If we do then we print .(v) rather than .v
              Right FieldName{} -> do
                RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "print.dotted" VerboseLevel
    50 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ RawName
    "Wrapping ambiguous name " RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ Name -> RawName
    forall a. Pretty a => a -> RawName
    prettyShow (Name -> Name
    nameConcrete Name
    v)
                Range -> Expr -> Pattern
    C.DotP 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) -> AbsToCon Expr -> AbsToCon Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> AbsToCon (ConOfAbs Expr)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (Name -> Expr
    A.Var Name
    v)
              Right ResolvedName
    _ -> PatInfo -> Expr -> AbsToCon Pattern
    printDotDefault PatInfo
    i Expr
    e
              Left NonEmpty QName
    _ -> AbsToCon Pattern
    forall a. HasCallStack => a
    __IMPOSSIBLE__

          A.DotP PatInfo
    i Expr
    e -> PatInfo -> Expr -> AbsToCon Pattern
    printDotDefault PatInfo
    i Expr
    e

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

          A.PatternSynP PatInfo
    i AmbiguousQName
    n [NamedArg Pattern]
    args -> QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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 PatInfo
    i [FieldAssignment' Pattern]
    as ->
            Range -> [FieldAssignment' Pattern] -> Pattern
    C.RecP (PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i) ([FieldAssignment' Pattern] -> Pattern)
    -> AbsToCon [FieldAssignment' Pattern] -> AbsToCon Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FieldAssignment' Pattern -> AbsToCon (FieldAssignment' Pattern))
    -> [FieldAssignment' Pattern]
    -> AbsToCon [FieldAssignment' Pattern]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((Pattern -> AbsToCon Pattern)
    -> FieldAssignment' Pattern -> AbsToCon (FieldAssignment' Pattern)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Pattern -> AbsToCon Pattern
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    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) -> AbsToCon Pattern -> AbsToCon Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Precedence -> Pattern -> AbsToCon (ConOfAbs Pattern)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    WithArgCtx Pattern
    p

          A.AnnP PatInfo
    i Expr
    a Pattern
    p -> Pattern -> AbsToCon (ConOfAbs Pattern)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Pattern
    p -- TODO: print type annotation

        where

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

        tryOp :: A.QName -> (A.Patterns -> A.Pattern) -> A.Patterns -> AbsToCon C.Pattern
        tryOp :: QName
    -> ([NamedArg Pattern] -> Pattern)
    -> [NamedArg Pattern]
    -> AbsToCon 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 :: AbsToCon (Maybe Pattern) -> AbsToCon (Maybe Pattern)
    funCtx = Bool
    -> (AbsToCon (Maybe Pattern) -> AbsToCon (Maybe Pattern))
    -> AbsToCon (Maybe Pattern)
    -> AbsToCon (Maybe Pattern)
    forall a. Bool -> (a -> a) -> a -> a
    applyUnless ([NamedArg Pattern] -> Bool
    forall a. Null a => a -> Bool
    null [NamedArg Pattern]
    args2) (Precedence -> AbsToCon (Maybe Pattern) -> AbsToCon (Maybe Pattern)
    forall a. Precedence -> AbsToCon a -> AbsToCon a
    withPrecedence Precedence
    FunctionCtx)
          Pattern -> AbsToCon Pattern -> AbsToCon Pattern
    tryToRecoverPatternSynP ([NamedArg Pattern] -> Pattern
    f [NamedArg Pattern]
    args) (AbsToCon Pattern -> AbsToCon Pattern)
    -> AbsToCon Pattern -> AbsToCon Pattern
    forall a b. (a -> b) -> a -> b
    $ AbsToCon (Maybe Pattern) -> AbsToCon (Maybe Pattern)
    funCtx (Pattern -> AbsToCon (Maybe Pattern)
    tryToRecoverOpAppP (Pattern -> AbsToCon (Maybe Pattern))
    -> Pattern -> AbsToCon (Maybe Pattern)
    forall a b. (a -> b) -> a -> b
    $ [NamedArg Pattern] -> Pattern
    f [NamedArg Pattern]
    args1) AbsToCon (Maybe Pattern)
    -> (Maybe Pattern -> AbsToCon Pattern) -> AbsToCon Pattern
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Just Pattern
    c  -> [NamedArg Pattern] -> Pattern -> AbsToCon Pattern
    forall {arg}.
    (ToConcrete arg, ConOfAbs arg ~ NamedArg Pattern) =>
    [arg] -> Pattern -> AbsToCon Pattern
    applyTo [NamedArg Pattern]
    args2 Pattern
    c
            Maybe Pattern
    Nothing -> [NamedArg Pattern] -> Pattern -> AbsToCon Pattern
    forall {arg}.
    (ToConcrete arg, ConOfAbs arg ~ NamedArg Pattern) =>
    [arg] -> Pattern -> AbsToCon Pattern
    applyTo [NamedArg Pattern]
    args (Pattern -> AbsToCon Pattern)
    -> (QName -> Pattern) -> QName -> AbsToCon Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Pattern
    C.IdentP (QName -> AbsToCon Pattern) -> AbsToCon QName -> AbsToCon Pattern
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< QName -> AbsToCon (ConOfAbs QName)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete QName
    x
        -- Note: applyTo [] c = return c
        applyTo :: [arg] -> Pattern -> AbsToCon Pattern
    applyTo [arg]
    args Pattern
    c = (PrecedenceStack -> Bool) -> AbsToCon Pattern -> AbsToCon Pattern
    bracketP_ ([arg] -> PrecedenceStack -> Bool
    forall arg. [arg] -> PrecedenceStack -> Bool
    appBracketsArgs [arg]
    args) (AbsToCon Pattern -> AbsToCon Pattern)
    -> AbsToCon Pattern -> AbsToCon Pattern
    forall a b. (a -> b) -> a -> b
    $ do
          (Pattern -> NamedArg Pattern -> Pattern)
    -> Pattern -> [NamedArg Pattern] -> Pattern
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Pattern -> NamedArg Pattern -> Pattern
    C.AppP Pattern
    c ([NamedArg Pattern] -> Pattern)
    -> AbsToCon [NamedArg Pattern] -> AbsToCon Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Precedence -> [arg] -> AbsToCon (ConOfAbs [arg])
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    argumentCtx_ [arg]
    args

    instance ToConcrete (Maybe A.Pattern) where
      type ConOfAbs (Maybe A.Pattern) = Maybe C.Pattern

      toConcrete :: Maybe Pattern -> AbsToCon (ConOfAbs (Maybe Pattern))
    toConcrete = (Pattern -> AbsToCon Pattern)
    -> Maybe Pattern -> AbsToCon (Maybe Pattern)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Pattern -> AbsToCon Pattern
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete

    -- Helpers for recovering natural number literals

    tryToRecoverNatural :: A.Expr -> AbsToCon C.Expr -> AbsToCon C.Expr
    tryToRecoverNatural :: Expr -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverNatural Expr
    e AbsToCon Expr
    def = do
      QName -> RawName -> Bool
    is <- AbsToCon (QName -> RawName -> Bool)
    isBuiltinFun
      Maybe Integer
    -> AbsToCon Expr -> (Integer -> AbsToCon Expr) -> AbsToCon Expr
    forall a b. Maybe a -> b -> (a -> b) -> b
    caseMaybe ((QName -> RawName -> Bool) -> Expr -> Maybe Integer
    recoverNatural QName -> RawName -> Bool
    is Expr
    e) AbsToCon Expr
    def ((Integer -> AbsToCon Expr) -> AbsToCon Expr)
    -> (Integer -> AbsToCon Expr) -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr)
    -> (Integer -> Expr) -> Integer -> AbsToCon Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> Literal -> Expr
    C.Lit Range
    forall a. Range' a
    noRange (Literal -> Expr) -> (Integer -> Literal) -> Integer -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Literal
    LitNat

    recoverNatural :: (A.QName -> String -> Bool) -> A.Expr -> Maybe Integer
    recoverNatural :: (QName -> RawName -> Bool) -> Expr -> Maybe Integer
    recoverNatural QName -> RawName -> Bool
    is Expr
    e = (QName -> Bool)
    -> (QName -> Bool) -> Integer -> Expr -> Maybe Integer
    explore (QName -> RawName -> Bool
    `is` RawName
    builtinZero) (QName -> RawName -> Bool
    `is` RawName
    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
    /= :: MaybeSection a -> MaybeSection a -> Bool
    $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
    Eq, VerboseLevel -> MaybeSection a -> RawName -> RawName
    [MaybeSection a] -> RawName -> RawName
    MaybeSection a -> RawName
    (VerboseLevel -> MaybeSection a -> RawName -> RawName)
    -> (MaybeSection a -> RawName)
    -> ([MaybeSection a] -> RawName -> RawName)
    -> Show (MaybeSection a)
    forall a.
    Show a =>
    VerboseLevel -> MaybeSection a -> RawName -> RawName
    forall a. Show a => [MaybeSection a] -> RawName -> RawName
    forall a. Show a => MaybeSection a -> RawName
    forall a.
    (VerboseLevel -> a -> RawName -> RawName)
    -> (a -> RawName) -> ([a] -> RawName -> RawName) -> Show a
    showList :: [MaybeSection a] -> RawName -> RawName
    $cshowList :: forall a. Show a => [MaybeSection a] -> RawName -> RawName
    show :: MaybeSection a -> RawName
    $cshow :: forall a. Show a => MaybeSection a -> RawName
    showsPrec :: VerboseLevel -> MaybeSection a -> RawName -> RawName
    $cshowsPrec :: forall a.
    Show a =>
    VerboseLevel -> MaybeSection a -> RawName -> RawName
    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
    <$ :: forall a b. a -> MaybeSection b -> MaybeSection a
    $c<$ :: forall a b. a -> MaybeSection b -> MaybeSection a
    fmap :: forall a b. (a -> b) -> MaybeSection a -> MaybeSection b
    $cfmap :: forall a b. (a -> b) -> MaybeSection a -> MaybeSection b
    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
    product :: forall a. Num a => MaybeSection a -> a
    $cproduct :: forall a. Num a => MaybeSection a -> a
    sum :: forall a. Num a => MaybeSection a -> a
    $csum :: forall a. Num a => MaybeSection a -> a
    minimum :: forall a. Ord a => MaybeSection a -> a
    $cminimum :: forall a. Ord a => MaybeSection a -> a
    maximum :: forall a. Ord a => MaybeSection a -> a
    $cmaximum :: forall a. Ord a => MaybeSection a -> a
    elem :: forall a. Eq a => a -> MaybeSection a -> Bool
    $celem :: forall a. Eq a => a -> MaybeSection a -> Bool
    length :: forall a. MaybeSection a -> VerboseLevel
    $clength :: forall a. MaybeSection a -> VerboseLevel
    null :: forall a. MaybeSection a -> Bool
    $cnull :: forall a. MaybeSection a -> Bool
    toList :: forall a. MaybeSection a -> [a]
    $ctoList :: forall a. MaybeSection a -> [a]
    foldl1 :: forall a. (a -> a -> a) -> MaybeSection a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> MaybeSection a -> a
    foldr1 :: forall a. (a -> a -> a) -> MaybeSection a -> a
    $cfoldr1 :: forall a. (a -> a -> a) -> MaybeSection a -> a
    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
    $cfoldl :: forall b a. (b -> a -> 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
    $cfoldr :: forall a b. (a -> b -> b) -> b -> MaybeSection a -> b
    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
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> MaybeSection a -> m
    fold :: forall m. Monoid m => MaybeSection m -> m
    $cfold :: forall m. Monoid m => MaybeSection m -> m
    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)
    sequence :: forall (m :: * -> *) a.
    Monad m =>
    MaybeSection (m a) -> m (MaybeSection a)
    $csequence :: forall (m :: * -> *) a.
    Monad m =>
    MaybeSection (m a) -> m (MaybeSection a)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MaybeSection a -> m (MaybeSection b)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MaybeSection a -> m (MaybeSection b)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    MaybeSection (f a) -> f (MaybeSection a)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    MaybeSection (f a) -> f (MaybeSection a)
    traverse :: 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)
    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 :: Range -> C.QName -> A.Name -> List1 (MaybeSection C.Expr) -> C.Expr
    cOpApp :: Range -> QName -> Name -> List1 (MaybeSection Expr) -> Expr
    cOpApp Range
    r QName
    x Name
    n List1 (MaybeSection Expr)
    es =
      Range -> QName -> Set Name -> OpAppArgs -> Expr
    C.OpApp Range
    r QName
    x (Name -> Set Name
    forall a. a -> Set a
    Set.singleton Name
    n) (OpAppArgs -> Expr) -> OpAppArgs -> Expr
    forall a b. (a -> b) -> a -> b
    $
      ((MaybeSection Expr, PositionInName)
     -> NamedArg (MaybePlaceholder (OpApp Expr)))
    -> [(MaybeSection Expr, PositionInName)] -> OpAppArgs
    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) ([(MaybeSection Expr, PositionInName)] -> OpAppArgs)
    -> [(MaybeSection Expr, PositionInName)] -> OpAppArgs
    forall a b. (a -> b) -> a -> b
    $
      NonEmpty (MaybeSection Expr, PositionInName)
    -> [(MaybeSection Expr, PositionInName)]
    forall a. NonEmpty a -> [a]
    List1.toList NonEmpty (MaybeSection Expr, PositionInName)
    eps
      where
        x0 :: Name
    x0 = QName -> Name
    C.unqualify QName
    x
        positions :: List1 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 -> List1 PositionInName
    forall a. [a] -> a -> List1 a
    `List1.snoc` PositionInName
    End
                  | Name -> Bool
    isPostfix Name
    x0 = PositionInName
    Beginning PositionInName -> [PositionInName] -> List1 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] -> List1 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) -> List1 PositionInName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> List1 (MaybeSection Expr)
    es
        eps :: NonEmpty (MaybeSection Expr, PositionInName)
    eps = List1 (MaybeSection Expr)
    -> List1 PositionInName
    -> NonEmpty (MaybeSection Expr, PositionInName)
    forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
    List1.zip List1 (MaybeSection Expr)
    es List1 PositionInName
    positions
        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 :: A.Expr -> AbsToCon C.Expr -> AbsToCon C.Expr
    tryToRecoverOpApp :: Expr -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverOpApp Expr
    e AbsToCon Expr
    def = AbsToCon Expr -> AbsToCon (Maybe Expr) -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
    fromMaybeM AbsToCon Expr
    def (AbsToCon (Maybe Expr) -> AbsToCon Expr)
    -> AbsToCon (Maybe Expr) -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $
      ((PrecedenceStack -> Bool) -> AbsToCon Expr -> AbsToCon Expr)
    -> (Expr -> Bool)
    -> (Range -> QName -> Name -> List1 (MaybeSection Expr) -> Expr)
    -> (Expr -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Expr))]))
    -> Expr
    -> AbsToCon (Maybe Expr)
    forall a c.
    (ToConcrete a, c ~ ConOfAbs a, HasRange c) =>
    ((PrecedenceStack -> Bool) -> AbsToCon c -> AbsToCon c)
    -> (a -> Bool)
    -> (Range -> QName -> Name -> List1 (MaybeSection c) -> c)
    -> (a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))]))
    -> a
    -> AbsToCon (Maybe c)
    recoverOpApp (PrecedenceStack -> Bool) -> AbsToCon Expr -> AbsToCon 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) 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)
    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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Name]
    -> [NamedArg (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) [NamedArg (AppInfo, Expr)]
    args
          where
            LamView     [LamBinding]
    bs Expr
    body = Expr -> LamView
    A.lamView Expr
    e
            Application Expr
    hd [NamedArg (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 TacticAttr
    _ 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]
    -> [NamedArg (AppInfo, Expr)]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    sectionArgs [Name]
    xs = [Name]
    -> [NamedArg (AppInfo, Expr)]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    go [Name]
    xs
              where
                noXs :: NamedArg (AppInfo, Expr) -> Bool
    noXs = All -> Bool
    getAll (All -> Bool)
    -> (NamedArg (AppInfo, Expr) -> All)
    -> NamedArg (AppInfo, Expr)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Expr -> All) -> Expr -> All
    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)
    -> (NamedArg (AppInfo, Expr) -> Expr)
    -> NamedArg (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)
    -> (NamedArg (AppInfo, Expr) -> (AppInfo, Expr))
    -> NamedArg (AppInfo, Expr)
    -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedArg (AppInfo, Expr) -> (AppInfo, Expr)
    forall a. NamedArg a -> a
    namedArg
                go :: [Name]
    -> [NamedArg (AppInfo, Expr)]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    go [] [] = [NamedArg (MaybeSection (AppInfo, Expr))]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                go (Name
    y : [Name]
    ys) (NamedArg (AppInfo, Expr)
    arg : [NamedArg (AppInfo, Expr)]
    args)
                  | NamedArg (AppInfo, Expr) -> Bool
    forall a. LensHiding a => a -> Bool
    visible NamedArg (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
    $ NamedArg (AppInfo, Expr) -> (AppInfo, Expr)
    forall a. NamedArg a -> a
    namedArg NamedArg (AppInfo, Expr)
    arg
                  , Name
    y Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    y' = ((Named NamedName (AppInfo, Expr)
     -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> NamedArg (AppInfo, Expr)
    -> NamedArg (MaybeSection (AppInfo, Expr))
    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 NamedName (AppInfo, Expr)
    -> Named NamedName (MaybeSection (AppInfo, Expr))
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$) NamedArg (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]
    -> [NamedArg (AppInfo, Expr)]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    go [Name]
    ys [NamedArg (AppInfo, Expr)]
    args
                go [Name]
    ys (NamedArg (AppInfo, Expr)
    arg : [NamedArg (AppInfo, Expr)]
    args)
                  | NamedArg (AppInfo, Expr) -> Bool
    forall a. LensHiding a => a -> Bool
    visible NamedArg (AppInfo, Expr)
    arg, NamedArg (AppInfo, Expr) -> Bool
    noXs NamedArg (AppInfo, Expr)
    arg = (((Named NamedName (AppInfo, Expr)
     -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> NamedArg (AppInfo, Expr)
    -> NamedArg (MaybeSection (AppInfo, Expr))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName (AppInfo, Expr)
      -> Named NamedName (MaybeSection (AppInfo, Expr)))
     -> NamedArg (AppInfo, Expr)
     -> NamedArg (MaybeSection (AppInfo, Expr)))
    -> (((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
        -> Named NamedName (AppInfo, Expr)
        -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> NamedArg (AppInfo, Expr)
    -> NamedArg (MaybeSection (AppInfo, Expr))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> Named NamedName (AppInfo, Expr)
    -> Named NamedName (MaybeSection (AppInfo, Expr))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) (AppInfo, Expr) -> MaybeSection (AppInfo, Expr)
    forall a. a -> MaybeSection a
    NoSection NamedArg (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]
    -> [NamedArg (AppInfo, Expr)]
    -> Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    go [Name]
    ys [NamedArg (AppInfo, Expr)]
    args
                go [Name]
    _ [NamedArg (AppInfo, Expr)]
    _ = Maybe [NamedArg (MaybeSection (AppInfo, Expr))]
    forall a. Maybe a
    Nothing

        view Expr
    e = (, ((NamedArg (AppInfo, Expr)
     -> NamedArg (MaybeSection (AppInfo, Expr)))
    -> [NamedArg (AppInfo, Expr)]
    -> [NamedArg (MaybeSection (AppInfo, Expr))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((NamedArg (AppInfo, Expr)
      -> NamedArg (MaybeSection (AppInfo, Expr)))
     -> [NamedArg (AppInfo, Expr)]
     -> [NamedArg (MaybeSection (AppInfo, Expr))])
    -> (((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
        -> NamedArg (AppInfo, Expr)
        -> NamedArg (MaybeSection (AppInfo, Expr)))
    -> ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> [NamedArg (AppInfo, Expr)]
    -> [NamedArg (MaybeSection (AppInfo, Expr))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Named NamedName (AppInfo, Expr)
     -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> NamedArg (AppInfo, Expr)
    -> NamedArg (MaybeSection (AppInfo, Expr))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName (AppInfo, Expr)
      -> Named NamedName (MaybeSection (AppInfo, Expr)))
     -> NamedArg (AppInfo, Expr)
     -> NamedArg (MaybeSection (AppInfo, Expr)))
    -> (((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
        -> Named NamedName (AppInfo, Expr)
        -> Named NamedName (MaybeSection (AppInfo, Expr)))
    -> ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> NamedArg (AppInfo, Expr)
    -> NamedArg (MaybeSection (AppInfo, Expr))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, Expr) -> MaybeSection (AppInfo, Expr))
    -> Named NamedName (AppInfo, Expr)
    -> Named NamedName (MaybeSection (AppInfo, Expr))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) (AppInfo, Expr) -> MaybeSection (AppInfo, Expr)
    forall a. a -> MaybeSection a
    NoSection [NamedArg (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 [NamedArg (AppInfo, Expr)]
    args = Expr -> AppView' (AppInfo, Expr)
    A.appView' Expr
    e

    tryToRecoverOpAppP :: A.Pattern -> AbsToCon (Maybe C.Pattern)
    tryToRecoverOpAppP :: Pattern -> AbsToCon (Maybe Pattern)
    tryToRecoverOpAppP Pattern
    p = do
      Maybe Pattern
    res <- ((PrecedenceStack -> Bool) -> AbsToCon Pattern -> AbsToCon Pattern)
    -> (Pattern -> Bool)
    -> (Range
        -> QName -> Name -> List1 (MaybeSection Pattern) -> Pattern)
    -> (Pattern
        -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))]))
    -> Pattern
    -> AbsToCon (Maybe Pattern)
    forall a c.
    (ToConcrete a, c ~ ConOfAbs a, HasRange c) =>
    ((PrecedenceStack -> Bool) -> AbsToCon c -> AbsToCon c)
    -> (a -> Bool)
    -> (Range -> QName -> Name -> List1 (MaybeSection c) -> c)
    -> (a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))]))
    -> a
    -> AbsToCon (Maybe c)
    recoverOpApp (PrecedenceStack -> Bool) -> AbsToCon Pattern -> AbsToCon Pattern
    bracketP_ (Bool -> Pattern -> Bool
    forall a b. a -> b -> a
    const Bool
    False) Range -> QName -> Name -> List1 (MaybeSection Pattern) -> Pattern
    opApp Pattern -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, Pattern))])
    view Pattern
    p
      RawName -> VerboseLevel -> [RawName] -> AbsToCon ()
    forall a (m :: * -> *).
    (ReportS a, MonadDebug m) =>
    RawName -> VerboseLevel -> a -> m ()
    reportS RawName
    "print.op" VerboseLevel
    90
        [ RawName
    "tryToRecoverOpApp"
        , RawName
    "in:  " RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> RawName
    forall a. Show a => a -> RawName
    show Pattern
    p
        , RawName
    "out: " RawName -> RawName -> RawName
    forall a. [a] -> [a] -> [a]
    ++ Maybe Pattern -> RawName
    forall a. Show a => a -> RawName
    show Maybe Pattern
    res
        ]
      Maybe Pattern -> AbsToCon (Maybe Pattern)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Pattern
    res
      where
        opApp :: Range -> QName -> Name -> List1 (MaybeSection Pattern) -> Pattern
    opApp Range
    r QName
    x Name
    n List1 (MaybeSection Pattern)
    ps = Range -> QName -> Set Name -> [NamedArg Pattern] -> Pattern
    C.OpAppP Range
    r QName
    x (Name -> Set Name
    forall a. a -> Set a
    Set.singleton Name
    n) ([NamedArg Pattern] -> Pattern) -> [NamedArg Pattern] -> Pattern
    forall a b. (a -> b) -> a -> b
    $
          (MaybeSection Pattern -> NamedArg Pattern)
    -> [MaybeSection Pattern] -> [NamedArg Pattern]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Pattern -> NamedArg Pattern
    forall a. a -> NamedArg a
    defaultNamedArg (Pattern -> NamedArg Pattern)
    -> (MaybeSection Pattern -> Pattern)
    -> MaybeSection Pattern
    -> NamedArg 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__) ([MaybeSection Pattern] -> [NamedArg Pattern])
    -> [MaybeSection Pattern] -> [NamedArg Pattern]
    forall a b. (a -> b) -> a -> b
    $
          -- `view` does not generate any `Nothing`s
          List1 (MaybeSection Pattern) -> [MaybeSection Pattern]
    forall a. NonEmpty a -> [a]
    List1.toList 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 NamedName (MaybeSection (AppInfo, Pattern)))
    -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName Pattern
      -> Named NamedName (MaybeSection (AppInfo, Pattern)))
     -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> ((Pattern -> MaybeSection (AppInfo, Pattern))
        -> Named NamedName Pattern
        -> Named NamedName (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 NamedName (MaybeSection (AppInfo, Pattern))
    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 NamedName (MaybeSection (AppInfo, Pattern)))
    -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName Pattern
      -> Named NamedName (MaybeSection (AppInfo, Pattern)))
     -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> ((Pattern -> MaybeSection (AppInfo, Pattern))
        -> Named NamedName Pattern
        -> Named NamedName (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 NamedName (MaybeSection (AppInfo, Pattern))
    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 NamedName (MaybeSection (AppInfo, Pattern)))
    -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Named NamedName Pattern
      -> Named NamedName (MaybeSection (AppInfo, Pattern)))
     -> NamedArg Pattern -> NamedArg (MaybeSection (AppInfo, Pattern)))
    -> ((Pattern -> MaybeSection (AppInfo, Pattern))
        -> Named NamedName Pattern
        -> Named NamedName (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 NamedName (MaybeSection (AppInfo, Pattern))
    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 . (ToConcrete a, c ~ ConOfAbs a, HasRange c)
      => ((PrecedenceStack -> Bool) -> AbsToCon c -> AbsToCon c)
      -> (a -> Bool)  -- ^ Check for lambdas
      -> (Range -> C.QName -> A.Name -> List1 (MaybeSection c) -> c)  -- ^ @opApp@
      -> (a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))]))
      -> a
      -> AbsToCon (Maybe c)
    recoverOpApp :: forall a c.
    (ToConcrete a, c ~ ConOfAbs a, HasRange c) =>
    ((PrecedenceStack -> Bool) -> AbsToCon c -> AbsToCon c)
    -> (a -> Bool)
    -> (Range -> QName -> Name -> List1 (MaybeSection c) -> c)
    -> (a -> Maybe (Hd, [NamedArg (MaybeSection (AppInfo, a))]))
    -> a
    -> AbsToCon (Maybe c)
    recoverOpApp (PrecedenceStack -> Bool) -> AbsToCon c -> AbsToCon c
    bracket a -> Bool
    isLam 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 -> AbsToCon (Maybe c)
    forall {a}. AbsToCon (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    -> AbsToCon (Maybe c)
    forall {a}. AbsToCon (Maybe a)
    mDefault
              | Bool
    otherwise     -> Either Name QName
    -> [MaybeSection (AppInfo, a)] -> AbsToCon (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
                              -> AbsToCon (Maybe c)
    forall {a}. AbsToCon (Maybe a)
    mDefault
              | Bool
    otherwise     -> Either Name QName
    -> [MaybeSection (AppInfo, a)] -> AbsToCon (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)] -> AbsToCon (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)] -> AbsToCon (Maybe c)
    doQNameHelper (QName -> Either Name QName
    forall a b. b -> Either a b
    Right QName
    qn) [MaybeSection (AppInfo, a)]
    args'
        | Bool
    otherwise           -> AbsToCon (Maybe c)
    forall {a}. AbsToCon (Maybe a)
    mDefault
      where
      mDefault :: AbsToCon (Maybe a)
    mDefault = Maybe a -> AbsToCon (Maybe 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 :: Either A.Name A.QName -> [MaybeSection (AppInfo, a)] -> AbsToCon (Maybe c)
      doQNameHelper :: Either Name QName
    -> [MaybeSection (AppInfo, a)] -> AbsToCon (Maybe c)
    doQNameHelper Either Name QName
    n [MaybeSection (AppInfo, a)]
    args = do
        QName
    x <- (Name -> AbsToCon QName)
    -> (QName -> AbsToCon QName) -> Either Name QName -> AbsToCon QName
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Name -> QName
    C.QName (Name -> QName)
    -> (Name -> AbsToCon Name) -> Name -> AbsToCon QName
    forall (m :: * -> *) b c a.
    Functor m =>
    (b -> c) -> (a -> m b) -> a -> m c
    <.> Name -> AbsToCon Name
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete) QName -> AbsToCon QName
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete Either Name QName
    n
        let n' :: Name
    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'.
        Fixity
    fx <- QName -> [Name] -> AbsToCon ResolvedName
    resolveName_ QName
    x [Name
    n'] AbsToCon ResolvedName
    -> (ResolvedName -> Fixity) -> AbsToCon Fixity
    forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    <&> \ case
                VarName Name
    y BindingSource
    _                -> Name
    y Name -> Lens' Fixity Name -> Fixity
    forall o i. o -> Lens' i o -> i
    ^. forall a. LensFixity a => Lens' Fixity a
    Lens' Fixity Name
    lensFixity
                DefinedName Access
    _ AbstractName
    q Suffix
    _          -> AbstractName
    q AbstractName -> Lens' Fixity AbstractName -> Fixity
    forall o i. o -> Lens' i o -> i
    ^. forall a. LensFixity a => Lens' Fixity a
    Lens' Fixity AbstractName
    lensFixity
                FieldName (AbstractName
    q :| [AbstractName]
    _)         -> AbstractName
    q AbstractName -> Lens' Fixity AbstractName -> Fixity
    forall o i. o -> Lens' i o -> i
    ^. forall a. LensFixity a => Lens' Fixity a
    Lens' Fixity AbstractName
    lensFixity
                ConstructorName Set Induction
    _ (AbstractName
    q :| [AbstractName]
    _) -> AbstractName
    q AbstractName -> Lens' Fixity AbstractName -> Fixity
    forall o i. o -> Lens' i o -> i
    ^. forall a. LensFixity a => Lens' Fixity a
    Lens' Fixity AbstractName
    lensFixity
                PatternSynResName (AbstractName
    q :| [AbstractName]
    _) -> AbstractName
    q AbstractName -> Lens' Fixity AbstractName -> Fixity
    forall o i. o -> Lens' i o -> i
    ^. forall a. LensFixity a => Lens' Fixity a
    Lens' Fixity AbstractName
    lensFixity
                ResolvedName
    UnknownName                -> Fixity
    noFixity
        [MaybeSection (AppInfo, a)]
    -> AbsToCon (Maybe c)
    -> (List1 (MaybeSection (AppInfo, a)) -> AbsToCon (Maybe c))
    -> AbsToCon (Maybe c)
    forall a b. [a] -> b -> (List1 a -> b) -> b
    List1.ifNull [MaybeSection (AppInfo, a)]
    args {-then-} AbsToCon (Maybe c)
    forall {a}. AbsToCon (Maybe a)
    mDefault {-else-} ((List1 (MaybeSection (AppInfo, a)) -> AbsToCon (Maybe c))
     -> AbsToCon (Maybe c))
    -> (List1 (MaybeSection (AppInfo, a)) -> AbsToCon (Maybe c))
    -> AbsToCon (Maybe c)
    forall a b. (a -> b) -> a -> b
    $ \ List1 (MaybeSection (AppInfo, a))
    as ->
          Fixity
    -> QName
    -> Name
    -> List1 (MaybeSection (AppInfo, a))
    -> NameParts
    -> AbsToCon (Maybe c)
    doQName 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 :: Fixity -> C.QName -> A.Name -> List1 (MaybeSection (AppInfo, a)) -> NameParts -> AbsToCon (Maybe c)

      -- fall-back (wrong number of arguments or no holes)
      doQName :: Fixity
    -> QName
    -> Name
    -> List1 (MaybeSection (AppInfo, a))
    -> NameParts
    -> AbsToCon (Maybe c)
    doQName Fixity
    _ QName
    x Name
    _ List1 (MaybeSection (AppInfo, a))
    as NameParts
    xs
        | List1 (MaybeSection (AppInfo, 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 = AbsToCon (Maybe c)
    forall {a}. AbsToCon (Maybe a)
    mDefault

      -- binary case
      doQName 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) -> AbsToCon c -> AbsToCon (Maybe c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
              (PrecedenceStack -> Bool) -> AbsToCon c -> AbsToCon c
    bracket (Bool -> Fixity -> PrecedenceStack -> Bool
    opBrackets' (MaybeSection (AppInfo, a) -> Bool
    skipParens MaybeSection (AppInfo, a)
    an) Fixity
    fixity) (AbsToCon c -> AbsToCon c) -> AbsToCon c -> AbsToCon c
    forall a b. (a -> b) -> a -> b
    $ do
                MaybeSection c
    e1 <- ((AppInfo, a) -> AbsToCon c)
    -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Precedence -> a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx (Fixity -> Precedence
    LeftOperandCtx Fixity
    fixity) (a -> AbsToCon c)
    -> ((AppInfo, a) -> a) -> (AppInfo, a) -> AbsToCon 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
                [MaybeSection c]
    es <- ((MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
    -> [MaybeSection (AppInfo, a)] -> AbsToCon [MaybeSection c]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
     -> [MaybeSection (AppInfo, a)] -> AbsToCon [MaybeSection c])
    -> (((AppInfo, a) -> AbsToCon c)
        -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
    -> ((AppInfo, a) -> AbsToCon c)
    -> [MaybeSection (AppInfo, a)]
    -> AbsToCon [MaybeSection c]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, a) -> AbsToCon c)
    -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse) (Precedence -> a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    InsideOperandCtx (a -> AbsToCon c)
    -> ((AppInfo, a) -> a) -> (AppInfo, a) -> AbsToCon 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'
                MaybeSection c
    en <- ((AppInfo, a) -> AbsToCon c)
    -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((AppInfo -> a -> AbsToCon c) -> (AppInfo, a) -> AbsToCon c
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ((AppInfo -> a -> AbsToCon c) -> (AppInfo, a) -> AbsToCon c)
    -> (AppInfo -> a -> AbsToCon c) -> (AppInfo, a) -> AbsToCon c
    forall a b. (a -> b) -> a -> b
    $ Precedence -> a -> AbsToCon c
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx (Precedence -> a -> AbsToCon c)
    -> (AppInfo -> Precedence) -> AppInfo -> a -> AbsToCon c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Fixity -> ParenPreference -> Precedence
    RightOperandCtx Fixity
    fixity (ParenPreference -> Precedence)
    -> (AppInfo -> ParenPreference) -> AppInfo -> Precedence
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AppInfo -> ParenPreference
    appParens) MaybeSection (AppInfo, a)
    an
                c -> AbsToCon c
    forall (m :: * -> *) a. Monad m => a -> m a
    return (c -> AbsToCon c) -> c -> AbsToCon c
    forall a b. (a -> b) -> a -> b
    $ Range -> QName -> Name -> List1 (MaybeSection c) -> c
    opApp ((MaybeSection c, MaybeSection c) -> Range
    forall a. HasRange a => a -> Range
    getRange (MaybeSection c
    e1, MaybeSection c
    en)) QName
    x Name
    n (MaybeSection c
    e1 MaybeSection c -> [MaybeSection c] -> List1 (MaybeSection c)
    forall a. a -> [a] -> NonEmpty a
    :| [MaybeSection c]
    es [MaybeSection c] -> [MaybeSection c] -> [MaybeSection c]
    forall a. [a] -> [a] -> [a]
    ++ [MaybeSection c
    en])

      -- prefix
      doQName 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) -> AbsToCon c -> AbsToCon (Maybe c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
              (PrecedenceStack -> Bool) -> AbsToCon c -> AbsToCon c
    bracket (Bool -> Fixity -> PrecedenceStack -> Bool
    opBrackets' (MaybeSection (AppInfo, a) -> Bool
    skipParens MaybeSection (AppInfo, a)
    an) Fixity
    fixity) (AbsToCon c -> AbsToCon c) -> AbsToCon c -> AbsToCon c
    forall a b. (a -> b) -> a -> b
    $ do
                [MaybeSection c]
    es <- ((MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
    -> [MaybeSection (AppInfo, a)] -> AbsToCon [MaybeSection c]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
     -> [MaybeSection (AppInfo, a)] -> AbsToCon [MaybeSection c])
    -> (((AppInfo, a) -> AbsToCon c)
        -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
    -> ((AppInfo, a) -> AbsToCon c)
    -> [MaybeSection (AppInfo, a)]
    -> AbsToCon [MaybeSection c]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, a) -> AbsToCon c)
    -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse) (Precedence -> a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    InsideOperandCtx (a -> AbsToCon c)
    -> ((AppInfo, a) -> a) -> (AppInfo, a) -> AbsToCon 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'
                MaybeSection c
    en <- ((AppInfo, a) -> AbsToCon c)
    -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (\ (AppInfo
    i, a
    e) -> Precedence -> a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (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) MaybeSection (AppInfo, a)
    an
                c -> AbsToCon c
    forall (m :: * -> *) a. Monad m => a -> m a
    return (c -> AbsToCon c) -> c -> AbsToCon c
    forall a b. (a -> b) -> a -> b
    $ Range -> QName -> Name -> List1 (MaybeSection c) -> c
    opApp ((Name, MaybeSection c) -> Range
    forall a. HasRange a => a -> Range
    getRange (Name
    n, MaybeSection c
    en)) QName
    x Name
    n ([MaybeSection c] -> MaybeSection c -> List1 (MaybeSection c)
    forall a. [a] -> a -> List1 a
    List1.snoc [MaybeSection c]
    es MaybeSection c
    en)

      -- postfix
      doQName 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
            MaybeSection c
    e1 <- ((AppInfo, a) -> AbsToCon c)
    -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Precedence -> a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx (Fixity -> Precedence
    LeftOperandCtx Fixity
    fixity) (a -> AbsToCon c)
    -> ((AppInfo, a) -> a) -> (AppInfo, a) -> AbsToCon 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
            [MaybeSection c]
    es <- ((MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
    -> [MaybeSection (AppInfo, a)] -> AbsToCon [MaybeSection c]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
     -> [MaybeSection (AppInfo, a)] -> AbsToCon [MaybeSection c])
    -> (((AppInfo, a) -> AbsToCon c)
        -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
    -> ((AppInfo, a) -> AbsToCon c)
    -> [MaybeSection (AppInfo, a)]
    -> AbsToCon [MaybeSection c]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, a) -> AbsToCon c)
    -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse) (Precedence -> a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    InsideOperandCtx (a -> AbsToCon c)
    -> ((AppInfo, a) -> a) -> (AppInfo, a) -> AbsToCon 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'
            c -> Maybe c
    forall a. a -> Maybe a
    Just (c -> Maybe c) -> AbsToCon c -> AbsToCon (Maybe c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
              (PrecedenceStack -> Bool) -> AbsToCon c -> AbsToCon c
    bracket (Fixity -> PrecedenceStack -> Bool
    opBrackets Fixity
    fixity) (AbsToCon c -> AbsToCon c) -> AbsToCon c -> AbsToCon c
    forall a b. (a -> b) -> a -> b
    $
                c -> AbsToCon c
    forall (m :: * -> *) a. Monad m => a -> m a
    return (c -> AbsToCon c) -> c -> AbsToCon c
    forall a b. (a -> b) -> a -> b
    $ Range -> QName -> Name -> List1 (MaybeSection c) -> c
    opApp ((MaybeSection c, Name) -> Range
    forall a. HasRange a => a -> Range
    getRange (MaybeSection c
    e1, Name
    n)) QName
    x Name
    n (MaybeSection c
    e1 MaybeSection c -> [MaybeSection c] -> List1 (MaybeSection c)
    forall a. a -> [a] -> NonEmpty a
    :| [MaybeSection c]
    es)

      -- roundfix
      doQName Fixity
    _ QName
    x Name
    n List1 (MaybeSection (AppInfo, a))
    as NameParts
    _ = do
        List1 (MaybeSection c)
    es <- ((MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
    -> List1 (MaybeSection (AppInfo, a))
    -> AbsToCon (List1 (MaybeSection c))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
     -> List1 (MaybeSection (AppInfo, a))
     -> AbsToCon (List1 (MaybeSection c)))
    -> (((AppInfo, a) -> AbsToCon c)
        -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c))
    -> ((AppInfo, a) -> AbsToCon c)
    -> List1 (MaybeSection (AppInfo, a))
    -> AbsToCon (List1 (MaybeSection c))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((AppInfo, a) -> AbsToCon c)
    -> MaybeSection (AppInfo, a) -> AbsToCon (MaybeSection c)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse) (Precedence -> a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => Precedence -> a -> AbsToCon (ConOfAbs a)
    toConcreteCtx Precedence
    InsideOperandCtx (a -> AbsToCon c)
    -> ((AppInfo, a) -> a) -> (AppInfo, a) -> AbsToCon 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
        c -> Maybe c
    forall a. a -> Maybe a
    Just (c -> Maybe c) -> AbsToCon c -> AbsToCon (Maybe c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
          (PrecedenceStack -> Bool) -> AbsToCon c -> AbsToCon c
    bracket PrecedenceStack -> Bool
    roundFixBrackets (AbsToCon c -> AbsToCon c) -> AbsToCon c -> AbsToCon c
    forall a b. (a -> b) -> a -> b
    $
            c -> AbsToCon c
    forall (m :: * -> *) a. Monad m => a -> m a
    return (c -> AbsToCon c) -> c -> AbsToCon c
    forall a b. (a -> b) -> a -> b
    $ Range -> QName -> Name -> List1 (MaybeSection c) -> c
    opApp (QName -> Range
    forall a. HasRange a => a -> Range
    getRange QName
    x) QName
    x Name
    n List1 (MaybeSection c)
    es

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

    -- | Recover pattern synonyms for expressions.
    tryToRecoverPatternSyn :: A.Expr -> AbsToCon C.Expr -> AbsToCon C.Expr
    tryToRecoverPatternSyn :: Expr -> AbsToCon Expr -> AbsToCon Expr
    tryToRecoverPatternSyn Expr
    e AbsToCon Expr
    fallback
      | Expr -> Bool
    userWritten Expr
    e = AbsToCon Expr
    fallback
      | Expr -> Bool
    litOrCon Expr
    e    = (QName -> [NamedArg Expr] -> Expr)
    -> (PatternSynDefn -> Expr -> Maybe [Arg Expr])
    -> Expr
    -> AbsToCon (ConOfAbs Expr)
    -> AbsToCon (ConOfAbs Expr)
    forall a.
    ToConcrete a =>
    (QName -> [NamedArg a] -> a)
    -> (PatternSynDefn -> a -> Maybe [Arg a])
    -> a
    -> AbsToCon (ConOfAbs a)
    -> AbsToCon (ConOfAbs a)
    recoverPatternSyn QName -> [NamedArg Expr] -> Expr
    apply PatternSynDefn -> Expr -> Maybe [Arg Expr]
    matchPatternSyn Expr
    e AbsToCon Expr
    AbsToCon (ConOfAbs Expr)
    fallback
      | Bool
    otherwise     = AbsToCon 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 :: A.Pattern -> AbsToCon C.Pattern -> AbsToCon C.Pattern
    tryToRecoverPatternSynP :: Pattern -> AbsToCon Pattern -> AbsToCon Pattern
    tryToRecoverPatternSynP = (QName -> [NamedArg Pattern] -> Pattern)
    -> (PatternSynDefn -> Pattern -> Maybe [Arg Pattern])
    -> Pattern
    -> AbsToCon (ConOfAbs Pattern)
    -> AbsToCon (ConOfAbs Pattern)
    forall a.
    ToConcrete a =>
    (QName -> [NamedArg a] -> a)
    -> (PatternSynDefn -> a -> Maybe [Arg a])
    -> a
    -> AbsToCon (ConOfAbs a)
    -> AbsToCon (ConOfAbs a)
    recoverPatternSyn QName -> [NamedArg Pattern] -> Pattern
    forall {e}. QName -> NAPs e -> Pattern' e
    apply PatternSynDefn -> Pattern -> Maybe [Arg Pattern]
    forall e. PatternSynDefn -> Pattern' e -> Maybe [Arg (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 :: ToConcrete a =>
      (A.QName -> [NamedArg a] -> a)         -> -- applySyn
      (PatternSynDefn -> a -> Maybe [Arg a]) -> -- match
      a -> AbsToCon (ConOfAbs a) -> AbsToCon (ConOfAbs a)
    recoverPatternSyn :: forall a.
    ToConcrete a =>
    (QName -> [NamedArg a] -> a)
    -> (PatternSynDefn -> a -> Maybe [Arg a])
    -> a
    -> AbsToCon (ConOfAbs a)
    -> AbsToCon (ConOfAbs a)
    recoverPatternSyn QName -> [NamedArg a] -> a
    applySyn PatternSynDefn -> a -> Maybe [Arg a]
    match a
    e AbsToCon (ConOfAbs a)
    fallback = do
      Bool
    doFold <- (Env -> Bool) -> AbsToCon Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Env -> Bool
    foldPatternSynonyms
      if Bool -> Bool
    not Bool
    doFold then AbsToCon (ConOfAbs a)
    fallback else do
        PatternSynDefns
    psyns  <- AbsToCon PatternSynDefns
    forall (m :: * -> *). ReadTCState m => m PatternSynDefns
    getAllPatternSyns
        ScopeInfo
    scope  <- AbsToCon ScopeInfo
    forall (m :: * -> *). ReadTCState m => m ScopeInfo
    getScope
        RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete.patsyn" VerboseLevel
    100 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> RawName
    render (Doc -> RawName) -> Doc -> RawName
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    hsep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $
          [ Doc
    "Scope when attempting to recover pattern synonyms:"
          , ScopeInfo -> Doc
    forall a. Pretty a => a -> Doc
    pretty ScopeInfo
    scope
          ]
        let isConP :: Pattern' e -> Bool
    isConP ConP{} = Bool
    True    -- #2828: only fold pattern synonyms with
            isConP Pattern' e
    _      = Bool
    False   --        constructor rhs
            cands :: [(QName, [Arg a], VerboseLevel)]
    cands = [ (QName
    q, [Arg a]
    args, Pattern' Void -> VerboseLevel
    score Pattern' Void
    rhs)
                    | (QName
    q, psyndef :: PatternSynDefn
    psyndef@([Arg 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 [Arg a]
    args <- [PatternSynDefn -> a -> Maybe [Arg 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 (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) -> (a, b, a) -> Ordering
    cmp (a
    _, b
    _, a
    x) (a
    _, b
    _, a
    y) = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    y a
    x
        RawName -> VerboseLevel -> RawName -> AbsToCon ()
    forall (m :: * -> *).
    MonadDebug m =>
    RawName -> VerboseLevel -> RawName -> m ()
    reportSLn RawName
    "toConcrete.patsyn" VerboseLevel
    50 (RawName -> AbsToCon ()) -> RawName -> AbsToCon ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> RawName
    render (Doc -> RawName) -> Doc -> RawName
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    hsep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $
          [ Doc
    "Found pattern synonym candidates:"
          , [QName] -> Doc
    forall a. Pretty a => [a] -> Doc
    prettyList_ ([QName] -> Doc) -> [QName] -> Doc
    forall a b. (a -> b) -> a -> b
    $ ((QName, [Arg a], VerboseLevel) -> QName)
    -> [(QName, [Arg a], VerboseLevel)] -> [QName]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ (QName
    q,[Arg a]
    _,VerboseLevel
    _) -> QName
    q) [(QName, [Arg a], VerboseLevel)]
    cands
          ]
        case ((QName, [Arg a], VerboseLevel)
     -> (QName, [Arg a], VerboseLevel) -> Ordering)
    -> [(QName, [Arg a], VerboseLevel)]
    -> [(QName, [Arg a], VerboseLevel)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (QName, [Arg a], VerboseLevel)
    -> (QName, [Arg a], VerboseLevel) -> Ordering
    forall {a} {a} {b} {a} {b}.
    Ord a =>
    (a, b, a) -> (a, b, a) -> Ordering
    cmp [(QName, [Arg a], VerboseLevel)]
    cands of
          (QName
    q, [Arg a]
    args, VerboseLevel
    _) : [(QName, [Arg a], VerboseLevel)]
    _ -> a -> AbsToCon (ConOfAbs a)
    forall a. ToConcrete a => a -> AbsToCon (ConOfAbs a)
    toConcrete (a -> AbsToCon (ConOfAbs a)) -> a -> AbsToCon (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
    $ ((Arg a -> NamedArg a) -> [Arg a] -> [NamedArg a]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Arg a -> NamedArg a) -> [Arg a] -> [NamedArg a])
    -> ((a -> Named NamedName a) -> Arg a -> NamedArg a)
    -> (a -> Named NamedName a)
    -> [Arg a]
    -> [NamedArg a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Named NamedName a) -> Arg a -> NamedArg a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) a -> Named NamedName a
    forall a name. a -> Named name a
    unnamed [Arg a]
    args
          []               -> AbsToCon (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' (ADotT (Pattern' Void)) -> Sum VerboseLevel
    forall {p} {e}. Num p => Pattern' e -> p
    con
          where con :: Pattern' e -> p
    con ConP{} = p
    1
                con Pattern' e
    _      = p
    0

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

    instance ToConcrete InteractionId where
        type ConOfAbs InteractionId = C.Expr
        toConcrete :: InteractionId -> AbsToCon (ConOfAbs InteractionId)
    toConcrete (InteractionId VerboseLevel
    i) = Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon 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 :: NamedMeta -> AbsToCon (ConOfAbs NamedMeta)
    toConcrete NamedMeta
    i = do
          Expr -> AbsToCon Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> AbsToCon Expr) -> Expr -> AbsToCon Expr
    forall a b. (a -> b) -> a -> b
    $ Range -> Maybe RawName -> Expr
    C.Underscore Range
    forall a. Range' a
    noRange (RawName -> Maybe RawName
    forall a. a -> Maybe a
    Just (RawName -> Maybe RawName) -> RawName -> Maybe RawName
    forall a b. (a -> b) -> a -> b
    $ NamedMeta -> RawName
    forall a. Pretty a => a -> RawName
    prettyShow NamedMeta
    i)