Ticket #7837: Rule.hs

File Rule.hs, 958 bytes (added by akio, 23 months ago)
Line 
1{-# LANGUAGE TypeFamilies #-}
2
3  -- needed for the workaround below
4{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
5
6module Rule where
7
8type family Scalar a
9class Fractional (Scalar a) => Norm a where
10  norm :: a -> Scalar a
11
12type instance Scalar Double = Double
13instance Norm Double where norm = abs
14
15normalize :: (Norm a, a ~ Scalar a) => a -> a
16normalize x = x / norm x
17{-# NOINLINE normalize #-}
18
19normalize_Double :: Double -> Double
20normalize_Double = signum
21{-# NOINLINE normalize_Double #-}
22
23-- This rule doesn't fire.
24{-# RULES "normalize/Double" normalize = normalize_Double #-}
25
26-- You can work around the issue by using a type class that wraps equality
27-- constraints.
28
29class a ~ b => TypeEq a b
30instance a ~ b => TypeEq a b
31
32normalize' :: (Norm a, TypeEq a (Scalar a)) => a -> a
33normalize' x = x / norm x
34{-# NOINLINE normalize' #-}
35
36-- This rule fires.
37{-# RULES "normalize'/Double" normalize' = normalize_Double #-}