ghc/tests/specialise/code001/Spec.hs

   1 module Spec (
   2
   3         Tree(..),
   4
   5         tree1, tree2, tree3,
   6
   7         lookup
   8
   9     ) where
  10
  11 data Tree k a = Leaf k a
  12               | Branch k (Tree k a) (Tree k a)
  13
  14 lookup eq lt k def (Leaf k1 v1)
  15   = if eq k k1 then v1 else def
  16 lookup eq lt k def (Branch k1 t1 t2)
  17   = if lt k k1 then lookup eq lt k def t1
  18                else lookup eq lt k def t2
  19
  20 -- Versions of Tree:
  21 -- SPEC Tree Int# Float#
  22 -- SPEC Tree Char# a
  23 -- use  Tree Int# Int#,
  24 -- use  Tree a Int#,
  25 -- use  Tree Char# a      (already requested)
  26 -- use  Tree Char# Char#  (via lookup SPEC)
  27
  28 -- Versions of lookup:
  29 -- SPEC lookup Char# Char# Char#
  30 -- SPEC lookup Char# Char# a
  31 -- use  lookup Int# Int# Int#
  32
  33 {-# SPECIALISE data Tree Int# Float# #-}
  34 {-# SPECIALISE data Tree Char# a #-}
  35
  36 {-# SPECIALISE lookup :: (Char#->Char#->Bool) -> (Char#->Char#->Bool)
  37                       -> Char# -> Char# -> Tree Char# Char# -> Char# #-}
  38 {-# SPECIALISE lookup :: (Char#->Char#->Bool) -> (Char#->Char#->Bool)
  39                       -> Char# -> a -> Tree Char# a -> a #-}
  40
  41 tree1   = case (lookup eqInt# ltInt# 1# 1# (Leaf 1# 1#)) of i# -> I# i#
  42 tree2 k = Leaf k  1#
  43 tree3 a = case 'k' of C# k# -> Leaf k# a
  44
  45 {- These should cause errors -}
  46
  47 {- *** # SPECIALISE data Tree Char# a #-}       -- duplicate
  48 {- *** # SPECIALISE data Tree Char# Int #-}     -- boxed type
  49 {- *** # SPECIALISE data Tree a b #-}           -- no spec
  50
  51