diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,11 +1,16 @@
+# 2.0.2 (2020-02-18)
+
+- Add `Algebra.Lattice.Stacked`
+  [#99](https://github.com/phadej/lattices/pull/99)
+
 # 2.0.1 (2019-07-22)
 
 - Add `(PartialOrd a, PartialOrd b) => PartialOrd (Either a b)` instance
 
 # 2 (2019-04-17)
 
-- Reduce to three classes (from six): `Lattice`, `BoundedMeetSemiLattice`
-  `BoundeJoinSemiLattice`.
+- Reduce to three classes (from six): `Lattice`, `BoundedMeetSemiLattice`,
+  `BoundedJoinSemiLattice`.
   The latter two names are kept to help migration.
 - Remove `Algebra.Enumerable` module. Use `universe` package.
 - Drop GHC-7.4.3 support (broken `ConstraintKinds`)
diff --git a/lattices.cabal b/lattices.cabal
--- a/lattices.cabal
+++ b/lattices.cabal
@@ -1,6 +1,6 @@
 cabal-version:      1.18
 name:               lattices
-version:            2.0.1
+version:            2.0.2
 category:           Math
 license:            BSD3
 license-file:       LICENSE
@@ -22,7 +22,14 @@
   wide.png
 
 tested-with:
-  GHC ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1
+  GHC ==7.6.3
+   || ==7.8.4
+   || ==7.10.3
+   || ==8.0.2
+   || ==8.2.2
+   || ==8.4.4
+   || ==8.6.5
+   || ==8.8.1
 
 synopsis:
   Fine-grained library for constructing and manipulating lattices
@@ -57,6 +64,7 @@
     Algebra.Lattice.N5
     Algebra.Lattice.Op
     Algebra.Lattice.Ordered
+    Algebra.Lattice.Stacked
     Algebra.Lattice.Unicode
     Algebra.Lattice.Wide
     Algebra.Lattice.ZeroHalfOne
@@ -71,8 +79,8 @@
     Algebra.PartialOrd.Instances
 
   build-depends:
-      base                        >=4.6      && <4.13
-    , base-compat                 >=0.10.5   && <0.11
+      base                        >=4.6      && <4.14
+    , base-compat                 >=0.10.5   && <0.12
     , containers                  >=0.5.0.0  && <0.7
     , deepseq                     >=1.3.0.0  && <1.5
     , hashable                    >=1.2.7.0  && <1.4
diff --git a/src/Algebra/Heyting.hs b/src/Algebra/Heyting.hs
--- a/src/Algebra/Heyting.hs
+++ b/src/Algebra/Heyting.hs
@@ -24,7 +24,7 @@
 import Data.Universe.Class   (Finite (..))
 
 import qualified Data.HashSet as HS
-import qualified Data.Set     as S
+import qualified Data.Set     as Set
 
 -- | A Heyting algebra is a bounded lattice equipped with a
 -- binary operation \(a \to b\) of implication.
@@ -128,15 +128,15 @@
 -- Sets
 -------------------------------------------------------------------------------
 
-instance (Ord a, Finite a) => Heyting (S.Set a) where
-    x ==> y = S.union (neg x) y
+instance (Ord a, Finite a) => Heyting (Set.Set a) where
+    x ==> y = Set.union (neg x) y
 
-    neg xs = S.fromList [ x | x <- universeF, S.notMember x xs]
+    neg xs = Set.fromList [ x | x <- universeF, Set.notMember x xs]
 
-    x <=> y = S.fromList
+    x <=> y = Set.fromList
         [ z
         | z <- universeF
-        , S.member z x <=> S.member z y
+        , Set.member z x <=> Set.member z y
         ]
 
 instance (Eq a, Hashable a, Finite a) => Heyting (HS.HashSet a) where
diff --git a/src/Algebra/Heyting/Free/Expr.hs b/src/Algebra/Heyting/Free/Expr.hs
--- a/src/Algebra/Heyting/Free/Expr.hs
+++ b/src/Algebra/Heyting/Free/Expr.hs
@@ -49,7 +49,7 @@
 
 instance Monad Expr where
     return = pure
-    
+
     Var x      >>= k = k x
     Bottom     >>= _ = Bottom
     Top        >>= _ = Top
diff --git a/src/Algebra/Lattice.hs b/src/Algebra/Lattice.hs
--- a/src/Algebra/Lattice.hs
+++ b/src/Algebra/Lattice.hs
@@ -61,8 +61,8 @@
 import qualified Data.HashSet      as HS
 import qualified Data.IntMap       as IM
 import qualified Data.IntSet       as IS
-import qualified Data.Map          as M
-import qualified Data.Set          as S
+import qualified Data.Map          as Map
+import qualified Data.Set          as Set
 import qualified Test.QuickCheck   as QC
 
 infixr 6 /\ -- This comment needed because of CPP
@@ -183,15 +183,15 @@
 -- Sets
 --
 
-instance Ord a => Lattice (S.Set a) where
-    (\/) = S.union
-    (/\) = S.intersection
+instance Ord a => Lattice (Set.Set a) where
+    (\/) = Set.union
+    (/\) = Set.intersection
 
-instance Ord a => BoundedJoinSemiLattice (S.Set a) where
-    bottom = S.empty
+instance Ord a => BoundedJoinSemiLattice (Set.Set a) where
+    bottom = Set.empty
 
-instance (Ord a, Finite a) => BoundedMeetSemiLattice (S.Set a) where
-    top = S.fromList universeF
+instance (Ord a, Finite a) => BoundedMeetSemiLattice (Set.Set a) where
+    top = Set.fromList universeF
 
 --
 -- IntSets
@@ -223,15 +223,15 @@
 -- Maps
 --
 
-instance (Ord k, Lattice v) => Lattice (M.Map k v) where
-    (\/) = M.unionWith (\/)
-    (/\) = M.intersectionWith (/\)
+instance (Ord k, Lattice v) => Lattice (Map.Map k v) where
+    (\/) = Map.unionWith (\/)
+    (/\) = Map.intersectionWith (/\)
 
-instance (Ord k, Lattice v) => BoundedJoinSemiLattice (M.Map k v) where
-    bottom = M.empty
+instance (Ord k, Lattice v) => BoundedJoinSemiLattice (Map.Map k v) where
+    bottom = Map.empty
 
-instance (Ord k, Finite k, BoundedMeetSemiLattice v) => BoundedMeetSemiLattice (M.Map k v) where
-    top = M.fromList (universeF `zip` repeat top)
+instance (Ord k, Finite k, BoundedMeetSemiLattice v) => BoundedMeetSemiLattice (Map.Map k v) where
+    top = Map.fromList (universeF `zip` repeat top)
 
 --
 -- IntMaps
diff --git a/src/Algebra/Lattice/Free.hs b/src/Algebra/Lattice/Free.hs
--- a/src/Algebra/Lattice/Free.hs
+++ b/src/Algebra/Lattice/Free.hs
@@ -50,7 +50,7 @@
 -- >>> let lhs = Var x \/ (Var y /\ Var z)
 -- >>> let rhs = (Var x \/ Var y) /\ (Var x \/ Var z)
 --
--- 'Free' is distributive so 
+-- 'Free' is distributive so
 --
 -- >>> lhs == rhs
 -- True
diff --git a/src/Algebra/Lattice/Levitated.hs b/src/Algebra/Lattice/Levitated.hs
--- a/src/Algebra/Lattice/Levitated.hs
+++ b/src/Algebra/Lattice/Levitated.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable     #-}
-{-# LANGUAGE DeriveFunctor      #-}
-{-# LANGUAGE DeriveGeneric      #-}
-{-# LANGUAGE DeriveTraversable  #-}
-{-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE DeriveFoldable      #-}
+{-# LANGUAGE DeriveFunctor       #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE Safe                #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE Safe               #-}
+{-# LANGUAGE TypeOperators       #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  Algebra.Lattice.Levitated
@@ -28,13 +28,13 @@
 import Algebra.Lattice
 import Algebra.PartialOrd
 
-import Control.DeepSeq     (NFData (..))
-import Control.Monad       (ap)
-import Data.Data           (Data, Typeable)
-import Data.Hashable       (Hashable (..))
+import Control.DeepSeq       (NFData (..))
+import Control.Monad         (ap)
+import Data.Data             (Data, Typeable)
+import Data.Hashable         (Hashable (..))
+import Data.Universe.Class   (Finite (..), Universe (..))
 import Data.Universe.Helpers (Natural, Tagged, retag)
-import Data.Universe.Class (Finite (..), Universe (..))
-import GHC.Generics        (Generic, Generic1)
+import GHC.Generics          (Generic, Generic1)
 
 import qualified Test.QuickCheck as QC
 
diff --git a/src/Algebra/Lattice/Lexicographic.hs b/src/Algebra/Lattice/Lexicographic.hs
--- a/src/Algebra/Lattice/Lexicographic.hs
+++ b/src/Algebra/Lattice/Lexicographic.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE DeriveFoldable      #-}
+{-# LANGUAGE DeriveFunctor       #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE Safe                #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DeriveFoldable     #-}
-{-# LANGUAGE DeriveFunctor      #-}
-{-# LANGUAGE DeriveGeneric      #-}
-{-# LANGUAGE DeriveTraversable  #-}
-{-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE Safe               #-}
-{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE TypeOperators       #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  Algebra.Lattice.Lexicographic
@@ -26,13 +26,13 @@
 import Algebra.Lattice
 import Algebra.PartialOrd
 
-import Control.DeepSeq     (NFData (..))
-import Control.Monad       (ap, liftM2)
-import Data.Data           (Data, Typeable)
-import Data.Hashable       (Hashable (..))
-import Data.Universe.Class (Finite (..), Universe (..))
+import Control.DeepSeq       (NFData (..))
+import Control.Monad         (ap, liftM2)
+import Data.Data             (Data, Typeable)
+import Data.Hashable         (Hashable (..))
+import Data.Universe.Class   (Finite (..), Universe (..))
 import Data.Universe.Helpers (Natural, Tagged, retag)
-import GHC.Generics        (Generic, Generic1)
+import GHC.Generics          (Generic, Generic1)
 
 import qualified Test.QuickCheck as QC
 
diff --git a/src/Algebra/Lattice/Lifted.hs b/src/Algebra/Lattice/Lifted.hs
--- a/src/Algebra/Lattice/Lifted.hs
+++ b/src/Algebra/Lattice/Lifted.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable     #-}
-{-# LANGUAGE DeriveFunctor      #-}
-{-# LANGUAGE DeriveGeneric      #-}
-{-# LANGUAGE DeriveTraversable  #-}
-{-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE Safe               #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE DeriveFoldable      #-}
+{-# LANGUAGE DeriveFunctor       #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE Safe                #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE TypeOperators       #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  Algebra.Lattice.Lifted
@@ -28,13 +28,13 @@
 import Algebra.Lattice
 import Algebra.PartialOrd
 
-import Control.DeepSeq     (NFData (..))
-import Control.Monad       (ap)
-import Data.Data           (Data, Typeable)
-import Data.Hashable       (Hashable (..))
-import Data.Universe.Class (Finite (..), Universe (..))
+import Control.DeepSeq       (NFData (..))
+import Control.Monad         (ap)
+import Data.Data             (Data, Typeable)
+import Data.Hashable         (Hashable (..))
+import Data.Universe.Class   (Finite (..), Universe (..))
 import Data.Universe.Helpers (Natural, Tagged, retag)
-import GHC.Generics        (Generic, Generic1)
+import GHC.Generics          (Generic, Generic1)
 
 import qualified Test.QuickCheck as QC
 
diff --git a/src/Algebra/Lattice/Op.hs b/src/Algebra/Lattice/Op.hs
--- a/src/Algebra/Lattice/Op.hs
+++ b/src/Algebra/Lattice/Op.hs
@@ -4,8 +4,8 @@
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE DeriveTraversable  #-}
 {-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE TypeOperators      #-}
 {-# LANGUAGE Safe               #-}
+{-# LANGUAGE TypeOperators      #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  Algebra.Lattice.Op
diff --git a/src/Algebra/Lattice/Stacked.hs b/src/Algebra/Lattice/Stacked.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Lattice/Stacked.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE DeriveFoldable      #-}
+{-# LANGUAGE DeriveFunctor       #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE Safe                #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators       #-}
+module Algebra.Lattice.Stacked (
+    Stacked(..)
+  , foldStacked
+  ) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Algebra.Lattice
+import Algebra.PartialOrd
+
+import Control.DeepSeq       (NFData (..))
+import Control.Monad         (ap, liftM2)
+import Data.Data             (Data, Typeable)
+import Data.Hashable         (Hashable (..))
+import Data.Universe.Class   (Finite (..), Universe (..))
+import Data.Universe.Helpers (Natural, Tagged, retag, (+++))
+import GHC.Generics          (Generic, Generic1)
+
+import qualified Test.QuickCheck as QC
+
+--
+-- Stacked
+--
+
+-- | Stacked two lattices, one on top of another. All minimal elements of upper lattice cover all maximal elements of lower lattice.
+data Stacked a b = Lower a
+              | Upper b
+    deriving ( Eq, Ord, Show, Read, Data, Typeable, Generic, Functor, Foldable, Traversable
+            , Generic1
+            )
+
+foldStacked :: (l -> r) -> (u -> r) -> Stacked l u -> r
+foldStacked f _ (Lower l) = f l
+foldStacked _ f (Upper u) = f u
+
+instance Applicative (Stacked a) where
+    pure = Upper
+    (<*>) = ap
+
+instance Monad (Stacked a) where
+    return = pure
+
+    Lower x >>= _ = Lower x
+    Upper x >>= f = f x
+
+instance (NFData a, NFData b) => NFData (Stacked a b) where
+    rnf (Upper x) = rnf x
+    rnf (Lower x) = rnf x
+
+instance (Hashable a, Hashable b) => Hashable (Stacked a b)
+
+instance (PartialOrd a, PartialOrd b) => PartialOrd (Stacked a b) where
+    leq (Upper x) (Upper y) = leq x y
+    leq (Upper _) _ = False
+    leq _ (Upper _) = True
+    leq (Lower x) (Lower y) = leq x y
+    comparable (Upper x) (Upper y) = comparable x y
+    comparable (Upper _) _ = True
+    comparable _ (Upper _) = True
+    comparable (Lower x) (Lower y) = comparable x y
+
+instance (Lattice a, Lattice b) => Lattice (Stacked a b) where
+    Upper x \/ Upper y = Upper (x \/ y)
+    u@(Upper _) \/ _ = u
+    _ \/ u@(Upper _) = u
+    Lower x \/ Lower y = Lower (x \/ y)
+    Lower x /\ Lower y = Lower (x /\ y)
+    l@(Lower _) /\ _ = l
+    _ /\ l@(Lower _) = l
+    Upper x /\ Upper y = Upper (x /\ y)
+
+instance (BoundedJoinSemiLattice a, Lattice b) => BoundedJoinSemiLattice (Stacked a b) where
+    bottom = Lower bottom
+
+instance (Lattice a, BoundedMeetSemiLattice b) => BoundedMeetSemiLattice (Stacked a b) where
+    top = Upper top
+
+instance (Universe a, Universe b) => Universe (Stacked a b) where
+    universe = (Lower <$> universe) +++ (Upper <$> universe)
+
+instance (Finite a, Finite b) => Finite (Stacked a b) where
+    universeF = (Lower <$> universe) ++ (Upper <$> universe)
+    cardinality = liftM2 (+)
+        (retag (cardinality :: Tagged a Natural))
+        (retag (cardinality :: Tagged b Natural))
+
+instance (QC.Arbitrary a, QC.Arbitrary b) => QC.Arbitrary (Stacked a b) where
+    arbitrary = QC.oneof [Upper <$> QC.arbitrary, Lower <$> QC.arbitrary]
+    shrink (Lower x) = Lower <$> QC.shrink x
+    shrink (Upper y) = Upper <$> QC.shrink y
diff --git a/src/Algebra/PartialOrd.hs b/src/Algebra/PartialOrd.hs
--- a/src/Algebra/PartialOrd.hs
+++ b/src/Algebra/PartialOrd.hs
@@ -25,9 +25,9 @@
 import qualified Data.IntMap       as IM
 import qualified Data.IntSet       as IS
 import qualified Data.List.Compat  as L
-import qualified Data.Map          as M
+import qualified Data.Map          as Map
 import           Data.Monoid       (All (..), Any (..))
-import qualified Data.Set          as S
+import qualified Data.Set          as Set
 import           Data.Void         (Void)
 
 -- | A partial ordering on sets
@@ -124,8 +124,8 @@
 instance Eq a => PartialOrd [a] where
     leq = L.isSubsequenceOf
 
-instance Ord a => PartialOrd (S.Set a) where
-    leq = S.isSubsetOf
+instance Ord a => PartialOrd (Set.Set a) where
+    leq = Set.isSubsetOf
 
 instance PartialOrd IS.IntSet where
     leq = IS.isSubsetOf
@@ -133,8 +133,8 @@
 instance (Eq k, Hashable k) => PartialOrd (HS.HashSet k) where
     leq a b = HS.null (HS.difference a b)
 
-instance (Ord k, PartialOrd v) => PartialOrd (M.Map k v) where
-    leq = M.isSubmapOfBy leq
+instance (Ord k, PartialOrd v) => PartialOrd (Map.Map k v) where
+    leq = Map.isSubmapOfBy leq
 
 instance PartialOrd v => PartialOrd (IM.IntMap v) where
     leq = IM.isSubmapOfBy leq
diff --git a/test/Tests.hs b/test/Tests.hs
--- a/test/Tests.hs
+++ b/test/Tests.hs
@@ -44,6 +44,7 @@
 import qualified Algebra.Lattice.Lifted        as U
 import qualified Algebra.Lattice.Op            as Op
 import qualified Algebra.Lattice.Ordered       as O
+import qualified Algebra.Lattice.Stacked       as S
 import qualified Algebra.Lattice.Wide          as W
 
 import Data.HashMap.Lazy (HashMap)
@@ -89,6 +90,8 @@
     , allLatticeLaws (LBounded Partial Modular)          (Proxy :: Proxy (W.Wide Int))
     , allLatticeLaws (LBounded Partial NonModular)       (Proxy :: Proxy (LO.Lexicographic (Set Bool) (Set Bool)))
     , allLatticeLaws (LBounded Partial NonModular)       (Proxy :: Proxy (LO.Lexicographic M2 M2)) -- non distributive!
+    , allLatticeLaws (LBounded Partial Distributive)     (Proxy :: Proxy (S.Stacked M2 M2))
+    , allLatticeLaws (LBounded Partial NonModular)       (Proxy :: Proxy (S.Stacked M3 N5)) -- non modular, though it takes QC time to find
 
     , allLatticeLaws LNotLattice                         (Proxy :: Proxy String)
 
@@ -119,6 +122,7 @@
     , monadLaws "Op" (Proxy1 :: Proxy1 Op.Op)
     , monadLaws "Ordered" (Proxy1 :: Proxy1 O.Ordered)
     , monadLaws "Wide" (Proxy1 :: Proxy1 W.Wide)
+    , monadLaws "Stacked" (Proxy1 :: Proxy1 (S.Stacked N5))
     , monadLaws "Heyting.Free" (Proxy1 :: Proxy1 HF.Free)
 
     , finiteLaws (Proxy :: Proxy M2)
@@ -133,6 +137,7 @@
     , finiteLaws (Proxy :: Proxy (L.Levitated OInt8))
     , finiteLaws (Proxy :: Proxy (U.Lifted OInt8))
     , finiteLaws (Proxy :: Proxy (LO.Lexicographic OInt8 OInt8))
+    , finiteLaws (Proxy :: Proxy (S.Stacked OInt8 OInt8))
     ]
 
 type OInt8 = O.Ordered Int8