Merge pull request #653 from google-research/merging-classes

Merging EnvReader/EnvGetter classes

src/lib/SaferNames/Builder.hs

@@ -51,11 +51,11 @@ class (BindingsReader m, Scopable m, MonadFail1 m)
       => Builder (m::MonadKind1) where
   emitDecl :: Emits n => NameHint -> LetAnn -> Expr n -> m n (AtomName n)
   emitBinding :: EmitsTop n => NameHint -> Binding c n -> m n (Name c n)
-  buildScoped :: (InjectableE e, HasNamesE e)
+  buildScoped :: HasNamesE e
               => (forall l. (Emits l, Ext n l) => m l (e l))
               -> m n (Abs (Nest Decl) e n)
 
-  buildScopedTop :: (InjectableE e, HasNamesE e)
+  buildScopedTop :: HasNamesE e
                  => (forall l. (EmitsTop l, Ext n l) => m l (e l))
                  -> m n (Abs (RecEnvFrag Binding) e n)
   getAllowedEffects :: m n (EffectRow n)
@@ -103,8 +103,7 @@ newtype BuilderT (m::MonadKind1) (n::S) (a:: *) =
   deriving (Functor, Applicative, Monad)
 
 runBuilderT
-  :: ( BindingsReader m, BindingsGetter m, BindingsExtender m, MonadFail1 m
-     , InjectableE e, HasNamesE e)
+  :: ( BindingsReader m, BindingsGetter m, BindingsExtender m, MonadFail1 m , HasNamesE e)
   => (forall l. (Distinct l, Ext n l) => BuilderT m l (e l))
   -> m n (e n)
 runBuilderT cont = do
@@ -114,8 +113,7 @@ runBuilderT cont = do
   fromConstAbs $ Abs decls result
 
 runBuilderTWithEmits
-  :: ( BindingsReader m, BindingsGetter m, BindingsExtender m, MonadFail1 m
-     , InjectableE e, HasNamesE e)
+  :: ( BindingsReader m, BindingsGetter m, BindingsExtender m, MonadFail1 m, HasNamesE e)
   => (forall l. (Emits l, Distinct l, Ext n l) => BuilderT m l (e l))
   -> m n (Abs (Nest Decl) e n)
 runBuilderTWithEmits cont = do
@@ -271,7 +269,7 @@ instance BindsBindings BinderWithInfo where
     withExtEvidence b $
       b @> inject (AtomNameBinding ty info)
 
-withFreshAtomBinder :: (Scopable m, SubstE Name e, InjectableE e)
+withFreshAtomBinder :: (Scopable m, SubstE Name e)
                     => NameHint -> Type n -> AtomBinderInfo n
                     -> (forall l. Ext n l => AtomName l -> m l (e l))
                     -> m n (Abs Binder e n)
@@ -372,7 +370,7 @@ buildNonDepPi arr argTy effs resultTy = buildPi arr argTy \_ -> do
   return (effs', resultTy')
 
 buildAbs
-  :: (Builder m, InjectableE e, HasNamesE e)
+  :: (Builder m, HasNamesE e)
   => Type n
   -> (forall l. Ext n l => AtomName l -> m l (e l))
   -> m n (Abs Binder e n)
@@ -389,7 +387,7 @@ singletonBinderNest ty = do
   return $ EmptyAbs (Nest b Empty)
 
 buildNaryAbs
-  :: (Builder m, InjectableE e, HasNamesE e)
+  :: (Builder m, HasNamesE e)
   => EmptyAbs (Nest Binder) n
   -> (forall l. Ext n l => [AtomName l] -> m l (e l))
   -> m n (Abs (Nest Binder) e n)

src/lib/SaferNames/Inference.hs

@@ -55,7 +55,7 @@ isTopDecl decl = case decl of
 
 -- === Inferer monad ===
 
-class (MonadErr2 m, Builder2 m, EnvGetter Name m)
+class (MonadErr2 m, Builder2 m, EnvReader Name m)
       => Inferer (m::MonadKind2)
 
 data InfererM (i::S) (o::S) (a:: *)
@@ -102,12 +102,8 @@ instance Scopable (InfererM i) where
   withBindings _ _ = undefined
 
 instance (EnvReader Name) InfererM where
-  lookupEnvM = undefined
-  extendEnv  = undefined
-  dropSubst  = undefined
-
-instance (EnvGetter Name) InfererM where
-  getEnv = undefined
+  getEnv  = undefined
+  withEnv = undefined
 
 instance Inferer InfererM
 
@@ -527,7 +523,7 @@ inferInterfaceDataDef className methodNames paramBs superclasses methods = do
   defName <- emitDataDef dictDef
   return $ ClassDef className methodNames (defName, dictDef)
 
-withNestedUBinders :: (Inferer m, InjectableE e, HasNamesE e)
+withNestedUBinders :: (Inferer m, HasNamesE e)
                   => Nest (UAnnBinder AtomNameC) i i'
                   -> (forall o'. Ext o o' => [AtomName o'] -> m i' o' (e o'))
                   -> m i o (Abs (Nest Binder) e o)
@@ -543,7 +539,7 @@ withNestedUBinders bs cont = case bs of
         cont (name':names)
     return $ Abs (Nest b' rest') body
 
-withUBinder :: (Inferer m, InjectableE e, HasNamesE e)
+withUBinder :: (Inferer m, HasNamesE e)
             => UAnnBinder AtomNameC i i'
             -> (forall o'. Ext o o' => AtomName o' -> m i' o' (e o'))
             -> m i o (Abs Binder e o)
@@ -714,7 +710,7 @@ checkCasePat (WithSrcB pos pat) scrutineeTy cont = addSrcContext' pos $ case pat
       bindLamPat p x cont
   _ -> throw TypeErr $ "Case patterns must start with a data constructor or variant pattern"
 
-inferParams :: (Inferer m, InjectableE e, HasNamesE e)
+inferParams :: (Inferer m, HasNamesE e)
             => Abs (Nest Binder) e o -> m i o ([Type o], e o)
 inferParams (Abs Empty body) = return ([], body)
 inferParams (Abs (Nest (b:>ty) bs) body) = do