-- | Check the kind of a type.moduleDDC.Type.Check(-- * Kinds of TypescheckType,kindOfType-- * Kinds of Constructors,takeSortOfKiCon,kindOfTwCon,kindOfTcCon-- * Errors,Error(..))whereimportDDC.Type.Check.CheckErrorimportDDC.Type.Check.CheckConimportDDC.Type.CompoundsimportDDC.Type.PredicatesimportDDC.Type.Transform.LiftTimportDDC.Type.ExpimportDDC.Base.PrettyimportData.ListimportControl.MonadimportDDC.Type.Check.Monad(throw,result)importDDC.Type.Pretty()importDDC.Type.Env(Env)importqualifiedDDC.Type.SumasTSimportqualifiedDDC.Type.EnvasEnvimportqualifiedDDC.Type.Check.MonadasG-- | The type checker monad.typeCheckMn=G.CheckM(Errorn)-- Wrappers --------------------------------------------------------------------- | Check a type in the given environment, returning an error or its kind.checkType::(Ordn,Prettyn)=>Envn->Typen->Either(Errorn)(Kindn)checkTypeenvtt=result$checkTypeMenvtt-- | Check a type in an empty environment, returning an error or its kind.kindOfType::(Ordn,Prettyn)=>Typen->Either(Errorn)(Kindn)kindOfTypett=result$checkTypeMEnv.emptytt-- checkType -------------------------------------------------------------------- | Check a type, returning its kind.----- Note that when comparing kinds, we can just use plain equality-- (==) instead of equivT. This is because kinds do not contain quantifiers-- that need to be compared up to alpha-equivalence, nor do they contain-- crushable components terms.checkTypeM::(Ordn,Prettyn)=>Envn->Typen->CheckMn(Kindn)checkTypeMenvtt=-- trace (pretty $ text "checkTypeM:" <+> ppr tt) $checkTypeM'envtt-- Variables ------------------checkTypeM'env(TVaru)=dolettBound=typeOfBounduletmtEnv=Env.lookupuenvletmkResult-- If the annot is Bot then just use the type-- from the environment.|JusttEnv<-mtEnv,isBottBound=returntEnv-- The bound has an explicit type annotation,-- which matches the one from the environment.-- -- When the bound is a deBruijn index we need to lift the-- annotation on the original binder through any lambdas-- between the binding occurrence and the use.|JusttEnv<-mtEnv,UIxi_<-u,tBound==liftT(i+1)tEnv=returntBound-- The bound has an explicit type annotation,-- that matches the one from the environment.|JusttEnv<-mtEnv,tBound==tEnv=returntBound-- The bound has an explicit type annotation,-- that does not match the one from the environment. |JusttEnv<-mtEnv=throw$ErrorVarAnnotMismatchutEnv-- Type variables must be in the environment.|_<-mtEnv=throw$ErrorUndefinedumkResult-- Constructors ---------------checkTypeM'_envtt@(TContc)=casetcof-- Sorts don't have a higher classification.TyConSort_->throw$ErrorNakedSorttt-- Can't sort check a naked kind function-- because the sort depends on the argument kinds.TyConKindkc->casetakeSortOfKiConkcofJusts->returnsNothing->throw$ErrorUnappliedKindFunTyConWitnesstcw->return$kindOfTwContcwTyConSpectcc->return$kindOfTcContccTyConBoundu->return$typeOfBoundu-- Quantifiers ----------------checkTypeM'envtt@(TForallb1t2)=do_<-checkTypeMenv(typeOfBindb1)k2<-checkTypeM(Env.extendb1env)t2-- The body must have data or witness kind.when((not$isDataKindk2)&&(not$isWitnessKindk2))$throw$ErrorForallKindInvalidttt2k2returnk2-- Applications ----------------- Applications of the kind function constructor are handled directly-- because the constructor doesn't have a sort by itself.checkTypeM'env(TApp(TApp(TCon(TyConKindKiConFun))k1)k2)=do_<-checkTypeMenvk1s2<-checkTypeMenvk2returns2-- The implication constructor is overloaded and can have the-- following kinds:-- (=>) :: @ ~> @ ~> @, for witness implication.-- (=>) :: @ ~> * ~> *, for a context.checkTypeM'envtt@(TApp(TApp(TCon(TyConWitnessTwConImpl))t1)t2)=dok1<-checkTypeMenvt1k2<-checkTypeMenvt2ifisWitnessKindk1&&isWitnessKindk2thenreturnkWitnesselseifisWitnessKindk1&&isDataKindk2thenreturnkDataelsethrow$ErrorWitnessImplInvalidttt1k1t2k2-- Type application.checkTypeM'envtt@(TAppt1t2)=dok1<-checkTypeMenvt1k2<-checkTypeMenvt2casek1ofTApp(TApp(TCon(TyConKindKiConFun))k11)k12|k11==k2->returnk12|otherwise->throw$ErrorAppArgMismatchttk1k2_->throw$ErrorAppNotFunttt1k1t2k2-- Sums -----------------------checkTypeM'env(TSumts)=doks<-mapM(checkTypeMenv)$TS.toListts-- Check that all the types in the sum have a single kind, -- and return that kind.k<-casenubksof[]->return$TS.kindOfSumts[k]->returnk_->throw$ErrorSumKindMismatch(TS.kindOfSumts)tsks-- Check that the kind of the elements is a valid one.-- Only effects and closures can be summed.if(k==kEffect||k==kClosure)thenreturnkelsethrow$ErrorSumKindInvalidtsk