| 1 | == Notes on the implementation of rewrite RULEs in GHC == |
| 2 | |
| 3 | === Looking through lets === |
| 4 | |
| 5 | We recently made the rule-matcher able to "look through" lets, thus |
| 6 | {{{ |
| 7 | RULE f (g x) = rhs |
| 8 | |
| 9 | Expression: f (let v = e in g v) |
| 10 | }}} |
| 11 | The rule will still match, giving |
| 12 | {{{ |
| 13 | let v = e in rhs[v/x] |
| 14 | }}} |
| 15 | |
| 16 | === Dictionaries === |
| 17 | |
| 18 | Suppose we have |
| 19 | {{{ |
| 20 | RULE f (g x) = rhs |
| 21 | |
| 22 | f :: Ord a => a -> a |
| 23 | |
| 24 | foo :: Int -> Int |
| 25 | foo x = f (g x) |
| 26 | }}} |
| 27 | Then we tend to get |
| 28 | {{{ |
| 29 | f_79 :: Int -> Int |
| 30 | f_79 = f Int dOrdInt |
| 31 | |
| 32 | foo :: Int -> Int |
| 33 | foo = \x -> f_79 (g x) |
| 34 | }}} |
| 35 | Lo, the f/g RULE cannot fire. |
| 36 | |
| 37 | Current solution: use {{{-fno-method-sharing}}} to get |
| 38 | {{{ |
| 39 | foo :: Int -> Int |
| 40 | foo = \x -> f Int dOrdInt (g x) |
| 41 | }}} |
| 42 | But we found other examples where this wasn't enough. Code is below. The solution is: use {{{-fdicts-cheap}}}, which makes dictionary construction look really cheap. |
| 43 | |
| 44 | Example of when -fno-method-sharing isn't enough. |
| 45 | {{{ |
| 46 | module Foo where |
| 47 | |
| 48 | data UArr a = UArr [a] |
| 49 | |
| 50 | class UA a where |
| 51 | ua :: [a] -> [a] |
| 52 | |
| 53 | instance UA Int where |
| 54 | ua xs = xs |
| 55 | |
| 56 | class DT a where |
| 57 | foo :: a -> a |
| 58 | bar :: a -> a |
| 59 | |
| 60 | instance DT Int where |
| 61 | foo x = x |
| 62 | bar x = x |
| 63 | |
| 64 | instance (DT a, DT b) => DT (a,b) where |
| 65 | foo x = x |
| 66 | bar x = x |
| 67 | |
| 68 | instance UA a => DT (UArr a) where |
| 69 | foo x = x |
| 70 | bar x = x |
| 71 | |
| 72 | data Dist a = Dist a |
| 73 | |
| 74 | mapD :: (DT a, DT b) => (a -> b) -> Dist a -> Dist b |
| 75 | {-# INLINE [1] mapD #-} |
| 76 | mapD f (Dist x) = Dist (f x) |
| 77 | |
| 78 | zipWithD :: (DT a, DT b, DT c) => (a -> b -> c) -> Dist a -> Dist b -> |
| 79 | Dist c |
| 80 | {-# INLINE zipWithD #-} |
| 81 | zipWithD f (Dist x) (Dist y) = mapD (uncurry f) (Dist (x,y)) |
| 82 | |
| 83 | splitD :: UA a => UArr a -> Dist (UArr a) |
| 84 | {-# INLINE [1] splitD #-} |
| 85 | splitD x = zipWithD const (Dist x) (Dist x) |
| 86 | |
| 87 | joinD :: UA a => Dist (UArr a) -> UArr a |
| 88 | {-# INLINE [1] joinD #-} |
| 89 | joinD (Dist x) = x |
| 90 | |
| 91 | {-# RULES |
| 92 | |
| 93 | "split/join" forall x. |
| 94 | splitD (joinD x) = x |
| 95 | |
| 96 | #-} |
| 97 | |
| 98 | ------ |
| 99 | |
| 100 | module Bar where |
| 101 | |
| 102 | import Foo |
| 103 | |
| 104 | foo :: Dist (UArr Int) -> Dist (UArr Int) |
| 105 | foo = splitD . joinD |
| 106 | |
| 107 | ------ |
| 108 | |
| 109 | Compared to the previous version, the important differences are |
| 110 | |
| 111 | - the class UA and the instance DT (UArr a) which builds a DT |
| 112 | dictionary from an UA one, |
| 113 | - splitD . joinD instead of splitD (joinD x) in foo. |
| 114 | |
| 115 | With this, we get |
| 116 | |
| 117 | ------ |
| 118 | |
| 119 | 15 splitD :: UA a => UArr a -> Dist (UArr a) |
| 120 | {- Arity: 1 HasNoCafRefs Strictness: A Inline: [1] |
| 121 | Unfolding: (__inline_me (\ @ a $dUA :: UA a -> |
| 122 | let { |
| 123 | $dDT :: DT (UArr a) = $f1 @ a $dUA |
| 124 | } in |
| 125 | \ x :: UArr a -> |
| 126 | zipWithD |
| 127 | @ (UArr a) |
| 128 | @ (UArr a) |
| 129 | @ (UArr a) |
| 130 | $dDT |
| 131 | $dDT |
| 132 | $dDT |
| 133 | (GHC.Base.const @ (UArr a) @ (UArr a)) |
| 134 | (Dist @ (UArr a) x) |
| 135 | (Dist @ (UArr a) x))) -} |
| 136 | |
| 137 | ------ |
| 138 | |
| 139 | and the rule doesn't fire. Nor does it with |
| 140 | |
| 141 | foo x = splitD $ joinD x |
| 142 | |
| 143 | But it *does* fire with |
| 144 | |
| 145 | foo x = splitD (joinD x) |
| 146 | |
| 147 | despite the arity of splitD. Very strange... |
| 148 | |
| 149 | Roman |
| 150 | }}} |