    {-| Translation from "Agda.Syntax.Concrete" to "Agda.Syntax.Abstract". Involves scope analysis,
        figuring out infix operator precedences and tidying up definitions.
    -}
    module Agda.Syntax.Translation.ConcreteToAbstract
        ( ToAbstract(..), localToAbstract
        , concreteToAbstract_
        , concreteToAbstract
        , NewModuleQName(..)
        , TopLevel(..)
        , TopLevelInfo(..)
        , topLevelModuleName
        , AbstractRHS
        , NewModuleName, OldModuleName
        , NewName, OldQName
        , PatName, APatName
        , importPrimitives
        ) where

    import Prelude hiding ( null )

    import Control.Monad        ( (<=<), foldM, forM, forM_, zipWithM, zipWithM_ )
    import Control.Applicative  ( liftA2, liftA3 )
    import Control.Monad.Except ( MonadError(..) )

    import Data.Bifunctor
    import Data.Foldable (traverse_)
    import Data.Set (Set)
    import Data.Map (Map)
    import Data.Functor (void)
    import qualified Data.List as List
    import Data.List.NonEmpty (NonEmpty(..))
    import qualified Data.List.NonEmpty as NonEmpty
    import qualified Data.Set as Set
    import qualified Data.Map as Map
    import Data.Maybe
    import Data.Monoid (First(..))
    import Data.Void

    import Agda.Syntax.Concrete as C hiding (topLevelModuleName)
    import Agda.Syntax.Concrete.Generic
    import Agda.Syntax.Concrete.Operators
    import Agda.Syntax.Concrete.Pattern
    import Agda.Syntax.Abstract as A
    import Agda.Syntax.Abstract.Pattern as A ( patternVars, checkPatternLinearity, containsAsPattern, lhsCoreApp, lhsCoreWith )
    import Agda.Syntax.Abstract.Pretty
    import qualified Agda.Syntax.Internal as I
    import Agda.Syntax.Position
    import Agda.Syntax.Literal
    import Agda.Syntax.Common
    import Agda.Syntax.Info
    import Agda.Syntax.Concrete.Definitions as C
    import Agda.Syntax.Fixity
    import Agda.Syntax.Concrete.Fixity (DoWarn(..))
    import Agda.Syntax.Notation
    import Agda.Syntax.Scope.Base as A
    import Agda.Syntax.Scope.Monad
    import Agda.Syntax.Translation.AbstractToConcrete (ToConcrete, ConOfAbs)
    import Agda.Syntax.DoNotation
    import Agda.Syntax.IdiomBrackets

    import Agda.TypeChecking.Monad.Base hiding (ModuleInfo, MetaInfo)
    import Agda.TypeChecking.Monad.Builtin
    import Agda.TypeChecking.Monad.Trace (traceCall, setCurrentRange)
    import Agda.TypeChecking.Monad.State
    import Agda.TypeChecking.Monad.MetaVars (registerInteractionPoint)
    import Agda.TypeChecking.Monad.Debug
    import Agda.TypeChecking.Monad.Env (insideDotPattern, isInsideDotPattern, getCurrentPath)
    import Agda.TypeChecking.Rules.Builtin (isUntypedBuiltin, bindUntypedBuiltin, builtinKindOfName)

    import Agda.TypeChecking.Patterns.Abstract (expandPatternSynonyms)
    import Agda.TypeChecking.Pretty hiding (pretty, prettyA)
    import Agda.TypeChecking.Quote (quotedName)
    import Agda.TypeChecking.Warnings

    import Agda.Interaction.FindFile (checkModuleName, rootNameModule, SourceFile(SourceFile))
    -- import Agda.Interaction.Imports  -- for type-checking in ghci
    import {-# SOURCE #-} Agda.Interaction.Imports (scopeCheckImport)
    import Agda.Interaction.Options
    import qualified Agda.Interaction.Options.Lenses as Lens
    import Agda.Interaction.Options.Warnings

    import qualified Agda.Utils.AssocList as AssocList
    import Agda.Utils.CallStack ( HasCallStack, withCurrentCallStack )
    import Agda.Utils.Char
    import Agda.Utils.Either
    import Agda.Utils.FileName
    import Agda.Utils.Functor
    import Agda.Utils.Lens
    import Agda.Utils.List
    import Agda.Utils.List1 ( List1, pattern (:|) )
    import Agda.Utils.List2 ( List2, pattern List2 )
    import qualified Agda.Utils.List1 as List1
    import qualified Agda.Utils.Map as Map
    import Agda.Utils.Maybe
    import Agda.Utils.Monad
    import Agda.Utils.Null
    import qualified Agda.Utils.Pretty as P
    import Agda.Utils.Pretty (render, Pretty, pretty, prettyShow)
    import Agda.Utils.Singleton
    import Agda.Utils.Tuple

    import Agda.Utils.Impossible
    import Agda.ImpossibleTest (impossibleTest, impossibleTestReduceM)

    {--------------------------------------------------------------------------
        Exceptions
     --------------------------------------------------------------------------}

    notAnExpression :: (HasCallStack, MonadTCError m) => C.Expr -> m a
    notAnExpression :: forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Expr -> m a
    notAnExpression = (Expr -> TypeError) -> HasCallStack => Expr -> m a
    forall (m :: * -> *) a b.
    MonadTCError m =>
    (a -> TypeError) -> HasCallStack => a -> m b
    locatedTypeError Expr -> TypeError
    NotAnExpression

    nothingAppliedToHiddenArg :: (HasCallStack, MonadTCError m) => C.Expr -> m a
    nothingAppliedToHiddenArg :: forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Expr -> m a
    nothingAppliedToHiddenArg = (Expr -> TypeError) -> HasCallStack => Expr -> m a
    forall (m :: * -> *) a b.
    MonadTCError m =>
    (a -> TypeError) -> HasCallStack => a -> m b
    locatedTypeError Expr -> TypeError
    NothingAppliedToHiddenArg

    nothingAppliedToInstanceArg :: (HasCallStack, MonadTCError m) => C.Expr -> m a
    nothingAppliedToInstanceArg :: forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Expr -> m a
    nothingAppliedToInstanceArg = (Expr -> TypeError) -> HasCallStack => Expr -> m a
    forall (m :: * -> *) a b.
    MonadTCError m =>
    (a -> TypeError) -> HasCallStack => a -> m b
    locatedTypeError Expr -> TypeError
    NothingAppliedToInstanceArg

    notAValidLetBinding :: (HasCallStack, MonadTCError m) => C.NiceDeclaration -> m a
    notAValidLetBinding :: forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    NiceDeclaration -> m a
    notAValidLetBinding = (NiceDeclaration -> TypeError)
    -> HasCallStack => NiceDeclaration -> m a
    forall (m :: * -> *) a b.
    MonadTCError m =>
    (a -> TypeError) -> HasCallStack => a -> m b
    locatedTypeError NiceDeclaration -> TypeError
    NotAValidLetBinding

    {--------------------------------------------------------------------------
        Helpers
     --------------------------------------------------------------------------}
    --UNUSED Liang-Ting Chen 2019-07-16
    --annotateDecl :: ScopeM A.Declaration -> ScopeM A.Declaration
    --annotateDecl m = annotateDecls $ (:[]) <$> m

    -- | Make sure that there are no dot patterns (called on pattern synonyms).
    noDotorEqPattern :: String -> A.Pattern' e -> ScopeM (A.Pattern' Void)
    noDotorEqPattern :: forall e. [Char] -> Pattern' e -> ScopeM (Pattern' Void)
    noDotorEqPattern [Char]
    err = Pattern' e -> ScopeM (Pattern' Void)
    forall e. Pattern' e -> ScopeM (Pattern' Void)
    dot
      where
        dot :: A.Pattern' e -> ScopeM (A.Pattern' Void)
        dot :: forall e. Pattern' e -> ScopeM (Pattern' Void)
    dot = \case
          A.VarP BindName
    x               -> Pattern' Void -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pattern' Void -> ScopeM (Pattern' Void))
    -> Pattern' Void -> ScopeM (Pattern' Void)
    forall a b. (a -> b) -> a -> b
    $ BindName -> Pattern' Void
    forall e. BindName -> Pattern' e
    A.VarP BindName
    x
          A.ConP ConPatInfo
    i AmbiguousQName
    c NAPs e
    args        -> ConPatInfo -> AmbiguousQName -> NAPs Void -> Pattern' Void
    forall e. ConPatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.ConP ConPatInfo
    i AmbiguousQName
    c (NAPs Void -> Pattern' Void)
    -> TCMT IO (NAPs Void) -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Arg (Named NamedName (Pattern' e))
     -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
    -> NAPs e -> TCMT IO (NAPs Void)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Arg (Named NamedName (Pattern' e))
      -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
     -> NAPs e -> TCMT IO (NAPs Void))
    -> (Arg (Named NamedName (Pattern' e))
        -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
    -> NAPs e
    -> TCMT IO (NAPs Void)
    forall a b. (a -> b) -> a -> b
    $ (Named NamedName (Pattern' e)
     -> TCMT IO (Named NamedName (Pattern' Void)))
    -> Arg (Named NamedName (Pattern' e))
    -> TCMT IO (Arg (Named NamedName (Pattern' Void)))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Named NamedName (Pattern' e)
      -> TCMT IO (Named NamedName (Pattern' Void)))
     -> Arg (Named NamedName (Pattern' e))
     -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
    -> (Named NamedName (Pattern' e)
        -> TCMT IO (Named NamedName (Pattern' Void)))
    -> Arg (Named NamedName (Pattern' e))
    -> TCMT IO (Arg (Named NamedName (Pattern' Void)))
    forall a b. (a -> b) -> a -> b
    $ (Pattern' e -> ScopeM (Pattern' Void))
    -> Named NamedName (Pattern' e)
    -> TCMT IO (Named NamedName (Pattern' Void))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Pattern' e -> ScopeM (Pattern' Void)
    forall e. Pattern' e -> ScopeM (Pattern' Void)
    dot) NAPs e
    args
          A.ProjP PatInfo
    i ProjOrigin
    o AmbiguousQName
    d          -> Pattern' Void -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pattern' Void -> ScopeM (Pattern' Void))
    -> Pattern' Void -> ScopeM (Pattern' Void)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> ProjOrigin -> AmbiguousQName -> Pattern' Void
    forall e. PatInfo -> ProjOrigin -> AmbiguousQName -> Pattern' e
    A.ProjP PatInfo
    i ProjOrigin
    o AmbiguousQName
    d
          A.WildP PatInfo
    i              -> Pattern' Void -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pattern' Void -> ScopeM (Pattern' Void))
    -> Pattern' Void -> ScopeM (Pattern' Void)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Pattern' Void
    forall e. PatInfo -> Pattern' e
    A.WildP PatInfo
    i
          A.AsP PatInfo
    i BindName
    x Pattern' e
    p            -> PatInfo -> BindName -> Pattern' Void -> Pattern' Void
    forall e. PatInfo -> BindName -> Pattern' e -> Pattern' e
    A.AsP PatInfo
    i BindName
    x (Pattern' Void -> Pattern' Void)
    -> ScopeM (Pattern' Void) -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pattern' e -> ScopeM (Pattern' Void)
    forall e. Pattern' e -> ScopeM (Pattern' Void)
    dot Pattern' e
    p
          A.DotP{}               -> [Char] -> ScopeM (Pattern' Void)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    err
          A.EqualP{}             -> [Char] -> ScopeM (Pattern' Void)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    err   -- Andrea: so we also disallow = patterns, reasonable?
          A.AbsurdP PatInfo
    i            -> Pattern' Void -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pattern' Void -> ScopeM (Pattern' Void))
    -> Pattern' Void -> ScopeM (Pattern' Void)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Pattern' Void
    forall e. PatInfo -> Pattern' e
    A.AbsurdP PatInfo
    i
          A.LitP PatInfo
    i Literal
    l             -> Pattern' Void -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pattern' Void -> ScopeM (Pattern' Void))
    -> Pattern' Void -> ScopeM (Pattern' Void)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Literal -> Pattern' Void
    forall e. PatInfo -> Literal -> Pattern' e
    A.LitP PatInfo
    i Literal
    l
          A.DefP PatInfo
    i AmbiguousQName
    f NAPs e
    args        -> PatInfo -> AmbiguousQName -> NAPs Void -> Pattern' Void
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.DefP PatInfo
    i AmbiguousQName
    f (NAPs Void -> Pattern' Void)
    -> TCMT IO (NAPs Void) -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Arg (Named NamedName (Pattern' e))
     -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
    -> NAPs e -> TCMT IO (NAPs Void)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Arg (Named NamedName (Pattern' e))
      -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
     -> NAPs e -> TCMT IO (NAPs Void))
    -> (Arg (Named NamedName (Pattern' e))
        -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
    -> NAPs e
    -> TCMT IO (NAPs Void)
    forall a b. (a -> b) -> a -> b
    $ (Named NamedName (Pattern' e)
     -> TCMT IO (Named NamedName (Pattern' Void)))
    -> Arg (Named NamedName (Pattern' e))
    -> TCMT IO (Arg (Named NamedName (Pattern' Void)))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Named NamedName (Pattern' e)
      -> TCMT IO (Named NamedName (Pattern' Void)))
     -> Arg (Named NamedName (Pattern' e))
     -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
    -> (Named NamedName (Pattern' e)
        -> TCMT IO (Named NamedName (Pattern' Void)))
    -> Arg (Named NamedName (Pattern' e))
    -> TCMT IO (Arg (Named NamedName (Pattern' Void)))
    forall a b. (a -> b) -> a -> b
    $ (Pattern' e -> ScopeM (Pattern' Void))
    -> Named NamedName (Pattern' e)
    -> TCMT IO (Named NamedName (Pattern' Void))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Pattern' e -> ScopeM (Pattern' Void)
    forall e. Pattern' e -> ScopeM (Pattern' Void)
    dot) NAPs e
    args
          A.PatternSynP PatInfo
    i AmbiguousQName
    c NAPs e
    args -> PatInfo -> AmbiguousQName -> NAPs Void -> Pattern' Void
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.PatternSynP PatInfo
    i AmbiguousQName
    c (NAPs Void -> Pattern' Void)
    -> TCMT IO (NAPs Void) -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Arg (Named NamedName (Pattern' e))
     -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
    -> NAPs e -> TCMT IO (NAPs Void)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Arg (Named NamedName (Pattern' e))
      -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
     -> NAPs e -> TCMT IO (NAPs Void))
    -> (Arg (Named NamedName (Pattern' e))
        -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
    -> NAPs e
    -> TCMT IO (NAPs Void)
    forall a b. (a -> b) -> a -> b
    $ (Named NamedName (Pattern' e)
     -> TCMT IO (Named NamedName (Pattern' Void)))
    -> Arg (Named NamedName (Pattern' e))
    -> TCMT IO (Arg (Named NamedName (Pattern' Void)))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Named NamedName (Pattern' e)
      -> TCMT IO (Named NamedName (Pattern' Void)))
     -> Arg (Named NamedName (Pattern' e))
     -> TCMT IO (Arg (Named NamedName (Pattern' Void))))
    -> (Named NamedName (Pattern' e)
        -> TCMT IO (Named NamedName (Pattern' Void)))
    -> Arg (Named NamedName (Pattern' e))
    -> TCMT IO (Arg (Named NamedName (Pattern' Void)))
    forall a b. (a -> b) -> a -> b
    $ (Pattern' e -> ScopeM (Pattern' Void))
    -> Named NamedName (Pattern' e)
    -> TCMT IO (Named NamedName (Pattern' Void))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Pattern' e -> ScopeM (Pattern' Void)
    forall e. Pattern' e -> ScopeM (Pattern' Void)
    dot) NAPs e
    args
          A.RecP PatInfo
    i [FieldAssignment' (Pattern' e)]
    fs            -> PatInfo -> [FieldAssignment' (Pattern' Void)] -> Pattern' Void
    forall e. PatInfo -> [FieldAssignment' (Pattern' e)] -> Pattern' e
    A.RecP PatInfo
    i ([FieldAssignment' (Pattern' Void)] -> Pattern' Void)
    -> TCMT IO [FieldAssignment' (Pattern' Void)]
    -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((FieldAssignment' (Pattern' e)
     -> TCMT IO (FieldAssignment' (Pattern' Void)))
    -> [FieldAssignment' (Pattern' e)]
    -> TCMT IO [FieldAssignment' (Pattern' Void)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((FieldAssignment' (Pattern' e)
      -> TCMT IO (FieldAssignment' (Pattern' Void)))
     -> [FieldAssignment' (Pattern' e)]
     -> TCMT IO [FieldAssignment' (Pattern' Void)])
    -> (FieldAssignment' (Pattern' e)
        -> TCMT IO (FieldAssignment' (Pattern' Void)))
    -> [FieldAssignment' (Pattern' e)]
    -> TCMT IO [FieldAssignment' (Pattern' Void)]
    forall a b. (a -> b) -> a -> b
    $ (Pattern' e -> ScopeM (Pattern' Void))
    -> FieldAssignment' (Pattern' e)
    -> TCMT IO (FieldAssignment' (Pattern' Void))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Pattern' e -> ScopeM (Pattern' Void)
    forall e. Pattern' e -> ScopeM (Pattern' Void)
    dot) [FieldAssignment' (Pattern' e)]
    fs
          A.WithP PatInfo
    i Pattern' e
    p            -> PatInfo -> Pattern' Void -> Pattern' Void
    forall e. PatInfo -> Pattern' e -> Pattern' e
    A.WithP PatInfo
    i (Pattern' Void -> Pattern' Void)
    -> ScopeM (Pattern' Void) -> ScopeM (Pattern' Void)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pattern' e -> ScopeM (Pattern' Void)
    forall e. Pattern' e -> ScopeM (Pattern' Void)
    dot Pattern' e
    p
          A.AnnP PatInfo
    i e
    a Pattern' e
    p           -> [Char] -> ScopeM (Pattern' Void)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    err   -- TODO: should this be allowed?
    --UNUSED Liang-Ting Chen 2019-07-16
    ---- | Make sure that there are no dot patterns (WAS: called on pattern synonyms).
    --noDotPattern :: String -> A.Pattern' e -> ScopeM (A.Pattern' Void)
    --noDotPattern err = traverse $ const $ genericError err

    newtype RecordConstructorType = RecordConstructorType [C.Declaration]

    instance ToAbstract RecordConstructorType where
      type AbsOfCon RecordConstructorType = A.Expr
      toAbstract :: RecordConstructorType -> ScopeM (AbsOfCon RecordConstructorType)
    toAbstract (RecordConstructorType [Declaration]
    ds) = [Declaration] -> ScopeM Expr
    recordConstructorType [Declaration]
    ds

    -- | Compute the type of the record constructor (with bogus target type)
    recordConstructorType :: [C.Declaration] -> ScopeM A.Expr
    recordConstructorType :: [Declaration] -> ScopeM Expr
    recordConstructorType [Declaration]
    decls =
        -- Nicify all declarations since there might be fixity declarations after
        -- the the last field. Use NoWarn to silence fixity warnings. We'll get
        -- them again when scope checking the declarations to build the record
        -- module.
        DoWarn
    -> [Declaration]
    -> ([NiceDeclaration] -> ScopeM Expr)
    -> ScopeM Expr
    forall a.
    DoWarn
    -> [Declaration] -> ([NiceDeclaration] -> ScopeM a) -> ScopeM a
    niceDecls DoWarn
    NoWarn [Declaration]
    decls (([NiceDeclaration] -> ScopeM Expr) -> ScopeM Expr)
    -> ([NiceDeclaration] -> ScopeM Expr) -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ [NiceDeclaration] -> ScopeM Expr
    buildType ([NiceDeclaration] -> ScopeM Expr)
    -> ([NiceDeclaration] -> [NiceDeclaration])
    -> [NiceDeclaration]
    -> ScopeM Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [NiceDeclaration] -> [NiceDeclaration]
    takeFields
      where
        takeFields :: [NiceDeclaration] -> [NiceDeclaration]
    takeFields = (NiceDeclaration -> Bool) -> [NiceDeclaration] -> [NiceDeclaration]
    forall a. (a -> Bool) -> [a] -> [a]
    List.dropWhileEnd NiceDeclaration -> Bool
    notField

        notField :: NiceDeclaration -> Bool
    notField NiceField{} = Bool
    False
        notField NiceDeclaration
    _           = Bool
    True

        buildType :: [C.NiceDeclaration] -> ScopeM A.Expr
          -- TODO: Telescope instead of Expr in abstract RecDef
        buildType :: [NiceDeclaration] -> ScopeM Expr
    buildType [NiceDeclaration]
    ds = do
          Expr
    dummy <- QName -> Expr
    A.Def (QName -> Expr) -> (Maybe QName -> QName) -> Maybe QName -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Maybe QName -> QName
    forall a. a -> Maybe a -> a
    fromMaybe QName
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe QName -> Expr) -> TCMT IO (Maybe QName) -> ScopeM Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> TCMT IO (Maybe QName)
    forall (m :: * -> *). HasBuiltins m => [Char] -> m (Maybe QName)
    getBuiltinName' [Char]
    builtinSet
          [TypedBinding]
    tel   <- [Maybe TypedBinding] -> [TypedBinding]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe TypedBinding] -> [TypedBinding])
    -> TCMT IO [Maybe TypedBinding] -> TCMT IO [TypedBinding]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (NiceDeclaration -> TCMT IO (Maybe TypedBinding))
    -> [NiceDeclaration] -> TCMT IO [Maybe TypedBinding]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM NiceDeclaration -> TCMT IO (Maybe TypedBinding)
    makeBinding [NiceDeclaration]
    ds
          Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> [TypedBinding] -> Expr -> Expr
    A.mkPi (Range -> ExprInfo
    ExprRange ([NiceDeclaration] -> Range
    forall a. HasRange a => a -> Range
    getRange [NiceDeclaration]
    ds)) [TypedBinding]
    tel Expr
    dummy

        makeBinding :: C.NiceDeclaration -> ScopeM (Maybe A.TypedBinding)
        makeBinding :: NiceDeclaration -> TCMT IO (Maybe TypedBinding)
    makeBinding NiceDeclaration
    d = do
          let failure :: TCMT IO (Maybe TypedBinding)
    failure = TypeError -> TCMT IO (Maybe TypedBinding)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO (Maybe TypedBinding))
    -> TypeError -> TCMT IO (Maybe TypedBinding)
    forall a b. (a -> b) -> a -> b
    $ NiceDeclaration -> TypeError
    NotValidBeforeField NiceDeclaration
    d
              r :: Range
    r       = NiceDeclaration -> Range
    forall a. HasRange a => a -> Range
    getRange NiceDeclaration
    d
              mkLet :: NiceDeclaration -> TCMT IO (Maybe TypedBinding)
    mkLet NiceDeclaration
    d = TypedBinding -> Maybe TypedBinding
    forall a. a -> Maybe a
    Just (TypedBinding -> Maybe TypedBinding)
    -> (List1 LetBinding -> TypedBinding)
    -> List1 LetBinding
    -> Maybe TypedBinding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> List1 LetBinding -> TypedBinding
    A.TLet Range
    r (List1 LetBinding -> Maybe TypedBinding)
    -> TCMT IO (List1 LetBinding) -> TCMT IO (Maybe TypedBinding)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> LetDef -> ScopeM (AbsOfCon LetDef)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (NiceDeclaration -> LetDef
    LetDef NiceDeclaration
    d)
          Call
    -> TCMT IO (Maybe TypedBinding) -> TCMT IO (Maybe TypedBinding)
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Range -> Call
    SetRange Range
    r) (TCMT IO (Maybe TypedBinding) -> TCMT IO (Maybe TypedBinding))
    -> TCMT IO (Maybe TypedBinding) -> TCMT IO (Maybe TypedBinding)
    forall a b. (a -> b) -> a -> b
    $ case NiceDeclaration
    d of

            C.NiceField Range
    r Access
    pr IsAbstract
    ab IsInstance
    inst TacticAttribute
    tac Name
    x Arg Expr
    a -> do
              Fixity'
    fx  <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
              let bv :: NamedArg Binder
    bv = Binder -> Named NamedName Binder
    forall a name. a -> Named name a
    unnamed (BoundName -> Binder
    forall a. a -> Binder' a
    C.mkBinder (BoundName -> Binder) -> BoundName -> Binder
    forall a b. (a -> b) -> a -> b
    $ (Name -> Fixity' -> BoundName
    C.mkBoundName Name
    x Fixity'
    fx) { bnameTactic :: TacticAttribute
    bnameTactic = TacticAttribute
    tac }) Named NamedName Binder -> Arg Expr -> NamedArg Binder
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Arg Expr
    a
              TypedBinding -> ScopeM (AbsOfCon TypedBinding)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (TypedBinding -> ScopeM (AbsOfCon TypedBinding))
    -> TypedBinding -> ScopeM (AbsOfCon TypedBinding)
    forall a b. (a -> b) -> a -> b
    $ Range -> List1 (NamedArg Binder) -> Expr -> TypedBinding
    forall e. Range -> List1 (NamedArg Binder) -> e -> TypedBinding' e
    C.TBind Range
    r (NamedArg Binder -> List1 (NamedArg Binder)
    forall el coll. Singleton el coll => el -> coll
    singleton NamedArg Binder
    bv) (Arg Expr -> Expr
    forall e. Arg e -> e
    unArg Arg Expr
    a)

            -- Public open is allowed and will take effect when scope checking as
            -- proper declarations.
            C.NiceOpen Range
    r QName
    m ImportDirective
    dir -> do
              NiceDeclaration -> TCMT IO (Maybe TypedBinding)
    mkLet (NiceDeclaration -> TCMT IO (Maybe TypedBinding))
    -> NiceDeclaration -> TCMT IO (Maybe TypedBinding)
    forall a b. (a -> b) -> a -> b
    $ Range -> QName -> ImportDirective -> NiceDeclaration
    C.NiceOpen Range
    r QName
    m ImportDirective
    dir{ publicOpen :: Maybe Range
    publicOpen = Maybe Range
    forall a. Maybe a
    Nothing }
            C.NiceModuleMacro Range
    r Access
    p Name
    x ModuleApplication
    modapp OpenShortHand
    open ImportDirective
    dir -> do
              NiceDeclaration -> TCMT IO (Maybe TypedBinding)
    mkLet (NiceDeclaration -> TCMT IO (Maybe TypedBinding))
    -> NiceDeclaration -> TCMT IO (Maybe TypedBinding)
    forall a b. (a -> b) -> a -> b
    $ Range
    -> Access
    -> Name
    -> ModuleApplication
    -> OpenShortHand
    -> ImportDirective
    -> NiceDeclaration
    C.NiceModuleMacro Range
    r Access
    p Name
    x ModuleApplication
    modapp OpenShortHand
    open ImportDirective
    dir{ publicOpen :: Maybe Range
    publicOpen = Maybe Range
    forall a. Maybe a
    Nothing }

            -- Do some rudimentary matching here to get NotValidBeforeField instead
            -- of NotAValidLetDecl.
            C.NiceMutual Range
    _ TerminationCheck
    _ CoverageCheck
    _ PositivityCheck
    _
              [ C.FunSig Range
    _ Access
    _ IsAbstract
    _ IsInstance
    _ IsMacro
    macro ArgInfo
    _ TerminationCheck
    _ CoverageCheck
    _ Name
    _ Expr
    _
              , C.FunDef Range
    _ [Declaration]
    _ IsAbstract
    abstract IsInstance
    _ TerminationCheck
    _ CoverageCheck
    _ Name
    _
                 [ C.Clause Name
    _ Bool
    _ (C.LHS Pattern
    _p [] []) (C.RHS Expr
    _) WhereClause' [Declaration]
    NoWhere [] ]
              ] | IsAbstract
    abstract IsAbstract -> IsAbstract -> Bool
    forall a. Eq a => a -> a -> Bool
    /= IsAbstract
    AbstractDef Bool -> Bool -> Bool
    && IsMacro
    macro IsMacro -> IsMacro -> Bool
    forall a. Eq a => a -> a -> Bool
    /= IsMacro
    MacroDef -> do
              NiceDeclaration -> TCMT IO (Maybe TypedBinding)
    mkLet NiceDeclaration
    d

            C.NiceLoneConstructor{} -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceMutual{}        -> TCMT IO (Maybe TypedBinding)
    failure
            -- TODO: some of these cases might be __IMPOSSIBLE__
            C.Axiom{}             -> TCMT IO (Maybe TypedBinding)
    failure
            C.PrimitiveFunction{} -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceModule{}        -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceImport{}        -> TCMT IO (Maybe TypedBinding)
    failure
            C.NicePragma{}        -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceRecSig{}        -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceDataSig{}       -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceFunClause{}     -> TCMT IO (Maybe TypedBinding)
    failure
            C.FunSig{}            -> TCMT IO (Maybe TypedBinding)
    failure  -- Note: these are bundled with FunDef in NiceMutual
            C.FunDef{}            -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceDataDef{}       -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceRecDef{}        -> TCMT IO (Maybe TypedBinding)
    failure
            C.NicePatternSyn{}    -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceGeneralize{}    -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceUnquoteDecl{}   -> TCMT IO (Maybe TypedBinding)
    failure
            C.NiceUnquoteDef{}    -> TCMT IO (Maybe TypedBinding)
    failure

    checkModuleApplication
      :: C.ModuleApplication
      -> ModuleName
      -> C.Name
      -> C.ImportDirective
      -> ScopeM (A.ModuleApplication, ScopeCopyInfo, A.ImportDirective)

    checkModuleApplication :: ModuleApplication
    -> ModuleName
    -> Name
    -> ImportDirective
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    checkModuleApplication (C.SectionApp Range
    _ Telescope
    tel Expr
    e) ModuleName
    m0 Name
    x ImportDirective
    dir' = do
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
        [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "scope checking ModuleApplication " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
        ]

      -- For the following, set the current module to be m0.
      ModuleName
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    forall (m :: * -> *) a.
    (ReadTCState m, MonadTCState m) =>
    ModuleName -> m a -> m a
    withCurrentModule ModuleName
    m0 (ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
     -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective))
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    forall a b. (a -> b) -> a -> b
    $ do
        -- Check that expression @e@ is of the form @m args@.
        (QName
    m, [NamedArg Expr]
    args) <- Expr -> ScopeM (QName, [NamedArg Expr])
    parseModuleApplication Expr
    e
        -- Scope check the telescope (introduces bindings!).
        [TypedBinding]
    tel' <- [Maybe TypedBinding] -> [TypedBinding]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe TypedBinding] -> [TypedBinding])
    -> TCMT IO [Maybe TypedBinding] -> TCMT IO [TypedBinding]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Telescope -> ScopeM (AbsOfCon Telescope)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Telescope
    tel
        -- Scope check the old module name and the module args.
        ModuleName
    m1    <- OldModuleName -> ScopeM (AbsOfCon OldModuleName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (OldModuleName -> ScopeM (AbsOfCon OldModuleName))
    -> OldModuleName -> ScopeM (AbsOfCon OldModuleName)
    forall a b. (a -> b) -> a -> b
    $ QName -> OldModuleName
    OldModuleName QName
    m
        [NamedArg Expr]
    args' <- Precedence -> [NamedArg Expr] -> ScopeM (AbsOfCon [NamedArg Expr])
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx (ParenPreference -> Precedence
    ArgumentCtx ParenPreference
    PreferParen) [NamedArg Expr]
    args
        -- Copy the scope associated with m and take the parts actually imported.
        (ImportDirective
    adir, Scope
    s) <- QName
    -> ImportDirective -> Scope -> ScopeM (ImportDirective, Scope)
    applyImportDirectiveM (Name -> QName
    C.QName Name
    x) ImportDirective
    dir' (Scope -> ScopeM (ImportDirective, Scope))
    -> TCMT IO Scope -> ScopeM (ImportDirective, Scope)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ModuleName -> TCMT IO Scope
    getNamedScope ModuleName
    m1
        (Scope
    s', ScopeCopyInfo
    copyInfo) <- QName -> ModuleName -> Scope -> ScopeM (Scope, ScopeCopyInfo)
    copyScope QName
    m ModuleName
    m0 Scope
    s
        -- Set the current scope to @s'@
        (Scope -> Scope) -> TCMT IO ()
    modifyCurrentScope ((Scope -> Scope) -> TCMT IO ()) -> (Scope -> Scope) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Scope -> Scope -> Scope
    forall a b. a -> b -> a
    const Scope
    s'
        [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "mod.inst" Int
    20 [Char]
    "copied source module"
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.mod.inst" Int
    30 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> TCMT IO Doc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> TCMT IO Doc) -> Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ ScopeCopyInfo -> Doc
    forall a. Pretty a => a -> Doc
    pretty ScopeCopyInfo
    copyInfo
        let amodapp :: ModuleApplication
    amodapp = [TypedBinding]
    -> ModuleName -> [NamedArg Expr] -> ModuleApplication
    A.SectionApp [TypedBinding]
    tel' ModuleName
    m1 [NamedArg Expr]
    args'
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
          [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "scope checked ModuleApplication " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
          ]
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
          [ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ ModuleApplication -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA ModuleApplication
    amodapp
          ]
        (ModuleApplication, ScopeCopyInfo, ImportDirective)
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleApplication
    amodapp, ScopeCopyInfo
    copyInfo, ImportDirective
    adir)

    checkModuleApplication (C.RecordModuleInstance Range
    _ QName
    recN) ModuleName
    m0 Name
    x ImportDirective
    dir' =
      ModuleName
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    forall (m :: * -> *) a.
    (ReadTCState m, MonadTCState m) =>
    ModuleName -> m a -> m a
    withCurrentModule ModuleName
    m0 (ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
     -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective))
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    forall a b. (a -> b) -> a -> b
    $ do
        ModuleName
    m1 <- OldModuleName -> ScopeM (AbsOfCon OldModuleName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (OldModuleName -> ScopeM (AbsOfCon OldModuleName))
    -> OldModuleName -> ScopeM (AbsOfCon OldModuleName)
    forall a b. (a -> b) -> a -> b
    $ QName -> OldModuleName
    OldModuleName QName
    recN
        Scope
    s <- ModuleName -> TCMT IO Scope
    getNamedScope ModuleName
    m1
        (ImportDirective
    adir, Scope
    s) <- QName
    -> ImportDirective -> Scope -> ScopeM (ImportDirective, Scope)
    applyImportDirectiveM QName
    recN ImportDirective
    dir' Scope
    s
        (Scope
    s', ScopeCopyInfo
    copyInfo) <- QName -> ModuleName -> Scope -> ScopeM (Scope, ScopeCopyInfo)
    copyScope QName
    recN ModuleName
    m0 Scope
    s
        (Scope -> Scope) -> TCMT IO ()
    modifyCurrentScope ((Scope -> Scope) -> TCMT IO ()) -> (Scope -> Scope) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Scope -> Scope -> Scope
    forall a b. a -> b -> a
    const Scope
    s'

        [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "mod.inst" Int
    20 [Char]
    "copied record module"
        (ModuleApplication, ScopeCopyInfo, ImportDirective)
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleName -> ModuleApplication
    A.RecordModuleInstance ModuleName
    m1, ScopeCopyInfo
    copyInfo, ImportDirective
    adir)

    -- | @checkModuleMacro mkApply range access concreteName modapp open dir@
    --
    --   Preserves local variables.

    checkModuleMacro
      :: (ToConcrete a, Pretty (ConOfAbs a))
      => (ModuleInfo
          -> ModuleName
          -> A.ModuleApplication
          -> ScopeCopyInfo
          -> A.ImportDirective
          -> a)
      -> OpenKind
      -> Range
      -> Access
      -> C.Name
      -> C.ModuleApplication
      -> OpenShortHand
      -> C.ImportDirective
      -> ScopeM a
    checkModuleMacro :: forall a.
    (ToConcrete a, Pretty (ConOfAbs a)) =>
    (ModuleInfo
     -> ModuleName
     -> ModuleApplication
     -> ScopeCopyInfo
     -> ImportDirective
     -> a)
    -> OpenKind
    -> Range
    -> Access
    -> Name
    -> ModuleApplication
    -> OpenShortHand
    -> ImportDirective
    -> ScopeM a
    checkModuleMacro ModuleInfo
    -> ModuleName
    -> ModuleApplication
    -> ScopeCopyInfo
    -> ImportDirective
    -> a
    apply OpenKind
    kind Range
    r Access
    p Name
    x ModuleApplication
    modapp OpenShortHand
    open ImportDirective
    dir = do
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
          [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "scope checking ModuleMacro " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
          ]
        ImportDirective
    dir <- OpenShortHand -> ImportDirective -> ScopeM ImportDirective
    notPublicWithoutOpen OpenShortHand
    open ImportDirective
    dir

        ModuleName
    m0 <- NewModuleName -> ScopeM (AbsOfCon NewModuleName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Name -> NewModuleName
    NewModuleName Name
    x)
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    90 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "NewModuleName: m0 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ModuleName -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA ModuleName
    m0

        [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "mod.inst" Int
    20 [Char]
    "module macro"

        -- If we're opening a /named/ module, the import directive is
        -- applied to the "open", otherwise to the module itself. However,
        -- "public" is always applied to the "open".
        let (ImportDirective
    moduleDir, ImportDirective
    openDir) = case (OpenShortHand
    open, Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    x) of
              (OpenShortHand
    DoOpen,   Bool
    False) -> (ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir, ImportDirective
    dir)
              (OpenShortHand
    DoOpen,   Bool
    True)  -> ( ImportDirective
    dir { publicOpen :: Maybe Range
    publicOpen = Maybe Range
    forall a. Maybe a
    Nothing }
                                   , ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir { publicOpen :: Maybe Range
    publicOpen = ImportDirective -> Maybe Range
    forall n m. ImportDirective' n m -> Maybe Range
    publicOpen ImportDirective
    dir }
                                   )
              (OpenShortHand
    DontOpen, Bool
    _)     -> (ImportDirective
    dir, ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir)

        -- Restore the locals after module application has been checked.
        (ModuleApplication
    modapp', ScopeCopyInfo
    copyInfo, ImportDirective
    adir') <- ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    forall a. ScopeM a -> ScopeM a
    withLocalVars (ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
     -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective))
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    forall a b. (a -> b) -> a -> b
    $ ModuleApplication
    -> ModuleName
    -> Name
    -> ImportDirective
    -> ScopeM (ModuleApplication, ScopeCopyInfo, ImportDirective)
    checkModuleApplication ModuleApplication
    modapp ModuleName
    m0 Name
    x ImportDirective
    moduleDir
        [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "mod.inst.app" Int
    20 [Char]
    "checkModuleMacro, after checkModuleApplication"

        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    90 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "after mod app: trying to print m0 ..."
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    90 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "after mod app: m0 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ModuleName -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA ModuleName
    m0

        Access -> Name -> ModuleName -> TCMT IO ()
    bindModule Access
    p Name
    x ModuleName
    m0
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    90 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "after bindMod: m0 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ModuleName -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA ModuleName
    m0

        [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "mod.inst.copy.after" Int
    20 [Char]
    "after copying"

        -- Open the module if DoOpen.
        -- Andreas, 2014-09-02: @openModule@ might shadow some locals!
        ImportDirective
    adir <- case OpenShortHand
    open of
          OpenShortHand
    DontOpen -> ImportDirective -> TCMT IO ImportDirective
    forall (m :: * -> *) a. Monad m => a -> m a
    return ImportDirective
    adir'
          OpenShortHand
    DoOpen   -> do
            ImportDirective
    adir'' <- OpenKind
    -> Maybe ModuleName
    -> QName
    -> ImportDirective
    -> TCMT IO ImportDirective
    openModule OpenKind
    kind (ModuleName -> Maybe ModuleName
    forall a. a -> Maybe a
    Just ModuleName
    m0) (Name -> QName
    C.QName Name
    x) ImportDirective
    openDir
            -- Andreas, 2020-05-14, issue #4656
            -- Keep the more meaningful import directive for highlighting
            -- (the other one is a defaultImportDir).
            ImportDirective -> TCMT IO ImportDirective
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ImportDirective -> TCMT IO ImportDirective)
    -> ImportDirective -> TCMT IO ImportDirective
    forall a b. (a -> b) -> a -> b
    $ if Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    x then ImportDirective
    adir' else ImportDirective
    adir''

        [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "mod.inst" Int
    20 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ OpenShortHand -> [Char]
    forall a. Show a => a -> [Char]
    show OpenShortHand
    open
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    90 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "after open   : m0 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ModuleName -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA ModuleName
    m0

        TCMT IO ()
    stripNoNames
        [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "mod.inst" Int
    10 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "after stripping"
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    90 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO Doc
    "after stripNo: m0 =" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> ModuleName -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA ModuleName
    m0

        let m :: ModuleName
    m      = ModuleName
    m0 ModuleName -> List1 Name -> ModuleName
    `withRangesOf` Name -> List1 Name
    forall el coll. Singleton el coll => el -> coll
    singleton Name
    x
            adecl :: a
    adecl  = ModuleInfo
    -> ModuleName
    -> ModuleApplication
    -> ScopeCopyInfo
    -> ImportDirective
    -> a
    apply ModuleInfo
    info ModuleName
    m ModuleApplication
    modapp' ScopeCopyInfo
    copyInfo ImportDirective
    adir

        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
          [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "scope checked ModuleMacro " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
          ]
        [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn  [Char]
    "scope.decl" Int
    90 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "info    = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ModuleInfo -> [Char]
    forall a. Show a => a -> [Char]
    show ModuleInfo
    info
        [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn  [Char]
    "scope.decl" Int
    90 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "m       = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ModuleName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ModuleName
    m
        [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn  [Char]
    "scope.decl" Int
    90 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "modapp' = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ModuleApplication -> [Char]
    forall a. Show a => a -> [Char]
    show ModuleApplication
    modapp'
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    90 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> TCMT IO Doc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> TCMT IO Doc) -> Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ ScopeCopyInfo -> Doc
    forall a. Pretty a => a -> Doc
    pretty ScopeCopyInfo
    copyInfo
        [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ a -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA a
    adecl
        a -> ScopeM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    adecl
      where
        info :: ModuleInfo
    info = ModuleInfo :: Range
    -> Range
    -> Maybe Name
    -> Maybe OpenShortHand
    -> Maybe ImportDirective
    -> ModuleInfo
    ModuleInfo
                 { minfoRange :: Range
    minfoRange  = Range
    r
                 , minfoAsName :: Maybe Name
    minfoAsName = Maybe Name
    forall a. Maybe a
    Nothing
                 , minfoAsTo :: Range
    minfoAsTo   = ImportDirective -> Range
    renamingRange ImportDirective
    dir
                 , minfoOpenShort :: Maybe OpenShortHand
    minfoOpenShort = OpenShortHand -> Maybe OpenShortHand
    forall a. a -> Maybe a
    Just OpenShortHand
    open
                 , minfoDirective :: Maybe ImportDirective
    minfoDirective = ImportDirective -> Maybe ImportDirective
    forall a. a -> Maybe a
    Just ImportDirective
    dir
                 }

    -- | The @public@ keyword must only be used together with @open@.

    notPublicWithoutOpen :: OpenShortHand -> C.ImportDirective -> ScopeM C.ImportDirective
    notPublicWithoutOpen :: OpenShortHand -> ImportDirective -> ScopeM ImportDirective
    notPublicWithoutOpen OpenShortHand
    DoOpen   ImportDirective
    dir = ImportDirective -> ScopeM ImportDirective
    forall (m :: * -> *) a. Monad m => a -> m a
    return ImportDirective
    dir
    notPublicWithoutOpen OpenShortHand
    DontOpen ImportDirective
    dir = do
      Maybe Range -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust (ImportDirective -> Maybe Range
    forall n m. ImportDirective' n m -> Maybe Range
    publicOpen ImportDirective
    dir) ((Range -> TCMT IO ()) -> TCMT IO ())
    -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ Range
    r ->
        Range -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Range
    r (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning Warning
    UselessPublic
      ImportDirective -> ScopeM ImportDirective
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ImportDirective -> ScopeM ImportDirective)
    -> ImportDirective -> ScopeM ImportDirective
    forall a b. (a -> b) -> a -> b
    $ ImportDirective
    dir { publicOpen :: Maybe Range
    publicOpen = Maybe Range
    forall a. Maybe a
    Nothing }

    -- | Computes the range of all the \"to\" keywords used in a renaming
    -- directive.

    renamingRange :: C.ImportDirective -> Range
    renamingRange :: ImportDirective -> Range
    renamingRange = [Range] -> Range
    forall a. HasRange a => a -> Range
    getRange ([Range] -> Range)
    -> (ImportDirective -> [Range]) -> ImportDirective -> Range
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Renaming' Name Name -> Range) -> [Renaming' Name Name] -> [Range]
    forall a b. (a -> b) -> [a] -> [b]
    map Renaming' Name Name -> Range
    forall n m. Renaming' n m -> Range
    renToRange ([Renaming' Name Name] -> [Range])
    -> (ImportDirective -> [Renaming' Name Name])
    -> ImportDirective
    -> [Range]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImportDirective -> [Renaming' Name Name]
    forall n m. ImportDirective' n m -> RenamingDirective' n m
    impRenaming

    -- | Scope check a 'NiceOpen'.
    checkOpen
      :: Range                -- ^ Range of @open@ statement.
      -> Maybe A.ModuleName   -- ^ Resolution of concrete module name (if already resolved).
      -> C.QName              -- ^ Module to open.
      -> C.ImportDirective    -- ^ Scope modifier.
      -> ScopeM (ModuleInfo, A.ModuleName, A.ImportDirective) -- ^ Arguments of 'A.Open'
    checkOpen :: Range
    -> Maybe ModuleName
    -> QName
    -> ImportDirective
    -> ScopeM (ModuleInfo, ModuleName, ImportDirective)
    checkOpen Range
    r Maybe ModuleName
    mam QName
    x ImportDirective
    dir = do
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        ModuleName
    cm <- TCMT IO ModuleName
    forall (m :: * -> *). ReadTCState m => m ModuleName
    getCurrentModule
        [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
          [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text   [Char]
    "scope checking NiceOpen " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> Doc -> TCMT IO Doc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> Doc
    forall a. Pretty a => a -> Doc
    pretty QName
    x)
          , [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text   [Char]
    "  getCurrentModule       = " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall a. Semigroup a => a -> a -> a
    <> ModuleName -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA ModuleName
    cm
          , [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "  getCurrentModule (raw) = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ModuleName -> [Char]
    forall a. Show a => a -> [Char]
    show ModuleName
    cm
          , [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "  C.ImportDirective      = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ImportDirective -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ImportDirective
    dir
          ]
      -- Andreas, 2017-01-01, issue #2377: warn about useless `public`
      Maybe Range -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust (ImportDirective -> Maybe Range
    forall n m. ImportDirective' n m -> Maybe Range
    publicOpen ImportDirective
    dir) ((Range -> TCMT IO ()) -> TCMT IO ())
    -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ Range
    r -> do
        TCMT IO Bool -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM ((ModuleName
    A.noModuleName ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (ModuleName -> Bool) -> TCMT IO ModuleName -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO ModuleName
    forall (m :: * -> *). ReadTCState m => m ModuleName
    getCurrentModule) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
          Range -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Range
    r (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning Warning
    UselessPublic

      ModuleName
    m <- Maybe ModuleName
    -> TCMT IO ModuleName
    -> (ModuleName -> TCMT IO ModuleName)
    -> TCMT IO ModuleName
    forall a b. Maybe a -> b -> (a -> b) -> b
    caseMaybe Maybe ModuleName
    mam (OldModuleName -> ScopeM (AbsOfCon OldModuleName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> OldModuleName
    OldModuleName QName
    x)) ModuleName -> TCMT IO ModuleName
    forall (m :: * -> *) a. Monad m => a -> m a
    return
      [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "open" Int
    20 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "opening " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
      ImportDirective
    adir <- OpenKind
    -> Maybe ModuleName
    -> QName
    -> ImportDirective
    -> TCMT IO ImportDirective
    openModule OpenKind
    TopOpenModule (ModuleName -> Maybe ModuleName
    forall a. a -> Maybe a
    Just ModuleName
    m) QName
    x ImportDirective
    dir
      [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "open" Int
    20 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "result:"
      let minfo :: ModuleInfo
    minfo = ModuleInfo :: Range
    -> Range
    -> Maybe Name
    -> Maybe OpenShortHand
    -> Maybe ImportDirective
    -> ModuleInfo
    ModuleInfo
            { minfoRange :: Range
    minfoRange     = Range
    r
            , minfoAsName :: Maybe Name
    minfoAsName    = Maybe Name
    forall a. Maybe a
    Nothing
            , minfoAsTo :: Range
    minfoAsTo      = ImportDirective -> Range
    renamingRange ImportDirective
    dir
            , minfoOpenShort :: Maybe OpenShortHand
    minfoOpenShort = Maybe OpenShortHand
    forall a. Maybe a
    Nothing
            , minfoDirective :: Maybe ImportDirective
    minfoDirective = ImportDirective -> Maybe ImportDirective
    forall a. a -> Maybe a
    Just ImportDirective
    dir
            }
      let adecls :: [Declaration]
    adecls = [ModuleInfo -> ModuleName -> ImportDirective -> Declaration
    A.Open ModuleInfo
    minfo ModuleName
    m ImportDirective
    adir]
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
        [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ( [Char]
    "scope checked NiceOpen " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
             ) TCMT IO Doc -> [TCMT IO Doc] -> [TCMT IO Doc]
    forall a. a -> [a] -> [a]
    : (Declaration -> TCMT IO Doc) -> [Declaration] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc)
    -> (Declaration -> TCMT IO Doc) -> Declaration -> TCMT IO Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Declaration -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA) [Declaration]
    adecls
      (ModuleInfo, ModuleName, ImportDirective)
    -> ScopeM (ModuleInfo, ModuleName, ImportDirective)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleInfo
    minfo, ModuleName
    m, ImportDirective
    adir)

    -- | Check a literal, issuing an error warning for bad literals.
    checkLiteral :: Literal -> ScopeM ()
    checkLiteral :: Literal -> TCMT IO ()
    checkLiteral (LitChar Char
    c)
      | Char -> Bool
    isSurrogateCodePoint Char
    c = Doc -> TCMT IO ()
    forall (m :: * -> *). MonadWarning m => Doc -> m ()
    genericNonFatalError (Doc -> TCMT IO ()) -> Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Doc
    P.text ([Char] -> Doc) -> [Char] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Invalid character literal " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char -> [Char]
    forall a. Show a => a -> [Char]
    show Char
    c [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                                                 [Char]
    " (surrogate code points are not supported)"
    checkLiteral Literal
    _ = () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    {--------------------------------------------------------------------------
        Translation
     --------------------------------------------------------------------------}

    concreteToAbstract_ :: ToAbstract c => c -> ScopeM (AbsOfCon c)
    concreteToAbstract_ :: forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    concreteToAbstract_ = c -> ScopeM (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract

    concreteToAbstract :: ToAbstract c => ScopeInfo -> c -> ScopeM (AbsOfCon c)
    concreteToAbstract :: forall c. ToAbstract c => ScopeInfo -> c -> ScopeM (AbsOfCon c)
    concreteToAbstract ScopeInfo
    scope c
    x = ScopeInfo -> TCMT IO (AbsOfCon c) -> TCMT IO (AbsOfCon c)
    forall (m :: * -> *) a. ReadTCState m => ScopeInfo -> m a -> m a
    withScope_ ScopeInfo
    scope (c -> TCMT IO (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract c
    x)

    -- | Things that can be translated to abstract syntax are instances of this
    --   class.
    class ToAbstract c where
        type AbsOfCon c
        toAbstract :: c -> ScopeM (AbsOfCon c)

    -- | This function should be used instead of 'toAbstract' for things that need
    --   to keep track of precedences to make sure that we don't forget about it.
    toAbstractCtx :: ToAbstract c => Precedence -> c-> ScopeM (AbsOfCon c)
    toAbstractCtx :: forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    ctx c
    c = Precedence -> TCMT IO (AbsOfCon c) -> TCMT IO (AbsOfCon c)
    forall (m :: * -> *) a. ReadTCState m => Precedence -> m a -> m a
    withContextPrecedence Precedence
    ctx (TCMT IO (AbsOfCon c) -> TCMT IO (AbsOfCon c))
    -> TCMT IO (AbsOfCon c) -> TCMT IO (AbsOfCon c)
    forall a b. (a -> b) -> a -> b
    $ c -> TCMT IO (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract c
    c

    --UNUSED Liang-Ting Chen 2019-07-16
    --toAbstractTopCtx :: ToAbstract c a => c -> ScopeM a
    --toAbstractTopCtx = toAbstractCtx TopCtx

    toAbstractHiding :: (LensHiding h, ToAbstract c) => h -> c -> ScopeM (AbsOfCon c)
    toAbstractHiding :: forall h c.
    (LensHiding h, ToAbstract c) =>
    h -> c -> ScopeM (AbsOfCon c)
    toAbstractHiding h
    h | h -> Bool
    forall a. LensHiding a => a -> Bool
    visible h
    h = c -> ScopeM (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract -- don't change precedence if visible
    toAbstractHiding h
    _             = Precedence -> c -> ScopeM (AbsOfCon c)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx

    --UNUSED Liang-Ting Chen 2019-07-16
    --setContextCPS :: Precedence -> (a -> ScopeM b) ->
    --                 ((a -> ScopeM b) -> ScopeM b) -> ScopeM b
    --setContextCPS p ret f = do
    --  old <- useScope scopePrecedence
    --  withContextPrecedence p $ f $ \ x -> setContextPrecedence old >> ret x
    --
    --localToAbstractCtx :: ToAbstract c =>
    --                     Precedence -> c -> (AbsOfCon -> ScopeM (AbsOfCon c)) -> ScopeM (AbsOfCon c)
    --localToAbstractCtx ctx c ret = setContextCPS ctx ret (localToAbstract c)

    -- | This operation does not affect the scope, i.e. the original scope
    --   is restored upon completion.
    localToAbstract :: ToAbstract c => c -> (AbsOfCon c -> ScopeM b) -> ScopeM b
    localToAbstract :: forall c b.
    ToAbstract c =>
    c -> (AbsOfCon c -> ScopeM b) -> ScopeM b
    localToAbstract c
    x AbsOfCon c -> ScopeM b
    ret = (b, ScopeInfo) -> b
    forall a b. (a, b) -> a
    fst ((b, ScopeInfo) -> b) -> TCMT IO (b, ScopeInfo) -> ScopeM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> c -> (AbsOfCon c -> ScopeM b) -> TCMT IO (b, ScopeInfo)
    forall c b.
    ToAbstract c =>
    c -> (AbsOfCon c -> ScopeM b) -> ScopeM (b, ScopeInfo)
    localToAbstract' c
    x AbsOfCon c -> ScopeM b
    ret

    -- | Like 'localToAbstract' but returns the scope after the completion of the
    --   second argument.
    localToAbstract' :: ToAbstract c => c -> (AbsOfCon c -> ScopeM b) -> ScopeM (b, ScopeInfo)
    localToAbstract' :: forall c b.
    ToAbstract c =>
    c -> (AbsOfCon c -> ScopeM b) -> ScopeM (b, ScopeInfo)
    localToAbstract' c
    x AbsOfCon c -> ScopeM b
    ret = do
      ScopeInfo
    scope <- TCMT IO ScopeInfo
    forall (m :: * -> *). ReadTCState m => m ScopeInfo
    getScope
      ScopeInfo -> ScopeM b -> ScopeM (b, ScopeInfo)
    forall (m :: * -> *) a.
    ReadTCState m =>
    ScopeInfo -> m a -> m (a, ScopeInfo)
    withScope ScopeInfo
    scope (ScopeM b -> ScopeM (b, ScopeInfo))
    -> ScopeM b -> ScopeM (b, ScopeInfo)
    forall a b. (a -> b) -> a -> b
    $ AbsOfCon c -> ScopeM b
    ret (AbsOfCon c -> ScopeM b) -> TCMT IO (AbsOfCon c) -> ScopeM b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< c -> TCMT IO (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract c
    x

    instance ToAbstract () where
      type AbsOfCon () = ()
      toAbstract :: () -> ScopeM (AbsOfCon ())
    toAbstract = () -> ScopeM (AbsOfCon ())
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    instance (ToAbstract c1, ToAbstract c2) => ToAbstract (c1, c2) where
      type AbsOfCon (c1, c2) = (AbsOfCon c1, AbsOfCon c2)
      toAbstract :: (c1, c2) -> ScopeM (AbsOfCon (c1, c2))
    toAbstract (c1
    x,c2
    y) = (,) (AbsOfCon c1 -> AbsOfCon c2 -> (AbsOfCon c1, AbsOfCon c2))
    -> TCMT IO (AbsOfCon c1)
    -> TCMT IO (AbsOfCon c2 -> (AbsOfCon c1, AbsOfCon c2))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> c1 -> TCMT IO (AbsOfCon c1)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract c1
    x TCMT IO (AbsOfCon c2 -> (AbsOfCon c1, AbsOfCon c2))
    -> TCMT IO (AbsOfCon c2) -> TCMT IO (AbsOfCon c1, AbsOfCon c2)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> c2 -> TCMT IO (AbsOfCon c2)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract c2
    y

    instance (ToAbstract c1, ToAbstract c2, ToAbstract c3) => ToAbstract (c1, c2, c3) where
      type AbsOfCon (c1, c2, c3) = (AbsOfCon c1, AbsOfCon c2, AbsOfCon c3)
      toAbstract :: (c1, c2, c3) -> ScopeM (AbsOfCon (c1, c2, c3))
    toAbstract (c1
    x,c2
    y,c3
    z) = (AbsOfCon c1, (AbsOfCon c2, AbsOfCon c3))
    -> (AbsOfCon c1, AbsOfCon c2, AbsOfCon c3)
    forall {a} {b} {c}. (a, (b, c)) -> (a, b, c)
    flatten ((AbsOfCon c1, (AbsOfCon c2, AbsOfCon c3))
     -> (AbsOfCon c1, AbsOfCon c2, AbsOfCon c3))
    -> TCMT IO (AbsOfCon c1, (AbsOfCon c2, AbsOfCon c3))
    -> TCMT IO (AbsOfCon c1, AbsOfCon c2, AbsOfCon c3)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (c1, (c2, c3)) -> ScopeM (AbsOfCon (c1, (c2, c3)))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (c1
    x,(c2
    y,c3
    z))
        where
          flatten :: (a, (b, c)) -> (a, b, c)
    flatten (a
    x,(b
    y,c
    z)) = (a
    x,b
    y,c
    z)

    instance ToAbstract c => ToAbstract [c] where
      type AbsOfCon [c] = [AbsOfCon c]
      toAbstract :: [c] -> ScopeM (AbsOfCon [c])
    toAbstract = (c -> TCMT IO (AbsOfCon c)) -> [c] -> TCMT IO [AbsOfCon c]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM c -> TCMT IO (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract

    instance ToAbstract c => ToAbstract (List1 c) where
      type AbsOfCon (List1 c) = List1 (AbsOfCon c)
      toAbstract :: List1 c -> ScopeM (AbsOfCon (List1 c))
    toAbstract = (c -> TCMT IO (AbsOfCon c))
    -> List1 c -> TCMT IO (NonEmpty (AbsOfCon c))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM c -> TCMT IO (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract

    instance (ToAbstract c1, ToAbstract c2) => ToAbstract (Either c1 c2) where
      type AbsOfCon (Either c1 c2) = Either (AbsOfCon c1) (AbsOfCon c2)
      toAbstract :: Either c1 c2 -> ScopeM (AbsOfCon (Either c1 c2))
    toAbstract = (c1 -> TCMT IO (AbsOfCon c1))
    -> (c2 -> TCMT IO (AbsOfCon c2))
    -> Either c1 c2
    -> TCMT IO (Either (AbsOfCon c1) (AbsOfCon c2))
    forall (f :: * -> *) a c b d.
    Functor f =>
    (a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
    traverseEither c1 -> TCMT IO (AbsOfCon c1)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract c2 -> TCMT IO (AbsOfCon c2)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract

    instance ToAbstract c => ToAbstract (Maybe c) where
      type AbsOfCon (Maybe c) = Maybe (AbsOfCon c)
      toAbstract :: Maybe c -> ScopeM (AbsOfCon (Maybe c))
    toAbstract = (c -> TCMT IO (AbsOfCon c))
    -> Maybe c -> TCMT IO (Maybe (AbsOfCon c))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse c -> TCMT IO (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract

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

    data NewName a = NewName
      { forall a. NewName a -> BindingSource
    newBinder   :: A.BindingSource -- what kind of binder?
      , forall a. NewName a -> a
    newName     :: a
      } deriving ((forall a b. (a -> b) -> NewName a -> NewName b)
    -> (forall a b. a -> NewName b -> NewName a) -> Functor NewName
    forall a b. a -> NewName b -> NewName a
    forall a b. (a -> b) -> NewName a -> NewName 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 -> NewName b -> NewName a
    $c<$ :: forall a b. a -> NewName b -> NewName a
    fmap :: forall a b. (a -> b) -> NewName a -> NewName b
    $cfmap :: forall a b. (a -> b) -> NewName a -> NewName b
    Functor)

    data OldQName = OldQName
      C.QName              -- ^ Concrete name to be resolved
      (Maybe (Set A.Name)) -- ^ If a set is given, then the first name must
                           --   correspond to one of the names in the set.

    -- | We sometimes do not want to fail hard if the name is not actually
    --   in scope because we have a strategy to recover from this problem
    --   (e.g. drop the offending COMPILE pragma)
    data MaybeOldQName = MaybeOldQName OldQName

    newtype OldName a = OldName a

    -- | Wrapper to resolve a name to a 'ResolvedName' (rather than an 'A.Expr').
    data ResolveQName = ResolveQName C.QName

    data PatName      = PatName C.QName (Maybe (Set A.Name))
      -- ^ If a set is given, then the first name must correspond to one
      -- of the names in the set.

    instance ToAbstract (NewName C.Name) where
      type AbsOfCon (NewName C.Name) = A.Name
      toAbstract :: NewName Name -> ScopeM (AbsOfCon (NewName Name))
    toAbstract (NewName BindingSource
    b Name
    x) = do
        Name
    y <- Name -> ScopeM Name
    freshAbstractName_ Name
    x
        BindingSource -> Name -> Name -> TCMT IO ()
    bindVariable BindingSource
    b Name
    x Name
    y
        Name -> ScopeM Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    y

    instance ToAbstract (NewName C.BoundName) where
      type AbsOfCon (NewName C.BoundName) = A.BindName
      toAbstract :: NewName BoundName -> ScopeM (AbsOfCon (NewName BoundName))
    toAbstract NewName{ newBinder :: forall a. NewName a -> BindingSource
    newBinder = BindingSource
    b, newName :: forall a. NewName a -> a
    newName = BName{ boundName :: BoundName -> Name
    boundName = Name
    x, bnameFixity :: BoundName -> Fixity'
    bnameFixity = Fixity'
    fx }} = do
        Name
    y <- Fixity' -> Name -> ScopeM Name
    freshAbstractName Fixity'
    fx Name
    x
        BindingSource -> Name -> Name -> TCMT IO ()
    bindVariable BindingSource
    b Name
    x Name
    y
        BindName -> TCMT IO BindName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BindName -> TCMT IO BindName) -> BindName -> TCMT IO BindName
    forall a b. (a -> b) -> a -> b
    $ Name -> BindName
    A.BindName Name
    y

    instance ToAbstract OldQName where
      type AbsOfCon OldQName = A.Expr
      toAbstract :: OldQName -> ScopeM (AbsOfCon OldQName)
    toAbstract q :: OldQName
    q@(OldQName QName
    x Maybe (Set Name)
    _) =
        ScopeM Expr -> TCMT IO (Maybe Expr) -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
    fromMaybeM (QName -> ScopeM Expr
    forall a. QName -> TCM a
    notInScopeError QName
    x) (TCMT IO (Maybe Expr) -> ScopeM Expr)
    -> TCMT IO (Maybe Expr) -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ MaybeOldQName -> ScopeM (AbsOfCon MaybeOldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (OldQName -> MaybeOldQName
    MaybeOldQName OldQName
    q)

    instance ToAbstract MaybeOldQName where
      type AbsOfCon MaybeOldQName = Maybe A.Expr
      toAbstract :: MaybeOldQName -> ScopeM (AbsOfCon MaybeOldQName)
    toAbstract (MaybeOldQName (OldQName QName
    x Maybe (Set Name)
    ns)) = do
        ResolvedName
    qx <- KindsOfNames -> Maybe (Set Name) -> QName -> ScopeM ResolvedName
    resolveName' KindsOfNames
    allKindsOfNames Maybe (Set Name)
    ns QName
    x
        [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.name" Int
    10 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "resolved " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ResolvedName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ResolvedName
    qx
        case ResolvedName
    qx of
          VarName Name
    x' BindingSource
    _         -> Maybe Expr -> TCMT IO (Maybe Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Expr -> TCMT IO (Maybe Expr))
    -> Maybe Expr -> TCMT IO (Maybe Expr)
    forall a b. (a -> b) -> a -> b
    $ Expr -> Maybe Expr
    forall a. a -> Maybe a
    Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
    forall a b. (a -> b) -> a -> b
    $ Name -> Expr
    A.Var Name
    x'
          DefinedName Access
    _ AbstractName
    d Suffix
    suffix -> do
            QName -> TCMT IO ()
    forall (m :: * -> *).
    (MonadWarning m, ReadTCState m) =>
    QName -> m ()
    raiseWarningsOnUsage (QName -> TCMT IO ()) -> QName -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName AbstractName
    d
            -- then we take note of generalized names used
            case AbstractName -> KindOfName
    anameKind AbstractName
    d of
              KindOfName
    GeneralizeName -> do
                Maybe (Set QName)
    gvs <- Lens' (Maybe (Set QName)) TCState -> TCMT IO (Maybe (Set QName))
    forall (m :: * -> *) a. ReadTCState m => Lens' a TCState -> m a
    useTC Lens' (Maybe (Set QName)) TCState
    stGeneralizedVars
                case Maybe (Set QName)
    gvs of   -- Subtle: Use (left-biased) union instead of insert to keep the old name if
                              -- already present. This way we can sort by source location when generalizing
                              -- (Issue 3354).
                    Just Set QName
    s -> Lens' (Maybe (Set QName)) TCState
    stGeneralizedVars Lens' (Maybe (Set QName)) TCState
    -> Maybe (Set QName) -> TCMT IO ()
    forall (m :: * -> *) a.
    MonadTCState m =>
    Lens' a TCState -> a -> m ()
    `setTCLens` Set QName -> Maybe (Set QName)
    forall a. a -> Maybe a
    Just (Set QName
    s Set QName -> Set QName -> Set QName
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` QName -> Set QName
    forall a. a -> Set a
    Set.singleton (AbstractName -> QName
    anameName AbstractName
    d))
                    Maybe (Set QName)
    Nothing -> TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ QName -> TypeError
    GeneralizeNotSupportedHere (QName -> TypeError) -> QName -> TypeError
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName AbstractName
    d
              KindOfName
    DisallowedGeneralizeName -> do
                TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ())
    -> (Doc -> TypeError) -> Doc -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<
                  [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text [Char]
    "Cannot use generalized variable from let-opened module:" TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+> QName -> TCMT IO Doc
    forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
    prettyTCM (AbstractName -> QName
    anameName AbstractName
    d)
              KindOfName
    _ -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            -- and then we return the name
            Maybe Expr -> TCMT IO (Maybe Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Expr -> TCMT IO (Maybe Expr))
    -> Maybe Expr -> TCMT IO (Maybe Expr)
    forall a b. (a -> b) -> a -> b
    $ Suffix -> Expr -> Maybe Expr
    withSuffix Suffix
    suffix (Expr -> Maybe Expr) -> Expr -> Maybe Expr
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> Expr
    forall a. NameToExpr a => a -> Expr
    nameToExpr AbstractName
    d
            where
              withSuffix :: Suffix -> Expr -> Maybe Expr
    withSuffix Suffix
    NoSuffix   Expr
    e         = Expr -> Maybe Expr
    forall a. a -> Maybe a
    Just Expr
    e
              withSuffix s :: Suffix
    s@Suffix{} (A.Def QName
    x) = Expr -> Maybe Expr
    forall a. a -> Maybe a
    Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
    forall a b. (a -> b) -> a -> b
    $ QName -> Suffix -> Expr
    A.Def' QName
    x Suffix
    s
              withSuffix Suffix
    _          Expr
    _         = Maybe Expr
    forall a. Maybe a
    Nothing

          FieldName     List1 AbstractName
    ds     -> (AmbiguousQName -> Expr)
    -> List1 AbstractName -> TCMT IO (Maybe Expr)
    ambiguous (ProjOrigin -> AmbiguousQName -> Expr
    A.Proj ProjOrigin
    ProjPrefix) List1 AbstractName
    ds
          ConstructorName Set Induction
    _ List1 AbstractName
    ds -> (AmbiguousQName -> Expr)
    -> List1 AbstractName -> TCMT IO (Maybe Expr)
    ambiguous AmbiguousQName -> Expr
    A.Con List1 AbstractName
    ds
          PatternSynResName List1 AbstractName
    ds -> (AmbiguousQName -> Expr)
    -> List1 AbstractName -> TCMT IO (Maybe Expr)
    ambiguous AmbiguousQName -> Expr
    A.PatternSyn List1 AbstractName
    ds
          ResolvedName
    UnknownName          -> Maybe Expr -> TCMT IO (Maybe Expr)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Expr
    forall a. Maybe a
    Nothing
        where
          ambiguous :: (AmbiguousQName -> A.Expr) -> List1 AbstractName -> ScopeM (Maybe A.Expr)
          ambiguous :: (AmbiguousQName -> Expr)
    -> List1 AbstractName -> TCMT IO (Maybe Expr)
    ambiguous AmbiguousQName -> Expr
    f List1 AbstractName
    ds = do
            let xs :: NonEmpty QName
    xs = (AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds
            NonEmpty QName -> TCMT IO ()
    raiseWarningsOnUsageIfUnambiguous NonEmpty QName
    xs
            Maybe Expr -> TCMT IO (Maybe Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Expr -> TCMT IO (Maybe Expr))
    -> Maybe Expr -> TCMT IO (Maybe Expr)
    forall a b. (a -> b) -> a -> b
    $ Expr -> Maybe Expr
    forall a. a -> Maybe a
    Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
    forall a b. (a -> b) -> a -> b
    $ AmbiguousQName -> Expr
    f (AmbiguousQName -> Expr) -> AmbiguousQName -> Expr
    forall a b. (a -> b) -> a -> b
    $ NonEmpty QName -> AmbiguousQName
    AmbQ NonEmpty QName
    xs

          -- Note: user warnings on ambiguous names will be raised by the type checker,
          -- see storeDiamsbiguatedName.
          raiseWarningsOnUsageIfUnambiguous :: List1 A.QName -> ScopeM ()
          raiseWarningsOnUsageIfUnambiguous :: NonEmpty QName -> TCMT IO ()
    raiseWarningsOnUsageIfUnambiguous = \case
            QName
    x :| [] -> QName -> TCMT IO ()
    forall (m :: * -> *).
    (MonadWarning m, ReadTCState m) =>
    QName -> m ()
    raiseWarningsOnUsage QName
    x
            NonEmpty QName
    _       -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    instance ToAbstract ResolveQName where
      type AbsOfCon ResolveQName = ResolvedName
      toAbstract :: ResolveQName -> ScopeM (AbsOfCon ResolveQName)
    toAbstract (ResolveQName QName
    x) = QName -> ScopeM ResolvedName
    resolveName QName
    x ScopeM ResolvedName
    -> (ResolvedName -> ScopeM ResolvedName) -> ScopeM ResolvedName
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        ResolvedName
    UnknownName -> QName -> ScopeM ResolvedName
    forall a. QName -> TCM a
    notInScopeError QName
    x
        ResolvedName
    q -> ResolvedName -> ScopeM ResolvedName
    forall (m :: * -> *) a. Monad m => a -> m a
    return ResolvedName
    q

    data APatName = VarPatName A.Name
                  | ConPatName (NonEmpty AbstractName)
                  | PatternSynPatName (NonEmpty AbstractName)

    instance ToAbstract PatName where
      type AbsOfCon PatName = APatName
      toAbstract :: PatName -> ScopeM (AbsOfCon PatName)
    toAbstract (PatName QName
    x Maybe (Set Name)
    ns) = do
        [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    10 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "checking pattern name: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
        ResolvedName
    rx <- KindsOfNames -> Maybe (Set Name) -> QName -> ScopeM ResolvedName
    resolveName' ([KindOfName] -> KindsOfNames
    someKindsOfNames [KindOfName
    ConName, KindOfName
    CoConName, KindOfName
    PatternSynName]) Maybe (Set Name)
    ns QName
    x
              -- Andreas, 2013-03-21 ignore conflicting names which cannot
              -- be meant since we are in a pattern
              -- Andreas, 2020-04-11 CoConName:
              -- coinductive constructors will be rejected later, in the type checker
        [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    20 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "resolved as " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ResolvedName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ResolvedName
    rx
        case (ResolvedName
    rx, QName
    x) of
          (VarName Name
    y BindingSource
    _,       C.QName Name
    x)                           -> Name -> TCMT IO APatName
    bindPatVar Name
    x
          (FieldName List1 AbstractName
    d,       C.QName Name
    x)                           -> Name -> TCMT IO APatName
    bindPatVar Name
    x
          (DefinedName Access
    _ AbstractName
    d Suffix
    _, C.QName Name
    x) | KindOfName -> Bool
    isDefName (AbstractName -> KindOfName
    anameKind AbstractName
    d) -> Name -> TCMT IO APatName
    bindPatVar Name
    x
          (ResolvedName
    UnknownName,       C.QName Name
    x)                           -> Name -> TCMT IO APatName
    bindPatVar Name
    x
          (ConstructorName Set Induction
    _ List1 AbstractName
    ds, QName
    _)                                -> List1 AbstractName -> TCMT IO APatName
    forall {m :: * -> *}.
    MonadDebug m =>
    List1 AbstractName -> m APatName
    patCon List1 AbstractName
    ds
          (PatternSynResName List1 AbstractName
    d, QName
    _)                                 -> List1 AbstractName -> TCMT IO APatName
    forall {m :: * -> *}.
    MonadDebug m =>
    List1 AbstractName -> m APatName
    patSyn List1 AbstractName
    d
          (ResolvedName, QName)
    _ -> [Char] -> TCMT IO APatName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO APatName) -> [Char] -> TCMT IO APatName
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cannot pattern match on non-constructor " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
        where
          bindPatVar :: Name -> TCMT IO APatName
    bindPatVar = Name -> APatName
    VarPatName (Name -> APatName)
    -> (Name -> ScopeM Name) -> Name -> TCMT IO APatName
    forall (m :: * -> *) b c a.
    Functor m =>
    (b -> c) -> (a -> m b) -> a -> m c
    <.> Name -> ScopeM Name
    bindPatternVariable
          patCon :: List1 AbstractName -> m APatName
    patCon List1 AbstractName
    ds = do
            [Char] -> Int -> [Char] -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    10 ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "it was a con: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ NonEmpty QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ((AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds)
            APatName -> m APatName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (APatName -> m APatName) -> APatName -> m APatName
    forall a b. (a -> b) -> a -> b
    $ List1 AbstractName -> APatName
    ConPatName List1 AbstractName
    ds
          patSyn :: List1 AbstractName -> m APatName
    patSyn List1 AbstractName
    ds = do
            [Char] -> Int -> [Char] -> m ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    10 ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "it was a pat syn: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ NonEmpty QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ((AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds)
            APatName -> m APatName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (APatName -> m APatName) -> APatName -> m APatName
    forall a b. (a -> b) -> a -> b
    $ List1 AbstractName -> APatName
    PatternSynPatName List1 AbstractName
    ds

    -- | Translate and possibly bind a pattern variable
    --   (which could have been bound before due to non-linearity).
    bindPatternVariable :: C.Name -> ScopeM A.Name
    bindPatternVariable :: Name -> ScopeM Name
    bindPatternVariable Name
    x = do
      Name
    y <- (Name -> [(Name, LocalVar)] -> Maybe LocalVar
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    AssocList.lookup Name
    x ([(Name, LocalVar)] -> Maybe LocalVar)
    -> TCMT IO [(Name, LocalVar)] -> TCMT IO (Maybe LocalVar)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO [(Name, LocalVar)]
    getVarsToBind) TCMT IO (Maybe LocalVar)
    -> (Maybe LocalVar -> ScopeM Name) -> ScopeM Name
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just (LocalVar Name
    y BindingSource
    _ [AbstractName]
    _) -> do
          [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    10 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "it was a old var: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
          Name -> ScopeM Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> ScopeM Name) -> Name -> ScopeM Name
    forall a b. (a -> b) -> a -> b
    $ Range -> Name -> Name
    forall a. SetRange a => Range -> a -> a
    setRange (Name -> Range
    forall a. HasRange a => a -> Range
    getRange Name
    x) Name
    y
        Maybe LocalVar
    Nothing -> do
          [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    10 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "it was a new var: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
          Name -> ScopeM Name
    freshAbstractName_ Name
    x
      Name -> LocalVar -> TCMT IO ()
    addVarToBind Name
    x (LocalVar -> TCMT IO ()) -> LocalVar -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Name -> BindingSource -> [AbstractName] -> LocalVar
    LocalVar Name
    y BindingSource
    PatternBound []
      Name -> ScopeM Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    y

    class ToQName a where
      toQName :: a -> C.QName

    instance ToQName C.Name  where toQName :: Name -> QName
    toQName = Name -> QName
    C.QName
    instance ToQName C.QName where toQName :: QName -> QName
    toQName = QName -> QName
    forall a. a -> a
    id

    -- Should be a defined name.
    instance ToQName a => ToAbstract (OldName a) where
      type AbsOfCon (OldName a) = A.QName
      toAbstract :: OldName a -> ScopeM (AbsOfCon (OldName a))
    toAbstract (OldName a
    x) = do
        ResolvedName
    rx <- QName -> ScopeM ResolvedName
    resolveName (a -> QName
    forall a. ToQName a => a -> QName
    toQName a
    x)
        case ResolvedName
    rx of
          DefinedName Access
    _ AbstractName
    d Suffix
    NoSuffix -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> TCMT IO QName) -> QName -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName AbstractName
    d
          DefinedName Access
    _ AbstractName
    d Suffix{} -> QName -> TCMT IO QName
    forall a. QName -> TCM a
    notInScopeError (a -> QName
    forall a. ToQName a => a -> QName
    toQName a
    x)
          -- We can get the cases below for DISPLAY pragmas
          ConstructorName Set Induction
    _ List1 AbstractName
    ds -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> TCMT IO QName) -> QName -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName (List1 AbstractName -> AbstractName
    forall a. NonEmpty a -> a
    NonEmpty.head List1 AbstractName
    ds)   -- We'll throw out this one, so it doesn't matter which one we pick
          FieldName List1 AbstractName
    ds         -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> TCMT IO QName) -> QName -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName (List1 AbstractName -> AbstractName
    forall a. NonEmpty a -> a
    NonEmpty.head List1 AbstractName
    ds)
          PatternSynResName List1 AbstractName
    ds -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> TCMT IO QName) -> QName -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName (List1 AbstractName -> AbstractName
    forall a. NonEmpty a -> a
    NonEmpty.head List1 AbstractName
    ds)
          VarName Name
    x BindingSource
    _          -> [Char] -> TCMT IO QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO QName) -> [Char] -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Not a defined name: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
          ResolvedName
    UnknownName          -> QName -> TCMT IO QName
    forall a. QName -> TCM a
    notInScopeError (a -> QName
    forall a. ToQName a => a -> QName
    toQName a
    x)

    -- | Resolve a non-local name and return its possibly ambiguous abstract name.
    toAbstractExistingName :: ToQName a => a -> ScopeM (List1 AbstractName)
    toAbstractExistingName :: forall a. ToQName a => a -> ScopeM (List1 AbstractName)
    toAbstractExistingName a
    x = QName -> ScopeM ResolvedName
    resolveName (a -> QName
    forall a. ToQName a => a -> QName
    toQName a
    x) ScopeM ResolvedName
    -> (ResolvedName -> ScopeM (List1 AbstractName))
    -> ScopeM (List1 AbstractName)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        DefinedName Access
    _ AbstractName
    d Suffix
    NoSuffix -> List1 AbstractName -> ScopeM (List1 AbstractName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (List1 AbstractName -> ScopeM (List1 AbstractName))
    -> List1 AbstractName -> ScopeM (List1 AbstractName)
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> List1 AbstractName
    forall el coll. Singleton el coll => el -> coll
    singleton AbstractName
    d
        DefinedName Access
    _ AbstractName
    d Suffix{} -> QName -> ScopeM (List1 AbstractName)
    forall a. QName -> TCM a
    notInScopeError (a -> QName
    forall a. ToQName a => a -> QName
    toQName a
    x)
        ConstructorName Set Induction
    _ List1 AbstractName
    ds     -> List1 AbstractName -> ScopeM (List1 AbstractName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return List1 AbstractName
    ds
        FieldName List1 AbstractName
    ds             -> List1 AbstractName -> ScopeM (List1 AbstractName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return List1 AbstractName
    ds
        PatternSynResName List1 AbstractName
    ds     -> List1 AbstractName -> ScopeM (List1 AbstractName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return List1 AbstractName
    ds
        VarName Name
    x BindingSource
    _              -> [Char] -> ScopeM (List1 AbstractName)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> ScopeM (List1 AbstractName))
    -> [Char] -> ScopeM (List1 AbstractName)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Not a defined name: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
        ResolvedName
    UnknownName              -> QName -> ScopeM (List1 AbstractName)
    forall a. QName -> TCM a
    notInScopeError (a -> QName
    forall a. ToQName a => a -> QName
    toQName a
    x)

    newtype NewModuleName      = NewModuleName      C.Name
    newtype NewModuleQName     = NewModuleQName     C.QName
    newtype OldModuleName      = OldModuleName      C.QName

    freshQModule :: A.ModuleName -> C.Name -> ScopeM A.ModuleName
    freshQModule :: ModuleName -> Name -> TCMT IO ModuleName
    freshQModule ModuleName
    m Name
    x = ModuleName -> ModuleName -> ModuleName
    A.qualifyM ModuleName
    m (ModuleName -> ModuleName)
    -> (Name -> ModuleName) -> Name -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . List1 Name -> ModuleName
    mnameFromList1 (List1 Name -> ModuleName)
    -> (Name -> List1 Name) -> Name -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> List1 Name
    forall el coll. Singleton el coll => el -> coll
    singleton (Name -> ModuleName) -> ScopeM Name -> TCMT IO ModuleName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> ScopeM Name
    freshAbstractName_ Name
    x

    checkForModuleClash :: C.Name -> ScopeM ()
    checkForModuleClash :: Name -> TCMT IO ()
    checkForModuleClash Name
    x = do
      [AbstractModule]
    ms :: [AbstractModule] <- QName -> ScopeInfo -> [AbstractModule]
    forall a. InScope a => QName -> ScopeInfo -> [a]
    scopeLookup (Name -> QName
    C.QName Name
    x) (ScopeInfo -> [AbstractModule])
    -> TCMT IO ScopeInfo -> TCMT IO [AbstractModule]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO ScopeInfo
    forall (m :: * -> *). ReadTCState m => m ScopeInfo
    getScope
      Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([AbstractModule] -> Bool
    forall a. Null a => a -> Bool
    null [AbstractModule]
    ms) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.clash" Int
    20 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "clashing modules ms = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [AbstractModule] -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow [AbstractModule]
    ms
        [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.clash" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "clashing modules ms = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [AbstractModule] -> [Char]
    forall a. Show a => a -> [Char]
    show [AbstractModule]
    ms
        Name -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Name
    x (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
          TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Name -> [ModuleName] -> TypeError
    ShadowedModule Name
    x ([ModuleName] -> TypeError) -> [ModuleName] -> TypeError
    forall a b. (a -> b) -> a -> b
    $
                    (AbstractModule -> ModuleName) -> [AbstractModule] -> [ModuleName]
    forall a b. (a -> b) -> [a] -> [b]
    map ((ModuleName -> Name -> ModuleName
    forall t u. (SetRange t, HasRange u) => t -> u -> t
    `withRangeOf` Name
    x) (ModuleName -> ModuleName)
    -> (AbstractModule -> ModuleName) -> AbstractModule -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AbstractModule -> ModuleName
    amodName) [AbstractModule]
    ms

    instance ToAbstract NewModuleName where
      type AbsOfCon NewModuleName = A.ModuleName
      toAbstract :: NewModuleName -> ScopeM (AbsOfCon NewModuleName)
    toAbstract (NewModuleName Name
    x) = do
        Name -> TCMT IO ()
    checkForModuleClash Name
    x
        ModuleName
    m <- TCMT IO ModuleName
    forall (m :: * -> *). ReadTCState m => m ModuleName
    getCurrentModule
        ModuleName
    y <- ModuleName -> Name -> TCMT IO ModuleName
    freshQModule ModuleName
    m Name
    x
        Maybe DataOrRecordModule -> ModuleName -> TCMT IO ()
    createModule Maybe DataOrRecordModule
    forall a. Maybe a
    Nothing ModuleName
    y
        ModuleName -> TCMT IO ModuleName
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleName
    y

    instance ToAbstract NewModuleQName where
      type AbsOfCon NewModuleQName = A.ModuleName
      toAbstract :: NewModuleQName -> ScopeM (AbsOfCon NewModuleQName)
    toAbstract (NewModuleQName QName
    m) = ModuleName -> QName -> TCMT IO ModuleName
    toAbs ModuleName
    noModuleName QName
    m
        where
          toAbs :: ModuleName -> QName -> TCMT IO ModuleName
    toAbs ModuleName
    m (C.QName Name
    x)  = do
            ModuleName
    y <- ModuleName -> Name -> TCMT IO ModuleName
    freshQModule ModuleName
    m Name
    x
            Maybe DataOrRecordModule -> ModuleName -> TCMT IO ()
    createModule Maybe DataOrRecordModule
    forall a. Maybe a
    Nothing ModuleName
    y
            ModuleName -> TCMT IO ModuleName
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleName
    y
          toAbs ModuleName
    m (C.Qual Name
    x QName
    q) = do
            ModuleName
    m' <- ModuleName -> Name -> TCMT IO ModuleName
    freshQModule ModuleName
    m Name
    x
            ModuleName -> QName -> TCMT IO ModuleName
    toAbs ModuleName
    m' QName
    q

    instance ToAbstract OldModuleName where
      type AbsOfCon OldModuleName = A.ModuleName

      toAbstract :: OldModuleName -> ScopeM (AbsOfCon OldModuleName)
    toAbstract (OldModuleName QName
    q) = QName -> TCMT IO ModuleName -> TCMT IO ModuleName
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange QName
    q (TCMT IO ModuleName -> TCMT IO ModuleName)
    -> TCMT IO ModuleName -> TCMT IO ModuleName
    forall a b. (a -> b) -> a -> b
    $ do
        AbstractModule -> ModuleName
    amodName (AbstractModule -> ModuleName)
    -> TCMT IO AbstractModule -> TCMT IO ModuleName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> TCMT IO AbstractModule
    resolveModule QName
    q

    -- Expressions ------------------------------------------------------------
    --UNUSED Liang-Ting Chen 2019-07-16
    ---- | Peel off 'C.HiddenArg' and represent it as an 'NamedArg'.
    --mkNamedArg :: C.Expr -> NamedArg C.Expr
    --mkNamedArg (C.HiddenArg   _ e) = Arg (hide         defaultArgInfo) e
    --mkNamedArg (C.InstanceArg _ e) = Arg (makeInstance defaultArgInfo) e
    --mkNamedArg e                   = Arg defaultArgInfo $ unnamed e

    -- | Peel off 'C.HiddenArg' and represent it as an 'Arg', throwing away any name.
    mkArg' :: ArgInfo -> C.Expr -> Arg C.Expr
    mkArg' :: ArgInfo -> Expr -> Arg Expr
    mkArg' ArgInfo
    info (C.HiddenArg   Range
    _ Named NamedName Expr
    e) = ArgInfo -> Expr -> Arg Expr
    forall e. ArgInfo -> e -> Arg e
    Arg (ArgInfo -> ArgInfo
    forall a. LensHiding a => a -> a
    hide         ArgInfo
    info) (Expr -> Arg Expr) -> Expr -> Arg Expr
    forall a b. (a -> b) -> a -> b
    $ Named NamedName Expr -> Expr
    forall name a. Named name a -> a
    namedThing Named NamedName Expr
    e
    mkArg' ArgInfo
    info (C.InstanceArg Range
    _ Named NamedName Expr
    e) = ArgInfo -> Expr -> Arg Expr
    forall e. ArgInfo -> e -> Arg e
    Arg (ArgInfo -> ArgInfo
    forall a. LensHiding a => a -> a
    makeInstance ArgInfo
    info) (Expr -> Arg Expr) -> Expr -> Arg Expr
    forall a b. (a -> b) -> a -> b
    $ Named NamedName Expr -> Expr
    forall name a. Named name a -> a
    namedThing Named NamedName Expr
    e
    mkArg' ArgInfo
    info Expr
    e                   = ArgInfo -> Expr -> Arg Expr
    forall e. ArgInfo -> e -> Arg e
    Arg (Hiding -> ArgInfo -> ArgInfo
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    NotHidden ArgInfo
    info) Expr
    e
    --UNUSED Liang-Ting 2019-07-16
    ---- | By default, arguments are @Relevant@.
    --mkArg :: C.Expr -> Arg C.Expr
    --mkArg e = mkArg' defaultArgInfo e

    inferParenPreference :: C.Expr -> ParenPreference
    inferParenPreference :: Expr -> ParenPreference
    inferParenPreference C.Paren{} = ParenPreference
    PreferParen
    inferParenPreference Expr
    _         = ParenPreference
    PreferParenless

    -- | Parse a possibly dotted and braced @C.Expr@ as @A.Expr@,
    --   interpreting dots as relevance and braces as hiding.
    --   Only accept a layer of dotting/bracing if the respective accumulator is @Nothing@.
    toAbstractDotHiding :: Maybe Relevance -> Maybe Hiding -> Precedence -> C.Expr -> ScopeM (A.Expr, Relevance, Hiding)
    toAbstractDotHiding :: Maybe Relevance
    -> Maybe Hiding
    -> Precedence
    -> Expr
    -> ScopeM (Expr, Relevance, Hiding)
    toAbstractDotHiding Maybe Relevance
    mr Maybe Hiding
    mh Precedence
    prec Expr
    e = do
        [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.irrelevance" Int
    100 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "toAbstractDotHiding: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Doc -> [Char]
    render (Expr -> Doc
    forall a. Pretty a => a -> Doc
    pretty Expr
    e)
        Call
    -> ScopeM (Expr, Relevance, Hiding)
    -> ScopeM (Expr, Relevance, Hiding)
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Expr -> Call
    ScopeCheckExpr Expr
    e) (ScopeM (Expr, Relevance, Hiding)
     -> ScopeM (Expr, Relevance, Hiding))
    -> ScopeM (Expr, Relevance, Hiding)
    -> ScopeM (Expr, Relevance, Hiding)
    forall a b. (a -> b) -> a -> b
    $ case Expr
    e of

          C.RawApp Range
    _ List2 Expr
    es     -> Maybe Relevance
    -> Maybe Hiding
    -> Precedence
    -> Expr
    -> ScopeM (Expr, Relevance, Hiding)
    toAbstractDotHiding Maybe Relevance
    mr Maybe Hiding
    mh Precedence
    prec (Expr -> ScopeM (Expr, Relevance, Hiding))
    -> TCMT IO Expr -> ScopeM (Expr, Relevance, Hiding)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< List2 Expr -> TCMT IO Expr
    parseApplication List2 Expr
    es
          C.Paren Range
    _ Expr
    e       -> Maybe Relevance
    -> Maybe Hiding
    -> Precedence
    -> Expr
    -> ScopeM (Expr, Relevance, Hiding)
    toAbstractDotHiding Maybe Relevance
    mr Maybe Hiding
    mh Precedence
    TopCtx Expr
    e

          C.Dot Range
    _ Expr
    e
            | Maybe Relevance
    Nothing <- Maybe Relevance
    mr -> Maybe Relevance
    -> Maybe Hiding
    -> Precedence
    -> Expr
    -> ScopeM (Expr, Relevance, Hiding)
    toAbstractDotHiding (Relevance -> Maybe Relevance
    forall a. a -> Maybe a
    Just Relevance
    Irrelevant) Maybe Hiding
    mh Precedence
    prec Expr
    e

          C.DoubleDot Range
    _ Expr
    e
            | Maybe Relevance
    Nothing <- Maybe Relevance
    mr -> Maybe Relevance
    -> Maybe Hiding
    -> Precedence
    -> Expr
    -> ScopeM (Expr, Relevance, Hiding)
    toAbstractDotHiding (Relevance -> Maybe Relevance
    forall a. a -> Maybe a
    Just Relevance
    NonStrict) Maybe Hiding
    mh Precedence
    prec Expr
    e

          C.HiddenArg Range
    _ (Named Maybe NamedName
    Nothing Expr
    e)
            | Maybe Hiding
    Nothing <- Maybe Hiding
    mh -> Maybe Relevance
    -> Maybe Hiding
    -> Precedence
    -> Expr
    -> ScopeM (Expr, Relevance, Hiding)
    toAbstractDotHiding Maybe Relevance
    mr (Hiding -> Maybe Hiding
    forall a. a -> Maybe a
    Just Hiding
    Hidden) Precedence
    TopCtx Expr
    e

          C.InstanceArg Range
    _ (Named Maybe NamedName
    Nothing Expr
    e)
            | Maybe Hiding
    Nothing <- Maybe Hiding
    mh -> Maybe Relevance
    -> Maybe Hiding
    -> Precedence
    -> Expr
    -> ScopeM (Expr, Relevance, Hiding)
    toAbstractDotHiding Maybe Relevance
    mr (Hiding -> Maybe Hiding
    forall a. a -> Maybe a
    Just (Hiding -> Maybe Hiding) -> Hiding -> Maybe Hiding
    forall a b. (a -> b) -> a -> b
    $ Overlappable -> Hiding
    Instance Overlappable
    NoOverlap) Precedence
    TopCtx Expr
    e

          Expr
    e                 -> (, Relevance -> Maybe Relevance -> Relevance
    forall a. a -> Maybe a -> a
    fromMaybe Relevance
    Relevant Maybe Relevance
    mr, Hiding -> Maybe Hiding -> Hiding
    forall a. a -> Maybe a -> a
    fromMaybe Hiding
    NotHidden Maybe Hiding
    mh) (Expr -> (Expr, Relevance, Hiding))
    -> ScopeM Expr -> ScopeM (Expr, Relevance, Hiding)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                 Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    prec Expr
    e

    -- | Translate concrete expression under at least one binder into nested
    --   lambda abstraction in abstract syntax.
    toAbstractLam :: Range -> List1 C.LamBinding -> C.Expr -> Precedence -> ScopeM A.Expr
    toAbstractLam :: Range
    -> NonEmpty (LamBinding' TypedBinding)
    -> Expr
    -> Precedence
    -> ScopeM Expr
    toAbstractLam Range
    r NonEmpty (LamBinding' TypedBinding)
    bs Expr
    e Precedence
    ctx = do
      -- Translate the binders
      [(Name, LocalVar)]
    lvars0 <- TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
      NonEmpty (LamBinding' TypedBinding)
    -> (AbsOfCon (NonEmpty (LamBinding' TypedBinding)) -> ScopeM Expr)
    -> ScopeM Expr
    forall c b.
    ToAbstract c =>
    c -> (AbsOfCon c -> ScopeM b) -> ScopeM b
    localToAbstract ((LamBinding' TypedBinding -> LamBinding' TypedBinding)
    -> NonEmpty (LamBinding' TypedBinding)
    -> NonEmpty (LamBinding' TypedBinding)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (TypedBinding -> LamBinding' TypedBinding
    forall a. a -> LamBinding' a
    C.DomainFull (TypedBinding -> LamBinding' TypedBinding)
    -> (LamBinding' TypedBinding -> TypedBinding)
    -> LamBinding' TypedBinding
    -> LamBinding' TypedBinding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LamBinding' TypedBinding -> TypedBinding
    makeDomainFull) NonEmpty (LamBinding' TypedBinding)
    bs) ((AbsOfCon (NonEmpty (LamBinding' TypedBinding)) -> ScopeM Expr)
     -> ScopeM Expr)
    -> (AbsOfCon (NonEmpty (LamBinding' TypedBinding)) -> ScopeM Expr)
    -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ \ AbsOfCon (NonEmpty (LamBinding' TypedBinding))
    bs -> do
        [(Name, LocalVar)]
    lvars1 <- TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
        [(Name, LocalVar)] -> [(Name, LocalVar)] -> TCMT IO ()
    checkNoShadowing [(Name, LocalVar)]
    lvars0 [(Name, LocalVar)]
    lvars1
        -- Translate the body
        Expr
    e <- Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    ctx Expr
    e
        -- We have at least one binder.  Get first @b@ and rest @bs@.
        Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ case List1 (Maybe LamBinding) -> [LamBinding]
    forall a. List1 (Maybe a) -> [a]
    List1.catMaybes List1 (Maybe LamBinding)
    AbsOfCon (NonEmpty (LamBinding' TypedBinding))
    bs of
          -- Andreas, 2020-06-18
          -- There is a pathological case in which we end up without binder:
          --   λ (let
          --        mutual -- warning: empty mutual block
          --     ) -> Set
          []   -> Expr
    e
          LamBinding
    b:[LamBinding]
    bs -> ExprInfo -> LamBinding -> Expr -> Expr
    A.Lam (Range -> ExprInfo
    ExprRange Range
    r) LamBinding
    b (Expr -> Expr) -> Expr -> Expr
    forall a b. (a -> b) -> a -> b
    $ (LamBinding -> Expr -> Expr) -> Expr -> [LamBinding] -> Expr
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr LamBinding -> Expr -> Expr
    mkLam Expr
    e [LamBinding]
    bs
      where
        mkLam :: LamBinding -> Expr -> Expr
    mkLam LamBinding
    b Expr
    e = ExprInfo -> LamBinding -> Expr -> Expr
    A.Lam (Range -> ExprInfo
    ExprRange (Range -> ExprInfo) -> Range -> ExprInfo
    forall a b. (a -> b) -> a -> b
    $ LamBinding -> Expr -> Range
    forall u t. (HasRange u, HasRange t) => u -> t -> Range
    fuseRange LamBinding
    b Expr
    e) LamBinding
    b Expr
    e

    -- | Scope check extended lambda expression.
    scopeCheckExtendedLam ::
      Range -> Erased -> List1 C.LamClause -> ScopeM A.Expr
    scopeCheckExtendedLam :: Range -> Erased -> List1 LamClause -> ScopeM Expr
    scopeCheckExtendedLam Range
    r Erased
    erased List1 LamClause
    cs = do
      TCMT IO Bool -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM TCMT IO Bool
    isInsideDotPattern (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
        [Char] -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Extended lambdas are not allowed in dot patterns"

      -- Find an unused name for the extended lambda definition.
      Name
    cname <- Range -> Int -> [Char] -> ScopeM Name
    freshConcreteName Range
    r Int
    0 [Char]
    extendedLambdaName
      Name
    name  <- Name -> ScopeM Name
    freshAbstractName_ Name
    cname
      IsAbstract
    a <- (TCEnv -> IsAbstract) -> TCMT IO IsAbstract
    forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
    asksTC (TCEnv -> Lens' IsAbstract TCEnv -> IsAbstract
    forall o i. o -> Lens' i o -> i
    ^. forall a. LensIsAbstract a => Lens' IsAbstract a
    Lens' IsAbstract TCEnv
    lensIsAbstract)
      [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.extendedLambda" Int
    10 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat
        [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "new extended lambda name (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ IsAbstract -> [Char]
    forall a. Show a => a -> [Char]
    show IsAbstract
    a [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "): " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    name
        ]
      [Char] -> Int -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *). MonadDebug m => [Char] -> Int -> m () -> m ()
    verboseS [Char]
    "scope.extendedLambda" Int
    60 (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        List1 LamClause -> (LamClause -> TCMT IO ()) -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ List1 LamClause
    cs ((LamClause -> TCMT IO ()) -> TCMT IO ())
    -> (LamClause -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ LamClause
    c -> do
          [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.extendedLambda" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "extended lambda lhs: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Pattern] -> [Char]
    forall a. Show a => a -> [Char]
    show (LamClause -> [Pattern]
    C.lamLHS LamClause
    c)
      QName
    qname <- Name -> TCMT IO QName
    qualifyName_ Name
    name
      Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName (Origin -> Access
    PrivateAccess Origin
    Inserted) KindOfName
    FunName Name
    cname QName
    qname

      -- Andreas, 2019-08-20
      -- Keep the following __IMPOSSIBLE__, which is triggered by -v scope.decl.trace:80,
      -- for testing issue #4016.
      NiceDeclaration
    d <- Range
    -> [Declaration]
    -> IsAbstract
    -> IsInstance
    -> TerminationCheck
    -> CoverageCheck
    -> Name
    -> [Clause]
    -> NiceDeclaration
    C.FunDef Range
    r [] IsAbstract
    a IsInstance
    NotInstanceDef TerminationCheck
    forall a. HasCallStack => a
    __IMPOSSIBLE__ CoverageCheck
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Name
    cname ([Clause] -> NiceDeclaration)
    -> (NonEmpty Clause -> [Clause])
    -> NonEmpty Clause
    -> NiceDeclaration
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty Clause -> [Clause]
    forall a. NonEmpty a -> [a]
    List1.toList (NonEmpty Clause -> NiceDeclaration)
    -> TCMT IO (NonEmpty Clause) -> TCMT IO NiceDeclaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
              List1 LamClause
    -> (LamClause -> TCMT IO Clause) -> TCMT IO (NonEmpty Clause)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM List1 LamClause
    cs ((LamClause -> TCMT IO Clause) -> TCMT IO (NonEmpty Clause))
    -> (LamClause -> TCMT IO Clause) -> TCMT IO (NonEmpty Clause)
    forall a b. (a -> b) -> a -> b
    $ \ (LamClause [Pattern]
    ps RHS' Expr
    rhs Bool
    ca) -> do
                let p :: Pattern
    p   = List1 Pattern -> Pattern
    C.rawAppP (List1 Pattern -> Pattern) -> List1 Pattern -> Pattern
    forall a b. (a -> b) -> a -> b
    $ (KillRangeT Pattern
    forall a. KillRange a => KillRangeT a
    killRange KillRangeT Pattern -> KillRangeT Pattern
    forall a b. (a -> b) -> a -> b
    $ QName -> Pattern
    IdentP (QName -> Pattern) -> QName -> Pattern
    forall a b. (a -> b) -> a -> b
    $ Name -> QName
    C.QName Name
    cname) Pattern -> [Pattern] -> List1 Pattern
    forall a. a -> [a] -> NonEmpty a
    :| [Pattern]
    ps
                let lhs :: LHS
    lhs = Pattern -> [RewriteEqn] -> [WithExpr] -> LHS
    C.LHS Pattern
    p [] []
                Clause -> TCMT IO Clause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Clause -> TCMT IO Clause) -> Clause -> TCMT IO Clause
    forall a b. (a -> b) -> a -> b
    $ Name
    -> Bool
    -> LHS
    -> RHS' Expr
    -> WhereClause' [Declaration]
    -> [Clause]
    -> Clause
    C.Clause Name
    cname Bool
    ca LHS
    lhs RHS' Expr
    rhs WhereClause' [Declaration]
    forall decls. WhereClause' decls
    NoWhere []
      Declaration
    scdef <- NiceDeclaration -> ScopeM (AbsOfCon NiceDeclaration)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract NiceDeclaration
    d

      -- Create the abstract syntax for the extended lambda.
      case Declaration
    scdef of
        A.ScopedDecl ScopeInfo
    si [A.FunDef DefInfo
    di QName
    qname' Delayed
    NotDelayed [Clause]
    cs] -> do
          ScopeInfo -> TCMT IO ()
    setScope ScopeInfo
    si  -- This turns into an A.ScopedExpr si $ A.ExtendedLam...
          Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $
            ExprInfo -> DefInfo -> Erased -> QName -> List1 Clause -> Expr
    A.ExtendedLam (Range -> ExprInfo
    ExprRange Range
    r) DefInfo
    di Erased
    erased QName
    qname' (List1 Clause -> Expr) -> List1 Clause -> Expr
    forall a b. (a -> b) -> a -> b
    $
            [Clause] -> List1 Clause
    forall a. [a] -> NonEmpty a
    List1.fromList [Clause]
    cs
        Declaration
    _ -> ScopeM Expr
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | Raise an error if argument is a C.Dot with Hiding info.

    rejectPostfixProjectionWithHiding :: NamedArg C.Expr -> ScopeM ()
    rejectPostfixProjectionWithHiding :: NamedArg Expr -> TCMT IO ()
    rejectPostfixProjectionWithHiding NamedArg Expr
    arg =
      case NamedArg Expr -> Expr
    forall a. NamedArg a -> a
    namedArg NamedArg Expr
    arg of
        C.Dot{} | NamedArg Expr -> Bool
    forall a. LensHiding a => a -> Bool
    notVisible NamedArg Expr
    arg -> NamedArg Expr -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange NamedArg Expr
    arg (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Doc -> m a
    genericDocError (Doc -> TCMT IO ()) -> Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
          Doc
    "Illegal hiding in postfix projection " Doc -> Doc -> Doc
    P.<+> NamedArg Expr -> Doc
    forall a. Pretty a => a -> Doc
    P.pretty NamedArg Expr
    arg
        Expr
    _ -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Scope check an expression.

    instance ToAbstract C.Expr where
      type AbsOfCon C.Expr = A.Expr

      toAbstract :: Expr -> ScopeM (AbsOfCon Expr)
    toAbstract Expr
    e =
        Call -> ScopeM Expr -> ScopeM Expr
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Expr -> Call
    ScopeCheckExpr Expr
    e) (ScopeM Expr -> ScopeM Expr) -> ScopeM Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ScopeM Expr -> ScopeM Expr
    forall (m :: * -> *). ReadTCState m => m Expr -> m Expr
    annotateExpr (ScopeM Expr -> ScopeM Expr) -> ScopeM Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ case Expr
    e of

      -- Names
          Ident QName
    x -> OldQName -> ScopeM (AbsOfCon OldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> Maybe (Set Name) -> OldQName
    OldQName QName
    x Maybe (Set Name)
    forall a. Maybe a
    Nothing)

      -- Literals
          C.Lit Range
    r Literal
    l -> do
            Literal -> TCMT IO ()
    checkLiteral Literal
    l
            case Literal
    l of
              LitNat Integer
    n -> do
                let builtin :: TCMT IO (Maybe Term)
    builtin | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0     = Term -> Maybe Term
    forall a. a -> Maybe a
    Just (Term -> Maybe Term) -> TCMT IO Term -> TCMT IO (Maybe Term)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO Term
    forall (m :: * -> *).
    (HasBuiltins m, MonadError TCErr m, MonadTCEnv m, ReadTCState m) =>
    m Term
    primFromNeg    -- negative literals are only allowed if FROMNEG is defined
                            | Bool
    otherwise = Maybe Term -> TCMT IO (Maybe Term)
    ensureInScope (Maybe Term -> TCMT IO (Maybe Term))
    -> TCMT IO (Maybe Term) -> TCMT IO (Maybe Term)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [Char] -> TCMT IO (Maybe Term)
    forall (m :: * -> *). HasBuiltins m => [Char] -> m (Maybe Term)
    getBuiltin' [Char]
    builtinFromNat
                TCMT IO (Maybe Term)
    builtin TCMT IO (Maybe Term) -> (Maybe Term -> ScopeM Expr) -> ScopeM Expr
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                  Just (I.Def QName
    q Elims
    _) -> Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ QName -> Expr -> Expr
    mkApp QName
    q (Expr -> Expr) -> Expr -> Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> Literal -> Expr
    A.Lit ExprInfo
    i (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    LitNat (Integer -> Literal) -> Integer -> Literal
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    n
                  Maybe Term
    _                -> Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return Expr
    alit

              LitString Text
    s -> do
                [Char] -> TCMT IO (Maybe Term)
    forall (m :: * -> *). HasBuiltins m => [Char] -> m (Maybe Term)
    getBuiltin' [Char]
    builtinFromString TCMT IO (Maybe Term)
    -> (Maybe Term -> TCMT IO (Maybe Term)) -> TCMT IO (Maybe Term)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe Term -> TCMT IO (Maybe Term)
    ensureInScope TCMT IO (Maybe Term) -> (Maybe Term -> ScopeM Expr) -> ScopeM Expr
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                  Just (I.Def QName
    q Elims
    _) -> Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ QName -> Expr -> Expr
    mkApp QName
    q Expr
    alit
                  Maybe Term
    _                -> Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return Expr
    alit

              Literal
    _ -> Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return Expr
    alit
            where
            i :: ExprInfo
    i       = Range -> ExprInfo
    ExprRange Range
    r
            alit :: Expr
    alit    = ExprInfo -> Literal -> Expr
    A.Lit ExprInfo
    i Literal
    l
            mkApp :: QName -> Expr -> Expr
    mkApp QName
    q = AppInfo -> Expr -> NamedArg Expr -> Expr
    A.App (Range -> AppInfo
    defaultAppInfo Range
    r) (QName -> Expr
    A.Def QName
    q) (NamedArg Expr -> Expr) -> (Expr -> NamedArg Expr) -> Expr -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Expr -> NamedArg Expr
    forall a. a -> NamedArg a
    defaultNamedArg

            -- #4925: Require fromNat/fromNeg to be in scope *unqualified* for literal overloading to
            -- apply.
            ensureInScope :: Maybe I.Term -> ScopeM (Maybe I.Term)
            ensureInScope :: Maybe Term -> TCMT IO (Maybe Term)
    ensureInScope v :: Maybe Term
    v@(Just (I.Def QName
    q Elims
    _)) =
              TCMT IO Bool
    -> TCMT IO (Maybe Term)
    -> TCMT IO (Maybe Term)
    -> TCMT IO (Maybe Term)
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (QName -> ScopeInfo -> Bool
    isNameInScopeUnqualified QName
    q (ScopeInfo -> Bool) -> TCMT IO ScopeInfo -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO ScopeInfo
    forall (m :: * -> *). ReadTCState m => m ScopeInfo
    getScope) (Maybe Term -> TCMT IO (Maybe Term)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Term
    v) (Maybe Term -> TCMT IO (Maybe Term)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Term
    forall a. Maybe a
    Nothing)
            ensureInScope Maybe Term
    _ = Maybe Term -> TCMT IO (Maybe Term)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Term
    forall a. Maybe a
    Nothing

      -- Meta variables
          C.QuestionMark Range
    r Maybe Int
    n -> do
            ScopeInfo
    scope <- TCMT IO ScopeInfo
    forall (m :: * -> *). ReadTCState m => m ScopeInfo
    getScope
            -- Andreas, 2014-04-06 create interaction point.
            InteractionId
    ii <- Bool -> Range -> Maybe Int -> TCMT IO InteractionId
    forall (m :: * -> *).
    MonadInteractionPoints m =>
    Bool -> Range -> Maybe Int -> m InteractionId
    registerInteractionPoint Bool
    True Range
    r Maybe Int
    n
            let info :: MetaInfo
    info = MetaInfo :: Range -> ScopeInfo -> Maybe MetaId -> [Char] -> MetaInfo
    MetaInfo
                 { metaRange :: Range
    metaRange  = Range
    r
                 , metaScope :: ScopeInfo
    metaScope  = ScopeInfo
    scope
                 , metaNumber :: Maybe MetaId
    metaNumber = Maybe MetaId
    forall a. Maybe a
    Nothing
                 , metaNameSuggestion :: [Char]
    metaNameSuggestion = [Char]
    ""
                 }
            Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ MetaInfo -> InteractionId -> Expr
    A.QuestionMark MetaInfo
    info InteractionId
    ii
          C.Underscore Range
    r Maybe [Char]
    n -> do
            ScopeInfo
    scope <- TCMT IO ScopeInfo
    forall (m :: * -> *). ReadTCState m => m ScopeInfo
    getScope
            Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ MetaInfo -> Expr
    A.Underscore (MetaInfo -> Expr) -> MetaInfo -> Expr
    forall a b. (a -> b) -> a -> b
    $ MetaInfo :: Range -> ScopeInfo -> Maybe MetaId -> [Char] -> MetaInfo
    MetaInfo
                        { metaRange :: Range
    metaRange  = Range
    r
                        , metaScope :: ScopeInfo
    metaScope  = ScopeInfo
    scope
                        , metaNumber :: Maybe MetaId
    metaNumber = [Char] -> Maybe MetaId
    forall a. HasCallStack => a
    __IMPOSSIBLE__ ([Char] -> Maybe MetaId) -> Maybe [Char] -> Maybe MetaId
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe [Char]
    n
                        , metaNameSuggestion :: [Char]
    metaNameSuggestion = [Char] -> Maybe [Char] -> [Char]
    forall a. a -> Maybe a -> a
    fromMaybe [Char]
    "" Maybe [Char]
    n
                        }

      -- Raw application
          C.RawApp Range
    r List2 Expr
    es -> do
            Expr
    e <- List2 Expr -> TCMT IO Expr
    parseApplication List2 Expr
    es
            Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    e

      -- Application
          C.App Range
    r Expr
    e1 NamedArg Expr
    e2 -> do
            -- Andreas, 2021-02-10, issue #3289: reject @e {.p}@ and @e ⦃ .p ⦄@.
            NamedArg Expr -> TCMT IO ()
    rejectPostfixProjectionWithHiding NamedArg Expr
    e2

            let parenPref :: ParenPreference
    parenPref = Expr -> ParenPreference
    inferParenPreference (NamedArg Expr -> Expr
    forall a. NamedArg a -> a
    namedArg NamedArg Expr
    e2)
                info :: AppInfo
    info = (Range -> AppInfo
    defaultAppInfo Range
    r) { appOrigin :: Origin
    appOrigin = Origin
    UserWritten, appParens :: ParenPreference
    appParens = ParenPreference
    parenPref }
            Expr
    e1 <- Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    FunctionCtx Expr
    e1
            NamedArg Expr
    e2 <- Precedence -> NamedArg Expr -> ScopeM (AbsOfCon (NamedArg Expr))
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx (ParenPreference -> Precedence
    ArgumentCtx ParenPreference
    parenPref) NamedArg Expr
    e2
            Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ AppInfo -> Expr -> NamedArg Expr -> Expr
    A.App AppInfo
    info Expr
    e1 NamedArg Expr
    e2

      -- Operator application
          C.OpApp Range
    r QName
    op Set Name
    ns OpAppArgs
    es -> QName -> Set Name -> OpAppArgs -> ScopeM Expr
    toAbstractOpApp QName
    op Set Name
    ns OpAppArgs
    es

      -- With application
          C.WithApp Range
    r Expr
    e [Expr]
    es -> do
            Expr
    e  <- Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    WithFunCtx Expr
    e
            [Expr]
    es <- (Expr -> ScopeM Expr) -> [Expr] -> TCMT IO [Expr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    WithArgCtx) [Expr]
    es
            Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> Expr -> [Expr] -> Expr
    A.WithApp (Range -> ExprInfo
    ExprRange Range
    r) Expr
    e [Expr]
    es

      -- Misplaced hidden argument
          C.HiddenArg Range
    _ Named NamedName Expr
    _ -> Expr -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Expr -> m a
    nothingAppliedToHiddenArg Expr
    e
          C.InstanceArg Range
    _ Named NamedName Expr
    _ -> Expr -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Expr -> m a
    nothingAppliedToInstanceArg Expr
    e

      -- Lambda
          C.AbsurdLam Range
    r Hiding
    h -> Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> Hiding -> Expr
    A.AbsurdLam (Range -> ExprInfo
    ExprRange Range
    r) Hiding
    h

          C.Lam Range
    r NonEmpty (LamBinding' TypedBinding)
    bs Expr
    e -> Range
    -> NonEmpty (LamBinding' TypedBinding)
    -> Expr
    -> Precedence
    -> ScopeM Expr
    toAbstractLam Range
    r NonEmpty (LamBinding' TypedBinding)
    bs Expr
    e Precedence
    TopCtx

      -- Extended Lambda
          C.ExtendedLam Range
    r Erased
    e List1 LamClause
    cs -> Range -> Erased -> List1 LamClause -> ScopeM Expr
    scopeCheckExtendedLam Range
    r Erased
    e List1 LamClause
    cs

      -- Relevant and irrelevant non-dependent function type
          C.Fun Range
    r (Arg ArgInfo
    info1 Expr
    e1) Expr
    e2 -> do
            let arg :: Arg Expr
    arg = ArgInfo -> Expr -> Arg Expr
    mkArg' ArgInfo
    info1 Expr
    e1
            let mr :: Maybe Relevance
    mr = case Arg Expr -> Relevance
    forall a. LensRelevance a => a -> Relevance
    getRelevance Arg Expr
    arg of
                  Relevance
    Relevant  -> Maybe Relevance
    forall a. Maybe a
    Nothing
                  Relevance
    r         -> Relevance -> Maybe Relevance
    forall a. a -> Maybe a
    Just Relevance
    r
            let mh :: Maybe Hiding
    mh = case Arg Expr -> Hiding
    forall a. LensHiding a => a -> Hiding
    getHiding Arg Expr
    arg of
                  Hiding
    NotHidden -> Maybe Hiding
    forall a. Maybe a
    Nothing
                  Hiding
    h         -> Hiding -> Maybe Hiding
    forall a. a -> Maybe a
    Just Hiding
    h
            Arg ArgInfo
    info (Expr
    e1', Relevance
    rel, Hiding
    hid) <- (Expr -> ScopeM (Expr, Relevance, Hiding))
    -> Arg Expr -> TCMT IO (Arg (Expr, Relevance, Hiding))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Maybe Relevance
    -> Maybe Hiding
    -> Precedence
    -> Expr
    -> ScopeM (Expr, Relevance, Hiding)
    toAbstractDotHiding Maybe Relevance
    mr Maybe Hiding
    mh Precedence
    FunctionSpaceDomainCtx) Arg Expr
    arg
            let updRel :: ArgInfo -> ArgInfo
    updRel = case Relevance
    rel of
                  Relevance
    Relevant -> ArgInfo -> ArgInfo
    forall a. a -> a
    id
                  Relevance
    rel      -> Relevance -> ArgInfo -> ArgInfo
    forall a. LensRelevance a => Relevance -> a -> a
    setRelevance Relevance
    rel
            let updHid :: ArgInfo -> ArgInfo
    updHid = case Hiding
    hid of
                  Hiding
    NotHidden -> ArgInfo -> ArgInfo
    forall a. a -> a
    id
                  Hiding
    hid       -> Hiding -> ArgInfo -> ArgInfo
    forall a. LensHiding a => Hiding -> a -> a
    setHiding Hiding
    hid
            ExprInfo -> Arg Expr -> Expr -> Expr
    A.Fun (Range -> ExprInfo
    ExprRange Range
    r) (ArgInfo -> Expr -> Arg Expr
    forall e. ArgInfo -> e -> Arg e
    Arg (ArgInfo -> ArgInfo
    updRel (ArgInfo -> ArgInfo) -> ArgInfo -> ArgInfo
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> ArgInfo
    updHid ArgInfo
    info) Expr
    e1') (Expr -> Expr) -> ScopeM Expr -> ScopeM Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx Expr
    e2

      -- Dependent function type
          e0 :: Expr
    e0@(C.Pi Telescope1
    tel Expr
    e) -> do
            [(Name, LocalVar)]
    lvars0 <- TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
            Telescope1 -> (AbsOfCon Telescope1 -> ScopeM Expr) -> ScopeM Expr
    forall c b.
    ToAbstract c =>
    c -> (AbsOfCon c -> ScopeM b) -> ScopeM b
    localToAbstract Telescope1
    tel ((AbsOfCon Telescope1 -> ScopeM Expr) -> ScopeM Expr)
    -> (AbsOfCon Telescope1 -> ScopeM Expr) -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ \AbsOfCon Telescope1
    tel -> do
              [(Name, LocalVar)]
    lvars1 <- TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
              [(Name, LocalVar)] -> [(Name, LocalVar)] -> TCMT IO ()
    checkNoShadowing [(Name, LocalVar)]
    lvars0 [(Name, LocalVar)]
    lvars1
              Expr
    e <- Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx Expr
    e
              let info :: ExprInfo
    info = Range -> ExprInfo
    ExprRange (Expr -> Range
    forall a. HasRange a => a -> Range
    getRange Expr
    e0)
              Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> [TypedBinding] -> Expr -> Expr
    A.mkPi ExprInfo
    info (List1 (Maybe TypedBinding) -> [TypedBinding]
    forall a. List1 (Maybe a) -> [a]
    List1.catMaybes List1 (Maybe TypedBinding)
    AbsOfCon Telescope1
    tel) Expr
    e

      -- Let
          e0 :: Expr
    e0@(C.Let Range
    _ List1 Declaration
    ds (Just Expr
    e)) ->
            TCMT IO Bool -> ScopeM Expr -> ScopeM Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM TCMT IO Bool
    isInsideDotPattern ([Char] -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> ScopeM Expr) -> [Char] -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Let-expressions are not allowed in dot patterns") (ScopeM Expr -> ScopeM Expr) -> ScopeM Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $
            LetDefs -> (AbsOfCon LetDefs -> ScopeM Expr) -> ScopeM Expr
    forall c b.
    ToAbstract c =>
    c -> (AbsOfCon c -> ScopeM b) -> ScopeM b
    localToAbstract (List1 Declaration -> LetDefs
    LetDefs List1 Declaration
    ds) ((AbsOfCon LetDefs -> ScopeM Expr) -> ScopeM Expr)
    -> (AbsOfCon LetDefs -> ScopeM Expr) -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ \AbsOfCon LetDefs
    ds' -> do
              Expr
    e <- Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx Expr
    e
              let info :: ExprInfo
    info = Range -> ExprInfo
    ExprRange (Expr -> Range
    forall a. HasRange a => a -> Range
    getRange Expr
    e0)
              Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> [LetBinding] -> Expr -> Expr
    A.mkLet ExprInfo
    info [LetBinding]
    AbsOfCon LetDefs
    ds' Expr
    e
          C.Let Range
    _ List1 Declaration
    _ TacticAttribute
    Nothing -> [Char] -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Missing body in let-expression"

      -- Record construction
          C.Rec Range
    r RecordAssignments
    fs  -> do
            [Either Assign (ModuleName, Maybe LetBinding)]
    fs' <- Precedence
    -> RecordAssignments -> ScopeM (AbsOfCon RecordAssignments)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx RecordAssignments
    fs
            let ds' :: [LetBinding]
    ds'  = [ LetBinding
    d | Right (ModuleName
    _, Just LetBinding
    d) <- [Either Assign (ModuleName, Maybe LetBinding)]
    fs' ]
                fs'' :: [Either Assign ModuleName]
    fs'' = (Either Assign (ModuleName, Maybe LetBinding)
     -> Either Assign ModuleName)
    -> [Either Assign (ModuleName, Maybe LetBinding)]
    -> [Either Assign ModuleName]
    forall a b. (a -> b) -> [a] -> [b]
    map (((ModuleName, Maybe LetBinding) -> ModuleName)
    -> Either Assign (ModuleName, Maybe LetBinding)
    -> Either Assign ModuleName
    forall b d a. (b -> d) -> Either a b -> Either a d
    mapRight (ModuleName, Maybe LetBinding) -> ModuleName
    forall a b. (a, b) -> a
    fst) [Either Assign (ModuleName, Maybe LetBinding)]
    fs'
                i :: ExprInfo
    i    = Range -> ExprInfo
    ExprRange Range
    r
            Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> [LetBinding] -> Expr -> Expr
    A.mkLet ExprInfo
    i [LetBinding]
    ds' (ExprInfo -> [Either Assign ModuleName] -> Expr
    A.Rec ExprInfo
    i [Either Assign ModuleName]
    fs'')

      -- Record update
          C.RecUpdate Range
    r Expr
    e [FieldAssignment]
    fs -> do
            ExprInfo -> Expr -> Assigns -> Expr
    A.RecUpdate (Range -> ExprInfo
    ExprRange Range
    r) (Expr -> Assigns -> Expr)
    -> ScopeM Expr -> TCMT IO (Assigns -> Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    e TCMT IO (Assigns -> Expr) -> TCMT IO Assigns -> ScopeM Expr
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Precedence
    -> [FieldAssignment] -> ScopeM (AbsOfCon [FieldAssignment])
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx [FieldAssignment]
    fs

      -- Parenthesis
          C.Paren Range
    _ Expr
    e -> Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx Expr
    e

      -- Idiom brackets
          C.IdiomBrackets Range
    r [Expr]
    es ->
            Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx (Expr -> ScopeM Expr) -> TCMT IO Expr -> ScopeM Expr
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Range -> [Expr] -> TCMT IO Expr
    parseIdiomBracketsSeq Range
    r [Expr]
    es

      -- Do notation
          C.DoBlock Range
    r List1 DoStmt
    ss ->
            Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx (Expr -> ScopeM Expr) -> TCMT IO Expr -> ScopeM Expr
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Range -> List1 DoStmt -> TCMT IO Expr
    desugarDoNotation Range
    r List1 DoStmt
    ss

      -- Post-fix projections
          C.Dot Range
    r Expr
    e  -> ExprInfo -> Expr -> Expr
    A.Dot (Range -> ExprInfo
    ExprRange Range
    r) (Expr -> Expr) -> ScopeM Expr -> ScopeM Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    e

      -- Pattern things
          C.As Range
    _ Name
    _ Expr
    _ -> Expr -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Expr -> m a
    notAnExpression Expr
    e
          C.Absurd Range
    _ -> Expr -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    Expr -> m a
    notAnExpression Expr
    e

      -- Impossible things
          C.ETel Telescope
    _  -> ScopeM Expr
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          C.Equal{} -> [Char] -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Parse error: unexpected '='"
          C.Ellipsis Range
    _ -> [Char] -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Parse error: unexpected '...'"
          C.DoubleDot Range
    _ Expr
    _ -> [Char] -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Parse error: unexpected '..'"

      -- Quoting
          C.Quote Range
    r -> Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> Expr
    A.Quote (Range -> ExprInfo
    ExprRange Range
    r)
          C.QuoteTerm Range
    r -> Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> Expr
    A.QuoteTerm (Range -> ExprInfo
    ExprRange Range
    r)
          C.Unquote Range
    r -> Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> Expr
    A.Unquote (Range -> ExprInfo
    ExprRange Range
    r)

          C.Tactic Range
    r Expr
    e -> [Char] -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Syntax error: 'tactic' can only appear in attributes"

      -- DontCare
          C.DontCare Expr
    e -> Expr -> Expr
    A.DontCare (Expr -> Expr) -> ScopeM Expr -> ScopeM Expr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    e

      -- forall-generalize
          C.Generalized Expr
    e -> do
            (Set QName
    s, Expr
    e) <- ScopeM Expr -> ScopeM (Set QName, Expr)
    forall a. ScopeM a -> ScopeM (Set QName, a)
    collectGeneralizables (ScopeM Expr -> ScopeM (Set QName, Expr))
    -> ScopeM Expr -> ScopeM (Set QName, Expr)
    forall a b. (a -> b) -> a -> b
    $ Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    e
            Expr -> ScopeM Expr
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ Set QName -> Expr -> Expr
    A.generalized Set QName
    s Expr
    e

    instance ToAbstract C.ModuleAssignment where
      type AbsOfCon C.ModuleAssignment = (A.ModuleName, Maybe A.LetBinding)
      toAbstract :: ModuleAssignment -> ScopeM (AbsOfCon ModuleAssignment)
    toAbstract (C.ModuleAssignment QName
    m [Expr]
    es ImportDirective
    i)
        | [Expr] -> Bool
    forall a. Null a => a -> Bool
    null [Expr]
    es Bool -> Bool -> Bool
    && ImportDirective -> Bool
    forall n m. ImportDirective' n m -> Bool
    isDefaultImportDir ImportDirective
    i = (, Maybe LetBinding
    forall a. Maybe a
    Nothing) (ModuleName -> (ModuleName, Maybe LetBinding))
    -> TCMT IO ModuleName -> TCMT IO (ModuleName, Maybe LetBinding)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> OldModuleName -> ScopeM (AbsOfCon OldModuleName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> OldModuleName
    OldModuleName QName
    m)
        | Bool
    otherwise = do
            Name
    x <- Range -> NameId -> Name
    C.NoName (QName -> Range
    forall a. HasRange a => a -> Range
    getRange QName
    m) (NameId -> Name) -> TCMT IO NameId -> ScopeM Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO NameId
    forall i (m :: * -> *). MonadFresh i m => m i
    fresh
            LetBinding
    r <- (ModuleInfo
     -> ModuleName
     -> ModuleApplication
     -> ScopeCopyInfo
     -> ImportDirective
     -> LetBinding)
    -> OpenKind
    -> Range
    -> Access
    -> Name
    -> ModuleApplication
    -> OpenShortHand
    -> ImportDirective
    -> ScopeM LetBinding
    forall a.
    (ToConcrete a, Pretty (ConOfAbs a)) =>
    (ModuleInfo
     -> ModuleName
     -> ModuleApplication
     -> ScopeCopyInfo
     -> ImportDirective
     -> a)
    -> OpenKind
    -> Range
    -> Access
    -> Name
    -> ModuleApplication
    -> OpenShortHand
    -> ImportDirective
    -> ScopeM a
    checkModuleMacro ModuleInfo
    -> ModuleName
    -> ModuleApplication
    -> ScopeCopyInfo
    -> ImportDirective
    -> LetBinding
    LetApply OpenKind
    LetOpenModule ((QName, [Expr], ImportDirective) -> Range
    forall a. HasRange a => a -> Range
    getRange (QName
    m, [Expr]
    es, ImportDirective
    i)) Access
    PublicAccess Name
    x
                   (Range -> Telescope -> Expr -> ModuleApplication
    C.SectionApp ((QName, [Expr]) -> Range
    forall a. HasRange a => a -> Range
    getRange (QName
    m , [Expr]
    es)) [] (List1 Expr -> Expr
    rawApp (QName -> Expr
    Ident QName
    m Expr -> [Expr] -> List1 Expr
    forall a. a -> [a] -> NonEmpty a
    :| [Expr]
    es)))
                   OpenShortHand
    DontOpen ImportDirective
    i
            case LetBinding
    r of
              LetApply ModuleInfo
    _ ModuleName
    m' ModuleApplication
    _ ScopeCopyInfo
    _ ImportDirective
    _ -> (ModuleName, Maybe LetBinding)
    -> TCMT IO (ModuleName, Maybe LetBinding)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleName
    m', LetBinding -> Maybe LetBinding
    forall a. a -> Maybe a
    Just LetBinding
    r)
              LetBinding
    _ -> TCMT IO (ModuleName, Maybe LetBinding)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    instance ToAbstract c => ToAbstract (FieldAssignment' c) where
      type AbsOfCon (FieldAssignment' c) = FieldAssignment' (AbsOfCon c)

      toAbstract :: FieldAssignment' c -> ScopeM (AbsOfCon (FieldAssignment' c))
    toAbstract = (c -> TCMT IO (AbsOfCon c))
    -> FieldAssignment' c -> TCMT IO (FieldAssignment' (AbsOfCon c))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse c -> TCMT IO (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract

    instance ToAbstract (C.Binder' (NewName C.BoundName)) where
      type AbsOfCon (C.Binder' (NewName C.BoundName)) = A.Binder

      toAbstract :: Binder' (NewName BoundName)
    -> ScopeM (AbsOfCon (Binder' (NewName BoundName)))
    toAbstract (C.Binder Maybe Pattern
    p NewName BoundName
    n) = do
        let name :: Name
    name = BoundName -> Name
    C.boundName (BoundName -> Name) -> BoundName -> Name
    forall a b. (a -> b) -> a -> b
    $ NewName BoundName -> BoundName
    forall a. NewName a -> a
    newName NewName BoundName
    n
        -- If we do have a pattern then the variable needs to be inserted
        -- so we do need a proper internal name for it.
        NewName BoundName
    n <- if Bool -> Bool
    not (Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    name Bool -> Bool -> Bool
    && Maybe Pattern -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Pattern
    p) then NewName BoundName -> TCMT IO (NewName BoundName)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure NewName BoundName
    n else do
               Name
    n' <- Range -> Int -> [Char] -> ScopeM Name
    freshConcreteName (BoundName -> Range
    forall a. HasRange a => a -> Range
    getRange (BoundName -> Range) -> BoundName -> Range
    forall a b. (a -> b) -> a -> b
    $ NewName BoundName -> BoundName
    forall a. NewName a -> a
    newName NewName BoundName
    n) Int
    0 [Char]
    patternInTeleName
               NewName BoundName -> TCMT IO (NewName BoundName)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (NewName BoundName -> TCMT IO (NewName BoundName))
    -> NewName BoundName -> TCMT IO (NewName BoundName)
    forall a b. (a -> b) -> a -> b
    $ (BoundName -> BoundName) -> NewName BoundName -> NewName BoundName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\ BoundName
    n -> BoundName
    n { boundName :: Name
    C.boundName = Name
    n' }) NewName BoundName
    n
        BindName
    n <- NewName BoundName -> ScopeM (AbsOfCon (NewName BoundName))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract NewName BoundName
    n
        -- Actually parsing the pattern, checking it is linear,
        -- and bind its variables
        Maybe Pattern
    p <- (Pattern -> TCMT IO Pattern)
    -> Maybe Pattern -> TCMT IO (Maybe Pattern)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Pattern -> TCMT IO Pattern
    parsePattern Maybe Pattern
    p
        Maybe (Pattern' Expr)
    p <- Maybe Pattern -> ScopeM (AbsOfCon (Maybe Pattern))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Maybe Pattern
    p
        Maybe (Pattern' Expr) -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) p.
    (Monad m, APatternLike p) =>
    p -> ([Name] -> m ()) -> m ()
    checkPatternLinearity Maybe (Pattern' Expr)
    p (([Name] -> TCMT IO ()) -> TCMT IO ())
    -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \[Name]
    ys ->
          TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Name] -> TypeError
    RepeatedVariablesInPattern [Name]
    ys
        TCMT IO ()
    bindVarsToBind
        Maybe Pattern
    p <- Maybe (Pattern' Expr) -> ScopeM (AbsOfCon (Maybe (Pattern' Expr)))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Maybe (Pattern' Expr)
    p
        Binder' BindName -> TCMT IO (Binder' BindName)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Binder' BindName -> TCMT IO (Binder' BindName))
    -> Binder' BindName -> TCMT IO (Binder' BindName)
    forall a b. (a -> b) -> a -> b
    $ Maybe Pattern -> BindName -> Binder' BindName
    forall a. Maybe Pattern -> a -> Binder' a
    A.Binder Maybe Pattern
    p BindName
    n

    instance ToAbstract C.LamBinding where
      type AbsOfCon C.LamBinding = Maybe A.LamBinding

      toAbstract :: LamBinding' TypedBinding
    -> ScopeM (AbsOfCon (LamBinding' TypedBinding))
    toAbstract (C.DomainFree NamedArg Binder
    x)  = do
        Maybe Expr
    tac <- (Expr -> ScopeM Expr) -> TacticAttribute -> TCMT IO (Maybe Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Expr -> ScopeM Expr
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (TacticAttribute -> TCMT IO (Maybe Expr))
    -> TacticAttribute -> TCMT IO (Maybe Expr)
    forall a b. (a -> b) -> a -> b
    $ BoundName -> TacticAttribute
    bnameTactic (BoundName -> TacticAttribute) -> BoundName -> TacticAttribute
    forall a b. (a -> b) -> a -> b
    $ Binder -> BoundName
    forall a. Binder' a -> a
    C.binderName (Binder -> BoundName) -> Binder -> BoundName
    forall a b. (a -> b) -> a -> b
    $ NamedArg Binder -> Binder
    forall a. NamedArg a -> a
    namedArg NamedArg Binder
    x
        LamBinding -> Maybe LamBinding
    forall a. a -> Maybe a
    Just (LamBinding -> Maybe LamBinding)
    -> (NamedArg (Binder' BindName) -> LamBinding)
    -> NamedArg (Binder' BindName)
    -> Maybe LamBinding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Expr -> NamedArg (Binder' BindName) -> LamBinding
    A.DomainFree Maybe Expr
    tac (NamedArg (Binder' BindName) -> Maybe LamBinding)
    -> TCMT IO (NamedArg (Binder' BindName))
    -> TCMT IO (Maybe LamBinding)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamedArg (Binder' (NewName BoundName))
    -> ScopeM (AbsOfCon (NamedArg (Binder' (NewName BoundName))))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ((Binder -> Binder' (NewName BoundName))
    -> NamedArg Binder -> NamedArg (Binder' (NewName BoundName))
    forall a b. (a -> b) -> NamedArg a -> NamedArg b
    updateNamedArg ((BoundName -> NewName BoundName)
    -> Binder -> Binder' (NewName BoundName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((BoundName -> NewName BoundName)
     -> Binder -> Binder' (NewName BoundName))
    -> (BoundName -> NewName BoundName)
    -> Binder
    -> Binder' (NewName BoundName)
    forall a b. (a -> b) -> a -> b
    $ BindingSource -> BoundName -> NewName BoundName
    forall a. BindingSource -> a -> NewName a
    NewName BindingSource
    LambdaBound) NamedArg Binder
    x)
      toAbstract (C.DomainFull TypedBinding
    tb) = (TypedBinding -> LamBinding)
    -> Maybe TypedBinding -> Maybe LamBinding
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TypedBinding -> LamBinding
    A.DomainFull (Maybe TypedBinding -> Maybe LamBinding)
    -> TCMT IO (Maybe TypedBinding) -> TCMT IO (Maybe LamBinding)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TypedBinding -> ScopeM (AbsOfCon TypedBinding)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract TypedBinding
    tb

    makeDomainFull :: C.LamBinding -> C.TypedBinding
    makeDomainFull :: LamBinding' TypedBinding -> TypedBinding
    makeDomainFull (C.DomainFull TypedBinding
    b) = TypedBinding
    b
    makeDomainFull (C.DomainFree NamedArg Binder
    x) = Range -> List1 (NamedArg Binder) -> Expr -> TypedBinding
    forall e. Range -> List1 (NamedArg Binder) -> e -> TypedBinding' e
    C.TBind Range
    r (NamedArg Binder -> List1 (NamedArg Binder)
    forall el coll. Singleton el coll => el -> coll
    singleton NamedArg Binder
    x) (Expr -> TypedBinding) -> Expr -> TypedBinding
    forall a b. (a -> b) -> a -> b
    $ Range -> Maybe [Char] -> Expr
    C.Underscore Range
    r Maybe [Char]
    forall a. Maybe a
    Nothing
      where r :: Range
    r = NamedArg Binder -> Range
    forall a. HasRange a => a -> Range
    getRange NamedArg Binder
    x

    instance ToAbstract C.TypedBinding where
      type AbsOfCon C.TypedBinding = Maybe A.TypedBinding

      toAbstract :: TypedBinding -> ScopeM (AbsOfCon TypedBinding)
    toAbstract (C.TBind Range
    r List1 (NamedArg Binder)
    xs Expr
    t) = do
        Expr
    t' <- Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx Expr
    t
        Maybe Expr
    tac <- (Expr -> ScopeM Expr) -> TacticAttribute -> TCMT IO (Maybe Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Expr -> ScopeM Expr
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (TacticAttribute -> TCMT IO (Maybe Expr))
    -> TacticAttribute -> TCMT IO (Maybe Expr)
    forall a b. (a -> b) -> a -> b
    $
                 case (NamedArg Binder -> TacticAttribute)
    -> List1 (NamedArg Binder) -> [Expr]
    forall a b. (a -> Maybe b) -> List1 a -> [b]
    List1.mapMaybe (BoundName -> TacticAttribute
    bnameTactic (BoundName -> TacticAttribute)
    -> (NamedArg Binder -> BoundName)
    -> NamedArg Binder
    -> TacticAttribute
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Binder -> BoundName
    forall a. Binder' a -> a
    C.binderName (Binder -> BoundName)
    -> (NamedArg Binder -> Binder) -> NamedArg Binder -> BoundName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedArg Binder -> Binder
    forall a. NamedArg a -> a
    namedArg) List1 (NamedArg Binder)
    xs of
                   []      -> TacticAttribute
    forall a. Maybe a
    Nothing
                   Expr
    tac : [Expr]
    _ -> Expr -> TacticAttribute
    forall a. a -> Maybe a
    Just Expr
    tac
                   -- Invariant: all tactics are the same
                   -- (distributed in the parser, TODO: don't)
        List1 (NamedArg (Binder' BindName))
    xs' <- NonEmpty (NamedArg (Binder' (NewName BoundName)))
    -> ScopeM
         (AbsOfCon (NonEmpty (NamedArg (Binder' (NewName BoundName)))))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (NonEmpty (NamedArg (Binder' (NewName BoundName)))
     -> ScopeM
          (AbsOfCon (NonEmpty (NamedArg (Binder' (NewName BoundName))))))
    -> NonEmpty (NamedArg (Binder' (NewName BoundName)))
    -> ScopeM
         (AbsOfCon (NonEmpty (NamedArg (Binder' (NewName BoundName)))))
    forall a b. (a -> b) -> a -> b
    $ (NamedArg Binder -> NamedArg (Binder' (NewName BoundName)))
    -> List1 (NamedArg Binder)
    -> NonEmpty (NamedArg (Binder' (NewName BoundName)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Binder -> Binder' (NewName BoundName))
    -> NamedArg Binder -> NamedArg (Binder' (NewName BoundName))
    forall a b. (a -> b) -> NamedArg a -> NamedArg b
    updateNamedArg ((BoundName -> NewName BoundName)
    -> Binder -> Binder' (NewName BoundName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((BoundName -> NewName BoundName)
     -> Binder -> Binder' (NewName BoundName))
    -> (BoundName -> NewName BoundName)
    -> Binder
    -> Binder' (NewName BoundName)
    forall a b. (a -> b) -> a -> b
    $ BindingSource -> BoundName -> NewName BoundName
    forall a. BindingSource -> a -> NewName a
    NewName BindingSource
    LambdaBound)) List1 (NamedArg Binder)
    xs
        Maybe TypedBinding -> TCMT IO (Maybe TypedBinding)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe TypedBinding -> TCMT IO (Maybe TypedBinding))
    -> Maybe TypedBinding -> TCMT IO (Maybe TypedBinding)
    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
    -> Maybe Expr
    -> List1 (NamedArg (Binder' BindName))
    -> Expr
    -> TypedBinding
    A.TBind Range
    r Maybe Expr
    tac List1 (NamedArg (Binder' BindName))
    xs' Expr
    t'
      toAbstract (C.TLet Range
    r List1 Declaration
    ds) = Range -> [LetBinding] -> Maybe TypedBinding
    A.mkTLet Range
    r ([LetBinding] -> Maybe TypedBinding)
    -> TCMT IO [LetBinding] -> TCMT IO (Maybe TypedBinding)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> LetDefs -> ScopeM (AbsOfCon LetDefs)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (List1 Declaration -> LetDefs
    LetDefs List1 Declaration
    ds)

    -- | Scope check a module (top level function).
    --
    scopeCheckNiceModule
      :: Range
      -> Access
      -> C.Name
      -> C.Telescope
      -> ScopeM [A.Declaration]
      -> ScopeM A.Declaration
           -- ^ The returned declaration is an 'A.Section'.
    scopeCheckNiceModule :: Range
    -> Access
    -> Name
    -> Telescope
    -> ScopeM [Declaration]
    -> TCMT IO Declaration
    scopeCheckNiceModule Range
    r Access
    p Name
    name Telescope
    tel ScopeM [Declaration]
    checkDs
      | Telescope -> Bool
    telHasOpenStmsOrModuleMacros Telescope
    tel = do
          -- Andreas, 2013-12-10:
          -- If the module telescope contains open statements
          -- or module macros (Issue 1299),
          -- add an extra anonymous module around the current one.
          -- Otherwise, the open statements would create
          -- identifiers in the parent scope of the current module.
          -- But open statements in the module telescope should
          -- only affect the current module!
          Range
    -> Access
    -> Name
    -> Telescope
    -> ScopeM [Declaration]
    -> TCMT IO Declaration
    scopeCheckNiceModule Range
    forall a. Range' a
    noRange Access
    p Name
    noName_ [] (ScopeM [Declaration] -> TCMT IO Declaration)
    -> ScopeM [Declaration] -> TCMT IO Declaration
    forall a b. (a -> b) -> a -> b
    $ Declaration -> [Declaration]
    forall el coll. Singleton el coll => el -> coll
    singleton (Declaration -> [Declaration])
    -> TCMT IO Declaration -> ScopeM [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            Access -> TCMT IO Declaration
    scopeCheckNiceModule_ Access
    PublicAccess  -- See #4350

      | Bool
    otherwise = do
            Access -> TCMT IO Declaration
    scopeCheckNiceModule_ Access
    p
      where
        -- The actual workhorse:
        scopeCheckNiceModule_ :: Access -> ScopeM A.Declaration
        scopeCheckNiceModule_ :: Access -> TCMT IO Declaration
    scopeCheckNiceModule_ Access
    p = do

          -- Check whether we are dealing with an anonymous module.
          -- This corresponds to a Coq/LEGO section.
          (Name
    name, Access
    p', Bool
    open) <- do
            if Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    name then do
              (NameId
    i :: NameId) <- TCMT IO NameId
    forall i (m :: * -> *). MonadFresh i m => m i
    fresh
              (Name, Access, Bool) -> TCMT IO (Name, Access, Bool)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Range -> NameId -> Name
    C.NoName (Name -> Range
    forall a. HasRange a => a -> Range
    getRange Name
    name) NameId
    i, Origin -> Access
    PrivateAccess Origin
    Inserted, Bool
    True)
             else (Name, Access, Bool) -> TCMT IO (Name, Access, Bool)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    name, Access
    p, Bool
    False)

          -- Check and bind the module, using the supplied check for its contents.
          ModuleName
    aname <- NewModuleName -> ScopeM (AbsOfCon NewModuleName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Name -> NewModuleName
    NewModuleName Name
    name)
          Declaration
    d <- (ScopeInfo, Declaration) -> Declaration
    forall a b. (a, b) -> b
    snd ((ScopeInfo, Declaration) -> Declaration)
    -> TCMT IO (ScopeInfo, Declaration) -> TCMT IO Declaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
            Range
    -> QName
    -> ModuleName
    -> Telescope
    -> ScopeM [Declaration]
    -> TCMT IO (ScopeInfo, Declaration)
    scopeCheckModule Range
    r (Name -> QName
    C.QName Name
    name) ModuleName
    aname Telescope
    tel ScopeM [Declaration]
    checkDs
          Access -> Name -> ModuleName -> TCMT IO ()
    bindModule Access
    p' Name
    name ModuleName
    aname

          -- If the module was anonymous open it public
          -- unless it's private, in which case we just open it (#2099)
          Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    open (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
           TCMT IO ImportDirective -> TCMT IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (TCMT IO ImportDirective -> TCMT IO ())
    -> TCMT IO ImportDirective -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ -- We can discard the returned default A.ImportDirective.
            OpenKind
    -> Maybe ModuleName
    -> QName
    -> ImportDirective
    -> TCMT IO ImportDirective
    openModule OpenKind
    TopOpenModule (ModuleName -> Maybe ModuleName
    forall a. a -> Maybe a
    Just ModuleName
    aname) (Name -> QName
    C.QName Name
    name) (ImportDirective -> TCMT IO ImportDirective)
    -> ImportDirective -> TCMT IO ImportDirective
    forall a b. (a -> b) -> a -> b
    $
              ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir { publicOpen :: Maybe Range
    publicOpen = Bool -> Range -> Maybe Range
    forall a. Bool -> a -> Maybe a
    boolToMaybe (Access
    p Access -> Access -> Bool
    forall a. Eq a => a -> a -> Bool
    == Access
    PublicAccess) Range
    forall a. Range' a
    noRange }
          Declaration -> TCMT IO Declaration
    forall (m :: * -> *) a. Monad m => a -> m a
    return Declaration
    d

    -- | Check whether a telescope has open declarations or module macros.
    telHasOpenStmsOrModuleMacros :: C.Telescope -> Bool
    telHasOpenStmsOrModuleMacros :: Telescope -> Bool
    telHasOpenStmsOrModuleMacros = (TypedBinding -> Bool) -> Telescope -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TypedBinding -> Bool
    forall {e}. TypedBinding' e -> Bool
    yesBind
      where
        yesBind :: TypedBinding' e -> Bool
    yesBind C.TBind{}     = Bool
    False
        yesBind (C.TLet Range
    _ List1 Declaration
    ds) = (Declaration -> Bool) -> List1 Declaration -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Declaration -> Bool
    yes List1 Declaration
    ds
        yes :: Declaration -> Bool
    yes C.ModuleMacro{}   = Bool
    True
        yes C.Open{}          = Bool
    True
        yes C.Import{}        = Bool
    True -- not __IMPOSSIBLE__, see Issue #1718
          -- However, it does not matter what we return here, as this will
          -- become an error later: "Not a valid let-declaration".
          -- (Andreas, 2015-11-17)
        yes (C.Mutual   Range
    _ [Declaration]
    ds) = (Declaration -> Bool) -> [Declaration] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Declaration -> Bool
    yes [Declaration]
    ds
        yes (C.Abstract Range
    _ [Declaration]
    ds) = (Declaration -> Bool) -> [Declaration] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Declaration -> Bool
    yes [Declaration]
    ds
        yes (C.Private Range
    _ Origin
    _ [Declaration]
    ds) = (Declaration -> Bool) -> [Declaration] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Declaration -> Bool
    yes [Declaration]
    ds
        yes Declaration
    _                 = Bool
    False

    {- UNUSED
    telHasLetStms :: C.Telescope -> Bool
    telHasLetStms = any isLetBind
      where
        isLetBind C.TBind{} = False
        isLetBind C.TLet{}  = True
    -}

    -- | We for now disallow let-bindings in @data@ and @record@ telescopes.
    --   This due "nested datatypes"; there is no easy interpretation of
    --   @
    --      data D (A : Set) (open M A) (b : B) : Set where
    --        c : D (A × A) b → D A b
    --   @
    --   where @B@ is brought in scope by @open M A@.

    class EnsureNoLetStms a where
      ensureNoLetStms :: a -> ScopeM ()

      default ensureNoLetStms :: (Foldable t, EnsureNoLetStms b, t b ~ a) => a -> ScopeM ()
      ensureNoLetStms = (b -> TCMT IO ()) -> t b -> TCMT IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ b -> TCMT IO ()
    forall a. EnsureNoLetStms a => a -> TCMT IO ()
    ensureNoLetStms

    instance EnsureNoLetStms C.Binder where
      ensureNoLetStms :: Binder -> TCMT IO ()
    ensureNoLetStms arg :: Binder
    arg@(C.Binder Maybe Pattern
    p BoundName
    n) =
        Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe Pattern -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Pattern
    p) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Binder -> TypeError
    IllegalPatternInTelescope Binder
    arg

    instance EnsureNoLetStms C.TypedBinding where
      ensureNoLetStms :: TypedBinding -> TCMT IO ()
    ensureNoLetStms = \case
        tb :: TypedBinding
    tb@C.TLet{}    -> TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TypedBinding -> TypeError
    IllegalLetInTelescope TypedBinding
    tb
        C.TBind Range
    _ List1 (NamedArg Binder)
    xs Expr
    _ -> (NamedArg Binder -> TCMT IO ())
    -> List1 (NamedArg Binder) -> TCMT IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (Binder -> TCMT IO ()
    forall a. EnsureNoLetStms a => a -> TCMT IO ()
    ensureNoLetStms (Binder -> TCMT IO ())
    -> (NamedArg Binder -> Binder) -> NamedArg Binder -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedArg Binder -> Binder
    forall a. NamedArg a -> a
    namedArg) List1 (NamedArg Binder)
    xs

    instance EnsureNoLetStms a => EnsureNoLetStms (LamBinding' a) where
      ensureNoLetStms :: LamBinding' a -> TCMT IO ()
    ensureNoLetStms = \case
        -- GA: DO NOT use traverse here: `LamBinding'` only uses its parameter in
        --     the DomainFull constructor so we would miss out on some potentially
        --     illegal lets! Cf. #4402
        C.DomainFree NamedArg Binder
    a -> NamedArg Binder -> TCMT IO ()
    forall a. EnsureNoLetStms a => a -> TCMT IO ()
    ensureNoLetStms NamedArg Binder
    a
        C.DomainFull a
    a -> a -> TCMT IO ()
    forall a. EnsureNoLetStms a => a -> TCMT IO ()
    ensureNoLetStms a
    a

    instance EnsureNoLetStms a => EnsureNoLetStms (Named_ a) where
    instance EnsureNoLetStms a => EnsureNoLetStms (NamedArg a) where
    instance EnsureNoLetStms a => EnsureNoLetStms [a] where

    -- | Returns the scope inside the checked module.
    scopeCheckModule
      :: Range                   -- ^ The range of the module.
      -> C.QName                 -- ^ The concrete name of the module.
      -> A.ModuleName            -- ^ The abstract name of the module.
      -> C.Telescope             -- ^ The module telescope.
      -> ScopeM [A.Declaration]  -- ^ The code for checking the module contents.
      -> ScopeM (ScopeInfo, A.Declaration)
           -- ^ The returned declaration is an 'A.Section'.
    scopeCheckModule :: Range
    -> QName
    -> ModuleName
    -> Telescope
    -> ScopeM [Declaration]
    -> TCMT IO (ScopeInfo, Declaration)
    scopeCheckModule Range
    r QName
    x ModuleName
    qm Telescope
    tel ScopeM [Declaration]
    checkDs = do
      [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "module" Int
    20 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "checking module " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
      -- Andreas, 2013-12-10: Telescope does not live in the new module
      -- but its parent, so check it before entering the new module.
      -- This is important for Nicolas Pouillard's open parametrized modules
      -- statements inside telescopes.
      (ScopeInfo, Declaration)
    res <- TCMT IO (ScopeInfo, Declaration)
    -> TCMT IO (ScopeInfo, Declaration)
    forall a. ScopeM a -> ScopeM a
    withLocalVars (TCMT IO (ScopeInfo, Declaration)
     -> TCMT IO (ScopeInfo, Declaration))
    -> TCMT IO (ScopeInfo, Declaration)
    -> TCMT IO (ScopeInfo, Declaration)
    forall a b. (a -> b) -> a -> b
    $ do
        GeneralizeTelescope
    tel <- GenTel -> ScopeM (AbsOfCon GenTel)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Telescope -> GenTel
    GenTel Telescope
    tel)
        ModuleName
    -> TCMT IO (ScopeInfo, Declaration)
    -> TCMT IO (ScopeInfo, Declaration)
    forall (m :: * -> *) a.
    (ReadTCState m, MonadTCState m) =>
    ModuleName -> m a -> m a
    withCurrentModule ModuleName
    qm (TCMT IO (ScopeInfo, Declaration)
     -> TCMT IO (ScopeInfo, Declaration))
    -> TCMT IO (ScopeInfo, Declaration)
    -> TCMT IO (ScopeInfo, Declaration)
    forall a b. (a -> b) -> a -> b
    $ do
          -- pushScope m
          -- qm <- getCurrentModule
          [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "module" Int
    20 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "inside module " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
          [Declaration]
    ds    <- ScopeM [Declaration]
    checkDs
          ScopeInfo
    scope <- TCMT IO ScopeInfo
    forall (m :: * -> *). ReadTCState m => m ScopeInfo
    getScope
          (ScopeInfo, Declaration) -> TCMT IO (ScopeInfo, Declaration)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ScopeInfo
    scope, Range
    -> ModuleName
    -> GeneralizeTelescope
    -> [Declaration]
    -> Declaration
    A.Section Range
    r (ModuleName
    qm ModuleName -> QName -> ModuleName
    `withRangesOfQ` QName
    x) GeneralizeTelescope
    tel [Declaration]
    ds)

      -- Binding is done by the caller
      [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "module" Int
    20 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "after module " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
      (ScopeInfo, Declaration) -> TCMT IO (ScopeInfo, Declaration)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ScopeInfo, Declaration)
    res

    -- | Temporary data type to scope check a file.
    data TopLevel a = TopLevel
      { forall a. TopLevel a -> AbsolutePath
    topLevelPath           :: AbsolutePath
        -- ^ The file path from which we loaded this module.
      , forall a. TopLevel a -> TopLevelModuleName
    topLevelExpectedName   :: C.TopLevelModuleName
        -- ^ The expected module name
        --   (coming from the import statement that triggered scope checking this file).
      , forall a. TopLevel a -> a
    topLevelTheThing       :: a
        -- ^ The file content.
      }

    data TopLevelInfo = TopLevelInfo
            { TopLevelInfo -> [Declaration]
    topLevelDecls :: [A.Declaration]
            , TopLevelInfo -> ScopeInfo
    topLevelScope :: ScopeInfo  -- ^ as seen from inside the module
            }

    -- | The top-level module name.

    topLevelModuleName :: TopLevelInfo -> A.ModuleName
    topLevelModuleName :: TopLevelInfo -> ModuleName
    topLevelModuleName = (ScopeInfo -> Lens' ModuleName ScopeInfo -> ModuleName
    forall o i. o -> Lens' i o -> i
    ^. Lens' ModuleName ScopeInfo
    scopeCurrent) (ScopeInfo -> ModuleName)
    -> (TopLevelInfo -> ScopeInfo) -> TopLevelInfo -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TopLevelInfo -> ScopeInfo
    topLevelScope

    -- | Top-level declarations are always
    --   @
    --     (import|open)*         -- a bunch of possibly opened imports
    --     module ThisModule ...  -- the top-level module of this file
    --   @
    instance ToAbstract (TopLevel [C.Declaration]) where
        type AbsOfCon (TopLevel [C.Declaration]) = TopLevelInfo

        toAbstract :: TopLevel [Declaration]
    -> ScopeM (AbsOfCon (TopLevel [Declaration]))
    toAbstract (TopLevel AbsolutePath
    file TopLevelModuleName
    expectedMName [Declaration]
    ds) =
          -- A file is a bunch of preliminary decls (imports etc.)
          -- plus a single module decl.
          case [Declaration] -> ([Declaration], [Declaration])
    C.spanAllowedBeforeModule [Declaration]
    ds of

            -- If there are declarations after the top-level module
            -- we have to report a parse error here.
            ([Declaration]
    _, C.Module{} : Declaration
    d : [Declaration]
    _) -> Call -> TCMT IO TopLevelInfo -> TCMT IO TopLevelInfo
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Range -> Call
    SetRange (Range -> Call) -> Range -> Call
    forall a b. (a -> b) -> a -> b
    $ Declaration -> Range
    forall a. HasRange a => a -> Range
    getRange Declaration
    d) (TCMT IO TopLevelInfo -> TCMT IO TopLevelInfo)
    -> TCMT IO TopLevelInfo -> TCMT IO TopLevelInfo
    forall a b. (a -> b) -> a -> b
    $
              [Char] -> TCMT IO TopLevelInfo
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO TopLevelInfo) -> [Char] -> TCMT IO TopLevelInfo
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "No declarations allowed after top-level module."

            -- Otherwise, proceed.
            ([Declaration]
    outsideDecls, [ C.Module Range
    r QName
    m0 Telescope
    tel [Declaration]
    insideDecls ]) -> do
              -- If the module name is _ compute the name from the file path
              QName
    m <- if QName -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName QName
    m0
                    then do
                      -- Andreas, 2017-07-28, issue #1077
                      -- Check if the insideDecls end in a single module which has the same
                      -- name as the file.  In this case, it is highly likely that the user
                      -- put some non-allowed declarations before the top-level module in error.
                      -- Andreas, 2017-10-19, issue #2808
                      -- Widen this check to:
                      -- If the first module of the insideDecls has the same name as the file,
                      -- report an error.
                      case ((Declaration -> Bool)
     -> [Declaration] -> ([Declaration], [Declaration]))
    -> [Declaration]
    -> (Declaration -> Bool)
    -> ([Declaration], [Declaration])
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Declaration -> Bool)
    -> [Declaration] -> ([Declaration], [Declaration])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span [Declaration]
    insideDecls ((Declaration -> Bool) -> ([Declaration], [Declaration]))
    -> (Declaration -> Bool) -> ([Declaration], [Declaration])
    forall a b. (a -> b) -> a -> b
    $ \case { C.Module{} -> Bool
    False; Declaration
    _ -> Bool
    True } of
                        ([Declaration]
    ds0, (C.Module Range
    _ QName
    m1 Telescope
    _ [Declaration]
    _ : [Declaration]
    _))
                           | QName -> TopLevelModuleName
    C.toTopLevelModuleName QName
    m1 TopLevelModuleName -> TopLevelModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == TopLevelModuleName
    expectedMName
                             -- If the anonymous module comes from the user,
                             -- the range cannot be the beginningOfFile.
                             -- That is the range if the parser inserted the anon. module.
                           , Range
    r Range -> Range -> Bool
    forall a. Eq a => a -> a -> Bool
    == Range -> Range
    beginningOfFile ([Declaration] -> Range
    forall a. HasRange a => a -> Range
    getRange [Declaration]
    insideDecls) -> do

                             -- GA #4888: We know we are in a bad place. But we still scopecheck
                             -- the initial segment on the off chance we generate a better error
                             -- message.
                             ScopeM [Declaration] -> TCMT IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ScopeM [Declaration]
    importPrimitives
                             ScopeM [Declaration] -> TCMT IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ScopeM [Declaration] -> TCMT IO ())
    -> ScopeM [Declaration] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Declarations -> ScopeM (AbsOfCon Declarations)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([Declaration] -> Declarations
    Declarations [Declaration]
    outsideDecls)
                             ScopeM [Declaration] -> TCMT IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ScopeM [Declaration] -> TCMT IO ())
    -> ScopeM [Declaration] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Declarations -> ScopeM (AbsOfCon Declarations)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([Declaration] -> Declarations
    Declarations [Declaration]
    ds0)
                             -- Fail with a crude error otherwise
                             Call -> TCMT IO QName -> TCMT IO QName
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Range -> Call
    SetRange (Range -> Call) -> Range -> Call
    forall a b. (a -> b) -> a -> b
    $ [Declaration] -> Range
    forall a. HasRange a => a -> Range
    getRange [Declaration]
    ds0) (TCMT IO QName -> TCMT IO QName) -> TCMT IO QName -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError
                               [Char]
    "Illegal declaration(s) before top-level module"

                        -- Otherwise, reconstruct the top-level module name
                        ([Declaration], [Declaration])
    _ -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> TCMT IO QName) -> QName -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ Name -> QName
    C.QName (Name -> QName) -> Name -> QName
    forall a b. (a -> b) -> a -> b
    $ Range -> Name -> Name
    forall a. SetRange a => Range -> a -> a
    setRange (QName -> Range
    forall a. HasRange a => a -> Range
    getRange QName
    m0) (Name -> Name) -> Name -> Name
    forall a b. (a -> b) -> a -> b
    $
                               [Char] -> Name
    C.simpleName ([Char] -> Name) -> [Char] -> Name
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    stringToRawName ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ AbsolutePath -> [Char]
    rootNameModule AbsolutePath
    file
                    -- Andreas, 2017-05-17, issue #2574, keep name as jump target!
                    -- Andreas, 2016-07-12, ALTERNATIVE:
                    -- -- We assign an anonymous file module the name expected from
                    -- -- its import.  For flat file structures, this is the same.
                    -- -- For hierarchical file structures, this reverses the behavior:
                    -- -- Loading the file by itself will fail, but it can be imported.
                    -- -- The previous behavior is: it can be loaded by itself, but not
                    -- -- be imported
                    -- then return $ C.fromTopLevelModuleName expectedMName
                    else do
                    -- Andreas, 2014-03-28  Issue 1078
                    -- We need to check the module name against the file name here.
                    -- Otherwise one could sneak in a lie and confuse the scope
                    -- checker.
                      TopLevelModuleName
    -> SourceFile -> Maybe TopLevelModuleName -> TCMT IO ()
    checkModuleName (QName -> TopLevelModuleName
    C.toTopLevelModuleName QName
    m0) (AbsolutePath -> SourceFile
    SourceFile AbsolutePath
    file) (Maybe TopLevelModuleName -> TCMT IO ())
    -> Maybe TopLevelModuleName -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TopLevelModuleName -> Maybe TopLevelModuleName
    forall a. a -> Maybe a
    Just TopLevelModuleName
    expectedMName
                      QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    m0
              QName -> TCMT IO ()
    setTopLevelModule QName
    m
              ModuleName
    am <- NewModuleQName -> ScopeM (AbsOfCon NewModuleQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> NewModuleQName
    NewModuleQName QName
    m)
              [Declaration]
    primitiveImport <- ScopeM [Declaration]
    importPrimitives
              -- Scope check the declarations outside
              [Declaration]
    outsideDecls <- Declarations -> ScopeM (AbsOfCon Declarations)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([Declaration] -> Declarations
    Declarations [Declaration]
    outsideDecls)
              (ScopeInfo
    insideScope, Declaration
    insideDecl) <- Range
    -> QName
    -> ModuleName
    -> Telescope
    -> ScopeM [Declaration]
    -> TCMT IO (ScopeInfo, Declaration)
    scopeCheckModule Range
    r QName
    m ModuleName
    am Telescope
    tel (ScopeM [Declaration] -> TCMT IO (ScopeInfo, Declaration))
    -> ScopeM [Declaration] -> TCMT IO (ScopeInfo, Declaration)
    forall a b. (a -> b) -> a -> b
    $
                 Declarations -> ScopeM (AbsOfCon Declarations)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([Declaration] -> Declarations
    Declarations [Declaration]
    insideDecls)
              -- Andreas, 2020-05-13, issue #1804, #4647
              -- Do not eagerly remove private definitions, only when serializing
              -- let scope = over scopeModules (fmap $ restrictLocalPrivate am) insideScope
              let scope :: ScopeInfo
    scope = ScopeInfo
    insideScope
              ScopeInfo -> TCMT IO ()
    setScope ScopeInfo
    scope
              TopLevelInfo -> TCMT IO TopLevelInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TopLevelInfo -> TCMT IO TopLevelInfo)
    -> TopLevelInfo -> TCMT IO TopLevelInfo
    forall a b. (a -> b) -> a -> b
    $ [Declaration] -> ScopeInfo -> TopLevelInfo
    TopLevelInfo ([Declaration]
    primitiveImport [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    outsideDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [ Declaration
    insideDecl ]) ScopeInfo
    scope

            -- We already inserted the missing top-level module, see
            -- 'Agda.Syntax.Parser.Parser.figureOutTopLevelModule',
            -- thus, this case is impossible:
            ([Declaration], [Declaration])
    _ -> ScopeM (AbsOfCon (TopLevel [Declaration]))
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | Declaration @open import Agda.Primitive using (Set; Prop)@ when 'optImportSorts'.
    importPrimitives :: ScopeM [A.Declaration]
    importPrimitives :: ScopeM [Declaration]
    importPrimitives = do
        Bool
    noImportSorts <- Bool -> Bool
    not (Bool -> Bool) -> (PragmaOptions -> Bool) -> PragmaOptions -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PragmaOptions -> Bool
    optImportSorts (PragmaOptions -> Bool) -> TCMT IO PragmaOptions -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
        -- Add implicit `open import Agda.Primitive using (Set; Prop)`
        let agdaPrimitiveName :: QName
    agdaPrimitiveName   = Name -> QName -> QName
    Qual ([Char] -> Name
    C.simpleName [Char]
    "Agda") (QName -> QName) -> QName -> QName
    forall a b. (a -> b) -> a -> b
    $ Name -> QName
    C.QName (Name -> QName) -> Name -> QName
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Name
    C.simpleName [Char]
    "Primitive"
            agdaSetName :: Name
    agdaSetName         = [Char] -> Name
    C.simpleName [Char]
    "Set"
            agdaPropName :: Name
    agdaPropName        = [Char] -> Name
    C.simpleName [Char]
    "Prop"
            usingDirective :: Using' Name m
    usingDirective      = [ImportedName' Name m] -> Using' Name m
    forall n m. [ImportedName' n m] -> Using' n m
    Using [Name -> ImportedName' Name m
    forall n m. n -> ImportedName' n m
    ImportedName Name
    agdaSetName, Name -> ImportedName' Name m
    forall n m. n -> ImportedName' n m
    ImportedName Name
    agdaPropName]
            directives :: ImportDirective' Name m
    directives          = Range
    -> Using' Name m
    -> HidingDirective' Name m
    -> RenamingDirective' Name m
    -> Maybe Range
    -> ImportDirective' Name m
    forall n m.
    Range
    -> Using' n m
    -> HidingDirective' n m
    -> RenamingDirective' n m
    -> Maybe Range
    -> ImportDirective' n m
    ImportDirective Range
    forall a. Range' a
    noRange Using' Name m
    forall {m}. Using' Name m
    usingDirective [] [] Maybe Range
    forall a. Maybe a
    Nothing
            importAgdaPrimitive :: [Declaration]
    importAgdaPrimitive = [Range
    -> QName
    -> Maybe AsName
    -> OpenShortHand
    -> ImportDirective
    -> Declaration
    C.Import Range
    forall a. Range' a
    noRange QName
    agdaPrimitiveName Maybe AsName
    forall a. Maybe a
    Nothing OpenShortHand
    C.DoOpen ImportDirective
    forall {m}. ImportDirective' Name m
    directives]
        if Bool
    noImportSorts
          then [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
          else Declarations -> ScopeM (AbsOfCon Declarations)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([Declaration] -> Declarations
    Declarations [Declaration]
    importAgdaPrimitive)

    -- | runs Syntax.Concrete.Definitions.niceDeclarations on main module
    niceDecls :: DoWarn -> [C.Declaration] -> ([NiceDeclaration] -> ScopeM a) -> ScopeM a
    niceDecls :: forall a.
    DoWarn
    -> [Declaration] -> ([NiceDeclaration] -> ScopeM a) -> ScopeM a
    niceDecls DoWarn
    warn [Declaration]
    ds [NiceDeclaration] -> ScopeM a
    ret = [Declaration] -> ScopeM a -> ScopeM a
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange [Declaration]
    ds (ScopeM a -> ScopeM a) -> ScopeM a -> ScopeM a
    forall a b. (a -> b) -> a -> b
    $ DoWarn -> [Declaration] -> ScopeM a -> ScopeM a
    forall a. DoWarn -> [Declaration] -> ScopeM a -> ScopeM a
    computeFixitiesAndPolarities DoWarn
    warn [Declaration]
    ds (ScopeM a -> ScopeM a) -> ScopeM a -> ScopeM a
    forall a b. (a -> b) -> a -> b
    $ do
      Fixities
    fixs <- Lens' Fixities ScopeInfo -> TCMT IO Fixities
    forall (m :: * -> *) a. ReadTCState m => Lens' a ScopeInfo -> m a
    useScope Lens' Fixities ScopeInfo
    scopeFixities  -- We need to pass the fixities to the nicifier for clause grouping
      let (Either DeclarationException [NiceDeclaration]
    result, NiceWarnings
    warns') = Nice [NiceDeclaration]
    -> (Either DeclarationException [NiceDeclaration], NiceWarnings)
    forall a. Nice a -> (Either DeclarationException a, NiceWarnings)
    runNice (Nice [NiceDeclaration]
     -> (Either DeclarationException [NiceDeclaration], NiceWarnings))
    -> Nice [NiceDeclaration]
    -> (Either DeclarationException [NiceDeclaration], NiceWarnings)
    forall a b. (a -> b) -> a -> b
    $ Fixities -> [Declaration] -> Nice [NiceDeclaration]
    niceDeclarations Fixities
    fixs [Declaration]
    ds

      -- COMPILED pragmas are not allowed in safe mode unless we are in a builtin module.
      -- So we start by filtering out all the PragmaCompiled warnings if one of these two
      -- conditions is not met.
      Bool
    isSafe    <- PragmaOptions -> Bool
    forall a. LensSafeMode a => a -> Bool
    Lens.getSafeMode (PragmaOptions -> Bool) -> TCMT IO PragmaOptions -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions
      Bool
    isBuiltin <- [Char] -> TCMT IO Bool
    forall (m :: * -> *). MonadIO m => [Char] -> m Bool
    Lens.isBuiltinModule ([Char] -> TCMT IO Bool)
    -> (AbsolutePath -> [Char]) -> AbsolutePath -> TCMT IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AbsolutePath -> [Char]
    filePath (AbsolutePath -> TCMT IO Bool)
    -> TCMT IO AbsolutePath -> TCMT IO Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TCMT IO AbsolutePath
    forall (m :: * -> *). MonadTCEnv m => m AbsolutePath
    getCurrentPath
      let warns :: NiceWarnings
    warns = if Bool
    isSafe Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    isBuiltin then NiceWarnings
    warns' else (DeclarationWarning -> Bool) -> NiceWarnings -> NiceWarnings
    forall a. (a -> Bool) -> [a] -> [a]
    filter DeclarationWarning -> Bool
    notOnlyInSafeMode NiceWarnings
    warns'

      -- Respect the @DoWarn@ directive. For this to be sound, we need to know for
      -- sure that each @Declaration@ is checked at least once with @DoWarn@.
      Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (DoWarn
    warn DoWarn -> DoWarn -> Bool
    forall a. Eq a => a -> a -> Bool
    == DoWarn
    NoWarn Bool -> Bool -> Bool
    || NiceWarnings -> Bool
    forall a. Null a => a -> Bool
    null NiceWarnings
    warns) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        -- If there are some warnings and the --safe flag is set,
        -- we check that none of the NiceWarnings are fatal
        Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isSafe (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
          let (NiceWarnings
    errs, NiceWarnings
    ws) = (DeclarationWarning -> Bool)
    -> NiceWarnings -> (NiceWarnings, NiceWarnings)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    List.partition DeclarationWarning -> Bool
    unsafeDeclarationWarning NiceWarnings
    warns
          -- If some of them are, we fail
          Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (NiceWarnings -> Bool
    forall a. Null a => a -> Bool
    null NiceWarnings
    errs) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            [Warning] -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    [Warning] -> m ()
    warnings ([Warning] -> TCMT IO ()) -> [Warning] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ DeclarationWarning -> Warning
    NicifierIssue (DeclarationWarning -> Warning) -> NiceWarnings -> [Warning]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NiceWarnings
    ws
            [TCWarning]
    tcerrs <- (Warning -> TCMT IO TCWarning) -> [Warning] -> TCMT IO [TCWarning]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Warning -> TCMT IO TCWarning
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m TCWarning
    warning_ ([Warning] -> TCMT IO [TCWarning])
    -> [Warning] -> TCMT IO [TCWarning]
    forall a b. (a -> b) -> a -> b
    $ DeclarationWarning -> Warning
    NicifierIssue (DeclarationWarning -> Warning) -> NiceWarnings -> [Warning]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NiceWarnings
    errs
            NiceWarnings -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange NiceWarnings
    errs (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCWarning] -> TypeError
    NonFatalErrors [TCWarning]
    tcerrs
        -- Otherwise we simply record the warnings
        (DeclarationWarning -> TCMT IO ()) -> NiceWarnings -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\ DeclarationWarning
    w -> CallStack -> Warning -> TCMT IO ()
    forall (m :: * -> *).
    MonadWarning m =>
    CallStack -> Warning -> m ()
    warning' (DeclarationWarning -> CallStack
    dwLocation DeclarationWarning
    w) (Warning -> TCMT IO ()) -> Warning -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ DeclarationWarning -> Warning
    NicifierIssue DeclarationWarning
    w) NiceWarnings
    warns
      case Either DeclarationException [NiceDeclaration]
    result of
        Left (DeclarationException CallStack
    loc DeclarationException'
    e) -> do
          [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "error" Int
    2 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Error raised at " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ CallStack -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow CallStack
    loc
          TCErr -> ScopeM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (TCErr -> ScopeM a) -> TCErr -> ScopeM a
    forall a b. (a -> b) -> a -> b
    $ Range -> Doc -> TCErr
    Exception (DeclarationException' -> Range
    forall a. HasRange a => a -> Range
    getRange DeclarationException'
    e) (Doc -> TCErr) -> Doc -> TCErr
    forall a b. (a -> b) -> a -> b
    $ DeclarationException' -> Doc
    forall a. Pretty a => a -> Doc
    pretty DeclarationException'
    e
        Right [NiceDeclaration]
    ds -> [NiceDeclaration] -> ScopeM a
    ret [NiceDeclaration]
    ds

      where notOnlyInSafeMode :: DeclarationWarning -> Bool
    notOnlyInSafeMode = (WarningName
    PragmaCompiled_ WarningName -> WarningName -> Bool
    forall a. Eq a => a -> a -> Bool
    /=) (WarningName -> Bool)
    -> (DeclarationWarning -> WarningName)
    -> DeclarationWarning
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DeclarationWarning -> WarningName
    declarationWarningName

    -- | Wrapper to avoid instance conflict with generic list instance.
    newtype Declarations = Declarations [C.Declaration]

    instance ToAbstract Declarations where
      type AbsOfCon Declarations = [A.Declaration]

      toAbstract :: Declarations -> ScopeM (AbsOfCon Declarations)
    toAbstract (Declarations [Declaration]
    ds) = do
        -- When --safe is active the termination checker (Issue 586),
        -- positivity checker (Issue 1614) and the coverage checker
        -- may not be switched off, and polarities may not be assigned.
        [Declaration]
    ds <- TCMT IO Bool
    -> TCMT IO [Declaration]
    -> TCMT IO [Declaration]
    -> TCMT IO [Declaration]
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (PragmaOptions -> Bool
    forall a. LensSafeMode a => a -> Bool
    Lens.getSafeMode (PragmaOptions -> Bool) -> TCMT IO PragmaOptions -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions)
                   {- then -} ((Declaration -> TCMT IO Declaration)
    -> [Declaration] -> TCMT IO [Declaration]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Declaration -> TCMT IO Declaration
    noUnsafePragma [Declaration]
    ds)
                   {- else -} ([Declaration] -> TCMT IO [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Declaration]
    ds)

        DoWarn
    -> [Declaration]
    -> ([NiceDeclaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration]
    forall a.
    DoWarn
    -> [Declaration] -> ([NiceDeclaration] -> ScopeM a) -> ScopeM a
    niceDecls DoWarn
    DoWarn [Declaration]
    ds [NiceDeclaration] -> ScopeM [Declaration]
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract
       where

         -- We need to dig deep into a declaration, otherwise it is possible
         -- to hide an illegal pragma in a block. Cf. Issue #3983
         noUnsafePragma :: C.Declaration -> TCM C.Declaration
         noUnsafePragma :: Declaration -> TCMT IO Declaration
    noUnsafePragma = \case
           C.Pragma Pragma
    pr                 -> Pragma -> TCMT IO Declaration
    warnUnsafePragma Pragma
    pr
           C.RecordDef Range
    r Name
    n RecordDirectives
    dir [LamBinding' TypedBinding]
    lams [Declaration]
    ds -> Range
    -> Name
    -> RecordDirectives
    -> [LamBinding' TypedBinding]
    -> [Declaration]
    -> Declaration
    C.RecordDef Range
    r Name
    n RecordDirectives
    dir [LamBinding' TypedBinding]
    lams ([Declaration] -> Declaration)
    -> TCMT IO [Declaration] -> TCMT IO Declaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Declaration -> TCMT IO Declaration)
    -> [Declaration] -> TCMT IO [Declaration]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Declaration -> TCMT IO Declaration
    noUnsafePragma [Declaration]
    ds
           C.Record Range
    r Name
    n RecordDirectives
    dir [LamBinding' TypedBinding]
    lams Expr
    e [Declaration]
    ds  -> Range
    -> Name
    -> RecordDirectives
    -> [LamBinding' TypedBinding]
    -> Expr
    -> [Declaration]
    -> Declaration
    C.Record Range
    r Name
    n RecordDirectives
    dir [LamBinding' TypedBinding]
    lams Expr
    e ([Declaration] -> Declaration)
    -> TCMT IO [Declaration] -> TCMT IO Declaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Declaration -> TCMT IO Declaration)
    -> [Declaration] -> TCMT IO [Declaration]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Declaration -> TCMT IO Declaration
    noUnsafePragma [Declaration]
    ds
           C.Mutual Range
    r [Declaration]
    ds               -> Range -> [Declaration] -> Declaration
    C.Mutual Range
    r ([Declaration] -> Declaration)
    -> TCMT IO [Declaration] -> TCMT IO Declaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Declaration -> TCMT IO Declaration)
    -> [Declaration] -> TCMT IO [Declaration]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Declaration -> TCMT IO Declaration
    noUnsafePragma [Declaration]
    ds
           C.Abstract Range
    r [Declaration]
    ds             -> Range -> [Declaration] -> Declaration
    C.Abstract Range
    r ([Declaration] -> Declaration)
    -> TCMT IO [Declaration] -> TCMT IO Declaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Declaration -> TCMT IO Declaration)
    -> [Declaration] -> TCMT IO [Declaration]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Declaration -> TCMT IO Declaration
    noUnsafePragma [Declaration]
    ds
           C.Private Range
    r Origin
    o [Declaration]
    ds            -> Range -> Origin -> [Declaration] -> Declaration
    C.Private Range
    r Origin
    o ([Declaration] -> Declaration)
    -> TCMT IO [Declaration] -> TCMT IO Declaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Declaration -> TCMT IO Declaration)
    -> [Declaration] -> TCMT IO [Declaration]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Declaration -> TCMT IO Declaration
    noUnsafePragma [Declaration]
    ds
           C.InstanceB Range
    r [Declaration]
    ds            -> Range -> [Declaration] -> Declaration
    C.InstanceB Range
    r ([Declaration] -> Declaration)
    -> TCMT IO [Declaration] -> TCMT IO Declaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Declaration -> TCMT IO Declaration)
    -> [Declaration] -> TCMT IO [Declaration]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Declaration -> TCMT IO Declaration
    noUnsafePragma [Declaration]
    ds
           C.Macro Range
    r [Declaration]
    ds                -> Range -> [Declaration] -> Declaration
    C.Macro Range
    r ([Declaration] -> Declaration)
    -> TCMT IO [Declaration] -> TCMT IO Declaration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Declaration -> TCMT IO Declaration)
    -> [Declaration] -> TCMT IO [Declaration]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Declaration -> TCMT IO Declaration
    noUnsafePragma [Declaration]
    ds
           Declaration
    d -> Declaration -> TCMT IO Declaration
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Declaration
    d

         warnUnsafePragma :: C.Pragma -> TCM C.Declaration
         warnUnsafePragma :: Pragma -> TCMT IO Declaration
    warnUnsafePragma Pragma
    pr = Pragma -> Declaration
    C.Pragma Pragma
    pr Declaration -> TCMT IO () -> TCMT IO Declaration
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ do
           TCMT IO Bool -> TCMT IO () -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM ([Char] -> TCMT IO Bool
    forall (m :: * -> *). MonadIO m => [Char] -> m Bool
    Lens.isBuiltinModuleWithSafePostulates ([Char] -> TCMT IO Bool)
    -> (AbsolutePath -> [Char]) -> AbsolutePath -> TCMT IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AbsolutePath -> [Char]
    filePath (AbsolutePath -> TCMT IO Bool)
    -> TCMT IO AbsolutePath -> TCMT IO Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TCMT IO AbsolutePath
    forall (m :: * -> *). MonadTCEnv m => m AbsolutePath
    getCurrentPath)
             {- then -} (() -> TCMT IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
             {- else -} (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ case Pragma -> Maybe Warning
    unsafePragma Pragma
    pr of
             Maybe Warning
    Nothing -> () -> TCMT IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
             Just Warning
    w  -> Pragma -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Pragma
    pr (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning Warning
    w

         unsafePragma :: C.Pragma -> Maybe Warning
         unsafePragma :: Pragma -> Maybe Warning
    unsafePragma = \case
           C.NoCoverageCheckPragma{}    -> Warning -> Maybe Warning
    forall a. a -> Maybe a
    Just Warning
    SafeFlagNoCoverageCheck
           C.NoPositivityCheckPragma{}  -> Warning -> Maybe Warning
    forall a. a -> Maybe a
    Just Warning
    SafeFlagNoPositivityCheck
           C.PolarityPragma{}           -> Warning -> Maybe Warning
    forall a. a -> Maybe a
    Just Warning
    SafeFlagPolarity
           C.NoUniverseCheckPragma{}    -> Warning -> Maybe Warning
    forall a. a -> Maybe a
    Just Warning
    SafeFlagNoUniverseCheck
           C.InjectivePragma{}          -> Warning -> Maybe Warning
    forall a. a -> Maybe a
    Just Warning
    SafeFlagInjective
           C.TerminationCheckPragma Range
    _ TerminationCheck
    m -> case TerminationCheck
    m of
             TerminationCheck
    NonTerminating       -> Warning -> Maybe Warning
    forall a. a -> Maybe a
    Just Warning
    SafeFlagNonTerminating
             TerminationCheck
    Terminating          -> Warning -> Maybe Warning
    forall a. a -> Maybe a
    Just Warning
    SafeFlagTerminating
             TerminationCheck
    TerminationCheck     -> Maybe Warning
    forall a. Maybe a
    Nothing
             TerminationMeasure{} -> Maybe Warning
    forall a. Maybe a
    Nothing
             -- ASR (31 December 2015). We don't pattern-match on
             -- @NoTerminationCheck@ because the @NO_TERMINATION_CHECK@ pragma
             -- was removed. See Issue #1763.
             TerminationCheck
    NoTerminationCheck -> Maybe Warning
    forall a. Maybe a
    Nothing
           -- exhaustive match to get told by ghc we should have a look at this
           -- when we add new pragmas.
           C.OptionsPragma{}    -> Maybe Warning
    forall a. Maybe a
    Nothing
           C.BuiltinPragma{}    -> Maybe Warning
    forall a. Maybe a
    Nothing
           C.ForeignPragma{}    -> Maybe Warning
    forall a. Maybe a
    Nothing
           C.StaticPragma{}     -> Maybe Warning
    forall a. Maybe a
    Nothing
           C.InlinePragma{}     -> Maybe Warning
    forall a. Maybe a
    Nothing
           C.ImpossiblePragma{} -> Maybe Warning
    forall a. Maybe a
    Nothing
           C.EtaPragma{}        -> Warning -> Maybe Warning
    forall a. a -> Maybe a
    Just Warning
    SafeFlagEta
           C.WarningOnUsage{}   -> Maybe Warning
    forall a. Maybe a
    Nothing
           C.WarningOnImport{}  -> Maybe Warning
    forall a. Maybe a
    Nothing
           C.DisplayPragma{}    -> Maybe Warning
    forall a. Maybe a
    Nothing
           C.CatchallPragma{}   -> Maybe Warning
    forall a. Maybe a
    Nothing
           -- @RewritePragma@ already requires --rewriting which is incompatible with --safe
           C.RewritePragma{}    -> Maybe Warning
    forall a. Maybe a
    Nothing
           -- @CompilePragma@ already handled in the nicifier
           C.CompilePragma{}    -> Maybe Warning
    forall a. Maybe a
    Nothing

    newtype LetDefs = LetDefs (List1 C.Declaration)
    newtype LetDef = LetDef NiceDeclaration

    instance ToAbstract LetDefs where
      type AbsOfCon LetDefs = [A.LetBinding]

      toAbstract :: LetDefs -> ScopeM (AbsOfCon LetDefs)
    toAbstract (LetDefs List1 Declaration
    ds) =
        [List1 LetBinding] -> [LetBinding]
    forall a. [List1 a] -> [a]
    List1.concat ([List1 LetBinding] -> [LetBinding])
    -> TCMT IO [List1 LetBinding] -> TCMT IO [LetBinding]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DoWarn
    -> [Declaration]
    -> ([NiceDeclaration] -> TCMT IO [List1 LetBinding])
    -> TCMT IO [List1 LetBinding]
    forall a.
    DoWarn
    -> [Declaration] -> ([NiceDeclaration] -> ScopeM a) -> ScopeM a
    niceDecls DoWarn
    DoWarn (List1 Declaration -> [Declaration]
    forall a. NonEmpty a -> [a]
    List1.toList List1 Declaration
    ds) ([LetDef] -> TCMT IO [List1 LetBinding]
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([LetDef] -> TCMT IO [List1 LetBinding])
    -> ([NiceDeclaration] -> [LetDef])
    -> [NiceDeclaration]
    -> TCMT IO [List1 LetBinding]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NiceDeclaration -> LetDef) -> [NiceDeclaration] -> [LetDef]
    forall a b. (a -> b) -> [a] -> [b]
    map NiceDeclaration -> LetDef
    LetDef)

    instance ToAbstract LetDef where
      type AbsOfCon LetDef = List1 A.LetBinding
      toAbstract :: LetDef -> ScopeM (AbsOfCon LetDef)
    toAbstract (LetDef NiceDeclaration
    d) =
        case NiceDeclaration
    d of
          NiceMutual Range
    _ TerminationCheck
    _ CoverageCheck
    _ PositivityCheck
    _ d :: [NiceDeclaration]
    d@[C.FunSig Range
    _ Access
    _ IsAbstract
    _ IsInstance
    instanc IsMacro
    macro ArgInfo
    info TerminationCheck
    _ CoverageCheck
    _ Name
    x Expr
    t, C.FunDef Range
    _ [Declaration]
    _ IsAbstract
    abstract IsInstance
    _ TerminationCheck
    _ CoverageCheck
    _ Name
    _ [Clause
    cl]] ->
              do  Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (IsAbstract
    abstract IsAbstract -> IsAbstract -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsAbstract
    AbstractDef) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    [Char] -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "`abstract` not allowed in let expressions"
                  Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (IsMacro
    macro IsMacro -> IsMacro -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsMacro
    MacroDef) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    [Char] -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Macros cannot be defined in a let expression"
                  Expr
    t <- Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    t
                  -- We bind the name here to make sure it's in scope for the LHS (#917).
                  -- It's unbound for the RHS in letToAbstract.
                  Fixity'
    fx <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
                  Name
    x  <- BindName -> Name
    A.unBind (BindName -> Name) -> TCMT IO BindName -> ScopeM Name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NewName BoundName -> ScopeM (AbsOfCon (NewName BoundName))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (BindingSource -> BoundName -> NewName BoundName
    forall a. BindingSource -> a -> NewName a
    NewName BindingSource
    LetBound (BoundName -> NewName BoundName) -> BoundName -> NewName BoundName
    forall a b. (a -> b) -> a -> b
    $ Name -> Fixity' -> BoundName
    mkBoundName Name
    x Fixity'
    fx)
                  (QName
    x', Expr
    e) <- Clause -> TCMT IO (QName, Expr)
    letToAbstract Clause
    cl
                  -- If InstanceDef set info to Instance
                  let info' :: ArgInfo
    info' = case IsInstance
    instanc of
                        InstanceDef Range
    _  -> ArgInfo -> ArgInfo
    forall a. LensHiding a => a -> a
    makeInstance ArgInfo
    info
                        IsInstance
    NotInstanceDef -> ArgInfo
    info
                  -- There are sometimes two instances of the
                  -- let-bound variable, one declaration and one
                  -- definition. The first list element below is
                  -- used to highlight the declared instance in the
                  -- right way (see Issue 1618).
                  List1 LetBinding -> TCMT IO (List1 LetBinding)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (List1 LetBinding -> TCMT IO (List1 LetBinding))
    -> List1 LetBinding -> TCMT IO (List1 LetBinding)
    forall a b. (a -> b) -> a -> b
    $ BindName -> LetBinding
    A.LetDeclaredVariable (Name -> BindName
    A.mkBindName (Range -> Name -> Name
    forall a. SetRange a => Range -> a -> a
    setRange (QName -> Range
    forall a. HasRange a => a -> Range
    getRange QName
    x') Name
    x)) LetBinding -> [LetBinding] -> List1 LetBinding
    forall a. a -> [a] -> NonEmpty a
    :|
                         [ LetInfo -> ArgInfo -> BindName -> Expr -> Expr -> LetBinding
    A.LetBind (Range -> LetInfo
    LetRange (Range -> LetInfo) -> Range -> LetInfo
    forall a b. (a -> b) -> a -> b
    $ [NiceDeclaration] -> Range
    forall a. HasRange a => a -> Range
    getRange [NiceDeclaration]
    d) ArgInfo
    info' (Name -> BindName
    A.mkBindName Name
    x) Expr
    t Expr
    e
                         ]

          -- irrefutable let binding, like  (x , y) = rhs
          NiceFunClause Range
    r Access
    PublicAccess IsAbstract
    ConcreteDef TerminationCheck
    tc CoverageCheck
    cc Bool
    catchall d :: Declaration
    d@(C.FunClause lhs :: LHS
    lhs@(C.LHS Pattern
    p0 [] []) RHS' Expr
    rhs0 WhereClause' [Declaration]
    wh Bool
    ca) -> do
            WhereClause' [Declaration] -> TCMT IO ()
    noWhereInLetBinding WhereClause' [Declaration]
    wh
            Expr
    rhs <- RHS' Expr -> TCMT IO Expr
    letBindingMustHaveRHS RHS' Expr
    rhs0
            Either TCErr Pattern
    mp  <- Pattern
    -> TCMT IO (Either TCErr Pattern) -> TCMT IO (Either TCErr Pattern)
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Pattern
    p0 (TCMT IO (Either TCErr Pattern) -> TCMT IO (Either TCErr Pattern))
    -> TCMT IO (Either TCErr Pattern) -> TCMT IO (Either TCErr Pattern)
    forall a b. (a -> b) -> a -> b
    $
                     (Pattern -> Either TCErr Pattern
    forall a b. b -> Either a b
    Right (Pattern -> Either TCErr Pattern)
    -> TCMT IO Pattern -> TCMT IO (Either TCErr Pattern)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pattern -> TCMT IO Pattern
    parsePattern Pattern
    p0)
                       TCMT IO (Either TCErr Pattern)
    -> (TCErr -> TCMT IO (Either TCErr Pattern))
    -> TCMT IO (Either TCErr Pattern)
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError`
                     (Either TCErr Pattern -> TCMT IO (Either TCErr Pattern)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either TCErr Pattern -> TCMT IO (Either TCErr Pattern))
    -> (TCErr -> Either TCErr Pattern)
    -> TCErr
    -> TCMT IO (Either TCErr Pattern)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TCErr -> Either TCErr Pattern
    forall a b. a -> Either a b
    Left)
            case Either TCErr Pattern
    mp of
              Right Pattern
    p -> do
                Expr
    rhs <- Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    rhs
                Pattern -> TCMT IO (List1 LetBinding) -> TCMT IO (List1 LetBinding)
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Pattern
    p0 (TCMT IO (List1 LetBinding) -> TCMT IO (List1 LetBinding))
    -> TCMT IO (List1 LetBinding) -> TCMT IO (List1 LetBinding)
    forall a b. (a -> b) -> a -> b
    $ do
                  Pattern' Expr
    p   <- Pattern -> ScopeM (AbsOfCon Pattern)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Pattern
    p
                  Pattern' Expr -> TCMT IO ()
    forall e. Pattern' e -> TCMT IO ()
    checkValidLetPattern Pattern' Expr
    p
                  Pattern' Expr -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) p.
    (Monad m, APatternLike p) =>
    p -> ([Name] -> m ()) -> m ()
    checkPatternLinearity Pattern' Expr
    p (([Name] -> TCMT IO ()) -> TCMT IO ())
    -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \[Name]
    ys ->
                    TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Name] -> TypeError
    RepeatedVariablesInPattern [Name]
    ys
                  TCMT IO ()
    bindVarsToBind
                  Pattern
    p   <- Pattern' Expr -> ScopeM (AbsOfCon (Pattern' Expr))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Pattern' Expr
    p
                  List1 LetBinding -> TCMT IO (List1 LetBinding)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (List1 LetBinding -> TCMT IO (List1 LetBinding))
    -> List1 LetBinding -> TCMT IO (List1 LetBinding)
    forall a b. (a -> b) -> a -> b
    $ LetBinding -> List1 LetBinding
    forall el coll. Singleton el coll => el -> coll
    singleton (LetBinding -> List1 LetBinding) -> LetBinding -> List1 LetBinding
    forall a b. (a -> b) -> a -> b
    $ LetInfo -> Pattern -> Expr -> LetBinding
    A.LetPatBind (Range -> LetInfo
    LetRange Range
    r) Pattern
    p Expr
    rhs
              -- It's not a record pattern, so it should be a prefix left-hand side
              Left TCErr
    err ->
                case Pattern -> Maybe Name
    definedName Pattern
    p0 of
                  Maybe Name
    Nothing -> TCErr -> TCMT IO (List1 LetBinding)
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError TCErr
    err
                  Just Name
    x  -> LetDef -> ScopeM (AbsOfCon LetDef)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (LetDef -> ScopeM (AbsOfCon LetDef))
    -> LetDef -> ScopeM (AbsOfCon LetDef)
    forall a b. (a -> b) -> a -> b
    $ NiceDeclaration -> LetDef
    LetDef (NiceDeclaration -> LetDef) -> NiceDeclaration -> LetDef
    forall a b. (a -> b) -> a -> b
    $ Range
    -> TerminationCheck
    -> CoverageCheck
    -> PositivityCheck
    -> [NiceDeclaration]
    -> NiceDeclaration
    NiceMutual Range
    r TerminationCheck
    tc CoverageCheck
    cc PositivityCheck
    YesPositivityCheck
                    [ Range
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> ArgInfo
    -> TerminationCheck
    -> CoverageCheck
    -> Name
    -> Expr
    -> NiceDeclaration
    C.FunSig Range
    r Access
    PublicAccess IsAbstract
    ConcreteDef IsInstance
    NotInstanceDef IsMacro
    NotMacroDef (Origin -> ArgInfo -> ArgInfo
    forall a. LensOrigin a => Origin -> a -> a
    setOrigin Origin
    Inserted ArgInfo
    defaultArgInfo) TerminationCheck
    tc CoverageCheck
    cc Name
    x (Range -> Maybe [Char] -> Expr
    C.Underscore (Name -> Range
    forall a. HasRange a => a -> Range
    getRange Name
    x) Maybe [Char]
    forall a. Maybe a
    Nothing)
                    , Range
    -> [Declaration]
    -> IsAbstract
    -> IsInstance
    -> TerminationCheck
    -> CoverageCheck
    -> Name
    -> [Clause]
    -> NiceDeclaration
    C.FunDef Range
    r [Declaration]
    forall a. HasCallStack => a
    __IMPOSSIBLE__ IsAbstract
    ConcreteDef IsInstance
    NotInstanceDef TerminationCheck
    forall a. HasCallStack => a
    __IMPOSSIBLE__ CoverageCheck
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Name
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                      [Name
    -> Bool
    -> LHS
    -> RHS' Expr
    -> WhereClause' [Declaration]
    -> [Clause]
    -> Clause
    C.Clause Name
    x (Bool
    ca Bool -> Bool -> Bool
    || Bool
    catchall) LHS
    lhs (Expr -> RHS' Expr
    forall e. e -> RHS' e
    C.RHS Expr
    rhs) WhereClause' [Declaration]
    forall decls. WhereClause' decls
    NoWhere []]
                    ]
                where
                  definedName :: Pattern -> Maybe Name
    definedName (C.IdentP (C.QName Name
    x)) = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    x
                  definedName C.IdentP{}             = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName (C.RawAppP Range
    _ (List2 Pattern
    p Pattern
    _ [Pattern]
    _)) = Pattern -> Maybe Name
    definedName Pattern
    p
                  definedName (C.ParenP Range
    _ Pattern
    p)         = Pattern -> Maybe Name
    definedName Pattern
    p
                  definedName C.WildP{}              = Maybe Name
    forall a. Maybe a
    Nothing   -- for instance let _ + x = x in ... (not allowed)
                  definedName C.AbsurdP{}            = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName C.AsP{}                = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName C.DotP{}               = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName C.EqualP{}             = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName C.LitP{}               = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName C.RecP{}               = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName C.QuoteP{}             = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName C.HiddenP{}            = Maybe Name
    forall a. Maybe a
    Nothing -- Not impossible, see issue #2291
                  definedName C.InstanceP{}          = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName C.WithP{}              = Maybe Name
    forall a. Maybe a
    Nothing
                  definedName C.AppP{}               = Maybe Name
    forall a. Maybe a
    Nothing -- Not impossible, see issue #4586
                  definedName C.OpAppP{}             = Maybe Name
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                  definedName C.EllipsisP{}          = Maybe Name
    forall a. Maybe a
    Nothing -- Not impossible, see issue #3937

          -- You can't open public in a let
          NiceOpen Range
    r QName
    x ImportDirective
    dirs -> do
            Maybe Range -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust (ImportDirective -> Maybe Range
    forall n m. ImportDirective' n m -> Maybe Range
    publicOpen ImportDirective
    dirs) ((Range -> TCMT IO ()) -> TCMT IO ())
    -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \Range
    r -> Range -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Range
    r (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning Warning
    UselessPublic
            ModuleName
    m    <- OldModuleName -> ScopeM (AbsOfCon OldModuleName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> OldModuleName
    OldModuleName QName
    x)
            ImportDirective
    adir <- OpenKind -> QName -> ImportDirective -> TCMT IO ImportDirective
    openModule_ OpenKind
    LetOpenModule QName
    x ImportDirective
    dirs
            let minfo :: ModuleInfo
    minfo = ModuleInfo :: Range
    -> Range
    -> Maybe Name
    -> Maybe OpenShortHand
    -> Maybe ImportDirective
    -> ModuleInfo
    ModuleInfo
                  { minfoRange :: Range
    minfoRange  = Range
    r
                  , minfoAsName :: Maybe Name
    minfoAsName = Maybe Name
    forall a. Maybe a
    Nothing
                  , minfoAsTo :: Range
    minfoAsTo   = ImportDirective -> Range
    renamingRange ImportDirective
    dirs
                  , minfoOpenShort :: Maybe OpenShortHand
    minfoOpenShort = Maybe OpenShortHand
    forall a. Maybe a
    Nothing
                  , minfoDirective :: Maybe ImportDirective
    minfoDirective = ImportDirective -> Maybe ImportDirective
    forall a. a -> Maybe a
    Just ImportDirective
    dirs
                  }
            List1 LetBinding -> TCMT IO (List1 LetBinding)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (List1 LetBinding -> TCMT IO (List1 LetBinding))
    -> List1 LetBinding -> TCMT IO (List1 LetBinding)
    forall a b. (a -> b) -> a -> b
    $ LetBinding -> List1 LetBinding
    forall el coll. Singleton el coll => el -> coll
    singleton (LetBinding -> List1 LetBinding) -> LetBinding -> List1 LetBinding
    forall a b. (a -> b) -> a -> b
    $ ModuleInfo -> ModuleName -> ImportDirective -> LetBinding
    A.LetOpen ModuleInfo
    minfo ModuleName
    m ImportDirective
    adir

          NiceModuleMacro Range
    r Access
    p Name
    x ModuleApplication
    modapp OpenShortHand
    open ImportDirective
    dir -> do
            Maybe Range -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust (ImportDirective -> Maybe Range
    forall n m. ImportDirective' n m -> Maybe Range
    publicOpen ImportDirective
    dir) ((Range -> TCMT IO ()) -> TCMT IO ())
    -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ Range
    r -> Range -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Range
    r (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning Warning
    UselessPublic
            -- Andreas, 2014-10-09, Issue 1299: module macros in lets need
            -- to be private
            LetBinding -> List1 LetBinding
    forall el coll. Singleton el coll => el -> coll
    singleton (LetBinding -> List1 LetBinding)
    -> ScopeM LetBinding -> TCMT IO (List1 LetBinding)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ModuleInfo
     -> ModuleName
     -> ModuleApplication
     -> ScopeCopyInfo
     -> ImportDirective
     -> LetBinding)
    -> OpenKind
    -> Range
    -> Access
    -> Name
    -> ModuleApplication
    -> OpenShortHand
    -> ImportDirective
    -> ScopeM LetBinding
    forall a.
    (ToConcrete a, Pretty (ConOfAbs a)) =>
    (ModuleInfo
     -> ModuleName
     -> ModuleApplication
     -> ScopeCopyInfo
     -> ImportDirective
     -> a)
    -> OpenKind
    -> Range
    -> Access
    -> Name
    -> ModuleApplication
    -> OpenShortHand
    -> ImportDirective
    -> ScopeM a
    checkModuleMacro ModuleInfo
    -> ModuleName
    -> ModuleApplication
    -> ScopeCopyInfo
    -> ImportDirective
    -> LetBinding
    LetApply OpenKind
    LetOpenModule Range
    r (Origin -> Access
    PrivateAccess Origin
    Inserted) Name
    x ModuleApplication
    modapp OpenShortHand
    open ImportDirective
    dir

          NiceDeclaration
    _   -> NiceDeclaration -> TCMT IO (List1 LetBinding)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    NiceDeclaration -> m a
    notAValidLetBinding NiceDeclaration
    d
        where
            letToAbstract :: Clause -> TCMT IO (QName, Expr)
    letToAbstract (C.Clause Name
    top Bool
    _catchall (C.LHS Pattern
    p [] []) RHS' Expr
    rhs0 WhereClause' [Declaration]
    wh []) = do
                WhereClause' [Declaration] -> TCMT IO ()
    noWhereInLetBinding WhereClause' [Declaration]
    wh
                Expr
    rhs <- RHS' Expr -> TCMT IO Expr
    letBindingMustHaveRHS RHS' Expr
    rhs0
                (QName
    x, [NamedArg Pattern]
    args) <- do
                  LHSCore
    res <- Pattern -> TCMT IO LHSCore -> TCMT IO LHSCore
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Pattern
    p (TCMT IO LHSCore -> TCMT IO LHSCore)
    -> TCMT IO LHSCore -> TCMT IO LHSCore
    forall a b. (a -> b) -> a -> b
    $ QName -> Pattern -> TCMT IO LHSCore
    parseLHS (Name -> QName
    C.QName Name
    top) Pattern
    p
                  case LHSCore
    res of
                    C.LHSHead QName
    x [NamedArg Pattern]
    args -> (QName, [NamedArg Pattern]) -> TCMT IO (QName, [NamedArg Pattern])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName
    x, [NamedArg Pattern]
    args)
                    C.LHSProj{} -> [Char] -> TCMT IO (QName, [NamedArg Pattern])
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO (QName, [NamedArg Pattern]))
    -> [Char] -> TCMT IO (QName, [NamedArg Pattern])
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Copatterns not allowed in let bindings"
                    C.LHSWith{} -> [Char] -> TCMT IO (QName, [NamedArg Pattern])
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO (QName, [NamedArg Pattern]))
    -> [Char] -> TCMT IO (QName, [NamedArg Pattern])
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "`with` patterns not allowed in let bindings"
                    C.LHSEllipsis{} -> [Char] -> TCMT IO (QName, [NamedArg Pattern])
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "`...` not allowed in let bindings"

                Expr
    e <- [NamedArg Pattern]
    -> (AbsOfCon [NamedArg Pattern] -> ScopeM Expr) -> ScopeM Expr
    forall c b.
    ToAbstract c =>
    c -> (AbsOfCon c -> ScopeM b) -> ScopeM b
    localToAbstract [NamedArg Pattern]
    args ((AbsOfCon [NamedArg Pattern] -> ScopeM Expr) -> ScopeM Expr)
    -> (AbsOfCon [NamedArg Pattern] -> ScopeM Expr) -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ \AbsOfCon [NamedArg Pattern]
    args -> do
                    TCMT IO ()
    bindVarsToBind
                    -- Make sure to unbind the function name in the RHS, since lets are non-recursive.
                    Expr
    rhs <- Name -> ScopeM Expr -> ScopeM Expr
    forall a. Name -> ScopeM a -> ScopeM a
    unbindVariable Name
    top (ScopeM Expr -> ScopeM Expr) -> ScopeM Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    rhs
                    (Expr -> Arg (Named NamedName (Pattern' Expr)) -> ScopeM Expr)
    -> Expr -> [Arg (Named NamedName (Pattern' Expr))] -> ScopeM Expr
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Expr -> Arg (Named NamedName (Pattern' Expr)) -> ScopeM Expr
    lambda Expr
    rhs ([Arg (Named NamedName (Pattern' Expr))]
    -> [Arg (Named NamedName (Pattern' Expr))]
    forall a. [a] -> [a]
    reverse [Arg (Named NamedName (Pattern' Expr))]
    AbsOfCon [NamedArg Pattern]
    args)  -- just reverse because these are DomainFree
                (QName, Expr) -> TCMT IO (QName, Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName
    x, Expr
    e)
            letToAbstract Clause
    _ = NiceDeclaration -> TCMT IO (QName, Expr)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    NiceDeclaration -> m a
    notAValidLetBinding NiceDeclaration
    d

            -- Named patterns not allowed in let definitions
            lambda :: Expr -> Arg (Named NamedName (Pattern' Expr)) -> ScopeM Expr
    lambda Expr
    e (Arg ArgInfo
    info (Named Maybe NamedName
    Nothing (A.VarP BindName
    x))) =
                    Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> LamBinding -> Expr -> Expr
    A.Lam ExprInfo
    i (NamedArg (Binder' BindName) -> LamBinding
    A.mkDomainFree (NamedArg (Binder' BindName) -> LamBinding)
    -> NamedArg (Binder' BindName) -> LamBinding
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Binder' BindName -> NamedArg (Binder' BindName)
    forall a. ArgInfo -> a -> NamedArg a
    unnamedArg ArgInfo
    info (Binder' BindName -> NamedArg (Binder' BindName))
    -> Binder' BindName -> NamedArg (Binder' BindName)
    forall a b. (a -> b) -> a -> b
    $ BindName -> Binder' BindName
    forall a. a -> Binder' a
    A.mkBinder BindName
    x) Expr
    e
                where i :: ExprInfo
    i = Range -> ExprInfo
    ExprRange (BindName -> Expr -> Range
    forall u t. (HasRange u, HasRange t) => u -> t -> Range
    fuseRange BindName
    x Expr
    e)
            lambda Expr
    e (Arg ArgInfo
    info (Named Maybe NamedName
    Nothing (A.WildP PatInfo
    i))) =
                do  Name
    x <- Range -> ScopeM Name
    forall (m :: * -> *). MonadFresh NameId m => Range -> m Name
    freshNoName (PatInfo -> Range
    forall a. HasRange a => a -> Range
    getRange PatInfo
    i)
                    Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ ExprInfo -> LamBinding -> Expr -> Expr
    A.Lam ExprInfo
    i' (NamedArg (Binder' BindName) -> LamBinding
    A.mkDomainFree (NamedArg (Binder' BindName) -> LamBinding)
    -> NamedArg (Binder' BindName) -> LamBinding
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Binder' BindName -> NamedArg (Binder' BindName)
    forall a. ArgInfo -> a -> NamedArg a
    unnamedArg ArgInfo
    info (Binder' BindName -> NamedArg (Binder' BindName))
    -> Binder' BindName -> NamedArg (Binder' BindName)
    forall a b. (a -> b) -> a -> b
    $ Name -> Binder' BindName
    A.mkBinder_ Name
    x) Expr
    e
                where i' :: ExprInfo
    i' = Range -> ExprInfo
    ExprRange (PatInfo -> Expr -> Range
    forall u t. (HasRange u, HasRange t) => u -> t -> Range
    fuseRange PatInfo
    i Expr
    e)
            lambda Expr
    _ Arg (Named NamedName (Pattern' Expr))
    _ = NiceDeclaration -> ScopeM Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    NiceDeclaration -> m a
    notAValidLetBinding NiceDeclaration
    d

            noWhereInLetBinding :: C.WhereClause -> ScopeM ()
            noWhereInLetBinding :: WhereClause' [Declaration] -> TCMT IO ()
    noWhereInLetBinding = \case
              WhereClause' [Declaration]
    NoWhere -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              WhereClause' [Declaration]
    wh -> WhereClause' [Declaration] -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange WhereClause' [Declaration]
    wh (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "`where` clauses not allowed in let bindings"
            letBindingMustHaveRHS :: C.RHS -> ScopeM C.Expr
            letBindingMustHaveRHS :: RHS' Expr -> TCMT IO Expr
    letBindingMustHaveRHS = \case
              C.RHS Expr
    e -> Expr -> TCMT IO Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return Expr
    e
              RHS' Expr
    C.AbsurdRHS -> [Char] -> TCMT IO Expr
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO Expr) -> [Char] -> TCMT IO Expr
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Missing right hand side in let binding"

            -- Only record patterns allowed, but we do not exclude data constructors here.
            -- They will fail in the type checker.
            checkValidLetPattern :: A.Pattern' e -> ScopeM ()
            checkValidLetPattern :: forall e. Pattern' e -> TCMT IO ()
    checkValidLetPattern = \case
                A.VarP{}             -> TCMT IO ()
    yes
                A.ConP ConPatInfo
    _ AmbiguousQName
    _ NAPs e
    ps        -> (NamedArg (Pattern' e) -> TCMT IO ()) -> NAPs e -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Pattern' e -> TCMT IO ()
    forall e. Pattern' e -> TCMT IO ()
    checkValidLetPattern (Pattern' e -> TCMT IO ())
    -> (NamedArg (Pattern' e) -> Pattern' e)
    -> NamedArg (Pattern' e)
    -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedArg (Pattern' e) -> Pattern' e
    forall a. NamedArg a -> a
    namedArg) NAPs e
    ps
                A.ProjP{}            -> TCMT IO ()
    forall {a}. TCMT IO a
    no
                A.DefP{}             -> TCMT IO ()
    forall {a}. TCMT IO a
    no
                A.WildP{}            -> TCMT IO ()
    yes
                A.AsP PatInfo
    _ BindName
    _ Pattern' e
    p          -> Pattern' e -> TCMT IO ()
    forall e. Pattern' e -> TCMT IO ()
    checkValidLetPattern Pattern' e
    p
                A.DotP{}             -> TCMT IO ()
    forall {a}. TCMT IO a
    no
                A.AbsurdP{}          -> TCMT IO ()
    forall {a}. TCMT IO a
    no
                A.LitP{}             -> TCMT IO ()
    forall {a}. TCMT IO a
    no
                A.PatternSynP PatInfo
    _ AmbiguousQName
    _ NAPs e
    ps -> (NamedArg (Pattern' e) -> TCMT IO ()) -> NAPs e -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Pattern' e -> TCMT IO ()
    forall e. Pattern' e -> TCMT IO ()
    checkValidLetPattern (Pattern' e -> TCMT IO ())
    -> (NamedArg (Pattern' e) -> Pattern' e)
    -> NamedArg (Pattern' e)
    -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedArg (Pattern' e) -> Pattern' e
    forall a. NamedArg a -> a
    namedArg) NAPs e
    ps
                A.RecP PatInfo
    _ [FieldAssignment' (Pattern' e)]
    fs          -> (FieldAssignment' (Pattern' e) -> TCMT IO ())
    -> [FieldAssignment' (Pattern' e)] -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Pattern' e -> TCMT IO ()
    forall e. Pattern' e -> TCMT IO ()
    checkValidLetPattern (Pattern' e -> TCMT IO ())
    -> (FieldAssignment' (Pattern' e) -> Pattern' e)
    -> FieldAssignment' (Pattern' e)
    -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FieldAssignment' (Pattern' e) -> Pattern' e
    forall a. FieldAssignment' a -> a
    _exprFieldA) [FieldAssignment' (Pattern' e)]
    fs
                A.EqualP{}           -> TCMT IO ()
    forall {a}. TCMT IO a
    no
                A.WithP{}            -> TCMT IO ()
    forall {a}. TCMT IO a
    no
                A.AnnP PatInfo
    _ e
    _ Pattern' e
    p         -> Pattern' e -> TCMT IO ()
    forall e. Pattern' e -> TCMT IO ()
    checkValidLetPattern Pattern' e
    p
              where
              yes :: TCMT IO ()
    yes = () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              no :: TCMT IO a
    no  = [Char] -> TCMT IO a
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Not a valid let pattern"

    instance ToAbstract NiceDeclaration where
      type AbsOfCon NiceDeclaration = A.Declaration

      toAbstract :: NiceDeclaration -> ScopeM (AbsOfCon NiceDeclaration)
    toAbstract NiceDeclaration
    d = ScopeM [Declaration] -> TCMT IO Declaration
    forall (m :: * -> *).
    ReadTCState m =>
    m [Declaration] -> m Declaration
    annotateDecls (ScopeM [Declaration] -> TCMT IO Declaration)
    -> ScopeM [Declaration] -> TCMT IO Declaration
    forall a b. (a -> b) -> a -> b
    $
        [Char]
    -> Int -> [[Char]] -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a (m :: * -> *) c.
    (TraceS a, MonadDebug m) =>
    [Char] -> Int -> a -> m c -> m c
    traceS [Char]
    "scope.decl.trace" Int
    50
          [ [Char]
    "scope checking declaration"
          , [Char]
    "  " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++  NiceDeclaration -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow NiceDeclaration
    d
          ] (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        [Char]
    -> Int -> [[Char]] -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a (m :: * -> *) c.
    (TraceS a, MonadDebug m) =>
    [Char] -> Int -> a -> m c -> m c
    traceS [Char]
    "scope.decl.trace" Int
    80  -- keep this debug message for testing issue #4016
          [ [Char]
    "scope checking declaration (raw)"
          , [Char]
    "  " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++  NiceDeclaration -> [Char]
    forall a. Show a => a -> [Char]
    show NiceDeclaration
    d
          ] (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        Call -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (NiceDeclaration -> Call
    ScopeCheckDeclaration NiceDeclaration
    d) (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        -- Andreas, 2015-10-05, Issue 1677:
        -- We record in the environment whether we are scope checking an
        -- abstract definition.  This way, we can propagate this attribute
        -- the extended lambdas.
        Maybe IsAbstract
    -> (ScopeM [Declaration] -> ScopeM [Declaration])
    -> (IsAbstract -> ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration]
    -> ScopeM [Declaration]
    forall a b. Maybe a -> b -> (a -> b) -> b
    caseMaybe (NiceDeclaration -> Maybe IsAbstract
    niceHasAbstract NiceDeclaration
    d) ScopeM [Declaration] -> ScopeM [Declaration]
    forall a. a -> a
    id (\ IsAbstract
    a -> (TCEnv -> TCEnv) -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a.
    MonadTCEnv m =>
    (TCEnv -> TCEnv) -> m a -> m a
    localTC ((TCEnv -> TCEnv) -> ScopeM [Declaration] -> ScopeM [Declaration])
    -> (TCEnv -> TCEnv) -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ \ TCEnv
    e -> TCEnv
    e { envAbstractMode :: AbstractMode
    envAbstractMode = IsAbstract -> AbstractMode
    aDefToMode IsAbstract
    a }) (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $
        case NiceDeclaration
    d of

      -- Axiom (actual postulate)
        C.Axiom Range
    r Access
    p IsAbstract
    a IsInstance
    i ArgInfo
    rel Name
    x Expr
    t -> do
          -- check that we do not postulate in --safe mode, unless it is a
          -- builtin module with safe postulates
          TCMT IO Bool -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM ((CommandLineOptions -> Bool
    forall a. LensSafeMode a => a -> Bool
    Lens.getSafeMode (CommandLineOptions -> Bool)
    -> TCMT IO CommandLineOptions -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO CommandLineOptions
    forall (m :: * -> *). HasOptions m => m CommandLineOptions
    commandLineOptions) TCMT IO Bool -> TCMT IO Bool -> TCMT IO Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    `and2M`
                 (Bool -> Bool
    not (Bool -> Bool) -> TCMT IO Bool -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([Char] -> TCMT IO Bool
    forall (m :: * -> *). MonadIO m => [Char] -> m Bool
    Lens.isBuiltinModuleWithSafePostulates ([Char] -> TCMT IO Bool)
    -> (AbsolutePath -> [Char]) -> AbsolutePath -> TCMT IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AbsolutePath -> [Char]
    filePath (AbsolutePath -> TCMT IO Bool)
    -> TCMT IO AbsolutePath -> TCMT IO Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TCMT IO AbsolutePath
    forall (m :: * -> *). MonadTCEnv m => m AbsolutePath
    getCurrentPath)))
                (Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning (Warning -> TCMT IO ()) -> Warning -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Name -> Warning
    SafeFlagPostulate Name
    x)
          -- check the postulate
          Declaration -> [Declaration]
    forall el coll. Singleton el coll => el -> coll
    singleton (Declaration -> [Declaration])
    -> TCMT IO Declaration -> ScopeM [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> KindOfName -> NiceDeclaration -> TCMT IO Declaration
    toAbstractNiceAxiom KindOfName
    AxiomName NiceDeclaration
    d

        C.NiceGeneralize Range
    r Access
    p ArgInfo
    i TacticAttribute
    tac Name
    x Expr
    t -> do
          [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.decl" Int
    10 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "found nice generalize: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
          Maybe Expr
    tac <- (Expr -> ScopeM Expr) -> TacticAttribute -> TCMT IO (Maybe Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx) TacticAttribute
    tac
          Expr
    t_ <- Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx Expr
    t
          let (Set QName
    s, Expr
    t) = Expr -> (Set QName, Expr)
    unGeneralized Expr
    t_
          [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.decl" Int
    50 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "generalizations: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ([QName], Expr) -> [Char]
    forall a. Show a => a -> [Char]
    show (Set QName -> [QName]
    forall a. Set a -> [a]
    Set.toList Set QName
    s, Expr
    t)
          Fixity'
    f <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
          QName
    y <- Fixity' -> Name -> TCMT IO QName
    freshAbstractQName Fixity'
    f Name
    x
          Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    p KindOfName
    GeneralizeName Name
    x QName
    y
          let info :: DefInfo
    info = (Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' Any
    forall t.
    Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
    mkDefInfo Name
    x Fixity'
    f Access
    p IsAbstract
    ConcreteDef Range
    r) { defTactic :: Maybe Expr
    defTactic = Maybe Expr
    tac }
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Set QName -> DefInfo -> ArgInfo -> QName -> Expr -> Declaration
    A.Generalize Set QName
    s DefInfo
    info ArgInfo
    i QName
    y Expr
    t]

      -- Fields
        C.NiceField Range
    r Access
    p IsAbstract
    a IsInstance
    i TacticAttribute
    tac Name
    x Arg Expr
    t -> do
          Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Access
    p Access -> Access -> Bool
    forall a. Eq a => a -> a -> Bool
    == Access
    PublicAccess) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Record fields can not be private"
          -- Interaction points for record fields have already been introduced
          -- when checking the type of the record constructor.
          -- To avoid introducing interaction points (IP) twice, we turn
          -- all question marks to underscores.  (See issue 1138.)
          let maskIP :: Expr -> Expr
    maskIP (C.QuestionMark Range
    r Maybe Int
    _) = Range -> Maybe [Char] -> Expr
    C.Underscore Range
    r Maybe [Char]
    forall a. Maybe a
    Nothing
              maskIP Expr
    e                     = Expr
    e
          Maybe Expr
    tac <- (Expr -> ScopeM Expr) -> TacticAttribute -> TCMT IO (Maybe Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx) TacticAttribute
    tac
          Arg Expr
    t' <- Precedence -> Arg Expr -> ScopeM (AbsOfCon (Arg Expr))
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx (Arg Expr -> ScopeM (AbsOfCon (Arg Expr)))
    -> Arg Expr -> ScopeM (AbsOfCon (Arg Expr))
    forall a b. (a -> b) -> a -> b
    $ (Expr -> Expr) -> Arg Expr -> Arg Expr
    forall a. ExprLike a => (Expr -> Expr) -> a -> a
    mapExpr Expr -> Expr
    maskIP Arg Expr
    t
          Fixity'
    f  <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
          QName
    y  <- Fixity' -> Name -> TCMT IO QName
    freshAbstractQName Fixity'
    f Name
    x
          -- Andreas, 2018-06-09 issue #2170
          -- We want dependent irrelevance without irrelevant projections,
          -- thus, do not disable irrelevant projections via the scope checker.
          -- irrProj <- optIrrelevantProjections <$> pragmaOptions
          -- unless (isIrrelevant t && not irrProj) $
          --   -- Andreas, 2010-09-24: irrelevant fields are not in scope
          --   -- this ensures that projections out of irrelevant fields cannot occur
          --   -- Ulf: unless you turn on --irrelevant-projections
          Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    p KindOfName
    FldName Name
    x QName
    y
          let info :: DefInfo
    info = (Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo' Any
    forall t.
    Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo' t
    mkDefInfoInstance Name
    x Fixity'
    f Access
    p IsAbstract
    a IsInstance
    i IsMacro
    NotMacroDef Range
    r) { defTactic :: Maybe Expr
    defTactic = Maybe Expr
    tac }
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ DefInfo -> QName -> Arg Expr -> Declaration
    A.Field DefInfo
    info QName
    y Arg Expr
    t' ]

      -- Primitive function
        PrimitiveFunction Range
    r Access
    p IsAbstract
    a Name
    x Arg Expr
    t -> do
          Arg Expr
    t' <- (Expr -> ScopeM Expr) -> Arg Expr -> TCMT IO (Arg Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx) Arg Expr
    t
          Fixity'
    f  <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
          QName
    y  <- Fixity' -> Name -> TCMT IO QName
    freshAbstractQName Fixity'
    f Name
    x
          Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    p KindOfName
    PrimName Name
    x QName
    y
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ DefInfo -> QName -> Arg Expr -> Declaration
    A.Primitive (Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo
    forall t.
    Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
    mkDefInfo Name
    x Fixity'
    f Access
    p IsAbstract
    a Range
    r) QName
    y Arg Expr
    t' ]

      -- Definitions (possibly mutual)
        NiceMutual Range
    r TerminationCheck
    tc CoverageCheck
    cc PositivityCheck
    pc [NiceDeclaration]
    ds -> do
          [Declaration]
    ds' <- [NiceDeclaration] -> ScopeM (AbsOfCon [NiceDeclaration])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [NiceDeclaration]
    ds
          -- We only termination check blocks that do not have a measure.
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ MutualInfo -> [Declaration] -> Declaration
    A.Mutual (TerminationCheck
    -> CoverageCheck -> PositivityCheck -> Range -> MutualInfo
    MutualInfo TerminationCheck
    tc CoverageCheck
    cc PositivityCheck
    pc Range
    r) [Declaration]
    ds' ]

        C.NiceRecSig Range
    r Access
    p IsAbstract
    a PositivityCheck
    _pc UniverseCheck
    _uc Name
    x [LamBinding' TypedBinding]
    ls Expr
    t -> do
          [LamBinding' TypedBinding] -> TCMT IO ()
    forall a. EnsureNoLetStms a => a -> TCMT IO ()
    ensureNoLetStms [LamBinding' TypedBinding]
    ls
          ScopeM [Declaration] -> ScopeM [Declaration]
    forall a. ScopeM a -> ScopeM a
    withLocalVars (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ do
            (GeneralizeTelescope
    ls', Expr
    _) <- ScopeM (GeneralizeTelescope, Expr)
    -> ScopeM (GeneralizeTelescope, Expr)
    forall a. ScopeM a -> ScopeM a
    withCheckNoShadowing (ScopeM (GeneralizeTelescope, Expr)
     -> ScopeM (GeneralizeTelescope, Expr))
    -> ScopeM (GeneralizeTelescope, Expr)
    -> ScopeM (GeneralizeTelescope, Expr)
    forall a b. (a -> b) -> a -> b
    $
              -- Minor hack: record types don't have indices so we include t when
              -- computing generalised parameters, but in the type checker any named
              -- generalizable arguments in the sort should be bound variables.
              GenTelAndType -> ScopeM (AbsOfCon GenTelAndType)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Telescope -> Expr -> GenTelAndType
    GenTelAndType ((LamBinding' TypedBinding -> TypedBinding)
    -> [LamBinding' TypedBinding] -> Telescope
    forall a b. (a -> b) -> [a] -> [b]
    map LamBinding' TypedBinding -> TypedBinding
    makeDomainFull [LamBinding' TypedBinding]
    ls) Expr
    t)
            Expr
    t' <- Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    t
            Fixity'
    f  <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
            QName
    x' <- Fixity' -> Name -> TCMT IO QName
    freshAbstractQName Fixity'
    f Name
    x
            Access -> KindOfName -> NameMetadata -> Name -> QName -> TCMT IO ()
    bindName' Access
    p KindOfName
    RecName (Map QName Name -> NameMetadata
    GeneralizedVarsMetadata (Map QName Name -> NameMetadata) -> Map QName Name -> NameMetadata
    forall a b. (a -> b) -> a -> b
    $ GeneralizeTelescope -> Map QName Name
    generalizeTelVars GeneralizeTelescope
    ls') Name
    x QName
    x'
            [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ DefInfo -> QName -> GeneralizeTelescope -> Expr -> Declaration
    A.RecSig (Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo
    forall t.
    Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
    mkDefInfo Name
    x Fixity'
    f Access
    p IsAbstract
    a Range
    r) QName
    x' GeneralizeTelescope
    ls' Expr
    t' ]

        C.NiceDataSig Range
    r Access
    p IsAbstract
    a PositivityCheck
    pc UniverseCheck
    uc Name
    x [LamBinding' TypedBinding]
    ls Expr
    t -> do
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.data.sig" Int
    20 ([Char]
    "checking DataSig for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x)
            [LamBinding' TypedBinding] -> TCMT IO ()
    forall a. EnsureNoLetStms a => a -> TCMT IO ()
    ensureNoLetStms [LamBinding' TypedBinding]
    ls
            ScopeM [Declaration] -> ScopeM [Declaration]
    forall a. ScopeM a -> ScopeM a
    withLocalVars (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ do
              GeneralizeTelescope
    ls' <- TCMT IO GeneralizeTelescope -> TCMT IO GeneralizeTelescope
    forall a. ScopeM a -> ScopeM a
    withCheckNoShadowing (TCMT IO GeneralizeTelescope -> TCMT IO GeneralizeTelescope)
    -> TCMT IO GeneralizeTelescope -> TCMT IO GeneralizeTelescope
    forall a b. (a -> b) -> a -> b
    $
                GenTel -> ScopeM (AbsOfCon GenTel)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (GenTel -> ScopeM (AbsOfCon GenTel))
    -> GenTel -> ScopeM (AbsOfCon GenTel)
    forall a b. (a -> b) -> a -> b
    $ Telescope -> GenTel
    GenTel (Telescope -> GenTel) -> Telescope -> GenTel
    forall a b. (a -> b) -> a -> b
    $ (LamBinding' TypedBinding -> TypedBinding)
    -> [LamBinding' TypedBinding] -> Telescope
    forall a b. (a -> b) -> [a] -> [b]
    map LamBinding' TypedBinding -> TypedBinding
    makeDomainFull [LamBinding' TypedBinding]
    ls
              Expr
    t'  <- Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Expr -> ScopeM (AbsOfCon Expr)) -> Expr -> ScopeM (AbsOfCon Expr)
    forall a b. (a -> b) -> a -> b
    $ Expr -> Expr
    C.Generalized Expr
    t
              Fixity'
    f  <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
              QName
    x' <- Fixity' -> Name -> TCMT IO QName
    freshAbstractQName Fixity'
    f Name
    x
              Maybe TypeError
    mErr <- Access
    -> KindOfName
    -> NameMetadata
    -> Name
    -> QName
    -> ScopeM (Maybe TypeError)
    bindName'' Access
    p KindOfName
    DataName (Map QName Name -> NameMetadata
    GeneralizedVarsMetadata (Map QName Name -> NameMetadata) -> Map QName Name -> NameMetadata
    forall a b. (a -> b) -> a -> b
    $ GeneralizeTelescope -> Map QName Name
    generalizeTelVars GeneralizeTelescope
    ls') Name
    x QName
    x'
              Maybe TypeError -> (TypeError -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe TypeError
    mErr ((TypeError -> TCMT IO ()) -> TCMT IO ())
    -> (TypeError -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \case
                err :: TypeError
    err@(ClashingDefinition QName
    cn QName
    an Maybe NiceDeclaration
    _) -> do
                  QName -> ScopeM ResolvedName
    resolveName (Name -> QName
    C.QName Name
    x) ScopeM ResolvedName -> (ResolvedName -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                    -- #4435: if a data type signature causes a ClashingDefinition error, and if
                    -- the data type name is bound to an Axiom, then the error may be caused by
                    -- the illegal type signature. Convert the NiceDataSig into a NiceDataDef
                    -- (which removes the type signature) and suggest it as a possible fix.
                    DefinedName Access
    p AbstractName
    ax Suffix
    NoSuffix | AbstractName -> KindOfName
    anameKind AbstractName
    ax KindOfName -> KindOfName -> Bool
    forall a. Eq a => a -> a -> Bool
    == KindOfName
    AxiomName -> do
                      let suggestion :: NiceDeclaration
    suggestion = Range
    -> Origin
    -> IsAbstract
    -> PositivityCheck
    -> UniverseCheck
    -> Name
    -> [LamBinding' TypedBinding]
    -> [NiceDeclaration]
    -> NiceDeclaration
    NiceDataDef Range
    r Origin
    Inserted IsAbstract
    a PositivityCheck
    pc UniverseCheck
    uc Name
    x [LamBinding' TypedBinding]
    ls []
                      TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ QName -> QName -> Maybe NiceDeclaration -> TypeError
    ClashingDefinition QName
    cn QName
    an (NiceDeclaration -> Maybe NiceDeclaration
    forall a. a -> Maybe a
    Just NiceDeclaration
    suggestion)
                    ResolvedName
    _ -> TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError TypeError
    err
                TypeError
    otherErr -> TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError TypeError
    otherErr
              [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ DefInfo -> QName -> GeneralizeTelescope -> Expr -> Declaration
    A.DataSig (Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo
    forall t.
    Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
    mkDefInfo Name
    x Fixity'
    f Access
    p IsAbstract
    a Range
    r) QName
    x' GeneralizeTelescope
    ls' Expr
    t' ]

      -- Type signatures
        C.FunSig Range
    r Access
    p IsAbstract
    a IsInstance
    i IsMacro
    m ArgInfo
    rel TerminationCheck
    _ CoverageCheck
    _ Name
    x Expr
    t -> do
            let kind :: KindOfName
    kind = if IsMacro
    m IsMacro -> IsMacro -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsMacro
    MacroDef then KindOfName
    MacroName else KindOfName
    FunName
            Declaration -> [Declaration]
    forall el coll. Singleton el coll => el -> coll
    singleton (Declaration -> [Declaration])
    -> TCMT IO Declaration -> ScopeM [Declaration]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> KindOfName -> NiceDeclaration -> TCMT IO Declaration
    toAbstractNiceAxiom KindOfName
    kind (Range
    -> Access
    -> IsAbstract
    -> IsInstance
    -> ArgInfo
    -> Name
    -> Expr
    -> NiceDeclaration
    C.Axiom Range
    r Access
    p IsAbstract
    a IsInstance
    i ArgInfo
    rel Name
    x Expr
    t)

      -- Function definitions
        C.FunDef Range
    r [Declaration]
    ds IsAbstract
    a IsInstance
    i TerminationCheck
    _ CoverageCheck
    _ Name
    x [Clause]
    cs -> do
            Int -> [Char] -> TCMT IO ()
    printLocals Int
    10 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "checking def " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
            (QName
    x',[Clause]
    cs) <- (OldName Name, [Clause])
    -> ScopeM (AbsOfCon (OldName Name, [Clause]))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Name -> OldName Name
    forall a. a -> OldName a
    OldName Name
    x,[Clause]
    cs)
            -- Andreas, 2017-12-04 the name must reside in the current module
            TCMT IO Bool -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM ((QName -> ModuleName
    A.qnameModule QName
    x' ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (ModuleName -> Bool) -> TCMT IO ModuleName -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO ModuleName
    forall (m :: * -> *). ReadTCState m => m ModuleName
    getCurrentModule) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
              TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            let delayed :: Delayed
    delayed = Delayed
    NotDelayed
            -- (delayed, cs) <- translateCopatternClauses cs -- TODO
            Fixity'
    f <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
            [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ DefInfo -> QName -> Delayed -> [Clause] -> Declaration
    A.FunDef (Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo
    forall t.
    Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo' t
    mkDefInfoInstance Name
    x Fixity'
    f Access
    PublicAccess IsAbstract
    a IsInstance
    i IsMacro
    NotMacroDef Range
    r) QName
    x' Delayed
    delayed [Clause]
    cs ]

      -- Uncategorized function clauses
        C.NiceFunClause Range
    _ Access
    _ IsAbstract
    _ TerminationCheck
    _ CoverageCheck
    _ Bool
    _ (C.FunClause LHS
    lhs RHS' Expr
    _ WhereClause' [Declaration]
    _ Bool
    _) ->
          [Char] -> ScopeM [Declaration]
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> ScopeM [Declaration]) -> [Char] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    "Missing type signature for left hand side " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ LHS -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow LHS
    lhs
        C.NiceFunClause{} -> ScopeM [Declaration]
    forall a. HasCallStack => a
    __IMPOSSIBLE__

      -- Data definitions
        C.NiceDataDef Range
    r Origin
    o IsAbstract
    a PositivityCheck
    _ UniverseCheck
    uc Name
    x [LamBinding' TypedBinding]
    pars [NiceDeclaration]
    cons -> do
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.data.def" Int
    20 ([Char]
    "checking " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Origin -> [Char]
    forall a. Show a => a -> [Char]
    show Origin
    o [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " DataDef for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x)
            (Access
    p, AbstractName
    ax) <- QName -> ScopeM ResolvedName
    resolveName (Name -> QName
    C.QName Name
    x) ScopeM ResolvedName
    -> (ResolvedName -> TCMT IO (Access, AbstractName))
    -> TCMT IO (Access, AbstractName)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
              DefinedName Access
    p AbstractName
    ax Suffix
    NoSuffix -> do
                Name -> KindOfName -> AbstractName -> TCMT IO ()
    clashUnless Name
    x KindOfName
    DataName AbstractName
    ax  -- Andreas 2019-07-07, issue #3892
                AbstractName -> TCMT IO ()
    forall a. LivesInCurrentModule a => a -> TCMT IO ()
    livesInCurrentModule AbstractName
    ax  -- Andreas, 2017-12-04, issue #2862
                Name -> AbstractName -> TCMT IO ()
    clashIfModuleAlreadyDefinedInCurrentModule Name
    x AbstractName
    ax
                (Access, AbstractName) -> TCMT IO (Access, AbstractName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Access
    p, AbstractName
    ax)
              ResolvedName
    _ -> [Char] -> TCMT IO (Access, AbstractName)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO (Access, AbstractName))
    -> [Char] -> TCMT IO (Access, AbstractName)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Missing type signature for data definition " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
            [LamBinding' TypedBinding] -> TCMT IO ()
    forall a. EnsureNoLetStms a => a -> TCMT IO ()
    ensureNoLetStms [LamBinding' TypedBinding]
    pars
            ScopeM [Declaration] -> ScopeM [Declaration]
    forall a. ScopeM a -> ScopeM a
    withLocalVars (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ do
              Set Name
    gvars <- Origin -> AbstractName -> ScopeM (Set Name)
    bindGeneralizablesIfInserted Origin
    o AbstractName
    ax
              -- Check for duplicate constructors
              do [Name]
    cs <- (NiceDeclaration -> ScopeM Name)
    -> [NiceDeclaration] -> TCMT IO [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM NiceDeclaration -> ScopeM Name
    conName [NiceDeclaration]
    cons
                 [Name] -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a.
    (Monad m, Null a) =>
    a -> (a -> m ()) -> m ()
    unlessNull ([Name] -> [Name]
    forall a. Ord a => [a] -> [a]
    duplicates [Name]
    cs) (([Name] -> TCMT IO ()) -> TCMT IO ())
    -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ [Name]
    dups -> do
                   let bad :: [Name]
    bad = (Name -> Bool) -> [Name] -> [Name]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    dups) [Name]
    cs
                   [Name] -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange [Name]
    bad (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
                     TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Name] -> TypeError
    DuplicateConstructors [Name]
    dups

              [LamBinding]
    pars <- [Maybe LamBinding] -> [LamBinding]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe LamBinding] -> [LamBinding])
    -> TCMT IO [Maybe LamBinding] -> TCMT IO [LamBinding]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [LamBinding' TypedBinding]
    -> ScopeM (AbsOfCon [LamBinding' TypedBinding])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [LamBinding' TypedBinding]
    pars
              let x' :: QName
    x' = AbstractName -> QName
    anameName AbstractName
    ax
              -- Create the module for the qualified constructors
              Name -> TCMT IO ()
    checkForModuleClash Name
    x -- disallow shadowing previously defined modules
              let m :: ModuleName
    m = QName -> ModuleName
    qnameToMName QName
    x'
              Maybe DataOrRecordModule -> ModuleName -> TCMT IO ()
    createModule (DataOrRecordModule -> Maybe DataOrRecordModule
    forall a. a -> Maybe a
    Just DataOrRecordModule
    IsDataModule) ModuleName
    m
              Access -> Name -> ModuleName -> TCMT IO ()
    bindModule Access
    p Name
    x ModuleName
    m  -- make it a proper module
              [Declaration]
    cons <- [DataConstrDecl] -> ScopeM (AbsOfCon [DataConstrDecl])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ((NiceDeclaration -> DataConstrDecl)
    -> [NiceDeclaration] -> [DataConstrDecl]
    forall a b. (a -> b) -> [a] -> [b]
    map (ModuleName
    -> IsAbstract -> Access -> NiceDeclaration -> DataConstrDecl
    DataConstrDecl ModuleName
    m IsAbstract
    a Access
    p) [NiceDeclaration]
    cons)
              [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "data" Int
    20 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Checked data " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
              Fixity'
    f <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
              [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ DefInfo
    -> QName
    -> UniverseCheck
    -> DataDefParams
    -> [Declaration]
    -> Declaration
    A.DataDef (Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo
    forall t.
    Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
    mkDefInfo Name
    x Fixity'
    f Access
    PublicAccess IsAbstract
    a Range
    r) QName
    x' UniverseCheck
    uc (Set Name -> [LamBinding] -> DataDefParams
    DataDefParams Set Name
    gvars [LamBinding]
    pars) [Declaration]
    cons ]
          where
            conName :: NiceDeclaration -> ScopeM Name
    conName (C.Axiom Range
    _ Access
    _ IsAbstract
    _ IsInstance
    _ ArgInfo
    _ Name
    c Expr
    _) = Name -> ScopeM Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    c
            conName NiceDeclaration
    d = NiceDeclaration -> ScopeM Name
    forall a. NiceDeclaration -> ScopeM a
    errorNotConstrDecl NiceDeclaration
    d

      -- Record definitions (mucho interesting)
        C.NiceRecDef Range
    r Origin
    o IsAbstract
    a PositivityCheck
    _ UniverseCheck
    uc Name
    x (RecordDirectives Maybe (Ranged Induction)
    ind Maybe HasEta0
    eta Maybe Range
    pat Maybe (Name, IsInstance)
    cm) [LamBinding' TypedBinding]
    pars [Declaration]
    fields -> do
          [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.rec.def" Int
    20 ([Char]
    "checking " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Origin -> [Char]
    forall a. Show a => a -> [Char]
    show Origin
    o [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " RecDef for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x)
          -- #3008: Termination pragmas are ignored in records
          WhereOrRecord -> [Declaration] -> TCMT IO ()
    forall (f :: * -> *).
    Foldable f =>
    WhereOrRecord -> f Declaration -> TCMT IO ()
    checkNoTerminationPragma WhereOrRecord
    InRecordDef [Declaration]
    fields
          -- Andreas, 2020-04-19, issue #4560
          -- 'pattern' declaration is incompatible with 'coinductive' or 'eta-equality'.
          Maybe Range -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe Range
    pat ((Range -> TCMT IO ()) -> TCMT IO ())
    -> (Range -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ Range
    r -> do
            let warn :: [Char] -> TCMT IO ()
    warn = Range -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Range
    r (TCMT IO () -> TCMT IO ())
    -> ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning (Warning -> TCMT IO ())
    -> ([Char] -> Warning) -> [Char] -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Warning
    UselessPatternDeclarationForRecord
            if | Just (Ranged Range
    _ Induction
    CoInductive) <- Maybe (Ranged Induction)
    ind -> [Char] -> TCMT IO ()
    warn [Char]
    "coinductive"
               | Just HasEta0
    YesEta                 <- Maybe HasEta0
    eta -> [Char] -> TCMT IO ()
    warn [Char]
    "eta"
               | Bool
    otherwise -> () -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

          (Access
    p, AbstractName
    ax) <- QName -> ScopeM ResolvedName
    resolveName (Name -> QName
    C.QName Name
    x) ScopeM ResolvedName
    -> (ResolvedName -> TCMT IO (Access, AbstractName))
    -> TCMT IO (Access, AbstractName)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            DefinedName Access
    p AbstractName
    ax Suffix
    NoSuffix -> do
              Name -> KindOfName -> AbstractName -> TCMT IO ()
    clashUnless Name
    x KindOfName
    RecName AbstractName
    ax  -- Andreas 2019-07-07, issue #3892
              AbstractName -> TCMT IO ()
    forall a. LivesInCurrentModule a => a -> TCMT IO ()
    livesInCurrentModule AbstractName
    ax  -- Andreas, 2017-12-04, issue #2862
              Name -> AbstractName -> TCMT IO ()
    clashIfModuleAlreadyDefinedInCurrentModule Name
    x AbstractName
    ax
              (Access, AbstractName) -> TCMT IO (Access, AbstractName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Access
    p, AbstractName
    ax)
            ResolvedName
    _ -> [Char] -> TCMT IO (Access, AbstractName)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO (Access, AbstractName))
    -> [Char] -> TCMT IO (Access, AbstractName)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Missing type signature for record definition " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
          [LamBinding' TypedBinding] -> TCMT IO ()
    forall a. EnsureNoLetStms a => a -> TCMT IO ()
    ensureNoLetStms [LamBinding' TypedBinding]
    pars
          ScopeM [Declaration] -> ScopeM [Declaration]
    forall a. ScopeM a -> ScopeM a
    withLocalVars (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ do
            Set Name
    gvars <- Origin -> AbstractName -> ScopeM (Set Name)
    bindGeneralizablesIfInserted Origin
    o AbstractName
    ax
            -- Check that the generated module doesn't clash with a previously
            -- defined module
            Name -> TCMT IO ()
    checkForModuleClash Name
    x
            [LamBinding]
    pars   <- [Maybe LamBinding] -> [LamBinding]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe LamBinding] -> [LamBinding])
    -> TCMT IO [Maybe LamBinding] -> TCMT IO [LamBinding]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [LamBinding' TypedBinding]
    -> ScopeM (AbsOfCon [LamBinding' TypedBinding])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [LamBinding' TypedBinding]
    pars
            let x' :: QName
    x' = AbstractName -> QName
    anameName AbstractName
    ax
            -- We scope check the fields a first time when putting together
            -- the type of the constructor.
            Expr
    contel <- RecordConstructorType
    -> (AbsOfCon RecordConstructorType -> ScopeM Expr) -> ScopeM Expr
    forall c b.
    ToAbstract c =>
    c -> (AbsOfCon c -> ScopeM b) -> ScopeM b
    localToAbstract ([Declaration] -> RecordConstructorType
    RecordConstructorType [Declaration]
    fields) AbsOfCon RecordConstructorType -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            ModuleName
    m0     <- TCMT IO ModuleName
    forall (m :: * -> *). ReadTCState m => m ModuleName
    getCurrentModule
            let m :: ModuleName
    m = ModuleName -> ModuleName -> ModuleName
    A.qualifyM ModuleName
    m0 (ModuleName -> ModuleName) -> ModuleName -> ModuleName
    forall a b. (a -> b) -> a -> b
    $ List1 Name -> ModuleName
    mnameFromList1 (List1 Name -> ModuleName) -> List1 Name -> ModuleName
    forall a b. (a -> b) -> a -> b
    $ Name -> List1 Name
    forall el coll. Singleton el coll => el -> coll
    singleton (Name -> List1 Name) -> Name -> List1 Name
    forall a b. (a -> b) -> a -> b
    $ List1 Name -> Name
    forall a. NonEmpty a -> a
    List1.last (List1 Name -> Name) -> List1 Name -> Name
    forall a b. (a -> b) -> a -> b
    $ QName -> List1 Name
    qnameToList QName
    x'
            [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "rec" Int
    15 [Char]
    "before record"
            Maybe DataOrRecordModule -> ModuleName -> TCMT IO ()
    createModule (DataOrRecordModule -> Maybe DataOrRecordModule
    forall a. a -> Maybe a
    Just DataOrRecordModule
    IsRecordModule) ModuleName
    m
            -- We scope check the fields a second time, as actual fields.
            [Declaration]
    afields <- ModuleName -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a.
    (ReadTCState m, MonadTCState m) =>
    ModuleName -> m a -> m a
    withCurrentModule ModuleName
    m (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ do
              [Declaration]
    afields <- Declarations -> ScopeM (AbsOfCon Declarations)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([Declaration] -> Declarations
    Declarations [Declaration]
    fields)
              [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "rec" Int
    15 [Char]
    "checked fields"
              [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Declaration]
    afields
            -- Andreas, 2017-07-13 issue #2642 disallow duplicate fields
            -- Check for duplicate fields. (See "Check for duplicate constructors")
            do let fs :: [C.Name]
                   fs :: [Name]
    fs = [[Name]] -> [Name]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Name]] -> [Name]) -> [[Name]] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ [Declaration] -> (Declaration -> Maybe [Name]) -> [[Name]]
    forall a b. [a] -> (a -> Maybe b) -> [b]
    forMaybe [Declaration]
    fields ((Declaration -> Maybe [Name]) -> [[Name]])
    -> (Declaration -> Maybe [Name]) -> [[Name]]
    forall a b. (a -> b) -> a -> b
    $ \case
                     C.Field Range
    _ [Declaration]
    fs -> [Name] -> Maybe [Name]
    forall a. a -> Maybe a
    Just ([Name] -> Maybe [Name]) -> [Name] -> Maybe [Name]
    forall a b. (a -> b) -> a -> b
    $ [Declaration]
    fs [Declaration] -> (Declaration -> Name) -> [Name]
    forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    <&> \case
                       -- a Field block only contains field signatures
                       C.FieldSig IsInstance
    _ TacticAttribute
    _ Name
    f Arg Expr
    _ -> Name
    f
                       Declaration
    _ -> Name
    forall a. HasCallStack => a
    __IMPOSSIBLE__
                     Declaration
    _ -> Maybe [Name]
    forall a. Maybe a
    Nothing
               [Name] -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a.
    (Monad m, Null a) =>
    a -> (a -> m ()) -> m ()
    unlessNull ([Name] -> [Name]
    forall a. Ord a => [a] -> [a]
    duplicates [Name]
    fs) (([Name] -> TCMT IO ()) -> TCMT IO ())
    -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ [Name]
    dups -> do
                 let bad :: [Name]
    bad = (Name -> Bool) -> [Name] -> [Name]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    dups) [Name]
    fs
                 [Name] -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange [Name]
    bad (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
                   TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Name] -> TypeError
    DuplicateFields [Name]
    dups
            Access -> Name -> ModuleName -> TCMT IO ()
    bindModule Access
    p Name
    x ModuleName
    m
            let kind :: KindOfName
    kind = KindOfName
    -> (Ranged Induction -> KindOfName)
    -> Maybe (Ranged Induction)
    -> KindOfName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe KindOfName
    ConName (Induction -> KindOfName
    conKindOfName (Induction -> KindOfName)
    -> (Ranged Induction -> Induction)
    -> Ranged Induction
    -> KindOfName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ranged Induction -> Induction
    forall a. Ranged a -> a
    rangedThing) Maybe (Ranged Induction)
    ind
            -- Andreas, 2019-11-11, issue #4189, no longer add record constructor to record module.
            Maybe QName
    cm' <- Maybe (Name, IsInstance)
    -> ((Name, IsInstance) -> TCMT IO QName) -> TCMT IO (Maybe QName)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM Maybe (Name, IsInstance)
    cm (((Name, IsInstance) -> TCMT IO QName) -> TCMT IO (Maybe QName))
    -> ((Name, IsInstance) -> TCMT IO QName) -> TCMT IO (Maybe QName)
    forall a b. (a -> b) -> a -> b
    $ \ (Name
    c, IsInstance
    _) -> Name -> KindOfName -> IsAbstract -> Access -> TCMT IO QName
    bindRecordConstructorName Name
    c KindOfName
    kind IsAbstract
    a Access
    p
            let inst :: IsInstance
    inst = Maybe (Name, IsInstance)
    -> IsInstance -> ((Name, IsInstance) -> IsInstance) -> IsInstance
    forall a b. Maybe a -> b -> (a -> b) -> b
    caseMaybe Maybe (Name, IsInstance)
    cm IsInstance
    NotInstanceDef (Name, IsInstance) -> IsInstance
    forall a b. (a, b) -> b
    snd
            [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "rec" Int
    15 [Char]
    "record complete"
            Fixity'
    f <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
            let params :: DataDefParams
    params = Set Name -> [LamBinding] -> DataDefParams
    DataDefParams Set Name
    gvars [LamBinding]
    pars
            let dir' :: RecordDirectives' QName
    dir' = Maybe (Ranged Induction)
    -> Maybe HasEta0
    -> Maybe Range
    -> Maybe QName
    -> RecordDirectives' QName
    forall a.
    Maybe (Ranged Induction)
    -> Maybe HasEta0 -> Maybe Range -> Maybe a -> RecordDirectives' a
    RecordDirectives Maybe (Ranged Induction)
    ind Maybe HasEta0
    eta Maybe Range
    pat Maybe QName
    cm'
            [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ DefInfo
    -> QName
    -> UniverseCheck
    -> RecordDirectives' QName
    -> DataDefParams
    -> Expr
    -> [Declaration]
    -> Declaration
    A.RecDef (Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo
    forall t.
    Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo' t
    mkDefInfoInstance Name
    x Fixity'
    f Access
    PublicAccess IsAbstract
    a IsInstance
    inst IsMacro
    NotMacroDef Range
    r) QName
    x' UniverseCheck
    uc RecordDirectives' QName
    dir' DataDefParams
    params Expr
    contel [Declaration]
    afields ]

        NiceModule Range
    r Access
    p IsAbstract
    a x :: QName
    x@(C.QName Name
    name) Telescope
    tel [Declaration]
    ds -> do
          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
            [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "scope checking NiceModule " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
            ]

          Declaration
    adecl <- Call -> TCMT IO Declaration -> TCMT IO Declaration
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (NiceDeclaration -> Call
    ScopeCheckDeclaration (NiceDeclaration -> Call) -> NiceDeclaration -> Call
    forall a b. (a -> b) -> a -> b
    $ Range
    -> Access
    -> IsAbstract
    -> QName
    -> Telescope
    -> [Declaration]
    -> NiceDeclaration
    NiceModule Range
    r Access
    p IsAbstract
    a QName
    x Telescope
    tel []) (TCMT IO Declaration -> TCMT IO Declaration)
    -> TCMT IO Declaration -> TCMT IO Declaration
    forall a b. (a -> b) -> a -> b
    $ do
            Range
    -> Access
    -> Name
    -> Telescope
    -> ScopeM [Declaration]
    -> TCMT IO Declaration
    scopeCheckNiceModule Range
    r Access
    p Name
    name Telescope
    tel (ScopeM [Declaration] -> TCMT IO Declaration)
    -> ScopeM [Declaration] -> TCMT IO Declaration
    forall a b. (a -> b) -> a -> b
    $ Declarations -> ScopeM (AbsOfCon Declarations)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([Declaration] -> Declarations
    Declarations [Declaration]
    ds)

          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
            [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "scope checked NiceModule " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
            , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Declaration -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA Declaration
    adecl
            ]
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Declaration
    adecl ]

        NiceModule Range
    _ Access
    _ IsAbstract
    _ m :: QName
    m@C.Qual{} Telescope
    _ [Declaration]
    _ ->
          [Char] -> ScopeM [Declaration]
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> ScopeM [Declaration]) -> [Char] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Local modules cannot have qualified names"

        NiceModuleMacro Range
    r Access
    p Name
    x ModuleApplication
    modapp OpenShortHand
    open ImportDirective
    dir -> do
          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
            [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "scope checking NiceModuleMacro " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
            ]

          Declaration
    adecl <- (ModuleInfo
     -> ModuleName
     -> ModuleApplication
     -> ScopeCopyInfo
     -> ImportDirective
     -> Declaration)
    -> OpenKind
    -> Range
    -> Access
    -> Name
    -> ModuleApplication
    -> OpenShortHand
    -> ImportDirective
    -> TCMT IO Declaration
    forall a.
    (ToConcrete a, Pretty (ConOfAbs a)) =>
    (ModuleInfo
     -> ModuleName
     -> ModuleApplication
     -> ScopeCopyInfo
     -> ImportDirective
     -> a)
    -> OpenKind
    -> Range
    -> Access
    -> Name
    -> ModuleApplication
    -> OpenShortHand
    -> ImportDirective
    -> ScopeM a
    checkModuleMacro ModuleInfo
    -> ModuleName
    -> ModuleApplication
    -> ScopeCopyInfo
    -> ImportDirective
    -> Declaration
    Apply OpenKind
    TopOpenModule Range
    r Access
    p Name
    x ModuleApplication
    modapp OpenShortHand
    open ImportDirective
    dir

          [Char] -> Int -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> TCMT IO Doc -> m ()
    reportSDoc [Char]
    "scope.decl" Int
    70 (TCMT IO Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    vcat ([TCMT IO Doc] -> TCMT IO Doc) -> [TCMT IO Doc] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $
            [ [Char] -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => [Char] -> m Doc
    text ([Char] -> TCMT IO Doc) -> [Char] -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "scope checked NiceModuleMacro " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x
            , Int -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
    nest Int
    2 (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
    forall a b. (a -> b) -> a -> b
    $ Declaration -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA Declaration
    adecl
            ]
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Declaration
    adecl ]

        NiceOpen Range
    r QName
    x ImportDirective
    dir -> do
          (ModuleInfo
    minfo, ModuleName
    m, ImportDirective
    adir) <- Range
    -> Maybe ModuleName
    -> QName
    -> ImportDirective
    -> ScopeM (ModuleInfo, ModuleName, ImportDirective)
    checkOpen Range
    r Maybe ModuleName
    forall a. Maybe a
    Nothing QName
    x ImportDirective
    dir
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ModuleInfo -> ModuleName -> ImportDirective -> Declaration
    A.Open ModuleInfo
    minfo ModuleName
    m ImportDirective
    adir]

        NicePragma Range
    r Pragma
    p -> do
          [Pragma]
    ps <- Pragma -> ScopeM (AbsOfCon Pragma)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Pragma
    p  -- could result in empty list of pragmas
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Declaration] -> ScopeM [Declaration])
    -> [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ (Pragma -> Declaration) -> [Pragma] -> [Declaration]
    forall a b. (a -> b) -> [a] -> [b]
    map (Range -> Pragma -> Declaration
    A.Pragma Range
    r) [Pragma]
    ps

        NiceImport Range
    r QName
    x Maybe AsName
    as OpenShortHand
    open ImportDirective
    dir -> Range -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Range
    r (ScopeM [Declaration] -> ScopeM [Declaration])
    -> ScopeM [Declaration] -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ do
          ImportDirective
    dir <- OpenShortHand -> ImportDirective -> ScopeM ImportDirective
    notPublicWithoutOpen OpenShortHand
    open ImportDirective
    dir

          -- Andreas, 2018-11-03, issue #3364, parse expression in as-clause as Name.
          let illformedAs :: [Char] -> TCMT IO (Maybe (AsName' Name))
    illformedAs [Char]
    s = Call
    -> TCMT IO (Maybe (AsName' Name)) -> TCMT IO (Maybe (AsName' Name))
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (Range -> Call
    SetRange (Range -> Call) -> Range -> Call
    forall a b. (a -> b) -> a -> b
    $ Maybe AsName -> Range
    forall a. HasRange a => a -> Range
    getRange Maybe AsName
    as) (TCMT IO (Maybe (AsName' Name)) -> TCMT IO (Maybe (AsName' Name)))
    -> TCMT IO (Maybe (AsName' Name)) -> TCMT IO (Maybe (AsName' Name))
    forall a b. (a -> b) -> a -> b
    $ do
                -- If @as@ is followed by something that is not a simple name,
                -- throw a warning and discard the as-clause.
                Maybe (AsName' Name)
    forall a. Maybe a
    Nothing Maybe (AsName' Name)
    -> TCMT IO () -> TCMT IO (Maybe (AsName' Name))
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning ([Char] -> Warning
    IllformedAsClause [Char]
    s)
          Maybe (AsName' Name)
    as <- case Maybe AsName
    as of
            -- Ok if no as-clause or it (already) contains a Name.
            Maybe AsName
    Nothing -> Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (AsName' Name)
    forall a. Maybe a
    Nothing
            Just (AsName (Right Name
    asName) Range
    r)                    -> Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name)))
    -> Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name))
    forall a b. (a -> b) -> a -> b
    $ AsName' Name -> Maybe (AsName' Name)
    forall a. a -> Maybe a
    Just (AsName' Name -> Maybe (AsName' Name))
    -> AsName' Name -> Maybe (AsName' Name)
    forall a b. (a -> b) -> a -> b
    $ Name -> Range -> AsName' Name
    forall a. a -> Range -> AsName' a
    AsName Name
    asName Range
    r
            Just (AsName (Left (C.Ident (C.QName Name
    asName))) Range
    r) -> Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name)))
    -> Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name))
    forall a b. (a -> b) -> a -> b
    $ AsName' Name -> Maybe (AsName' Name)
    forall a. a -> Maybe a
    Just (AsName' Name -> Maybe (AsName' Name))
    -> AsName' Name -> Maybe (AsName' Name)
    forall a b. (a -> b) -> a -> b
    $ Name -> Range -> AsName' Name
    forall a. a -> Range -> AsName' a
    AsName Name
    asName Range
    r
            Just (AsName (Left C.Underscore{})     Range
    r)         -> Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name)))
    -> Maybe (AsName' Name) -> TCMT IO (Maybe (AsName' Name))
    forall a b. (a -> b) -> a -> b
    $ AsName' Name -> Maybe (AsName' Name)
    forall a. a -> Maybe a
    Just (AsName' Name -> Maybe (AsName' Name))
    -> AsName' Name -> Maybe (AsName' Name)
    forall a b. (a -> b) -> a -> b
    $ Name -> Range -> AsName' Name
    forall a. a -> Range -> AsName' a
    AsName Name
    forall a. Underscore a => a
    underscore Range
    r
            Just (AsName (Left (C.Ident C.Qual{})) Range
    r) -> [Char] -> TCMT IO (Maybe (AsName' Name))
    illformedAs [Char]
    "; a qualified name is not allowed here"
            Just (AsName (Left Expr
    e)                  Range
    r) -> [Char] -> TCMT IO (Maybe (AsName' Name))
    illformedAs [Char]
    ""

          -- First scope check the imported module and return its name and
          -- interface. This is done with that module as the top-level module.
          -- This is quite subtle. We rely on the fact that when setting the
          -- top-level module and generating a fresh module name, the generated
          -- name will be exactly the same as the name generated when checking
          -- the imported module.
          (ModuleName
    m, Map ModuleName Scope
    i) <- ModuleName
    -> TCMT IO (ModuleName, Map ModuleName Scope)
    -> TCMT IO (ModuleName, Map ModuleName Scope)
    forall (m :: * -> *) a.
    (ReadTCState m, MonadTCState m) =>
    ModuleName -> m a -> m a
    withCurrentModule ModuleName
    noModuleName (TCMT IO (ModuleName, Map ModuleName Scope)
     -> TCMT IO (ModuleName, Map ModuleName Scope))
    -> TCMT IO (ModuleName, Map ModuleName Scope)
    -> TCMT IO (ModuleName, Map ModuleName Scope)
    forall a b. (a -> b) -> a -> b
    $ QName
    -> TCMT IO (ModuleName, Map ModuleName Scope)
    -> TCMT IO (ModuleName, Map ModuleName Scope)
    forall a. QName -> TCM a -> TCM a
    withTopLevelModule QName
    x (TCMT IO (ModuleName, Map ModuleName Scope)
     -> TCMT IO (ModuleName, Map ModuleName Scope))
    -> TCMT IO (ModuleName, Map ModuleName Scope)
    -> TCMT IO (ModuleName, Map ModuleName Scope)
    forall a b. (a -> b) -> a -> b
    $ do
            ModuleName
    m <- NewModuleQName -> ScopeM (AbsOfCon NewModuleQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (NewModuleQName -> ScopeM (AbsOfCon NewModuleQName))
    -> NewModuleQName -> ScopeM (AbsOfCon NewModuleQName)
    forall a b. (a -> b) -> a -> b
    $ QName -> NewModuleQName
    NewModuleQName QName
    x  -- (No longer erases the contents of @m@.)
            [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "import" Int
    10 [Char]
    "before import:"
            (ModuleName
    m, Map ModuleName Scope
    i) <- ModuleName -> TCMT IO (ModuleName, Map ModuleName Scope)
    scopeCheckImport ModuleName
    m
            [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "import" Int
    10 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "scope checked import: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Map ModuleName Scope -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Map ModuleName Scope
    i
            -- We don't want the top scope of the imported module (things happening
            -- before the module declaration)
            (ModuleName, Map ModuleName Scope)
    -> TCMT IO (ModuleName, Map ModuleName Scope)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleName
    m, ModuleName -> Map ModuleName Scope -> Map ModuleName Scope
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete ModuleName
    noModuleName Map ModuleName Scope
    i)

          -- Bind the desired module name to the right abstract name.
          (QName
    name, Range
    theAsSymbol, Maybe Name
    theAsName) <- case Maybe (AsName' Name)
    as of

             Just AsName' Name
    a | let y :: Name
    y = AsName' Name -> Name
    forall a. AsName' a -> a
    asName AsName' Name
    a, Bool -> Bool
    not (Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    y) -> do
               Access -> Name -> ModuleName -> TCMT IO ()
    bindModule (Origin -> Access
    PrivateAccess Origin
    Inserted) Name
    y ModuleName
    m
               (QName, Range, Maybe Name) -> TCMT IO (QName, Range, Maybe Name)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> QName
    C.QName Name
    y, AsName' Name -> Range
    forall a. AsName' a -> Range
    asRange AsName' Name
    a, Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    y)

             Maybe (AsName' Name)
    _ -> do
               -- Don't bind if @import ... as _@ with "no name"
               Maybe (AsName' Name) -> TCMT IO () -> TCMT IO ()
    forall m a. Monoid m => Maybe a -> m -> m
    whenNothing Maybe (AsName' Name)
    as (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Access -> QName -> ModuleName -> TCMT IO ()
    bindQModule (Origin -> Access
    PrivateAccess Origin
    Inserted) QName
    x ModuleName
    m
               (QName, Range, Maybe Name) -> TCMT IO (QName, Range, Maybe Name)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName
    x, Range
    forall a. Range' a
    noRange, Maybe Name
    forall a. Maybe a
    Nothing)

          -- Open if specified, otherwise apply import directives
          ImportDirective
    adir <- case OpenShortHand
    open of

            -- With @open@ import directives apply to the opening.
            -- The module is thus present in its qualified form without restrictions.
            OpenShortHand
    DoOpen   -> do

              -- Merge the imported scopes with the current scopes.
              -- This might override a previous import of @m@, but monotonously (add stuff).
              (Map ModuleName Scope -> Map ModuleName Scope) -> TCMT IO ()
    modifyScopes ((Map ModuleName Scope -> Map ModuleName Scope) -> TCMT IO ())
    -> (Map ModuleName Scope -> Map ModuleName Scope) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ Map ModuleName Scope
    ms -> (Scope -> Scope -> Scope)
    -> Map ModuleName Scope
    -> Map ModuleName Scope
    -> Map ModuleName Scope
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith Scope -> Scope -> Scope
    mergeScope (ModuleName -> Map ModuleName Scope -> Map ModuleName Scope
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete ModuleName
    m Map ModuleName Scope
    ms) Map ModuleName Scope
    i

              -- Andreas, 2019-05-29, issue #3818.
              -- Pass the resolved name to open instead triggering another resolution.
              -- This helps in situations like
              -- @
              --    module Top where
              --    module M where
              --    open import M
              -- @
              -- It is clear than in @open import M@, name @M@ must refer to a file
              -- rather than the above defined local module @M@.
              -- This already worked in the situation
              -- @
              --    module Top where
              --    module M where
              --    import M
              -- @
              -- Note that the manual desugaring of @open import@ as
              -- @
              --    module Top where
              --    module M where
              --    import M
              --    open M
              -- @
              -- will not work, as @M@ is now ambiguous in @open M@;
              -- the information that @M@ is external is lost here.
              (ModuleInfo
    _minfo, ModuleName
    _m, ImportDirective
    adir) <- Range
    -> Maybe ModuleName
    -> QName
    -> ImportDirective
    -> ScopeM (ModuleInfo, ModuleName, ImportDirective)
    checkOpen Range
    r (ModuleName -> Maybe ModuleName
    forall a. a -> Maybe a
    Just ModuleName
    m) QName
    name ImportDirective
    dir
              ImportDirective -> TCMT IO ImportDirective
    forall (m :: * -> *) a. Monad m => a -> m a
    return ImportDirective
    adir

            -- If not opening, import directives are applied to the original scope.
            OpenShortHand
    DontOpen -> do
              (ImportDirective
    adir, Map ModuleName Scope
    i') <- (Scope -> ScopeM (ImportDirective, Scope))
    -> ModuleName
    -> Map ModuleName Scope
    -> TCMT IO (ImportDirective, Map ModuleName Scope)
    forall (f :: * -> *) k v a.
    (Functor f, Ord k) =>
    (v -> f (a, v)) -> k -> Map k v -> f (a, Map k v)
    Map.adjustM' (QName
    -> ImportDirective -> Scope -> ScopeM (ImportDirective, Scope)
    applyImportDirectiveM QName
    x ImportDirective
    dir) ModuleName
    m Map ModuleName Scope
    i
              -- Andreas, 2020-05-18, issue #3933
              -- We merge the new imports without deleting old imports, to be monotone.
              (Map ModuleName Scope -> Map ModuleName Scope) -> TCMT IO ()
    modifyScopes ((Map ModuleName Scope -> Map ModuleName Scope) -> TCMT IO ())
    -> (Map ModuleName Scope -> Map ModuleName Scope) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ Map ModuleName Scope
    ms -> (Scope -> Scope -> Scope)
    -> Map ModuleName Scope
    -> Map ModuleName Scope
    -> Map ModuleName Scope
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith Scope -> Scope -> Scope
    mergeScope Map ModuleName Scope
    ms Map ModuleName Scope
    i'
              ImportDirective -> TCMT IO ImportDirective
    forall (m :: * -> *) a. Monad m => a -> m a
    return ImportDirective
    adir

          [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "import" Int
    10 [Char]
    "merged imported sig:"
          let minfo :: ModuleInfo
    minfo = ModuleInfo :: Range
    -> Range
    -> Maybe Name
    -> Maybe OpenShortHand
    -> Maybe ImportDirective
    -> ModuleInfo
    ModuleInfo
                { minfoRange :: Range
    minfoRange     = Range
    r
                , minfoAsName :: Maybe Name
    minfoAsName    = Maybe Name
    theAsName
                , minfoAsTo :: Range
    minfoAsTo      = (Range, Range) -> Range
    forall a. HasRange a => a -> Range
    getRange (Range
    theAsSymbol, ImportDirective -> Range
    renamingRange ImportDirective
    dir)
                , minfoOpenShort :: Maybe OpenShortHand
    minfoOpenShort = OpenShortHand -> Maybe OpenShortHand
    forall a. a -> Maybe a
    Just OpenShortHand
    open
                , minfoDirective :: Maybe ImportDirective
    minfoDirective = ImportDirective -> Maybe ImportDirective
    forall a. a -> Maybe a
    Just ImportDirective
    dir
                }
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ ModuleInfo -> ModuleName -> ImportDirective -> Declaration
    A.Import ModuleInfo
    minfo ModuleName
    m ImportDirective
    adir ]

        NiceUnquoteDecl Range
    r Access
    p IsAbstract
    a IsInstance
    i TerminationCheck
    tc CoverageCheck
    cc [Name]
    xs Expr
    e -> do
          [Fixity']
    fxs <- (Name -> ScopeM Fixity') -> [Name] -> TCMT IO [Fixity']
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Name -> ScopeM Fixity'
    getConcreteFixity [Name]
    xs
          [QName]
    ys <- (Fixity' -> Name -> TCMT IO QName)
    -> [Fixity'] -> [Name] -> TCMT IO [QName]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Fixity' -> Name -> TCMT IO QName
    freshAbstractQName [Fixity']
    fxs [Name]
    xs
          (Name -> QName -> TCMT IO ()) -> [Name] -> [QName] -> TCMT IO ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ (Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    p KindOfName
    QuotableName) [Name]
    xs [QName]
    ys
          Expr
    e <- Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    e
          (Name -> QName -> TCMT IO ()) -> [Name] -> [QName] -> TCMT IO ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ (Access -> KindOfName -> Name -> QName -> TCMT IO ()
    rebindName Access
    p KindOfName
    OtherDefName) [Name]
    xs [QName]
    ys
          let mi :: MutualInfo
    mi = TerminationCheck
    -> CoverageCheck -> PositivityCheck -> Range -> MutualInfo
    MutualInfo TerminationCheck
    tc CoverageCheck
    cc PositivityCheck
    YesPositivityCheck Range
    r
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ MutualInfo -> [Declaration] -> Declaration
    A.Mutual MutualInfo
    mi [MutualInfo -> [DefInfo] -> [QName] -> Expr -> Declaration
    A.UnquoteDecl MutualInfo
    mi [ Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo
    forall t.
    Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo' t
    mkDefInfoInstance Name
    x Fixity'
    fx Access
    p IsAbstract
    a IsInstance
    i IsMacro
    NotMacroDef Range
    r | (Fixity'
    fx, Name
    x) <- [Fixity'] -> [Name] -> [(Fixity', Name)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Fixity']
    fxs [Name]
    xs ] [QName]
    ys Expr
    e] ]

        NiceUnquoteDef Range
    r Access
    p IsAbstract
    a TerminationCheck
    _ CoverageCheck
    _ [Name]
    xs Expr
    e -> do
          [Fixity']
    fxs <- (Name -> ScopeM Fixity') -> [Name] -> TCMT IO [Fixity']
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Name -> ScopeM Fixity'
    getConcreteFixity [Name]
    xs
          [QName]
    ys <- (Name -> TCMT IO QName) -> [Name] -> TCMT IO [QName]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (OldName Name -> TCMT IO QName
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (OldName Name -> TCMT IO QName)
    -> (Name -> OldName Name) -> Name -> TCMT IO QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OldName Name
    forall a. a -> OldName a
    OldName) [Name]
    xs
          (Name -> QName -> TCMT IO ()) -> [Name] -> [QName] -> TCMT IO ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ (Access -> KindOfName -> Name -> QName -> TCMT IO ()
    rebindName Access
    p KindOfName
    QuotableName) [Name]
    xs [QName]
    ys
          Expr
    e <- Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    e
          (Name -> QName -> TCMT IO ()) -> [Name] -> [QName] -> TCMT IO ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ (Access -> KindOfName -> Name -> QName -> TCMT IO ()
    rebindName Access
    p KindOfName
    OtherDefName) [Name]
    xs [QName]
    ys
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ [DefInfo] -> [QName] -> Expr -> Declaration
    A.UnquoteDef [ Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo
    forall t.
    Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo' t
    mkDefInfo Name
    x Fixity'
    fx Access
    PublicAccess IsAbstract
    a Range
    r | (Fixity'
    fx, Name
    x) <- [Fixity'] -> [Name] -> [(Fixity', Name)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Fixity']
    fxs [Name]
    xs ] [QName]
    ys Expr
    e ]

        NicePatternSyn Range
    r Access
    a Name
    n [Arg Name]
    as Pattern
    p -> do
          [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    10 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "found nice pattern syn: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    n
          ([Arg Name]
    as, Pattern' Void
    p) <- ScopeM ([Arg Name], Pattern' Void)
    -> ScopeM ([Arg Name], Pattern' Void)
    forall a. ScopeM a -> ScopeM a
    withLocalVars (ScopeM ([Arg Name], Pattern' Void)
     -> ScopeM ([Arg Name], Pattern' Void))
    -> ScopeM ([Arg Name], Pattern' Void)
    -> ScopeM ([Arg Name], Pattern' Void)
    forall a b. (a -> b) -> a -> b
    $ do
             Pattern' Expr
    p  <- Pattern -> TCMT IO (Pattern' Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Pattern -> TCMT IO (Pattern' Expr))
    -> TCMT IO Pattern -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Pattern -> TCMT IO Pattern
    parsePatternSyn Pattern
    p
             Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Pattern' Expr -> Bool
    forall p. APatternLike p => p -> Bool
    containsAsPattern Pattern' Expr
    p) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
               TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> TypeError
    GenericError ([Char] -> TypeError) -> [Char] -> TypeError
    forall a b. (a -> b) -> a -> b
    $
                 [Char]
    "@-patterns are not allowed in pattern synonyms"
             Pattern' Expr -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) p.
    (Monad m, APatternLike p) =>
    p -> ([Name] -> m ()) -> m ()
    checkPatternLinearity Pattern' Expr
    p (([Name] -> TCMT IO ()) -> TCMT IO ())
    -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \[Name]
    ys ->
               TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Name] -> TypeError
    RepeatedVariablesInPattern [Name]
    ys
             TCMT IO ()
    bindVarsToBind
             let err :: [Char]
    err = [Char]
    "Dot or equality patterns are not allowed in pattern synonyms. Maybe use '_' instead."
             Pattern' Void
    p <- [Char] -> Pattern' Expr -> ScopeM (Pattern' Void)
    forall e. [Char] -> Pattern' e -> ScopeM (Pattern' Void)
    noDotorEqPattern [Char]
    err Pattern' Expr
    p
             [Arg Name]
    as <- ((Arg Name -> TCMT IO (Arg Name))
    -> [Arg Name] -> TCMT IO [Arg Name]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Arg Name -> TCMT IO (Arg Name))
     -> [Arg Name] -> TCMT IO [Arg Name])
    -> ((Name -> ScopeM Name) -> Arg Name -> TCMT IO (Arg Name))
    -> (Name -> ScopeM Name)
    -> [Arg Name]
    -> TCMT IO [Arg Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name -> ScopeM Name) -> Arg Name -> TCMT IO (Arg Name)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM) (ResolvedName -> ScopeM Name
    forall {m :: * -> *}.
    (MonadTCEnv m, ReadTCState m, MonadError TCErr m) =>
    ResolvedName -> m Name
    unVarName (ResolvedName -> ScopeM Name)
    -> (Name -> ScopeM ResolvedName) -> Name -> ScopeM Name
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< QName -> ScopeM ResolvedName
    resolveName (QName -> ScopeM ResolvedName)
    -> (Name -> QName) -> Name -> ScopeM ResolvedName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> QName
    C.QName) [Arg Name]
    as
             [Name] -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a.
    (Monad m, Null a) =>
    a -> (a -> m ()) -> m ()
    unlessNull (Pattern' Void -> [Name]
    forall p. APatternLike p => p -> [Name]
    patternVars Pattern' Void
    p [Name] -> [Name] -> [Name]
    forall a. Eq a => [a] -> [a] -> [a]
    List.\\ (Arg Name -> Name) -> [Arg Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Arg Name -> Name
    forall e. Arg e -> e
    unArg [Arg Name]
    as) (([Name] -> TCMT IO ()) -> TCMT IO ())
    -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ [Name]
    xs -> do
               TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ())
    -> (Doc -> TypeError) -> Doc -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> TCMT IO ()) -> TCMT IO Doc -> TCMT IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< do
                 TCMT IO Doc
    "Unbound variables in pattern synonym: " TCMT IO Doc -> TCMT IO Doc -> TCMT IO Doc
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    <+>
                   [TCMT IO Doc] -> TCMT IO Doc
    forall (m :: * -> *) (t :: * -> *).
    (Applicative m, Foldable t) =>
    t (m Doc) -> m Doc
    sep ((Name -> TCMT IO Doc) -> [Name] -> [TCMT IO Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> TCMT IO Doc
    forall a (m :: * -> *).
    (ToConcrete a, Pretty (ConOfAbs a), MonadAbsToCon m) =>
    a -> m Doc
    prettyA [Name]
    xs)
             ([Arg Name], Pattern' Void) -> ScopeM ([Arg Name], Pattern' Void)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Arg Name]
    as, Pattern' Void
    p)
          QName
    y <- Name -> TCMT IO QName
    freshAbstractQName' Name
    n
          Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    a KindOfName
    PatternSynName Name
    n QName
    y
          -- Expanding pattern synonyms already at definition makes it easier to
          -- fold them back when printing (issue #2762).
          Pattern' Void
    ep <- Pattern' Void -> ScopeM (Pattern' Void)
    forall a. ExpandPatternSynonyms a => a -> TCM a
    expandPatternSynonyms Pattern' Void
    p
          (PatternSynDefns -> PatternSynDefns) -> TCMT IO ()
    modifyPatternSyns (QName
    -> ([Arg Name], Pattern' Void)
    -> PatternSynDefns
    -> PatternSynDefns
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert QName
    y ([Arg Name]
    as, Pattern' Void
    ep))
          [Declaration] -> ScopeM [Declaration]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [QName -> [Arg BindName] -> Pattern' Void -> Declaration
    A.PatternSynDef QName
    y ((Arg Name -> Arg BindName) -> [Arg Name] -> [Arg BindName]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Name -> BindName) -> Arg Name -> Arg BindName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name -> BindName
    BindName) [Arg Name]
    as) Pattern' Void
    p]   -- only for highlighting, so use unexpanded version
          where unVarName :: ResolvedName -> m Name
    unVarName (VarName Name
    a BindingSource
    _) = Name -> m Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    a
                unVarName ResolvedName
    _ = TypeError -> m Name
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> m Name) -> TypeError -> m Name
    forall a b. (a -> b) -> a -> b
    $ TypeError
    UnusedVariableInPatternSynonym

        d :: NiceDeclaration
    d@NiceLoneConstructor{} -> (CallStack -> ScopeM [Declaration]) -> ScopeM [Declaration]
    forall b. HasCallStack => (CallStack -> b) -> b
    withCurrentCallStack ((CallStack -> ScopeM [Declaration]) -> ScopeM [Declaration])
    -> (CallStack -> ScopeM [Declaration]) -> ScopeM [Declaration]
    forall a b. (a -> b) -> a -> b
    $ \ CallStack
    stk -> do
          Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning (Warning -> TCMT IO ()) -> Warning -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ DeclarationWarning -> Warning
    NicifierIssue (CallStack -> DeclarationWarning' -> DeclarationWarning
    DeclarationWarning CallStack
    stk (Range -> DeclarationWarning'
    InvalidConstructorBlock (NiceDeclaration -> Range
    forall a. HasRange a => a -> Range
    getRange NiceDeclaration
    d)))
          [Declaration] -> ScopeM [Declaration]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []

        where
          -- checking postulate or type sig. without checking safe flag
          toAbstractNiceAxiom :: KindOfName -> C.NiceDeclaration -> ScopeM A.Declaration
          toAbstractNiceAxiom :: KindOfName -> NiceDeclaration -> TCMT IO Declaration
    toAbstractNiceAxiom KindOfName
    kind (C.Axiom Range
    r Access
    p IsAbstract
    a IsInstance
    i ArgInfo
    info Name
    x Expr
    t) = do
            Expr
    t' <- Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx Expr
    t
            Fixity'
    f  <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
            Maybe [Occurrence]
    mp <- Name -> ScopeM (Maybe [Occurrence])
    getConcretePolarity Name
    x
            QName
    y  <- Fixity' -> Name -> TCMT IO QName
    freshAbstractQName Fixity'
    f Name
    x
            let isMacro :: IsMacro
    isMacro | KindOfName
    kind KindOfName -> KindOfName -> Bool
    forall a. Eq a => a -> a -> Bool
    == KindOfName
    MacroName = IsMacro
    MacroDef
                        | Bool
    otherwise         = IsMacro
    NotMacroDef
            Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    p KindOfName
    kind Name
    x QName
    y
            Declaration -> TCMT IO Declaration
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Declaration -> TCMT IO Declaration)
    -> Declaration -> TCMT IO Declaration
    forall a b. (a -> b) -> a -> b
    $ KindOfName
    -> DefInfo
    -> ArgInfo
    -> Maybe [Occurrence]
    -> QName
    -> Expr
    -> Declaration
    A.Axiom KindOfName
    kind (Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo
    forall t.
    Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo' t
    mkDefInfoInstance Name
    x Fixity'
    f Access
    p IsAbstract
    a IsInstance
    i IsMacro
    isMacro Range
    r) ArgInfo
    info Maybe [Occurrence]
    mp QName
    y Expr
    t'
          toAbstractNiceAxiom KindOfName
    _ NiceDeclaration
    _ = TCMT IO Declaration
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    unGeneralized :: A.Expr -> (Set.Set I.QName, A.Expr)
    unGeneralized :: Expr -> (Set QName, Expr)
    unGeneralized (A.Generalized Set QName
    s Expr
    t) = (Set QName
    s, Expr
    t)
    unGeneralized (A.ScopedExpr ScopeInfo
    si Expr
    e) = ScopeInfo -> Expr -> Expr
    A.ScopedExpr ScopeInfo
    si (Expr -> Expr) -> (Set QName, Expr) -> (Set QName, Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> (Set QName, Expr)
    unGeneralized Expr
    e
    unGeneralized Expr
    t = (Set QName
    forall a. Monoid a => a
    mempty, Expr
    t)

    alreadyGeneralizing :: ScopeM Bool
    alreadyGeneralizing :: TCMT IO Bool
    alreadyGeneralizing = Maybe (Set QName) -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe (Set QName) -> Bool)
    -> TCMT IO (Maybe (Set QName)) -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Lens' (Maybe (Set QName)) TCState -> TCMT IO (Maybe (Set QName))
    forall (m :: * -> *) a. ReadTCState m => Lens' a TCState -> m a
    useTC Lens' (Maybe (Set QName)) TCState
    stGeneralizedVars

    collectGeneralizables :: ScopeM a -> ScopeM (Set I.QName, a)
    collectGeneralizables :: forall a. ScopeM a -> ScopeM (Set QName, a)
    collectGeneralizables ScopeM a
    m =
      -- #5683: No nested generalization
      TCMT IO Bool
    -> TCMT IO (Set QName, a)
    -> TCMT IO (Set QName, a)
    -> TCMT IO (Set QName, a)
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM TCMT IO Bool
    alreadyGeneralizing ((Set QName
    forall a. Set a
    Set.empty,) (a -> (Set QName, a)) -> ScopeM a -> TCMT IO (Set QName, a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ScopeM a
    m) (TCMT IO (Set QName, a) -> TCMT IO (Set QName, a))
    -> TCMT IO (Set QName, a) -> TCMT IO (Set QName, a)
    forall a b. (a -> b) -> a -> b
    $
      {-else-} TCMT IO (Maybe (Set QName))
    -> (Maybe (Set QName) -> TCMT IO ())
    -> TCMT IO (Set QName, a)
    -> TCMT IO (Set QName, a)
    forall (m :: * -> *) a b.
    Monad m =>
    m a -> (a -> m ()) -> m b -> m b
    bracket_ TCMT IO (Maybe (Set QName))
    open Maybe (Set QName) -> TCMT IO ()
    close (TCMT IO (Set QName, a) -> TCMT IO (Set QName, a))
    -> TCMT IO (Set QName, a) -> TCMT IO (Set QName, a)
    forall a b. (a -> b) -> a -> b
    $ do
          a
    a <- ScopeM a
    m
          Maybe (Set QName)
    s <- Lens' (Maybe (Set QName)) TCState -> TCMT IO (Maybe (Set QName))
    forall (m :: * -> *) a. ReadTCState m => Lens' a TCState -> m a
    useTC Lens' (Maybe (Set QName)) TCState
    stGeneralizedVars
          case Maybe (Set QName)
    s of
              Maybe (Set QName)
    Nothing -> TCMT IO (Set QName, a)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
              Just Set QName
    s -> (Set QName, a) -> TCMT IO (Set QName, a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Set QName
    s, a
    a)
      where
        open :: TCMT IO (Maybe (Set QName))
    open = do
            Maybe (Set QName)
    gvs <- Lens' (Maybe (Set QName)) TCState -> TCMT IO (Maybe (Set QName))
    forall (m :: * -> *) a. ReadTCState m => Lens' a TCState -> m a
    useTC Lens' (Maybe (Set QName)) TCState
    stGeneralizedVars
            Lens' (Maybe (Set QName)) TCState
    stGeneralizedVars Lens' (Maybe (Set QName)) TCState
    -> Maybe (Set QName) -> TCMT IO ()
    forall (m :: * -> *) a.
    MonadTCState m =>
    Lens' a TCState -> a -> m ()
    `setTCLens` Set QName -> Maybe (Set QName)
    forall a. a -> Maybe a
    Just Set QName
    forall a. Monoid a => a
    mempty
            Maybe (Set QName) -> TCMT IO (Maybe (Set QName))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Set QName)
    gvs
        close :: Maybe (Set QName) -> TCMT IO ()
    close = (Lens' (Maybe (Set QName)) TCState
    stGeneralizedVars Lens' (Maybe (Set QName)) TCState
    -> Maybe (Set QName) -> TCMT IO ()
    forall (m :: * -> *) a.
    MonadTCState m =>
    Lens' a TCState -> a -> m ()
    `setTCLens`)

    createBoundNamesForGeneralizables :: Set I.QName -> ScopeM (Map I.QName I.Name)
    createBoundNamesForGeneralizables :: Set QName -> ScopeM (Map QName Name)
    createBoundNamesForGeneralizables Set QName
    vs =
      ((QName -> () -> ScopeM Name)
     -> Map QName () -> ScopeM (Map QName Name))
    -> Map QName ()
    -> (QName -> () -> ScopeM Name)
    -> ScopeM (Map QName Name)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (QName -> () -> ScopeM Name)
    -> Map QName () -> ScopeM (Map QName Name)
    forall (t :: * -> *) k a b.
    Applicative t =>
    (k -> a -> t b) -> Map k a -> t (Map k b)
    Map.traverseWithKey ((QName -> ()) -> Set QName -> Map QName ()
    forall k a. (k -> a) -> Set k -> Map k a
    Map.fromSet (() -> QName -> ()
    forall a b. a -> b -> a
    const ()) Set QName
    vs) ((QName -> () -> ScopeM Name) -> ScopeM (Map QName Name))
    -> (QName -> () -> ScopeM Name) -> ScopeM (Map QName Name)
    forall a b. (a -> b) -> a -> b
    $ \ QName
    q ()
    _ -> do
        let x :: Name
    x  = Name -> Name
    nameConcrete (Name -> Name) -> Name -> Name
    forall a b. (a -> b) -> a -> b
    $ QName -> Name
    qnameName QName
    q
            fx :: Fixity'
    fx = Name -> Fixity'
    nameFixity   (Name -> Fixity') -> Name -> Fixity'
    forall a b. (a -> b) -> a -> b
    $ QName -> Name
    qnameName QName
    q
        Fixity' -> Name -> ScopeM Name
    freshAbstractName Fixity'
    fx Name
    x

    collectAndBindGeneralizables :: ScopeM a -> ScopeM (Map I.QName I.Name, a)
    collectAndBindGeneralizables :: forall a. ScopeM a -> ScopeM (Map QName Name, a)
    collectAndBindGeneralizables ScopeM a
    m = do
      Int
    fvBefore <- [(Name, LocalVar)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([(Name, LocalVar)] -> Int)
    -> TCMT IO [(Name, LocalVar)] -> TCMT IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
      (Set QName
    s, a
    res) <- ScopeM a -> ScopeM (Set QName, a)
    forall a. ScopeM a -> ScopeM (Set QName, a)
    collectGeneralizables ScopeM a
    m
      Int
    fvAfter  <- [(Name, LocalVar)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([(Name, LocalVar)] -> Int)
    -> TCMT IO [(Name, LocalVar)] -> TCMT IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
      -- We should bind the named generalizable variables as fresh variables
      Map QName Name
    binds <- Set QName -> ScopeM (Map QName Name)
    createBoundNamesForGeneralizables Set QName
    s
      -- Issue #3735: We need to bind the generalizable variables outside any variables bound by `m`.
      Int -> TCMT IO () -> TCMT IO ()
    forall a. Int -> ScopeM a -> ScopeM a
    outsideLocalVars (Int
    fvAfter Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fvBefore) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Map QName Name -> TCMT IO ()
    bindGeneralizables Map QName Name
    binds
      (Map QName Name, a) -> ScopeM (Map QName Name, a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map QName Name
    binds, a
    res)

    bindGeneralizables :: Map A.QName A.Name -> ScopeM ()
    bindGeneralizables :: Map QName Name -> TCMT IO ()
    bindGeneralizables Map QName Name
    vars =
      [(QName, Name)] -> ((QName, Name) -> TCMT IO ()) -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Map QName Name -> [(QName, Name)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map QName Name
    vars) (((QName, Name) -> TCMT IO ()) -> TCMT IO ())
    -> ((QName, Name) -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ (QName
    q, Name
    y) ->
        BindingSource -> Name -> Name -> TCMT IO ()
    bindVariable BindingSource
    LambdaBound (Name -> Name
    nameConcrete (Name -> Name) -> Name -> Name
    forall a b. (a -> b) -> a -> b
    $ QName -> Name
    qnameName QName
    q) Name
    y

    -- | Bind generalizable variables if data or record decl was split by the system
    --   (origin == Inserted)
    bindGeneralizablesIfInserted :: Origin -> AbstractName -> ScopeM (Set A.Name)
    bindGeneralizablesIfInserted :: Origin -> AbstractName -> ScopeM (Set Name)
    bindGeneralizablesIfInserted Origin
    Inserted AbstractName
    y = Set Name
    bound Set Name -> TCMT IO () -> ScopeM (Set Name)
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Map QName Name -> TCMT IO ()
    bindGeneralizables Map QName Name
    gvars
      where gvars :: Map QName Name
    gvars = case AbstractName -> NameMetadata
    anameMetadata AbstractName
    y of
              GeneralizedVarsMetadata Map QName Name
    gvars -> Map QName Name
    gvars
              NameMetadata
    NoMetadata                    -> Map QName Name
    forall k a. Map k a
    Map.empty
            bound :: Set Name
    bound = [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList (Map QName Name -> [Name]
    forall k a. Map k a -> [a]
    Map.elems Map QName Name
    gvars)
    bindGeneralizablesIfInserted Origin
    UserWritten AbstractName
    _ = Set Name -> ScopeM (Set Name)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Set Name
    forall a. Set a
    Set.empty
    bindGeneralizablesIfInserted Origin
    _ AbstractName
    _           = ScopeM (Set Name)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    newtype GenTel = GenTel C.Telescope
    data GenTelAndType = GenTelAndType C.Telescope C.Expr

    instance ToAbstract GenTel where
      type AbsOfCon GenTel = A.GeneralizeTelescope
      toAbstract :: GenTel -> ScopeM (AbsOfCon GenTel)
    toAbstract (GenTel Telescope
    tel) =
        (Map QName Name -> [TypedBinding] -> GeneralizeTelescope)
    -> (Map QName Name, [TypedBinding]) -> GeneralizeTelescope
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Map QName Name -> [TypedBinding] -> GeneralizeTelescope
    A.GeneralizeTel ((Map QName Name, [TypedBinding]) -> GeneralizeTelescope)
    -> TCMT IO (Map QName Name, [TypedBinding])
    -> TCMT IO GeneralizeTelescope
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO [TypedBinding] -> TCMT IO (Map QName Name, [TypedBinding])
    forall a. ScopeM a -> ScopeM (Map QName Name, a)
    collectAndBindGeneralizables ([Maybe TypedBinding] -> [TypedBinding]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe TypedBinding] -> [TypedBinding])
    -> TCMT IO [Maybe TypedBinding] -> TCMT IO [TypedBinding]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Telescope -> ScopeM (AbsOfCon Telescope)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Telescope
    tel)

    instance ToAbstract GenTelAndType where
      type AbsOfCon GenTelAndType = (A.GeneralizeTelescope, A.Expr)

      toAbstract :: GenTelAndType -> ScopeM (AbsOfCon GenTelAndType)
    toAbstract (GenTelAndType Telescope
    tel Expr
    t) = do
        (Map QName Name
    binds, ([Maybe TypedBinding]
    tel, Expr
    t)) <- ScopeM ([Maybe TypedBinding], Expr)
    -> ScopeM (Map QName Name, ([Maybe TypedBinding], Expr))
    forall a. ScopeM a -> ScopeM (Map QName Name, a)
    collectAndBindGeneralizables (ScopeM ([Maybe TypedBinding], Expr)
     -> ScopeM (Map QName Name, ([Maybe TypedBinding], Expr)))
    -> ScopeM ([Maybe TypedBinding], Expr)
    -> ScopeM (Map QName Name, ([Maybe TypedBinding], Expr))
    forall a b. (a -> b) -> a -> b
    $
                              (,) ([Maybe TypedBinding] -> Expr -> ([Maybe TypedBinding], Expr))
    -> TCMT IO [Maybe TypedBinding]
    -> TCMT IO (Expr -> ([Maybe TypedBinding], Expr))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Telescope -> ScopeM (AbsOfCon Telescope)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Telescope
    tel TCMT IO (Expr -> ([Maybe TypedBinding], Expr))
    -> ScopeM Expr -> ScopeM ([Maybe TypedBinding], Expr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    t
        (GeneralizeTelescope, Expr) -> ScopeM (GeneralizeTelescope, Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map QName Name -> [TypedBinding] -> GeneralizeTelescope
    A.GeneralizeTel Map QName Name
    binds ([Maybe TypedBinding] -> [TypedBinding]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe TypedBinding]
    tel), Expr
    t)

    -- | Make sure definition is in same module as signature.
    class LivesInCurrentModule a where
      livesInCurrentModule :: a -> ScopeM ()

    instance LivesInCurrentModule AbstractName where
      livesInCurrentModule :: AbstractName -> TCMT IO ()
    livesInCurrentModule = QName -> TCMT IO ()
    forall a. LivesInCurrentModule a => a -> TCMT IO ()
    livesInCurrentModule (QName -> TCMT IO ())
    -> (AbstractName -> QName) -> AbstractName -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AbstractName -> QName
    anameName

    instance LivesInCurrentModule A.QName where
      livesInCurrentModule :: QName -> TCMT IO ()
    livesInCurrentModule QName
    x = do
        ModuleName
    m <- TCMT IO ModuleName
    forall (m :: * -> *). ReadTCState m => m ModuleName
    getCurrentModule
        [Char] -> Int -> [[Char]] -> TCMT IO ()
    forall a (m :: * -> *).
    (ReportS a, MonadDebug m) =>
    [Char] -> Int -> a -> m ()
    reportS [Char]
    "scope.data.def" Int
    30
          [ [Char]
    "  A.QName of data type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
          , [Char]
    "  current module: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ModuleName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ModuleName
    m
          ]
        Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (QName -> ModuleName
    A.qnameModule QName
    x ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    m) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
          [Char] -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Definition in different module than its type signature"

    -- | Unless the resolved 'AbstractName' has the given 'KindOfName',
    --   report a 'ClashingDefinition' for the 'C.Name'.
    clashUnless :: C.Name -> KindOfName -> AbstractName -> ScopeM ()
    clashUnless :: Name -> KindOfName -> AbstractName -> TCMT IO ()
    clashUnless Name
    x KindOfName
    k AbstractName
    ax = Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (AbstractName -> KindOfName
    anameKind AbstractName
    ax KindOfName -> KindOfName -> Bool
    forall a. Eq a => a -> a -> Bool
    == KindOfName
    k) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
      TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ QName -> QName -> Maybe NiceDeclaration -> TypeError
    ClashingDefinition (Name -> QName
    C.QName Name
    x) (AbstractName -> QName
    anameName AbstractName
    ax) Maybe NiceDeclaration
    forall a. Maybe a
    Nothing

    -- | If a (data/record) module with the given name is already present in the current module,
    --   we take this as evidence that a data/record with that name is already defined.
    clashIfModuleAlreadyDefinedInCurrentModule :: C.Name -> AbstractName -> ScopeM ()
    clashIfModuleAlreadyDefinedInCurrentModule :: Name -> AbstractName -> TCMT IO ()
    clashIfModuleAlreadyDefinedInCurrentModule Name
    x AbstractName
    ax = do
      [DataOrRecordModule]
    datRecMods <- [Maybe DataOrRecordModule] -> [DataOrRecordModule]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe DataOrRecordModule] -> [DataOrRecordModule])
    -> TCMT IO [Maybe DataOrRecordModule]
    -> TCMT IO [DataOrRecordModule]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
        (AbstractModule -> TCMT IO (Maybe DataOrRecordModule))
    -> [AbstractModule] -> TCMT IO [Maybe DataOrRecordModule]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (ModuleName -> TCMT IO (Maybe DataOrRecordModule)
    forall (m :: * -> *).
    ReadTCState m =>
    ModuleName -> m (Maybe DataOrRecordModule)
    isDatatypeModule (ModuleName -> TCMT IO (Maybe DataOrRecordModule))
    -> (AbstractModule -> ModuleName)
    -> AbstractModule
    -> TCMT IO (Maybe DataOrRecordModule)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AbstractModule -> ModuleName
    amodName) ([AbstractModule] -> TCMT IO [Maybe DataOrRecordModule])
    -> TCMT IO [AbstractModule] -> TCMT IO [Maybe DataOrRecordModule]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Name -> TCMT IO [AbstractModule]
    lookupModuleInCurrentModule Name
    x
      [DataOrRecordModule]
    -> ([DataOrRecordModule] -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a.
    (Monad m, Null a) =>
    a -> (a -> m ()) -> m ()
    unlessNull [DataOrRecordModule]
    datRecMods (([DataOrRecordModule] -> TCMT IO ()) -> TCMT IO ())
    -> ([DataOrRecordModule] -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TCMT IO () -> [DataOrRecordModule] -> TCMT IO ()
    forall a b. a -> b -> a
    const (TCMT IO () -> [DataOrRecordModule] -> TCMT IO ())
    -> TCMT IO () -> [DataOrRecordModule] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
        TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ QName -> QName -> Maybe NiceDeclaration -> TypeError
    ClashingDefinition (Name -> QName
    C.QName Name
    x) (AbstractName -> QName
    anameName AbstractName
    ax) Maybe NiceDeclaration
    forall a. Maybe a
    Nothing

    lookupModuleInCurrentModule :: C.Name -> ScopeM [AbstractModule]
    lookupModuleInCurrentModule :: Name -> TCMT IO [AbstractModule]
    lookupModuleInCurrentModule Name
    x =
      [AbstractModule] -> Maybe [AbstractModule] -> [AbstractModule]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [AbstractModule] -> [AbstractModule])
    -> (Scope -> Maybe [AbstractModule]) -> Scope -> [AbstractModule]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Map Name [AbstractModule] -> Maybe [AbstractModule]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    x (Map Name [AbstractModule] -> Maybe [AbstractModule])
    -> (Scope -> Map Name [AbstractModule])
    -> Scope
    -> Maybe [AbstractModule]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameSpace -> Map Name [AbstractModule]
    nsModules (NameSpace -> Map Name [AbstractModule])
    -> (Scope -> NameSpace) -> Scope -> Map Name [AbstractModule]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [NameSpaceId] -> Scope -> NameSpace
    thingsInScope [NameSpaceId
    PublicNS, NameSpaceId
    PrivateNS] (Scope -> [AbstractModule])
    -> TCMT IO Scope -> TCMT IO [AbstractModule]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO Scope
    getCurrentScope

    data DataConstrDecl = DataConstrDecl A.ModuleName IsAbstract Access C.NiceDeclaration

    -- | Bind a @data@ constructor.
    bindConstructorName
      :: ModuleName      -- ^ Name of @data@/@record@ module.
      -> C.Name          -- ^ Constructor name.
      -> IsAbstract
      -> Access
      -> ScopeM A.QName
    bindConstructorName :: ModuleName -> Name -> IsAbstract -> Access -> TCMT IO QName
    bindConstructorName ModuleName
    m Name
    x IsAbstract
    a Access
    p = do
      Fixity'
    f <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
      -- The abstract name is the qualified one
      QName
    y <- ModuleName -> TCMT IO QName -> TCMT IO QName
    forall (m :: * -> *) a.
    (ReadTCState m, MonadTCState m) =>
    ModuleName -> m a -> m a
    withCurrentModule ModuleName
    m (TCMT IO QName -> TCMT IO QName) -> TCMT IO QName -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ Fixity' -> Name -> TCMT IO QName
    freshAbstractQName Fixity'
    f Name
    x
      -- Bind it twice, once unqualified and once qualified
      Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    p' KindOfName
    ConName Name
    x QName
    y
      ModuleName -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) a.
    (ReadTCState m, MonadTCState m) =>
    ModuleName -> m a -> m a
    withCurrentModule ModuleName
    m (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    p'' KindOfName
    ConName Name
    x QName
    y
      QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    y
      where
        -- An abstract constructor is private (abstract constructor means
        -- abstract datatype, so the constructor should not be exported).
        p' :: Access
    p' = case IsAbstract
    a of
               IsAbstract
    AbstractDef -> Origin -> Access
    PrivateAccess Origin
    Inserted
               IsAbstract
    _           -> Access
    p
        p'' :: Access
    p'' = case IsAbstract
    a of
                IsAbstract
    AbstractDef -> Origin -> Access
    PrivateAccess Origin
    Inserted
                IsAbstract
    _           -> Access
    PublicAccess

    -- | Record constructors do not live in the record module (as it is parameterized).
    --   Abstract constructors are bound privately, so that they are not exported.
    bindRecordConstructorName :: C.Name -> KindOfName -> IsAbstract -> Access -> ScopeM A.QName
    bindRecordConstructorName :: Name -> KindOfName -> IsAbstract -> Access -> TCMT IO QName
    bindRecordConstructorName Name
    x KindOfName
    kind IsAbstract
    a Access
    p = do
      QName
    y <- Name -> TCMT IO QName
    freshAbstractQName' Name
    x
      Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    p' KindOfName
    kind Name
    x QName
    y
      QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    y
      where
        -- An abstract constructor is private (abstract constructor means
        -- abstract datatype, so the constructor should not be exported).
        p' :: Access
    p' = case IsAbstract
    a of
               IsAbstract
    AbstractDef -> Origin -> Access
    PrivateAccess Origin
    Inserted
               IsAbstract
    _           -> Access
    p

    instance ToAbstract DataConstrDecl where
      type AbsOfCon DataConstrDecl = A.Declaration

      toAbstract :: DataConstrDecl -> ScopeM (AbsOfCon DataConstrDecl)
    toAbstract (DataConstrDecl ModuleName
    m IsAbstract
    a Access
    p NiceDeclaration
    d) = do
        case NiceDeclaration
    d of
          C.Axiom Range
    r Access
    p1 IsAbstract
    a1 IsInstance
    i ArgInfo
    info Name
    x Expr
    t -> do -- rel==Relevant
            -- unless (p1 == p) __IMPOSSIBLE__  -- This invariant is currently violated by test/Succeed/Issue282.agda
            Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (IsAbstract
    a1 IsAbstract -> IsAbstract -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsAbstract
    a) TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            Expr
    t' <- Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx Expr
    t
            -- The abstract name is the qualified one
            -- Bind it twice, once unqualified and once qualified
            Fixity'
    f <- Name -> ScopeM Fixity'
    getConcreteFixity Name
    x
            QName
    y <- ModuleName -> Name -> IsAbstract -> Access -> TCMT IO QName
    bindConstructorName ModuleName
    m Name
    x IsAbstract
    a Access
    p
            [Char] -> Int -> [Char] -> TCMT IO ()
    printScope [Char]
    "con" Int
    15 [Char]
    "bound constructor"
            Declaration -> TCMT IO Declaration
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Declaration -> TCMT IO Declaration)
    -> Declaration -> TCMT IO Declaration
    forall a b. (a -> b) -> a -> b
    $ KindOfName
    -> DefInfo
    -> ArgInfo
    -> Maybe [Occurrence]
    -> QName
    -> Expr
    -> Declaration
    A.Axiom KindOfName
    ConName (Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo
    forall t.
    Name
    -> Fixity'
    -> Access
    -> IsAbstract
    -> IsInstance
    -> IsMacro
    -> Range
    -> DefInfo' t
    mkDefInfoInstance Name
    x Fixity'
    f Access
    p IsAbstract
    a IsInstance
    i IsMacro
    NotMacroDef Range
    r)
                             ArgInfo
    info Maybe [Occurrence]
    forall a. Maybe a
    Nothing QName
    y Expr
    t'
          NiceDeclaration
    _ -> NiceDeclaration -> TCMT IO Declaration
    forall a. NiceDeclaration -> ScopeM a
    errorNotConstrDecl NiceDeclaration
    d

    errorNotConstrDecl :: C.NiceDeclaration -> ScopeM a
    errorNotConstrDecl :: forall a. NiceDeclaration -> ScopeM a
    errorNotConstrDecl NiceDeclaration
    d = TypeError -> TCMT IO a
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO a) -> (Doc -> TypeError) -> Doc -> TCMT IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> TypeError
    GenericDocError (Doc -> TCMT IO a) -> Doc -> TCMT IO a
    forall a b. (a -> b) -> a -> b
    $
            Doc
    "Illegal declaration in data type definition " Doc -> Doc -> Doc
    P.$$
            Int -> Doc -> Doc
    P.nest Int
    2 ([Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    P.vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (Declaration -> Doc) -> [Declaration] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Declaration -> Doc
    forall a. Pretty a => a -> Doc
    pretty (NiceDeclaration -> [Declaration]
    notSoNiceDeclarations NiceDeclaration
    d))

    instance ToAbstract C.Pragma where
      type AbsOfCon C.Pragma = [A.Pragma]

      toAbstract :: Pragma -> ScopeM (AbsOfCon Pragma)
    toAbstract (C.ImpossiblePragma Range
    _ [[Char]]
    strs) =
        case [[Char]]
    strs of
          [Char]
    "ReduceM" : [[Char]]
    _ -> [[Char]] -> TCMT IO [Pragma]
    forall a. HasCallStack => [[Char]] -> TCM a
    impossibleTestReduceM [[Char]]
    strs
          [[Char]]
    _ -> [[Char]] -> TCMT IO [Pragma]
    forall (m :: * -> *) a.
    (MonadDebug m, HasCallStack) =>
    [[Char]] -> m a
    impossibleTest [[Char]]
    strs
      toAbstract (C.OptionsPragma Range
    _ [[Char]]
    opts) = [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ [[Char]] -> Pragma
    A.OptionsPragma [[Char]]
    opts ]
      toAbstract (C.RewritePragma Range
    _ Range
    _ []) = [] [Pragma] -> TCMT IO () -> TCMT IO [Pragma]
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning Warning
    EmptyRewritePragma
      toAbstract (C.RewritePragma Range
    _ Range
    r [QName]
    xs) = Pragma -> [Pragma]
    forall el coll. Singleton el coll => el -> coll
    singleton (Pragma -> [Pragma])
    -> ([[QName]] -> Pragma) -> [[QName]] -> [Pragma]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Range -> [QName] -> Pragma
    A.RewritePragma Range
    r ([QName] -> Pragma)
    -> ([[QName]] -> [QName]) -> [[QName]] -> Pragma
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[QName]] -> [QName]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[QName]] -> [Pragma]) -> TCMT IO [[QName]] -> TCMT IO [Pragma]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
       [QName] -> (QName -> TCMT IO [QName]) -> TCMT IO [[QName]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [QName]
    xs ((QName -> TCMT IO [QName]) -> TCMT IO [[QName]])
    -> (QName -> TCMT IO [QName]) -> TCMT IO [[QName]]
    forall a b. (a -> b) -> a -> b
    $ \ QName
    x -> do
        Expr
    e <- OldQName -> ScopeM (AbsOfCon OldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (OldQName -> ScopeM (AbsOfCon OldQName))
    -> OldQName -> ScopeM (AbsOfCon OldQName)
    forall a b. (a -> b) -> a -> b
    $ QName -> Maybe (Set Name) -> OldQName
    OldQName QName
    x Maybe (Set Name)
    forall a. Maybe a
    Nothing
        case Expr
    e of
          A.Def QName
    x          -> [QName] -> TCMT IO [QName]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ QName
    x ]
          A.Proj ProjOrigin
    _ AmbiguousQName
    p | Just QName
    x <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    p -> [QName] -> TCMT IO [QName]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ QName
    x ]
          A.Proj ProjOrigin
    _ AmbiguousQName
    x       -> [Char] -> TCMT IO [QName]
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO [QName]) -> [Char] -> TCMT IO [QName]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "REWRITE used on ambiguous name " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ AmbiguousQName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow AmbiguousQName
    x
          A.Con AmbiguousQName
    c | Just QName
    x <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    c -> [QName] -> TCMT IO [QName]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ QName
    x ]
          A.Con AmbiguousQName
    x          -> [Char] -> TCMT IO [QName]
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO [QName]) -> [Char] -> TCMT IO [QName]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "REWRITE used on ambiguous name " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ AmbiguousQName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow AmbiguousQName
    x
          A.Var Name
    x          -> [Char] -> TCMT IO [QName]
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO [QName]) -> [Char] -> TCMT IO [QName]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "REWRITE used on parameter " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    x [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " instead of on a defined symbol"
          Expr
    _       -> TCMT IO [QName]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract (C.ForeignPragma Range
    _ RString
    rb [Char]
    s) = [] [Pragma] -> TCMT IO () -> TCMT IO [Pragma]
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ [Char] -> [Char] -> TCMT IO ()
    addForeignCode (RString -> [Char]
    forall a. Ranged a -> a
    rangedThing RString
    rb) [Char]
    s
      toAbstract (C.CompilePragma Range
    _ RString
    rb QName
    x [Char]
    s) = do
        Maybe Expr
    me <- MaybeOldQName -> ScopeM (AbsOfCon MaybeOldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (MaybeOldQName -> ScopeM (AbsOfCon MaybeOldQName))
    -> MaybeOldQName -> ScopeM (AbsOfCon MaybeOldQName)
    forall a b. (a -> b) -> a -> b
    $ OldQName -> MaybeOldQName
    MaybeOldQName (OldQName -> MaybeOldQName) -> OldQName -> MaybeOldQName
    forall a b. (a -> b) -> a -> b
    $ QName -> Maybe (Set Name) -> OldQName
    OldQName QName
    x Maybe (Set Name)
    forall a. Maybe a
    Nothing
        case Maybe Expr
    me of
          Maybe Expr
    Nothing -> [] [Pragma] -> TCMT IO () -> TCMT IO [Pragma]
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ QName -> TCMT IO ()
    notInScopeWarning QName
    x
          Just Expr
    e  -> do
            let err :: [Char] -> TCMT IO QName
    err [Char]
    what = [Char] -> TCMT IO QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO QName) -> [Char] -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cannot COMPILE " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    what [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x
            QName
    y <- case Expr
    e of
              A.Def QName
    x             -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
              A.Proj ProjOrigin
    _ AmbiguousQName
    p | Just QName
    x <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    p -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
              A.Proj ProjOrigin
    _ AmbiguousQName
    x          -> [Char] -> TCMT IO QName
    err [Char]
    "ambiguous projection"
              A.Con AmbiguousQName
    c | Just QName
    x <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    c -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
              A.Con AmbiguousQName
    x             -> [Char] -> TCMT IO QName
    err [Char]
    "ambiguous constructor"
              A.PatternSyn{}      -> [Char] -> TCMT IO QName
    err [Char]
    "pattern synonym"
              A.Var{}             -> [Char] -> TCMT IO QName
    err [Char]
    "local variable"
              Expr
    _                   -> TCMT IO QName
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ RString -> QName -> [Char] -> Pragma
    A.CompilePragma RString
    rb QName
    y [Char]
    s ]

      toAbstract (C.StaticPragma Range
    _ QName
    x) = do
          Expr
    e <- OldQName -> ScopeM (AbsOfCon OldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (OldQName -> ScopeM (AbsOfCon OldQName))
    -> OldQName -> ScopeM (AbsOfCon OldQName)
    forall a b. (a -> b) -> a -> b
    $ QName -> Maybe (Set Name) -> OldQName
    OldQName QName
    x Maybe (Set Name)
    forall a. Maybe a
    Nothing
          QName
    y <- case Expr
    e of
              A.Def  QName
    x -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
              A.Proj ProjOrigin
    _ AmbiguousQName
    p | Just QName
    x <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    p -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
              A.Proj ProjOrigin
    _ AmbiguousQName
    x -> [Char] -> TCMT IO QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO QName) -> [Char] -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $
                [Char]
    "STATIC used on ambiguous name " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ AmbiguousQName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow AmbiguousQName
    x
              Expr
    _        -> [Char] -> TCMT IO QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Target of STATIC pragma should be a function"
          [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ QName -> Pragma
    A.StaticPragma QName
    y ]
      toAbstract (C.InjectivePragma Range
    _ QName
    x) = do
          Expr
    e <- OldQName -> ScopeM (AbsOfCon OldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (OldQName -> ScopeM (AbsOfCon OldQName))
    -> OldQName -> ScopeM (AbsOfCon OldQName)
    forall a b. (a -> b) -> a -> b
    $ QName -> Maybe (Set Name) -> OldQName
    OldQName QName
    x Maybe (Set Name)
    forall a. Maybe a
    Nothing
          QName
    y <- case Expr
    e of
              A.Def  QName
    x -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
              A.Proj ProjOrigin
    _ AmbiguousQName
    p | Just QName
    x <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    p -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
              A.Proj ProjOrigin
    _ AmbiguousQName
    x -> [Char] -> TCMT IO QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO QName) -> [Char] -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $
                [Char]
    "INJECTIVE used on ambiguous name " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ AmbiguousQName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow AmbiguousQName
    x
              Expr
    _        -> [Char] -> TCMT IO QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "Target of INJECTIVE pragma should be a defined symbol"
          [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ QName -> Pragma
    A.InjectivePragma QName
    y ]
      toAbstract (C.InlinePragma Range
    _ Bool
    b QName
    x) = do
          Expr
    e <- OldQName -> ScopeM (AbsOfCon OldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (OldQName -> ScopeM (AbsOfCon OldQName))
    -> OldQName -> ScopeM (AbsOfCon OldQName)
    forall a b. (a -> b) -> a -> b
    $ QName -> Maybe (Set Name) -> OldQName
    OldQName QName
    x Maybe (Set Name)
    forall a. Maybe a
    Nothing
          let sINLINE :: [Char]
    sINLINE = if Bool
    b then [Char]
    "INLINE" else [Char]
    "NOINLINE"
          QName
    y <- case Expr
    e of
              A.Def  QName
    x -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
              A.Proj ProjOrigin
    _ AmbiguousQName
    p | Just QName
    x <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    p -> QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
              A.Proj ProjOrigin
    _ AmbiguousQName
    x -> [Char] -> TCMT IO QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO QName) -> [Char] -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $
                [Char]
    sINLINE [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " used on ambiguous name " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ AmbiguousQName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow AmbiguousQName
    x
              Expr
    _        -> [Char] -> TCMT IO QName
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO QName) -> [Char] -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Target of " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    sINLINE [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " pragma should be a function"
          [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Bool -> QName -> Pragma
    A.InlinePragma Bool
    b QName
    y ]
      toAbstract (C.BuiltinPragma Range
    _ RString
    rb QName
    qx)
        | [Char] -> Bool
    isUntypedBuiltin [Char]
    b = do
            ResolvedName
    q <- ResolveQName -> ScopeM (AbsOfCon ResolveQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (ResolveQName -> ScopeM (AbsOfCon ResolveQName))
    -> ResolveQName -> ScopeM (AbsOfCon ResolveQName)
    forall a b. (a -> b) -> a -> b
    $ QName -> ResolveQName
    ResolveQName QName
    qx
            [Char] -> ResolvedName -> TCMT IO ()
    bindUntypedBuiltin [Char]
    b ResolvedName
    q
            [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ RString -> ResolvedName -> Pragma
    A.BuiltinPragma RString
    rb ResolvedName
    q ]
            -- Andreas, 2015-02-14
            -- Some builtins cannot be given a valid Agda type,
            -- thus, they do not come with accompanying postulate or definition.
        | [Char] -> Bool
    isBuiltinNoDef [Char]
    b = do
              case QName
    qx of
                C.QName Name
    x -> do
                  -- The name shouldn't exist yet. If it does, we raise a warning
                  -- and drop the existing definition.
                  TCMT IO Bool -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM ((ResolvedName
    UnknownName ResolvedName -> ResolvedName -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (ResolvedName -> Bool) -> ScopeM ResolvedName -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> ScopeM ResolvedName
    resolveName QName
    qx) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    Doc -> TCMT IO ()
    forall (m :: * -> *). MonadWarning m => Doc -> m ()
    genericWarning (Doc -> TCMT IO ()) -> Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Doc
    P.text ([Char] -> Doc) -> [Char] -> Doc
    forall a b. (a -> b) -> a -> b
    $
                       [Char]
    "BUILTIN " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    b [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " declares an identifier " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                       [Char]
    "(no longer expects an already defined identifier)"
                    (Scope -> Scope) -> TCMT IO ()
    modifyCurrentScope ((Scope -> Scope) -> TCMT IO ()) -> (Scope -> Scope) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ NameSpaceId -> Name -> Scope -> Scope
    removeNameFromScope NameSpaceId
    PublicNS Name
    x
                  -- We then happily bind the name
                  QName
    y <- Name -> TCMT IO QName
    freshAbstractQName' Name
    x
                  let kind :: KindOfName
    kind = KindOfName -> Maybe KindOfName -> KindOfName
    forall a. a -> Maybe a -> a
    fromMaybe KindOfName
    forall a. HasCallStack => a
    __IMPOSSIBLE__ (Maybe KindOfName -> KindOfName) -> Maybe KindOfName -> KindOfName
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe KindOfName
    builtinKindOfName [Char]
    b
                  Access -> KindOfName -> Name -> QName -> TCMT IO ()
    bindName Access
    PublicAccess KindOfName
    kind Name
    x QName
    y
                  [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ RString -> KindOfName -> QName -> Pragma
    A.BuiltinNoDefPragma RString
    rb KindOfName
    kind QName
    y ]
                QName
    _ -> [Char] -> TCMT IO [Pragma]
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO [Pragma]) -> [Char] -> TCMT IO [Pragma]
    forall a b. (a -> b) -> a -> b
    $
                  [Char]
    "Pragma BUILTIN " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    b [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": expected unqualified identifier, " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                  [Char]
    "but found " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    qx
        | Bool
    otherwise = do
              ResolvedName
    q0 <- ResolveQName -> ScopeM (AbsOfCon ResolveQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (ResolveQName -> ScopeM (AbsOfCon ResolveQName))
    -> ResolveQName -> ScopeM (AbsOfCon ResolveQName)
    forall a b. (a -> b) -> a -> b
    $ QName -> ResolveQName
    ResolveQName QName
    qx

              -- Andreas, 2020-04-12, pr #4574.  For highlighting purposes:
              -- Rebind 'BuiltinPrim' as 'PrimName' and similar.
              ResolvedName
    q <- case (ResolvedName
    q0, [Char] -> Maybe KindOfName
    builtinKindOfName [Char]
    b, QName
    qx) of
                (DefinedName Access
    acc AbstractName
    y Suffix
    suffix, Just KindOfName
    kind, C.QName Name
    x)
                  | AbstractName -> KindOfName
    anameKind AbstractName
    y KindOfName -> KindOfName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= KindOfName
    kind
                  , KindOfName
    kind KindOfName -> [KindOfName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ KindOfName
    PrimName, KindOfName
    AxiomName ] -> do
                      Access -> KindOfName -> Name -> QName -> TCMT IO ()
    rebindName Access
    acc KindOfName
    kind Name
    x (QName -> TCMT IO ()) -> QName -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName AbstractName
    y
                      ResolvedName -> ScopeM ResolvedName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ResolvedName -> ScopeM ResolvedName)
    -> ResolvedName -> ScopeM ResolvedName
    forall a b. (a -> b) -> a -> b
    $ Access -> AbstractName -> Suffix -> ResolvedName
    DefinedName Access
    acc AbstractName
    y{ anameKind :: KindOfName
    anameKind = KindOfName
    kind } Suffix
    suffix
                (ResolvedName, Maybe KindOfName, QName)
    _ -> ResolvedName -> ScopeM ResolvedName
    forall (m :: * -> *) a. Monad m => a -> m a
    return ResolvedName
    q0

              [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ RString -> ResolvedName -> Pragma
    A.BuiltinPragma RString
    rb ResolvedName
    q ]
        where b :: [Char]
    b = RString -> [Char]
    forall a. Ranged a -> a
    rangedThing RString
    rb

      toAbstract (C.EtaPragma Range
    _ QName
    x) = do
        Expr
    e <- OldQName -> ScopeM (AbsOfCon OldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (OldQName -> ScopeM (AbsOfCon OldQName))
    -> OldQName -> ScopeM (AbsOfCon OldQName)
    forall a b. (a -> b) -> a -> b
    $ QName -> Maybe (Set Name) -> OldQName
    OldQName QName
    x Maybe (Set Name)
    forall a. Maybe a
    Nothing
        case Expr
    e of
          A.Def QName
    x -> [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ QName -> Pragma
    A.EtaPragma QName
    x ]
          Expr
    _       -> do
           [Char]
    e <- Expr -> TCMT IO [Char]
    forall a (m :: * -> *).
    (ToConcrete a, Show (ConOfAbs a), MonadAbsToCon m) =>
    a -> m [Char]
    showA Expr
    e
           [Char] -> TCMT IO [Pragma]
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO [Pragma]) -> [Char] -> TCMT IO [Pragma]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Pragma ETA: expected identifier, " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
             [Char]
    "but found expression " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    e

      toAbstract (C.DisplayPragma Range
    _ Pattern
    lhs Expr
    rhs) = TCMT IO [Pragma] -> TCMT IO [Pragma]
    forall a. ScopeM a -> ScopeM a
    withLocalVars (TCMT IO [Pragma] -> TCMT IO [Pragma])
    -> TCMT IO [Pragma] -> TCMT IO [Pragma]
    forall a b. (a -> b) -> a -> b
    $ do
        let err :: TCMT IO a
    err = [Char] -> TCMT IO a
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "DISPLAY pragma left-hand side must have form 'f e1 .. en'"
            getHead :: Pattern -> TCMT IO QName
    getHead (C.IdentP QName
    x)          = QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return QName
    x
            getHead (C.RawAppP Range
    _ (List2 Pattern
    p Pattern
    _ [Pattern]
    _)) = Pattern -> TCMT IO QName
    getHead Pattern
    p
            getHead Pattern
    _                     = TCMT IO QName
    forall {a}. TCMT IO a
    err

        QName
    top <- Pattern -> TCMT IO QName
    getHead Pattern
    lhs

        (Bool
    isPatSyn, QName
    hd) <- do
          ResolvedName
    qx <- KindsOfNames -> Maybe (Set Name) -> QName -> ScopeM ResolvedName
    resolveName' KindsOfNames
    allKindsOfNames Maybe (Set Name)
    forall a. Maybe a
    Nothing QName
    top
          case ResolvedName
    qx of
            VarName Name
    x' BindingSource
    _                -> (Bool, QName) -> TCMT IO (Bool, QName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Bool, QName) -> TCMT IO (Bool, QName))
    -> (QName -> (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool
    False,) (QName -> TCMT IO (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall a b. (a -> b) -> a -> b
    $ List1 Name -> QName
    A.qnameFromList (List1 Name -> QName) -> List1 Name -> QName
    forall a b. (a -> b) -> a -> b
    $ Name -> List1 Name
    forall el coll. Singleton el coll => el -> coll
    singleton Name
    x'
            DefinedName Access
    _ AbstractName
    d Suffix
    NoSuffix    -> (Bool, QName) -> TCMT IO (Bool, QName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Bool, QName) -> TCMT IO (Bool, QName))
    -> (QName -> (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool
    False,) (QName -> TCMT IO (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName AbstractName
    d
            DefinedName Access
    _ AbstractName
    d Suffix{}    -> [Char] -> TCMT IO (Bool, QName)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO (Bool, QName))
    -> [Char] -> TCMT IO (Bool, QName)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Invalid pattern " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    top
            FieldName     (AbstractName
    d :| [])     -> (Bool, QName) -> TCMT IO (Bool, QName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Bool, QName) -> TCMT IO (Bool, QName))
    -> (QName -> (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool
    False,) (QName -> TCMT IO (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName AbstractName
    d
            FieldName List1 AbstractName
    ds                -> [Char] -> TCMT IO (Bool, QName)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO (Bool, QName))
    -> [Char] -> TCMT IO (Bool, QName)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Ambiguous projection " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    top [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ NonEmpty QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ((AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds)
            ConstructorName Set Induction
    _ (AbstractName
    d :| []) -> (Bool, QName) -> TCMT IO (Bool, QName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Bool, QName) -> TCMT IO (Bool, QName))
    -> (QName -> (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool
    False,) (QName -> TCMT IO (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName AbstractName
    d
            ConstructorName Set Induction
    _ List1 AbstractName
    ds        -> [Char] -> TCMT IO (Bool, QName)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO (Bool, QName))
    -> [Char] -> TCMT IO (Bool, QName)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Ambiguous constructor " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    top [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ NonEmpty QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ((AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds)
            ResolvedName
    UnknownName                 -> QName -> TCMT IO (Bool, QName)
    forall a. QName -> TCM a
    notInScopeError QName
    top
            PatternSynResName (AbstractName
    d :| []) -> (Bool, QName) -> TCMT IO (Bool, QName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Bool, QName) -> TCMT IO (Bool, QName))
    -> (QName -> (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool
    True,) (QName -> TCMT IO (Bool, QName)) -> QName -> TCMT IO (Bool, QName)
    forall a b. (a -> b) -> a -> b
    $ AbstractName -> QName
    anameName AbstractName
    d
            PatternSynResName List1 AbstractName
    ds        -> [Char] -> TCMT IO (Bool, QName)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO (Bool, QName))
    -> [Char] -> TCMT IO (Bool, QName)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Ambiguous pattern synonym" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    top [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ NonEmpty QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow ((AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds)

        LHS
    lhs <- LeftHandSide -> ScopeM (AbsOfCon LeftHandSide)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (LeftHandSide -> ScopeM (AbsOfCon LeftHandSide))
    -> LeftHandSide -> ScopeM (AbsOfCon LeftHandSide)
    forall a b. (a -> b) -> a -> b
    $ QName -> Pattern -> LeftHandSide
    LeftHandSide QName
    top Pattern
    lhs
        [NamedArg Pattern]
    ps  <- case LHS
    lhs of
                 A.LHS LHSInfo
    _ (A.LHSHead QName
    _ [NamedArg Pattern]
    ps) -> [NamedArg Pattern] -> TCMT IO [NamedArg Pattern]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [NamedArg Pattern]
    ps
                 LHS
    _ -> TCMT IO [NamedArg Pattern]
    forall {a}. TCMT IO a
    err

        -- Andreas, 2016-08-08, issue #2132
        -- Remove pattern synonyms on lhs
        (QName
    hd, [NamedArg Pattern]
    ps) <- do
          let mkP :: [NamedArg Pattern] -> Pattern
    mkP | Bool
    isPatSyn  = PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.PatternSynP (Range -> PatInfo
    PatRange (Range -> PatInfo) -> Range -> PatInfo
    forall a b. (a -> b) -> a -> b
    $ LHS -> Range
    forall a. HasRange a => a -> Range
    getRange LHS
    lhs) (QName -> AmbiguousQName
    unambiguous QName
    hd)
                  | Bool
    otherwise = PatInfo -> AmbiguousQName -> [NamedArg Pattern] -> Pattern
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.DefP (Range -> PatInfo
    PatRange (Range -> PatInfo) -> Range -> PatInfo
    forall a b. (a -> b) -> a -> b
    $ LHS -> Range
    forall a. HasRange a => a -> Range
    getRange LHS
    lhs) (QName -> AmbiguousQName
    unambiguous QName
    hd)
          Pattern
    p <- Pattern -> TCMT IO Pattern
    forall a. ExpandPatternSynonyms a => a -> TCM a
    expandPatternSynonyms (Pattern -> TCMT IO Pattern) -> Pattern -> TCMT IO Pattern
    forall a b. (a -> b) -> a -> b
    $ [NamedArg Pattern] -> Pattern
    mkP [NamedArg Pattern]
    ps
          case Pattern
    p of
            A.DefP PatInfo
    _ AmbiguousQName
    f [NamedArg Pattern]
    ps | Just QName
    hd <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    f -> (QName, [NamedArg Pattern]) -> TCMT IO (QName, [NamedArg Pattern])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName
    hd, [NamedArg Pattern]
    ps)
            A.ConP ConPatInfo
    _ AmbiguousQName
    c [NamedArg Pattern]
    ps | Just QName
    hd <- AmbiguousQName -> Maybe QName
    getUnambiguous AmbiguousQName
    c -> (QName, [NamedArg Pattern]) -> TCMT IO (QName, [NamedArg Pattern])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName
    hd, [NamedArg Pattern]
    ps)
            A.PatternSynP{} -> TCMT IO (QName, [NamedArg Pattern])
    forall a. HasCallStack => a
    __IMPOSSIBLE__
            Pattern
    _ -> TCMT IO (QName, [NamedArg Pattern])
    forall {a}. TCMT IO a
    err

        Expr
    rhs <- Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    rhs
        [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [QName -> [NamedArg Pattern] -> Expr -> Pragma
    A.DisplayPragma QName
    hd [NamedArg Pattern]
    ps Expr
    rhs]

      -- A warning attached to an ambiguous name shall apply to all disambiguations.
      toAbstract (C.WarningOnUsage Range
    _ QName
    x Text
    str) = do
        NonEmpty QName
    ys <- (AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName (List1 AbstractName -> NonEmpty QName)
    -> ScopeM (List1 AbstractName) -> TCMT IO (NonEmpty QName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> QName -> ScopeM (List1 AbstractName)
    forall a. ToQName a => a -> ScopeM (List1 AbstractName)
    toAbstractExistingName QName
    x
        NonEmpty QName -> (QName -> TCMT IO ()) -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ NonEmpty QName
    ys ((QName -> TCMT IO ()) -> TCMT IO ())
    -> (QName -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ QName
    qn -> Lens' (Map QName Text) TCState
    stLocalUserWarnings Lens' (Map QName Text) TCState
    -> (Map QName Text -> Map QName Text) -> TCMT IO ()
    forall (m :: * -> *) a.
    MonadTCState m =>
    Lens' a TCState -> (a -> a) -> m ()
    `modifyTCLens` QName -> Text -> Map QName Text -> Map QName Text
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert QName
    qn Text
    str
        [Pragma] -> TCMT IO [Pragma]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

      toAbstract (C.WarningOnImport Range
    _ Text
    str) = do
        Lens' (Maybe Text) TCState
    stWarningOnImport Lens' (Maybe Text) TCState -> Maybe Text -> TCMT IO ()
    forall (m :: * -> *) a.
    MonadTCState m =>
    Lens' a TCState -> a -> m ()
    `setTCLens` Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    str
        [Pragma] -> TCMT IO [Pragma]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []

      -- Termination, Coverage, Positivity, Universe, and Catchall
      -- pragmes are handled by the nicifier
      toAbstract C.TerminationCheckPragma{}  = ScopeM (AbsOfCon Pragma)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract C.NoCoverageCheckPragma{}   = ScopeM (AbsOfCon Pragma)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract C.NoPositivityCheckPragma{} = ScopeM (AbsOfCon Pragma)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract C.NoUniverseCheckPragma{}   = ScopeM (AbsOfCon Pragma)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract C.CatchallPragma{}          = ScopeM (AbsOfCon Pragma)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

      -- Polarity pragmas are handled by the niceifier.
      toAbstract C.PolarityPragma{} = ScopeM (AbsOfCon Pragma)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    instance ToAbstract C.Clause where
      type AbsOfCon C.Clause = A.Clause

      toAbstract :: Clause -> ScopeM (AbsOfCon Clause)
    toAbstract (C.Clause Name
    top Bool
    catchall lhs :: LHS
    lhs@(C.LHS Pattern
    p [RewriteEqn]
    eqs [WithExpr]
    with) RHS' Expr
    rhs WhereClause' [Declaration]
    wh [Clause]
    wcs) = ScopeM Clause -> ScopeM Clause
    forall a. ScopeM a -> ScopeM a
    withLocalVars (ScopeM Clause -> ScopeM Clause) -> ScopeM Clause -> ScopeM Clause
    forall a b. (a -> b) -> a -> b
    $ do
        -- Jesper, 2018-12-10, #3095: pattern variables bound outside the
        -- module are locally treated as module parameters
        (ScopeInfo -> ScopeInfo) -> TCMT IO ()
    forall (m :: * -> *).
    MonadTCState m =>
    (ScopeInfo -> ScopeInfo) -> m ()
    modifyScope_ ((ScopeInfo -> ScopeInfo) -> TCMT IO ())
    -> (ScopeInfo -> ScopeInfo) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ ([(Name, LocalVar)] -> [(Name, LocalVar)])
    -> ScopeInfo -> ScopeInfo
    updateScopeLocals (([(Name, LocalVar)] -> [(Name, LocalVar)])
     -> ScopeInfo -> ScopeInfo)
    -> ([(Name, LocalVar)] -> [(Name, LocalVar)])
    -> ScopeInfo
    -> ScopeInfo
    forall a b. (a -> b) -> a -> b
    $ ((Name, LocalVar) -> (Name, LocalVar))
    -> [(Name, LocalVar)] -> [(Name, LocalVar)]
    forall a b. (a -> b) -> [a] -> [b]
    map (((Name, LocalVar) -> (Name, LocalVar))
     -> [(Name, LocalVar)] -> [(Name, LocalVar)])
    -> ((Name, LocalVar) -> (Name, LocalVar))
    -> [(Name, LocalVar)]
    -> [(Name, LocalVar)]
    forall a b. (a -> b) -> a -> b
    $ (LocalVar -> LocalVar) -> (Name, LocalVar) -> (Name, LocalVar)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second LocalVar -> LocalVar
    patternToModuleBound
        -- Andreas, 2012-02-14: need to reset local vars before checking subclauses
        [(Name, LocalVar)]
    vars0 <- TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
        LHS
    lhs' <- LeftHandSide -> ScopeM (AbsOfCon LeftHandSide)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (LeftHandSide -> ScopeM (AbsOfCon LeftHandSide))
    -> LeftHandSide -> ScopeM (AbsOfCon LeftHandSide)
    forall a b. (a -> b) -> a -> b
    $ QName -> Pattern -> LeftHandSide
    LeftHandSide (Name -> QName
    C.QName Name
    top) Pattern
    p
        Int -> [Char] -> TCMT IO ()
    printLocals Int
    10 [Char]
    "after lhs:"
        [(Name, LocalVar)]
    vars1 <- TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
        [RewriteEqn' () BindName Pattern Expr]
    eqs <- (RewriteEqn -> TCMT IO (RewriteEqn' () BindName Pattern Expr))
    -> [RewriteEqn] -> TCMT IO [RewriteEqn' () BindName Pattern Expr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Precedence -> RewriteEqn -> ScopeM (AbsOfCon RewriteEqn)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx) [RewriteEqn]
    eqs
        [(Name, LocalVar)]
    vars2 <- TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
        let vars :: [(Name, LocalVar)]
    vars = Int -> [(Name, LocalVar)] -> [(Name, LocalVar)]
    forall a. Int -> [a] -> [a]
    dropEnd ([(Name, LocalVar)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Name, LocalVar)]
    vars1) [(Name, LocalVar)]
    vars2 [(Name, LocalVar)] -> [(Name, LocalVar)] -> [(Name, LocalVar)]
    forall a. [a] -> [a] -> [a]
    ++ [(Name, LocalVar)]
    vars0
        let wcs' :: ([(Name, LocalVar)], [Clause])
    wcs' = ([(Name, LocalVar)]
    vars, [Clause]
    wcs)

        -- Handle rewrite equations first.
        if Bool -> Bool
    not ([RewriteEqn' () BindName Pattern Expr] -> Bool
    forall a. Null a => a -> Bool
    null [RewriteEqn' () BindName Pattern Expr]
    eqs)
          then do
            AbstractRHS
    rhs <- Precedence -> RightHandSide -> ScopeM (AbsOfCon RightHandSide)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx (RightHandSide -> ScopeM (AbsOfCon RightHandSide))
    -> RightHandSide -> ScopeM (AbsOfCon RightHandSide)
    forall a b. (a -> b) -> a -> b
    $ [RewriteEqn' () BindName Pattern Expr]
    -> [WithExpr]
    -> ([(Name, LocalVar)], [Clause])
    -> RHS' Expr
    -> WhereClause' [Declaration]
    -> RightHandSide
    RightHandSide [RewriteEqn' () BindName Pattern Expr]
    eqs [WithExpr]
    with ([(Name, LocalVar)], [Clause])
    wcs' RHS' Expr
    rhs WhereClause' [Declaration]
    wh
            RHS
    rhs <- AbstractRHS -> ScopeM (AbsOfCon AbstractRHS)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract AbstractRHS
    rhs
            Clause -> ScopeM Clause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Clause -> ScopeM Clause) -> Clause -> ScopeM Clause
    forall a b. (a -> b) -> a -> b
    $ LHS -> [ProblemEq] -> RHS -> WhereDeclarations -> Bool -> Clause
    forall lhs.
    lhs
    -> [ProblemEq] -> RHS -> WhereDeclarations -> Bool -> Clause' lhs
    A.Clause LHS
    lhs' [] RHS
    rhs WhereDeclarations
    A.noWhereDecls Bool
    catchall
          else do
            -- the right hand side is checked with the module of the local definitions opened
            (AbstractRHS
    rhs, WhereDeclarations
    ds) <- Range
    -> WhereClause' [Declaration]
    -> TCMT IO AbstractRHS
    -> ScopeM (AbstractRHS, WhereDeclarations)
    forall a.
    Range
    -> WhereClause' [Declaration]
    -> ScopeM a
    -> ScopeM (a, WhereDeclarations)
    whereToAbstract (WhereClause' [Declaration] -> Range
    forall a. HasRange a => a -> Range
    getRange WhereClause' [Declaration]
    wh) WhereClause' [Declaration]
    wh (TCMT IO AbstractRHS -> ScopeM (AbstractRHS, WhereDeclarations))
    -> TCMT IO AbstractRHS -> ScopeM (AbstractRHS, WhereDeclarations)
    forall a b. (a -> b) -> a -> b
    $
                           Precedence -> RightHandSide -> ScopeM (AbsOfCon RightHandSide)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx (RightHandSide -> ScopeM (AbsOfCon RightHandSide))
    -> RightHandSide -> ScopeM (AbsOfCon RightHandSide)
    forall a b. (a -> b) -> a -> b
    $ [RewriteEqn' () BindName Pattern Expr]
    -> [WithExpr]
    -> ([(Name, LocalVar)], [Clause])
    -> RHS' Expr
    -> WhereClause' [Declaration]
    -> RightHandSide
    RightHandSide [] [WithExpr]
    with ([(Name, LocalVar)], [Clause])
    wcs' RHS' Expr
    rhs WhereClause' [Declaration]
    forall decls. WhereClause' decls
    NoWhere
            RHS
    rhs <- AbstractRHS -> ScopeM (AbsOfCon AbstractRHS)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract AbstractRHS
    rhs
            Clause -> ScopeM Clause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Clause -> ScopeM Clause) -> Clause -> ScopeM Clause
    forall a b. (a -> b) -> a -> b
    $ LHS -> [ProblemEq] -> RHS -> WhereDeclarations -> Bool -> Clause
    forall lhs.
    lhs
    -> [ProblemEq] -> RHS -> WhereDeclarations -> Bool -> Clause' lhs
    A.Clause LHS
    lhs' [] RHS
    rhs WhereDeclarations
    ds Bool
    catchall

    whereToAbstract
      :: Range                            -- ^ The range of the @where@ block.
      -> C.WhereClause                    -- ^ The @where@ block.
      -> ScopeM a                         -- ^ The scope-checking task to be run in the context of the @where@ module.
      -> ScopeM (a, A.WhereDeclarations)  -- ^ Additionally return the scope-checked contents of the @where@ module.
    whereToAbstract :: forall a.
    Range
    -> WhereClause' [Declaration]
    -> ScopeM a
    -> ScopeM (a, WhereDeclarations)
    whereToAbstract Range
    r WhereClause' [Declaration]
    wh ScopeM a
    inner = do
      case WhereClause' [Declaration]
    wh of
        WhereClause' [Declaration]
    NoWhere       -> ScopeM (a, WhereDeclarations)
    ret
        AnyWhere Range
    _ [] -> ScopeM (a, WhereDeclarations)
    warnEmptyWhere
        AnyWhere Range
    _ [Declaration]
    ds -> do
          -- Andreas, 2016-07-17 issues #2081 and #2101
          -- where-declarations are automatically private.
          -- This allows their type signature to be checked InAbstractMode.
          Range
    -> Maybe (Name, Access)
    -> List1 Declaration
    -> ScopeM a
    -> ScopeM (a, WhereDeclarations)
    forall a.
    Range
    -> Maybe (Name, Access)
    -> List1 Declaration
    -> ScopeM a
    -> ScopeM (a, WhereDeclarations)
    whereToAbstract1 Range
    r Maybe (Name, Access)
    forall a. Maybe a
    Nothing (Declaration -> List1 Declaration
    forall el coll. Singleton el coll => el -> coll
    singleton (Declaration -> List1 Declaration)
    -> Declaration -> List1 Declaration
    forall a b. (a -> b) -> a -> b
    $ Range -> Origin -> [Declaration] -> Declaration
    C.Private Range
    forall a. Range' a
    noRange Origin
    Inserted [Declaration]
    ds) ScopeM a
    inner
        SomeWhere Range
    _ Name
    m Access
    a [Declaration]
    ds0 -> [Declaration]
    -> ScopeM (a, WhereDeclarations)
    -> (List1 Declaration -> ScopeM (a, WhereDeclarations))
    -> ScopeM (a, WhereDeclarations)
    forall a b. [a] -> b -> (List1 a -> b) -> b
    List1.ifNull [Declaration]
    ds0 ScopeM (a, WhereDeclarations)
    warnEmptyWhere {-else-} ((List1 Declaration -> ScopeM (a, WhereDeclarations))
     -> ScopeM (a, WhereDeclarations))
    -> (List1 Declaration -> ScopeM (a, WhereDeclarations))
    -> ScopeM (a, WhereDeclarations)
    forall a b. (a -> b) -> a -> b
    $ \ List1 Declaration
    ds -> do
          -- Named where-modules do not default to private.
          Range
    -> Maybe (Name, Access)
    -> List1 Declaration
    -> ScopeM a
    -> ScopeM (a, WhereDeclarations)
    forall a.
    Range
    -> Maybe (Name, Access)
    -> List1 Declaration
    -> ScopeM a
    -> ScopeM (a, WhereDeclarations)
    whereToAbstract1 Range
    r ((Name, Access) -> Maybe (Name, Access)
    forall a. a -> Maybe a
    Just (Name
    m, Access
    a)) List1 Declaration
    ds ScopeM a
    inner
      where
      ret :: ScopeM (a, WhereDeclarations)
    ret = (,WhereDeclarations
    A.noWhereDecls) (a -> (a, WhereDeclarations))
    -> ScopeM a -> ScopeM (a, WhereDeclarations)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ScopeM a
    inner
      warnEmptyWhere :: ScopeM (a, WhereDeclarations)
    warnEmptyWhere = do
        Range -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Range
    r (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning Warning
    EmptyWhere
        ScopeM (a, WhereDeclarations)
    ret

    whereToAbstract1
      :: Range                            -- ^ The range of the @where@-block.
      -> Maybe (C.Name, Access)           -- ^ The name of the @where@ module (if any).
      -> List1 C.Declaration              -- ^ The contents of the @where@ module.
      -> ScopeM a                         -- ^ The scope-checking task to be run in the context of the @where@ module.
      -> ScopeM (a, A.WhereDeclarations)  -- ^ Additionally return the scope-checked contents of the @where@ module.
    whereToAbstract1 :: forall a.
    Range
    -> Maybe (Name, Access)
    -> List1 Declaration
    -> ScopeM a
    -> ScopeM (a, WhereDeclarations)
    whereToAbstract1 Range
    r Maybe (Name, Access)
    whname List1 Declaration
    whds ScopeM a
    inner = do
      -- ASR (16 November 2015) Issue 1137: We ban termination
      -- pragmas inside `where` clause.
      WhereOrRecord -> List1 Declaration -> TCMT IO ()
    forall (f :: * -> *).
    Foldable f =>
    WhereOrRecord -> f Declaration -> TCMT IO ()
    checkNoTerminationPragma WhereOrRecord
    InWhereBlock List1 Declaration
    whds

      -- Create a fresh concrete name if there isn't (a proper) one.
      (Name
    m, Access
    acc) <- do
        case Maybe (Name, Access)
    whname of
          Just (Name
    m, Access
    acc) | Bool -> Bool
    not (Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName Name
    m) -> (Name, Access) -> TCMT IO (Name, Access)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    m, Access
    acc)
          Maybe (Name, Access)
    _ -> TCMT IO NameId
    forall i (m :: * -> *). MonadFresh i m => m i
    fresh TCMT IO NameId
    -> (NameId -> (Name, Access)) -> TCMT IO (Name, Access)
    forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    <&> \ NameId
    x -> (Range -> NameId -> Name
    C.NoName (Maybe (Name, Access) -> Range
    forall a. HasRange a => a -> Range
    getRange Maybe (Name, Access)
    whname) NameId
    x, Origin -> Access
    PrivateAccess Origin
    Inserted)
               -- unnamed where's are private
      ModuleName
    old <- TCMT IO ModuleName
    forall (m :: * -> *). ReadTCState m => m ModuleName
    getCurrentModule
      ModuleName
    am  <- NewModuleName -> ScopeM (AbsOfCon NewModuleName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Name -> NewModuleName
    NewModuleName Name
    m)
      (ScopeInfo
    scope, Declaration
    d) <- Range
    -> QName
    -> ModuleName
    -> Telescope
    -> ScopeM [Declaration]
    -> TCMT IO (ScopeInfo, Declaration)
    scopeCheckModule Range
    r (Name -> QName
    C.QName Name
    m) ModuleName
    am [] (ScopeM [Declaration] -> TCMT IO (ScopeInfo, Declaration))
    -> ScopeM [Declaration] -> TCMT IO (ScopeInfo, Declaration)
    forall a b. (a -> b) -> a -> b
    $ Declarations -> ScopeM (AbsOfCon Declarations)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Declarations -> ScopeM (AbsOfCon Declarations))
    -> Declarations -> ScopeM (AbsOfCon Declarations)
    forall a b. (a -> b) -> a -> b
    $ [Declaration] -> Declarations
    Declarations ([Declaration] -> Declarations) -> [Declaration] -> Declarations
    forall a b. (a -> b) -> a -> b
    $ List1 Declaration -> [Declaration]
    forall a. NonEmpty a -> [a]
    List1.toList List1 Declaration
    whds
      ScopeInfo -> TCMT IO ()
    setScope ScopeInfo
    scope
      a
    x <- ScopeM a
    inner
      ModuleName -> TCMT IO ()
    forall (m :: * -> *). MonadTCState m => ModuleName -> m ()
    setCurrentModule ModuleName
    old
      Access -> Name -> ModuleName -> TCMT IO ()
    bindModule Access
    acc Name
    m ModuleName
    am
      -- Issue 848: if the module was anonymous (module _ where) open it public
      let anonymousSomeWhere :: Bool
    anonymousSomeWhere = Bool -> ((Name, Access) -> Bool) -> Maybe (Name, Access) -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Name -> Bool
    forall a. IsNoName a => a -> Bool
    isNoName (Name -> Bool)
    -> ((Name, Access) -> Name) -> (Name, Access) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, Access) -> Name
    forall a b. (a, b) -> a
    fst) Maybe (Name, Access)
    whname
      Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    anonymousSomeWhere (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
       TCMT IO ImportDirective -> TCMT IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (TCMT IO ImportDirective -> TCMT IO ())
    -> TCMT IO ImportDirective -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ -- We can ignore the returned default A.ImportDirective.
        OpenKind
    -> Maybe ModuleName
    -> QName
    -> ImportDirective
    -> TCMT IO ImportDirective
    openModule OpenKind
    TopOpenModule (ModuleName -> Maybe ModuleName
    forall a. a -> Maybe a
    Just ModuleName
    am) (Name -> QName
    C.QName Name
    m) (ImportDirective -> TCMT IO ImportDirective)
    -> ImportDirective -> TCMT IO ImportDirective
    forall a b. (a -> b) -> a -> b
    $
          ImportDirective
    forall n m. ImportDirective' n m
    defaultImportDir { publicOpen :: Maybe Range
    publicOpen = Range -> Maybe Range
    forall a. a -> Maybe a
    Just Range
    forall a. Range' a
    noRange }
      (a, WhereDeclarations) -> ScopeM (a, WhereDeclarations)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    x, Maybe ModuleName -> Maybe Declaration -> WhereDeclarations
    A.WhereDecls (ModuleName
    am ModuleName -> Maybe (Name, Access) -> Maybe ModuleName
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Maybe (Name, Access)
    whname) (Maybe Declaration -> WhereDeclarations)
    -> Maybe Declaration -> WhereDeclarations
    forall a b. (a -> b) -> a -> b
    $ Declaration -> Maybe Declaration
    forall el coll. Singleton el coll => el -> coll
    singleton Declaration
    d)

    data TerminationOrPositivity = Termination | Positivity
      deriving (Int -> TerminationOrPositivity -> [Char] -> [Char]
    [TerminationOrPositivity] -> [Char] -> [Char]
    TerminationOrPositivity -> [Char]
    (Int -> TerminationOrPositivity -> [Char] -> [Char])
    -> (TerminationOrPositivity -> [Char])
    -> ([TerminationOrPositivity] -> [Char] -> [Char])
    -> Show TerminationOrPositivity
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    showList :: [TerminationOrPositivity] -> [Char] -> [Char]
    $cshowList :: [TerminationOrPositivity] -> [Char] -> [Char]
    show :: TerminationOrPositivity -> [Char]
    $cshow :: TerminationOrPositivity -> [Char]
    showsPrec :: Int -> TerminationOrPositivity -> [Char] -> [Char]
    $cshowsPrec :: Int -> TerminationOrPositivity -> [Char] -> [Char]
    Show)

    data WhereOrRecord = InWhereBlock | InRecordDef

    checkNoTerminationPragma :: Foldable f => WhereOrRecord -> f C.Declaration -> ScopeM ()
    checkNoTerminationPragma :: forall (f :: * -> *).
    Foldable f =>
    WhereOrRecord -> f Declaration -> TCMT IO ()
    checkNoTerminationPragma WhereOrRecord
    b f Declaration
    ds =
      ((TerminationOrPositivity, Range) -> TCMT IO ())
    -> [(TerminationOrPositivity, Range)] -> TCMT IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\ (TerminationOrPositivity
    p, Range
    r) -> Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning (Warning -> TCMT IO ()) -> Warning -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Range -> Doc -> Warning
    GenericUseless Range
    r (Doc -> Warning) -> Doc -> Warning
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    P.vcat [ [Char] -> Doc
    P.text ([Char] -> Doc) -> [Char] -> Doc
    forall a b. (a -> b) -> a -> b
    $ TerminationOrPositivity -> [Char]
    forall a. Show a => a -> [Char]
    show TerminationOrPositivity
    p [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " pragmas are ignored in " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ WhereOrRecord -> [Char]
    forall {p}. IsString p => WhereOrRecord -> p
    what WhereOrRecord
    b
                                                             , [Char] -> Doc
    P.text ([Char] -> Doc) -> [Char] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "(see " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ WhereOrRecord -> [Char]
    issue WhereOrRecord
    b [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")" ])
            ((Declaration -> [(TerminationOrPositivity, Range)])
    -> f Declaration -> [(TerminationOrPositivity, Range)]
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas f Declaration
    ds)
      where
        what :: WhereOrRecord -> p
    what WhereOrRecord
    InWhereBlock = p
    "where clauses"
        what WhereOrRecord
    InRecordDef  = p
    "record definitions"
        github :: a -> [Char]
    github a
    n = [Char]
    "https://github.com/agda/agda/issues/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    n
        issue :: WhereOrRecord -> [Char]
    issue WhereOrRecord
    InWhereBlock = Integer -> [Char]
    forall a. Show a => a -> [Char]
    github Integer
    3355
        issue WhereOrRecord
    InRecordDef  = Integer -> [Char]
    forall a. Show a => a -> [Char]
    github Integer
    3008

    terminationPragmas :: C.Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas :: Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas (C.Private  Range
    _ Origin
    _      [Declaration]
    ds) = (Declaration -> [(TerminationOrPositivity, Range)])
    -> [Declaration] -> [(TerminationOrPositivity, Range)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas [Declaration]
    ds
    terminationPragmas (C.Abstract Range
    _        [Declaration]
    ds) = (Declaration -> [(TerminationOrPositivity, Range)])
    -> [Declaration] -> [(TerminationOrPositivity, Range)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas [Declaration]
    ds
    terminationPragmas (C.InstanceB Range
    _       [Declaration]
    ds) = (Declaration -> [(TerminationOrPositivity, Range)])
    -> [Declaration] -> [(TerminationOrPositivity, Range)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas [Declaration]
    ds
    terminationPragmas (C.Mutual Range
    _          [Declaration]
    ds) = (Declaration -> [(TerminationOrPositivity, Range)])
    -> [Declaration] -> [(TerminationOrPositivity, Range)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas [Declaration]
    ds
    terminationPragmas (C.Module Range
    _ QName
    _ Telescope
    _      [Declaration]
    ds) = (Declaration -> [(TerminationOrPositivity, Range)])
    -> [Declaration] -> [(TerminationOrPositivity, Range)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas [Declaration]
    ds
    terminationPragmas (C.Macro Range
    _           [Declaration]
    ds) = (Declaration -> [(TerminationOrPositivity, Range)])
    -> [Declaration] -> [(TerminationOrPositivity, Range)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas [Declaration]
    ds
    terminationPragmas (C.Record Range
    _ Name
    _ RecordDirectives
    _ [LamBinding' TypedBinding]
    _ Expr
    _  [Declaration]
    ds) = (Declaration -> [(TerminationOrPositivity, Range)])
    -> [Declaration] -> [(TerminationOrPositivity, Range)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas [Declaration]
    ds
    terminationPragmas (C.RecordDef Range
    _ Name
    _ RecordDirectives
    _ [LamBinding' TypedBinding]
    _ [Declaration]
    ds) = (Declaration -> [(TerminationOrPositivity, Range)])
    -> [Declaration] -> [(TerminationOrPositivity, Range)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Declaration -> [(TerminationOrPositivity, Range)]
    terminationPragmas [Declaration]
    ds
    terminationPragmas (C.Pragma (TerminationCheckPragma Range
    r TerminationCheck
    _)) = [(TerminationOrPositivity
    Termination, Range
    r)]
    terminationPragmas (C.Pragma (NoPositivityCheckPragma Range
    r))  = [(TerminationOrPositivity
    Positivity, Range
    r)]
    terminationPragmas Declaration
    _                                       = []

    data RightHandSide = RightHandSide
      { RightHandSide -> [RewriteEqn' () BindName Pattern Expr]
    _rhsRewriteEqn :: [RewriteEqn' () A.BindName A.Pattern A.Expr]
        -- ^ @rewrite e | with p <- e in eq@ (many)
      , RightHandSide -> [WithExpr]
    _rhsWithExpr   :: [C.WithExpr]
        -- ^ @with e@ (many)
      , RightHandSide -> ([(Name, LocalVar)], [Clause])
    _rhsSubclauses :: (LocalVars, [C.Clause])
        -- ^ the subclauses spawned by a with (monadic because we need to reset the local vars before checking these clauses)
      , RightHandSide -> RHS' Expr
    _rhs           :: C.RHS
      , RightHandSide -> WhereClause' [Declaration]
    _rhsWhere      :: WhereClause
          -- ^ @where@ module.
      }

    data AbstractRHS
      = AbsurdRHS'
      | WithRHS' [A.WithExpr] [ScopeM C.Clause]
        -- ^ The with clauses haven't been translated yet
      | RHS' A.Expr C.Expr
      | RewriteRHS' [RewriteEqn' () A.BindName A.Pattern A.Expr] AbstractRHS A.WhereDeclarations

    qualifyName_ :: A.Name -> ScopeM A.QName
    qualifyName_ :: Name -> TCMT IO QName
    qualifyName_ Name
    x = do
      ModuleName
    m <- TCMT IO ModuleName
    forall (m :: * -> *). ReadTCState m => m ModuleName
    getCurrentModule
      QName -> TCMT IO QName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> TCMT IO QName) -> QName -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> Name -> QName
    A.qualify ModuleName
    m Name
    x

    withFunctionName :: String -> ScopeM A.QName
    withFunctionName :: [Char] -> TCMT IO QName
    withFunctionName [Char]
    s = do
      NameId Word64
    i ModuleNameHash
    _ <- TCMT IO NameId
    forall i (m :: * -> *). MonadFresh i m => m i
    fresh
      Name -> TCMT IO QName
    qualifyName_ (Name -> TCMT IO QName) -> ScopeM Name -> TCMT IO QName
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [Char] -> ScopeM Name
    forall a (m :: * -> *).
    (FreshName a, MonadFresh NameId m) =>
    a -> m Name
    freshName_ ([Char]
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Word64 -> [Char]
    forall a. Show a => a -> [Char]
    show Word64
    i)

    instance ToAbstract (RewriteEqn' () A.BindName A.Pattern A.Expr) where
      type AbsOfCon (RewriteEqn' () A.BindName A.Pattern A.Expr) = A.RewriteEqn
      toAbstract :: RewriteEqn' () BindName Pattern Expr
    -> ScopeM (AbsOfCon (RewriteEqn' () BindName Pattern Expr))
    toAbstract = \case
        Rewrite List1 ((), Expr)
    es -> (List1 (QName, Expr) -> RewriteEqn' QName BindName Pattern Expr)
    -> TCMT IO (List1 (QName, Expr))
    -> TCMT IO (RewriteEqn' QName BindName Pattern Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap List1 (QName, Expr) -> RewriteEqn' QName BindName Pattern Expr
    forall qn nm p e. List1 (qn, e) -> RewriteEqn' qn nm p e
    Rewrite (TCMT IO (List1 (QName, Expr))
     -> TCMT IO (RewriteEqn' QName BindName Pattern Expr))
    -> TCMT IO (List1 (QName, Expr))
    -> TCMT IO (RewriteEqn' QName BindName Pattern Expr)
    forall a b. (a -> b) -> a -> b
    $ List1 ((), Expr)
    -> (((), Expr) -> TCMT IO (QName, Expr))
    -> TCMT IO (List1 (QName, Expr))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM List1 ((), Expr)
    es ((((), Expr) -> TCMT IO (QName, Expr))
     -> TCMT IO (List1 (QName, Expr)))
    -> (((), Expr) -> TCMT IO (QName, Expr))
    -> TCMT IO (List1 (QName, Expr))
    forall a b. (a -> b) -> a -> b
    $ \ (()
    _, Expr
    e) -> do
          QName
    qn <- [Char] -> TCMT IO QName
    withFunctionName [Char]
    "-rewrite"
          (QName, Expr) -> TCMT IO (QName, Expr)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (QName
    qn, Expr
    e)
        Invert ()
    _ List1 (Named BindName (Pattern, Expr))
    pes -> do
          QName
    qn <- [Char] -> TCMT IO QName
    withFunctionName [Char]
    "-invert"
          RewriteEqn' QName BindName Pattern Expr
    -> TCMT IO (RewriteEqn' QName BindName Pattern Expr)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (RewriteEqn' QName BindName Pattern Expr
     -> TCMT IO (RewriteEqn' QName BindName Pattern Expr))
    -> RewriteEqn' QName BindName Pattern Expr
    -> TCMT IO (RewriteEqn' QName BindName Pattern Expr)
    forall a b. (a -> b) -> a -> b
    $ QName
    -> List1 (Named BindName (Pattern, Expr))
    -> RewriteEqn' QName BindName Pattern Expr
    forall qn nm p e.
    qn -> List1 (Named nm (p, e)) -> RewriteEqn' qn nm p e
    Invert QName
    qn List1 (Named BindName (Pattern, Expr))
    pes

    instance ToAbstract C.RewriteEqn where
      type AbsOfCon C.RewriteEqn = RewriteEqn' () A.BindName A.Pattern A.Expr
      toAbstract :: RewriteEqn -> ScopeM (AbsOfCon RewriteEqn)
    toAbstract = \case
        Rewrite List1 ((), Expr)
    es   -> List1 ((), Expr) -> RewriteEqn' () BindName Pattern Expr
    forall qn nm p e. List1 (qn, e) -> RewriteEqn' qn nm p e
    Rewrite (List1 ((), Expr) -> RewriteEqn' () BindName Pattern Expr)
    -> TCMT IO (List1 ((), Expr))
    -> TCMT IO (RewriteEqn' () BindName Pattern Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (((), Expr) -> TCMT IO ((), Expr))
    -> List1 ((), Expr) -> TCMT IO (List1 ((), Expr))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((), Expr) -> TCMT IO ((), Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract List1 ((), Expr)
    es
        Invert ()
    _ List1 (Named Name (Pattern, Expr))
    npes -> ()
    -> List1 (Named BindName (Pattern, Expr))
    -> RewriteEqn' () BindName Pattern Expr
    forall qn nm p e.
    qn -> List1 (Named nm (p, e)) -> RewriteEqn' qn nm p e
    Invert () (List1 (Named BindName (Pattern, Expr))
     -> RewriteEqn' () BindName Pattern Expr)
    -> TCMT IO (List1 (Named BindName (Pattern, Expr)))
    -> TCMT IO (RewriteEqn' () BindName Pattern Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
          -- Given a list of irrefutable with expressions of the form @p <- e in q@
          let (NonEmpty (Maybe Name, Pattern)
    nps, List1 Expr
    es) = NonEmpty ((Maybe Name, Pattern), Expr)
    -> (NonEmpty (Maybe Name, Pattern), List1 Expr)
    forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
    List1.unzip
                        (NonEmpty ((Maybe Name, Pattern), Expr)
     -> (NonEmpty (Maybe Name, Pattern), List1 Expr))
    -> NonEmpty ((Maybe Name, Pattern), Expr)
    -> (NonEmpty (Maybe Name, Pattern), List1 Expr)
    forall a b. (a -> b) -> a -> b
    $ (Named Name (Pattern, Expr) -> ((Maybe Name, Pattern), Expr))
    -> List1 (Named Name (Pattern, Expr))
    -> NonEmpty ((Maybe Name, Pattern), Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\ (Named Maybe Name
    nm (Pattern
    p, Expr
    e)) -> ((Maybe Name
    nm, Pattern
    p), Expr
    e)) List1 (Named Name (Pattern, Expr))
    npes
          -- we first check the expressions @e@: the patterns may shadow some of the
          -- variables mentioned in them!
          NonEmpty Expr
    es <- List1 Expr -> ScopeM (AbsOfCon (List1 Expr))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract List1 Expr
    es
          -- we then parse the pairs of patterns @p@ and names @q@ for the equality
          -- constraints of the form @p ≡ e@.
          NonEmpty (Maybe BindName, Pattern)
    nps <- NonEmpty (Maybe Name, Pattern)
    -> ((Maybe Name, Pattern) -> TCMT IO (Maybe BindName, Pattern))
    -> TCMT IO (NonEmpty (Maybe BindName, Pattern))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM NonEmpty (Maybe Name, Pattern)
    nps (((Maybe Name, Pattern) -> TCMT IO (Maybe BindName, Pattern))
     -> TCMT IO (NonEmpty (Maybe BindName, Pattern)))
    -> ((Maybe Name, Pattern) -> TCMT IO (Maybe BindName, Pattern))
    -> TCMT IO (NonEmpty (Maybe BindName, Pattern))
    forall a b. (a -> b) -> a -> b
    $ \ (Maybe Name
    n, Pattern
    p) -> do
            -- first the pattern
            Pattern
    p <- Pattern -> TCMT IO Pattern
    parsePattern Pattern
    p
            Pattern' Expr
    p <- Pattern -> ScopeM (AbsOfCon Pattern)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Pattern
    p
            Pattern' Expr -> ([Name] -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) p.
    (Monad m, APatternLike p) =>
    p -> ([Name] -> m ()) -> m ()
    checkPatternLinearity Pattern' Expr
    p (TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ())
    -> ([Name] -> TypeError) -> [Name] -> TCMT IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Name] -> TypeError
    RepeatedVariablesInPattern)
            TCMT IO ()
    bindVarsToBind
            Pattern
    p <- Pattern' Expr -> ScopeM (AbsOfCon (Pattern' Expr))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Pattern' Expr
    p
            -- and then the name
            Maybe BindName
    n <- Maybe (NewName BoundName)
    -> ScopeM (AbsOfCon (Maybe (NewName BoundName)))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Maybe (NewName BoundName)
     -> ScopeM (AbsOfCon (Maybe (NewName BoundName))))
    -> Maybe (NewName BoundName)
    -> ScopeM (AbsOfCon (Maybe (NewName BoundName)))
    forall a b. (a -> b) -> a -> b
    $ (Name -> NewName BoundName)
    -> Maybe Name -> Maybe (NewName BoundName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (BindingSource -> BoundName -> NewName BoundName
    forall a. BindingSource -> a -> NewName a
    NewName BindingSource
    WithBound (BoundName -> NewName BoundName)
    -> (Name -> BoundName) -> Name -> NewName BoundName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> BoundName
    C.mkBoundName_) Maybe Name
    n
            (Maybe BindName, Pattern) -> TCMT IO (Maybe BindName, Pattern)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe BindName
    n, Pattern
    p)
          -- we finally reassemble the telescope
          List1 (Named BindName (Pattern, Expr))
    -> TCMT IO (List1 (Named BindName (Pattern, Expr)))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (List1 (Named BindName (Pattern, Expr))
     -> TCMT IO (List1 (Named BindName (Pattern, Expr))))
    -> List1 (Named BindName (Pattern, Expr))
    -> TCMT IO (List1 (Named BindName (Pattern, Expr)))
    forall a b. (a -> b) -> a -> b
    $ ((Maybe BindName, Pattern)
     -> Expr -> Named BindName (Pattern, Expr))
    -> NonEmpty (Maybe BindName, Pattern)
    -> NonEmpty Expr
    -> List1 (Named BindName (Pattern, Expr))
    forall a b c.
    (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
    List1.zipWith (\ (Maybe BindName
    n,Pattern
    p) Expr
    e -> Maybe BindName -> (Pattern, Expr) -> Named BindName (Pattern, Expr)
    forall name a. Maybe name -> a -> Named name a
    Named Maybe BindName
    n (Pattern
    p, Expr
    e)) NonEmpty (Maybe BindName, Pattern)
    nps NonEmpty Expr
    es

    instance ToAbstract AbstractRHS where
      type AbsOfCon AbstractRHS = A.RHS

      toAbstract :: AbstractRHS -> ScopeM (AbsOfCon AbstractRHS)
    toAbstract AbstractRHS
    AbsurdRHS'            = RHS -> TCMT IO RHS
    forall (m :: * -> *) a. Monad m => a -> m a
    return RHS
    A.AbsurdRHS
      toAbstract (RHS' Expr
    e Expr
    c)            = RHS -> TCMT IO RHS
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RHS -> TCMT IO RHS) -> RHS -> TCMT IO RHS
    forall a b. (a -> b) -> a -> b
    $ Expr -> TacticAttribute -> RHS
    A.RHS Expr
    e (TacticAttribute -> RHS) -> TacticAttribute -> RHS
    forall a b. (a -> b) -> a -> b
    $ Expr -> TacticAttribute
    forall a. a -> Maybe a
    Just Expr
    c
      toAbstract (RewriteRHS' [RewriteEqn' () BindName Pattern Expr]
    eqs AbstractRHS
    rhs WhereDeclarations
    wh) = do
        [RewriteEqn' QName BindName Pattern Expr]
    eqs <- [RewriteEqn' () BindName Pattern Expr]
    -> ScopeM (AbsOfCon [RewriteEqn' () BindName Pattern Expr])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [RewriteEqn' () BindName Pattern Expr]
    eqs
        RHS
    rhs <- AbstractRHS -> ScopeM (AbsOfCon AbstractRHS)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract AbstractRHS
    rhs
        RHS -> TCMT IO RHS
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RHS -> TCMT IO RHS) -> RHS -> TCMT IO RHS
    forall a b. (a -> b) -> a -> b
    $ [RewriteEqn' QName BindName Pattern Expr]
    -> [ProblemEq] -> RHS -> WhereDeclarations -> RHS
    RewriteRHS [RewriteEqn' QName BindName Pattern Expr]
    eqs [] RHS
    rhs WhereDeclarations
    wh
      toAbstract (WithRHS' [WithExpr]
    es [TCMT IO Clause]
    cs) = do
        QName
    aux <- [Char] -> TCMT IO QName
    withFunctionName [Char]
    "with-"
        QName -> [WithExpr] -> [Clause] -> RHS
    A.WithRHS QName
    aux [WithExpr]
    es ([Clause] -> RHS) -> TCMT IO [Clause] -> TCMT IO RHS
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do [Clause] -> TCMT IO [Clause]
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([Clause] -> TCMT IO [Clause])
    -> TCMT IO [Clause] -> TCMT IO [Clause]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [TCMT IO Clause] -> TCMT IO [Clause]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [TCMT IO Clause]
    cs

    instance ToAbstract RightHandSide where
      type AbsOfCon RightHandSide = AbstractRHS
      toAbstract :: RightHandSide -> ScopeM (AbsOfCon RightHandSide)
    toAbstract (RightHandSide eqs :: [RewriteEqn' () BindName Pattern Expr]
    eqs@(RewriteEqn' () BindName Pattern Expr
    _:[RewriteEqn' () BindName Pattern Expr]
    _) [WithExpr]
    es ([(Name, LocalVar)], [Clause])
    cs RHS' Expr
    rhs WhereClause' [Declaration]
    wh)               = do
        (AbstractRHS
    rhs, WhereDeclarations
    ds) <- Range
    -> WhereClause' [Declaration]
    -> TCMT IO AbstractRHS
    -> ScopeM (AbstractRHS, WhereDeclarations)
    forall a.
    Range
    -> WhereClause' [Declaration]
    -> ScopeM a
    -> ScopeM (a, WhereDeclarations)
    whereToAbstract (WhereClause' [Declaration] -> Range
    forall a. HasRange a => a -> Range
    getRange WhereClause' [Declaration]
    wh) WhereClause' [Declaration]
    wh (TCMT IO AbstractRHS -> ScopeM (AbstractRHS, WhereDeclarations))
    -> TCMT IO AbstractRHS -> ScopeM (AbstractRHS, WhereDeclarations)
    forall a b. (a -> b) -> a -> b
    $
                       RightHandSide -> ScopeM (AbsOfCon RightHandSide)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract ([RewriteEqn' () BindName Pattern Expr]
    -> [WithExpr]
    -> ([(Name, LocalVar)], [Clause])
    -> RHS' Expr
    -> WhereClause' [Declaration]
    -> RightHandSide
    RightHandSide [] [WithExpr]
    es ([(Name, LocalVar)], [Clause])
    cs RHS' Expr
    rhs WhereClause' [Declaration]
    forall decls. WhereClause' decls
    NoWhere)
        AbstractRHS -> TCMT IO AbstractRHS
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AbstractRHS -> TCMT IO AbstractRHS)
    -> AbstractRHS -> TCMT IO AbstractRHS
    forall a b. (a -> b) -> a -> b
    $ [RewriteEqn' () BindName Pattern Expr]
    -> AbstractRHS -> WhereDeclarations -> AbstractRHS
    RewriteRHS' [RewriteEqn' () BindName Pattern Expr]
    eqs AbstractRHS
    rhs WhereDeclarations
    ds
      toAbstract (RightHandSide [] []    ([(Name, LocalVar)]
    _  , Clause
    _:[Clause]
    _) RHS' Expr
    _          WhereClause' [Declaration]
    _)  = ScopeM (AbsOfCon RightHandSide)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract (RightHandSide [] (WithExpr
    _:[WithExpr]
    _) ([(Name, LocalVar)], [Clause])
    _         (C.RHS Expr
    _)   WhereClause' [Declaration]
    _)  = TypeError -> TCMT IO AbstractRHS
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO AbstractRHS)
    -> TypeError -> TCMT IO AbstractRHS
    forall a b. (a -> b) -> a -> b
    $ TypeError
    BothWithAndRHS
      toAbstract (RightHandSide [] []    ([(Name, LocalVar)]
    _  , []) RHS' Expr
    rhs         WhereClause' [Declaration]
    NoWhere) = RHS' Expr -> ScopeM (AbsOfCon (RHS' Expr))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract RHS' Expr
    rhs
      toAbstract (RightHandSide [] [WithExpr]
    nes   ([(Name, LocalVar)]
    lv , [Clause]
    cs) RHS' Expr
    C.AbsurdRHS WhereClause' [Declaration]
    NoWhere) = do
        let ([Maybe (NewName BoundName)]
    ns , [Arg Expr]
    es) = (WithExpr -> (Maybe (NewName BoundName), Arg Expr))
    -> [WithExpr] -> ([Maybe (NewName BoundName)], [Arg Expr])
    forall a b c. (a -> (b, c)) -> [a] -> ([b], [c])
    unzipWith (\ (Named Maybe Name
    nm Arg Expr
    e) -> (BindingSource -> BoundName -> NewName BoundName
    forall a. BindingSource -> a -> NewName a
    NewName BindingSource
    WithBound (BoundName -> NewName BoundName)
    -> (Name -> BoundName) -> Name -> NewName BoundName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> BoundName
    C.mkBoundName_ (Name -> NewName BoundName)
    -> Maybe Name -> Maybe (NewName BoundName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Name
    nm, Arg Expr
    e)) [WithExpr]
    nes
        [Arg Expr]
    es <- Precedence -> [Arg Expr] -> ScopeM (AbsOfCon [Arg Expr])
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    TopCtx [Arg Expr]
    es
        [(Name, LocalVar)]
    lvars0 <- TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
        [Maybe BindName]
    ns <- [Maybe (NewName BoundName)]
    -> ScopeM (AbsOfCon [Maybe (NewName BoundName)])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [Maybe (NewName BoundName)]
    ns
        [(Name, LocalVar)]
    lvars1 <- TCMT IO [(Name, LocalVar)]
    forall (m :: * -> *). ReadTCState m => m [(Name, LocalVar)]
    getLocalVars
        let lv' :: [(Name, LocalVar)]
    lv' = Int -> [(Name, LocalVar)] -> [(Name, LocalVar)]
    forall a. Int -> [a] -> [a]
    dropEnd ([(Name, LocalVar)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Name, LocalVar)]
    lvars0) [(Name, LocalVar)]
    lvars1 [(Name, LocalVar)] -> [(Name, LocalVar)] -> [(Name, LocalVar)]
    forall a. [a] -> [a] -> [a]
    ++ [(Name, LocalVar)]
    lv
        let cs' :: [TCMT IO Clause]
    cs' = [Clause] -> (Clause -> TCMT IO Clause) -> [TCMT IO Clause]
    forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
    for [Clause]
    cs ((Clause -> TCMT IO Clause) -> [TCMT IO Clause])
    -> (Clause -> TCMT IO Clause) -> [TCMT IO Clause]
    forall a b. (a -> b) -> a -> b
    $ \ Clause
    c -> [(Name, LocalVar)] -> TCMT IO ()
    setLocalVars [(Name, LocalVar)]
    lv' TCMT IO () -> Clause -> TCMT IO Clause
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Clause
    c
        let nes :: [WithExpr]
    nes = (Maybe BindName -> Arg Expr -> WithExpr)
    -> [Maybe BindName] -> [Arg Expr] -> [WithExpr]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Maybe BindName -> Arg Expr -> WithExpr
    forall name a. Maybe name -> a -> Named name a
    Named [Maybe BindName]
    ns [Arg Expr]
    es
        AbstractRHS -> TCMT IO AbstractRHS
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AbstractRHS -> TCMT IO AbstractRHS)
    -> AbstractRHS -> TCMT IO AbstractRHS
    forall a b. (a -> b) -> a -> b
    $ [WithExpr] -> [TCMT IO Clause] -> AbstractRHS
    WithRHS' [WithExpr]
    nes [TCMT IO Clause]
    cs'
      -- TODO: some of these might be possible
      toAbstract (RightHandSide [] (WithExpr
    _ : [WithExpr]
    _) ([(Name, LocalVar)], [Clause])
    _ RHS' Expr
    C.AbsurdRHS  AnyWhere{}) = ScopeM (AbsOfCon RightHandSide)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract (RightHandSide [] (WithExpr
    _ : [WithExpr]
    _) ([(Name, LocalVar)], [Clause])
    _ RHS' Expr
    C.AbsurdRHS SomeWhere{}) = ScopeM (AbsOfCon RightHandSide)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract (RightHandSide [] []     ([(Name, LocalVar)]
    _, []) RHS' Expr
    C.AbsurdRHS  AnyWhere{}) = ScopeM (AbsOfCon RightHandSide)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract (RightHandSide [] []     ([(Name, LocalVar)]
    _, []) RHS' Expr
    C.AbsurdRHS SomeWhere{}) = ScopeM (AbsOfCon RightHandSide)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract (RightHandSide [] []     ([(Name, LocalVar)]
    _, []) C.RHS{}      AnyWhere{}) = ScopeM (AbsOfCon RightHandSide)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
      toAbstract (RightHandSide [] []     ([(Name, LocalVar)]
    _, []) C.RHS{}     SomeWhere{}) = ScopeM (AbsOfCon RightHandSide)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    instance ToAbstract C.RHS where
        type AbsOfCon C.RHS = AbstractRHS

        toAbstract :: RHS' Expr -> ScopeM (AbsOfCon (RHS' Expr))
    toAbstract RHS' Expr
    C.AbsurdRHS = AbstractRHS -> TCMT IO AbstractRHS
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AbstractRHS -> TCMT IO AbstractRHS)
    -> AbstractRHS -> TCMT IO AbstractRHS
    forall a b. (a -> b) -> a -> b
    $ AbstractRHS
    AbsurdRHS'
        toAbstract (C.RHS Expr
    e)   = Expr -> Expr -> AbstractRHS
    RHS' (Expr -> Expr -> AbstractRHS)
    -> ScopeM Expr -> TCMT IO (Expr -> AbstractRHS)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    e TCMT IO (Expr -> AbstractRHS)
    -> TCMT IO Expr -> TCMT IO AbstractRHS
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Expr -> TCMT IO Expr
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Expr
    e

    data LeftHandSide = LeftHandSide C.QName C.Pattern

    instance ToAbstract LeftHandSide where
        type AbsOfCon LeftHandSide = A.LHS

        toAbstract :: LeftHandSide -> ScopeM (AbsOfCon LeftHandSide)
    toAbstract (LeftHandSide QName
    top Pattern
    lhs) =
          Call -> TCMT IO LHS -> TCMT IO LHS
    forall (m :: * -> *) a. MonadTrace m => Call -> m a -> m a
    traceCall (QName -> Pattern -> Call
    ScopeCheckLHS QName
    top Pattern
    lhs) (TCMT IO LHS -> TCMT IO LHS) -> TCMT IO LHS -> TCMT IO LHS
    forall a b. (a -> b) -> a -> b
    $ do
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.lhs" Int
    5 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "original lhs: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Pattern
    lhs
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.lhs" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "patternQNames: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [QName] -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow (Pattern -> [QName]
    forall p. CPatternLike p => p -> [QName]
    patternQNames Pattern
    lhs)
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.lhs" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "original lhs (raw): " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> [Char]
    forall a. Show a => a -> [Char]
    show Pattern
    lhs
            LHSCore
    lhscore <- QName -> Pattern -> TCMT IO LHSCore
    parseLHS QName
    top Pattern
    lhs
            let ell :: ExpandedEllipsis
    ell = LHSCore -> ExpandedEllipsis
    hasExpandedEllipsis LHSCore
    lhscore
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.lhs" Int
    5 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "parsed lhs: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ LHSCore -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow LHSCore
    lhscore
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.lhs" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "parsed lhs (raw): " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ LHSCore -> [Char]
    forall a. Show a => a -> [Char]
    show LHSCore
    lhscore
            Int -> [Char] -> TCMT IO ()
    printLocals Int
    10 [Char]
    "before lhs:"
            -- error if copattern parsed but --no-copatterns option
            TCMT IO Bool -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM (PragmaOptions -> Bool
    optCopatterns (PragmaOptions -> Bool) -> TCMT IO PragmaOptions -> TCMT IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TCMT IO PragmaOptions
    forall (m :: * -> *). HasOptions m => m PragmaOptions
    pragmaOptions) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
              Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (LHSCore -> Bool
    hasCopatterns LHSCore
    lhscore) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $
                TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TypeError
    NeedOptionCopatterns
            -- scope check patterns except for dot patterns
            LHSCore' Expr
    lhscore <- LHSCore -> ScopeM (AbsOfCon LHSCore)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract LHSCore
    lhscore
            TCMT IO ()
    bindVarsToBind
            -- reportSLn "scope.lhs" 5 $ "parsed lhs patterns: " ++ prettyShow lhscore  -- TODO: Pretty A.LHSCore'
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.lhs" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "parsed lhs patterns: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ LHSCore' Expr -> [Char]
    forall a. Show a => a -> [Char]
    show LHSCore' Expr
    lhscore
            Int -> [Char] -> TCMT IO ()
    printLocals Int
    10 [Char]
    "checked pattern:"
            -- scope check dot patterns
            LHSCore' Expr
    lhscore <- LHSCore' Expr -> ScopeM (AbsOfCon (LHSCore' Expr))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract LHSCore' Expr
    lhscore
            -- reportSLn "scope.lhs" 5 $ "parsed lhs dot patterns: " ++ prettyShow lhscore  -- TODO: Pretty A.LHSCore'
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.lhs" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "parsed lhs dot patterns: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ LHSCore' Expr -> [Char]
    forall a. Show a => a -> [Char]
    show LHSCore' Expr
    lhscore
            Int -> [Char] -> TCMT IO ()
    printLocals Int
    10 [Char]
    "checked dots:"
            LHS -> TCMT IO LHS
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHS -> TCMT IO LHS) -> LHS -> TCMT IO LHS
    forall a b. (a -> b) -> a -> b
    $ LHSInfo -> LHSCore' Expr -> LHS
    A.LHS (Range -> ExpandedEllipsis -> LHSInfo
    LHSInfo (Pattern -> Range
    forall a. HasRange a => a -> Range
    getRange Pattern
    lhs) ExpandedEllipsis
    ell) LHSCore' Expr
    lhscore

    hasExpandedEllipsis :: C.LHSCore -> ExpandedEllipsis
    hasExpandedEllipsis :: LHSCore -> ExpandedEllipsis
    hasExpandedEllipsis LHSCore
    core = case LHSCore
    core of
      C.LHSHead{}       -> ExpandedEllipsis
    NoEllipsis
      C.LHSProj{}       -> LHSCore -> ExpandedEllipsis
    hasExpandedEllipsis (LHSCore -> ExpandedEllipsis) -> LHSCore -> ExpandedEllipsis
    forall a b. (a -> b) -> a -> b
    $ NamedArg LHSCore -> LHSCore
    forall a. NamedArg a -> a
    namedArg (NamedArg LHSCore -> LHSCore) -> NamedArg LHSCore -> LHSCore
    forall a b. (a -> b) -> a -> b
    $ LHSCore -> NamedArg LHSCore
    C.lhsFocus LHSCore
    core -- can this ever be ExpandedEllipsis?
      C.LHSWith{}       -> LHSCore -> ExpandedEllipsis
    hasExpandedEllipsis (LHSCore -> ExpandedEllipsis) -> LHSCore -> ExpandedEllipsis
    forall a b. (a -> b) -> a -> b
    $ LHSCore -> LHSCore
    C.lhsHead LHSCore
    core
      C.LHSEllipsis Range
    r LHSCore
    p -> case LHSCore
    p of
        C.LHSWith LHSCore
    p [Pattern]
    wps [NamedArg Pattern]
    _ -> LHSCore -> ExpandedEllipsis
    hasExpandedEllipsis LHSCore
    p ExpandedEllipsis -> ExpandedEllipsis -> ExpandedEllipsis
    forall a. Semigroup a => a -> a -> a
    <> Range -> Int -> ExpandedEllipsis
    ExpandedEllipsis Range
    r ([Pattern] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pattern]
    wps)
        C.LHSHead{}       -> Range -> Int -> ExpandedEllipsis
    ExpandedEllipsis Range
    r Int
    0
        C.LHSProj{}       -> Range -> Int -> ExpandedEllipsis
    ExpandedEllipsis Range
    r Int
    0
        C.LHSEllipsis{}   -> ExpandedEllipsis
    forall a. HasCallStack => a
    __IMPOSSIBLE__

    -- | Merges adjacent EqualP patterns into one:
    -- type checking expects only one pattern for each domain in the telescope.
    mergeEqualPs :: [NamedArg (Pattern' e)] -> ScopeM [NamedArg (Pattern' e)]
    mergeEqualPs :: forall e. [NamedArg (Pattern' e)] -> ScopeM [NamedArg (Pattern' e)]
    mergeEqualPs = (PatInfo, [(e, e)])
    -> [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    forall {e}.
    (PatInfo, [(e, e)])
    -> [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    go (PatInfo
    forall a. Null a => a
    empty, [])
      where
        go :: (PatInfo, [(e, e)])
    -> [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    go (PatInfo, [(e, e)])
    acc (p :: Arg (Named NamedName (Pattern' e))
    p@(Arg ArgInfo
    i (Named Maybe NamedName
    mn (A.EqualP PatInfo
    r [(e, e)]
    es))) : [Arg (Named NamedName (Pattern' e))]
    ps) = Arg (Named NamedName (Pattern' e))
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Arg (Named NamedName (Pattern' e))
    p (TCMT IO [Arg (Named NamedName (Pattern' e))]
     -> TCMT IO [Arg (Named NamedName (Pattern' e))])
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    forall a b. (a -> b) -> a -> b
    $ do
          -- Face constraint patterns must be defaultNamedArg; check this:
          Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ArgInfo -> Modality
    forall a. LensModality a => a -> Modality
    getModality ArgInfo
    i Modality -> Modality -> Bool
    forall a. Eq a => a -> a -> Bool
    == Modality
    defaultModality) TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
          Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ArgInfo -> Bool
    forall a. LensHiding a => a -> Bool
    hidden     ArgInfo
    i) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Doc -> TCMT IO ()
    forall {m :: * -> *} {a}.
    (MonadWarning m, HasRange a) =>
    a -> Doc -> m ()
    warn ArgInfo
    i (Doc -> TCMT IO ()) -> Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc
    "Face constraint patterns cannot be hidden arguments"
          Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ArgInfo -> Bool
    forall a. LensHiding a => a -> Bool
    isInstance ArgInfo
    i) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ ArgInfo -> Doc -> TCMT IO ()
    forall {m :: * -> *} {a}.
    (MonadWarning m, HasRange a) =>
    a -> Doc -> m ()
    warn ArgInfo
    i (Doc -> TCMT IO ()) -> Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc
    "Face constraint patterns cannot be instance arguments"
          Maybe NamedName -> (NamedName -> TCMT IO ()) -> TCMT IO ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe NamedName
    mn ((NamedName -> TCMT IO ()) -> TCMT IO ())
    -> (NamedName -> TCMT IO ()) -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ \ NamedName
    x -> NamedName -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange NamedName
    x (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ NamedName -> Doc -> TCMT IO ()
    forall {m :: * -> *} {a}.
    (MonadWarning m, HasRange a) =>
    a -> Doc -> m ()
    warn NamedName
    x (Doc -> TCMT IO ()) -> Doc -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    P.hcat
              [ Doc
    "Ignoring name `", NamedName -> Doc
    forall a. Pretty a => a -> Doc
    P.pretty NamedName
    x, Doc
    "` given to face constraint pattern" ]
          (PatInfo, [(e, e)])
    -> [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    go ((PatInfo, [(e, e)])
    acc (PatInfo, [(e, e)]) -> (PatInfo, [(e, e)]) -> (PatInfo, [(e, e)])
    forall a. Monoid a => a -> a -> a
    `mappend` (PatInfo
    r, [(e, e)]
    es)) [Arg (Named NamedName (Pattern' e))]
    ps
        go (PatInfo
    r, es :: [(e, e)]
    es@((e, e)
    _:[(e, e)]
    _)) [Arg (Named NamedName (Pattern' e))]
    ps = (Pattern' e -> Arg (Named NamedName (Pattern' e))
    forall a. a -> NamedArg a
    defaultNamedArg (PatInfo -> [(e, e)] -> Pattern' e
    forall e. PatInfo -> [(e, e)] -> Pattern' e
    A.EqualP PatInfo
    r [(e, e)]
    es) Arg (Named NamedName (Pattern' e))
    -> [Arg (Named NamedName (Pattern' e))]
    -> [Arg (Named NamedName (Pattern' e))]
    forall a. a -> [a] -> [a]
    :) ([Arg (Named NamedName (Pattern' e))]
     -> [Arg (Named NamedName (Pattern' e))])
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    forall e. [NamedArg (Pattern' e)] -> ScopeM [NamedArg (Pattern' e)]
    mergeEqualPs [Arg (Named NamedName (Pattern' e))]
    ps
        go (PatInfo
    _, []) []       = [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        go (PatInfo
    _, []) (Arg (Named NamedName (Pattern' e))
    p : [Arg (Named NamedName (Pattern' e))]
    ps) = (Arg (Named NamedName (Pattern' e))
    p Arg (Named NamedName (Pattern' e))
    -> [Arg (Named NamedName (Pattern' e))]
    -> [Arg (Named NamedName (Pattern' e))]
    forall a. a -> [a] -> [a]
    :) ([Arg (Named NamedName (Pattern' e))]
     -> [Arg (Named NamedName (Pattern' e))])
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Arg (Named NamedName (Pattern' e))]
    -> TCMT IO [Arg (Named NamedName (Pattern' e))]
    forall e. [NamedArg (Pattern' e)] -> ScopeM [NamedArg (Pattern' e)]
    mergeEqualPs [Arg (Named NamedName (Pattern' e))]
    ps

        warn :: a -> Doc -> m ()
    warn a
    r Doc
    d = Warning -> m ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning (Warning -> m ()) -> Warning -> m ()
    forall a b. (a -> b) -> a -> b
    $ Range -> Doc -> Warning
    GenericUseless (a -> Range
    forall a. HasRange a => a -> Range
    getRange a
    r) Doc
    d

    -- does not check pattern linearity
    instance ToAbstract C.LHSCore where
        type AbsOfCon C.LHSCore = (A.LHSCore' C.Expr)

        toAbstract :: LHSCore -> ScopeM (AbsOfCon LHSCore)
    toAbstract (C.LHSHead QName
    x [NamedArg Pattern]
    ps) = do
            QName
    x <- TCMT IO QName -> TCMT IO QName
    forall a. ScopeM a -> ScopeM a
    withLocalVars (TCMT IO QName -> TCMT IO QName) -> TCMT IO QName -> TCMT IO QName
    forall a b. (a -> b) -> a -> b
    $ do
              [(Name, LocalVar)] -> TCMT IO ()
    setLocalVars []
              OldName QName -> ScopeM (AbsOfCon (OldName QName))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> OldName QName
    forall a. a -> OldName a
    OldName QName
    x)
            QName -> [Arg (Named NamedName (Pattern' Expr))] -> LHSCore' Expr
    forall e. QName -> [NamedArg (Pattern' e)] -> LHSCore' e
    A.LHSHead QName
    x ([Arg (Named NamedName (Pattern' Expr))] -> LHSCore' Expr)
    -> TCMT IO [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO (LHSCore' Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO [Arg (Named NamedName (Pattern' Expr))]
    forall e. [NamedArg (Pattern' e)] -> ScopeM [NamedArg (Pattern' e)]
    mergeEqualPs ([Arg (Named NamedName (Pattern' Expr))]
     -> TCMT IO [Arg (Named NamedName (Pattern' Expr))])
    -> TCMT IO [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO [Arg (Named NamedName (Pattern' Expr))]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [NamedArg Pattern] -> ScopeM (AbsOfCon [NamedArg Pattern])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [NamedArg Pattern]
    ps
        toAbstract (C.LHSProj QName
    d [NamedArg Pattern]
    ps1 NamedArg LHSCore
    l [NamedArg Pattern]
    ps2) = do
            Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([NamedArg Pattern] -> Bool
    forall a. Null a => a -> Bool
    null [NamedArg Pattern]
    ps1) (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> TCMT IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO ()) -> TypeError -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> TypeError
    GenericDocError (Doc -> TypeError) -> Doc -> TypeError
    forall a b. (a -> b) -> a -> b
    $
              Doc
    "Ill-formed projection pattern" Doc -> Doc -> Doc
    P.<+> Pattern -> Doc
    forall a. Pretty a => a -> Doc
    P.pretty ((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 (QName -> Pattern
    C.IdentP QName
    d) [NamedArg Pattern]
    ps1)
            ResolvedName
    qx <- QName -> ScopeM ResolvedName
    resolveName QName
    d
            NonEmpty QName
    ds <- case ResolvedName
    qx of
                    FieldName List1 AbstractName
    ds -> NonEmpty QName -> TCMT IO (NonEmpty QName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NonEmpty QName -> TCMT IO (NonEmpty QName))
    -> NonEmpty QName -> TCMT IO (NonEmpty QName)
    forall a b. (a -> b) -> a -> b
    $ (AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds
                    ResolvedName
    UnknownName -> QName -> TCMT IO (NonEmpty QName)
    forall a. QName -> TCM a
    notInScopeError QName
    d
                    ResolvedName
    _           -> [Char] -> TCMT IO (NonEmpty QName)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError ([Char] -> TCMT IO (NonEmpty QName))
    -> [Char] -> TCMT IO (NonEmpty QName)
    forall a b. (a -> b) -> a -> b
    $
                      [Char]
    "head of copattern needs to be a field identifier, but "
                      [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    d [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " isn't one"
            AmbiguousQName
    -> NamedArg (LHSCore' Expr)
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> LHSCore' Expr
    forall e.
    AmbiguousQName
    -> NamedArg (LHSCore' e) -> [NamedArg (Pattern' e)] -> LHSCore' e
    A.LHSProj (NonEmpty QName -> AmbiguousQName
    AmbQ NonEmpty QName
    ds) (NamedArg (LHSCore' Expr)
     -> [Arg (Named NamedName (Pattern' Expr))] -> LHSCore' Expr)
    -> TCMT IO (NamedArg (LHSCore' Expr))
    -> TCMT
         IO ([Arg (Named NamedName (Pattern' Expr))] -> LHSCore' Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NamedArg LHSCore -> ScopeM (AbsOfCon (NamedArg LHSCore))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract NamedArg LHSCore
    l TCMT IO ([Arg (Named NamedName (Pattern' Expr))] -> LHSCore' Expr)
    -> TCMT IO [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO (LHSCore' Expr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ([Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO [Arg (Named NamedName (Pattern' Expr))]
    forall e. [NamedArg (Pattern' e)] -> ScopeM [NamedArg (Pattern' e)]
    mergeEqualPs ([Arg (Named NamedName (Pattern' Expr))]
     -> TCMT IO [Arg (Named NamedName (Pattern' Expr))])
    -> TCMT IO [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO [Arg (Named NamedName (Pattern' Expr))]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [NamedArg Pattern] -> ScopeM (AbsOfCon [NamedArg Pattern])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [NamedArg Pattern]
    ps2)
        toAbstract (C.LHSWith LHSCore
    core [Pattern]
    wps [NamedArg Pattern]
    ps) = do
          (LHSCore' Expr
     -> [Arg (Named NamedName (Pattern' Expr))] -> LHSCore' Expr)
    -> TCMT IO (LHSCore' Expr)
    -> TCMT IO [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO (LHSCore' Expr)
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 LHSCore' Expr
    -> [Arg (Named NamedName (Pattern' Expr))] -> LHSCore' Expr
    forall e. LHSCore' e -> [NamedArg (Pattern' e)] -> LHSCore' e
    A.lhsCoreApp
            ((LHSCore' Expr -> [Arg (Pattern' Expr)] -> LHSCore' Expr)
    -> TCMT IO (LHSCore' Expr)
    -> TCMT IO [Arg (Pattern' Expr)]
    -> TCMT IO (LHSCore' Expr)
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 LHSCore' Expr -> [Arg (Pattern' Expr)] -> LHSCore' Expr
    forall e. LHSCore' e -> [Arg (Pattern' e)] -> LHSCore' e
    A.lhsCoreWith
              (LHSCore -> ScopeM (AbsOfCon LHSCore)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract LHSCore
    core)
              ((Pattern' Expr -> Arg (Pattern' Expr))
    -> [Pattern' Expr] -> [Arg (Pattern' Expr)]
    forall a b. (a -> b) -> [a] -> [b]
    map Pattern' Expr -> Arg (Pattern' Expr)
    forall a. a -> Arg a
    defaultArg ([Pattern' Expr] -> [Arg (Pattern' Expr)])
    -> TCMT IO [Pattern' Expr] -> TCMT IO [Arg (Pattern' Expr)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Pattern] -> ScopeM (AbsOfCon [Pattern])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [Pattern]
    wps))
            ([NamedArg Pattern] -> ScopeM (AbsOfCon [NamedArg Pattern])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [NamedArg Pattern]
    ps)
        -- In case of a part of the LHS which was expanded from an ellipsis,
        -- we flush the @scopeVarsToBind@ in order to allow variables bound
        -- in the ellipsis to be shadowed.
        toAbstract (C.LHSEllipsis Range
    _ LHSCore
    p) = do
          LHSCore' Expr
    ap <- LHSCore -> ScopeM (AbsOfCon LHSCore)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract LHSCore
    p
          TCMT IO ()
    bindVarsToBind
          LHSCore' Expr -> TCMT IO (LHSCore' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHSCore' Expr
    ap

    instance ToAbstract c => ToAbstract (WithHiding c) where
      type AbsOfCon (WithHiding c) = WithHiding (AbsOfCon c)
      toAbstract :: WithHiding c -> ScopeM (AbsOfCon (WithHiding c))
    toAbstract (WithHiding Hiding
    h c
    a) = Hiding -> AbsOfCon c -> WithHiding (AbsOfCon c)
    forall a. Hiding -> a -> WithHiding a
    WithHiding Hiding
    h (AbsOfCon c -> WithHiding (AbsOfCon c))
    -> TCMT IO (AbsOfCon c) -> TCMT IO (WithHiding (AbsOfCon c))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Hiding -> c -> TCMT IO (AbsOfCon c)
    forall h c.
    (LensHiding h, ToAbstract c) =>
    h -> c -> ScopeM (AbsOfCon c)
    toAbstractHiding Hiding
    h c
    a

    instance ToAbstract c => ToAbstract (Arg c) where
        type AbsOfCon (Arg c) = Arg (AbsOfCon c)
        toAbstract :: Arg c -> ScopeM (AbsOfCon (Arg c))
    toAbstract (Arg ArgInfo
    info c
    e) =
            ArgInfo -> AbsOfCon c -> Arg (AbsOfCon c)
    forall e. ArgInfo -> e -> Arg e
    Arg ArgInfo
    info (AbsOfCon c -> Arg (AbsOfCon c))
    -> TCMT IO (AbsOfCon c) -> TCMT IO (Arg (AbsOfCon c))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ArgInfo -> c -> TCMT IO (AbsOfCon c)
    forall h c.
    (LensHiding h, ToAbstract c) =>
    h -> c -> ScopeM (AbsOfCon c)
    toAbstractHiding ArgInfo
    info c
    e

    instance ToAbstract c => ToAbstract (Named name c) where
        type AbsOfCon (Named name c) = Named name (AbsOfCon c)
        toAbstract :: Named name c -> ScopeM (AbsOfCon (Named name c))
    toAbstract (Named Maybe name
    n c
    e) = Maybe name -> AbsOfCon c -> Named name (AbsOfCon c)
    forall name a. Maybe name -> a -> Named name a
    Named Maybe name
    n (AbsOfCon c -> Named name (AbsOfCon c))
    -> TCMT IO (AbsOfCon c) -> TCMT IO (Named name (AbsOfCon c))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> c -> TCMT IO (AbsOfCon c)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract c
    e

    {- DOES NOT WORK ANYMORE with pattern synonyms
    instance ToAbstract c a => ToAbstract (A.LHSCore' c) (A.LHSCore' a) where
        toAbstract = mapM toAbstract
    -}

    instance ToAbstract (A.LHSCore' C.Expr) where
        type AbsOfCon (A.LHSCore' C.Expr) = A.LHSCore' A.Expr
        toAbstract :: LHSCore' Expr -> ScopeM (AbsOfCon (LHSCore' Expr))
    toAbstract (A.LHSHead QName
    f [Arg (Named NamedName (Pattern' Expr))]
    ps)         = QName -> [NamedArg Pattern] -> LHSCore' Expr
    forall e. QName -> [NamedArg (Pattern' e)] -> LHSCore' e
    A.LHSHead QName
    f ([NamedArg Pattern] -> LHSCore' Expr)
    -> TCMT IO [NamedArg Pattern] -> TCMT IO (LHSCore' Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Arg (Named NamedName (Pattern' Expr))
     -> TCMT IO (NamedArg Pattern))
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO [NamedArg Pattern]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Arg (Named NamedName (Pattern' Expr)) -> TCMT IO (NamedArg Pattern)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [Arg (Named NamedName (Pattern' Expr))]
    ps
        toAbstract (A.LHSProj AmbiguousQName
    d NamedArg (LHSCore' Expr)
    lhscore [Arg (Named NamedName (Pattern' Expr))]
    ps) = AmbiguousQName
    -> NamedArg (LHSCore' Expr) -> [NamedArg Pattern] -> LHSCore' Expr
    forall e.
    AmbiguousQName
    -> NamedArg (LHSCore' e) -> [NamedArg (Pattern' e)] -> LHSCore' e
    A.LHSProj AmbiguousQName
    d (NamedArg (LHSCore' Expr) -> [NamedArg Pattern] -> LHSCore' Expr)
    -> TCMT IO (NamedArg (LHSCore' Expr))
    -> TCMT IO ([NamedArg Pattern] -> LHSCore' Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Named_ (LHSCore' Expr) -> TCMT IO (Named_ (LHSCore' Expr)))
    -> NamedArg (LHSCore' Expr) -> TCMT IO (NamedArg (LHSCore' Expr))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Named_ (LHSCore' Expr) -> TCMT IO (Named_ (LHSCore' Expr))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract NamedArg (LHSCore' Expr)
    lhscore TCMT IO ([NamedArg Pattern] -> LHSCore' Expr)
    -> TCMT IO [NamedArg Pattern] -> TCMT IO (LHSCore' Expr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Arg (Named NamedName (Pattern' Expr))
     -> TCMT IO (NamedArg Pattern))
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO [NamedArg Pattern]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Arg (Named NamedName (Pattern' Expr)) -> TCMT IO (NamedArg Pattern)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [Arg (Named NamedName (Pattern' Expr))]
    ps
        toAbstract (A.LHSWith LHSCore' Expr
    core [Arg (Pattern' Expr)]
    wps [Arg (Named NamedName (Pattern' Expr))]
    ps)  = (LHSCore' Expr
     -> [Arg Pattern] -> [NamedArg Pattern] -> LHSCore' Expr)
    -> TCMT IO (LHSCore' Expr)
    -> TCMT IO [Arg Pattern]
    -> TCMT IO [NamedArg Pattern]
    -> TCMT IO (LHSCore' Expr)
    forall (f :: * -> *) a b c d.
    Applicative f =>
    (a -> b -> c -> d) -> f a -> f b -> f c -> f d
    liftA3 LHSCore' Expr
    -> [Arg Pattern] -> [NamedArg Pattern] -> LHSCore' Expr
    forall e.
    LHSCore' e
    -> [Arg (Pattern' e)] -> [NamedArg (Pattern' e)] -> LHSCore' e
    A.LHSWith (LHSCore' Expr -> ScopeM (AbsOfCon (LHSCore' Expr))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract LHSCore' Expr
    core) ([Arg (Pattern' Expr)] -> ScopeM (AbsOfCon [Arg (Pattern' Expr)])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [Arg (Pattern' Expr)]
    wps) ([Arg (Named NamedName (Pattern' Expr))]
    -> ScopeM (AbsOfCon [Arg (Named NamedName (Pattern' Expr))])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [Arg (Named NamedName (Pattern' Expr))]
    ps)

    -- Patterns are done in two phases. First everything but the dot patterns, and
    -- then the dot patterns. This is because dot patterns can refer to variables
    -- bound anywhere in the pattern.

    instance ToAbstract (A.Pattern' C.Expr) where
      type AbsOfCon (A.Pattern' C.Expr) = A.Pattern' A.Expr
      toAbstract :: Pattern' Expr -> ScopeM (AbsOfCon (Pattern' Expr))
    toAbstract = (Expr -> ScopeM Expr) -> Pattern' Expr -> TCMT IO Pattern
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Expr -> ScopeM Expr) -> Pattern' Expr -> TCMT IO Pattern)
    -> (Expr -> ScopeM Expr) -> Pattern' Expr -> TCMT IO Pattern
    forall a b. (a -> b) -> a -> b
    $ ScopeM Expr -> ScopeM Expr
    forall a. ScopeM a -> ScopeM a
    insideDotPattern (ScopeM Expr -> ScopeM Expr)
    -> (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    DotPatternCtx  -- Issue #3033

    resolvePatternIdentifier ::
      Range -> C.QName -> Maybe (Set A.Name) -> ScopeM (A.Pattern' C.Expr)
    resolvePatternIdentifier :: Range -> QName -> Maybe (Set Name) -> TCMT IO (Pattern' Expr)
    resolvePatternIdentifier Range
    r QName
    x Maybe (Set Name)
    ns = do
      [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "resolvePatternIdentifier " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ QName -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow QName
    x [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " at source position " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Range -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Range
    r
      APatName
    px <- PatName -> ScopeM (AbsOfCon PatName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> Maybe (Set Name) -> PatName
    PatName QName
    x Maybe (Set Name)
    ns)
      case APatName
    px of
        VarPatName Name
    y         -> do
          [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "  resolved to VarPatName " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow Name
    y [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " with range " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Range -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow (Name -> Range
    forall a. HasRange a => a -> Range
    getRange Name
    y)
          Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ BindName -> Pattern' Expr
    forall e. BindName -> Pattern' e
    VarP (BindName -> Pattern' Expr) -> BindName -> Pattern' Expr
    forall a b. (a -> b) -> a -> b
    $ Name -> BindName
    A.mkBindName Name
    y
        ConPatName List1 AbstractName
    ds        -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ ConPatInfo
    -> AmbiguousQName
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> Pattern' Expr
    forall e. ConPatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    ConP (ConOrigin -> PatInfo -> ConPatLazy -> ConPatInfo
    ConPatInfo ConOrigin
    ConOCon (Range -> PatInfo
    PatRange Range
    r) ConPatLazy
    ConPatEager)
                                              (NonEmpty QName -> AmbiguousQName
    AmbQ (NonEmpty QName -> AmbiguousQName)
    -> NonEmpty QName -> AmbiguousQName
    forall a b. (a -> b) -> a -> b
    $ (AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds) []
        PatternSynPatName List1 AbstractName
    ds -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ PatInfo
    -> AmbiguousQName
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> Pattern' Expr
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    PatternSynP (Range -> PatInfo
    PatRange Range
    r)
                                                     (NonEmpty QName -> AmbiguousQName
    AmbQ (NonEmpty QName -> AmbiguousQName)
    -> NonEmpty QName -> AmbiguousQName
    forall a b. (a -> b) -> a -> b
    $ (AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds) []

    -- | Apply an abstract syntax pattern head to pattern arguments.
    --
    --   Fails with 'InvalidPattern' if head is not a constructor pattern
    --   (or similar) that can accept arguments.
    --
    applyAPattern
      :: C.Pattern            -- ^ The application pattern in concrete syntax.
      -> A.Pattern' C.Expr    -- ^ Head of application.
      -> NAPs C.Expr          -- ^ Arguments of application.
      -> ScopeM (A.Pattern' C.Expr)
    applyAPattern :: Pattern
    -> Pattern' Expr
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO (Pattern' Expr)
    applyAPattern Pattern
    p0 Pattern' Expr
    p [Arg (Named NamedName (Pattern' Expr))]
    ps = do
      Range -> Pattern' Expr -> Pattern' Expr
    forall a. SetRange a => Range -> a -> a
    setRange (Pattern -> Range
    forall a. HasRange a => a -> Range
    getRange Pattern
    p0) (Pattern' Expr -> Pattern' Expr)
    -> TCMT IO (Pattern' Expr) -> TCMT IO (Pattern' Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
        case Pattern' Expr
    p of
          A.ConP ConPatInfo
    i AmbiguousQName
    x [Arg (Named NamedName (Pattern' Expr))]
    as        -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ ConPatInfo
    -> AmbiguousQName
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> Pattern' Expr
    forall e. ConPatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.ConP        ConPatInfo
    i AmbiguousQName
    x ([Arg (Named NamedName (Pattern' Expr))]
    as [Arg (Named NamedName (Pattern' Expr))]
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> [Arg (Named NamedName (Pattern' Expr))]
    forall a. [a] -> [a] -> [a]
    ++ [Arg (Named NamedName (Pattern' Expr))]
    ps)
          A.DefP PatInfo
    i AmbiguousQName
    x [Arg (Named NamedName (Pattern' Expr))]
    as        -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ PatInfo
    -> AmbiguousQName
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> Pattern' Expr
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.DefP        PatInfo
    i AmbiguousQName
    x ([Arg (Named NamedName (Pattern' Expr))]
    as [Arg (Named NamedName (Pattern' Expr))]
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> [Arg (Named NamedName (Pattern' Expr))]
    forall a. [a] -> [a] -> [a]
    ++ [Arg (Named NamedName (Pattern' Expr))]
    ps)
          A.PatternSynP PatInfo
    i AmbiguousQName
    x [Arg (Named NamedName (Pattern' Expr))]
    as -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ PatInfo
    -> AmbiguousQName
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> Pattern' Expr
    forall e. PatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.PatternSynP PatInfo
    i AmbiguousQName
    x ([Arg (Named NamedName (Pattern' Expr))]
    as [Arg (Named NamedName (Pattern' Expr))]
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> [Arg (Named NamedName (Pattern' Expr))]
    forall a. [a] -> [a] -> [a]
    ++ [Arg (Named NamedName (Pattern' Expr))]
    ps)
          -- Dotted constructors are turned into "lazy" constructor patterns.
          A.DotP PatInfo
    i (Ident QName
    x)   -> QName -> ScopeM ResolvedName
    resolveName QName
    x ScopeM ResolvedName
    -> (ResolvedName -> TCMT IO (Pattern' Expr))
    -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            ConstructorName Set Induction
    _ List1 AbstractName
    ds -> do
              let cpi :: ConPatInfo
    cpi = ConOrigin -> PatInfo -> ConPatLazy -> ConPatInfo
    ConPatInfo ConOrigin
    ConOCon PatInfo
    i ConPatLazy
    ConPatLazy
                  c :: AmbiguousQName
    c   = NonEmpty QName -> AmbiguousQName
    AmbQ ((AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    ds)
              Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ ConPatInfo
    -> AmbiguousQName
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> Pattern' Expr
    forall e. ConPatInfo -> AmbiguousQName -> NAPs e -> Pattern' e
    A.ConP ConPatInfo
    cpi AmbiguousQName
    c [Arg (Named NamedName (Pattern' Expr))]
    ps
            ResolvedName
    _ -> TCMT IO (Pattern' Expr)
    failure
          A.DotP{}    -> TCMT IO (Pattern' Expr)
    failure
          A.VarP{}    -> TCMT IO (Pattern' Expr)
    failure
          A.ProjP{}   -> TCMT IO (Pattern' Expr)
    failure
          A.WildP{}   -> TCMT IO (Pattern' Expr)
    failure
          A.AsP{}     -> TCMT IO (Pattern' Expr)
    failure
          A.AbsurdP{} -> TCMT IO (Pattern' Expr)
    failure
          A.LitP{}    -> TCMT IO (Pattern' Expr)
    failure
          A.RecP{}    -> TCMT IO (Pattern' Expr)
    failure
          A.EqualP{}  -> TCMT IO (Pattern' Expr)
    failure
          A.WithP{}   -> TCMT IO (Pattern' Expr)
    failure
          A.AnnP{}    -> TCMT IO (Pattern' Expr)
    failure
      where
        failure :: TCMT IO (Pattern' Expr)
    failure = TypeError -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    TypeError -> m a
    typeError (TypeError -> TCMT IO (Pattern' Expr))
    -> TypeError -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ Pattern -> TypeError
    InvalidPattern Pattern
    p0

    instance ToAbstract C.Pattern where
        type AbsOfCon C.Pattern = A.Pattern' C.Expr

        toAbstract :: Pattern -> ScopeM (AbsOfCon Pattern)
    toAbstract (C.IdentP QName
    x) =
          Range -> QName -> Maybe (Set Name) -> TCMT IO (Pattern' Expr)
    resolvePatternIdentifier (QName -> Range
    forall a. HasRange a => a -> Range
    getRange QName
    x) QName
    x Maybe (Set Name)
    forall a. Maybe a
    Nothing

        toAbstract (AppP (QuoteP Range
    _) NamedArg Pattern
    p)
          | IdentP QName
    x <- NamedArg Pattern -> Pattern
    forall a. NamedArg a -> a
    namedArg NamedArg Pattern
    p,
            NamedArg Pattern -> Bool
    forall a. LensHiding a => a -> Bool
    visible NamedArg Pattern
    p = do
          Expr
    e <- OldQName -> ScopeM (AbsOfCon OldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> Maybe (Set Name) -> OldQName
    OldQName QName
    x Maybe (Set Name)
    forall a. Maybe a
    Nothing)
          PatInfo -> Literal -> Pattern' Expr
    forall e. PatInfo -> Literal -> Pattern' e
    A.LitP (Range -> PatInfo
    PatRange (Range -> PatInfo) -> Range -> PatInfo
    forall a b. (a -> b) -> a -> b
    $ QName -> Range
    forall a. HasRange a => a -> Range
    getRange QName
    x) (Literal -> Pattern' Expr)
    -> (QName -> Literal) -> QName -> Pattern' Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Literal
    LitQName (QName -> Pattern' Expr)
    -> TCMT IO QName -> TCMT IO (Pattern' Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> TCMT IO QName
    forall (m :: * -> *).
    (MonadTCError m, MonadAbsToCon m) =>
    Expr -> m QName
    quotedName Expr
    e

        toAbstract (QuoteP Range
    r) =
          [Char] -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a.
    (HasCallStack, MonadTCError m) =>
    [Char] -> m a
    genericError [Char]
    "quote must be applied to an identifier"

        toAbstract p0 :: Pattern
    p0@(AppP Pattern
    p NamedArg Pattern
    q) = do
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    50 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "distributeDots before = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> [Char]
    forall a. Show a => a -> [Char]
    show Pattern
    p
            Pattern
    p <- Pattern -> TCMT IO Pattern
    distributeDots Pattern
    p
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    50 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "distributeDots after  = " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> [Char]
    forall a. Show a => a -> [Char]
    show Pattern
    p
            (Pattern' Expr
    p', Arg (Named NamedName (Pattern' Expr))
    q') <- (Pattern, NamedArg Pattern)
    -> ScopeM (AbsOfCon (Pattern, NamedArg Pattern))
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (Pattern
    p, NamedArg Pattern
    q)
            Pattern
    -> Pattern' Expr
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO (Pattern' Expr)
    applyAPattern Pattern
    p0 Pattern' Expr
    p' ([Arg (Named NamedName (Pattern' Expr))]
     -> TCMT IO (Pattern' Expr))
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ Arg (Named NamedName (Pattern' Expr))
    -> [Arg (Named NamedName (Pattern' Expr))]
    forall el coll. Singleton el coll => el -> coll
    singleton Arg (Named NamedName (Pattern' Expr))
    q'

            where
                distributeDots :: C.Pattern -> ScopeM C.Pattern
                distributeDots :: Pattern -> TCMT IO Pattern
    distributeDots p :: Pattern
    p@(C.DotP Range
    r Expr
    e) = Range -> Expr -> TCMT IO Pattern
    distributeDotsExpr Range
    r Expr
    e
                distributeDots Pattern
    p = Pattern -> TCMT IO Pattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return Pattern
    p

                distributeDotsExpr :: Range -> C.Expr -> ScopeM C.Pattern
                distributeDotsExpr :: Range -> Expr -> TCMT IO Pattern
    distributeDotsExpr Range
    r Expr
    e = Expr -> TCMT IO Expr
    parseRawApp Expr
    e TCMT IO Expr -> (Expr -> TCMT IO Pattern) -> TCMT IO Pattern
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                  C.App Range
    r Expr
    e NamedArg Expr
    a     ->
                    Pattern -> NamedArg Pattern -> Pattern
    AppP (Pattern -> NamedArg Pattern -> Pattern)
    -> TCMT IO Pattern -> TCMT IO (NamedArg Pattern -> Pattern)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Range -> Expr -> TCMT IO Pattern
    distributeDotsExpr Range
    r Expr
    e
                         TCMT IO (NamedArg Pattern -> Pattern)
    -> TCMT IO (NamedArg Pattern) -> TCMT IO Pattern
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ((Named NamedName Expr -> TCMT IO (Named NamedName Pattern))
    -> NamedArg Expr -> TCMT IO (NamedArg Pattern)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Named NamedName Expr -> TCMT IO (Named NamedName Pattern))
     -> NamedArg Expr -> TCMT IO (NamedArg Pattern))
    -> ((Expr -> TCMT IO Pattern)
        -> Named NamedName Expr -> TCMT IO (Named NamedName Pattern))
    -> (Expr -> TCMT IO Pattern)
    -> NamedArg Expr
    -> TCMT IO (NamedArg Pattern)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Expr -> TCMT IO Pattern)
    -> Named NamedName Expr -> TCMT IO (Named NamedName Pattern)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse) (Range -> Expr -> TCMT IO Pattern
    distributeDotsExpr Range
    r) NamedArg Expr
    a
                  OpApp Range
    r QName
    q Set Name
    ns OpAppArgs
    as ->
                    case ((Arg (Named NamedName (MaybePlaceholder (OpApp Expr)))
     -> Maybe (NamedArg Expr))
    -> OpAppArgs -> Maybe [NamedArg Expr]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Arg (Named NamedName (MaybePlaceholder (OpApp Expr)))
      -> Maybe (NamedArg Expr))
     -> OpAppArgs -> Maybe [NamedArg Expr])
    -> ((MaybePlaceholder (OpApp Expr) -> TacticAttribute)
        -> Arg (Named NamedName (MaybePlaceholder (OpApp Expr)))
        -> Maybe (NamedArg Expr))
    -> (MaybePlaceholder (OpApp Expr) -> TacticAttribute)
    -> OpAppArgs
    -> Maybe [NamedArg Expr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Named NamedName (MaybePlaceholder (OpApp Expr))
     -> Maybe (Named NamedName Expr))
    -> Arg (Named NamedName (MaybePlaceholder (OpApp Expr)))
    -> Maybe (NamedArg Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Named NamedName (MaybePlaceholder (OpApp Expr))
      -> Maybe (Named NamedName Expr))
     -> Arg (Named NamedName (MaybePlaceholder (OpApp Expr)))
     -> Maybe (NamedArg Expr))
    -> ((MaybePlaceholder (OpApp Expr) -> TacticAttribute)
        -> Named NamedName (MaybePlaceholder (OpApp Expr))
        -> Maybe (Named NamedName Expr))
    -> (MaybePlaceholder (OpApp Expr) -> TacticAttribute)
    -> Arg (Named NamedName (MaybePlaceholder (OpApp Expr)))
    -> Maybe (NamedArg Expr)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (MaybePlaceholder (OpApp Expr) -> TacticAttribute)
    -> Named NamedName (MaybePlaceholder (OpApp Expr))
    -> Maybe (Named NamedName Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse) MaybePlaceholder (OpApp Expr) -> TacticAttribute
    forall a. MaybePlaceholder (OpApp a) -> Maybe a
    fromNoPlaceholder OpAppArgs
    as of
                      Just [NamedArg Expr]
    as -> Range -> QName -> Set Name -> [NamedArg Pattern] -> Pattern
    OpAppP Range
    r QName
    q Set Name
    ns ([NamedArg Pattern] -> Pattern)
    -> TCMT IO [NamedArg Pattern] -> TCMT IO Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                        ((NamedArg Expr -> TCMT IO (NamedArg Pattern))
    -> [NamedArg Expr] -> TCMT IO [NamedArg Pattern]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((NamedArg Expr -> TCMT IO (NamedArg Pattern))
     -> [NamedArg Expr] -> TCMT IO [NamedArg Pattern])
    -> ((Expr -> TCMT IO Pattern)
        -> NamedArg Expr -> TCMT IO (NamedArg Pattern))
    -> (Expr -> TCMT IO Pattern)
    -> [NamedArg Expr]
    -> TCMT IO [NamedArg Pattern]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Named NamedName Expr -> TCMT IO (Named NamedName Pattern))
    -> NamedArg Expr -> TCMT IO (NamedArg Pattern)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Named NamedName Expr -> TCMT IO (Named NamedName Pattern))
     -> NamedArg Expr -> TCMT IO (NamedArg Pattern))
    -> ((Expr -> TCMT IO Pattern)
        -> Named NamedName Expr -> TCMT IO (Named NamedName Pattern))
    -> (Expr -> TCMT IO Pattern)
    -> NamedArg Expr
    -> TCMT IO (NamedArg Pattern)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Expr -> TCMT IO Pattern)
    -> Named NamedName Expr -> TCMT IO (Named NamedName Pattern)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse) (Range -> Expr -> TCMT IO Pattern
    distributeDotsExpr Range
    r) [NamedArg Expr]
    as
                      Maybe [NamedArg Expr]
    Nothing -> Pattern -> TCMT IO Pattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> TCMT IO Pattern) -> Pattern -> TCMT IO Pattern
    forall a b. (a -> b) -> a -> b
    $ Range -> Expr -> Pattern
    C.DotP Range
    r Expr
    e
                  Paren Range
    r Expr
    e -> Range -> KillRangeT Pattern
    ParenP Range
    r KillRangeT Pattern -> TCMT IO Pattern -> TCMT IO Pattern
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Range -> Expr -> TCMT IO Pattern
    distributeDotsExpr Range
    r Expr
    e
                  Expr
    _ -> Pattern -> TCMT IO Pattern
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern -> TCMT IO Pattern) -> Pattern -> TCMT IO Pattern
    forall a b. (a -> b) -> a -> b
    $ Range -> Expr -> Pattern
    C.DotP Range
    r Expr
    e

                fromNoPlaceholder :: MaybePlaceholder (OpApp a) -> Maybe a
                fromNoPlaceholder :: forall a. MaybePlaceholder (OpApp a) -> Maybe a
    fromNoPlaceholder (NoPlaceholder Maybe PositionInName
    _ (Ordinary a
    e)) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    e
                fromNoPlaceholder MaybePlaceholder (OpApp a)
    _ = Maybe a
    forall a. Maybe a
    Nothing

                parseRawApp :: C.Expr -> ScopeM C.Expr
                parseRawApp :: Expr -> TCMT IO Expr
    parseRawApp (RawApp Range
    r List2 Expr
    es) = List2 Expr -> TCMT IO Expr
    parseApplication List2 Expr
    es
                parseRawApp Expr
    e             = Expr -> TCMT IO Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return Expr
    e

        toAbstract p0 :: Pattern
    p0@(OpAppP Range
    r QName
    op Set Name
    ns [NamedArg Pattern]
    ps) = do
            [Char] -> Int -> [Char] -> TCMT IO ()
    forall (m :: * -> *).
    MonadDebug m =>
    [Char] -> Int -> [Char] -> m ()
    reportSLn [Char]
    "scope.pat" Int
    60 ([Char] -> TCMT IO ()) -> [Char] -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "ConcreteToAbstract.toAbstract OpAppP{}: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> [Char]
    forall a. Show a => a -> [Char]
    show Pattern
    p0
            Pattern' Expr
    p  <- Range -> QName -> Maybe (Set Name) -> TCMT IO (Pattern' Expr)
    resolvePatternIdentifier (QName -> Range
    forall a. HasRange a => a -> Range
    getRange QName
    op) QName
    op (Set Name -> Maybe (Set Name)
    forall a. a -> Maybe a
    Just Set Name
    ns)
            [Arg (Named NamedName (Pattern' Expr))]
    ps <- [NamedArg Pattern] -> ScopeM (AbsOfCon [NamedArg Pattern])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [NamedArg Pattern]
    ps
            Pattern
    -> Pattern' Expr
    -> [Arg (Named NamedName (Pattern' Expr))]
    -> TCMT IO (Pattern' Expr)
    applyAPattern Pattern
    p0 Pattern' Expr
    p [Arg (Named NamedName (Pattern' Expr))]
    ps

        toAbstract (EllipsisP Range
    _ Maybe Pattern
    mp) = TCMT IO (Pattern' Expr)
    -> (Pattern -> TCMT IO (Pattern' Expr))
    -> Maybe Pattern
    -> TCMT IO (Pattern' Expr)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe TCMT IO (Pattern' Expr)
    forall a. HasCallStack => a
    __IMPOSSIBLE__ Pattern -> TCMT IO (Pattern' Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Maybe Pattern
    mp

        -- Removed when parsing
        toAbstract (HiddenP Range
    _ Named NamedName Pattern
    _)   = ScopeM (AbsOfCon Pattern)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        toAbstract (InstanceP Range
    _ Named NamedName Pattern
    _) = ScopeM (AbsOfCon Pattern)
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        toAbstract (RawAppP Range
    _ List2 Pattern
    _)   = ScopeM (AbsOfCon Pattern)
    forall a. HasCallStack => a
    __IMPOSSIBLE__

        toAbstract p :: Pattern
    p@(C.WildP Range
    r)    = Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Pattern' Expr
    forall e. PatInfo -> Pattern' e
    A.WildP (Range -> PatInfo
    PatRange Range
    r)
        -- Andreas, 2015-05-28 futile attempt to fix issue 819: repeated variable on lhs "_"
        -- toAbstract p@(C.WildP r)    = A.VarP <$> freshName r "_"
        toAbstract (C.ParenP Range
    _ Pattern
    p)   = Pattern -> ScopeM (AbsOfCon Pattern)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Pattern
    p
        toAbstract (C.LitP Range
    r Literal
    l)     = Range -> TCMT IO (Pattern' Expr) -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Range
    r (TCMT IO (Pattern' Expr) -> TCMT IO (Pattern' Expr))
    -> TCMT IO (Pattern' Expr) -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Literal -> Pattern' Expr
    forall e. PatInfo -> Literal -> Pattern' e
    A.LitP (Range -> PatInfo
    PatRange Range
    r) Literal
    l Pattern' Expr -> TCMT IO () -> TCMT IO (Pattern' Expr)
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Literal -> TCMT IO ()
    checkLiteral Literal
    l

        toAbstract p0 :: Pattern
    p0@(C.AsP Range
    r Name
    x Pattern
    p) = do
            -- Andreas, 2018-06-30, issue #3147: as-variables can be non-linear a priori!
            -- x <- toAbstract (NewName PatternBound x)
            -- Andreas, 2020-05-01, issue #4631: as-variables should not shadow constructors.
            -- x <- bindPatternVariable x
          PatName -> ScopeM (AbsOfCon PatName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> Maybe (Set Name) -> PatName
    PatName (Name -> QName
    C.QName Name
    x) Maybe (Set Name)
    forall a. Maybe a
    Nothing) TCMT IO APatName
    -> (APatName -> TCMT IO (Pattern' Expr)) -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            VarPatName Name
    x        -> PatInfo -> BindName -> Pattern' Expr -> Pattern' Expr
    forall e. PatInfo -> BindName -> Pattern' e -> Pattern' e
    A.AsP (Range -> PatInfo
    PatRange Range
    r) (Name -> BindName
    A.mkBindName Name
    x) (Pattern' Expr -> Pattern' Expr)
    -> TCMT IO (Pattern' Expr) -> TCMT IO (Pattern' Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pattern -> ScopeM (AbsOfCon Pattern)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Pattern
    p
            ConPatName{}        -> Bool -> TCMT IO (Pattern' Expr)
    ignoreAsPat Bool
    False
            PatternSynPatName{} -> Bool -> TCMT IO (Pattern' Expr)
    ignoreAsPat Bool
    True
          where
          -- An @-bound name which shadows a constructor is illegal and becomes dead code.
          ignoreAsPat :: Bool -> TCMT IO (Pattern' Expr)
    ignoreAsPat Bool
    b = do
            Name -> TCMT IO () -> TCMT IO ()
    forall (m :: * -> *) x a.
    (MonadTrace m, HasRange x) =>
    x -> m a -> m a
    setCurrentRange Name
    x (TCMT IO () -> TCMT IO ()) -> TCMT IO () -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Warning -> TCMT IO ()
    forall (m :: * -> *).
    (HasCallStack, MonadWarning m) =>
    Warning -> m ()
    warning (Warning -> TCMT IO ()) -> Warning -> TCMT IO ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Warning
    AsPatternShadowsConstructorOrPatternSynonym Bool
    b
            Pattern -> ScopeM (AbsOfCon Pattern)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Pattern
    p

        toAbstract p0 :: Pattern
    p0@(C.EqualP Range
    r [(Expr, Expr)]
    es)  = Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> [(Expr, Expr)] -> Pattern' Expr
    forall e. PatInfo -> [(e, e)] -> Pattern' e
    A.EqualP (Range -> PatInfo
    PatRange Range
    r) [(Expr, Expr)]
    es

        -- We have to do dot patterns at the end since they can
        -- refer to the variables bound by the other patterns.
        toAbstract p0 :: Pattern
    p0@(C.DotP Range
    r Expr
    e) = do
          let fallback :: TCMT IO (Pattern' Expr)
    fallback = Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Expr -> Pattern' Expr
    forall e. PatInfo -> e -> Pattern' e
    A.DotP (Range -> PatInfo
    PatRange Range
    r) Expr
    e
          case Expr
    e of
            C.Ident QName
    x -> QName -> ScopeM ResolvedName
    resolveName QName
    x ScopeM ResolvedName
    -> (ResolvedName -> TCMT IO (Pattern' Expr))
    -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
              -- Andreas, 2018-06-19, #3130
              -- We interpret .x as postfix projection if x is a field name in scope
              FieldName List1 AbstractName
    xs -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> ProjOrigin -> AmbiguousQName -> Pattern' Expr
    forall e. PatInfo -> ProjOrigin -> AmbiguousQName -> Pattern' e
    A.ProjP (Range -> PatInfo
    PatRange Range
    r) ProjOrigin
    ProjPostfix (AmbiguousQName -> Pattern' Expr)
    -> AmbiguousQName -> Pattern' Expr
    forall a b. (a -> b) -> a -> b
    $ NonEmpty QName -> AmbiguousQName
    AmbQ (NonEmpty QName -> AmbiguousQName)
    -> NonEmpty QName -> AmbiguousQName
    forall a b. (a -> b) -> a -> b
    $
                (AbstractName -> QName) -> List1 AbstractName -> NonEmpty QName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AbstractName -> QName
    anameName List1 AbstractName
    xs
              ResolvedName
    _ -> TCMT IO (Pattern' Expr)
    fallback
            Expr
    _ -> TCMT IO (Pattern' Expr)
    ScopeM (AbsOfCon Pattern)
    fallback

        toAbstract p0 :: Pattern
    p0@(C.AbsurdP Range
    r)    = Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pattern' Expr -> TCMT IO (Pattern' Expr))
    -> Pattern' Expr -> TCMT IO (Pattern' Expr)
    forall a b. (a -> b) -> a -> b
    $ PatInfo -> Pattern' Expr
    forall e. PatInfo -> Pattern' e
    A.AbsurdP (Range -> PatInfo
    PatRange Range
    r)
        toAbstract (C.RecP Range
    r [FieldAssignment' Pattern]
    fs)       = PatInfo -> [FieldAssignment' (Pattern' Expr)] -> Pattern' Expr
    forall e. PatInfo -> [FieldAssignment' (Pattern' e)] -> Pattern' e
    A.RecP (Range -> PatInfo
    PatRange Range
    r) ([FieldAssignment' (Pattern' Expr)] -> Pattern' Expr)
    -> TCMT IO [FieldAssignment' (Pattern' Expr)]
    -> TCMT IO (Pattern' Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FieldAssignment' Pattern
     -> TCMT IO (FieldAssignment' (Pattern' Expr)))
    -> [FieldAssignment' Pattern]
    -> TCMT IO [FieldAssignment' (Pattern' Expr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((Pattern -> TCMT IO (Pattern' Expr))
    -> FieldAssignment' Pattern
    -> TCMT IO (FieldAssignment' (Pattern' Expr))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Pattern -> TCMT IO (Pattern' Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract) [FieldAssignment' Pattern]
    fs
        toAbstract (C.WithP Range
    r Pattern
    p)       = PatInfo -> Pattern' Expr -> Pattern' Expr
    forall e. PatInfo -> Pattern' e -> Pattern' e
    A.WithP (Range -> PatInfo
    PatRange Range
    r) (Pattern' Expr -> Pattern' Expr)
    -> TCMT IO (Pattern' Expr) -> TCMT IO (Pattern' Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pattern -> ScopeM (AbsOfCon Pattern)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Pattern
    p

    -- | An argument @OpApp C.Expr@ to an operator can have binders,
    --   in case the operator is some @syntax@-notation.
    --   For these binders, we have to create lambda-abstractions.
    toAbstractOpArg :: Precedence -> OpApp C.Expr -> ScopeM A.Expr
    toAbstractOpArg :: Precedence -> OpApp Expr -> ScopeM Expr
    toAbstractOpArg Precedence
    ctx (Ordinary Expr
    e)                 = Precedence -> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => Precedence -> c -> ScopeM (AbsOfCon c)
    toAbstractCtx Precedence
    ctx Expr
    e
    toAbstractOpArg Precedence
    ctx (SyntaxBindingLambda Range
    r NonEmpty (LamBinding' TypedBinding)
    bs Expr
    e) = Range
    -> NonEmpty (LamBinding' TypedBinding)
    -> Expr
    -> Precedence
    -> ScopeM Expr
    toAbstractLam Range
    r NonEmpty (LamBinding' TypedBinding)
    bs Expr
    e Precedence
    ctx

    -- | Turn an operator application into abstract syntax. Make sure to
    -- record the right precedences for the various arguments.
    toAbstractOpApp :: C.QName -> Set A.Name -> OpAppArgs -> ScopeM A.Expr
    toAbstractOpApp :: QName -> Set Name -> OpAppArgs -> ScopeM Expr
    toAbstractOpApp QName
    op Set Name
    ns OpAppArgs
    es = do
        -- Replace placeholders with bound variables.
        ([LamBinding]
    binders, [NamedArg (Either Expr (OpApp Expr))]
    es) <- OpAppArgs
    -> ScopeM ([LamBinding], [NamedArg (Either Expr (OpApp Expr))])
    forall e.
    OpAppArgs' e
    -> ScopeM ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    replacePlaceholders OpAppArgs
    es
        -- Get the notation for the operator.
        NewNotation
    nota <- QName -> Set Name -> ScopeM NewNotation
    getNotation QName
    op Set Name
    ns
        let parts :: Notation
    parts = NewNotation -> Notation
    notation NewNotation
    nota
        -- We can throw away the @BindingHoles@, since binders
        -- have been preprocessed into @OpApp C.Expr@.
        let nonBindingParts :: Notation
    nonBindingParts = (GenPart -> Bool) -> Notation -> Notation
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (GenPart -> Bool) -> GenPart -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenPart -> Bool
    isBindingHole) Notation
    parts
        -- We should be left with as many holes as we have been given args @es@.
        -- If not, crash.
        Bool -> TCMT IO () -> TCMT IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Notation -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ((GenPart -> Bool) -> Notation -> Notation
    forall a. (a -> Bool) -> [a] -> [a]
    filter GenPart -> Bool
    isAHole Notation
    nonBindingParts) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [NamedArg (Either Expr (OpApp Expr))] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [NamedArg (Either Expr (OpApp Expr))]
    es) TCMT IO ()
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        -- Translate operator and its arguments (each in the right context).
        Expr
    op <- OldQName -> ScopeM (AbsOfCon OldQName)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract (QName -> Maybe (Set Name) -> OldQName
    OldQName QName
    op (Set Name -> Maybe (Set Name)
    forall a. a -> Maybe a
    Just Set Name
    ns))
        [(ParenPreference, NamedArg Expr)]
    es <- Fixity
    -> Notation
    -> [NamedArg (Either Expr (OpApp Expr))]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    left (NewNotation -> Fixity
    notaFixity NewNotation
    nota) Notation
    nonBindingParts [NamedArg (Either Expr (OpApp Expr))]
    es
        -- Prepend the generated section binders (if any).
        let body :: Expr
    body = (Expr -> (ParenPreference, NamedArg Expr) -> Expr)
    -> Expr -> [(ParenPreference, NamedArg Expr)] -> Expr
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' Expr -> (ParenPreference, NamedArg Expr) -> Expr
    app Expr
    op [(ParenPreference, NamedArg Expr)]
    es
        Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr -> ScopeM Expr) -> Expr -> ScopeM Expr
    forall a b. (a -> b) -> a -> b
    $ (LamBinding -> Expr -> Expr) -> Expr -> [LamBinding] -> Expr
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (ExprInfo -> LamBinding -> Expr -> Expr
    A.Lam (Range -> ExprInfo
    ExprRange (Expr -> Range
    forall a. HasRange a => a -> Range
    getRange Expr
    body))) Expr
    body [LamBinding]
    binders
      where
        -- Build an application in the abstract syntax, with correct Range.
        app :: Expr -> (ParenPreference, NamedArg Expr) -> Expr
    app Expr
    e (ParenPreference
    pref, NamedArg Expr
    arg) = AppInfo -> Expr -> NamedArg Expr -> Expr
    A.App AppInfo
    info Expr
    e NamedArg Expr
    arg
          where info :: AppInfo
    info = (Range -> AppInfo
    defaultAppInfo Range
    r) { appOrigin :: Origin
    appOrigin = NamedArg Expr -> Origin
    forall a. LensOrigin a => a -> Origin
    getOrigin NamedArg Expr
    arg
                                          , appParens :: ParenPreference
    appParens = ParenPreference
    pref }
                r :: Range
    r = Expr -> NamedArg Expr -> Range
    forall u t. (HasRange u, HasRange t) => u -> t -> Range
    fuseRange Expr
    e NamedArg Expr
    arg

        inferParenPref :: NamedArg (Either A.Expr (OpApp C.Expr)) -> ParenPreference
        inferParenPref :: NamedArg (Either Expr (OpApp Expr)) -> ParenPreference
    inferParenPref NamedArg (Either Expr (OpApp Expr))
    e =
          case NamedArg (Either Expr (OpApp Expr)) -> Either Expr (OpApp Expr)
    forall a. NamedArg a -> a
    namedArg NamedArg (Either Expr (OpApp Expr))
    e of
            Right (Ordinary Expr
    e) -> Expr -> ParenPreference
    inferParenPreference Expr
    e
            Left{}             -> ParenPreference
    PreferParenless  -- variable inserted by section expansion
            Right{}            -> ParenPreference
    PreferParenless  -- syntax lambda

        -- Translate an argument. Returns the paren preference for the argument, so
        -- we can build the correct info for the A.App node.
        toAbsOpArg :: Precedence ->
                      NamedArg (Either A.Expr (OpApp C.Expr)) ->
                      ScopeM (ParenPreference, NamedArg A.Expr)
        toAbsOpArg :: Precedence
    -> NamedArg (Either Expr (OpApp Expr))
    -> ScopeM (ParenPreference, NamedArg Expr)
    toAbsOpArg Precedence
    cxt NamedArg (Either Expr (OpApp Expr))
    e = (ParenPreference
    pref,) (NamedArg Expr -> (ParenPreference, NamedArg Expr))
    -> TCMT IO (NamedArg Expr)
    -> ScopeM (ParenPreference, NamedArg Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Named NamedName (Either Expr (OpApp Expr))
     -> TCMT IO (Named NamedName Expr))
    -> NamedArg (Either Expr (OpApp Expr)) -> TCMT IO (NamedArg Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Named NamedName (Either Expr (OpApp Expr))
      -> TCMT IO (Named NamedName Expr))
     -> NamedArg (Either Expr (OpApp Expr)) -> TCMT IO (NamedArg Expr))
    -> ((Either Expr (OpApp Expr) -> ScopeM Expr)
        -> Named NamedName (Either Expr (OpApp Expr))
        -> TCMT IO (Named NamedName Expr))
    -> (Either Expr (OpApp Expr) -> ScopeM Expr)
    -> NamedArg (Either Expr (OpApp Expr))
    -> TCMT IO (NamedArg Expr)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Either Expr (OpApp Expr) -> ScopeM Expr)
    -> Named NamedName (Either Expr (OpApp Expr))
    -> TCMT IO (Named NamedName Expr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse) ((Expr -> ScopeM Expr)
    -> (OpApp Expr -> ScopeM Expr)
    -> Either Expr (OpApp Expr)
    -> ScopeM Expr
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Expr -> ScopeM Expr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Precedence -> OpApp Expr -> ScopeM Expr
    toAbstractOpArg Precedence
    cxt)) NamedArg (Either Expr (OpApp Expr))
    e
          where pref :: ParenPreference
    pref = NamedArg (Either Expr (OpApp Expr)) -> ParenPreference
    inferParenPref NamedArg (Either Expr (OpApp Expr))
    e

        -- The hole left to the first @IdPart@ is filled with an expression in @LeftOperandCtx@.
        left :: Fixity
    -> Notation
    -> [NamedArg (Either Expr (OpApp Expr))]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    left Fixity
    f (IdPart RString
    _ : Notation
    xs) [NamedArg (Either Expr (OpApp Expr))]
    es = Fixity
    -> Notation
    -> [NamedArg (Either Expr (OpApp Expr))]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    inside Fixity
    f Notation
    xs [NamedArg (Either Expr (OpApp Expr))]
    es
        left Fixity
    f (GenPart
    _ : Notation
    xs) (NamedArg (Either Expr (OpApp Expr))
    e : [NamedArg (Either Expr (OpApp Expr))]
    es) = do
            (ParenPreference, NamedArg Expr)
    e  <- Precedence
    -> NamedArg (Either Expr (OpApp Expr))
    -> ScopeM (ParenPreference, NamedArg Expr)
    toAbsOpArg (Fixity -> Precedence
    LeftOperandCtx Fixity
    f) NamedArg (Either Expr (OpApp Expr))
    e
            [(ParenPreference, NamedArg Expr)]
    es <- Fixity
    -> Notation
    -> [NamedArg (Either Expr (OpApp Expr))]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    inside Fixity
    f Notation
    xs [NamedArg (Either Expr (OpApp Expr))]
    es
            [(ParenPreference, NamedArg Expr)]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((ParenPreference, NamedArg Expr)
    e (ParenPreference, NamedArg Expr)
    -> [(ParenPreference, NamedArg Expr)]
    -> [(ParenPreference, NamedArg Expr)]
    forall a. a -> [a] -> [a]
    : [(ParenPreference, NamedArg Expr)]
    es)
        left Fixity
    f (GenPart
    _  : Notation
    _)  [] = TCMT IO [(ParenPreference, NamedArg Expr)]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        left Fixity
    f []        [NamedArg (Either Expr (OpApp Expr))]
    _  = TCMT IO [(ParenPreference, NamedArg Expr)]
    forall a. HasCallStack => a
    __IMPOSSIBLE__

        -- The holes in between the @IdPart@s is filled with an expression in @InsideOperandCtx@.
        inside :: Fixity
    -> Notation
    -> [NamedArg (Either Expr (OpApp Expr))]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    inside Fixity
    f [GenPart
    x]          [NamedArg (Either Expr (OpApp Expr))]
    es    = Fixity
    -> GenPart
    -> [NamedArg (Either Expr (OpApp Expr))]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    right Fixity
    f GenPart
    x [NamedArg (Either Expr (OpApp Expr))]
    es
        inside Fixity
    f (IdPart RString
    _ : Notation
    xs) [NamedArg (Either Expr (OpApp Expr))]
    es = Fixity
    -> Notation
    -> [NamedArg (Either Expr (OpApp Expr))]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    inside Fixity
    f Notation
    xs [NamedArg (Either Expr (OpApp Expr))]
    es
        inside Fixity
    f (GenPart
    _  : Notation
    xs) (NamedArg (Either Expr (OpApp Expr))
    e : [NamedArg (Either Expr (OpApp Expr))]
    es) = do
            (ParenPreference, NamedArg Expr)
    e  <- Precedence
    -> NamedArg (Either Expr (OpApp Expr))
    -> ScopeM (ParenPreference, NamedArg Expr)
    toAbsOpArg Precedence
    InsideOperandCtx NamedArg (Either Expr (OpApp Expr))
    e
            [(ParenPreference, NamedArg Expr)]
    es <- Fixity
    -> Notation
    -> [NamedArg (Either Expr (OpApp Expr))]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    inside Fixity
    f Notation
    xs [NamedArg (Either Expr (OpApp Expr))]
    es
            [(ParenPreference, NamedArg Expr)]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((ParenPreference, NamedArg Expr)
    e (ParenPreference, NamedArg Expr)
    -> [(ParenPreference, NamedArg Expr)]
    -> [(ParenPreference, NamedArg Expr)]
    forall a. a -> [a] -> [a]
    : [(ParenPreference, NamedArg Expr)]
    es)
        inside Fixity
    _ (GenPart
    _ : Notation
    _) [] = TCMT IO [(ParenPreference, NamedArg Expr)]
    forall a. HasCallStack => a
    __IMPOSSIBLE__
        inside Fixity
    _ []         [NamedArg (Either Expr (OpApp Expr))]
    _  = TCMT IO [(ParenPreference, NamedArg Expr)]
    forall a. HasCallStack => a
    __IMPOSSIBLE__

        -- The hole right of the last @IdPart@ is filled with an expression in @RightOperandCtx@.
        right :: Fixity
    -> GenPart
    -> [NamedArg (Either Expr (OpApp Expr))]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    right Fixity
    _ (IdPart RString
    _)  [] = [(ParenPreference, NamedArg Expr)]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        right Fixity
    f GenPart
    _          [NamedArg (Either Expr (OpApp Expr))
    e] = do
            let pref :: ParenPreference
    pref = NamedArg (Either Expr (OpApp Expr)) -> ParenPreference
    inferParenPref NamedArg (Either Expr (OpApp Expr))
    e
            (ParenPreference, NamedArg Expr)
    e <- Precedence
    -> NamedArg (Either Expr (OpApp Expr))
    -> ScopeM (ParenPreference, NamedArg Expr)
    toAbsOpArg (Fixity -> ParenPreference -> Precedence
    RightOperandCtx Fixity
    f ParenPreference
    pref) NamedArg (Either Expr (OpApp Expr))
    e
            [(ParenPreference, NamedArg Expr)]
    -> TCMT IO [(ParenPreference, NamedArg Expr)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(ParenPreference, NamedArg Expr)
    e]
        right Fixity
    _ GenPart
    _     [NamedArg (Either Expr (OpApp Expr))]
    _  = TCMT IO [(ParenPreference, NamedArg Expr)]
    forall a. HasCallStack => a
    __IMPOSSIBLE__

        replacePlaceholders ::
          OpAppArgs' e ->
          ScopeM ([A.LamBinding], [NamedArg (Either A.Expr (OpApp e))])
        replacePlaceholders :: forall e.
    OpAppArgs' e
    -> ScopeM ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    replacePlaceholders []       = ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    -> TCMT IO ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
        replacePlaceholders (NamedArg (MaybePlaceholder (OpApp e))
    a : [NamedArg (MaybePlaceholder (OpApp e))]
    as) = case NamedArg (MaybePlaceholder (OpApp e)) -> MaybePlaceholder (OpApp e)
    forall a. NamedArg a -> a
    namedArg NamedArg (MaybePlaceholder (OpApp e))
    a of
          NoPlaceholder Maybe PositionInName
    _ OpApp e
    x -> ([NamedArg (Either Expr (OpApp e))]
     -> [NamedArg (Either Expr (OpApp e))])
    -> ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    -> ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    forall b d a. (b -> d) -> (a, b) -> (a, d)
    mapSnd (Either Expr (OpApp e)
    -> NamedArg (MaybePlaceholder (OpApp e))
    -> NamedArg (Either Expr (OpApp e))
    forall a b. a -> NamedArg b -> NamedArg a
    set (OpApp e -> Either Expr (OpApp e)
    forall a b. b -> Either a b
    Right OpApp e
    x) NamedArg (MaybePlaceholder (OpApp e))
    a NamedArg (Either Expr (OpApp e))
    -> [NamedArg (Either Expr (OpApp e))]
    -> [NamedArg (Either Expr (OpApp e))]
    forall a. a -> [a] -> [a]
    :) (([LamBinding], [NamedArg (Either Expr (OpApp e))])
     -> ([LamBinding], [NamedArg (Either Expr (OpApp e))]))
    -> TCMT IO ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    -> TCMT IO ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                 [NamedArg (MaybePlaceholder (OpApp e))]
    -> TCMT IO ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    forall e.
    OpAppArgs' e
    -> ScopeM ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    replacePlaceholders [NamedArg (MaybePlaceholder (OpApp e))]
    as
          Placeholder PositionInName
    _     -> do
            Name
    x <- Range -> [Char] -> ScopeM Name
    forall (m :: * -> *).
    MonadFresh NameId m =>
    Range -> [Char] -> m Name
    freshName Range
    forall a. Range' a
    noRange [Char]
    "section"
            let i :: ArgInfo
    i = Origin -> ArgInfo -> ArgInfo
    forall a. LensOrigin a => Origin -> a -> a
    setOrigin Origin
    Inserted (ArgInfo -> ArgInfo) -> ArgInfo -> ArgInfo
    forall a b. (a -> b) -> a -> b
    $ NamedArg (MaybePlaceholder (OpApp e)) -> ArgInfo
    forall e. Arg e -> ArgInfo
    argInfo NamedArg (MaybePlaceholder (OpApp e))
    a
            ([LamBinding]
    ls, [NamedArg (Either Expr (OpApp e))]
    ns) <- [NamedArg (MaybePlaceholder (OpApp e))]
    -> TCMT IO ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    forall e.
    OpAppArgs' e
    -> ScopeM ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    replacePlaceholders [NamedArg (MaybePlaceholder (OpApp e))]
    as
            ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    -> TCMT IO ([LamBinding], [NamedArg (Either Expr (OpApp e))])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( NamedArg (Binder' BindName) -> LamBinding
    A.mkDomainFree (ArgInfo -> Binder' BindName -> NamedArg (Binder' BindName)
    forall a. ArgInfo -> a -> NamedArg a
    unnamedArg ArgInfo
    i (Binder' BindName -> NamedArg (Binder' BindName))
    -> Binder' BindName -> NamedArg (Binder' BindName)
    forall a b. (a -> b) -> a -> b
    $ Name -> Binder' BindName
    A.mkBinder_ Name
    x) LamBinding -> [LamBinding] -> [LamBinding]
    forall a. a -> [a] -> [a]
    : [LamBinding]
    ls
                   , Either Expr (OpApp e)
    -> NamedArg (MaybePlaceholder (OpApp e))
    -> NamedArg (Either Expr (OpApp e))
    forall a b. a -> NamedArg b -> NamedArg a
    set (Expr -> Either Expr (OpApp e)
    forall a b. a -> Either a b
    Left (Name -> Expr
    Var Name
    x)) NamedArg (MaybePlaceholder (OpApp e))
    a NamedArg (Either Expr (OpApp e))
    -> [NamedArg (Either Expr (OpApp e))]
    -> [NamedArg (Either Expr (OpApp e))]
    forall a. a -> [a] -> [a]
    : [NamedArg (Either Expr (OpApp e))]
    ns
                   )
          where
          set :: a -> NamedArg b -> NamedArg a
          set :: forall a b. a -> NamedArg b -> NamedArg a
    set a
    x NamedArg b
    arg = (Named NamedName b -> Named NamedName a)
    -> NamedArg b -> Arg (Named NamedName a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((b -> a) -> Named NamedName b -> Named NamedName a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> b -> a
    forall a b. a -> b -> a
    const a
    x)) NamedArg b
    arg

    {--------------------------------------------------------------------------
        Things we parse but are not part of the Agda file syntax
     --------------------------------------------------------------------------}

    -- | Content of interaction hole.

    instance ToAbstract C.HoleContent where
      type AbsOfCon C.HoleContent = A.HoleContent
      toAbstract :: HoleContent -> ScopeM (AbsOfCon HoleContent)
    toAbstract = \case
        HoleContentExpr Expr
    e     -> Expr -> HoleContent' () BindName Pattern Expr
    forall qn nm p e. e -> HoleContent' qn nm p e
    HoleContentExpr (Expr -> HoleContent' () BindName Pattern Expr)
    -> ScopeM Expr -> TCMT IO (HoleContent' () BindName Pattern Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr -> ScopeM (AbsOfCon Expr)
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract Expr
    e
        HoleContentRewrite [RewriteEqn]
    es -> [RewriteEqn' () BindName Pattern Expr]
    -> HoleContent' () BindName Pattern Expr
    forall qn nm p e. [RewriteEqn' qn nm p e] -> HoleContent' qn nm p e
    HoleContentRewrite ([RewriteEqn' () BindName Pattern Expr]
     -> HoleContent' () BindName Pattern Expr)
    -> TCMT IO [RewriteEqn' () BindName Pattern Expr]
    -> TCMT IO (HoleContent' () BindName Pattern Expr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [RewriteEqn] -> ScopeM (AbsOfCon [RewriteEqn])
    forall c. ToAbstract c => c -> ScopeM (AbsOfCon c)
    toAbstract [RewriteEqn]
    es