-- | Type environments.---- An environment contains the types -- named bound variables,-- named primitives, -- and a deBruijn stack for anonymous variables.--moduleDDC.Type.Env(Env(..),empty,extend,extends,setPrimFun,isPrim,fromList,union,member,memberBind,lookup,lookupName,depth,lift,wrapTForalls)whereimportDDC.Type.ExpimportDDC.Type.Transform.LiftTimportData.MaybeimportData.Map(Map)importPreludehiding(lookup)importqualifiedData.MapasMapimportqualifiedPreludeasPimportControl.Monad-- | A type environment.dataEnvn=Env{-- | Types of named binders.envMap::Mapn(Typen)-- | Types of anonymous deBruijn binders.,envStack::[Typen]-- | The length of the above stack.,envStackLength::Int-- | Types of baked in, primitive names.,envPrimFun::n->Maybe(Typen)}-- | An empty environment.empty::Envnempty=Env{envMap=Map.empty,envStack=[],envStackLength=0,envPrimFun=\_->Nothing}-- | Extend an environment with a new binding.-- Replaces bindings with the same name already in the environment.extend::Ordn=>Bindn->Envn->Envnextendbbenv=casebbofBNamenk->env{envMap=Map.insertnk(envMapenv)}BAnonk->env{envStack=k:envStackenv,envStackLength=envStackLengthenv+1}BNone{}->env-- | Extend an environment with a list of new bindings.-- Replaces bindings with the same name already in the environment.extends::Ordn=>[Bindn]->Envn->Envnextendsbsenv=foldl(flipextend)envbs-- | Set the function that knows the types of primitive things.setPrimFun::(n->Maybe(Typen))->Envn->EnvnsetPrimFunfenv=env{envPrimFun=f}-- | Check if the type of a name is defined by the `envPrimFun`.isPrim::Envn->n->BoolisPrimenvn=isJust$envPrimFunenvn-- | Convert a list of `Bind`s to an environment.fromList::Ordn=>[Bindn]->EnvnfromListbs=foldrextendemptybs-- | Combine two environments.-- If both environments have a binding with the same name,-- then the one in the second environment takes preference.union::Ordn=>Envn->Envn->Envnunionenv1env2=Env{envMap=envMapenv1`Map.union`envMapenv2,envStack=envStackenv2++envStackenv1,envStackLength=envStackLengthenv2+envStackLengthenv1,envPrimFun=\n->envPrimFunenv2n`mplus`envPrimFunenv1n}-- | Check whether a bound variable is present in an environment.member::Ordn=>Boundn->Envn->Boolmemberuuenv=isJust$lookupuuenv-- | Check whether a binder is already present in the an environment.-- This can only return True for named binders, not anonymous or primitive ones.memberBind::Ordn=>Bindn->Envn->BoolmemberBinduuenv=caseuuofBNamen_->Map.membern(envMapenv)_->False-- | Lookup a bound variable from an environment.lookup::Ordn=>Boundn->Envn->Maybe(Typen)lookupuuenv=caseuuofUNamen_->Map.lookupn(envMapenv)`mplus`envPrimFunenvnUIxi_->P.lookupi(zip[0..](envStackenv))UPrimn_->envPrimFunenvn-- | Lookup a bound name from an environment.lookupName::Ordn=>n->Envn->Maybe(Typen)lookupNamenenv=Map.lookupn(envMapenv)-- | Yield the total depth of the deBruijn stack.depth::Envn->Intdepthenv=envStackLengthenv-- | Lift all free deBruijn indices in the environment by the given number of steps.-- TODO: Delay this, only lift when we extract the final type.-- will also need to update the 'member' function.lift::Ordn=>Int->Envn->Envnliftnenv=Env{envMap=Map.map(liftTn)(envMapenv),envStack=map(liftTn)(envStackenv),envStackLength=envStackLengthenv,envPrimFun=envPrimFunenv}-- | Wrap locally bound (non primitive) variables defined in an environment-- around a type as new foralls.wrapTForalls::Ordn=>Envn->Typen->TypenwrapTForallsenvtBody=letbsNamed=[BNamebt|(b,t)<-Map.toList$envMapenv]bsAnon=[BAnont|t<-envStackenv]tInner=foldrTForalltBody(reversebsAnon)infoldrTForalltInnerbsNamed