dependent-sum-0.2.0.1/0000755000000000000000000000000011620514053012603 5ustar0000000000000000dependent-sum-0.2.0.1/dependent-sum.cabal0000644000000000000000000000213011620514053016333 0ustar0000000000000000name: dependent-sum version: 0.2.0.1 stability: provisional cabal-version: >= 1.6 build-type: Simple author: James Cook maintainer: James Cook license: PublicDomain homepage: https://github.com/mokus0/dependent-sum category: Data, Dependent Types synopsis: Dependent sum type description: Dependent sums and supporting typeclasses for comparing and formatting them. tested-with: GHC == 7.0.4, GHC == 6.12.3, GHC == 6.10.4 extra-source-files: examples/*.hs source-repository head type: git location: git://github.com/mokus0/dependent-sum.git Library hs-source-dirs: src exposed-modules: Data.Dependent.Sum Data.GADT.Compare Data.GADT.Show other-modules: Data.Dependent.Sum.Typeable build-depends: base >= 3 && <5 if impl(ghc >= 7.2) ghc-options: -trust base dependent-sum-0.2.0.1/Setup.lhs0000644000000000000000000000011611620514053014411 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain dependent-sum-0.2.0.1/examples/0000755000000000000000000000000011620514053014421 5ustar0000000000000000dependent-sum-0.2.0.1/examples/FooGADT.hs0000644000000000000000000000423011620514053016137 0ustar0000000000000000{-# LANGUAGE GADTs #-} module FooGADT where import Data.Dependent.Sum import Data.GADT.Show import Data.GADT.Compare data Foo a where Foo :: Foo Double Bar :: Foo Int Baz :: Foo String Qux :: Foo Double instance Eq (Foo a) where (==) = defaultEq instance GEq Foo where geq Foo Foo = Just Refl geq Bar Bar = Just Refl geq Baz Baz = Just Refl geq Qux Qux = Just Refl geq _ _ = Nothing instance EqTag Foo where eqTagged Foo Foo = (==) eqTagged Bar Bar = (==) eqTagged Baz Baz = (==) eqTagged Qux Qux = (==) eqTagged _ _ = const (const False) instance GCompare Foo where gcompare Foo Foo = GEQ gcompare Foo _ = GLT gcompare _ Foo = GGT gcompare Bar Bar = GEQ gcompare Bar _ = GLT gcompare _ Bar = GGT gcompare Baz Baz = GEQ gcompare Baz _ = GLT gcompare _ Baz = GGT gcompare Qux Qux = GEQ instance OrdTag Foo where compareTagged Foo Foo = compare compareTagged Bar Bar = compare compareTagged Baz Baz = compare compareTagged Qux Qux = compare compareTagged _ _ = error "OrdTag (Foo): bad case" instance Show (Foo a) where showsPrec _ Foo = showString "Foo" showsPrec _ Bar = showString "Bar" showsPrec _ Baz = showString "Baz" showsPrec _ Qux = showString "Qux" instance GShow Foo where gshowsPrec = showsPrec instance ShowTag Foo where showTaggedPrec Foo = showsPrec showTaggedPrec Bar = showsPrec showTaggedPrec Baz = showsPrec showTaggedPrec Qux = showsPrec instance GRead Foo where greadsPrec _ str = case tag of "Foo" -> [(\k -> k Foo, rest)] "Bar" -> [(\k -> k Bar, rest)] "Baz" -> [(\k -> k Baz, rest)] "Qux" -> [(\k -> k Qux, rest)] _ -> [] where (tag, rest) = splitAt 3 str instance ReadTag Foo where readTaggedPrec Foo = readsPrec readTaggedPrec Bar = readsPrec readTaggedPrec Baz = readsPrec readTaggedPrec Qux = readsPrec foo x = Foo :=> x bar x = Bar :=> x baz x = Baz :=> x qux x = Qux :=> x xs = [foo pi, bar 100, baz "hello world", qux (exp 1)] xs' = read (show xs) `asTypeOf` xsdependent-sum-0.2.0.1/src/0000755000000000000000000000000011620514053013372 5ustar0000000000000000dependent-sum-0.2.0.1/src/Data/0000755000000000000000000000000011620514053014243 5ustar0000000000000000dependent-sum-0.2.0.1/src/Data/Dependent/0000755000000000000000000000000011620514053016151 5ustar0000000000000000dependent-sum-0.2.0.1/src/Data/Dependent/Sum.hs0000644000000000000000000001470511620514053017260 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification, GADTs #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} #endif module Data.Dependent.Sum where import Data.Dependent.Sum.Typeable ({- instance Typeable ... -}) import Data.GADT.Show import Data.GADT.Compare import Data.Maybe (fromMaybe) -- |A basic dependent sum type; the first component is a tag that specifies -- the type of the second; for example, think of a GADT such as: -- -- > data Tag a where -- > AString :: Tag String -- > AnInt :: Tag Int -- -- Then, we have the following valid expressions of type @DSum Tag@: -- -- > AString :=> "hello!" -- > AnInt :=> 42 -- -- And we can write functions that consume @DSum Tag@ values by matching, -- such as: -- -- > toString :: DSum Tag -> String -- > toString (AString :=> str) = str -- > toString (AnInt :=> int) = show int -- -- By analogy to the (key => value) construction for dictionary entries in -- many dynamic languages, we use (key :=> value) as the constructor for -- dependent sums. The :=> operator has very low precedence and binds to -- the right, so if the @Tag@ GADT is extended with an additional constructor -- @Rec :: Tag (DSum Tag)@, then @Rec :=> AnInt :=> 3 + 4@ is parsed as -- would be expected (@Rec :=> (AnInt :=> (3 + 4))@) and has type @DSum Tag@. -- Its precedence is just above that of '$', so @foo bar $ AString :=> "eep"@ -- is equivalent to @foo bar (AString :=> "eep")@. data DSum tag = forall a. !(tag a) :=> a infixr 1 :=> -- |In order to make a 'Show' instance for @DSum tag@, @tag@ must be able -- to show itself as well as any value of the tagged type. 'GShow' together -- with this class provides the interface by which it can do so. -- -- @GShow tag => t@ is conceptually equivalent to something like this -- imaginary syntax: @(forall a. Inhabited (tag a) => Show a) => t@, -- where 'Inhabited' is an imaginary predicate that characterizes -- non-empty types, and 'a' does not occur free in 't'. -- -- The @Tag@ example type introduced in the 'DSum' section could be given the -- following instances: -- -- > instance GShow Tag where -- > gshowsPrec _showsValPrec _p AString = showString "AString" -- > gshowsPrec _showsValPrec _p AnInt = showString "AnInt" -- > instance ShowTag Tag where -- > showTaggedPrec AString = showsPrec -- > showTaggedPrec AnInt = showsPrec -- class GShow tag => ShowTag tag where -- |Given a value of type @tag a@, return the 'showsPrec' function for -- the type parameter @a@. showTaggedPrec :: tag a -> Int -> a -> ShowS instance Show a => ShowTag ((:=) a) where showTaggedPrec Refl = showsPrec -- This instance is questionable. It works, but is pretty useless. instance Show a => ShowTag (GOrdering a) where showTaggedPrec GEQ = showsPrec showTaggedPrec _ = \p _ -> showParen (p > 10) ( showString "error " . shows "type information lost into the mists of oblivion" ) instance ShowTag tag => Show (DSum tag) where showsPrec p (tag :=> value) = showParen (p >= 10) ( gshowsPrec 0 tag . showString " :=> " . showTaggedPrec tag 1 value ) class GRead tag => ReadTag tag where readTaggedPrec :: tag a -> Int -> ReadS a instance Read a => ReadTag ((:=) a) where readTaggedPrec Refl = readsPrec -- This instance is questionable. It works, but is partial (and is also pretty useless) -- instance Read a => ReadTag (GOrdering a) where -- readTaggedPrec GEQ = readsPrec -- readTaggedPrec tag = \p -> readParen (p>10) $ \s -> -- [ (error msg, rest') -- | let (con, rest) = splitAt 6 s -- , con == "error " -- , (msg, rest') <- reads rest :: [(String, String)] -- ] instance ReadTag tag => Read (DSum tag) where readsPrec p = readParen (p > 1) $ \s -> concat [ withTag $ \tag -> [ (tag :=> val, rest'') | (val, rest'') <- readTaggedPrec tag 1 rest' ] | (withTag, rest) <- greadsPrec p s , let (con, rest') = splitAt 5 rest , con == " :=> " ] -- |In order to test @DSum tag@ for equality, @tag@ must know how to test -- both itself and its tagged values for equality. 'EqTag' defines -- the interface by which they are expected to do so. -- -- Continuing the @Tag@ example from the 'DSum' section, we can define: -- -- > instance GEq Tag where -- > geq AString AString = Just Refl -- > geq AString AnInt = Nothing -- > geq AnInt AString = Nothing -- > geq AnInt AnInt = Just Refl -- > instance EqTag Tag where -- > eqTagged AString AString = (==) -- > eqTagged AnInt AnInt = (==) -- -- Note that 'eqTagged' is not called until after the tags have been -- compared, so it only needs to consider the cases where 'gcompare' returns 'GEQ'. class GEq tag => EqTag tag where -- |Given two values of type @tag a@ (for which 'gcompare' returns 'GEQ'), -- return the '==' function for the type @a@. eqTagged :: tag a -> tag a -> a -> a -> Bool instance Eq a => EqTag ((:=) a) where eqTagged Refl Refl = (==) instance EqTag tag => Eq (DSum tag) where (t1 :=> x1) == (t2 :=> x2) = fromMaybe False $ do Refl <- geq t1 t2 return (eqTagged t1 t2 x1 x2) -- |In order to compare @DSum tag@ values, @tag@ must know how to compare -- both itself and its tagged values. 'OrdTag' defines the -- interface by which they are expected to do so. -- -- Continuing the @Tag@ example from the 'EqTag' section, we can define: -- -- > instance GCompare Tag where -- > gcompare AString AString = GEQ -- > gcompare AString AnInt = GLT -- > gcompare AnInt AString = GGT -- > gcompare AnInt AnInt = GEQ -- > instance OrdTag Tag where -- > compareTagged AString AString = compare -- > compareTagged AnInt AnInt = compare -- -- As with 'eqTagged', 'compareTagged' only needs to consider cases where -- 'gcompare' returns 'GEQ'. class (EqTag tag, GCompare tag) => OrdTag tag where -- |Given two values of type @tag a@ (for which 'gcompare' returns 'GEQ'), -- return the 'compare' function for the type @a@. compareTagged :: tag a -> tag a -> a -> a -> Ordering instance Ord a => OrdTag ((:=) a) where compareTagged Refl Refl = compare instance OrdTag tag => Ord (DSum tag) where compare (t1 :=> x1) (t2 :=> x2) = case gcompare t1 t2 of GLT -> LT GGT -> GT GEQ -> compareTagged t1 t2 x1 x2dependent-sum-0.2.0.1/src/Data/Dependent/Sum.hs-boot0000644000000000000000000000022111620514053020205 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification, TypeOperators #-} module Data.Dependent.Sum where data DSum tag = forall a. !(tag a) :=> a infixr 1 :=> dependent-sum-0.2.0.1/src/Data/Dependent/Sum/0000755000000000000000000000000011620514053016715 5ustar0000000000000000dependent-sum-0.2.0.1/src/Data/Dependent/Sum/Typeable.hs0000644000000000000000000000163111620514053021017 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- |Separate module for Typeable declaration, to minimize the amount of -- visual inspection required to determine that this package is "safe" module Data.Dependent.Sum.Typeable where import {-# SOURCE #-} Data.Dependent.Sum import Data.Typeable #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 instance Typeable1 t => Typeable (DSum t) where typeOf ds = mkTyConApp dSumCon [typeOfT] where dSumCon = mkTyCon3 "dependent-sum" "Data.Dependent.Sum" "DSum" typeOfT = typeOf1 $ (undefined :: DSum f -> f a) ds #else instance Typeable1 t => Typeable (DSum t) where typeOf ds = mkTyConApp dSumCon [typeOfT] where dSumCon = mkTyCon "Data.Dependent.Sum.DSum" typeOfT = typeOf1 $ (undefined :: DSum f -> f a) ds #endifdependent-sum-0.2.0.1/src/Data/GADT/0000755000000000000000000000000011620514053014762 5ustar0000000000000000dependent-sum-0.2.0.1/src/Data/GADT/Compare.hs0000644000000000000000000001164211620514053016710 0ustar0000000000000000{-# LANGUAGE GADTs, TypeOperators, RankNTypes, TypeFamilies, FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-warn-deprecated-flags #-} {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} #endif module Data.GADT.Compare where import Data.Maybe import Data.GADT.Show import Data.Typeable -- |A GADT witnessing equality of two types. Its only inhabitant is 'Refl'. data a := b where Refl :: a := a deriving Typeable instance Eq (a := b) where Refl == Refl = True instance Ord (a := b) where compare Refl Refl = EQ instance Show (a := b) where showsPrec _ Refl = showString "Refl" instance GShow ((:=) a) where gshowsPrec _ Refl = showString "Refl" instance Read (a := a) where readsPrec _ s = case con of "Refl" -> [(Refl, rest)] _ -> [] where (con,rest) = splitAt 4 s instance GRead ((:=) a) where greadsPrec p s = readsPrec p s >>= f where f :: (x := x, String) -> [(forall b. (forall a. x := a -> b) -> b, String)] f (Refl, rest) = return (\x -> x Refl, rest) -- |A class for type-contexts which contain enough information -- to (at least in some cases) decide the equality of types -- occurring within them. class GEq f where -- |Produce a witness of type-equality, if one exists. -- -- A handy idiom for using this would be to pattern-bind in the Maybe monad, eg.: -- -- > extract :: GEq tag => tag a -> DSum tag -> Maybe a -- > extract t1 (t2 :=> x) = do -- > Refl <- geq t1 t2 -- > return x -- -- Or in a list comprehension: -- -- > extractMany :: GEq tag => tag a -> [DSum tag] -> [a] -- > extractMany t1 things = [ x | (t2 :=> x) <- things, Refl <- maybeToList (geq t1 t2)] -- -- (Making use of the 'DSum' type from "Data.Dependent.Sum" in both examples) geq :: f a -> f b -> Maybe (a := b) -- |If 'f' has a 'GEq' instance, this function makes a suitable default -- implementation of '(==)'. defaultEq :: GEq f => f a -> f b -> Bool defaultEq x y = isJust (geq x y) -- |If 'f' has a 'GEq' instance, this function makes a suitable default -- implementation of '(/=)'. defaultNeq :: GEq f => f a -> f b -> Bool defaultNeq x y = isNothing (geq x y) instance GEq ((:=) a) where geq Refl Refl = Just Refl -- This instance seems nice, but it's simply not right: -- -- > instance GEq StableName where -- > geq sn1 sn2 -- > | sn1 == unsafeCoerce sn2 -- > = Just (unsafeCoerce Refl) -- > | otherwise = Nothing -- -- Proof: -- -- > x <- makeStableName id :: IO (StableName (Int -> Int)) -- > y <- makeStableName id :: IO (StableName ((Int -> Int) -> Int -> Int)) -- > -- > let Just boom = geq x y -- > let coerce :: (a := b) -> a -> b; coerce Refl = id -- > -- > coerce boom (const 0) id 0 -- > let "Illegal Instruction" = "QED." -- -- The core of the problem is that 'makeStableName' only knows the closure -- it is passed to, not any type information. Together with the fact that -- the same closure has the same StableName each time 'makeStableName' is -- called on it, there is serious potential for abuse when a closure can -- be given many incompatible types. -- |A type for the result of comparing GADT constructors; the type parameters -- of the GADT values being compared are included so that in the case where -- they are equal their parameter types can be unified. data GOrdering a b where GLT :: GOrdering a b GEQ :: GOrdering t t GGT :: GOrdering a b deriving Typeable -- |TODO: Think of a better name -- -- This operation forgets the phantom types of a 'GOrdering' value. weakenOrdering :: GOrdering a b -> Ordering weakenOrdering GLT = LT weakenOrdering GEQ = EQ weakenOrdering GGT = GT instance Eq (GOrdering a b) where x == y = weakenOrdering x == weakenOrdering y instance Ord (GOrdering a b) where compare x y = compare (weakenOrdering x) (weakenOrdering y) instance Show (GOrdering a b) where showsPrec _ GGT = showString "GGT" showsPrec _ GEQ = showString "GEQ" showsPrec _ GLT = showString "GLT" instance GShow (GOrdering a) where gshowsPrec = showsPrec instance GRead (GOrdering a) where greadsPrec _ s = case con of "GGT" -> [(\x -> x GGT, rest)] "GEQ" -> [(\x -> x GEQ, rest)] "GLT" -> [(\x -> x GLT, rest)] _ -> [] where (con, rest) = splitAt 3 s -- |Type class for orderable GADT-like structures. When 2 things are equal, -- must return a witness that their parameter types are equal as well (GEQ). -- |Type class for comparable GADT-like structures. When 2 things are equal, -- must return a witness that their parameter types are equal as well ('GEQ'). class GEq f => GCompare f where gcompare :: f a -> f b -> GOrdering a b instance GCompare ((:=) a) where gcompare Refl Refl = GEQ dependent-sum-0.2.0.1/src/Data/GADT/Show.hs0000644000000000000000000000140011620514053016231 0ustar0000000000000000{-# LANGUAGE RankNTypes, ImpredicativeTypes #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} #endif module Data.GADT.Show where -- |'Show'-like class for 1-type-parameter GADTs class GShow t where gshowsPrec :: Int -> t a -> ShowS gshows :: GShow t => t a -> ShowS gshows = gshowsPrec (-1) gshow :: (GShow t) => t a -> String gshow x = gshows x "" type GReadS t = String -> [(forall b. (forall a. t a -> b) -> b, String)] class GRead t where greadsPrec :: Int -> GReadS t greads :: GRead t => GReadS t greads = greadsPrec (-1) gread :: GRead t => String -> (forall a. t a -> b) -> b gread s = hd [f | (f, "") <- greads s] where hd (x:_) = x hd _ = error "gread: no parse"