{-# LANGUAGE CPP, ExistentialQuantification, FlexibleContexts, Rank2Types,
TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances,
UndecidableInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving
#-}moduleAgda.TypeChecking.Monad.BasewhereimportControl.ExceptionasEimportControl.Monad.ErrorimportControl.Monad.StateimportControl.Monad.ReaderimportControl.ApplicativeimportData.IntimportData.MapasMapimportData.SetasSetimportData.GenericsimportData.FoldableimportData.TraversableimportSystem.TimeimportAgda.Syntax.CommonimportqualifiedAgda.Syntax.ConcreteasCimportqualifiedAgda.Syntax.Concrete.DefinitionsasDimportqualifiedAgda.Syntax.AbstractasAimportAgda.Syntax.InternalimportAgda.Syntax.PositionimportAgda.Syntax.Scope.BaseimportAgda.TypeChecking.CompiledClauseimportAgda.Interaction.Exceptionsimport{-# SOURCE #-}Agda.Interaction.FindFileimportAgda.Interaction.OptionsimportqualifiedAgda.Interaction.Highlighting.RangeasRimportAgda.Interaction.Highlighting.Precise(HighlightingInfo)importAgda.Utils.FileNameimportAgda.Utils.FreshimportAgda.Utils.MonadimportAgda.Utils.Permutation#include "../../undefined.h"importAgda.Utils.Impossible----------------------------------------------------------------------------- * Type checking state---------------------------------------------------------------------------dataTCState=TCSt{stFreshThings::FreshThings,stMetaStore::MetaStore,stInteractionPoints::InteractionPoints,stConstraints::Constraints,stSignature::Signature,stImports::Signature,stImportedModules::SetModuleName,stModuleToSource::ModuleToSource,stVisitedModules::VisitedModules,stDecodedModules::DecodedModules,stCurrentModule::MaybeModuleName-- ^ The current module is available after it has been type-- checked.,stScope::ScopeInfo,stPersistentOptions::CommandLineOptions-- ^ Options which apply to all files, unless overridden.,stPragmaOptions::PragmaOptions-- ^ Options applying to the current file. @OPTIONS@-- pragmas only affect this field.,stStatistics::Statistics,stMutualBlocks::MapMutualId(SetQName),stLocalBuiltins::BuiltinThingsPrimFun,stImportedBuiltins::BuiltinThingsPrimFun,stHaskellImports::SetString-- ^ Imports that should be generated by the compiler (this-- includes imports from imported modules).}dataFreshThings=Fresh{fMeta::MetaId,fInteraction::InteractionId,fMutual::MutualId,fName::NameId,fCtx::CtxId,fInteger::Integer-- ^ Can be used for various things.}deriving(Show)initState::TCStateinitState=TCSt{stFreshThings=Fresh000(NameId00)00,stMetaStore=Map.empty,stInteractionPoints=Map.empty,stConstraints=[],stSignature=emptySignature,stImports=emptySignature,stImportedModules=Set.empty,stModuleToSource=Map.empty,stVisitedModules=Map.empty,stDecodedModules=Map.empty,stCurrentModule=Nothing,stScope=emptyScopeInfo,stPersistentOptions=defaultOptions,stPragmaOptions=optPragmaOptions$defaultOptions,stStatistics=Map.empty,stMutualBlocks=Map.empty,stLocalBuiltins=Map.empty,stImportedBuiltins=Map.empty,stHaskellImports=Set.empty}stBuiltinThings::TCState->BuiltinThingsPrimFunstBuiltinThingss=stLocalBuiltinss`Map.union`stImportedBuiltinssinstanceHasFreshMetaIdFreshThingswherenextFreshs=(i,s{fMeta=i+1})wherei=fMetasinstanceHasFreshMutualIdFreshThingswherenextFreshs=(i,s{fMutual=i+1})wherei=fMutualsinstanceHasFreshInteractionIdFreshThingswherenextFreshs=(i,s{fInteraction=i+1})wherei=fInteractionsinstanceHasFreshNameIdFreshThingswherenextFreshs=(i,s{fName=succi})wherei=fNamesinstanceHasFreshCtxIdFreshThingswherenextFreshs=(i,s{fCtx=succi})wherei=fCtxsinstanceHasFreshIntegerFreshThingswherenextFreshs=(i,s{fInteger=succi})wherei=fIntegersinstanceHasFreshiFreshThings=>HasFreshiTCStatewherenextFreshs=((,)$!i)$!s{stFreshThings=f}where(i,f)=nextFresh$stFreshThingss----------------------------------------------------------------------------- ** Interface---------------------------------------------------------------------------dataModuleInfo=ModuleInfo{miInterface::Interface,miWarnings::Bool-- ^ 'True' if warnings were encountered when the module was type-- checked.,miTimeStamp::ClockTime-- ^ The modification time stamp of the interface file when the-- interface was read or written. Alternatively, if warnings were-- encountered (in which case there may not be any up-to-date-- interface file), the time at which the interface was produced-- (approximately).}-- Note that the use of 'C.TopLevelModuleName' here is a potential-- performance problem, because these names do not contain unique-- identifiers.typeVisitedModules=MapC.TopLevelModuleNameModuleInfotypeDecodedModules=MapC.TopLevelModuleName(Interface,ClockTime)dataInterface=Interface{iImportedModules::[ModuleName],iModuleName::ModuleName,iScope::MapModuleNameScope,iInsideScope::ScopeInfo,iSignature::Signature,iBuiltin::BuiltinThingsString,iHaskellImports::SetString-- ^ Haskell imports listed in-- (transitively) imported modules are-- not included here.,iHighlighting::HighlightingInfo,iPragmaOptions::[OptionsPragma]-- ^ Pragma options set in the file.}deriving(Typeable,Data,Show)----------------------------------------------------------------------------- ** Closure---------------------------------------------------------------------------dataClosurea=Closure{clSignature::Signature,clEnv::TCEnv,clScope::ScopeInfo,clValue::a}deriving(Typeable,Data)instanceShowa=>Show(Closurea)whereshowcl="Closure "++show(clValuecl)instanceHasRangea=>HasRange(Closurea)wheregetRange=getRange.clValuebuildClosure::MonadTCMtcm=>a->tcm(Closurea)buildClosurex=liftTCM$doenv<-asksig<-getsstSignaturescope<-getsstScopereturn$Closuresigenvscopex----------------------------------------------------------------------------- ** Constraints---------------------------------------------------------------------------typeConstraintClosure=ClosureConstraintdataConstraint=ValueCmpComparisonTypeTermTerm|ArgsCmp[Polarity]TypeArgsArgs|TypeCmpComparisonTypeType|TelCmpComparisonTelescopeTelescope|SortCmpComparisonSortSort|LevelCmpComparisonTermTerm|UnBlockMetaId|GuardedConstraintConstraints|IsEmptyTypederiving(Typeable,Show)dataComparison=CmpEq|CmpLeqderiving(Eq,Typeable,Show)typeConstraints=[ConstraintClosure]----------------------------------------------------------------------------- * Open things----------------------------------------------------------------------------- | A thing tagged with the context it came from.dataOpena=OpenThing[CtxId]aderiving(Typeable,Data,Show)----------------------------------------------------------------------------- * Judgements---------------------------------------------------------------------------dataJudgementta=HasTypeat|IsSortaderiving(Typeable,Data)instance(Showt,Showa)=>Show(Judgementta)whereshow(HasTypeat)=showa++" : "++showtshow(IsSorta)=showa++" sort"instanceFunctor(Judgementt)wherefmapf(HasTypext)=HasType(fx)tfmapf(IsSortx)=IsSort(fx)instanceFoldable(Judgementt)wherefoldrfz(HasTypex_)=fxzfoldrfz(IsSortx)=fxzinstanceTraversable(Judgementt)wheretraversef(HasTypext)=flipHasTypet<$>fxtraversef(IsSortx)=IsSort<$>fx----------------------------------------------------------------------------- ** Meta variables---------------------------------------------------------------------------dataMetaVariable=MetaVar{mvInfo::MetaInfo,mvPriority::MetaPriority-- ^ some metavariables are more eager to be instantiated,mvPermutation::Permutation-- ^ a metavariable doesn't have to depend on all variables-- in the context, this "permutation" will throw away the-- ones it does not depend on,mvJudgement::JudgementTypeMetaId,mvInstantiation::MetaInstantiation,mvListeners::SetMetaId-- ^ metavariables interested in what happens to this guy}deriving(Typeable)dataMetaInstantiation=InstVTerm|InstSTerm-- should be Lam .. Sort s|Open|BlockedConstTerm|PostponedTypeCheckingProblem(Closure(A.Expr,Type,TCMBool))deriving(Typeable)instanceShowMetaInstantiationwhereshow(InstVt)="InstV ("++showt++")"show(InstSs)="InstS ("++shows++")"showOpen="Open"show(BlockedConstt)="BlockedConst ("++showt++")"show(PostponedTypeCheckingProblem{})="PostponedTypeCheckingProblem (...)"newtypeMetaPriority=MetaPriorityIntderiving(Eq,Ord,Show)-- | TODO: Not so nice.typeMetaInfo=ClosureRangetypeMetaStore=MapMetaIdMetaVariableinstanceHasRangeMetaVariablewheregetRangem=getRange$getMetaInfominstanceSetRangeMetaVariablewheresetRanger(MetaVarmippermjinstls)=MetaVar(mi{clValue=r})ppermjinstlsnormalMetaPriority::MetaPrioritynormalMetaPriority=MetaPriority0lowMetaPriority::MetaPrioritylowMetaPriority=MetaPriority(-10)highMetaPriority::MetaPriorityhighMetaPriority=MetaPriority10getMetaInfo::MetaVariable->MetaInfogetMetaInfo=mvInfogetMetaScope::MetaVariable->ScopeInfogetMetaScopem=clScope$getMetaInfomgetMetaEnv::MetaVariable->TCEnvgetMetaEnvm=clEnv$getMetaInfomgetMetaSig::MetaVariable->SignaturegetMetaSigm=clSignature$getMetaInfom----------------------------------------------------------------------------- ** Interaction meta variables---------------------------------------------------------------------------typeInteractionPoints=MapInteractionIdMetaIdnewtypeInteractionId=InteractionIdNatderiving(Eq,Ord,Num,Integral,Real,Enum)instanceShowInteractionIdwhereshow(InteractionIdx)="?"++showx----------------------------------------------------------------------------- ** Signature---------------------------------------------------------------------------dataSignature=Sig{sigSections::Sections,sigDefinitions::Definitions}deriving(Typeable,Data,Show)typeSections=MapModuleNameSectiontypeDefinitions=MapQNameDefinitiondataSection=Section{secTelescope::Telescope,secFreeVars::Nat-- ^ This is the number of parameters when-- we're inside the section and 0-- outside. It's used to know how much of-- the context to apply function from the-- section to when translating from-- abstract to internal syntax.}deriving(Typeable,Data,Show)emptySignature::SignatureemptySignature=SigMap.emptyMap.emptydataDisplayForm=DisplayNat[Term]DisplayTerm-- ^ The three arguments are:---- * @n@: number of free variables;---- * Patterns for arguments, one extra free var which-- represents pattern vars. There should @n@ of them.---- * Display form. @n@ free variables.deriving(Typeable,Data,Show)dataDisplayTerm=DWithApp[DisplayTerm]Args|DTermTermderiving(Typeable,Data,Show)defaultDisplayForm::QName->[OpenDisplayForm]defaultDisplayFormc=[]dataDefinition=Defn{defName::QName,defType::Type-- type of the lifted definition,defDisplay::[OpenDisplayForm],defMutual::MutualId,theDef::Defn}deriving(Typeable,Data,Show)typeHaskellCode=StringtypeHaskellType=StringdataHaskellRepresentation=HsDefnHaskellTypeHaskellCode|HsTypeHaskellTypederiving(Typeable,Data,Show)dataPolarity=Covariant|Contravariant|Invariantderiving(Typeable,Data,Show,Eq)-- | 'Positive' means strictly positive and 'Negative' means not strictly-- positive.dataOccurrence=Positive|Negative|Unusedderiving(Typeable,Data,Show,Eq,Ord)dataDefn=Axiom{axHsDef::MaybeHaskellRepresentation}|Function{funClauses::[Clauses],funCompiled::CompiledClauses,funInv::FunctionInverse,funPolarity::[Polarity],funArgOccurrences::[Occurrence],funAbstr::IsAbstract,funDelayed::Delayed-- ^ Are the clauses of this definition delayed?}|Datatype{dataPars::Nat-- nof parameters,dataIxs::Nat-- nof indices,dataInduction::Induction-- data or codata?,dataClause::(MaybeClause)-- this might be in an instantiated module,dataCons::[QName]-- constructor names,dataSort::Sort,dataPolarity::[Polarity],dataArgOccurrences::[Occurrence],dataHsType::MaybeHaskellType,dataAbstr::IsAbstract}|Record{recPars::Nat,recClause::MaybeClause,recCon::QName-- ^ Constructor name.,recNamedCon::Bool,recConType::Type-- ^ The record constructor's type.,recFields::[ArgA.QName],recTel::Telescope,recPolarity::[Polarity],recArgOccurrences::[Occurrence],recEtaEquality::Bool,recAbstr::IsAbstract}|Constructor{conPars::Nat-- nof parameters,conSrcCon::QName-- original constructor (this might be in a module instance),conData::QName-- name of datatype or record type,conHsCode::Maybe(HaskellType,HaskellCode)-- used by the compiler,conAbstr::IsAbstract,conInd::Induction-- ^ Inductive or coinductive?}-- ^ Note that, currently, the sharp constructor is-- represented as a definition ('Def'), but if you look-- up the name you will get a @Constructor@.|Primitive{primAbstr::IsAbstract,primName::String,primClauses::Maybe[Clauses]-- ^ 'Nothing' for primitive functions, @'Just'-- something@ for builtin functions.}-- ^ Primitive or builtin functions.deriving(Typeable,Data,Show)defIsRecord::Defn->BooldefIsRecordRecord{}=TruedefIsRecord_=FalsenewtypeFields=Fields[(C.Name,Type)]deriving(Typeable,Data)dataReducednoyes=NoReductionno|YesReductionyesderiving(Typeable)dataPrimFun=PrimFun{primFunName::QName,primFunArity::Arity,primFunImplementation::MonadTCMtcm=>[ArgTerm]->tcm(Reduced[ArgTerm]Term)}deriving(Typeable)defClauses::Definition->[Clauses]defClausesDefn{theDef=Function{funClauses=cs}}=csdefClausesDefn{theDef=Primitive{primClauses=Justcs}}=csdefClausesDefn{theDef=Datatype{dataClause=Justc}}=[ClausesNothingc]defClausesDefn{theDef=Record{recClause=Justc}}=[ClausesNothingc]defClauses_=[]defCompiled::Definition->MaybeCompiledClausesdefCompiledDefn{theDef=Function{funCompiled=cc}}=JustccdefCompiled_=Nothing-- | Used to specify whether something should be delayed.dataDelayed=Delayed|NotDelayedderiving(Typeable,Data,Show,Eq)-- | Are the clauses of this definition delayed?defDelayed::Definition->DelayeddefDelayedDefn{theDef=Function{funDelayed=d}}=ddefDelayed_=NotDelayeddefAbstract::Definition->IsAbstractdefAbstractd=casetheDefdofAxiom{}->AbstractDefFunction{funAbstr=a}->aDatatype{dataAbstr=a}->aRecord{recAbstr=a}->aConstructor{conAbstr=a}->aPrimitive{primAbstr=a}->a----------------------------------------------------------------------------- ** Injectivity---------------------------------------------------------------------------dataFunctionInverse=NotInjective|Inverse(MapTermHeadClause)deriving(Typeable,Data,Show)dataTermHead=SortHead|PiHead|ConHeadQNamederiving(Typeable,Data,Eq,Ord,Show)----------------------------------------------------------------------------- ** Mutual blocks---------------------------------------------------------------------------newtypeMutualId=MutIdInt32deriving(Typeable,Data,Eq,Ord,Show,Num)----------------------------------------------------------------------------- ** Statistics---------------------------------------------------------------------------typeStatistics=MapStringInt----------------------------------------------------------------------------- ** Trace---------------------------------------------------------------------------dataCall=CheckClauseTypeA.Clause(MaybeClause)|foralla.CheckPatternA.PatternTelescopeType(Maybea)|CheckLetBindingA.LetBinding(Maybe())|InferExprA.Expr(Maybe(Term,Type))|CheckExprA.ExprType(MaybeTerm)|CheckDotPatternA.ExprTerm(MaybeConstraints)|CheckPatternShadowingA.Clause(Maybe())|IsTypeCallA.ExprSort(MaybeType)|IsType_A.Expr(MaybeType)|InferVarName(Maybe(Term,Type))|InferDefRangeQName(Maybe(Term,Type))|CheckArgumentsRange[NamedArgA.Expr]TypeType(Maybe(Args,Type,Constraints))|CheckDataDefRangeName[A.LamBinding][A.Constructor](Maybe())|CheckRecDefRangeName[A.LamBinding][A.Constructor](Maybe())|CheckConstructorQNameTelescopeSortA.Constructor(Maybe())|CheckFunDefRangeName[A.Clause](Maybe())|CheckPragmaRangeA.Pragma(Maybe())|CheckPrimitiveRangeNameA.Expr(Maybe())|CheckSectionApplicationRangeModuleNameA.TelescopeModuleName[NamedArgA.Expr](Maybe())|ScopeCheckExprC.Expr(MaybeA.Expr)|ScopeCheckDeclarationD.NiceDeclaration(Maybe[A.Declaration])|ScopeCheckLHSC.NameC.Pattern(MaybeA.LHS)|ScopeCheckDefinitionD.NiceDefinition(MaybeA.Definition)|foralla.TermFunDefRangeName[A.Clause](Maybea)|foralla.SetRangeRange(Maybea)-- ^ used by 'setCurrentRange'-- actually, 'a' is Agda.Termination.TermCheck.CallGraph-- but I was to lazy to import the stuff here --Andreas,2007-5-29deriving(Typeable)-- Dummy instanceinstanceDataCallwheredataTypeOf_=mkDataType"Call"[]toConstrx=mkConstr(dataTypeOfx)"Dummy"[]Prefixgunfoldkz_=__IMPOSSIBLE__instanceHasRangeCallwheregetRange(CheckClause_c_)=getRangecgetRange(CheckPatternp___)=getRangepgetRange(InferExpre_)=getRangeegetRange(CheckExpre__)=getRangeegetRange(CheckLetBindingb_)=getRangebgetRange(IsTypeCalles_)=getRangeegetRange(IsType_e_)=getRangeegetRange(InferVarx_)=getRangexgetRange(InferDef_f_)=getRangefgetRange(CheckArgumentsr____)=rgetRange(CheckDataDefi____)=getRangeigetRange(CheckRecDefi____)=getRangeigetRange(CheckConstructor___c_)=getRangecgetRange(CheckFunDefi___)=getRangeigetRange(CheckPragmar__)=rgetRange(CheckPrimitivei___)=getRangeigetRange(ScopeCheckExpre_)=getRangeegetRange(ScopeCheckDeclarationd_)=getRangedgetRange(ScopeCheckLHS_p_)=getRangepgetRange(ScopeCheckDefinitiond_)=getRangedgetRange(CheckDotPatterne__)=getRangeegetRange(CheckPatternShadowingc_)=getRangecgetRange(TermFunDefi___)=getRangeigetRange(SetRanger_)=rgetRange(CheckSectionApplicationr_____)=r----------------------------------------------------------------------------- ** Builtin things---------------------------------------------------------------------------typeBuiltinThingspf=MapString(Builtinpf)dataBuiltinpf=BuiltinTerm|Primpfderiving(Typeable,Data,Show)instanceFunctorBuiltinwherefmapf(Builtint)=Builtintfmapf(Primx)=Prim$fxinstanceFoldableBuiltinwherefoldrfz(Builtint)=zfoldrfz(Primx)=fxzinstanceTraversableBuiltinwheretraversef(Builtint)=pure$Builtinttraversef(Primx)=Prim<$>fx----------------------------------------------------------------------------- * Type checking environment---------------------------------------------------------------------------dataTCEnv=TCEnv{envContext::Context,envLetBindings::LetBindings,envCurrentModule::ModuleName,envAnonymousModules::[(ModuleName,Nat)]-- ^ anonymous modules and their number of free variables,envImportPath::[C.TopLevelModuleName]-- ^ to detect import cycles,envMutualBlock::MaybeMutualId-- ^ the current (if any) mutual block,envAbstractMode::AbstractMode-- ^ When checking the typesignature of a public definition-- or the body of a non-abstract definition this is true.-- To prevent information about abstract things leaking-- outside the module.,envReplace::Bool-- ^ Coinductive constructor applications @c args@ get-- replaced by a function application @f tel@, where-- tel corresponds to the current telescope and @f@ is-- defined as @f tel = c args@. The initial occurrence-- of @c@ in the body of @f@ should not be replaced by-- yet another function application, though. To avoid-- that this happens the @envReplace@ flag is set to-- 'False' when @f@ is checked.,envDisplayFormsEnabled::Bool-- ^ Sometimes we want to disable display forms.,envReifyInteractionPoints::Bool-- ^ should we try to recover interaction points when reifying?-- disabled when generating types for with functions,envEtaContractImplicit::Bool-- ^ it's safe to eta contract implicit lambdas as long as we're-- not going to reify and retypecheck (like when doing with-- abstraction),envRange::Range,envCall::Maybe(ClosureCall)-- ^ what we're doing at the moment}deriving(Typeable,Data)initEnv::TCEnvinitEnv=TCEnv{envContext=[],envLetBindings=Map.empty,envCurrentModule=noModuleName,envAnonymousModules=[],envImportPath=[],envMutualBlock=Nothing,envAbstractMode=AbstractMode,envReplace=True,envDisplayFormsEnabled=True,envReifyInteractionPoints=True,envEtaContractImplicit=True,envRange=noRange,envCall=Nothing}----------------------------------------------------------------------------- ** Context---------------------------------------------------------------------------typeContext=[ContextEntry]dataContextEntry=Ctx{ctxId::CtxId,ctxEntry::Arg(Name,Type)}deriving(Typeable,Data)newtypeCtxId=CtxIdNatderiving(Typeable,Data,Eq,Ord,Show,Enum,Real,Integral,Num)----------------------------------------------------------------------------- ** Let bindings---------------------------------------------------------------------------typeLetBindings=MapName(Open(Term,ArgType))----------------------------------------------------------------------------- ** Abstract mode---------------------------------------------------------------------------dataAbstractMode=AbstractMode-- ^ abstract things in the current module can be accessed|ConcreteMode-- ^ no abstract things can be accessed|IgnoreAbstractMode-- ^ all abstract things can be accessedderiving(Typeable,Data)----------------------------------------------------------------------------- * Type checking errors----------------------------------------------------------------------------- Occurence of a name in a datatype definitiondataOcc=OccCon{occDatatype::QName,occConstructor::QName,occPosition::OccPos}|OccClause{occFunction::QName,occClause::Int,occPosition::OccPos}dataOccPos=NonPositively|ArgumentToNatQNamedataTypeError=InternalErrorString|NotImplementedString|NotSupportedString|CompilationErrorString|TerminationCheckFailed[([QName],[R.Range])]-- ^ Parameterised on functions which failed to termination-- check (grouped if they are mutual), along with ranges-- for problematic call sites.|PropMustBeSingleton|DataMustEndInSortTerm|ShouldEndInApplicationOfTheDatatypeType-- ^ The target of a constructor isn't an application of its-- datatype. The 'Type' records what it does target.|ShouldBeAppliedToTheDatatypeParametersTermTerm-- ^ The target of a constructor isn't its datatype applied to-- something that isn't the parameters. First term is the correct-- target and the second term is the actual target.|ShouldBeApplicationOfTypeQName-- ^ Expected a type to be an application of a particular datatype.|ConstructorPatternInWrongDatatypeQNameQName-- ^ constructor, datatype|DoesNotConstructAnElementOfQNameTerm-- ^ constructor, type|DifferentArities-- ^ Varying number of arguments for a function.|WrongHidingInLHSType-- ^ The left hand side of a function definition has a hidden argument-- where a non-hidden was expected.|WrongHidingInLambdaType-- ^ Expected a non-hidden function and found a hidden lambda.|WrongHidingInApplicationType-- ^ A function is applied to a hidden argument where a non-hidden was expected.|NotInductiveTerm-- ^ The term does not correspond to an inductive data type.|UninstantiatedDotPatternA.Expr|IlltypedPatternA.PatternType|TooManyArgumentsInLHSNatType|WrongNumberOfConstructorArgumentsQNameNatNat|ShouldBeEmptyType[Pattern]|ShouldBeASortType-- ^ The given type should have been a sort.|ShouldBePiType-- ^ The given type should have been a pi.|ShouldBeRecordTypeType|NotAProperTerm|SplitOnIrrelevantA.Pattern(ArgType)|VariableIsIrrelevantName|UnequalLevelComparisonTermTerm|UnequalTermsComparisonTermTermType|UnequalTypesComparisonTypeType|UnequalTelescopesComparisonTelescopeTelescope|UnequalRelevanceTypeType-- ^ The two function types have different relevance.|UnequalHidingTypeType-- ^ The two function types have different hiding.|UnequalSortsSortSort|NotLeqSortSortSort|MetaCannotDependOnMetaId[Nat]Nat-- ^ The arguments are the meta variable, the parameters it can-- depend on and the paratemeter that it wants to depend on.|MetaOccursInItselfMetaId|GenericErrorString|BuiltinMustBeConstructorStringA.Expr|NoSuchBuiltinNameString|DuplicateBuiltinBindingStringTermTerm|NoBindingForBuiltinString|NoSuchPrimitiveFunctionString|ShadowedModule[A.ModuleName]|BuiltinInParameterisedModuleString|NoRHSRequiresAbsurdPattern[NamedArgA.Pattern]|AbsurdPatternRequiresNoRHS[NamedArgA.Pattern]|TooFewFieldsQName[C.Name]|TooManyFieldsQName[C.Name]|DuplicateFields[C.Name]|DuplicateConstructors[C.Name]|UnexpectedWithPatterns[A.Pattern]|WithClausePatternMismatchA.PatternPattern|FieldOutsideRecord|ModuleArityMismatchA.ModuleNameTelescope[NamedArgA.Expr]-- Coverage errors|IncompletePatternMatchingTermArgs-- can only happen if coverage checking is switched off|CoverageFailureQName[[ArgPattern]]|UnreachableClausesQName[[ArgPattern]]|CoverageCantSplitOnQName|CoverageCantSplitTypeType-- Positivity errors|NotStrictlyPositiveQName[Occ]-- Import errors|LocalVsImportedModuleClashModuleName|UnsolvedMetas[Range]|UnsolvedConstraintsConstraints|CyclicModuleDependency[C.TopLevelModuleName]|FileNotFoundC.TopLevelModuleName[AbsolutePath]|OverlappingProjectsAbsolutePathC.TopLevelModuleNameC.TopLevelModuleName|AmbiguousTopLevelModuleNameC.TopLevelModuleName[AbsolutePath]|ModuleNameDoesntMatchFileNameC.TopLevelModuleName[AbsolutePath]|ClashingFileNamesForModuleName[AbsolutePath]|ModuleDefinedInOtherFileC.TopLevelModuleNameAbsolutePathAbsolutePath-- ^ Module name, file from which it was loaded, file which-- the include path says contains the module.-- Scope errors|BothWithAndRHS|NotInScope[C.QName]|NoSuchModuleC.QName|AmbiguousNameC.QName[A.QName]|AmbiguousModuleC.QName[A.ModuleName]|UninstantiatedModuleC.QName|ClashingDefinitionC.QNameA.QName|ClashingModuleA.ModuleNameA.ModuleName|ClashingImportC.NameA.QName|ClashingModuleImportC.NameA.ModuleName|PatternShadowsConstructorA.NameA.QName|ModuleDoesntExportC.QName[C.ImportedName]|DuplicateImportsC.QName[C.ImportedName]|InvalidPatternC.Pattern|RepeatedVariablesInPattern[C.Name]-- Concrete to Abstract errors|NotAModuleExprC.Expr-- ^ The expr was used in the right hand side of an implicit module-- definition, but it wasn't of the form @m Delta@.|NotAnExpressionC.Expr|NotAValidLetBindingD.NiceDeclaration|NothingAppliedToHiddenArgC.Expr-- Operator errors|NoParseForApplication[C.Expr]|AmbiguousParseForApplication[C.Expr][C.Expr]|NoParseForLHSC.Pattern|AmbiguousParseForLHSC.Pattern[C.Pattern]-- Usage errorsderiving(Typeable)instanceShowTypeErrorwhereshow_="<TypeError>"-- TODO: more info?instanceErrorTypeErrorwherenoMsg=strMsg""strMsg=GenericError-- | Type-checking errors.dataTCErr'=TypeErrorTCState(ClosureTypeError)|ExceptionRangeString|IOExceptionRangeE.IOException|PatternErrTCState-- ^ for pattern violations|AbortAssignTCState-- ^ used to abort assignment to meta when there are instantiationsderiving(Typeable)-- | Type-checking errors, potentially paired with relevant syntax-- highlighting information.dataTCErr=TCErr{errHighlighting::Maybe(HighlightingInfo,ModuleToSource)-- ^ The 'ModuleToSource' can be used to map the module-- names in the 'HighlightingInfo' to file names.,errError::TCErr'}deriving(Typeable)instanceErrorTCErrwherenoMsg=strMsg""strMsg=TCErrNothing.ExceptionnoRange.strMsginstanceShowTCErrwhereshow=show.errErrorinstanceShowTCErr'whereshow(TypeError_e)=show(envRange$clEnve)++": "++show(clValuee)show(Exceptionrs)=showr++": "++sshow(IOExceptionre)=showr++": "++showeshow(PatternErr_)="Pattern violation (you shouldn't see this)"show(AbortAssign_)="Abort assignment (you shouldn't see this)"instanceHasRangeTCErr'wheregetRange(TypeError_cl)=envRange$clEnvclgetRange(Exceptionr_)=rgetRange(IOExceptionr_)=rgetRange(PatternErrs)=noRangegetRange(AbortAssigns)=noRangeinstanceHasRangeTCErrwheregetRange=getRange.errErrorinstanceExceptionTCErr----------------------------------------------------------------------------- * Type checking monad transformer---------------------------------------------------------------------------newtypeTCMTma=TCM{unTCM::TCState->TCEnv->m(a,TCState)}instanceMonadIOm=>MonadReaderTCEnv(TCMTm)whereask=TCM$\se->return(e,s)localf(TCMm)=TCM$\se->ms(fe)instanceMonadIOm=>MonadStateTCState(TCMTm)whereget=TCM$\s_->return(s,s)puts=TCM$\__->return((),s)typeTCM=TCMTIOclass(Applicativetcm,MonadIOtcm,MonadReaderTCEnvtcm,MonadStateTCStatetcm)=>MonadTCMtcmwhereliftTCM::TCMa->tcmainstanceMonadErrorTCErr(TCMTIO)wherethrowError=liftIO.throwIOcatchErrormh=TCM$\se->unTCMmse`E.catch`\err->unTCM(herr)secatchError_::TCMa->(TCErr->TCMa)->TCMacatchError_mh=TCM$\se->unTCMmse`E.catch`\err->unTCM(herr)(error"catchError_")emapTCMT::(foralla.ma->na)->TCMTma->TCMTnamapTCMTf(TCMm)=TCM$\se->f(mse)pureTCM::Monadm=>(TCState->TCEnv->a)->TCMTmapureTCMf=TCM$\se->return(fse,s)instanceMonadIOm=>MonadTCM(TCMTm)whereliftTCM=mapTCMTliftIOinstance(Errorerr,MonadTCMtcm)=>MonadTCM(ErrorTerrtcm)whereliftTCM=lift.liftTCMinstanceMonadTransTCMTwhereliftm=TCM$\s_->m>>=\x->return(x,s)-- We want a special monad implementation of fail.{-# SPECIALIZE instance Monad TCM #-}instanceMonadIOm=>Monad(TCMTm)wherereturnx=TCM$\s_->return(x,s)m>>=k=TCM$\se->do(x,s')<-unTCMmseunTCM(kx)s'efail=internalErrorinstanceMonadIOm=>Functor(TCMTm)wherefmap=liftMinstanceMonadIOm=>Applicative(TCMTm)wherepure=return(<*>)=apinstanceMonadIOm=>MonadIO(TCMTm)whereliftIOm=TCM$\se->doletr=envRangeeliftIO$wrapr$dox<-mx`seq`return(x,s)wherewraprm=failOnExceptionhandleException$E.catchm(handleIOExceptionr)handleIOExceptionre=throwIO$TCErrNothing$IOExceptionrehandleExceptionrs=throwIO$TCErrNothing$ExceptionrspatternViolation::MonadTCMtcm=>tcmapatternViolation=liftTCM$dos<-getthrowError$TCErrNothing$PatternErrsinternalError::MonadTCMtcm=>String->tcmainternalErrors=typeError$InternalErrorstypeError::MonadTCMtcm=>TypeError->tcmatypeErrorerr=liftTCM$docl<-buildClosureerrs<-getthrowError$TCErrNothing$TypeErrorscl-- | Running the type checking monadrunTCM::TCMTIOa->IO(EitherTCErra)runTCMm=(Right<$>runTCM'm)`E.catch`(return.Left)runTCM'::Monadm=>TCMTma->marunTCM'm=liftMfst(unTCMminitStateinitEnv)