🔥 the Monoid instance of Lower.

src/Analysis/Abstract/Evaluating.hs

@@ -6,7 +6,6 @@ module Analysis.Abstract.Evaluating
 import Control.Abstract.Analysis hiding (lower)
 import Control.Monad.Effect.Exception as Exc
 import Control.Monad.Effect.Resumable as Res
-import Data.Abstract.Address
 import Data.Abstract.Environment
 import Data.Abstract.Evaluatable hiding (lower)
 import Data.Abstract.Module
@@ -54,10 +53,7 @@ instance ( Corecursive term
   analyzeModule eval m = pushOrigin (moduleOrigin (subterm <$> m)) (eval m)
 
 
-instance ( Ord location
-         , Semigroup (Cell location value)
-         )
-      => Interpreter
+instance Interpreter
           (EvaluatingEffects location term value)
           result
           ( Either String

src/Control/Abstract/Evaluator.hs

@@ -105,7 +105,7 @@ deriving instance (Show (Cell location value), Show location, Show term, Show va
 instance (Ord location, Semigroup (Cell location value)) => Semigroup (EvaluatorState location term value) where
   EvaluatorState e1 h1 m1 l1 x1 j1 o1 <> EvaluatorState e2 h2 m2 l2 x2 j2 o2 = EvaluatorState (e1 <> e2) (h1 <> h2) (m1 <> m2) (l1 <> l2) (x1 <> x2) (j1 <> j2) (o1 <> o2)
 
-instance  (Ord location, Semigroup (Cell location value)) => Lower (EvaluatorState location term value) where
+instance Lower (EvaluatorState location term value) where
   lower = EvaluatorState lower lower lower lower lower lower lower
 
 

src/Data/Abstract/Environment.hs

@@ -23,6 +23,7 @@ import           Data.Abstract.Live
 import           Data.Align
 import qualified Data.Map as Map
 import           Data.Semigroup.Reducer
+import           Data.Semilattice.Lower
 import           GHC.Exts (IsList (..))
 import           Prologue
 import qualified Data.List.NonEmpty as NonEmpty
@@ -137,3 +138,6 @@ roots env = foldMap (maybe mempty liveSingleton . flip lookup env)
 
 addresses :: Ord l => Environment l a -> Live l a
 addresses = Live . fromList . fmap snd . pairs
+
+
+instance Lower (Environment location value) where lower = Environment (lower:|[])

src/Data/Abstract/Exports.hs

@@ -14,10 +14,11 @@ import Data.Abstract.Environment (Environment)
 import Data.Abstract.FreeVariables
 import qualified Data.Map as Map
 import Data.Semigroup.Reducer
+import Data.Semilattice.Lower
 
 -- | A map of export names to an alias & address tuple.
 newtype Exports l a = Exports { unExports :: Map.Map Name (Name, Maybe (Address l a)) }
-  deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable)
+  deriving (Eq, Foldable, Functor, Generic1, Lower, Monoid, Ord, Semigroup, Show, Traversable)
 
 null :: Exports l a -> Bool
 null = Map.null . unExports

src/Data/Abstract/Heap.hs

@@ -5,11 +5,12 @@ import Data.Abstract.Address
 import Data.Abstract.Live
 import qualified Data.Map.Monoidal as Monoidal
 import Data.Semigroup.Reducer
+import Data.Semilattice.Lower
 import Prologue
 
 -- | A map of addresses onto cells holding their values.
 newtype Heap l a = Heap { unHeap :: Monoidal.Map l (Cell l a) }
-  deriving (Generic1)
+  deriving (Generic1, Lower)
 
 deriving instance (Eq l, Eq (Cell l a)) => Eq (Heap l a)
 deriving instance (Ord l, Ord (Cell l a)) => Ord (Heap l a)

src/Data/Abstract/ModuleTable.hs

@@ -18,13 +18,14 @@ module Data.Abstract.ModuleTable
 import Data.Abstract.Module
 import qualified Data.Map as Map
 import Data.Semigroup
+import Data.Semilattice.Lower
 import Prologue
 import System.FilePath.Posix
 import GHC.Generics (Generic1)
 import Prelude hiding (lookup)
 
 newtype ModuleTable a = ModuleTable { unModuleTable :: Map.Map ModulePath a }
-  deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable)
+  deriving (Eq, Foldable, Functor, Generic1, Lower, Monoid, Ord, Semigroup, Show, Traversable)
 
 singleton :: ModulePath -> a -> ModuleTable a
 singleton name = ModuleTable . Map.singleton name
@@ -55,7 +56,7 @@ toPairs = Map.toList . unModuleTable
 
 -- | Stack of module paths used to help break circular loads/imports.
 newtype LoadStack = LoadStack { unLoadStack :: [ModulePath] }
-  deriving (Eq, Ord, Show, Monoid, Semigroup)
+  deriving (Eq, Lower, Monoid, Ord, Semigroup, Show)
 
 loadStackPush :: ModulePath -> LoadStack -> LoadStack
 loadStackPush x LoadStack{..} = LoadStack (x : unLoadStack)

src/Data/Abstract/Origin.hs

@@ -102,3 +102,5 @@ instance Semigroup (SomeOrigin term) where
 instance Monoid (SomeOrigin term) where
   mempty = SomeOrigin Unknown
   mappend = (<>)
+
+instance Lower (SomeOrigin term) where lower = SomeOrigin lower

src/Data/Map/Monoidal.hs

@@ -11,6 +11,7 @@ module Data.Map.Monoidal
 
 import qualified Data.Map as Map
 import Data.Semigroup.Reducer as Reducer
+import Data.Semilattice.Lower
 import Prelude hiding (lookup)
 import Prologue hiding (Map)
 
@@ -42,3 +43,5 @@ instance (Ord key, Reducer a value) => Reducer (key, a) (Map key value) where
   unit (key, a) = Map (Map.singleton key (unit a))
   cons (key, a) (Map m) = Map (Map.insertWith (<>) key (unit a) m)
   snoc (Map m) (key, a) = Map (Map.insertWith (flip (<>)) key (unit a) m)
+
+instance Lower (Map key value) where lower = Map lower

src/Data/Semilattice/Lower.hs

@@ -1,8 +1,13 @@
-{-# LANGUAGE DefaultSignatures, UndecidableInstances #-}
+{-# LANGUAGE DefaultSignatures #-}
 module Data.Semilattice.Lower
 ( Lower (..)
 ) where
 
+import Data.IntMap as IntMap
+import Data.IntSet as IntSet
+import Data.Map as Map
+import Data.Set as Set
+
 class Lower s where
   -- | The greatest lower bound of @s@.
   --
@@ -23,6 +28,13 @@ class Lower s where
   default lower :: Bounded s => s
   lower = minBound
 
---- | Every Monoid has a Lower instance.
-instance {-# OVERLAPS #-} Monoid a => Lower a where
-  lower = mempty
+instance Lower b => Lower (a -> b) where lower = const lower
+
+instance Lower (Maybe a) where lower = Nothing
+instance Lower [a] where lower = []
+
+-- containers
+instance Lower (IntMap a) where lower = IntMap.empty
+instance Lower IntSet where lower = IntSet.empty
+instance Lower (Map k a) where lower = Map.empty
+instance Lower (Set a) where lower = Set.empty