Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

standalone deriving

  • Loading branch information...
commit 844de696f282404efeab0b5640c87a4bb40cfc31 1 parent 557a4af
Edward Kmett authored

Showing 1 changed file with 40 additions and 27 deletions. Show diff stats Hide diff stats

  1. +40 27 Data/Constraint.hs
67 Data/Constraint.hs
@@ -8,6 +8,7 @@
8 8 TypeOperators,
9 9 FunctionalDependencies,
10 10 Rank2Types,
  11 + StandaloneDeriving,
11 12 GADTs
12 13 #-}
13 14
@@ -41,24 +42,20 @@ import Data.Complex
41 42 import Data.Ratio
42 43 import Unsafe.Coerce
43 44
  45 +-- | Capture a dictionary for a given constraint
44 46 data Dict :: Constraint -> * where
45 47 Dict :: a => Dict a
46 48
47   -instance Eq (Dict a) where
48   - Dict == Dict = True
49   -
50   -instance Ord (Dict a) where
51   - compare Dict Dict = EQ
52   -
53   -instance Show (Dict a) where
54   - showsPrec _ Dict = showString "Dict"
  49 +deriving instance Eq (Dict a)
  50 +deriving instance Ord (Dict a)
  51 +deriving instance Show (Dict a)
55 52
56 53 infixr 9 :-
57 54 -- entailment
58 55 data (:-) :: Constraint -> Constraint -> * where
59 56 Sub :: (a => Dict b) -> a :- b
60 57
61   -instance Eq (a :- b) where
  58 +instance Eq (a :- b) where
62 59 Sub _ == Sub _ = True
63 60
64 61 instance Ord (a :- b) where
@@ -68,41 +65,60 @@ instance Show (a :- b) where
68 65 showsPrec d (Sub _) = showParen (d > 10) $ showString "Sub Dict"
69 66
70 67 infixl 1 \\ -- required comment
  68 +
  69 +-- | Given that @a :- b@, derive something that needs a context @b@, using the context @a@
71 70 (\\) :: a => (b => r) -> (a :- b) -> r
72 71 r \\ Sub Dict = r
73 72
74   --- due to the hack for the kind of (,) in the compiler we can't actually make (,) a bifunctor!
  73 +-- | due to the hack for the kind of (,) in the current version of GHC we can't actually
  74 +-- make instances for (,) :: Constraint -> Constraint -> Constraint
75 75 (***) :: (a :- b) -> (c :- d) -> (a, c) :- (b, d)
76 76 f *** g = Sub $ Dict \\ f \\ g
77 77
78   --- weakening constraints / constraint product projections
79   -weaken1 :: (a,b) :- a
  78 +-- | Weakening a constraint product
  79 +weaken1 :: (a, b) :- a
80 80 weaken1 = Sub Dict
81 81
82   -weaken2 :: (a,b) :- b
  82 +-- | Weakening a constraint product
  83 +weaken2 :: (a, b) :- b
83 84 weaken2 = Sub Dict
84 85
85   --- contracting constraints / diagonal morphism
  86 +-- | Contracting a constraint / diagonal morphism
86 87 contract :: a :- (a, a)
87 88 contract = Sub Dict
88 89
89   --- constraint product
90   -(&&&) :: (a :- b) -> (a :- c) -> a :- (b,c)
  90 +-- | Constraint product
  91 +--
  92 +-- > trans weaken1 (f &&& g) = f
  93 +-- > trans weaken2 (f &&& g) = g
  94 +(&&&) :: (a :- b) -> (a :- c) -> a :- (b, c)
91 95 f &&& g = Sub $ Dict \\ f \\ g
92 96
93   --- transitivity of entailment
  97 +-- ?
  98 +-- / \
  99 +-- (#) ?? ???
  100 +-- / \ / \
  101 +-- # * Constraint
  102 +
  103 +-- | Transitivity of entailment
  104 +--
  105 +-- If we view '(:-)' as a Constraint-indexed category, then this is '(.)'
94 106 trans :: (b :- c) -> (a :- b) -> a :- c
95 107 trans f g = Sub $ Dict \\ f \\ g
96 108
97   --- reflexivity
  109 +-- | Reflexivity of entailment
  110 +--
  111 +-- If we view '(:-)' as a Constraint-indexed category, then this is 'id'
98 112 refl :: a :- a
99 113 refl = Sub Dict
100 114
101   --- terminal arrows
  115 +-- | Every constraint implies truth
  116 +--
  117 +-- These are the terminal arrows of the category, and () is the terminal object.
102 118 top :: a :- ()
103 119 top = Sub Dict
104 120
105   --- don't do this!
  121 +-- | Don't be evil
106 122 evil :: a :- b
107 123 evil = unsafeCoerce refl
108 124
@@ -116,10 +132,10 @@ class (b :: Constraint) :=> (h :: Constraint) | h -> b where
116 132 instance Class () (Class b a) where cls = Sub Dict
117 133 instance Class () (b :=> a) where cls = Sub Dict
118 134
119   --- bootstrapping
120   -
121 135 #ifdef UNDECIDABLE
  136 +-- | Decidable under GHC HEAD
122 137 instance Class b a => () :=> Class b a where ins = Sub Dict
  138 +-- | Decidable under GHC HEAD
123 139 instance (b :=> a) => () :=> b :=> a where ins = Sub Dict
124 140 #endif
125 141
@@ -299,9 +315,7 @@ instance a => Bounded (Dict a) where
299 315 maxBound = Dict
300 316
301 317 instance a :=> Read (Dict a) where ins = Sub Dict
302   -instance a => Read (Dict a) where
303   - readsPrec d = readParen (d > 10) $ \s ->
304   - [ (Dict, t) | ("Dict", t) <- lex s ]
  318 +deriving instance a => Read (Dict a)
305 319
306 320 instance a :=> Monoid (Dict a) where ins = Sub Dict
307 321 instance a => Monoid (Dict a) where
@@ -315,7 +329,6 @@ applicative m = m \\ trans (evil :: Applicative (WrappedMonad m) :- Applicative
315 329 alternative :: forall m a. MonadPlus m => (Alternative m => m a) -> m a
316 330 alternative m = m \\ trans (evil :: Alternative (WrappedMonad m) :- Alternative m) ins
317 331
318   --- Using applicative sugar given just a monad, no lifting needed
  332 +-- Demonstration of the use of applicative sugar given just a monad, no lifting needed
319 333 (<&>) :: Monad m => m a -> m b -> m (a, b)
320 334 m <&> n = applicative $ (,) <$> m <*> n
321   -

0 comments on commit 844de69

Please sign in to comment.
Something went wrong with that request. Please try again.