ghc/interpreter/test/typechecker/t006.hs

   1 --!!! Examples from the Hugs 1.3c documentation
   2
   3 -- Multiparameter type classes
   4 class Collection c a where
   5     empty  :: c a
   6     insert :: a -> c a -> c a
   7     enum   :: c a -> [a]
   8
   9 -- Some instances (not included in docs)
  10 instance Collection [] a where
  11     empty  = []
  12     insert = (:)
  13     enum   = id
  14
  15 -- need a newtype to avoid conflict with [] instance
  16 newtype Set a = MkSet [a]
  17
  18 instance Eq a => Collection Set a where
  19     empty           = MkSet []
  20     insert x s@(MkSet xs)
  21       | x `elem` xs = s\0
  22       | otherwise   = MkSet (x:xs)
  23     enum (MkSet xs) = xs
  24
  25 -- less restrictions on contexts (a few random examples)
  26 data Tree a = Branch [Tree a]
  27             | Leaf a
  28
  29 instance (Eq [Tree a], Eq a) => Eq (Tree a) where
  30   (Branch xs) == (Branch ys) = xs == ys
  31   (Leaf x)    == (Leaf y)    = x == y
  32
  33 instance Eq a => Eq (Bool -> a) where
  34   f == g = all (\x -> f x == g x) [False,True]
  35
  36 instance Num a => Num (String,[a]) where
  37   (s,xs) + (t,ys) = (s++"+"++t,zipWith (+) xs ys)
  38   negate (s,xs)  = ("-"++s, map negate xs)
  39
  40 -- It's ok to give a more restrictive context that the one inferred
  41 f  :: Eq a => [a] -> Bool
  42 f x = x==[]
  43
  44 -- polymorphic recursion
  45 p  :: Eq a => a -> Bool
  46 p x = x==x && p [x]
  47
  48 -- polymorphic mutual recursion
  49 p'  :: Eq a => a -> Bool
  50 p' x = x==x && q' [x]
  51
  52 q' x = x==x && p' [x]
  53
  54 -- Rank 2 polymorphism
  55 amazed :: (forall a. a -> a) -> (Bool,Char)
  56 amazed i = (i True, i 'a')
  57
  58 twice    :: (forall b. b -> f b) -> a -> f (f a)
  59 twice f   = f . f
  60
  61 eg1 = amazed (let i x = x in i)
  62 eg2 = amazed (\x -> x)
  63 eg3 = amazed (id . id . id . id)
  64 eg4 = amazed (id id id id id)
  65
  66 -- Rank 2 polymorphism in data constructors
  67 data Monad1 m = MkMonad1 {
  68                  unit1 :: (forall a. a -> m a),
  69                  bind1 :: (forall a, b. m a -> (a -> m b) -> m b)
  70                 }
  71
  72 data Monad2 m = MkMonad2 (forall a. a -> m a)
  73                          (forall a, b. m a -> (a -> m b) -> m b)
  74
  75 listMonad1 = MkMonad1 {unit1 = \x->[x],
  76                        bind1 = \x f -> concat (map f x)}
  77
  78 listMonad2 = MkMonad2 (\x->[x]) (\x f -> concat (map f x))
  79
  80 listMonad1 :: Monad1 []
  81 listMonad2 :: Monad2 []
  82
  83 eg5 = \(x::Int) -> x                  -- :: Int -> Int
  84 eg6 = \(x::a) (xs::[a]) -> xs ++ [x]  -- :: a -> [a] -> [a].
  85
  86 f' (x::a) = let g   :: a -> [a]
  87                 g y  = [x,y]
  88             in  g x
  89
  90
  91 pair         :: t -> s -> (t,s)
  92 pair x (y::t) = (x,y::t)
  93
  94 data Appl = MkAppl (a -> Int) a (a -> a)
  95
  96 good1 (MkAppl f x i) = f x
  97 good2 (MkAppl f x i) = map f (iterate i x)
  98
  99 -- Using scoped type variables with existentials
 100 good3 (MkAppl f (x::a) i) = map f (iterate i x :: [a])
 101