{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE PolyKinds #-} -- For instances
#endif
{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.Lub
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Compute least upper bound ('lub') of two values, with respect to
-- information content.  I.e., merge the information available in each.
-- For flat types (in which all values are either bottom or fully
-- defined), 'lub' is equivalent to 'unamb'.
----------------------------------------------------------------------

module Data.Lub
  ( 
  -- * Least upper bounds
    HasLub(..), Lub(..), flatLub
  -- * Some useful special applications of 'lub'
  , parCommute, ptimes
  -- * Generic deriving
  , GHasLub
  , genericLub
  ) where

import Control.Applicative (liftA2, Const, ZipList)

import Data.Unamb hiding (parCommute)
-- import qualified Data.Unamb as Unamb

import GHC.Generics
import qualified Data.Typeable as Typeable
#if MIN_VERSION_base(4,7,0)
import Data.Type.Equality ((:~:))
import qualified Data.Proxy as Proxy
#endif
#if MIN_VERSION_base(4,8,0)
import qualified Data.Functor.Identity as Identity
import qualified Data.Void as Void
#endif
#if MIN_VERSION_base(4,9,0)
import qualified Data.Functor.Compose as Compose
import qualified Data.Functor.Product as Product
import qualified Data.Functor.Sum as Sum
import qualified Data.Semigroup as Semigroup
#endif
#if MIN_VERSION_base(4,10,0)
import Data.Type.Equality ((:~~:))
import qualified Type.Reflection as TR
#endif

-- | Types that support information merging ('lub')
class HasLub a where
  -- | Least upper information bound.  Combines information available from
  -- each argument.  The arguments must be consistent, i.e., must have a
  -- common upper bound.
  lub  :: a -> a -> a
  default lub :: (Generic a, GHasLub (Rep a)) => a -> a -> a
  lub = a -> a -> a
forall a. (Generic a, GHasLub (Rep a)) => a -> a -> a
genericLub
  -- | n-ary 'lub'.  Defaults to @foldr lub undefined@
  lubs :: [a] -> a
  -- Why not foldr1 lub? That would be cheaper, because it avoids
  -- a call to `lub` with `undefined`. But it would be too strict:
  -- lubs (3 : undefined) would be undefined when it should be 3.
  lubs = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall a. HasLub a => a -> a -> a
lub a
forall a. HasCallStack => a
undefined

-- | The 'Semigroup.Semigroup' operation takes the
-- least upper bound.
newtype Lub a = Lub { Lub a -> a
getLub :: a }
  deriving (Int -> Lub a -> ShowS
[Lub a] -> ShowS
Lub a -> String
(Int -> Lub a -> ShowS)
-> (Lub a -> String) -> ([Lub a] -> ShowS) -> Show (Lub a)
forall a. Show a => Int -> Lub a -> ShowS
forall a. Show a => [Lub a] -> ShowS
forall a. Show a => Lub a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lub a] -> ShowS
$cshowList :: forall a. Show a => [Lub a] -> ShowS
show :: Lub a -> String
$cshow :: forall a. Show a => Lub a -> String
showsPrec :: Int -> Lub a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Lub a -> ShowS
Show, ReadPrec [Lub a]
ReadPrec (Lub a)
Int -> ReadS (Lub a)
ReadS [Lub a]
(Int -> ReadS (Lub a))
-> ReadS [Lub a]
-> ReadPrec (Lub a)
-> ReadPrec [Lub a]
-> Read (Lub a)
forall a. Read a => ReadPrec [Lub a]
forall a. Read a => ReadPrec (Lub a)
forall a. Read a => Int -> ReadS (Lub a)
forall a. Read a => ReadS [Lub a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Lub a]
$creadListPrec :: forall a. Read a => ReadPrec [Lub a]
readPrec :: ReadPrec (Lub a)
$creadPrec :: forall a. Read a => ReadPrec (Lub a)
readList :: ReadS [Lub a]
$creadList :: forall a. Read a => ReadS [Lub a]
readsPrec :: Int -> ReadS (Lub a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Lub a)
Read, Lub a -> Lub a -> Bool
(Lub a -> Lub a -> Bool) -> (Lub a -> Lub a -> Bool) -> Eq (Lub a)
forall a. Eq a => Lub a -> Lub a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lub a -> Lub a -> Bool
$c/= :: forall a. Eq a => Lub a -> Lub a -> Bool
== :: Lub a -> Lub a -> Bool
$c== :: forall a. Eq a => Lub a -> Lub a -> Bool
Eq, Eq (Lub a)
Eq (Lub a)
-> (Lub a -> Lub a -> Ordering)
-> (Lub a -> Lub a -> Bool)
-> (Lub a -> Lub a -> Bool)
-> (Lub a -> Lub a -> Bool)
-> (Lub a -> Lub a -> Bool)
-> (Lub a -> Lub a -> Lub a)
-> (Lub a -> Lub a -> Lub a)
-> Ord (Lub a)
Lub a -> Lub a -> Bool
Lub a -> Lub a -> Ordering
Lub a -> Lub a -> Lub a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Lub a)
forall a. Ord a => Lub a -> Lub a -> Bool
forall a. Ord a => Lub a -> Lub a -> Ordering
forall a. Ord a => Lub a -> Lub a -> Lub a
min :: Lub a -> Lub a -> Lub a
$cmin :: forall a. Ord a => Lub a -> Lub a -> Lub a
max :: Lub a -> Lub a -> Lub a
$cmax :: forall a. Ord a => Lub a -> Lub a -> Lub a
>= :: Lub a -> Lub a -> Bool
$c>= :: forall a. Ord a => Lub a -> Lub a -> Bool
> :: Lub a -> Lub a -> Bool
$c> :: forall a. Ord a => Lub a -> Lub a -> Bool
<= :: Lub a -> Lub a -> Bool
$c<= :: forall a. Ord a => Lub a -> Lub a -> Bool
< :: Lub a -> Lub a -> Bool
$c< :: forall a. Ord a => Lub a -> Lub a -> Bool
compare :: Lub a -> Lub a -> Ordering
$ccompare :: forall a. Ord a => Lub a -> Lub a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Lub a)
Ord, (forall x. Lub a -> Rep (Lub a) x)
-> (forall x. Rep (Lub a) x -> Lub a) -> Generic (Lub a)
forall x. Rep (Lub a) x -> Lub a
forall x. Lub a -> Rep (Lub a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Lub a) x -> Lub a
forall a x. Lub a -> Rep (Lub a) x
$cto :: forall a x. Rep (Lub a) x -> Lub a
$cfrom :: forall a x. Lub a -> Rep (Lub a) x
Generic)

instance HasLub a => HasLub (Lub a)

#if MIN_VERSION_base(4,9,0)
instance HasLub a => Semigroup.Semigroup (Lub a) where
  Lub a
a <> :: Lub a -> Lub a -> Lub a
<> Lub a
b = a -> Lub a
forall a. a -> Lub a
Lub (a
a a -> a -> a
forall a. HasLub a => a -> a -> a
`lub` a
b)
  stimes :: b -> Lub a -> Lub a
stimes = b -> Lub a -> Lub a
forall b a. Integral b => b -> a -> a
Semigroup.stimesIdempotent
#endif

instance HasLub a => Monoid (Lub a) where
  mempty :: Lub a
mempty = Lub a
forall a. HasCallStack => a
undefined  -- This is actually the unit for Lub a!
#if !MIN_VERSION_base(4,11,0)
  Lub a `mappend` Lub b = Lub (a `lub` b)
#endif

instance Functor Lub where
  fmap :: (a -> b) -> Lub a -> Lub b
fmap a -> b
f (Lub a
a) = b -> Lub b
forall a. a -> Lub a
Lub (a -> b
f a
a)
instance Applicative Lub where
  pure :: a -> Lub a
pure = a -> Lub a
forall a. a -> Lub a
Lub
  Lub a -> b
f <*> :: Lub (a -> b) -> Lub a -> Lub b
<*> Lub a
a = b -> Lub b
forall a. a -> Lub a
Lub (a -> b
f a
a)
instance Monad Lub where
  Lub a
a >>= :: Lub a -> (a -> Lub b) -> Lub b
>>= a -> Lub b
f = a -> Lub b
f a
a

-- | A 'lub' for flat domains.  Equivalent to 'unamb'.  Handy for defining
-- 'HasLub' instances, e.g.,
-- 
-- @
--   instance HasLub Integer where lub = flatLub
-- @
flatLub :: a -> a -> a
flatLub :: a -> a -> a
flatLub = a -> a -> a
forall a. a -> a -> a
unamb

-- Flat types:
instance HasLub Char    where lub :: Char -> Char -> Char
lub = Char -> Char -> Char
forall a. a -> a -> a
flatLub
instance HasLub Int     where lub :: Int -> Int -> Int
lub = Int -> Int -> Int
forall a. a -> a -> a
flatLub
instance HasLub Integer where lub :: Integer -> Integer -> Integer
lub = Integer -> Integer -> Integer
forall a. a -> a -> a
flatLub
instance HasLub Float   where lub :: Float -> Float -> Float
lub = Float -> Float -> Float
forall a. a -> a -> a
flatLub
instance HasLub Double  where lub :: Double -> Double -> Double
lub = Double -> Double -> Double
forall a. a -> a -> a
flatLub
#if MIN_VERSION_base(4,7,0)
instance HasLub (a :~: b) where lub :: (a :~: b) -> (a :~: b) -> a :~: b
lub = (a :~: b) -> (a :~: b) -> a :~: b
forall a. a -> a -> a
flatLub
#endif
#if MIN_VERSION_base(4,10,0)
instance HasLub (a :~~: b) where lub :: (a :~~: b) -> (a :~~: b) -> a :~~: b
lub = (a :~~: b) -> (a :~~: b) -> a :~~: b
forall a. a -> a -> a
flatLub
instance HasLub (TR.TypeRep a) where lub :: TypeRep a -> TypeRep a -> TypeRep a
lub = TypeRep a -> TypeRep a -> TypeRep a
forall a. a -> a -> a
flatLub
#endif
instance HasLub Typeable.TypeRep where lub :: TypeRep -> TypeRep -> TypeRep
lub = TypeRep -> TypeRep -> TypeRep
forall a. a -> a -> a
flatLub
-- ...

-- Generic-derived types:
instance HasLub ()
#if MIN_VERSION_base(4,7,0)
instance HasLub (Proxy.Proxy t)
#endif
instance HasLub Bool
instance HasLub Ordering
instance (HasLub a, HasLub b) => HasLub (Either a b)
instance HasLub a => HasLub (Maybe a)
instance HasLub a => HasLub [a]
instance HasLub a => HasLub (ZipList a)

instance (HasLub a, HasLub b) => HasLub (a,b)
instance (HasLub a, HasLub b, HasLub c) => HasLub (a,b,c)
instance (HasLub a, HasLub b, HasLub c, HasLub d) => HasLub (a,b,c,d)
instance (HasLub a, HasLub b, HasLub c, HasLub d, HasLub e) => HasLub (a,b,c,d,e)

instance HasLub a => HasLub (Const a b)

#if MIN_VERSION_base(4,8,0)
instance HasLub a => HasLub (Identity.Identity a)
instance HasLub Void.Void
#endif

-- People often use :+: and :*: rather than Sum and Product
-- even outside of a Generic context.
instance (HasLub (f a), HasLub (g a)) => HasLub ((f :*: g) a)
instance (HasLub (f a), HasLub (g a)) => HasLub ((f :+: g) a)

#if MIN_VERSION_base(4,9,0)
instance HasLub (f (g a)) => HasLub (Compose.Compose f g a)
instance (HasLub (f a), HasLub (g a)) => HasLub (Product.Product f g a)
instance (HasLub (f a), HasLub (g a)) => HasLub (Sum.Sum f g a)
#endif

-- Functions. This is not *strictly* correct, because it converts `undefined`
-- into `const undefined`, but anyone who cares is doing something fishy
-- anyway.
instance HasLub b => HasLub (a -> b) where
  lub :: (a -> b) -> (a -> b) -> a -> b
lub = (b -> b -> b) -> (a -> b) -> (a -> b) -> a -> b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. HasLub a => a -> a -> a
lub
  -- f `lub` g = \ a -> f a `lub` g a

-- | Turn a binary commutative operation into that tries both orders in
-- parallel, 'lub'-merging the results.  Useful when there are special
-- cases that don't require evaluating both arguments.
-- 
-- Similar to parCommute from Unamb, but uses 'lub' instead of 'unamb'.
parCommute :: HasLub b => (a -> a -> b) -> (a -> a -> b)
parCommute :: (a -> a -> b) -> a -> a -> b
parCommute a -> a -> b
op a
x a
y = (a
x a -> a -> b
`op` a
y) b -> b -> b
forall a. HasLub a => a -> a -> a
`lub` (a
y a -> a -> b
`op` a
x)

-- | Multiplication optimized for either argument being zero or one, where
-- the other might be expensive/delayed.
ptimes :: (HasLub a, Eq a, Num a) => a -> a -> a
ptimes :: a -> a -> a
ptimes = (a -> a -> a) -> a -> a -> a
forall b a. HasLub b => (a -> a -> b) -> a -> a -> b
parCommute a -> a -> a
forall a. (Eq a, Num a) => a -> a -> a
times
 where
   a
0 times :: a -> a -> a
`times` a
_ = a
0
   a
1 `times` a
b = a
b
   a
a `times` a
b = a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
b

-- I don't think this pplus is useful, since both arguments have to get
-- evaluated anyway.
-- 
-- -- | Addition optimized for either argument being zero, where the other
-- -- might be expensive/delayed.
-- pplus :: (HasLub a, Num a) => a -> a -> a
-- pplus = parCommute plus
--  where
--    0 `plus` b = b
--    a `plus` b = a+b


{-  -- Examples:

0     *    undefined :: Integer
0 `ptimes` undefined :: Integer
undefined `ptimes` 0 :: Integer

zip' :: (HasLub a, HasLub b) => [a] -> [b] -> [(a,b)]
zip' = lubs [p1,p2,p3]
 where
   p1 []     _      = []
   p2 _      []     = []
   p3 (x:xs) (y:ys) = (x,y) : zip' xs ys

zip' [] (error "boom") :: [(Int,Int)]
zip' (error "boom") [] :: [(Int,Int)]

zip' [10,20] (1 : 2 : error "boom")
zip' (1 : 2 : error "boom") [10,20]

Alternatively, we can avoid the constraints and partial matches
by using lub only to (lazily) calculate the *length* of the
result. See Data.Laxer.fairZipWith and fairZip.
-}

-- ------------------------
-- Generic deriving

-- | Used for generic deriving of 'HasLub'
class GHasLub f where
  -- Yes, this is an unusual type for the method of a class of Generic
  -- representations. But we need to make decisions about what we do with `a`
  -- itself based on what its representation looks like, and this seems
  -- to be the simplest way to achieve that by far.
  glub :: (Generic a, Rep a ~ f) => a -> a -> a

-- | A suitable definition of 'lub' for instances of 'Generic'.
genericLub :: (Generic a, GHasLub (Rep a)) => a -> a -> a
-- What makes genericLub different from glub? When using
-- TypeApplications, the first type argument of glub is
-- the representation type; that's not very friendly.
genericLub :: a -> a -> a
genericLub a
a a
b = a -> a -> a
forall (f :: * -> *) a.
(GHasLub f, Generic a, Rep a ~ f) =>
a -> a -> a
glub a
a a
b

-- Newtypes don't want their outsides forced/checked, because they don't have any.
instance HasLub x => GHasLub (D1 ('MetaData _q _r _s 'True) (C1 _t (S1 _u (K1 _v x)))) where
  glub :: a -> a -> a
glub a
a a
b
    | M1 (M1 (M1 (K1 x))) <- a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
a
    , M1 (M1 (M1 (K1 y))) <- a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
b
    = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (M1 C _t (S1 _u (K1 _v x)) Any
-> M1 D ('MetaData _q _r _s 'True) (C1 _t (S1 _u (K1 _v x))) Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 S _u (K1 _v x) Any -> M1 C _t (S1 _u (K1 _v x)) Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 _v x Any -> M1 S _u (K1 _v x) Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (x -> K1 _v x Any
forall k i c (p :: k). c -> K1 i c p
K1 (x -> x -> x
forall a. HasLub a => a -> a -> a
lub x
x x
y)))))

-- Not a newtype. First, we use 'unamb' to get the value in WHNF.
-- We can then walk the generic representation of that WHNF value,
-- setting up 'lub' computations using the actual values stored
-- in the (generic representations of) the two argument values.
instance GHasLub' f => GHasLub (D1 ('MetaData _q _r _s 'False) f) where
  -- It turns out to be *really* helpful to use `unamb a b` here rather than
  -- unamb (from a) (from b). Doing so gets us really clean Core without a
  -- bunch of unnecessary generic conversions. Basically, we want to avoid
  -- computing any generic representations within `unamb`, because nothing can
  -- inline through that. An extra side benefit is that we can use the same
  -- GHasLub instance for lifted unary tuples as for other non-newtype types,
  -- which avoids a lot of mess.
  glub :: a -> a -> a
glub a
a a
b
    = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (f Any -> M1 D ('MetaData _q _r _s 'False) f Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f Any -> f Any -> f Any -> f Any
forall k (f :: k -> *) (p :: k).
GHasLub' f =>
f p -> f p -> f p -> f p
glub' (M1 D ('MetaData _q _r _s 'False) f Any -> f Any
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
ab)) f Any
ar f Any
br))
    where
      M1 f Any
ar = a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
a
      M1 f Any
br = a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
b
      -- We force ab here in case the type is a lifted unary tuple, in which case
      -- its outside *won't* be forced by glub'.
      !ab :: a
ab = a
a a -> a -> a
forall a. a -> a -> a
`unamb` a
b

-- | Used for non-newtype 'Generic' deriving.
class GHasLub' f where
  -- | The first argument is used to get constructor
  -- info. We are free to pattern match
  -- on it all we like.
  glub' :: f p -> f p -> f p -> f p

instance GHasLub' f => GHasLub' (M1 i c f) where
  glub' :: M1 i c f p -> M1 i c f p -> M1 i c f p -> M1 i c f p
glub' (M1 f p
outer) (M1 f p
l) (M1 f p
r) = f p -> M1 i c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> f p -> f p -> f p
forall k (f :: k -> *) (p :: k).
GHasLub' f =>
f p -> f p -> f p -> f p
glub' f p
outer f p
l f p
r)

instance (GHasLub' f, GHasLub' g) => GHasLub' (f :+: g) where
  glub' :: (:+:) f g p -> (:+:) f g p -> (:+:) f g p -> (:+:) f g p
glub' (L1 f p
o) ~(L1 f p
l1) ~(L1 f p
l2) = f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f p -> f p -> f p -> f p
forall k (f :: k -> *) (p :: k).
GHasLub' f =>
f p -> f p -> f p -> f p
glub' f p
o f p
l1 f p
l2)
  glub' (R1 g p
o) ~(R1 g p
r1) ~(R1 g p
r2) = g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g p -> g p -> g p -> g p
forall k (f :: k -> *) (p :: k).
GHasLub' f =>
f p -> f p -> f p -> f p
glub' g p
o g p
r1 g p
r2)

instance (GHasLub' f, GHasLub' g) => GHasLub' (f :*: g) where
  -- We must pattern match strictly on the first argument, because
  -- otherwise we'll end up with things like
  --
  --   lub @(a,b) undefined undefined = (undefined, undefined)
  glub' :: (:*:) f g p -> (:*:) f g p -> (:*:) f g p -> (:*:) f g p
glub' (f p
o1 :*: g p
o2) ~(f p
l1 :*: g p
l2) ~(f p
r1 :*: g p
r2) =
    f p -> f p -> f p -> f p
forall k (f :: k -> *) (p :: k).
GHasLub' f =>
f p -> f p -> f p -> f p
glub' f p
o1 f p
l1 f p
r1 f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p -> g p -> g p -> g p
forall k (f :: k -> *) (p :: k).
GHasLub' f =>
f p -> f p -> f p -> f p
glub' g p
o2 g p
l2 g p
r2

instance GHasLub' U1 where
  -- We pattern match strictly so we don't get
  --
  -- lub @() undefined undefined = ()
  glub' :: U1 p -> U1 p -> U1 p -> U1 p
glub' U1 p
U1 U1 p
_ U1 p
_ = U1 p
forall k (p :: k). U1 p
U1

instance GHasLub' V1 where
#if __GLASGOW_HASKELL__ >= 708
  glub' :: V1 p -> V1 p -> V1 p -> V1 p
glub' V1 p
v V1 p
_ V1 p
_ = case V1 p
v of
#else
  glub' !_ _ _ = error "Can't happen"
#endif

instance HasLub c => GHasLub' (K1 i c) where
  glub' :: K1 i c p -> K1 i c p -> K1 i c p -> K1 i c p
glub' K1 i c p
_ (K1 c
l) (K1 c
r) = c -> K1 i c p
forall k i c (p :: k). c -> K1 i c p
K1 (c -> K1 i c p) -> c -> K1 i c p
forall a b. (a -> b) -> a -> b
$ c -> c -> c
forall a. HasLub a => a -> a -> a
lub c
l c
r