Rename our Union type to Sum.

semantic.cabal

@@ -91,6 +91,8 @@ library
                      , Data.Span
                      , Data.SplitDiff
                      -- À la carte syntax types
+                     , Data.Sum
+                     , Data.Sum.Templates
                      , Data.Syntax
                      , Data.Syntax.Comment
                      , Data.Syntax.Declaration
@@ -99,8 +101,6 @@ library
                      , Data.Syntax.Literal
                      , Data.Syntax.Statement
                      , Data.Syntax.Type
-                     , Data.Syntax.Union
-                     , Data.Syntax.Union.Templates
                      , Data.Term
                      -- Diffing algorithms & interpretation thereof
                      , Diffing.Algorithm

src/Data/Sum.hs

@@ -10,7 +10,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 {-|
-Module      : Data.Union
+Module      : Data.Sum
 Description : Open unions (type-indexed co-products) for extensible effects.
 Copyright   : Allele Dev 2015
 License     : BSD-3
@@ -33,11 +33,11 @@ Our list r of open union components is a small Universe.
 Therefore, we can use the Typeable-like evidence in that
 universe.
 
-The data constructors of Union are not exported.
+The data constructors of Sum are not exported.
 -}
 
-module Data.Syntax.Union (
+module Data.Sum (
-  Union,
+  Sum,
   decompose,
   weaken,
   inj,
@@ -55,11 +55,11 @@ module Data.Syntax.Union (
 import Data.Functor.Classes (Eq1(..), eq1, Ord1(..), compare1, Show1(..), showsPrec1)
 import Data.Maybe (fromMaybe)
 import Data.Proxy
-import Data.Syntax.Union.Templates
+import Data.Sum.Templates
-import Unsafe.Coerce(unsafeCoerce)
 import GHC.Exts (Constraint)
 import GHC.Prim (Proxy#, proxy#)
 import GHC.TypeLits
+import Unsafe.Coerce(unsafeCoerce)
 
 pure [mkElemIndexTypeFamily 150]
 
@@ -69,16 +69,16 @@ infixr 5 :<
 -- t is can be a GADT and hence not necessarily a Functor.
 -- Int is the index of t in the list r; that is, the index of t in the
 -- universe r.
-data Union (r :: [ * -> * ]) (v :: *) where
+data Sum (r :: [ * -> * ]) (v :: *) where
-  Union :: {-# UNPACK #-} !Int -> t v -> Union r v
+  Sum :: {-# UNPACK #-} !Int -> t v -> Sum r v
 
 {-# INLINE prj' #-}
 {-# INLINE inj' #-}
-inj' :: Int -> t v -> Union r v
+inj' :: Int -> t v -> Sum r v
-inj' = Union
+inj' = Sum
 
-prj' :: Int -> Union r v -> Maybe (t v)
+prj' :: Int -> Sum r v -> Maybe (t v)
-prj' n (Union n' x) | n == n'   = Just (unsafeCoerce x)
+prj' n (Sum n' x) | n == n'   = Just (unsafeCoerce x)
                     | otherwise = Nothing
 
 newtype P (t :: * -> *) (r :: [* -> *]) = P { unP :: Int }
@@ -92,31 +92,31 @@ type family Members ms r :: Constraint where
 type (ts :<: r) = Members ts r
 
 -- | Inject a functor into a type-aligned union.
-inj :: forall e r v. (e :< r) => e v -> Union r v
+inj :: forall e r v. (e :< r) => e v -> Sum r v
 inj = inj' (unP (elemNo :: P e r))
 {-# INLINE inj #-}
 
 -- | Maybe project a functor out of a type-aligned union.
-prj :: forall e r v. (e :< r) => Union r v -> Maybe (e v)
+prj :: forall e r v. (e :< r) => Sum r v -> Maybe (e v)
 prj = prj' (unP (elemNo :: P e r))
 {-# INLINE prj #-}
 
 
-decompose :: Union (t ': r) v -> Either (Union r v) (t v)
+decompose :: Sum (t ': r) v -> Either (Sum r v) (t v)
-decompose (Union 0 v) = Right $ unsafeCoerce v
+decompose (Sum 0 v) = Right $ unsafeCoerce v
-decompose (Union n v) = Left  $ Union (n-1) v
+decompose (Sum n v) = Left  $ Sum (n-1) v
 {-# INLINE [2] decompose #-}
 
 
 -- | Specialized version of 'decompose'.
-decompose0 :: Union '[t] v -> Either (Union '[] v) (t v)
+decompose0 :: Sum '[t] v -> Either (Sum '[] v) (t v)
-decompose0 (Union _ v) = Right $ unsafeCoerce v
+decompose0 (Sum _ v) = Right $ unsafeCoerce v
 -- No other case is possible
 {-# RULES "decompose/singleton"  decompose = decompose0 #-}
 {-# INLINE decompose0 #-}
 
-weaken :: Union r w -> Union (any ': r) w
+weaken :: Sum r w -> Sum (any ': r) w
-weaken (Union n v) = Union (n+1) v
+weaken (Sum n v) = Sum (n+1) v
 
 type (Member t r) = KnownNat (ElemIndex t r)
 type (t :< r) = Member t r
@@ -128,20 +128,20 @@ elemNo = P (fromIntegral (natVal' (proxy# :: Proxy# (ElemIndex t r))))
 
 -- | Helper to apply a function to a functor of the nth type in a type list.
 class Apply (c :: (* -> *) -> Constraint) (fs :: [* -> *]) where
-  apply :: proxy c -> (forall g . c g => g a -> b) -> Union fs a -> b
+  apply :: proxy c -> (forall g . c g => g a -> b) -> Sum fs a -> b
 
-apply' :: Apply c fs => proxy c -> (forall g . c g => (forall x. g x -> Union fs x) -> g a -> b) -> Union fs a -> b
+apply' :: Apply c fs => proxy c -> (forall g . c g => (forall x. g x -> Sum fs x) -> g a -> b) -> Sum fs a -> b
-apply' proxy f u@(Union n _) = apply proxy (f (Union n)) u
+apply' proxy f u@(Sum n _) = apply proxy (f (Sum n)) u
 {-# INLINABLE apply' #-}
 
-apply2 :: Apply c fs => proxy c -> (forall g . c g => g a -> g b -> d) -> Union fs a -> Union fs b -> Maybe d
+apply2 :: Apply c fs => proxy c -> (forall g . c g => g a -> g b -> d) -> Sum fs a -> Sum fs b -> Maybe d
-apply2 proxy f u@(Union n1 _) (Union n2 r2)
+apply2 proxy f u@(Sum n1 _) (Sum n2 r2)
   | n1 == n2  = Just (apply proxy (\ r1 -> f r1 (unsafeCoerce r2)) u)
   | otherwise = Nothing
 {-# INLINABLE apply2 #-}
 
-apply2' :: Apply c fs => proxy c -> (forall g . c g => (forall x. g x -> Union fs x) -> g a -> g b -> d) -> Union fs a -> Union fs b -> Maybe d
+apply2' :: Apply c fs => proxy c -> (forall g . c g => (forall x. g x -> Sum fs x) -> g a -> g b -> d) -> Sum fs a -> Sum fs b -> Maybe d
-apply2' proxy f u@(Union n1 _) (Union n2 r2)
+apply2' proxy f u@(Sum n1 _) (Sum n2 r2)
   | n1 == n2  = Just (apply' proxy (\ reinj r1 -> f reinj r1 (unsafeCoerce r2)) u)
   | otherwise = Nothing
 {-# INLINABLE apply2' #-}
@@ -149,7 +149,7 @@ apply2' proxy f u@(Union n1 _) (Union n2 r2)
 pure (mkApplyInstance <$> [1..150])
 
 
-instance Apply Foldable fs => Foldable (Union fs) where
+instance Apply Foldable fs => Foldable (Sum fs) where
   foldMap f = apply (Proxy :: Proxy Foldable) (foldMap f)
   {-# INLINABLE foldMap #-}
 
@@ -165,14 +165,14 @@ instance Apply Foldable fs => Foldable (Union fs) where
   length = apply (Proxy :: Proxy Foldable) length
   {-# INLINABLE length #-}
 
-instance Apply Functor fs => Functor (Union fs) where
+instance Apply Functor fs => Functor (Sum fs) where
   fmap f = apply' (Proxy :: Proxy Functor) (\ reinj a -> reinj (fmap f a))
   {-# INLINABLE fmap #-}
 
   (<$) v = apply' (Proxy :: Proxy Functor) (\ reinj a -> reinj (v <$ a))
   {-# INLINABLE (<$) #-}
 
-instance (Apply Foldable fs, Apply Functor fs, Apply Traversable fs) => Traversable (Union fs) where
+instance (Apply Foldable fs, Apply Functor fs, Apply Traversable fs) => Traversable (Sum fs) where
   traverse f = apply' (Proxy :: Proxy Traversable) (\ reinj a -> reinj <$> traverse f a)
   {-# INLINABLE traverse #-}
 
@@ -180,28 +180,28 @@ instance (Apply Foldable fs, Apply Functor fs, Apply Traversable fs) => Traversa
   {-# INLINABLE sequenceA #-}
 
 
-instance Apply Eq1 fs => Eq1 (Union fs) where
+instance Apply Eq1 fs => Eq1 (Sum fs) where
   liftEq eq u1 u2 = fromMaybe False (apply2 (Proxy :: Proxy Eq1) (liftEq eq) u1 u2)
   {-# INLINABLE liftEq #-}
 
-instance (Apply Eq1 fs, Eq a) => Eq (Union fs a) where
+instance (Apply Eq1 fs, Eq a) => Eq (Sum fs a) where
   (==) = eq1
   {-# INLINABLE (==) #-}
 
 
-instance (Apply Eq1 fs, Apply Ord1 fs) => Ord1 (Union fs) where
+instance (Apply Eq1 fs, Apply Ord1 fs) => Ord1 (Sum fs) where
-  liftCompare compareA u1@(Union n1 _) u2@(Union n2 _) = fromMaybe (compare n1 n2) (apply2 (Proxy :: Proxy Ord1) (liftCompare compareA) u1 u2)
+  liftCompare compareA u1@(Sum n1 _) u2@(Sum n2 _) = fromMaybe (compare n1 n2) (apply2 (Proxy :: Proxy Ord1) (liftCompare compareA) u1 u2)
   {-# INLINABLE liftCompare #-}
 
-instance (Apply Eq1 fs, Apply Ord1 fs, Ord a) => Ord (Union fs a) where
+instance (Apply Eq1 fs, Apply Ord1 fs, Ord a) => Ord (Sum fs a) where
   compare = compare1
   {-# INLINABLE compare #-}
 
 
-instance Apply Show1 fs => Show1 (Union fs) where
+instance Apply Show1 fs => Show1 (Sum fs) where
   liftShowsPrec sp sl d = apply (Proxy :: Proxy Show1) (liftShowsPrec sp sl d)
   {-# INLINABLE liftShowsPrec #-}
 
-instance (Apply Show1 fs, Show a) => Show (Union fs a) where
+instance (Apply Show1 fs, Show a) => Show (Sum fs a) where
   showsPrec = showsPrec1
   {-# INLINABLE showsPrec #-}

src/Data/Sum/Templates.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
-module Data.Syntax.Union.Templates
+module Data.Sum.Templates
 ( mkElemIndexTypeFamily
 , mkApplyInstance
 ) where
@@ -42,7 +42,7 @@ mkApplyInstance paramN =
     , PragmaD (InlineP apply Inlinable FunLike AllPhases)
     ]
   where typeParams = VarT . mkName . ('f' :) . show <$> [0..pred paramN]
-        [applyC, apply, f, r, union] = mkName <$> ["Apply", "apply", "f", "r", "Union"]
+        [applyC, apply, f, r, union] = mkName <$> ["Apply", "apply", "f", "r", "Sum"]
         [constraint, a] = VarT . mkName <$> ["constraint", "a"]
         mkClause i nthType = Clause
           [ WildP, VarP f, ConP union [ LitP (IntegerL i), VarP r ] ]