@@ -0,0 +1,73 @@
1+{-# LANGUAGE MagicHash #-}
2+
3+{-# RULES
4+"map/map" forall f g xs. map f (map g xs) = map (f.g) xs
5+"map/append" forall f xs ys. map f (xs ++ ys) = map f xs ++ map f ys
6+ #-}
7+
8+{-# RULES
9+"fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) .
10+ foldr k z (build g) = g k z
11+
12+"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
13+ foldr k z (augment g xs) = g k (foldr k z xs)
14+
15+"foldr/id" foldr (:) [] = \x -> x
16+"foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys
17+ -- Only activate this from phase 1, because that's
18+ -- when we disable the rule that expands (++) into foldr
19+
20+-- The foldr/cons rule looks nice, but it can give disastrously
21+-- bloated code when commpiling
22+-- array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
23+-- i.e. when there are very very long literal lists
24+-- So I've disabled it for now. We could have special cases
25+-- for short lists, I suppose.
26+-- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
27+
28+"foldr/single" forall k z x. foldr k z [x] = k x z
29+"foldr/nil" forall k z. foldr k z [] = z
30+
31+"augment/build" forall (g::forall b. (a->b->b) -> b -> b)
32+ (h::forall b. (a->b->b) -> b -> b) .
33+ augment g (build h) = build (\c n -> g c (h c n))
34+"augment/nil" forall (g::forall b. (a->b->b) -> b -> b) .
35+ augment g [] = build g
36+ #-}
37+
38+{-# RULES
39+"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)
40+"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f
41+"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g)
42+ #-}
43+
44+{-# RULES
45+ "map/map" [~2] forall f g xs.
46+ map f (map g xs) = map (f.g) xs; "f" op True y = False;
47+ "g" op True y = False
48+#-}
49+
50+{-# RULES
51+"x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
52+"x# `neChar#` x#" forall x#. x# `neChar#` x# = False
53+"x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
54+"x# `geChar#` x#" forall x#. x# `geChar#` x# = True
55+"x# `leChar#` x#" forall x#. x# `leChar#` x# = True
56+"x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
57+ #-}
58+
59+{-# RULES
60+"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
61+"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a
62+"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n
63+
64+-- There's a built-in rule (in PrelRules.lhs) for
65+-- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n
66+
67+ #-}
68+
69+{-# RULES
70+ "foldr/build"
71+ forall f n (g :: forall b. (a -> b -> b) -> b -> b).
72+ foldr f n (build g) = g f n
73+#-}