{-# LANGUAGE CPP #-}moduleAgda.TypeChecking.Rules.DatawhereimportControl.ApplicativeimportControl.MonadimportControl.Monad.TransimportqualifiedAgda.Syntax.AbstractasAimportAgda.Syntax.InternalimportAgda.Syntax.CommonimportAgda.Syntax.PositionimportqualifiedAgda.Syntax.InfoasInfoimportAgda.TypeChecking.MonadimportAgda.TypeChecking.ConversionimportAgda.TypeChecking.SubstituteimportAgda.TypeChecking.MetaVarsimportAgda.TypeChecking.ReduceimportAgda.TypeChecking.ConstraintsimportAgda.TypeChecking.PrettyimportAgda.TypeChecking.PolarityimportAgda.TypeChecking.FreeimportAgda.TypeChecking.ForcingimportAgda.TypeChecking.Rules.Term(isType_)importAgda.Interaction.OptionsimportAgda.Utils.MonadimportAgda.Utils.SizeimportAgda.Utils.Tuple#include "../../undefined.h"importAgda.Utils.Impossible----------------------------------------------------------------------------- * Datatypes----------------------------------------------------------------------------- | Type check a datatype definition. Assumes that the type has already been-- checked.checkDataDef::Info.DefInfo->QName->[A.LamBinding]->[A.Constructor]->TCM()checkDataDefinamepscs=traceCall(CheckDataDef(getRangei)(qnameNamename)pscs)$do-- TODO!! (qnameName)letnpars=sizeps-- Add the datatype moduleaddSection(qnameToMNamename)0-- Look up the type of the datatype.t<-instantiateFull=<<typeOfConstname-- The parameters are in scope when checking the constructors.dataDef<-bindParameterspst$\telt0->do-- Parameters are always hidden in constructorslettel'=hideTeltel-- The type we get from bindParameters is Θ -> s where Θ is the type of-- the indices. We count the number of indices and return s.(nofIxs,s)<-splitType=<<normaliset0when(any(`freeIn`s)[0..nofIxs-1])$doerr<-fsep[text"The sort of"<+>prettyTCMname,text"cannot depend on its indices in the type",prettyTCMt0]typeError$GenericError$showerrs<-return$raise(-nofIxs)sreportSDoc"tc.data.sort"20$vcat[text"checking datatype"<+>prettyTCMname,nest2$vcat[text"type: "<+>prettyTCMt0,text"sort: "<+>prettyTCMs,text"indices:"<+>text(shownofIxs)]]-- Change the datatype from an axiom to a datatype with no constructors.letdataDef=Datatype{dataPars=npars,dataIxs=nofIxs,dataInduction=Inductive,dataClause=Nothing,dataCons=[]-- Constructors are added later,dataSort=s,dataHsType=Nothing,dataAbstr=Info.defAbstracti,dataPolarity=[],dataArgOccurrences=[]}escapeContext(sizetel)$doaddConstantname(Defnnamet(defaultDisplayFormname)0dataDef)-- Check the types of the constructorsmapM_(checkConstructornametel'nofIxss)cs-- Return the data definitionreturndataDefletnofIxs=dataIxsdataDefs=dataSortdataDef-- If proof irrelevance is enabled we have to check that datatypes in-- Prop contain at most one element.doproofIrr<-proofIrrelevancecase(proofIrr,s,cs)of(True,Prop,_:_:_)->setCurrentRange(getRange$mapconNamecs)$typeErrorPropMustBeSingletonwhereconName(A.Axiom_c_)=cconName(A.ScopedDecl_(d:_))=conNamedconName_=__IMPOSSIBLE___->return()-- Add the datatype to the signature with its constructors. It was previously-- added without them.addConstantname(Defnnamet(defaultDisplayFormname)0$dataDef{dataCons=mapcnamecs})computePolaritynamewherecname(A.ScopedDecl_[d])=cnamedcname(A.Axiom_x_)=xcname_=__IMPOSSIBLE__-- constructors are axiomshideTelEmptyTel=EmptyTelhideTel(ExtendTel(Arg_rt)tel)=ExtendTel(ArgHiddenrt)$hideTel<$>telsplitType(El_(Pi_b))=((+1)-*-id)<$>splitType(absBodyb)splitType(El_(Fun_b))=((+1)-*-raise1)<$>splitTypebsplitType(El_(Sorts))=return(0,s)splitType(El_t)=typeError$DataMustEndInSortt-- | Type check a constructor declaration. Checks that the constructor targets-- the datatype and that it fits inside the declared sort.checkConstructor::QName->Telescope->Nat->Sort->A.Constructor->TCM()checkConstructordtelnofIxss(A.ScopedDeclscope[con])=dosetScopescopecheckConstructordtelnofIxssconcheckConstructordtelnofIxsscon@(A.Axiomice)=traceCall(CheckConstructordtelscon)$dot<-isType_en<-size<$>getContextTelescopedebugEndsIntdnconstructsntddebugFitsInst`fitsIn`st'<-addForcingAnnotationstescapeContext(sizetel)$addConstantc$Defnc(telePitelt')(defaultDisplayFormc)0$Constructor(sizetel)cdNothing(Info.defAbstracti)InductivewheredebugEndsIntdn=reportSDoc"tc.data.con"15$vcat[sep[text"checking that",nest2$prettyTCMt,text"ends in"<+>prettyTCMd],nest2$text"nofPars ="<+>text(shown)]debugFitsIns=reportSDoc"tc.data.con"15$sep[text"checking that the type fits in",nest2$prettyTCMs]checkConstructor_____=__IMPOSSIBLE__-- constructors are axioms-- | Bind the parameters of a datatype. The bindings should be domain free.bindParameters::[A.LamBinding]->Type->(Telescope->Type->TCMa)->TCMabindParameters[]aret=retEmptyTelabindParameters(A.DomainFreehx:ps)(El_(Pi(Argh'Relevanta)b))ret|h/=h'=__IMPOSSIBLE__|otherwise=addCtxxarg$bindParametersps(absBodyb)$\tels->ret(ExtendTelarg$Abs(showx)tel)swherearg=ArghRelevantabindParameters(A.DomainFreehx:ps)(El_(Fun(Argh'Relevanta)b))ret|h/=h'=__IMPOSSIBLE__|otherwise=addCtxxarg$bindParametersps(raise1b)$\tels->ret(ExtendTelarg$Abs(showx)tel)swherearg=ArghRelevantabindParameters___=__IMPOSSIBLE__-- | Check that the arguments to a constructor fits inside the sort of the datatype.-- The first argument is the type of the constructor.fitsIn::Type->Sort->TCM()fitsInts=dot<-instantiateFullts'<-instantiateFull(getSortt)reportSDoc"tc.data.fits"10$sep[text"does"<+>prettyTCMt,text"of sort"<+>prettyTCMs',text"fit in"<+>prettyTCMs<+>text"?"]-- The line below would be simpler, but doesn't allow datatypes-- to be indexed by the universe level.-- noConstraints $ s' `leqSort` scasefunView$unEltofFunVarg@(Arghra)_->dolets'=getSortacs<-s'`leqSort`saddConstraintscsx<-freshName_(argNamet)letv=Arghr$Var0[]t'=piApply(raise1t)[v]addCtxxarg$fitsInt'(raise1s)_->return()-- | Check that a type constructs something of the given datatype. The first-- argument is the number of parameters to the datatype.-- TODO: what if there's a meta here?constructs::Int->Type->QName->TCM()constructsnofParstq=constrT0twhereconstrTn(Elsv)=constrnsvconstrnsv=dov<-reducevcasevofPiab->underAbstractionab$\t->constrT(n+1)tFun_b->constrTnbDefdvs|d==q->checkParamsn=<<reduce(takenofParsvs)-- we only check the parameters_->bad$Elsvbadt=typeError$ShouldEndInApplicationOfTheDatatypetcheckParamsnvs=zipWithM_sameVar(mapunArgvs)pswhereps=reverse[i|(i,_)<-zip[n..]vs]sameVarvi=dot<-typeOfBViaddConstraints=<<equalTermtv(Vari[])-- | Force a type to be a specific datatype.forceData::MonadTCMtcm=>QName->Type->tcmTypeforceDatad(Els0t)=liftTCM$dot'<-reducetd<-canonicalNamedcaset'ofDefd'_|d==d'->return$Els0t'|otherwise->fail$"wrong datatype "++showd++" != "++showd'MetaVmvs->doDefn_t__Datatype{dataSort=s}<-getConstInfodps<-newArgsMetatnoConstraints$leqType(Els0t')(Els(Defdps))-- TODO: need equalType?reduce$Els0t'_->typeError$ShouldBeApplicationOf(Els0t)d-- | Is the type coinductive? Returns 'Nothing' if the answer cannot-- be determined.isCoinductive::MonadTCMtcm=>Type->tcm(MaybeBool)isCoinductivet=doEl_t<-normalisetcasetofDefq_->dodef<-getConstInfoqcasetheDefdefofAxiom{}->return(JustFalse)Function{}->returnNothingDatatype{dataInduction=CoInductive}->return(JustTrue)Datatype{dataInduction=Inductive}->return(JustFalse)Record{}->return(JustFalse)Constructor{}->__IMPOSSIBLE__Primitive{}->__IMPOSSIBLE__Var{}->returnNothingLam{}->__IMPOSSIBLE__Lit{}->__IMPOSSIBLE__Con{}->__IMPOSSIBLE__Pi{}->return(JustFalse)Fun{}->return(JustFalse)Sort{}->return(JustFalse)MetaV{}->returnNothingDontCare->__IMPOSSIBLE__