{-# LANGUAGE NondecreasingIndentation #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Agda.TypeChecking.Errors
  ( prettyError
  , prettyWarning
  , tcErrString
  , prettyTCWarnings'
  , prettyTCWarnings
  , tcWarningsToError
  , applyFlagsToTCWarnings'
  , applyFlagsToTCWarnings
  , dropTopLevelModule
  , topLevelModuleDropper
  , stringTCErr
  ) where

import Prelude hiding ( null )

import Data.Function
import Data.List (sortBy, isInfixOf, dropWhileEnd)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe
import Data.Char (toLower)
import qualified Data.Set as Set
import qualified Text.PrettyPrint.Boxes as Boxes

import Agda.Syntax.Common
import Agda.Syntax.Concrete.Pretty (prettyHiding, prettyRelevance)
import Agda.Syntax.Fixity
import Agda.Syntax.Notation
import Agda.Syntax.Position
import qualified Agda.Syntax.Concrete as C
import Agda.Syntax.Abstract as A
import Agda.Syntax.Internal as I
import Agda.Syntax.Translation.InternalToAbstract
import Agda.Syntax.Scope.Monad (isDatatypeModule)
import Agda.Syntax.Scope.Base

import Agda.TypeChecking.Monad.Base
import Agda.TypeChecking.Monad.Closure
import Agda.TypeChecking.Monad.Context
import Agda.TypeChecking.Monad.Debug
import Agda.TypeChecking.Monad.Builtin
import Agda.TypeChecking.Monad.SizedTypes ( sizeType )
import Agda.TypeChecking.Monad.State
import Agda.TypeChecking.Pretty
import Agda.TypeChecking.Pretty.Call
import Agda.TypeChecking.Pretty.Warning
import Agda.TypeChecking.Substitute
import Agda.TypeChecking.Telescope ( ifPiType )
import Agda.TypeChecking.Reduce (instantiate)

import Agda.Utils.Except ( MonadError(catchError) )
import Agda.Utils.FileName
import Agda.Utils.Float  ( toStringWithoutDotZero )
import Agda.Utils.Function
import Agda.Utils.Maybe
import Agda.Utils.Null
import Agda.Utils.Pretty ( prettyShow )
import qualified Agda.Utils.Pretty as P
import Agda.Utils.Size

import Agda.Utils.Impossible

---------------------------------------------------------------------------
-- * Top level function
---------------------------------------------------------------------------

{-# SPECIALIZE prettyError :: TCErr -> TCM String #-}
prettyError :: MonadTCM tcm => TCErr -> tcm String
prettyError :: TCErr -> tcm String
prettyError TCErr
err = TCM String -> tcm String
forall (tcm :: * -> *) a. MonadTCM tcm => TCM a -> tcm a
liftTCM (TCM String -> tcm String) -> TCM String -> tcm String
forall a b. (a -> b) -> a -> b
$ Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> TCMT IO Doc -> TCM String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCErr -> [TCErr] -> TCMT IO Doc
prettyError' TCErr
err []
  where
  prettyError' :: TCErr -> [TCErr] -> TCM Doc
  prettyError' :: TCErr -> [TCErr] -> TCMT IO Doc
prettyError' TCErr
err [TCErr]
errs
    | [TCErr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TCErr]
errs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3 = [TCMT IO Doc] -> TCMT IO Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (
        String -> [TCMT IO Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"total panic: error when printing error from printing error from printing error." [TCMT IO Doc] -> [TCMT IO Doc] -> [TCMT IO Doc]
forall a. [a] -> [a] -> [a]
++
        String -> [TCMT IO Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"I give up! Approximations of errors (original error last):" )
        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 :: * -> *). Monad m => [m Doc] -> m Doc
vcat ((TCErr -> TCMT IO Doc) -> [TCErr] -> [TCMT IO Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> TCMT IO Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String -> TCMT IO Doc)
-> (TCErr -> String) -> TCErr -> TCMT IO Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TCErr -> String
tcErrString) [TCErr]
errs)
    | Bool
otherwise = Bool -> (TCMT IO Doc -> TCMT IO Doc) -> TCMT IO Doc -> TCMT IO Doc
forall a. Bool -> (a -> a) -> a -> a
applyUnless ([TCErr] -> Bool
forall a. Null a => a -> Bool
null [TCErr]
errs) (TCMT IO Doc
"panic: error when printing error!" 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) -> TCMT IO Doc -> TCMT IO Doc
forall a b. (a -> b) -> a -> b
$ do
        (TCErr -> TCMT IO Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM TCErr
err 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 :: * -> *). Monad m => [m Doc] -> m Doc
vcat ((TCErr -> TCMT IO Doc) -> [TCErr] -> [TCMT IO Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> TCMT IO Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String -> TCMT IO Doc)
-> (TCErr -> String) -> TCErr -> TCMT IO Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"when printing error " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (TCErr -> String) -> TCErr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TCErr -> String
tcErrString) [TCErr]
errs))
        TCMT IO Doc -> (TCErr -> TCMT IO Doc) -> TCMT IO Doc
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ TCErr
err' -> TCErr -> [TCErr] -> TCMT IO Doc
prettyError' TCErr
err' (TCErr
errTCErr -> [TCErr] -> [TCErr]
forall a. a -> [a] -> [a]
:[TCErr]
errs)

---------------------------------------------------------------------------
-- * Helpers
---------------------------------------------------------------------------

panic :: Monad m => String -> m Doc
panic :: String -> m Doc
panic String
s = String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$ String
"Panic: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

nameWithBinding :: MonadPretty m => QName -> m Doc
nameWithBinding :: QName -> m Doc
nameWithBinding QName
q =
  (QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
q m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> m Doc
"bound at") m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<?> Range -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Range
r
  where
    r :: Range
r = Name -> Range
nameBindingSite (Name -> Range) -> Name -> Range
forall a b. (a -> b) -> a -> b
$ QName -> Name
qnameName QName
q

tcErrString :: TCErr -> String
tcErrString :: TCErr -> String
tcErrString TCErr
err = Range -> String
forall a. Show a => a -> String
show (TCErr -> Range
forall t. HasRange t => t -> Range
getRange TCErr
err) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ case TCErr
err of
  TypeError TCState
_ Closure TypeError
cl    -> TypeError -> String
errorString (TypeError -> String) -> TypeError -> String
forall a b. (a -> b) -> a -> b
$ Closure TypeError -> TypeError
forall a. Closure a -> a
clValue Closure TypeError
cl
  Exception Range
r Doc
s     -> Range -> String
forall a. Show a => a -> String
show Range
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show Doc
s
  IOException TCState
_ Range
r IOException
e -> Range -> String
forall a. Show a => a -> String
show Range
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
e
  PatternErr{}      -> String
"PatternErr"

stringTCErr :: String -> TCErr
stringTCErr :: String -> TCErr
stringTCErr = Range -> Doc -> TCErr
Exception Range
forall a. Range' a
noRange (Doc -> TCErr) -> (String -> Doc) -> String -> TCErr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
P.text

errorString :: TypeError -> String
errorString :: TypeError -> String
errorString TypeError
err = case TypeError
err of
  AmbiguousModule{}                        -> String
"AmbiguousModule"
  AmbiguousName{}                          -> String
"AmbiguousName"
  AmbiguousParseForApplication{}           -> String
"AmbiguousParseForApplication"
  AmbiguousParseForLHS{}                   -> String
"AmbiguousParseForLHS"
--  AmbiguousParseForPatternSynonym{}        -> "AmbiguousParseForPatternSynonym"
  AmbiguousTopLevelModuleName {}           -> String
"AmbiguousTopLevelModuleName"
  BadArgumentsToPatternSynonym{}           -> String
"BadArgumentsToPatternSynonym"
  TooFewArgumentsToPatternSynonym{}        -> String
"TooFewArgumentsToPatternSynonym"
  CannotResolveAmbiguousPatternSynonym{}   -> String
"CannotResolveAmbiguousPatternSynonym"
  TypeError
BothWithAndRHS                           -> String
"BothWithAndRHS"
  BuiltinInParameterisedModule{}           -> String
"BuiltinInParameterisedModule"
  BuiltinMustBeConstructor{}               -> String
"BuiltinMustBeConstructor"
  ClashingDefinition{}                     -> String
"ClashingDefinition"
  ClashingFileNamesFor{}                   -> String
"ClashingFileNamesFor"
  ClashingImport{}                         -> String
"ClashingImport"
  ClashingModule{}                         -> String
"ClashingModule"
  ClashingModuleImport{}                   -> String
"ClashingModuleImport"
  CompilationError{}                       -> String
"CompilationError"
  ConstructorPatternInWrongDatatype{}      -> String
"ConstructorPatternInWrongDatatype"
  CyclicModuleDependency{}                 -> String
"CyclicModuleDependency"
  DataMustEndInSort{}                      -> String
"DataMustEndInSort"
-- UNUSED:    DataTooManyParameters{}                  -> "DataTooManyParameters"
  CantResolveOverloadedConstructorsTargetingSameDatatype{} -> String
"CantResolveOverloadedConstructorsTargetingSameDatatype"
  DoesNotConstructAnElementOf{}            -> String
"DoesNotConstructAnElementOf"
  DuplicateBuiltinBinding{}                -> String
"DuplicateBuiltinBinding"
  DuplicateConstructors{}                  -> String
"DuplicateConstructors"
  DuplicateFields{}                        -> String
"DuplicateFields"
  DuplicateImports{}                       -> String
"DuplicateImports"
  TypeError
FieldOutsideRecord                       -> String
"FieldOutsideRecord"
  FileNotFound{}                           -> String
"FileNotFound"
  GenericError{}                           -> String
"GenericError"
  GenericDocError{}                        -> String
"GenericDocError"
  InstanceNoCandidate{}                    -> String
"InstanceNoCandidate"
  IlltypedPattern{}                        -> String
"IlltypedPattern"
  IllformedProjectionPattern{}             -> String
"IllformedProjectionPattern"
  CannotEliminateWithPattern{}             -> String
"CannotEliminateWithPattern"
  IllegalLetInTelescope{}                  -> String
"IllegalLetInTelescope"
  IllegalPatternInTelescope{}              -> String
"IllegalPatternInTelescope"
-- UNUSED:  IncompletePatternMatching{}              -> "IncompletePatternMatching"
  InternalError{}                          -> String
"InternalError"
  InvalidPattern{}                         -> String
"InvalidPattern"
  LocalVsImportedModuleClash{}             -> String
"LocalVsImportedModuleClash"
  MetaCannotDependOn{}                     -> String
"MetaCannotDependOn"
  MetaOccursInItself{}                     -> String
"MetaOccursInItself"
  MetaIrrelevantSolution{}                 -> String
"MetaIrrelevantSolution"
  MetaErasedSolution{}                     -> String
"MetaErasedSolution"
  ModuleArityMismatch{}                    -> String
"ModuleArityMismatch"
  ModuleDefinedInOtherFile {}              -> String
"ModuleDefinedInOtherFile"
  ModuleNameUnexpected{}                   -> String
"ModuleNameUnexpected"
  ModuleNameDoesntMatchFileName {}         -> String
"ModuleNameDoesntMatchFileName"
  NeedOptionCopatterns{}                   -> String
"NeedOptionCopatterns"
  NeedOptionRewriting{}                    -> String
"NeedOptionRewriting"
  NeedOptionProp{}                         -> String
"NeedOptionProp"
  GeneralizeNotSupportedHere{}             -> String
"GeneralizeNotSupportedHere"
  GeneralizeCyclicDependency{}             -> String
"GeneralizeCyclicDependency"
  GeneralizeUnsolvedMeta{}                 -> String
"GeneralizeUnsolvedMeta"
  MultipleFixityDecls{}                    -> String
"MultipleFixityDecls"
  MultiplePolarityPragmas{}                -> String
"MultiplePolarityPragmas"
  NoBindingForBuiltin{}                    -> String
"NoBindingForBuiltin"
  NoParseForApplication{}                  -> String
"NoParseForApplication"
  NoParseForLHS{}                          -> String
"NoParseForLHS"
--  NoParseForPatternSynonym{}               -> "NoParseForPatternSynonym"
  NoRHSRequiresAbsurdPattern{}             -> String
"NoRHSRequiresAbsurdPattern"
  NoSuchBuiltinName{}                      -> String
"NoSuchBuiltinName"
  NoSuchModule{}                           -> String
"NoSuchModule"
  DuplicatePrimitiveBinding{}              -> String
"DuplicatePrimitiveBinding"
  NoSuchPrimitiveFunction{}                -> String
"NoSuchPrimitiveFunction"
  NotAModuleExpr{}                         -> String
"NotAModuleExpr"
  TypeError
NotAProperTerm                           -> String
"NotAProperTerm"
  InvalidType{}                            -> String
"InvalidType"
  InvalidTypeSort{}                        -> String
"InvalidTypeSort"
  FunctionTypeInSizeUniv{}                 -> String
"FunctionTypeInSizeUniv"
  NotAValidLetBinding{}                    -> String
"NotAValidLetBinding"
  NotValidBeforeField{}                    -> String
"NotValidBeforeField"
  NotAnExpression{}                        -> String
"NotAnExpression"
  NotImplemented{}                         -> String
"NotImplemented"
  NotSupported{}                           -> String
"NotSupported"
  AbstractConstructorNotInScope{}          -> String
"AbstractConstructorNotInScope"
  NotInScope{}                             -> String
"NotInScope"
  NotLeqSort{}                             -> String
"NotLeqSort"
  NothingAppliedToHiddenArg{}              -> String
"NothingAppliedToHiddenArg"
  NothingAppliedToInstanceArg{}            -> String
"NothingAppliedToInstanceArg"
  OverlappingProjects {}                   -> String
"OverlappingProjects"
  OperatorInformation {}                   -> String
"OperatorInformation"
  PatternShadowsConstructor {}             -> String
"PatternShadowsConstructor"
  TypeError
PropMustBeSingleton                      -> String
"PropMustBeSingleton"
  RepeatedVariablesInPattern{}             -> String
"RepeatedVariablesInPattern"
  ShadowedModule{}                         -> String
"ShadowedModule"
  ShouldBeASort{}                          -> String
"ShouldBeASort"
  ShouldBeApplicationOf{}                  -> String
"ShouldBeApplicationOf"
  ShouldBeAppliedToTheDatatypeParameters{} -> String
"ShouldBeAppliedToTheDatatypeParameters"
  ShouldBeEmpty{}                          -> String
"ShouldBeEmpty"
  ShouldBePi{}                             -> String
"ShouldBePi"
  ShouldBePath{}                           -> String
"ShouldBePath"
  ShouldBeRecordType{}                     -> String
"ShouldBeRecordType"
  ShouldBeRecordPattern{}                  -> String
"ShouldBeRecordPattern"
  NotAProjectionPattern{}                  -> String
"NotAProjectionPattern"
  ShouldEndInApplicationOfTheDatatype{}    -> String
"ShouldEndInApplicationOfTheDatatype"
  SplitError{}                             -> String
"SplitError"
  ImpossibleConstructor{}                  -> String
"ImpossibleConstructor"
  TooManyFields{}                          -> String
"TooManyFields"
  TooManyPolarities{}                      -> String
"TooManyPolarities"
  SplitOnIrrelevant{}                      -> String
"SplitOnIrrelevant"
  SplitOnUnusableCohesion{}                -> String
"SplitOnUnusableCohesion"
  -- UNUSED: -- SplitOnErased{}                          -> "SplitOnErased"
  SplitOnNonVariable{}                     -> String
"SplitOnNonVariable"
  DefinitionIsIrrelevant{}                 -> String
"DefinitionIsIrrelevant"
  DefinitionIsErased{}                     -> String
"DefinitionIsErased"
  VariableIsIrrelevant{}                   -> String
"VariableIsIrrelevant"
  VariableIsErased{}                       -> String
"VariableIsErased"
  VariableIsOfUnusableCohesion{}           -> String
"VariableIsOfUnusableCohesion"
  UnequalBecauseOfUniverseConflict{}       -> String
"UnequalBecauseOfUniverseConflict"
  UnequalRelevance{}                       -> String
"UnequalRelevance"
  UnequalQuantity{}                        -> String
"UnequalQuantity"
  UnequalCohesion{}                        -> String
"UnequalCohesion"
  UnequalHiding{}                          -> String
"UnequalHiding"
  UnequalLevel{}                           -> String
"UnequalLevel"
  UnequalSorts{}                           -> String
"UnequalSorts"
  UnequalTerms{}                           -> String
"UnequalTerms"
  UnequalTypes{}                           -> String
"UnequalTypes"
--  UnequalTelescopes{}                      -> "UnequalTelescopes" -- UNUSED
  WithOnFreeVariable{}                     -> String
"WithOnFreeVariable"
  UnexpectedWithPatterns{}                 -> String
"UnexpectedWithPatterns"
  UninstantiatedDotPattern{}               -> String
"UninstantiatedDotPattern"
  ForcedConstructorNotInstantiated{}       -> String
"ForcedConstructorNotInstantiated"
  SolvedButOpenHoles{}                     -> String
"SolvedButOpenHoles"
  TypeError
UnusedVariableInPatternSynonym           -> String
"UnusedVariableInPatternSynonym"
  UnquoteFailed{}                          -> String
"UnquoteFailed"
  DeBruijnIndexOutOfScope{}                -> String
"DeBruijnIndexOutOfScope"
  WithClausePatternMismatch{}              -> String
"WithClausePatternMismatch"
  WrongHidingInApplication{}               -> String
"WrongHidingInApplication"
  WrongHidingInLHS{}                       -> String
"WrongHidingInLHS"
  WrongHidingInLambda{}                    -> String
"WrongHidingInLambda"
  WrongIrrelevanceInLambda{}               -> String
"WrongIrrelevanceInLambda"
  WrongQuantityInLambda{}                  -> String
"WrongQuantityInLambda"
  WrongCohesionInLambda{}                  -> String
"WrongCohesionInLambda"
  WrongNamedArgument{}                     -> String
"WrongNamedArgument"
  WrongNumberOfConstructorArguments{}      -> String
"WrongNumberOfConstructorArguments"
  QuantityMismatch{}                       -> String
"QuantityMismatch"
  HidingMismatch{}                         -> String
"HidingMismatch"
  RelevanceMismatch{}                      -> String
"RelevanceMismatch"
  NonFatalErrors{}                         -> String
"NonFatalErrors"
  InstanceSearchDepthExhausted{}           -> String
"InstanceSearchDepthExhausted"
  TriedToCopyConstrainedPrim{}             -> String
"TriedToCopyConstrainedPrim"

instance PrettyTCM TCErr where
  prettyTCM :: TCErr -> m Doc
prettyTCM TCErr
err = case TCErr
err of
    -- Gallais, 2016-05-14
    -- Given where `NonFatalErrors` are created, we know for a
    -- fact that ̀ws` is non-empty.
    TypeError TCState
_ Closure{ clValue :: forall a. Closure a -> a
clValue = NonFatalErrors [TCWarning]
ws } -> (m Doc -> m Doc -> m Doc) -> [m Doc] -> m Doc
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
($$) ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (TCWarning -> m Doc) -> [TCWarning] -> [m Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TCWarning -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM [TCWarning]
ws
    -- Andreas, 2014-03-23
    -- This use of withTCState seems ok since we do not collect
    -- Benchmark info during printing errors.
    TypeError TCState
s Closure TypeError
e -> (TCState -> TCState) -> m Doc -> m Doc
forall (m :: * -> *) a.
ReadTCState m =>
(TCState -> TCState) -> m a -> m a
withTCState (TCState -> TCState -> TCState
forall a b. a -> b -> a
const TCState
s) (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$
      Range -> Maybe (Closure Call) -> m Doc -> m Doc
forall (m :: * -> *).
MonadPretty m =>
Range -> Maybe (Closure Call) -> m Doc -> m Doc
sayWhen (TCEnv -> Range
envRange (TCEnv -> Range) -> TCEnv -> Range
forall a b. (a -> b) -> a -> b
$ Closure TypeError -> TCEnv
forall a. Closure a -> TCEnv
clEnv Closure TypeError
e) (TCEnv -> Maybe (Closure Call)
envCall (TCEnv -> Maybe (Closure Call)) -> TCEnv -> Maybe (Closure Call)
forall a b. (a -> b) -> a -> b
$ Closure TypeError -> TCEnv
forall a. Closure a -> TCEnv
clEnv Closure TypeError
e) (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Closure TypeError -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Closure TypeError
e
    Exception Range
r Doc
s     -> Range -> m Doc -> m Doc
forall (m :: * -> *) a.
(MonadPretty m, HasRange a) =>
a -> m Doc -> m Doc
sayWhere Range
r (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
s
    IOException TCState
_ Range
r IOException
e -> Range -> m Doc -> m Doc
forall (m :: * -> *) a.
(MonadPretty m, HasRange a) =>
a -> m Doc -> m Doc
sayWhere Range
r (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show IOException
e
    PatternErr{}      -> TCErr -> m Doc -> m Doc
forall (m :: * -> *) a.
(MonadPretty m, HasRange a) =>
a -> m Doc -> m Doc
sayWhere TCErr
err (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
panic String
"uncaught pattern violation"

-- | Drops given amount of leading components of the qualified name.
dropTopLevelModule' :: Int -> QName -> QName
dropTopLevelModule' :: Int -> QName -> QName
dropTopLevelModule' Int
k (QName (MName [Name]
ns) Name
n) = ModuleName -> Name -> QName
QName ([Name] -> ModuleName
MName (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
drop Int
k [Name]
ns)) Name
n

-- | Drops the filename component of the qualified name.
dropTopLevelModule :: QName -> TCM QName
dropTopLevelModule :: QName -> TCM QName
dropTopLevelModule QName
q = ((QName -> QName) -> QName -> QName
forall a b. (a -> b) -> a -> b
$ QName
q) ((QName -> QName) -> QName)
-> TCMT IO (QName -> QName) -> TCM QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TCMT IO (QName -> QName)
forall (m :: * -> *).
(MonadTCEnv m, ReadTCState m) =>
m (QName -> QName)
topLevelModuleDropper

-- | Produces a function which drops the filename component of the qualified name.
topLevelModuleDropper :: (MonadTCEnv m, ReadTCState m) => m (QName -> QName)
topLevelModuleDropper :: m (QName -> QName)
topLevelModuleDropper = do
  m (Maybe AbsolutePath)
-> m (QName -> QName)
-> (AbsolutePath -> m (QName -> QName))
-> m (QName -> QName)
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
caseMaybeM ((TCEnv -> Maybe AbsolutePath) -> m (Maybe AbsolutePath)
forall (m :: * -> *) a. MonadTCEnv m => (TCEnv -> a) -> m a
asksTC TCEnv -> Maybe AbsolutePath
envCurrentPath) ((QName -> QName) -> m (QName -> QName)
forall (m :: * -> *) a. Monad m => a -> m a
return QName -> QName
forall a. a -> a
id) ((AbsolutePath -> m (QName -> QName)) -> m (QName -> QName))
-> (AbsolutePath -> m (QName -> QName)) -> m (QName -> QName)
forall a b. (a -> b) -> a -> b
$ \ AbsolutePath
f -> do
  TopLevelModuleName
m <- TopLevelModuleName
-> Maybe TopLevelModuleName -> TopLevelModuleName
forall a. a -> Maybe a -> a
fromMaybe TopLevelModuleName
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe TopLevelModuleName -> TopLevelModuleName)
-> m (Maybe TopLevelModuleName) -> m TopLevelModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsolutePath -> m (Maybe TopLevelModuleName)
forall (m :: * -> *).
ReadTCState m =>
AbsolutePath -> m (Maybe TopLevelModuleName)
lookupModuleFromSource AbsolutePath
f
  (QName -> QName) -> m (QName -> QName)
forall (m :: * -> *) a. Monad m => a -> m a
return ((QName -> QName) -> m (QName -> QName))
-> (QName -> QName) -> m (QName -> QName)
forall a b. (a -> b) -> a -> b
$ Int -> QName -> QName
dropTopLevelModule' (Int -> QName -> QName) -> Int -> QName -> QName
forall a b. (a -> b) -> a -> b
$ TopLevelModuleName -> Int
forall a. Sized a => a -> Int
size TopLevelModuleName
m

instance PrettyTCM TypeError where
  prettyTCM :: TypeError -> m Doc
prettyTCM TypeError
err = case TypeError
err of
    InternalError String
s -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
panic String
s

    NotImplemented String
s -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$ String
"Not implemented: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

    NotSupported String
s -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$ String
"Not supported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

    CompilationError String
s -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"Compilation error:", String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
s]

    GenericError String
s -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
s

    GenericDocError Doc
d -> Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
d

    TypeError
PropMustBeSingleton -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords
      String
"Datatypes in Prop must have at most one constructor when proof irrelevance is enabled"

    DataMustEndInSort Term
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The type of a datatype must end in a sort."
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"isn't a sort."

{- UNUSED:
    DataTooManyParameters -> fsep $ pwords "Too many parameters given to data type."
-}

    ShouldEndInApplicationOfTheDatatype Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The target of a constructor must be the datatype applied to its parameters,"
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"isn't"

    ShouldBeAppliedToTheDatatypeParameters Term
s Term
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The target of the constructor should be" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
s] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"instead of" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
t]

    ShouldBeApplicationOf Type
t QName
q -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The pattern constructs an element of" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
q] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"which is not the right datatype"

    ShouldBeRecordType Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Expected non-abstract record type, found " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t]

    ShouldBeRecordPattern DeBruijnPattern
p -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Expected record pattern" -- ", found " ++ [prettyTCM p]

    NotAProjectionPattern NamedArg Pattern
p -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Not a valid projection for a copattern: " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [ NamedArg Pattern -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA NamedArg Pattern
p ]

    TypeError
WrongHidingInLHS -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"Unexpected implicit argument"

    WrongHidingInLambda Type
t ->
      String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"Found an implicit lambda where an explicit lambda was expected"

    TypeError
WrongIrrelevanceInLambda ->
      String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"Found a non-strict lambda where a irrelevant lambda was expected"

    TypeError
WrongQuantityInLambda ->
      String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"Incorrect quantity annotation in lambda"

    TypeError
WrongCohesionInLambda ->
      String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"Incorrect cohesion annotation in lambda"

    WrongNamedArgument NamedArg Expr
a [NamedName]
xs0 -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Function does not accept argument "
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [NamedArg Expr -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM NamedArg Expr
a] -- ++ pwords " (wrong argument name)"
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ if [NamedName] -> Bool
forall a. Null a => a -> Bool
null [NamedName]
xs then [] else
         [m Doc -> m Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
parens (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
"possible arguments:" m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: (NamedName -> m Doc) -> [NamedName] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map NamedName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [NamedName]
xs]
      where
      xs :: [NamedName]
xs = (NamedName -> Bool) -> [NamedName] -> [NamedName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (NamedName -> Bool) -> NamedName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedName -> Bool
forall a. IsNoName a => a -> Bool
isNoName) [NamedName]
xs0

    WrongHidingInApplication Type
t ->
      String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"Found an implicit application where an explicit application was expected"

    HidingMismatch Hiding
h Hiding
h' -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$
      String
"Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Indefinite Hiding -> String
forall a. Verbalize a => a -> String
verbalize (Hiding -> Indefinite Hiding
forall a. a -> Indefinite a
Indefinite Hiding
h') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" argument, but found " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      Indefinite Hiding -> String
forall a. Verbalize a => a -> String
verbalize (Hiding -> Indefinite Hiding
forall a. a -> Indefinite a
Indefinite Hiding
h) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" argument"

    RelevanceMismatch Relevance
r Relevance
r' -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$
      String
"Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Indefinite Relevance -> String
forall a. Verbalize a => a -> String
verbalize (Relevance -> Indefinite Relevance
forall a. a -> Indefinite a
Indefinite Relevance
r') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" argument, but found " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      Indefinite Relevance -> String
forall a. Verbalize a => a -> String
verbalize (Relevance -> Indefinite Relevance
forall a. a -> Indefinite a
Indefinite Relevance
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" argument"

    QuantityMismatch Quantity
q Quantity
q' -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$
      String
"Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Indefinite Quantity -> String
forall a. Verbalize a => a -> String
verbalize (Quantity -> Indefinite Quantity
forall a. a -> Indefinite a
Indefinite Quantity
q') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" argument, but found " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      Indefinite Quantity -> String
forall a. Verbalize a => a -> String
verbalize (Quantity -> Indefinite Quantity
forall a. a -> Indefinite a
Indefinite Quantity
q) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" argument"

    UninstantiatedDotPattern Expr
e -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Failed to infer the value of dotted pattern"

    ForcedConstructorNotInstantiated Pattern
p -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Failed to infer that constructor pattern "
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Pattern -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Pattern
p] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" is forced"

    IlltypedPattern Pattern
p Type
a -> do
      let ho :: p -> p -> m Doc
ho p
_ p
_ = [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot pattern match on functions"
      Type -> (Dom Type -> Abs Type -> m Doc) -> (Type -> m Doc) -> m Doc
forall (m :: * -> *) a.
MonadReduce m =>
Type -> (Dom Type -> Abs Type -> m a) -> (Type -> m a) -> m a
ifPiType Type
a Dom Type -> Abs Type -> m Doc
forall (m :: * -> *) p p. Monad m => p -> p -> m Doc
ho ((Type -> m Doc) -> m Doc) -> (Type -> m Doc) -> m Doc
forall a b. (a -> b) -> a -> b
$ {- else -} \ Type
_ -> do
        [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Type mismatch"

    IllformedProjectionPattern Pattern
p -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Ill-formed projection pattern " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Pattern -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Pattern
p]

    CannotEliminateWithPattern NamedArg Pattern
p Type
a -> do
      let isProj :: Bool
isProj = Maybe (ProjOrigin, AmbiguousQName) -> Bool
forall a. Maybe a -> Bool
isJust (NamedArg Pattern -> Maybe (ProjOrigin, AmbiguousQName)
forall a. IsProjP a => a -> Maybe (ProjOrigin, AmbiguousQName)
isProjP NamedArg Pattern
p)
      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot eliminate type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
a m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: if
         | Bool
isProj -> String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"with projection pattern" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [NamedArg Pattern -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA NamedArg Pattern
p]
         | A.ProjP PatInfo
_ ProjOrigin
_ AmbiguousQName
f <- NamedArg Pattern -> Pattern
forall a. NamedArg a -> a
namedArg NamedArg Pattern
p -> String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"with pattern" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [NamedArg Pattern -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA NamedArg Pattern
p] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
             String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"(suggestion: write" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [m Doc
".(" m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Expr -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA (ProjOrigin -> AmbiguousQName -> Expr
A.Proj ProjOrigin
ProjPrefix AmbiguousQName
f) m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
")"] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"for a dot pattern," [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
             String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"or remove the braces for a postfix projection)"
         | Bool
otherwise ->
             m Doc
"with" m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (Pattern -> String
forall e. Pattern' e -> String
kindOfPattern (NamedArg Pattern -> Pattern
forall a. NamedArg a -> a
namedArg NamedArg Pattern
p)) m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: m Doc
"pattern" m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: NamedArg Pattern -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA NamedArg Pattern
p m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
:
             String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"(did you supply too many arguments?)"
      where
      kindOfPattern :: Pattern' e -> String
kindOfPattern = \case
        A.VarP{}    -> String
"variable"
        A.ConP{}    -> String
"constructor"
        A.ProjP{}   -> String
forall a. HasCallStack => a
__IMPOSSIBLE__
        A.DefP{}    -> String
forall a. HasCallStack => a
__IMPOSSIBLE__
        A.WildP{}   -> String
"wildcard"
        A.DotP{}    -> String
"dot"
        A.AbsurdP{} -> String
"absurd"
        A.LitP{}    -> String
"literal"
        A.RecP{}    -> String
"record"
        A.WithP{}   -> String
"with"
        A.EqualP{}  -> String
"equality"
        A.AsP PatInfo
_ BindName
_ Pattern' e
p -> Pattern' e -> String
kindOfPattern Pattern' e
p
        A.PatternSynP{} -> String
forall a. HasCallStack => a
__IMPOSSIBLE__

    WrongNumberOfConstructorArguments QName
c Int
expect Int
given -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The constructor" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
c] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"expects" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Int -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Int
expect] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"arguments (including hidden ones), but has been given"
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Int -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Int
given] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"(including hidden ones)"

    CantResolveOverloadedConstructorsTargetingSameDatatype QName
d [QName]
cs -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Can't resolve overloaded constructors targeting the same datatype"
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [(m Doc -> m Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
parens (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (QName -> QName
qnameToConcrete QName
d)) m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (m :: * -> *). Monad m => m Doc
colon]
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ (QName -> m Doc) -> [QName] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map QName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [QName]
cs

    DoesNotConstructAnElementOf QName
c Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The constructor" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
c] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"does not construct an element of" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t]

    ConstructorPatternInWrongDatatype QName
c QName
d -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
c] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is not a constructor of the datatype"
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
d]

    ShadowedModule Name
x [] -> m Doc
forall a. HasCallStack => a
__IMPOSSIBLE__

    ShadowedModule Name
x ms :: [ModuleName]
ms@(ModuleName
m0 : [ModuleName]
_) -> do
      -- Clash! Concrete module name x already points to the abstract names ms.
      (Range
r, ModuleName
m) <- do
        -- Andreas, 2017-07-28, issue #719.
        -- First, we try to find whether one of the abstract names @ms@ points back to @x@
        ScopeInfo
scope <- m ScopeInfo
forall (m :: * -> *). ReadTCState m => m ScopeInfo
getScope
        -- Get all pairs (y,m) such that y points to some m ∈ ms.
        let xms0 :: [(QName, ModuleName)]
xms0 = [ModuleName]
ms [ModuleName]
-> (ModuleName -> [(QName, ModuleName)]) -> [(QName, ModuleName)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ModuleName
m -> (QName -> (QName, ModuleName)) -> [QName] -> [(QName, ModuleName)]
forall a b. (a -> b) -> [a] -> [b]
map (,ModuleName
m) ([QName] -> [(QName, ModuleName)])
-> [QName] -> [(QName, ModuleName)]
forall a b. (a -> b) -> a -> b
$ ModuleName -> ScopeInfo -> [QName]
inverseScopeLookupModule ModuleName
m ScopeInfo
scope
        String -> Int -> String -> m ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> String -> m ()
reportSLn String
"scope.clash.error" Int
30 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"candidates = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(QName, ModuleName)] -> String
forall a. Pretty a => a -> String
prettyShow [(QName, ModuleName)]
xms0

        -- Try to find x (which will have a different Range, if it has one (#2649)).
        let xms :: [(QName, ModuleName)]
xms = ((QName, ModuleName) -> Bool)
-> [(QName, ModuleName)] -> [(QName, ModuleName)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((\ QName
y -> Bool -> Bool
not (Range -> Bool
forall a. Null a => a -> Bool
null (Range -> Bool) -> Range -> Bool
forall a b. (a -> b) -> a -> b
$ QName -> Range
forall t. HasRange t => t -> Range
getRange QName
y) Bool -> Bool -> Bool
&& QName
y QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> QName
C.QName Name
x) (QName -> Bool)
-> ((QName, ModuleName) -> QName) -> (QName, ModuleName) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName, ModuleName) -> QName
forall a b. (a, b) -> a
fst) [(QName, ModuleName)]
xms0
        String -> Int -> String -> m ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> String -> m ()
reportSLn String
"scope.class.error" Int
30 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"filtered candidates = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(QName, ModuleName)] -> String
forall a. Pretty a => a -> String
prettyShow [(QName, ModuleName)]
xms

        -- If we found a copy of x with non-empty range, great!
        Maybe (QName, ModuleName)
-> ((QName, ModuleName) -> m (Range, ModuleName))
-> m (Range, ModuleName)
-> m (Range, ModuleName)
forall a b. Maybe a -> (a -> b) -> b -> b
ifJust ([(QName, ModuleName)] -> Maybe (QName, ModuleName)
forall a. [a] -> Maybe a
listToMaybe [(QName, ModuleName)]
xms) (\ (QName
x', ModuleName
m) -> (Range, ModuleName) -> m (Range, ModuleName)
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> Range
forall t. HasRange t => t -> Range
getRange QName
x', ModuleName
m)) (m (Range, ModuleName) -> m (Range, ModuleName))
-> m (Range, ModuleName) -> m (Range, ModuleName)
forall a b. (a -> b) -> a -> b
$ {-else-} do

        -- If that failed, we pick the first m from ms which has a nameBindingSite.
        let rms :: [(Range, ModuleName)]
rms = [ModuleName]
ms [ModuleName]
-> (ModuleName -> [(Range, ModuleName)]) -> [(Range, ModuleName)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ModuleName
m -> (Range -> (Range, ModuleName)) -> [Range] -> [(Range, ModuleName)]
forall a b. (a -> b) -> [a] -> [b]
map (,ModuleName
m) ([Range] -> [(Range, ModuleName)])
-> [Range] -> [(Range, ModuleName)]
forall a b. (a -> b) -> a -> b
$
              (Range -> Bool) -> [Range] -> [Range]
forall a. (a -> Bool) -> [a] -> [a]
filter (Range
forall a. Range' a
noRange Range -> Range -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([Range] -> [Range]) -> [Range] -> [Range]
forall a b. (a -> b) -> a -> b
$ (Name -> Range) -> [Name] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Range
nameBindingSite ([Name] -> [Range]) -> [Name] -> [Range]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
forall a. [a] -> [a]
reverse ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ModuleName -> [Name]
mnameToList ModuleName
m
              -- Andreas, 2017-07-25, issue #2649
              -- Take the first nameBindingSite we can get hold of.
        String -> Int -> String -> m ()
forall (m :: * -> *).
MonadDebug m =>
String -> Int -> String -> m ()
reportSLn String
"scope.class.error" Int
30 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"rangeful clashing modules = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Range, ModuleName)] -> String
forall a. Pretty a => a -> String
prettyShow [(Range, ModuleName)]
rms

        -- If even this fails, we pick the first m and give no range.
        (Range, ModuleName) -> m (Range, ModuleName)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Range, ModuleName) -> m (Range, ModuleName))
-> (Range, ModuleName) -> m (Range, ModuleName)
forall a b. (a -> b) -> a -> b
$ (Range, ModuleName)
-> Maybe (Range, ModuleName) -> (Range, ModuleName)
forall a. a -> Maybe a -> a
fromMaybe (Range
forall a. Range' a
noRange, ModuleName
m0) (Maybe (Range, ModuleName) -> (Range, ModuleName))
-> Maybe (Range, ModuleName) -> (Range, ModuleName)
forall a b. (a -> b) -> a -> b
$ [(Range, ModuleName)] -> Maybe (Range, ModuleName)
forall a. [a] -> Maybe a
listToMaybe [(Range, ModuleName)]
rms

      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Duplicate definition of module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Name -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Name
x m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Previous definition of" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [ModuleName -> m Doc
forall (m :: * -> *) b.
(ReadTCState m, Null (m b), IsString (m b)) =>
ModuleName -> m b
help ModuleName
m] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Name -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Name
x] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"at" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Range -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Range
r]
      where
        help :: ModuleName -> m b
help ModuleName
m = m (Maybe DataOrRecord) -> m b -> (DataOrRecord -> m b) -> m b
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
caseMaybeM (ModuleName -> m (Maybe DataOrRecord)
forall (m :: * -> *).
ReadTCState m =>
ModuleName -> m (Maybe DataOrRecord)
isDatatypeModule ModuleName
m) m b
forall a. Null a => a
empty ((DataOrRecord -> m b) -> m b) -> (DataOrRecord -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \case
          DataOrRecord
IsData   -> m b
"(datatype)"
          DataOrRecord
IsRecord -> m b
"(record)"

    ModuleArityMismatch ModuleName
m Tele (Dom Type)
EmptyTel [NamedArg Expr]
args -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [ModuleName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ModuleName
m] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is not parameterized, but is being applied to arguments"

    ModuleArityMismatch ModuleName
m tel :: Tele (Dom Type)
tel@(ExtendTel Dom Type
_ Abs (Tele (Dom Type))
_) [NamedArg Expr]
args -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The arguments to " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [ModuleName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ModuleName
m] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"do not fit the telescope" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [Tele (Dom Type) -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Tele (Dom Type)
tel]

    ShouldBeEmpty Type
t [] -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
       [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"should be empty, but that's not obvious to me"

    ShouldBeEmpty Type
t [DeBruijnPattern]
ps -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (
      [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"should be empty, but the following constructor patterns are valid:"
      ) m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (DeBruijnPattern -> m Doc) -> [DeBruijnPattern] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> DeBruijnPattern -> m Doc
forall (m :: * -> *) a.
MonadPretty m =>
Integer -> Pattern' a -> m Doc
prettyPat Integer
0) [DeBruijnPattern]
ps)

    ShouldBeASort Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"should be a sort, but it isn't"

    ShouldBePi Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"should be a function type, but it isn't"

    ShouldBePath Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"should be a Path or PathP type, but it isn't"

    TypeError
NotAProperTerm -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"Found a malformed term"

    InvalidTypeSort Sort
s -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ [Sort -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Sort
s] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is not a valid type"
    InvalidType Term
v -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is not a valid type"

    FunctionTypeInSizeUniv Term
v -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Functions may not return sizes, thus, function type " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [ Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v ] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" is illegal"

    SplitOnIrrelevant Dom Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot pattern match against" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$ Relevance -> String
forall a. Verbalize a => a -> String
verbalize (Relevance -> String) -> Relevance -> String
forall a b. (a -> b) -> a -> b
$ Dom Type -> Relevance
forall a. LensRelevance a => a -> Relevance
getRelevance Dom Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"argument of type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Type -> m Doc) -> Type -> m Doc
forall a b. (a -> b) -> a -> b
$ Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
t]

    SplitOnUnusableCohesion Dom Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot pattern match against" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$ Cohesion -> String
forall a. Verbalize a => a -> String
verbalize (Cohesion -> String) -> Cohesion -> String
forall a b. (a -> b) -> a -> b
$ Dom Type -> Cohesion
forall a. LensCohesion a => a -> Cohesion
getCohesion Dom Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"argument of type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Type -> m Doc) -> Type -> m Doc
forall a b. (a -> b) -> a -> b
$ Dom Type -> Type
forall t e. Dom' t e -> e
unDom Dom Type
t]

    -- UNUSED:
    -- SplitOnErased t -> fsep $
    --   pwords "Cannot pattern match against" ++ [text $ verbalize $ getQuantity t] ++
    --   pwords "argument of type" ++ [prettyTCM $ unDom t]

    SplitOnNonVariable Term
v Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot pattern match because the (refined) argument " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [ Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v ] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" is not a variable."

    DefinitionIsIrrelevant QName
x -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      m Doc
"Identifier" m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is declared irrelevant, so it cannot be used here"

    DefinitionIsErased QName
x -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      m Doc
"Identifier" m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is declared erased, so it cannot be used here"

    VariableIsIrrelevant Name
x -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      m Doc
"Variable" m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: Name -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Name -> Name
nameConcrete Name
x) m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is declared irrelevant, so it cannot be used here"

    VariableIsErased Name
x -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      m Doc
"Variable" m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: Name -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Name -> Name
nameConcrete Name
x) m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is declared erased, so it cannot be used here"

    VariableIsOfUnusableCohesion Name
x Cohesion
c -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep
      [m Doc
"Variable", Name -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Name -> Name
nameConcrete Name
x), m Doc
"is declared", String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (Cohesion -> String
forall a. Show a => a -> String
show Cohesion
c), m Doc
"so it cannot be used here"]

    UnequalBecauseOfUniverseConflict Comparison
cmp Term
s Term
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
s, Comparison -> m Doc
forall (m :: * -> *). MonadPretty m => Comparison -> m Doc
notCmp Comparison
cmp, Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
t, m Doc
"because this would result in an invalid use of Setω" ]

    UnequalTerms Comparison
cmp Term
s Term
t CompareAs
a -> case (Term
s,Term
t) of
      (Sort Sort
s1      , Sort Sort
s2      )
        | Comparison
CmpEq  <- Comparison
cmp              -> TypeError -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (TypeError -> m Doc) -> TypeError -> m Doc
forall a b. (a -> b) -> a -> b
$ Sort -> Sort -> TypeError
UnequalSorts Sort
s1 Sort
s2
        | Comparison
CmpLeq <- Comparison
cmp              -> TypeError -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (TypeError -> m Doc) -> TypeError -> m Doc
forall a b. (a -> b) -> a -> b
$ Sort -> Sort -> TypeError
NotLeqSort Sort
s1 Sort
s2
      (Sort MetaS{} , Term
t            ) -> TypeError -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (TypeError -> m Doc) -> TypeError -> m Doc
forall a b. (a -> b) -> a -> b
$ Type -> TypeError
ShouldBeASort (Type -> TypeError) -> Type -> TypeError
forall a b. (a -> b) -> a -> b
$ Sort -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort
forall t. Sort' t
Inf Term
t
      (Term
s            , Sort MetaS{} ) -> TypeError -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (TypeError -> m Doc) -> TypeError -> m Doc
forall a b. (a -> b) -> a -> b
$ Type -> TypeError
ShouldBeASort (Type -> TypeError) -> Type -> TypeError
forall a b. (a -> b) -> a -> b
$ Sort -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort
forall t. Sort' t
Inf Term
s
      (Sort DefS{}  , Term
t            ) -> TypeError -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (TypeError -> m Doc) -> TypeError -> m Doc
forall a b. (a -> b) -> a -> b
$ Type -> TypeError
ShouldBeASort (Type -> TypeError) -> Type -> TypeError
forall a b. (a -> b) -> a -> b
$ Sort -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort
forall t. Sort' t
Inf Term
t
      (Term
s            , Sort DefS{}  ) -> TypeError -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (TypeError -> m Doc) -> TypeError -> m Doc
forall a b. (a -> b) -> a -> b
$ Type -> TypeError
ShouldBeASort (Type -> TypeError) -> Type -> TypeError
forall a b. (a -> b) -> a -> b
$ Sort -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort
forall t. Sort' t
Inf Term
s
      (Term
_            , Term
_            ) -> do
        (Doc
d1, Doc
d2, Doc
d) <- Term -> Term -> m (Doc, Doc, Doc)
forall (m :: * -> *).
MonadPretty m =>
Term -> Term -> m (Doc, Doc, Doc)
prettyInEqual Term
s Term
t
        [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ [[m Doc]] -> [m Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[m Doc]] -> [m Doc]) -> [[m Doc]] -> [m Doc]
forall a b. (a -> b) -> a -> b
$
          [ [Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
d1, Comparison -> m Doc
forall (m :: * -> *). MonadPretty m => Comparison -> m Doc
notCmp Comparison
cmp, Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
d2]
          , case CompareAs
a of
                AsTermsOf Type
t -> String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"of type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t]
                CompareAs
AsSizes     -> String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"of type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Type -> m Doc) -> m Type -> m Doc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Type
forall (m :: * -> *).
(HasBuiltins m, MonadTCEnv m, ReadTCState m) =>
m Type
sizeType]
                CompareAs
AsTypes     -> []
          , [Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
d]
          ]

    UnequalLevel Comparison
cmp Level
s Level
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Level -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Level
s, Comparison -> m Doc
forall (m :: * -> *). MonadPretty m => Comparison -> m Doc
notCmp Comparison
cmp, Level -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Level
t]

-- UnequalTelescopes is UNUSED
--   UnequalTelescopes cmp a b -> fsep $
--     [prettyTCM a, notCmp cmp, prettyTCM b]

    UnequalTypes Comparison
cmp Type
a Type
b -> Type -> m Doc -> Type -> m Doc
forall a (m :: * -> *).
(PrettyUnequal a, MonadPretty m) =>
a -> m Doc -> a -> m Doc
prettyUnequal Type
a (Comparison -> m Doc
forall (m :: * -> *). MonadPretty m => Comparison -> m Doc
notCmp Comparison
cmp) Type
b
--              fsep $ [prettyTCM a, notCmp cmp, prettyTCM b]

    UnequalRelevance Comparison
cmp Term
a Term
b -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
a, Comparison -> m Doc
forall (m :: * -> *). MonadPretty m => Comparison -> m Doc
notCmp Comparison
cmp, Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
b] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because one is a relevant function type and the other is an irrelevant function type"

    UnequalQuantity Comparison
cmp Term
a Term
b -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
a, Comparison -> m Doc
forall (m :: * -> *). MonadPretty m => Comparison -> m Doc
notCmp Comparison
cmp, Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
b] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because one is a non-erased function type and the other is an erased function type"

    UnequalCohesion Comparison
cmp Term
a Term
b -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
a, Comparison -> m Doc
forall (m :: * -> *). MonadPretty m => Comparison -> m Doc
notCmp Comparison
cmp, Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
b] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because one is a non-flat function type and the other is a flat function type"
      -- FUTURE Cohesion: update message if/when introducing sharp.

    UnequalHiding Term
a Term
b -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
a, m Doc
"!=", Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
b] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because one is an implicit function type and the other is an explicit function type"

    UnequalSorts Sort
s1 Sort
s2 -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Sort -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Sort
s1, m Doc
"!=", Sort -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Sort
s2]

    NotLeqSort Sort
s1 Sort
s2 -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Sort -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Sort
s1] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is not less or equal than" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Sort -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Sort
s2]

    TooManyFields QName
r [Name]
missing [Name]
xs -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The record type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
r] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"does not have the fields" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ m Doc -> [m Doc] -> [m Doc]
forall (m :: * -> *).
(Applicative m, Semigroup (m Doc)) =>
m Doc -> [m Doc] -> [m Doc]
punctuate m Doc
forall (m :: * -> *). Monad m => m Doc
comma ((Name -> m Doc) -> [Name] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [Name]
xs) [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      if [Name] -> Bool
forall a. Null a => a -> Bool
null [Name]
missing then [] else
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"but it would have the fields"  [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ m Doc -> [m Doc] -> [m Doc]
forall (m :: * -> *).
(Applicative m, Semigroup (m Doc)) =>
m Doc -> [m Doc] -> [m Doc]
punctuate m Doc
forall (m :: * -> *). Monad m => m Doc
comma ((Name -> m Doc) -> [Name] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [Name]
missing)

    DuplicateConstructors [Name]
xs -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Duplicate constructors" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ m Doc -> [m Doc] -> [m Doc]
forall (m :: * -> *).
(Applicative m, Semigroup (m Doc)) =>
m Doc -> [m Doc] -> [m Doc]
punctuate m Doc
forall (m :: * -> *). Monad m => m Doc
comma ((Name -> m Doc) -> [Name] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [Name]
xs) [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"in datatype"

    DuplicateFields [Name]
xs -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Duplicate fields" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ m Doc -> [m Doc] -> [m Doc]
forall (m :: * -> *).
(Applicative m, Semigroup (m Doc)) =>
m Doc -> [m Doc] -> [m Doc]
punctuate m Doc
forall (m :: * -> *). Monad m => m Doc
comma ((Name -> m Doc) -> [Name] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [Name]
xs) [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"in record"

    WithOnFreeVariable Expr
e Term
v -> do
      Doc
de <- Expr -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Expr
e
      Doc
dv <- Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v
      if Doc -> String
forall a. Show a => a -> String
show Doc
de String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Doc -> String
forall a. Show a => a -> String
show Doc
dv
        then [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
          String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot `with` on variable" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
dv] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
          String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" bound in a module telescope (or patterns of a parent clause)"
        else [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
          String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot `with` on expression" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
de] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"which reduces to variable" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
dv] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
          String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" bound in a module telescope (or patterns of a parent clause)"

    UnexpectedWithPatterns [Pattern]
ps -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Unexpected with patterns" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ (m Doc -> [m Doc] -> [m Doc]
forall (m :: * -> *).
(Applicative m, Semigroup (m Doc)) =>
m Doc -> [m Doc] -> [m Doc]
punctuate m Doc
" |" ([m Doc] -> [m Doc]) -> [m Doc] -> [m Doc]
forall a b. (a -> b) -> a -> b
$ (Pattern -> m Doc) -> [Pattern] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA [Pattern]
ps)

    WithClausePatternMismatch Pattern
p NamedArg DeBruijnPattern
q -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"With clause pattern " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Pattern -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Pattern
p] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" is not an instance of its parent pattern " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
P.fsep ([Doc] -> Doc) -> m [Doc] -> m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedArg DeBruijnPattern] -> m [Doc]
forall (m :: * -> *).
MonadPretty m =>
[NamedArg DeBruijnPattern] -> m [Doc]
prettyTCMPatterns [NamedArg DeBruijnPattern
q]]

    -- The following error is caught and reraised as GenericDocError in Occurs.hs
    MetaCannotDependOn MetaId
m {- ps -} Int
i -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The metavariable" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Term -> m Doc) -> Term -> m Doc
forall a b. (a -> b) -> a -> b
$ MetaId -> Elims -> Term
MetaV MetaId
m []] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"cannot depend on" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Int -> m Doc
pvar Int
i] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [] -- pwords "because it" ++ deps
        where
          pvar :: Int -> m Doc
pvar = Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Term -> m Doc) -> (Int -> Term) -> Int -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Term
I.var
          -- deps = case map pvar ps of
          --   []  -> pwords "does not depend on any variables"
          --   [x] -> pwords "only depends on the variable" ++ [x]
          --   xs  -> pwords "only depends on the variables" ++ punctuate comma xs

    -- The following error is caught and reraised as GenericDocError in Occurs.hs
    MetaOccursInItself MetaId
m -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot construct infinite solution of metavariable" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Term -> m Doc) -> Term -> m Doc
forall a b. (a -> b) -> a -> b
$ MetaId -> Elims -> Term
MetaV MetaId
m []]

    -- The following error is caught and reraised as GenericDocError in Occurs.hs
    MetaIrrelevantSolution MetaId
m Term
_ -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot instantiate the metavariable because (part of) the" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"solution was created in an irrelevant context."

    -- The following error is caught and reraised as GenericDocError in Occurs.hs
    MetaErasedSolution MetaId
m Term
_ -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot instantiate the metavariable because (part of) the" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"solution was created in an erased context."

    BuiltinMustBeConstructor String
s Expr
e -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Expr -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA Expr
e] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"must be a constructor in the binding to builtin" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
s]

    NoSuchBuiltinName String
s -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"There is no built-in thing called" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
s]

    DuplicateBuiltinBinding String
b Term
x Term
y -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Duplicate binding for built-in thing" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
b m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (m :: * -> *). Monad m => m Doc
comma] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"previous binding to" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
x]

    NoBindingForBuiltin String
x
      | String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
builtinZero, String
builtinSuc] -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"No binding for builtin " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
x m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (m :: * -> *). Monad m => m Doc
comma] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords (String
"use {-# BUILTIN " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
builtinNat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" name #-} to bind builtin natural " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"numbers to the type 'name'")
      | Bool
otherwise -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"No binding for builtin thing" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
x m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (m :: * -> *). Monad m => m Doc
comma] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords (String
"use {-# BUILTIN " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" name #-} to bind it to 'name'")

    DuplicatePrimitiveBinding String
b QName
x QName
y -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Duplicate binding for primitive thing" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
b m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (m :: * -> *). Monad m => m Doc
comma] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"previous binding to" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x]

    NoSuchPrimitiveFunction String
x -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"There is no primitive function called" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
x]

    BuiltinInParameterisedModule String
x -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$
      String
"The BUILTIN pragma cannot appear inside a bound context " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"(for instance, in a parameterised module or as a local declaration)"

    IllegalLetInTelescope TypedBinding
tb -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      -- pwords "The binding" ++
      [TypedBinding -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty TypedBinding
tb] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" is not allowed in a telescope here."

    IllegalPatternInTelescope Binder
bd -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Binder -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Binder
bd] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" is not allowed in a telescope here."

    NoRHSRequiresAbsurdPattern [NamedArg Pattern]
ps -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$
      String
"The right-hand side can only be omitted if there " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"is an absurd pattern, () or {}, in the left-hand side."

    LocalVsImportedModuleClash ModuleName
m -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [ModuleName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ModuleName
m] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"can refer to either a local module or an imported module"

    TypeError
SolvedButOpenHoles -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Module cannot be imported since it has open interaction points" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"(consider adding {-# OPTIONS --allow-unsolved-metas #-} to this module)"

    CyclicModuleDependency [TopLevelModuleName]
ms ->
      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"cyclic module dependency:")
      m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (TopLevelModuleName -> m Doc) -> [TopLevelModuleName] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map TopLevelModuleName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [TopLevelModuleName]
ms)

    FileNotFound TopLevelModuleName
x [AbsolutePath]
files ->
      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ( String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Failed to find source of module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [TopLevelModuleName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty TopLevelModuleName
x] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
             String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"in any of the following locations:"
           ) m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (AbsolutePath -> m Doc) -> [AbsolutePath] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String -> m Doc)
-> (AbsolutePath -> String) -> AbsolutePath -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> String
filePath) [AbsolutePath]
files)

    OverlappingProjects AbsolutePath
f TopLevelModuleName
m1 TopLevelModuleName
m2 ->
      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ( String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The file" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (AbsolutePath -> String
filePath AbsolutePath
f)] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
             String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"can be accessed via several project roots. Both" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
             [TopLevelModuleName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty TopLevelModuleName
m1] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"and" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [TopLevelModuleName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty TopLevelModuleName
m2] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
             String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"point to this file."
           )

    AmbiguousTopLevelModuleName TopLevelModuleName
x [AbsolutePath]
files ->
      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ( String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Ambiguous module name. The module name" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
             [TopLevelModuleName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty TopLevelModuleName
x] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
             String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"could refer to any of the following files:"
           ) m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (AbsolutePath -> m Doc) -> [AbsolutePath] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String -> m Doc)
-> (AbsolutePath -> String) -> AbsolutePath -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> String
filePath) [AbsolutePath]
files)

    ClashingFileNamesFor ModuleName
x [AbsolutePath]
files ->
      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ( String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Multiple possible sources for module"
             [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [ModuleName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ModuleName
x] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"found:"
           ) m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (AbsolutePath -> m Doc) -> [AbsolutePath] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String -> m Doc)
-> (AbsolutePath -> String) -> AbsolutePath -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> String
filePath) [AbsolutePath]
files)

    ModuleDefinedInOtherFile TopLevelModuleName
mod AbsolutePath
file AbsolutePath
file' -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"You tried to load" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (AbsolutePath -> String
filePath AbsolutePath
file)] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"which defines the module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [TopLevelModuleName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty TopLevelModuleName
mod m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"However, according to the include path this module should" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"be defined in" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (AbsolutePath -> String
filePath AbsolutePath
file') m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."]

    ModuleNameUnexpected TopLevelModuleName
given TopLevelModuleName
expected -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The name of the top level module does not match the file name. The module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [ TopLevelModuleName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty TopLevelModuleName
given ] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"should probably be named" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [ TopLevelModuleName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty TopLevelModuleName
expected ]

    ModuleNameDoesntMatchFileName TopLevelModuleName
given [AbsolutePath]
files ->
      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The name of the top level module does not match the file name. The module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
           [ TopLevelModuleName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty TopLevelModuleName
given ] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"should be defined in one of the following files:")
      m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (AbsolutePath -> m Doc) -> [AbsolutePath] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String -> m Doc)
-> (AbsolutePath -> String) -> AbsolutePath -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> String
filePath) [AbsolutePath]
files)

    TypeError
BothWithAndRHS -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Unexpected right hand side"

    AbstractConstructorNotInScope QName
q -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [ m Doc
"Constructor"
      , QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
q
      ] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is abstract, thus, not in scope here"

    NotInScope [QName]
xs ->
      -- using the warning version to avoid code duplication
      Warning -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ([QName] -> Warning
NotInScopeW [QName]
xs)

    NoSuchModule QName
x -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"No module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty QName
x] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"in scope"

    AmbiguousName QName
x NonEmpty QName
ys -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
      [ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Ambiguous name" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty QName
x m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
               String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"It could refer to any one of"
      , Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (QName -> m Doc) -> [QName] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map QName -> m Doc
forall (m :: * -> *). MonadPretty m => QName -> m Doc
nameWithBinding (NonEmpty QName -> [QName]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty QName
ys)
      , String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"(hint: Use C-c C-w (in Emacs) if you want to know why)"
      ]

    AmbiguousModule QName
x NonEmpty ModuleName
ys -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
      [ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Ambiguous module name" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty QName
x m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
               String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"It could refer to any one of"
      , Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (ModuleName -> m Doc) -> [ModuleName] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> m Doc
forall (m :: * -> *). MonadPretty m => ModuleName -> m Doc
help (NonEmpty ModuleName -> [ModuleName]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ModuleName
ys)
      , String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"(hint: Use C-c C-w (in Emacs) if you want to know why)"
      ]
      where
        help :: MonadPretty m => ModuleName -> m Doc
        help :: ModuleName -> m Doc
help ModuleName
m = do
          m Doc
anno <- m (Maybe DataOrRecord)
-> m (m Doc) -> (DataOrRecord -> m (m Doc)) -> m (m Doc)
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
caseMaybeM (ModuleName -> m (Maybe DataOrRecord)
forall (m :: * -> *).
ReadTCState m =>
ModuleName -> m (Maybe DataOrRecord)
isDatatypeModule ModuleName
m) (m Doc -> m (m Doc)
forall (m :: * -> *) a. Monad m => a -> m a
return m Doc
forall a. Null a => a
empty) ((DataOrRecord -> m (m Doc)) -> m (m Doc))
-> (DataOrRecord -> m (m Doc)) -> m (m Doc)
forall a b. (a -> b) -> a -> b
$ \case
            DataOrRecord
IsData   -> m Doc -> m (m Doc)
forall (m :: * -> *) a. Monad m => a -> m a
return (m Doc -> m (m Doc)) -> m Doc -> m (m Doc)
forall a b. (a -> b) -> a -> b
$ m Doc
"(datatype module)"
            DataOrRecord
IsRecord -> m Doc -> m (m Doc)
forall (m :: * -> *) a. Monad m => a -> m a
return (m Doc -> m (m Doc)) -> m Doc -> m (m Doc)
forall a b. (a -> b) -> a -> b
$ m Doc
"(record module)"
          [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep [ModuleName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ModuleName
m, m Doc
anno ]

    ClashingDefinition QName
x QName
y -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Multiple definitions of" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty QName
x m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Previous definition at"
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Range -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Range -> m Doc) -> Range -> m Doc
forall a b. (a -> b) -> a -> b
$ Name -> Range
nameBindingSite (Name -> Range) -> Name -> Range
forall a b. (a -> b) -> a -> b
$ QName -> Name
qnameName QName
y]

    ClashingModule ModuleName
m1 ModuleName
m2 -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The modules" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [ModuleName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ModuleName
m1, m Doc
"and", ModuleName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ModuleName
m2]
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"clash."

    ClashingImport Name
x QName
y -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Import clash between" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Name -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Name
x, m Doc
"and", QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
y]

    ClashingModuleImport Name
x ModuleName
y -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Module import clash between" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Name -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Name
x, m Doc
"and", ModuleName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ModuleName
y]

    PatternShadowsConstructor Name
x QName
c -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The pattern variable" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Name -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Name
x] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"has the same name as the constructor" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
c]

    DuplicateImports QName
m [ImportedName]
xs -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Ambiguous imports from module" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty QName
m] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"for" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      m Doc -> [m Doc] -> [m Doc]
forall (m :: * -> *).
(Applicative m, Semigroup (m Doc)) =>
m Doc -> [m Doc] -> [m Doc]
punctuate m Doc
forall (m :: * -> *). Monad m => m Doc
comma ((ImportedName -> m Doc) -> [ImportedName] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map ImportedName -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [ImportedName]
xs)

    NotAModuleExpr Expr
e -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The right-hand side of a module definition must have the form 'M e1 .. en'" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"where M is a module name. The expression"
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Expr
e, m Doc
"doesn't."]

    TypeError
FieldOutsideRecord -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Field appearing outside record declaration."

    InvalidPattern Pattern
p -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      Pattern -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Pattern
p m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is not a valid pattern"

    RepeatedVariablesInPattern [Name]
xs -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Repeated variables in pattern:" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ (Name -> m Doc) -> [Name] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [Name]
xs

    NotAnExpression Expr
e -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Expr
e] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"is not a valid expression."

    NotAValidLetBinding NiceDeclaration
nd -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$
      String
"Not a valid let-declaration"

    NotValidBeforeField NiceDeclaration
nd -> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$
      String
"This declaration is illegal in a record before the last field"

    NothingAppliedToHiddenArg Expr
e -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Expr
e] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"cannot appear by itself. It needs to be the argument to" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"a function expecting an implicit argument."

    NothingAppliedToInstanceArg Expr
e -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Expr
e] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"cannot appear by itself. It needs to be the argument to" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"a function expecting an instance argument."

    NoParseForApplication [Expr]
es -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Could not parse the application" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty (Expr -> m Doc) -> Expr -> m Doc
forall a b. (a -> b) -> a -> b
$ Range -> [Expr] -> Expr
C.RawApp Range
forall a. Range' a
noRange [Expr]
es])

    AmbiguousParseForApplication [Expr]
es [Expr]
es' -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Don't know how to parse" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [m Doc
forall (m :: * -> *). MonadPretty m => m Doc
pretty_es m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Could mean any one of:"
      ) m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (Expr -> m Doc) -> [Expr] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> m Doc
forall (m :: * -> *). MonadPretty m => Expr -> m Doc
pretty' [Expr]
es')
      where
        pretty_es :: MonadPretty m => m Doc
        pretty_es :: m Doc
pretty_es = Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty (Expr -> m Doc) -> Expr -> m Doc
forall a b. (a -> b) -> a -> b
$ Range -> [Expr] -> Expr
C.RawApp Range
forall a. Range' a
noRange [Expr]
es

        pretty' :: MonadPretty m => C.Expr -> m Doc
        pretty' :: Expr -> m Doc
pretty' Expr
e = do
          Doc
p1 <- m Doc
forall (m :: * -> *). MonadPretty m => m Doc
pretty_es
          Doc
p2 <- Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Expr
e
          if Doc -> String
forall a. Show a => a -> String
show Doc
p1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Doc -> String
forall a. Show a => a -> String
show Doc
p2 then Expr -> m Doc
forall (m :: * -> *). MonadPretty m => Expr -> m Doc
unambiguous Expr
e else Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Expr
e

        unambiguous :: MonadPretty m => C.Expr -> m Doc
        unambiguous :: Expr -> m Doc
unambiguous e :: Expr
e@(C.OpApp Range
r QName
op Set Name
_ [NamedArg (MaybePlaceholder (OpApp Expr))]
xs)
          | (NamedArg (MaybePlaceholder (OpApp Expr)) -> Bool)
-> [NamedArg (MaybePlaceholder (OpApp Expr))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (MaybePlaceholder (OpApp Expr) -> Bool
forall e. MaybePlaceholder (OpApp e) -> Bool
isOrdinary (MaybePlaceholder (OpApp Expr) -> Bool)
-> (NamedArg (MaybePlaceholder (OpApp Expr))
    -> MaybePlaceholder (OpApp Expr))
-> NamedArg (MaybePlaceholder (OpApp Expr))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedArg (MaybePlaceholder (OpApp Expr))
-> MaybePlaceholder (OpApp Expr)
forall a. NamedArg a -> a
namedArg) [NamedArg (MaybePlaceholder (OpApp Expr))]
xs =
            Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty (Expr -> m Doc) -> Expr -> m Doc
forall a b. (a -> b) -> a -> b
$
              (Expr -> NamedArg Expr -> Expr) -> Expr -> [NamedArg Expr] -> Expr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Range -> Expr -> NamedArg Expr -> Expr
C.App Range
r) (QName -> Expr
C.Ident QName
op) ([NamedArg Expr] -> Expr) -> [NamedArg Expr] -> Expr
forall a b. (a -> b) -> a -> b
$
                ((NamedArg (MaybePlaceholder (OpApp Expr)) -> NamedArg Expr)
-> [NamedArg (MaybePlaceholder (OpApp Expr))] -> [NamedArg Expr]
forall a b. (a -> b) -> [a] -> [b]
map ((NamedArg (MaybePlaceholder (OpApp Expr)) -> NamedArg Expr)
 -> [NamedArg (MaybePlaceholder (OpApp Expr))] -> [NamedArg Expr])
-> ((MaybePlaceholder (OpApp Expr) -> Expr)
    -> NamedArg (MaybePlaceholder (OpApp Expr)) -> NamedArg Expr)
-> (MaybePlaceholder (OpApp Expr) -> Expr)
-> [NamedArg (MaybePlaceholder (OpApp Expr))]
-> [NamedArg Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Named NamedName (MaybePlaceholder (OpApp Expr))
 -> Named NamedName Expr)
-> NamedArg (MaybePlaceholder (OpApp Expr)) -> NamedArg Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Named NamedName (MaybePlaceholder (OpApp Expr))
  -> Named NamedName Expr)
 -> NamedArg (MaybePlaceholder (OpApp Expr)) -> NamedArg Expr)
-> ((MaybePlaceholder (OpApp Expr) -> Expr)
    -> Named NamedName (MaybePlaceholder (OpApp Expr))
    -> Named NamedName Expr)
-> (MaybePlaceholder (OpApp Expr) -> Expr)
-> NamedArg (MaybePlaceholder (OpApp Expr))
-> NamedArg Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MaybePlaceholder (OpApp Expr) -> Expr)
-> Named NamedName (MaybePlaceholder (OpApp Expr))
-> Named NamedName Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) MaybePlaceholder (OpApp Expr) -> Expr
forall e. MaybePlaceholder (OpApp e) -> e
fromOrdinary [NamedArg (MaybePlaceholder (OpApp Expr))]
xs
          | (NamedArg (MaybePlaceholder (OpApp Expr)) -> Bool)
-> [NamedArg (MaybePlaceholder (OpApp Expr))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MaybePlaceholder (OpApp Expr) -> Bool
forall a. MaybePlaceholder a -> Bool
isPlaceholder (MaybePlaceholder (OpApp Expr) -> Bool)
-> (NamedArg (MaybePlaceholder (OpApp Expr))
    -> MaybePlaceholder (OpApp Expr))
-> NamedArg (MaybePlaceholder (OpApp Expr))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedArg (MaybePlaceholder (OpApp Expr))
-> MaybePlaceholder (OpApp Expr)
forall a. NamedArg a -> a
namedArg) [NamedArg (MaybePlaceholder (OpApp Expr))]
xs =
              Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Expr
e m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> m Doc
"(section)"
        unambiguous Expr
e = Expr -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Expr
e

        isOrdinary :: MaybePlaceholder (C.OpApp e) -> Bool
        isOrdinary :: MaybePlaceholder (OpApp e) -> Bool
isOrdinary (NoPlaceholder Maybe PositionInName
_ (C.Ordinary e
_)) = Bool
True
        isOrdinary MaybePlaceholder (OpApp e)
_                                = Bool
False

        fromOrdinary :: MaybePlaceholder (C.OpApp e) -> e
        fromOrdinary :: MaybePlaceholder (OpApp e) -> e
fromOrdinary (NoPlaceholder Maybe PositionInName
_ (C.Ordinary e
e)) = e
e
        fromOrdinary MaybePlaceholder (OpApp e)
_                                = e
forall a. HasCallStack => a
__IMPOSSIBLE__

        isPlaceholder :: MaybePlaceholder a -> Bool
        isPlaceholder :: MaybePlaceholder a -> Bool
isPlaceholder Placeholder{}   = Bool
True
        isPlaceholder NoPlaceholder{} = Bool
False

    BadArgumentsToPatternSynonym AmbiguousQName
x -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Bad arguments to pattern synonym " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (QName -> m Doc) -> QName -> m Doc
forall a b. (a -> b) -> a -> b
$ AmbiguousQName -> QName
headAmbQ AmbiguousQName
x]

    TooFewArgumentsToPatternSynonym AmbiguousQName
x -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Too few arguments to pattern synonym " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (QName -> m Doc) -> QName -> m Doc
forall a b. (a -> b) -> a -> b
$ AmbiguousQName -> QName
headAmbQ AmbiguousQName
x]

    CannotResolveAmbiguousPatternSynonym NonEmpty (QName, PatternSynDefn)
defs -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat
      [ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot resolve overloaded pattern synonym" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (m :: * -> *). Monad m => m Doc
comma] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
               String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"since candidates have different shapes:"
      , Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ ((QName, PatternSynDefn) -> m Doc)
-> [(QName, PatternSynDefn)] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (QName, PatternSynDefn) -> m Doc
forall (m :: * -> *).
(MonadTCEnv m, ReadTCState m, MonadStConcreteNames m, HasOptions m,
 HasBuiltins m, MonadDebug m, IsString (m Doc)) =>
(QName, PatternSynDefn) -> m Doc
prDef (NonEmpty (QName, PatternSynDefn) -> [(QName, PatternSynDefn)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (QName, PatternSynDefn)
defs)
      , [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"(hint: overloaded pattern synonyms must be equal up to variable and constructor names)"
      ]
      where
        (QName
x, PatternSynDefn
_) = NonEmpty (QName, PatternSynDefn) -> (QName, PatternSynDefn)
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (QName, PatternSynDefn)
defs
        prDef :: (QName, PatternSynDefn) -> m Doc
prDef (QName
x, ([Arg Name]
xs, Pattern' Void
p)) = Declaration -> m Doc
forall c a (m :: * -> *).
(Pretty c, ToConcrete a c, MonadAbsToCon m) =>
a -> m Doc
prettyA (QName -> [Arg Name] -> Pattern' Void -> Declaration
A.PatternSynDef QName
x [Arg Name]
xs Pattern' Void
p) m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<?> (m Doc
"at" m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Range -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Range
r)
          where r :: Range
r = Name -> Range
nameBindingSite (Name -> Range) -> Name -> Range
forall a b. (a -> b) -> a -> b
$ QName -> Name
qnameName QName
x

    TypeError
UnusedVariableInPatternSynonym -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Unused variable in pattern synonym."

    NoParseForLHS LHSOrPatSyn
IsLHS Pattern
p -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Could not parse the left-hand side" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Pattern -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Pattern
p])

    NoParseForLHS LHSOrPatSyn
IsPatSyn Pattern
p -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Could not parse the pattern synonym" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Pattern -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Pattern
p])

{- UNUSED
    NoParseForPatternSynonym p -> fsep $
      pwords "Could not parse the pattern synonym" ++ [pretty p]
-}

    AmbiguousParseForLHS LHSOrPatSyn
lhsOrPatSyn Pattern
p [Pattern]
ps -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Don't know how to parse" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [m Doc
forall (m :: * -> *). MonadPretty m => m Doc
pretty_p m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Could mean any one of:"
      ) m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (Pattern -> m Doc) -> [Pattern] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> m Doc
forall (m :: * -> *). MonadPretty m => Pattern -> m Doc
pretty' [Pattern]
ps)
      where
        pretty_p :: MonadPretty m => m Doc
        pretty_p :: m Doc
pretty_p = Pattern -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Pattern
p

        pretty' :: MonadPretty m => C.Pattern -> m Doc
        pretty' :: Pattern -> m Doc
pretty' Pattern
p' = do
          Doc
p1 <- m Doc
forall (m :: * -> *). MonadPretty m => m Doc
pretty_p
          Doc
p2 <- Pattern -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty Pattern
p'
          Pattern -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty (Pattern -> m Doc) -> Pattern -> m Doc
forall a b. (a -> b) -> a -> b
$ if Doc -> String
forall a. Show a => a -> String
show Doc
p1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Doc -> String
forall a. Show a => a -> String
show Doc
p2 then Pattern -> Pattern
unambiguousP Pattern
p' else Pattern
p'

        -- the entire pattern is shown, not just the ambiguous part,
        -- so we need to dig in order to find the OpAppP's.
        unambiguousP :: C.Pattern -> C.Pattern
        unambiguousP :: Pattern -> Pattern
unambiguousP (C.AppP Pattern
x NamedArg Pattern
y)         = Pattern -> NamedArg Pattern -> Pattern
C.AppP (Pattern -> Pattern
unambiguousP Pattern
x) (NamedArg Pattern -> Pattern) -> NamedArg Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ ((Named NamedName Pattern -> Named NamedName Pattern)
-> NamedArg Pattern -> NamedArg Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Named NamedName Pattern -> Named NamedName Pattern)
 -> NamedArg Pattern -> NamedArg Pattern)
-> ((Pattern -> Pattern)
    -> Named NamedName Pattern -> Named NamedName Pattern)
-> (Pattern -> Pattern)
-> NamedArg Pattern
-> NamedArg Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Pattern -> Pattern)
-> Named NamedName Pattern -> Named NamedName Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Pattern -> Pattern
unambiguousP NamedArg Pattern
y
        unambiguousP (C.HiddenP Range
r Named NamedName Pattern
x)      = Range -> Named NamedName Pattern -> Pattern
C.HiddenP Range
r (Named NamedName Pattern -> Pattern)
-> Named NamedName Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ (Pattern -> Pattern)
-> Named NamedName Pattern -> Named NamedName Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pattern -> Pattern
unambiguousP Named NamedName Pattern
x
        unambiguousP (C.InstanceP Range
r Named NamedName Pattern
x)    = Range -> Named NamedName Pattern -> Pattern
C.InstanceP Range
r (Named NamedName Pattern -> Pattern)
-> Named NamedName Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ (Pattern -> Pattern)
-> Named NamedName Pattern -> Named NamedName Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pattern -> Pattern
unambiguousP Named NamedName Pattern
x
        unambiguousP (C.ParenP Range
r Pattern
x)       = Range -> Pattern -> Pattern
C.ParenP Range
r (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> Pattern
unambiguousP Pattern
x
        unambiguousP (C.AsP Range
r Name
n Pattern
x)        = Range -> Name -> Pattern -> Pattern
C.AsP Range
r Name
n (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> Pattern
unambiguousP Pattern
x
        unambiguousP (C.OpAppP Range
r QName
op Set Name
_ [NamedArg Pattern]
xs) = (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
op) [NamedArg Pattern]
xs
        unambiguousP Pattern
e                    = Pattern
e

    OperatorInformation [NotationSection]
sects TypeError
err ->
      TypeError -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM TypeError
err
        m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$+$
      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Operators used in the grammar:")
        m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$
      Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2
        (if [NotationSection] -> Bool
forall a. Null a => a -> Bool
null [NotationSection]
sects then m Doc
"None" else
         [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ((String -> m Doc) -> [String] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text ([String] -> [m Doc]) -> [String] -> [m Doc]
forall a b. (a -> b) -> a -> b
$
               String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$
               Box -> String
Boxes.render (Box -> String) -> Box -> String
forall a b. (a -> b) -> a -> b
$
               (\([Box]
col1, [Box]
col2, [Box]
col3) ->
                   Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
Boxes.hsep Int
1 Alignment
Boxes.top ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$
                   ([Box] -> Box) -> [[Box]] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Boxes.vcat Alignment
Boxes.left) [[Box]
col1, [Box]
col2, [Box]
col3]) (([Box], [Box], [Box]) -> Box) -> ([Box], [Box], [Box]) -> Box
forall a b. (a -> b) -> a -> b
$
               [(Box, Box, Box)] -> ([Box], [Box], [Box])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Box, Box, Box)] -> ([Box], [Box], [Box]))
-> [(Box, Box, Box)] -> ([Box], [Box], [Box])
forall a b. (a -> b) -> a -> b
$
               (NotationSection -> (Box, Box, Box))
-> [NotationSection] -> [(Box, Box, Box)]
forall a b. (a -> b) -> [a] -> [b]
map NotationSection -> (Box, Box, Box)
prettySect ([NotationSection] -> [(Box, Box, Box)])
-> [NotationSection] -> [(Box, Box, Box)]
forall a b. (a -> b) -> a -> b
$
               (NotationSection -> NotationSection -> Ordering)
-> [NotationSection] -> [NotationSection]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (NotationSection -> String)
-> NotationSection
-> NotationSection
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` QName -> String
forall a. Show a => a -> String
show (QName -> String)
-> (NotationSection -> QName) -> NotationSection -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewNotation -> QName
notaName (NewNotation -> QName)
-> (NotationSection -> NewNotation) -> NotationSection -> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotationSection -> NewNotation
sectNotation) ([NotationSection] -> [NotationSection])
-> [NotationSection] -> [NotationSection]
forall a b. (a -> b) -> a -> b
$
               (NotationSection -> Bool) -> [NotationSection] -> [NotationSection]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (NotationSection -> Bool) -> NotationSection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotationSection -> Bool
closedWithoutHoles) [NotationSection]
sects))
      where
      trimLeft :: [GenPart] -> [GenPart]
trimLeft  = (GenPart -> Bool) -> [GenPart] -> [GenPart]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile GenPart -> Bool
isNormalHole
      trimRight :: [GenPart] -> [GenPart]
trimRight = (GenPart -> Bool) -> [GenPart] -> [GenPart]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd GenPart -> Bool
isNormalHole

      closedWithoutHoles :: NotationSection -> Bool
closedWithoutHoles NotationSection
sect =
        NotationSection -> NotationKind
sectKind NotationSection
sect NotationKind -> NotationKind -> Bool
forall a. Eq a => a -> a -> Bool
== NotationKind
NonfixNotation
          Bool -> Bool -> Bool
&&
        [()] -> Bool
forall a. Null a => a -> Bool
null [ () | NormalHole {} <- [GenPart] -> [GenPart]
trimLeft ([GenPart] -> [GenPart]) -> [GenPart] -> [GenPart]
forall a b. (a -> b) -> a -> b
$ [GenPart] -> [GenPart]
trimRight ([GenPart] -> [GenPart]) -> [GenPart] -> [GenPart]
forall a b. (a -> b) -> a -> b
$
                                       NewNotation -> [GenPart]
notation (NotationSection -> NewNotation
sectNotation NotationSection
sect) ]

      prettyName :: Name -> Box
prettyName Name
n = String -> Box
Boxes.text (String -> Box) -> String -> Box
forall a b. (a -> b) -> a -> b
$
        Doc -> String
P.render (Name -> Doc
forall a. Pretty a => a -> Doc
P.pretty Name
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
P.render (Range -> Doc
forall a. Pretty a => a -> Doc
P.pretty (Name -> Range
nameBindingSite Name
n)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

      prettySect :: NotationSection -> (Box, Box, Box)
prettySect NotationSection
sect =
        ( String -> Box
Boxes.text (Doc -> String
P.render ([GenPart] -> Doc
forall a. Pretty a => a -> Doc
P.pretty [GenPart]
section))
            Box -> Box -> Box
Boxes.//
          Box
strut
        , String -> Box
Boxes.text
            (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++
             String
kind String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
             (if NewNotation -> Bool
notaIsOperator NewNotation
nota
              then String
"operator"
              else String
"notation") String -> String -> String
forall a. [a] -> [a] -> [a]
++
             (if NotationSection -> Bool
sectIsSection NotationSection
sect
              then String
" section"
              else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++
             (case NotationSection -> Maybe FixityLevel
sectLevel NotationSection
sect of
                Maybe FixityLevel
Nothing          -> String
""
                Just FixityLevel
Unrelated   -> String
", unrelated"
                Just (Related PrecedenceLevel
l) -> String
", level " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrecedenceLevel -> String
toStringWithoutDotZero PrecedenceLevel
l) String -> String -> String
forall a. [a] -> [a] -> [a]
++
             String
")")
            Box -> Box -> Box
Boxes.//
          Box
strut
        , Box
"["
            Box -> Box -> Box
Boxes.<>
          Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Boxes.vcat Alignment
Boxes.left
            ((Name -> Box) -> [Name] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
n -> Name -> Box
prettyName Name
n Box -> Box -> Box
Boxes.<> Box
",") [Name]
names [Box] -> [Box] -> [Box]
forall a. [a] -> [a] -> [a]
++
             [Name -> Box
prettyName Name
name Box -> Box -> Box
Boxes.<> Box
"]"])
        )
        where
        nota :: NewNotation
nota    = NotationSection -> NewNotation
sectNotation NotationSection
sect
        section :: [GenPart]
section = String -> [GenPart] -> [GenPart]
qualifyFirstIdPart
                    ((Name -> String -> String) -> String -> [Name] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Name
x String
s -> Name -> String
C.nameToRawName Name
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
                           String
""
                           ([Name] -> [Name]
forall a. [a] -> [a]
init (QName -> [Name]
C.qnameParts (NewNotation -> QName
notaName NewNotation
nota))))
                    ([GenPart] -> [GenPart]
trim (NewNotation -> [GenPart]
notation NewNotation
nota))

        qualifyFirstIdPart :: String -> [GenPart] -> [GenPart]
qualifyFirstIdPart String
_ []              = []
        qualifyFirstIdPart String
q (IdPart RString
x : [GenPart]
ps) = RString -> GenPart
IdPart ((String -> String) -> RString -> RString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
q String -> String -> String
forall a. [a] -> [a] -> [a]
++) RString
x) GenPart -> [GenPart] -> [GenPart]
forall a. a -> [a] -> [a]
: [GenPart]
ps
        qualifyFirstIdPart String
q (GenPart
p : [GenPart]
ps)        = GenPart
p GenPart -> [GenPart] -> [GenPart]
forall a. a -> [a] -> [a]
: String -> [GenPart] -> [GenPart]
qualifyFirstIdPart String
q [GenPart]
ps

        trim :: [GenPart] -> [GenPart]
trim = case NotationSection -> NotationKind
sectKind NotationSection
sect of
          NotationKind
InfixNotation   -> [GenPart] -> [GenPart]
trimLeft ([GenPart] -> [GenPart])
-> ([GenPart] -> [GenPart]) -> [GenPart] -> [GenPart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenPart] -> [GenPart]
trimRight
          NotationKind
PrefixNotation  -> [GenPart] -> [GenPart]
trimRight
          NotationKind
PostfixNotation -> [GenPart] -> [GenPart]
trimLeft
          NotationKind
NonfixNotation  -> [GenPart] -> [GenPart]
forall a. a -> a
id
          NotationKind
NoNotation      -> [GenPart] -> [GenPart]
forall a. HasCallStack => a
__IMPOSSIBLE__

        ([Name]
names, Name
name) = case Set Name -> [Name]
forall a. Set a -> [a]
Set.toList (Set Name -> [Name]) -> Set Name -> [Name]
forall a b. (a -> b) -> a -> b
$ NewNotation -> Set Name
notaNames NewNotation
nota of
          [] -> ([Name], Name)
forall a. HasCallStack => a
__IMPOSSIBLE__
          [Name]
ns -> ([Name] -> [Name]
forall a. [a] -> [a]
init [Name]
ns, [Name] -> Name
forall a. [a] -> a
last [Name]
ns)

        strut :: Box
strut = Int -> Int -> Box
Boxes.emptyBox ([Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
names) Int
0

        kind :: String
kind = case NotationSection -> NotationKind
sectKind NotationSection
sect of
          NotationKind
PrefixNotation  -> String
"prefix"
          NotationKind
PostfixNotation -> String
"postfix"
          NotationKind
NonfixNotation  -> String
"closed"
          NotationKind
NoNotation      -> String
forall a. HasCallStack => a
__IMPOSSIBLE__
          NotationKind
InfixNotation   ->
            case Fixity -> Associativity
fixityAssoc (Fixity -> Associativity) -> Fixity -> Associativity
forall a b. (a -> b) -> a -> b
$ NewNotation -> Fixity
notaFixity NewNotation
nota of
              Associativity
NonAssoc   -> String
"infix"
              Associativity
LeftAssoc  -> String
"infixl"
              Associativity
RightAssoc -> String
"infixr"

{- UNUSED
    AmbiguousParseForPatternSynonym p ps -> fsep (
      pwords "Don't know how to parse" ++ [pretty p <> "."] ++
      pwords "Could mean any one of:"
      ) $$ nest 2 (vcat $ map pretty ps)
-}

{- UNUSED
    IncompletePatternMatching v args -> fsep $
      pwords "Incomplete pattern matching for" ++ [prettyTCM v <> "."] ++
      pwords "No match for" ++ map prettyTCM args
-}

    SplitError SplitError
e -> SplitError -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM SplitError
e

    ImpossibleConstructor QName
c NegativeUnification
neg -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"The case for the constructor " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
c] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" is impossible" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [NegativeUnification -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM NegativeUnification
neg] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Possible solution: remove the clause, or use an absurd pattern ()."

    TooManyPolarities QName
x Int
n -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Too many polarities given in the POLARITY pragma for" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"(at most" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (Int -> String
forall a. Show a => a -> String
show Int
n)] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"allowed)."

    InstanceNoCandidate Type
t [(Term, TCErr)]
errs -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"No instance of type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"was found in scope."
      , [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ ((Term, TCErr) -> m Doc) -> [(Term, TCErr)] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Term, TCErr) -> m Doc
forall (m :: * -> *) a a.
(MonadReduce m, MonadAddContext m, MonadInteractionPoints m,
 MonadFresh NameId m, HasConstInfo m, HasBuiltins m,
 MonadStConcreteNames m, IsString (m Doc), Null (m Doc),
 Semigroup (m Doc), PrettyTCM a, PrettyTCM a) =>
(a, a) -> m Doc
prCand [(Term, TCErr)]
errs ]
      where
        prCand :: (a, a) -> m Doc
prCand (a
term, a
err) =
          String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
"-" m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+>
            [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat [ a -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM a
term m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<?> String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text String
"was ruled out because"
                 , a -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM a
err ]

    UnquoteFailed UnquoteError
e -> case UnquoteError
e of
      BadVisibility String
msg Arg Term
arg -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords (String -> [m Doc]) -> String -> [m Doc]
forall a b. (a -> b) -> a -> b
$ String
"Unable to unquote the argument. It should be `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."

      ConInsteadOfDef QName
x String
def String
con -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords (String
"Use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
con String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" instead of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
def String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for constructor") [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
        [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x]

      DefInsteadOfCon QName
x String
def String
con -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords (String
"Use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
def String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" instead of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
con String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for non-constructor")
        [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
x]

      NonCanonical String
kind Term
t ->
        String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String
"Cannot unquote non-canonical " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
kind)
        m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
t)

      BlockedOnMeta TCState
_ MetaId
m -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords (String -> [m Doc]) -> String -> [m Doc]
forall a b. (a -> b) -> a -> b
$ String
"Unquote failed because of unsolved meta variables."

      UnquotePanic String
err -> m Doc
forall a. HasCallStack => a
__IMPOSSIBLE__

    DeBruijnIndexOutOfScope Int
i Tele (Dom Type)
EmptyTel [] -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
        String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords (String -> [m Doc]) -> String -> [m Doc]
forall a b. (a -> b) -> a -> b
$ String
"de Bruijn index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not in scope in the empty context"
    DeBruijnIndexOutOfScope Int
i Tele (Dom Type)
cxt [Name]
names ->
        [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep [ String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String
"de Bruijn index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not in scope in the context")
            , m Doc -> m Doc
forall (tcm :: * -> *) a.
(MonadTCEnv tcm, ReadTCState tcm) =>
tcm a -> tcm a
inTopContext (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> m Doc -> m Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext (String
"_" :: String) (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Tele (Dom Type) -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Tele (Dom Type)
cxt' ]
      where
        cxt' :: Tele (Dom Type)
cxt' = Tele (Dom Type)
cxt Tele (Dom Type) -> Tele (Dom Type) -> Tele (Dom Type)
forall t. Abstract t => Tele (Dom Type) -> t -> t
`abstract` Int -> Tele (Dom Type) -> Tele (Dom Type)
forall t a. Subst t a => Int -> a -> a
raise (Tele (Dom Type) -> Int
forall a. Sized a => a -> Int
size Tele (Dom Type)
cxt) ([Name] -> Tele (Dom Type)
nameCxt [Name]
names)
        nameCxt :: [Name] -> I.Telescope
        nameCxt :: [Name] -> Tele (Dom Type)
nameCxt [] = Tele (Dom Type)
forall a. Tele a
EmptyTel
        nameCxt (Name
x : [Name]
xs) = Dom Type -> Abs (Tele (Dom Type)) -> Tele (Dom Type)
forall a. a -> Abs (Tele a) -> Tele a
ExtendTel (Type -> Dom Type
forall a. a -> Dom a
defaultDom (Sort -> Term -> Type
forall t a. Sort' t -> a -> Type'' t a
El Sort
HasCallStack => Sort
__DUMMY_SORT__ (Term -> Type) -> Term -> Type
forall a b. (a -> b) -> a -> b
$ Int -> Term
I.var Int
0)) (Abs (Tele (Dom Type)) -> Tele (Dom Type))
-> Abs (Tele (Dom Type)) -> Tele (Dom Type)
forall a b. (a -> b) -> a -> b
$
          String -> Tele (Dom Type) -> Abs (Tele (Dom Type))
forall a. String -> a -> Abs a
NoAbs (Name -> String
forall a. Pretty a => a -> String
P.prettyShow Name
x) (Tele (Dom Type) -> Abs (Tele (Dom Type)))
-> Tele (Dom Type) -> Abs (Tele (Dom Type))
forall a b. (a -> b) -> a -> b
$ [Name] -> Tele (Dom Type)
nameCxt [Name]
xs

    TypeError
NeedOptionCopatterns -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Option --copatterns needed to enable destructor patterns"

    TypeError
NeedOptionRewriting  -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Option --rewriting needed to add and use rewrite rules"

    TypeError
NeedOptionProp       -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Universe Prop is disabled (use options --prop and --no-prop to enable/disable Prop)"

    GeneralizeNotSupportedHere QName
x -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords (String -> [m Doc]) -> String -> [m Doc]
forall a b. (a -> b) -> a -> b
$ String
"Generalizable variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not supported here"

    TypeError
GeneralizeCyclicDependency -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cyclic dependency between generalized variables"

    TypeError
GeneralizeUnsolvedMeta -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Unsolved meta not generalized"

    MultipleFixityDecls [(Name, [Fixity'])]
xs ->
      [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
sep [ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Multiple fixity or syntax declarations for"
          , [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ ((Name, [Fixity']) -> m Doc) -> [(Name, [Fixity'])] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [Fixity']) -> m Doc
forall (m :: * -> *) a a.
(Semigroup (m Doc), Monad m, IsString (m Doc), Pretty a,
 Pretty a) =>
(a, [a]) -> m Doc
f [(Name, [Fixity'])]
xs
          ]
      where
        f :: (a, [a]) -> m Doc
f (a
x, [a]
fs) = (a -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty a
x m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
": ") m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ((a -> m Doc) -> [a] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [a]
fs)

    MultiplePolarityPragmas [Name]
xs -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Multiple polarity pragmas for" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ (Name -> m Doc) -> [Name] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> m Doc
forall (m :: * -> *) a. (Monad m, Pretty a) => a -> m Doc
pretty [Name]
xs

    NonFatalErrors [TCWarning]
ws -> (m Doc -> m Doc -> m Doc) -> [m Doc] -> m Doc
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
($$) ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (TCWarning -> m Doc) -> [TCWarning] -> [m Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TCWarning -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM [TCWarning]
ws

    InstanceSearchDepthExhausted Term
c Type
a Int
d -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords (String
"Instance search depth exhausted (max depth: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") for candidate") [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [m Doc -> Int -> m Doc -> m Doc
forall (m :: * -> *).
Applicative m =>
m Doc -> Int -> m Doc -> m Doc
hang (Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
c m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> m Doc
":") Int
2 (Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
a)]

    TriedToCopyConstrainedPrim QName
q -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot create a module containing a copy of" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
q]

    where
    mpar :: a -> a -> m Doc -> m Doc
mpar a
n a
args
      | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. Null a => a -> Bool
null a
args) = m Doc -> m Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
parens
      | Bool
otherwise                = m Doc -> m Doc
forall a. a -> a
id

    prettyArg :: MonadPretty m => Arg (I.Pattern' a) -> m Doc
    prettyArg :: Arg (Pattern' a) -> m Doc
prettyArg (Arg ArgInfo
info Pattern' a
x) = case ArgInfo -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding ArgInfo
info of
      Hiding
Hidden     -> m Doc -> m Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
braces (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Integer -> Pattern' a -> m Doc
forall (m :: * -> *) a.
MonadPretty m =>
Integer -> Pattern' a -> m Doc
prettyPat Integer
0 Pattern' a
x
      Instance{} -> m Doc -> m Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
dbraces (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Integer -> Pattern' a -> m Doc
forall (m :: * -> *) a.
MonadPretty m =>
Integer -> Pattern' a -> m Doc
prettyPat Integer
0 Pattern' a
x
      Hiding
NotHidden  -> Integer -> Pattern' a -> m Doc
forall (m :: * -> *) a.
MonadPretty m =>
Integer -> Pattern' a -> m Doc
prettyPat Integer
1 Pattern' a
x

    prettyPat :: MonadPretty m => Integer -> (I.Pattern' a) -> m Doc
    prettyPat :: Integer -> Pattern' a -> m Doc
prettyPat Integer
_ (I.VarP PatternInfo
_ a
_) = m Doc
"_"
    prettyPat Integer
_ (I.DotP PatternInfo
_ Term
_) = m Doc
"._"
    prettyPat Integer
n (I.ConP ConHead
c ConPatternInfo
_ [NamedArg (Pattern' a)]
args) =
      Integer -> [NamedArg (Pattern' a)] -> m Doc -> m Doc
forall a a (m :: * -> *).
(Ord a, Num a, Null a, Functor m) =>
a -> a -> m Doc -> m Doc
mpar Integer
n [NamedArg (Pattern' a)]
args (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$
        ConHead -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM ConHead
c m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ((NamedArg (Pattern' a) -> m Doc)
-> [NamedArg (Pattern' a)] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Arg (Pattern' a) -> m Doc
forall (m :: * -> *) a. MonadPretty m => Arg (Pattern' a) -> m Doc
prettyArg (Arg (Pattern' a) -> m Doc)
-> (NamedArg (Pattern' a) -> Arg (Pattern' a))
-> NamedArg (Pattern' a)
-> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Named NamedName (Pattern' a) -> Pattern' a)
-> NamedArg (Pattern' a) -> Arg (Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Named NamedName (Pattern' a) -> Pattern' a
forall name a. Named name a -> a
namedThing) [NamedArg (Pattern' a)]
args)
    prettyPat Integer
n (I.DefP PatternInfo
o QName
q [NamedArg (Pattern' a)]
args) =
      Integer -> [NamedArg (Pattern' a)] -> m Doc -> m Doc
forall a a (m :: * -> *).
(Ord a, Num a, Null a, Functor m) =>
a -> a -> m Doc -> m Doc
mpar Integer
n [NamedArg (Pattern' a)]
args (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$
        QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
q m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ((NamedArg (Pattern' a) -> m Doc)
-> [NamedArg (Pattern' a)] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Arg (Pattern' a) -> m Doc
forall (m :: * -> *) a. MonadPretty m => Arg (Pattern' a) -> m Doc
prettyArg (Arg (Pattern' a) -> m Doc)
-> (NamedArg (Pattern' a) -> Arg (Pattern' a))
-> NamedArg (Pattern' a)
-> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Named NamedName (Pattern' a) -> Pattern' a)
-> NamedArg (Pattern' a) -> Arg (Pattern' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Named NamedName (Pattern' a) -> Pattern' a
forall name a. Named name a -> a
namedThing) [NamedArg (Pattern' a)]
args)
    prettyPat Integer
_ (I.LitP PatternInfo
_ Literal
l) = Literal -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Literal
l
    prettyPat Integer
_ (I.ProjP ProjOrigin
_ QName
p) = m Doc
"." m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
p
    prettyPat Integer
_ (I.IApplyP PatternInfo
_ Term
_ Term
_ a
_) = m Doc
"_"

notCmp :: MonadPretty m => Comparison -> m Doc
notCmp :: Comparison -> m Doc
notCmp Comparison
cmp = m Doc
"!" m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Comparison -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Comparison
cmp

-- | Print two terms that are supposedly unequal.
--   If they print to the same identifier, add some explanation
--   why they are different nevertheless.
prettyInEqual :: MonadPretty m => Term -> Term -> m (Doc, Doc, Doc)
prettyInEqual :: Term -> Term -> m (Doc, Doc, Doc)
prettyInEqual Term
t1 Term
t2 = do
  Doc
d1 <- Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
t1
  Doc
d2 <- Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
t2
  (Doc
d1, Doc
d2,) (Doc -> (Doc, Doc, Doc)) -> m Doc -> m (Doc, Doc, Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
     -- if printed differently, no extra explanation needed
    if Doc -> String
P.render Doc
d1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= Doc -> String
P.render Doc
d2 then m Doc
forall a. Null a => a
empty else do
      (Term
v1, Term
v2) <- (Term, Term) -> m (Term, Term)
forall a (m :: * -> *). (Instantiate a, MonadReduce m) => a -> m a
instantiate (Term
t1, Term
t2)
      case (Term
v1, Term
v2) of
        (I.Var Int
i1 Elims
_, I.Var Int
i2 Elims
_)
          | Int
i1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i2  -> m Doc
forall (m :: * -> *). MonadPretty m => m Doc
generic -- possible, see issue 1826
          | Bool
otherwise -> Int -> Int -> m Doc
forall (m :: * -> *). MonadPretty m => Int -> Int -> m Doc
varVar Int
i1 Int
i2
        (I.Def{}, I.Con{}) -> m Doc
forall a. HasCallStack => a
__IMPOSSIBLE__  -- ambiguous identifiers
        (I.Con{}, I.Def{}) -> m Doc
forall a. HasCallStack => a
__IMPOSSIBLE__
        (I.Var{}, I.Def{}) -> m Doc
forall (m :: * -> *). MonadPretty m => m Doc
varDef
        (I.Def{}, I.Var{}) -> m Doc
forall (m :: * -> *). MonadPretty m => m Doc
varDef
        (I.Var{}, I.Con{}) -> m Doc
forall (m :: * -> *). MonadPretty m => m Doc
varCon
        (I.Con{}, I.Var{}) -> m Doc
forall (m :: * -> *). MonadPretty m => m Doc
varCon
        (Term, Term)
_                  -> m Doc
forall a. Null a => a
empty
  where
    varDef, varCon, generic :: MonadPretty m => m Doc
    varDef :: m Doc
varDef = m Doc -> m Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
parens (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"because one is a variable and one a defined identifier"
    varCon :: m Doc
varCon = m Doc -> m Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
parens (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords String
"because one is a variable and one a constructor"
    generic :: m Doc
generic = m Doc -> m Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
parens (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$ String
"although these terms are looking the same, " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"they contain different but identically rendered identifiers somewhere"
    varVar :: MonadPretty m => Int -> Int -> m Doc
    varVar :: Int -> Int -> m Doc
varVar Int
i Int
j = m Doc -> m Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
parens (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
fwords (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$
                   String
"because one has de Bruijn index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and the other " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j

class PrettyUnequal a where
  prettyUnequal :: MonadPretty m => a -> m Doc -> a -> m Doc

instance PrettyUnequal Term where
  prettyUnequal :: Term -> m Doc -> Term -> m Doc
prettyUnequal Term
t1 m Doc
ncmp Term
t2 = do
    (Doc
d1, Doc
d2, Doc
d) <- Term -> Term -> m (Doc, Doc, Doc)
forall (m :: * -> *).
MonadPretty m =>
Term -> Term -> m (Doc, Doc, Doc)
prettyInEqual Term
t1 Term
t2
    [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
d1 m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: m Doc
ncmp m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
d2 m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
d m Doc -> [m Doc] -> [m Doc]
forall a. a -> [a] -> [a]
: []

instance PrettyUnequal Type where
  prettyUnequal :: Type -> m Doc -> Type -> m Doc
prettyUnequal Type
t1 m Doc
ncmp Type
t2 = Term -> m Doc -> Term -> m Doc
forall a (m :: * -> *).
(PrettyUnequal a, MonadPretty m) =>
a -> m Doc -> a -> m Doc
prettyUnequal (Type -> Term
forall t a. Type'' t a -> a
unEl Type
t1) m Doc
ncmp (Type -> Term
forall t a. Type'' t a -> a
unEl Type
t2)

instance PrettyTCM SplitError where
  prettyTCM :: SplitError -> m Doc
prettyTCM SplitError
err = case SplitError
err of
    NotADatatype Closure Type
t -> Closure Type -> (Type -> m Doc) -> m Doc
forall (m :: * -> *) a c b.
(MonadTCEnv m, ReadTCState m, LensClosure a c) =>
c -> (a -> m b) -> m b
enterClosure Closure Type
t ((Type -> m Doc) -> m Doc) -> (Type -> m Doc) -> m Doc
forall a b. (a -> b) -> a -> b
$ \ Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot split on argument of non-datatype" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t]

    IrrelevantDatatype Closure Type
t -> Closure Type -> (Type -> m Doc) -> m Doc
forall (m :: * -> *) a c b.
(MonadTCEnv m, ReadTCState m, LensClosure a c) =>
c -> (a -> m b) -> m b
enterClosure Closure Type
t ((Type -> m Doc) -> m Doc) -> (Type -> m Doc) -> m Doc
forall a b. (a -> b) -> a -> b
$ \ Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot split on argument of irrelevant datatype" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t]

    ErasedDatatype Bool
causedByWithoutK Closure Type
t -> Closure Type -> (Type -> m Doc) -> m Doc
forall (m :: * -> *) a c b.
(MonadTCEnv m, ReadTCState m, LensClosure a c) =>
c -> (a -> m b) -> m b
enterClosure Closure Type
t ((Type -> m Doc) -> m Doc) -> (Type -> m Doc) -> m Doc
forall a b. (a -> b) -> a -> b
$ \ Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot branch on erased argument of datatype" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      if Bool
causedByWithoutK
      then String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because the K rule is turned off"
      else []

    CoinductiveDatatype Closure Type
t -> Closure Type -> (Type -> m Doc) -> m Doc
forall (m :: * -> *) a c b.
(MonadTCEnv m, ReadTCState m, LensClosure a c) =>
c -> (a -> m b) -> m b
enterClosure Closure Type
t ((Type -> m Doc) -> m Doc) -> (Type -> m Doc) -> m Doc
forall a b. (a -> b) -> a -> b
$ \ Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot pattern match on the coinductive type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t]

{- UNUSED
    NoRecordConstructor t -> fsep $
      pwords "Cannot pattern match on record" ++ [prettyTCM t] ++
      pwords "because it has no constructor"
 -}

    UnificationStuck QName
c Tele (Dom Type)
tel Args
cIxs Args
gIxs [UnificationFailure]
errs
      | Args -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Args
cIxs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Args -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Args
gIxs -> m Doc
forall a. HasCallStack => a
__IMPOSSIBLE__
      | Bool
otherwise                  -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> ([[m Doc]] -> [m Doc]) -> [[m Doc]] -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[m Doc]] -> [m Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[m Doc]] -> m Doc) -> [[m Doc]] -> m Doc
forall a b. (a -> b) -> a -> b
$
        [ [ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> ([[m Doc]] -> [m Doc]) -> [[m Doc]] -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[m Doc]] -> [m Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[m Doc]] -> m Doc) -> [[m Doc]] -> m Doc
forall a b. (a -> b) -> a -> b
$
            [ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"I'm not sure if there should be a case for the constructor"
            , [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
c m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
","]
            , String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because I get stuck when trying to solve the following"
            , String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"unification problems (inferred index ≟ expected index):"
            ]
          ]
        , (Arg Term -> Arg Term -> m Doc) -> Args -> Args -> [m Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Arg Term -> Arg Term -> m Doc
forall (m :: * -> *) a a.
(MonadAddContext m, MonadReduce m, MonadInteractionPoints m,
 MonadFresh NameId m, HasConstInfo m, HasBuiltins m,
 MonadStConcreteNames m, IsString (m Doc), Null (m Doc),
 Semigroup (m Doc), PrettyTCM a, PrettyTCM a) =>
Arg a -> Arg a -> m Doc
prEq Args
cIxs Args
gIxs
        , if [UnificationFailure] -> Bool
forall a. Null a => a -> Bool
null [UnificationFailure]
errs then [] else
            [ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Possible" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords ([UnificationFailure] -> String -> String -> String
forall a c. Sized a => a -> c -> c -> c
P.singPlural [UnificationFailure]
errs String
"reason" String
"reasons") [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
                     String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"why unification failed:" ] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
            (UnificationFailure -> m Doc) -> [UnificationFailure] -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (m Doc -> m Doc)
-> (UnificationFailure -> m Doc) -> UnificationFailure -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnificationFailure -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM) [UnificationFailure]
errs
        ]
      where
        -- Andreas, 2019-08-08, issue #3943
        -- To not print hidden indices just as {_}, we strip the Arg and print
        -- the hiding information manually.
        prEq :: Arg a -> Arg a -> m Doc
prEq Arg a
cIx Arg a
gIx = Tele (Dom Type) -> m Doc -> m Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext Tele (Dom Type)
tel (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
hsep [ Arg a -> m Doc
forall (f :: * -> *) a.
(PrettyTCM a, MonadReduce f, MonadAddContext f,
 MonadInteractionPoints f, MonadFresh NameId f, HasConstInfo f,
 HasBuiltins f, MonadStConcreteNames f, IsString (f Doc),
 Null (f Doc), Semigroup (f Doc)) =>
Arg a -> f Doc
pr Arg a
cIx , m Doc
"≟" , Arg a -> m Doc
forall (f :: * -> *) a.
(PrettyTCM a, MonadReduce f, MonadAddContext f,
 MonadInteractionPoints f, MonadFresh NameId f, HasConstInfo f,
 HasBuiltins f, MonadStConcreteNames f, IsString (f Doc),
 Null (f Doc), Semigroup (f Doc)) =>
Arg a -> f Doc
pr Arg a
gIx ]
        pr :: Arg a -> f Doc
pr Arg a
arg = Arg a -> Doc -> Doc
forall a. LensRelevance a => a -> Doc -> Doc
prettyRelevance Arg a
arg (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg a -> (Doc -> Doc) -> Doc -> Doc
forall a. LensHiding a => a -> (Doc -> Doc) -> Doc -> Doc
prettyHiding Arg a
arg Doc -> Doc
forall a. a -> a
id (Doc -> Doc) -> f Doc -> f Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Arg a -> a
forall e. Arg e -> e
unArg Arg a
arg)

    SplitError
CosplitCatchall -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot split into projections because not all clauses have a projection copattern"

    SplitError
CosplitNoTarget -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot split into projections because target type is unknown"

    CosplitNoRecordType Closure Type
t -> Closure Type -> (Type -> m Doc) -> m Doc
forall (m :: * -> *) a c b.
(MonadTCEnv m, ReadTCState m, LensClosure a c) =>
c -> (a -> m b) -> m b
enterClosure Closure Type
t ((Type -> m Doc) -> m Doc) -> (Type -> m Doc) -> m Doc
forall a b. (a -> b) -> a -> b
$ \Type
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot split into projections because the target type "
      [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
t] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" is not a record type"

    CannotCreateMissingClause QName
f (Tele (Dom Type), [NamedArg DeBruijnPattern])
cl Doc
msg Closure (Abs Type)
t -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep (
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot generate inferred clause for" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [QName -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM QName
f m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Case to handle:") m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 ([m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ [(Tele (Dom Type), [NamedArg DeBruijnPattern]) -> m Doc
forall (m :: * -> *).
(MonadReduce m, MonadAddContext m, MonadInteractionPoints m,
 MonadFresh NameId m, HasConstInfo m, HasBuiltins m,
 MonadStConcreteNames m, IsString (m Doc), Null (m Doc),
 Semigroup (m Doc)) =>
(Tele (Dom Type), [NamedArg DeBruijnPattern]) -> m Doc
display (Tele (Dom Type), [NamedArg DeBruijnPattern])
cl])
                                m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
$$ ((Doc -> m Doc
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
msg m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Closure (Abs Type) -> (Abs Type -> m Doc) -> m Doc
forall (m :: * -> *) a c b.
(MonadTCEnv m, ReadTCState m, LensClosure a c) =>
c -> (a -> m b) -> m b
enterClosure Closure (Abs Type)
t Abs Type -> m Doc
forall (m :: * -> *) a.
(MonadAddContext m, PrettyTCM a, MonadReduce m,
 MonadInteractionPoints m, MonadFresh NameId m, HasConstInfo m,
 HasBuiltins m, MonadStConcreteNames m, IsString (m Doc),
 Null (m Doc), Semigroup (m Doc)) =>
Abs a -> m Doc
displayAbs) m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
".")
        where
        displayAbs :: Abs a -> m Doc
displayAbs (Abs String
x a
t) = String -> m Doc -> m Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext String
x (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ a -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM a
t
        displayAbs (NoAbs String
x a
t) = a -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM a
t
        display :: (Tele (Dom Type), [NamedArg DeBruijnPattern]) -> m Doc
display (Tele (Dom Type)
tel, [NamedArg DeBruijnPattern]
ps) = NamedClause -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (NamedClause -> m Doc) -> NamedClause -> m Doc
forall a b. (a -> b) -> a -> b
$ QName -> Bool -> Clause -> NamedClause
NamedClause QName
f Bool
True (Clause -> NamedClause) -> Clause -> NamedClause
forall a b. (a -> b) -> a -> b
$
          Clause
forall a. Null a => a
empty { clauseTel :: Tele (Dom Type)
clauseTel = Tele (Dom Type)
tel, namedClausePats :: [NamedArg DeBruijnPattern]
namedClausePats = [NamedArg DeBruijnPattern]
ps }


    GenericSplitError String
s -> [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Split failed:" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
s

instance PrettyTCM NegativeUnification where
  prettyTCM :: NegativeUnification -> m Doc
prettyTCM NegativeUnification
err = case NegativeUnification
err of
    UnifyConflict Tele (Dom Type)
tel Term
u Term
v -> Tele (Dom Type) -> m Doc -> m Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext Tele (Dom Type)
tel (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because unification ended with a conflicting equation "
      , Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
u m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> m Doc
"≟" m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v
      ]

    UnifyCycle Tele (Dom Type)
tel Int
i Term
u -> Tele (Dom Type) -> m Doc -> m Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext Tele (Dom Type)
tel (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
vcat ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      [ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because unification ended with a cyclic equation "
      , Int -> m Doc -> m Doc
forall (m :: * -> *). Functor m => Int -> m Doc -> m Doc
nest Int
2 (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Int -> Term
var Int
i) m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> m Doc
"≟" m Doc -> m Doc -> m Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
u
      ]

instance PrettyTCM UnificationFailure where
  prettyTCM :: UnificationFailure -> m Doc
prettyTCM UnificationFailure
err = case UnificationFailure
err of
    UnifyIndicesNotVars Tele (Dom Type)
tel Type
a Term
u Term
v Args
ixs -> Tele (Dom Type) -> m Doc -> m Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext Tele (Dom Type)
tel (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot apply injectivity to the equation" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
u] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"=" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
v] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"of type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
a] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because I cannot generalize over the indices" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      [[m Doc] -> m Doc
forall (m :: * -> *).
(Monad m, Semigroup (m Doc)) =>
[m Doc] -> m Doc
prettyList ((Arg Term -> m Doc) -> Args -> [m Doc]
forall a b. (a -> b) -> [a] -> [b]
map Arg Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Args
ixs) m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
"."]

    UnifyRecursiveEq Tele (Dom Type)
tel Type
a Int
i Term
u -> Tele (Dom Type) -> m Doc -> m Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext Tele (Dom Type)
tel (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot solve variable " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Int -> Term
var Int
i)] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" of type " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
a] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" with solution " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
u] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" because the variable occurs in the solution," [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
" or in the type of one of the variables in the solution."

    UnifyReflexiveEq Tele (Dom Type)
tel Type
a Term
u -> Tele (Dom Type) -> m Doc -> m Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext Tele (Dom Type)
tel (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot eliminate reflexive equation" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
u] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"=" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
u] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"of type" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
a] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because K has been disabled."

    UnifyUnusableModality Tele (Dom Type)
tel Type
a Int
i Term
u Modality
mod -> Tele (Dom Type) -> m Doc -> m Doc
forall b (m :: * -> *) a.
(AddContext b, MonadAddContext m) =>
b -> m a -> m a
addContext Tele (Dom Type)
tel (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ [m Doc] -> m Doc
forall (m :: * -> *). Monad m => [m Doc] -> m Doc
fsep ([m Doc] -> m Doc) -> [m Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"Cannot solve variable " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM (Int -> Term
var Int
i)] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"of type " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Type -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Type
a] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"with solution " [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++ [Term -> m Doc
forall a (m :: * -> *). (PrettyTCM a, MonadPretty m) => a -> m Doc
prettyTCM Term
u] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"because the solution cannot be used at" [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
             [ String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (Relevance -> String
forall a. Verbalize a => a -> String
verbalize (Relevance -> String) -> Relevance -> String
forall a b. (a -> b) -> a -> b
$ Modality -> Relevance
forall a. LensRelevance a => a -> Relevance
getRelevance Modality
mod) m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
","
             , String -> m Doc
forall (m :: * -> *). Monad m => String -> m Doc
text (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$ Quantity -> String
forall a. Verbalize a => a -> String
verbalize (Quantity -> String) -> Quantity -> String
forall a b. (a -> b) -> a -> b
$ Modality -> Quantity
forall a. LensQuantity a => a -> Quantity
getQuantity Modality
mod ] [m Doc] -> [m Doc] -> [m Doc]
forall a. [a] -> [a] -> [a]
++
      String -> [m Doc]
forall (m :: * -> *). Monad m => String -> [m Doc]
pwords String
"modality"


---------------------------------------------------------------------------
-- * Natural language
---------------------------------------------------------------------------

class Verbalize a where
  verbalize :: a -> String

instance Verbalize Hiding where
  verbalize :: Hiding -> String
verbalize Hiding
h =
    case Hiding
h of
      Hiding
Hidden     -> String
"hidden"
      Hiding
NotHidden  -> String
"visible"
      Instance{} -> String
"instance"

instance Verbalize Relevance where
  verbalize :: Relevance -> String
verbalize Relevance
r =
    case Relevance
r of
      Relevance
Relevant   -> String
"relevant"
      Relevance
Irrelevant -> String
"irrelevant"
      Relevance
NonStrict  -> String
"shape-irrelevant"

instance Verbalize Quantity where
  verbalize :: Quantity -> String
verbalize = \case
    Quantity0{} -> String
"erased"
    Quantity1{} -> String
"linear"
    Quantityω{} -> String
"unrestricted"

instance Verbalize Cohesion where
  verbalize :: Cohesion -> String
verbalize Cohesion
r =
    case Cohesion
r of
      Cohesion
Flat       -> String
"flat"
      Cohesion
Continuous -> String
"continuous"
      Cohesion
Squash     -> String
"squashed"

-- | Indefinite article.
data Indefinite a = Indefinite a

instance Verbalize a => Verbalize (Indefinite a) where
  verbalize :: Indefinite a -> String
verbalize (Indefinite a
a) =
    case a -> String
forall a. Verbalize a => a -> String
verbalize a
a of
      String
"" -> String
""
      w :: String
w@(Char
c:String
cs) | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'a',Char
'e',Char
'i',Char
'o'] -> String
"an " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w
               | Bool
otherwise                  -> String
"a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w
      -- Aarne Ranta would whip me if he saw this.