compiler/ilxGen/tests/test12.hs

   1 class  NewFunctor f  where
   2     new_fmap         :: (a -> b) -> f a -> f b
   3
   4 data N a = Z a | S (N a)
   5
   6 nmap f (Z x) = Z (f x)
   7 nmap f (S n) = S (nmap f n)
   8
   9 tag (Z x) = x
  10 tag (S n) = tag n
  11
  12 instance NewFunctor N where
  13     new_fmap = nmap
  14
  15 --class  Strange f  where
  16 --    zero         :: a -> f a
  17 --    suc         :: f a -> f a
  18 --    tag         :: f a -> a
  19
  20
  21 --class  FMonad m  where
  22 --    (>>=)       :: m a -> (a -> m b) -> m b
  23 --    (>>)        :: m a -> m b -> m b
  24 --    return      :: a -> m a
  25 --    fail      :: String -> m a
  26 --
  27 --    m >> k      =  m >>= \_ -> k
  28 --    fail s      = error s
  29
  30
  31
  32
  33 --instance Strange N
  34 --  where
  35 --   zero x = Z x
  36 --   suc y = S y
  37 --   tag n = gettag n
  38
  39 twice :: NewFunctor f => (a -> a) -> f a -> f a
  40 twice f x = new_fmap f (new_fmap f x)
  41
  42 main = putStr (tag (nmap (\x -> x) (Z "hello world\n")))
  43 --main = putStr (tag (nmap (\x -> x) (Z "hello world\n")))
  44 -- main = putStr (tag {- (twice (\x -> x) -}  (Z "hello world\n"))