tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/TypeClassBug2.scl

   1 data Foo1 a = Foo1 a
   2 data Foo2 a = Foo2 a
   3
   4 foo1 :: Foo1 a -> a
   5 foo1 (Foo1 x) = x
   6
   7 foo2 :: Foo2 a -> a
   8 foo2 (Foo2 x) = x
   9
  10 class Makeable s where
  11     make :: a -> s a
  12
  13 instance Makeable Foo1 where
  14     make = Foo1
  15
  16 instance Makeable Foo2 where
  17     make = Foo2
  18
  19 class (Makeable f) => Foo f where
  20     foo :: f a -> a
  21
  22 class (Makeable b) => Bar b where
  23     bar :: b a -> a
  24
  25 class (Makeable b) => Baz b where
  26     baz :: b a -> a
  27
  28 class (Makeable b) => Bim b where
  29     bim :: b a -> a
  30
  31 instance Foo Foo1 where
  32     foo = foo1
  33
  34 instance Bar Foo2 where
  35     bar = foo2
  36
  37 instance (Bar b) => Baz b where
  38     baz = bar
  39
  40 instance Bim Foo1 where
  41     bim = foo1
  42
  43 instance (Baz b) => Bim b where
  44     bim = baz
  45
  46 doFoo1 (Foo1 x) = x
  47 doFoo2 (Foo2 x) = x
  48
  49 useBim :: Bim b => (forall a. b a -> a) -> a -> [a]
  50 useBim doit x = [doit (make x), bim (make x :: Foo1 a)]
  51
  52 main = "OK"
  53 --
  54 "OK"