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

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