Skip to content

Commit f5b8472

Browse files
epostmarcosh
authored andcommitted
Reimplement EQ as a specialisation of underlying newtype EQF a = EQ (a, a). #148
1 parent 8c543f2 commit f5b8472

File tree

4 files changed

+14
-9
lines changed

4 files changed

+14
-9
lines changed

src/Language/CQL/Collage.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ import Data.Map.Strict as Map hiding (foldr, size)
4646
import Data.Set as Set hiding (foldr, size)
4747
import Data.Void
4848
import Language.CQL.Common
49-
import Language.CQL.Term (Ctx, EQ(..), Head(..), Term(..), occsTerm, upp)
49+
import Language.CQL.Term (Ctx, EQ, EQF(..), Head(..), Term(..), occsTerm, upp)
5050
import qualified Language.CQL.Term as T (simplifyTheory)
5151
import Prelude hiding (EQ)
5252

src/Language/CQL/Instance/Algebra.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,7 @@ import qualified Data.Set as Set
4949
import Data.Void
5050
import Language.CQL.Common (intercalate, mapl, section, MultiTyMap, TyMap, type (+))
5151
import Language.CQL.Schema as Schema
52-
import Language.CQL.Term (EQ(..), Head(HSk), Term(..), subst, upp, replaceRepeatedly, simplifyTheory)
52+
import Language.CQL.Term (EQ, Head(HSk), Term(..), subst, upp, replaceRepeatedly, simplifyTheory)
5353
import Language.CQL.Typeside as Typeside
5454
import Prelude hiding (EQ)
5555
import qualified Text.Tabular as T

src/Language/CQL/Morphism.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ import Data.Set as Set hiding (foldr, size)
4646
import Data.Void
4747
import Language.CQL.Collage (Collage(..))
4848
import Language.CQL.Common
49-
import Language.CQL.Term (Ctx, Term(..), EQ(..), subst, upp)
49+
import Language.CQL.Term (Ctx, Term(..), EQ, EQF(..), subst, upp)
5050
import Prelude hiding (EQ)
5151

5252
-- | A morphism between 'Collage's.

src/Language/CQL/Term.hs

+11-6
Original file line numberDiff line numberDiff line change
@@ -382,13 +382,18 @@ type Theory var ty sym en fk att gen sk = Set (Ctx var (ty+en), EQ var ty sym en
382382
-- TODO wrap Map class to throw an error (or do something less ad hoc) if a key is ever put twice
383383
type Ctx k v = Map k v
384384

385-
-- Our own pair type for pretty printing purposes
386-
-- | This type indicates that the two terms are equal.
387-
newtype EQ var ty sym en fk att gen sk
388-
= EQ (Term var ty sym en fk att gen sk, Term var ty sym en fk att gen sk) deriving (Ord, Eq)
385+
-- | A value of this type means the lhs and rhs are equal.
386+
-- One reason for its existence is to allow pretty-printing.
387+
type EQ var ty sym en fk att gen sk = EQF (Term var ty sym en fk att gen sk)
389388

390-
instance TyMap Show '[var, ty, sym, en, fk, att, gen, sk] => Show (EQ var ty sym en fk att gen sk) where
391-
show (EQ (lhs,rhs)) = show lhs ++ " = " ++ show rhs
389+
newtype EQF a = EQ (a, a)
390+
391+
instance (Show a) => Show (EQF a) where
392+
show (EQ (lhs, rhs)) = show lhs ++ " = " ++ show rhs
393+
394+
deriving instance (Ord a) => Ord (EQF a)
395+
396+
deriving instance (Eq a) => Eq (EQF a)
392397

393398
deriving instance TyMap Eq '[var, sym, fk, att, gen, sk] => Eq (Term var ty sym en fk att gen sk)
394399

0 commit comments

Comments
 (0)