Major Overhaul of Pattern Match Checking (Fixes #595)
[ghc.git] / testsuite / tests / gadt / Gadt17_help.hs
1 {-# LANGUAGE GADTs #-}
2 {-# OPTIONS_GHC -O -fno-warn-redundant-constraints #-}
3
4 module Gadt17_help (
5 TernOp (..), applyTernOp
6 ) where
7
8 data TypeWitness a where
9 TWInt :: TypeWitness Int
10 TWBool :: TypeWitness Bool
11 TWFloat :: TypeWitness Float
12 TWDouble :: TypeWitness Double
13
14 instance (Eq a) => Eq (TypeWitness a) where
15 (==) TWInt TWInt = True
16 (==) TWBool TWBool = True
17 (==) TWFloat TWFloat = True
18 (==) TWDouble TWDouble = True
19
20 data TernOp a b c d where
21 OpIf :: TypeWitness a -> TernOp Bool a a a
22 OpTernFunc :: TypeWitness a -> TypeWitness b -> TypeWitness c
23 -> TypeWitness d -> (a -> b -> c -> d) -> TernOp a b c d
24
25 instance Show (TernOp a b c d) where
26 show (OpIf {}) = "OpIf"
27 show (OpTernFunc {}) = "OpTernFunc <function>"
28
29
30 applyTernOp :: TernOp a b c d -> a -> b -> c -> d
31 applyTernOp (OpIf {}) cond x y = if (cond) then x else y
32 applyTernOp (OpTernFunc _ _ _ _ f) x y z = f x y z
33