c2dd159 · ormolu · git.iko.soy

data/examples/declaration/rewrite-rule/basic-out.hsnew file+29

compare with master

unifiedsplit

@@ -0,0 +1,29 @@

1+{-# RULES

2+"fold/build" foldr k z (build g) = g k z

3+ #-}

4+

5+{-# RULES

6+"fusable/aux"

7+ fusable x (aux y) =

8+ faux x y

9+ #-}

10+

11+{-# RULES

12+"map/map"

13+ map f

14+ (map g xs) =

15+ map

16+ (f . g)

17+ xs

18+ #-}

19+

20+{-# RULES

21+"++" xs ++ ys = augment (\c n -> foldr c n xs) ys

22+"concat" xs `concat` ys = augment (\c n -> foldr c n xs) ys

23+ #-}

24+

25+{-# RULES

26+"++" xs ++ ys = augment (\c n -> foldr c n xs) ys

27+"concat" xs `concat` ys = augment (\c n -> foldr c n xs) ys

28+"map/Double" fmap f xs = foldr (++) f xs

29+ #-}

data/examples/declaration/rewrite-rule/basic.hsnew file+27

@@ -0,0 +1,27 @@

1+{-# RULES

2+"fold/build" foldr k z (build g) = g k z

3+ #-}

4+

5+{-# RULES

6+"fusable/aux"

7+ fusable x (aux y) = faux x y

8+ #-}

9+

10+{-# RULES

11+"map/map"

12+ map f

13+ (map g xs) = map

14+ (f . g)

15+ xs

16+ #-}

17+

18+{-# RULES

19+"++" xs ++ ys = augment (\c n -> foldr c n xs) ys

20+"concat" xs `concat` ys = augment (\c n -> foldr c n xs) ys

21+ #-}

22+

23+{-# RULES

24+"++" xs ++ ys = augment (\c n -> foldr c n xs) ys;

25+"concat" xs `concat` ys = augment (\c n -> foldr c n xs) ys;

26+"map/Double" fmap f xs = foldr (++) f xs

27+ #-}

data/examples/declaration/rewrite-rule/empty-out.hsnew file+3

@@ -0,0 +1,3 @@

1+{-# RULES

2+

3+ #-}

data/examples/declaration/rewrite-rule/empty.hsnew file+2

@@ -0,0 +1,2 @@

1+{-# RULES

2+ #-}

data/examples/declaration/rewrite-rule/forall-out.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# RULES

2+"fold/build" forall k z. foldr k z (build g) = g k z

3+ #-}

4+

5+{-# RULES

6+"fusable/aux" forall x y.

7+ fusable x (aux y) =

8+ faux x y

9+ #-}

data/examples/declaration/rewrite-rule/forall.hsnew file+8

@@ -0,0 +1,8 @@

1+{-# RULES

2+"fold/build" forall k z . foldr k z (build g) = g k z

3+ #-}

4+

5+{-# RULES

6+"fusable/aux" forall x y.

7+ fusable x (aux y) = faux x y

8+ #-}

data/examples/declaration/rewrite-rule/phase-out.hsnew file+21

@@ -0,0 +1,21 @@

1+{-# RULES

2+"map/map" [2]

3+ map f

4+ (map g xs) =

5+ map

6+ (f . g)

7+ xs

8+ #-}

9+

10+{-# RULES

11+"map/map" [1] forall x y z.

12+ map f

13+ (map g xs) =

14+ map

15+ (f . g)

16+ xs

17+ #-}

18+

19+{-# RULES

20+"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys

21+ #-}

data/examples/declaration/rewrite-rule/phase.hsnew file+19

@@ -0,0 +1,19 @@

1+{-# RULES

2+"map/map" [2]

3+ map f

4+ (map g xs) = map

5+ (f . g)

6+ xs

7+ #-}

8+

9+{-# RULES

10+"map/map" [1] forall x y z.

11+ map f

12+ (map g xs) = map

13+ (f . g)

14+ xs

15+ #-}

16+

17+{-# RULES

18+"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys

19+ #-}

data/examples/declaration/rewrite-rule/prelude-out.hsnew file+74

@@ -0,0 +1,74 @@

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) =

11+ g k z

12+"foldr/augment" forall k z xs (g :: forall b. (a -> b -> b) -> b -> b).

13+ foldr k z (augment g xs) =

14+ g k (foldr k z xs)

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+"foldr/single" forall k z x. foldr k z [x] = k x z

28+"foldr/nil" forall k z. foldr k z [] = z

29+"augment/build" forall

30+ (g :: forall b. (a -> b -> b) -> b -> b)

31+ (h :: forall b. (a -> b -> b) -> b -> b).

32+ augment g (build h) =

33+ build (\c n -> g c (h c n))

34+"augment/nil" forall (g :: forall b. (a -> b -> b) -> b -> b).

35+ augment g [] =

36+ build g

37+ #-}

38+

39+{-# RULES

40+"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)

41+"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f

42+"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f . g)

43+ #-}

44+

45+{-# RULES

46+"map/map" [~2] forall f g xs.

47+ map f (map g xs) =

48+ map (f . g) xs

49+"f" op True y = False

50+"g" op True y = False

51+ #-}

52+

53+{-# RULES

54+"x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True

55+"x# `neChar#` x#" forall x#. x# `neChar#` x# = False

56+"x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False

57+"x# `geChar#` x#" forall x#. x# `geChar#` x# = True

58+"x# `leChar#` x#" forall x#. x# `leChar#` x# = True

59+"x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False

60+ #-}

61+

62+{-# RULES

63+"unpack" [~1] forall a. unpackCString# a = build (unpackFoldrCString# a)

64+"unpack-list" [1] forall a. unpackFoldrCString# a (:) [] = unpackCString# a

65+"unpack-append" forall a n. unpackFoldrCString# a (:) n = unpackAppendCString# a n

66+ #-}

67+

68+-- There's a built-in rule (in PrelRules.lhs) for

69+-- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n

70+{-# RULES

71+"foldr/build" forall f n (g :: forall b. (a -> b -> b) -> b -> b).

72+ foldr f n (build g) =

73+ g f n

74+ #-}

data/examples/declaration/rewrite-rule/prelude.hsnew file+73

@@ -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+#-}

data/examples/declaration/rewrite-rule/type-signature-out.hsnew file+16

@@ -0,0 +1,16 @@

1+{-# RULES

2+"fold/build" forall k z (g :: forall b. (a -> b -> b) -> b -> b). foldr k z (build g) = g k z

3+ #-}

4+

5+{-# RULES

6+"fold/build" forall

7+ k

8+ z

9+ ( g

10+ :: forall b. (a -> b -> b)

11+ -> b

12+ -> b

13+ ).

14+ foldr k z (build g) =

15+ g k z

16+ #-}

data/examples/declaration/rewrite-rule/type-signature.hsnew file+12

@@ -0,0 +1,12 @@

1+{-# RULES

2+"fold/build" forall k z (g :: forall b. (a -> b -> b) -> b -> b). foldr k z (build g) = g k z

3+ #-}

4+

5+{-# RULES

6+"fold/build"

7+ forall k z

8+ (g :: forall b.

9+ (a -> b -> b) -> b -> b).

10+ foldr k z (build g) =

11+ g k z

12+ #-}

ormolu.cabal+1

@@ -70,6 +70,7 @@ library

70 , Ormolu.Printer.Meat.Declaration.Foreign

71 , Ormolu.Printer.Meat.Declaration.Instance

72 , Ormolu.Printer.Meat.Declaration.RoleAnnotation

73+ , Ormolu.Printer.Meat.Declaration.Rule

73 , Ormolu.Printer.Meat.Declaration.Signature

74 , Ormolu.Printer.Meat.Declaration.Signature

74 , Ormolu.Printer.Meat.Declaration.Splice

75 , Ormolu.Printer.Meat.Declaration.Splice

75 , Ormolu.Printer.Meat.Declaration.Type

76 , Ormolu.Printer.Meat.Declaration.Type

src/Ormolu/Printer/Combinators.hs+1−1

@@ -296,7 +296,7 @@ pragma

296pragma pragmaText body = pragmaBraces $ do

297 txt pragmaText

298 breakpoint

299− inci body

299+ body

300

301-- | Surround given entity by optional space before and a newline after, iff

302-- current layout is multiline.

src/Ormolu/Printer/Meat/Declaration.hs+2−1

@@ -22,6 +22,7 @@ import Ormolu.Printer.Meat.Declaration.Default

22import Ormolu.Printer.Meat.Declaration.Foreign

23import Ormolu.Printer.Meat.Declaration.Instance

24import Ormolu.Printer.Meat.Declaration.RoleAnnotation

25+import Ormolu.Printer.Meat.Declaration.Rule

25import Ormolu.Printer.Meat.Declaration.Signature

26import Ormolu.Printer.Meat.Declaration.Signature

26import Ormolu.Printer.Meat.Declaration.Splice

27import Ormolu.Printer.Meat.Declaration.Splice

27import Ormolu.Printer.Meat.Declaration.Type

28import Ormolu.Printer.Meat.Declaration.Type

@@ -54,7 +55,7 @@ p_hsDecl style = \case

54 ForD NoExt x -> p_foreignDecl x

55 ForD NoExt x -> p_foreignDecl x

55 WarningD NoExt x -> p_warnDecls x

56 WarningD NoExt x -> p_warnDecls x

56 AnnD NoExt x -> p_annDecl x

57 AnnD NoExt x -> p_annDecl x

57− RuleD _ _ -> notImplemented "RuleD"

58+ RuleD NoExt x -> p_ruleDecls x

58 SpliceD NoExt x -> p_spliceDecl x

59 SpliceD NoExt x -> p_spliceDecl x

59 DocD _ _ -> notImplemented "DocD"

60 DocD _ _ -> notImplemented "DocD"

60 RoleAnnotD NoExt x -> p_roleAnnot x

61 RoleAnnotD NoExt x -> p_roleAnnot x

src/Ormolu/Printer/Meat/Declaration/Annotation.hs+1−1

@@ -14,7 +14,7 @@ import Ormolu.Utils

14

15p_annDecl :: AnnDecl GhcPs -> R ()

16p_annDecl = \case

17− HsAnnotation NoExt _ annProv expr -> line . pragma "ANN" $ do

17+ HsAnnotation NoExt _ annProv expr -> line . pragma "ANN" . inci $ do

18 p_annProv annProv

19 breakpoint

20 located expr p_hsExpr

src/Ormolu/Printer/Meat/Declaration/Rule.hsnew file+68

@@ -0,0 +1,68 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE RecordWildCards #-}

4+

5+module Ormolu.Printer.Meat.Declaration.Rule

6+ ( p_ruleDecls

7+ )

8+where

9+

10+import BasicTypes

11+import Control.Monad

12+import FastString (unpackFS)

13+import GHC

14+import Ormolu.Printer.Combinators

15+import Ormolu.Printer.Meat.Common

16+import Ormolu.Printer.Meat.Declaration.Signature

17+import Ormolu.Printer.Meat.Declaration.Value

18+import Ormolu.Utils

19+import qualified Data.List.NonEmpty as NE

20+import qualified Data.Text as T

21+

22+p_ruleDecls :: RuleDecls GhcPs -> R ()

23+p_ruleDecls = \case

24+ HsRules NoExt _ xs -> line $ pragma "RULES" $

25+ velt' $ (located' p_ruleDecl) <$> xs

26+ XRuleDecls NoExt -> notImplemented "XRuleDecls"

27+

28+p_ruleDecl :: RuleDecl GhcPs -> R ()

29+p_ruleDecl = \case

30+ HsRule NoExt ruleName activation ruleBndrs lhs rhs -> do

31+ located ruleName p_ruleName

32+ let gotBinders = not (null ruleBndrs)

33+ when (visibleActivation activation || gotBinders) space

34+ p_activation activation

35+ when (visibleActivation activation && gotBinders) space

36+ p_ruleBndrs ruleBndrs

37+ breakpoint

38+ inci $ do

39+ located lhs p_hsExpr

40+ txt " ="

41+ inci $ do

42+ breakpoint

43+ located rhs p_hsExpr

44+ XRuleDecl NoExt -> notImplemented "XRuleDecl"

45+

46+p_ruleName :: (SourceText, RuleName) -> R ()

47+p_ruleName (_, name) = do

48+ txt "\""

49+ txt $ T.pack $ unpackFS $ name

50+ txt "\""

51+

52+p_ruleBndrs :: [LRuleBndr GhcPs] -> R ()

53+p_ruleBndrs bndrs =

54+ forM_ (NE.nonEmpty bndrs) $ \bndrs_ne ->

55+ switchLayout (combineSrcSpans' (getLoc <$> bndrs_ne)) $ do

56+ txt "forall"

57+ breakpoint

58+ inci $ do

59+ velt' (located' p_ruleBndr <$> bndrs)

60+ txt "."

61+

62+p_ruleBndr :: RuleBndr GhcPs -> R ()

63+p_ruleBndr = \case

64+ RuleBndr NoExt x -> p_rdrName x

65+ RuleBndrSig NoExt x hswc -> parens $ do

66+ p_rdrName x

67+ p_typeAscription hswc

68+ XRuleBndr NoExt -> notImplemented "XRuleBndr"

src/Ormolu/Printer/Meat/Declaration/Signature.hs+14−6

@@ -8,6 +8,8 @@ module Ormolu.Printer.Meat.Declaration.Signature

8 ( p_sigDecl

9 , p_sigDecl'

10 , p_typeAscription

11+ , p_activation

12+ , visibleActivation

11 )

13 )

12where

14where

13

15

@@ -106,6 +108,7 @@ p_inlineSig name InlinePragma {..} = pragmaBraces $ do

106 NoUserInline -> notImplemented "NoUserInline"

108 NoUserInline -> notImplemented "NoUserInline"

107 space

109 space

108 p_activation inl_act

110 p_activation inl_act

111+ when (visibleActivation inl_act) space

109 p_rdrName name

112 p_rdrName name

110

113

111p_specSig

114p_specSig

@@ -117,6 +120,7 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do

117 txt "SPECIALIZE"

120 txt "SPECIALIZE"

118 space

121 space

119 p_activation inl_act

122 p_activation inl_act

123+ when (visibleActivation inl_act) space

120 p_rdrName name

124 p_rdrName name

121 breakpoint

125 breakpoint

122 inci $ do

126 inci $ do

@@ -134,15 +138,19 @@ p_activation = \case

134 txt "[~"

138 txt "[~"

135 atom n

139 atom n

136 txt "]"

140 txt "]"

137− space

138 ActiveAfter _ n -> do

141 ActiveAfter _ n -> do

139 txt "["

142 txt "["

140 atom n

143 atom n

141 txt "]"

144 txt "]"

142− space

145+

146+visibleActivation :: Activation -> Bool

147+visibleActivation = \case

148+ NeverActive -> False

149+ AlwaysActive -> False

150+ _ -> True

143

151

144p_specInstSig :: LHsSigType GhcPs -> R ()

152p_specInstSig :: LHsSigType GhcPs -> R ()

145−p_specInstSig hsib = pragma "SPECIALIZE instance" $

153+p_specInstSig hsib = pragma "SPECIALIZE instance" . inci $

146 located (hsib_body hsib) p_hsType

154 located (hsib_body hsib) p_hsType

147

155

148p_minimalSig

156p_minimalSig

@@ -150,7 +158,7 @@ p_minimalSig

150 -> R ()

158 -> R ()

151p_minimalSig =

159p_minimalSig =

152 located' $ \booleanFormula ->

160 located' $ \booleanFormula ->

153− pragma "MINIMAL" (p_booleanFormula booleanFormula)

161+ pragma "MINIMAL" (inci $ p_booleanFormula booleanFormula)

154

162

155p_booleanFormula

163p_booleanFormula

156 :: BooleanFormula (Located RdrName) -- ^ Boolean formula

164 :: BooleanFormula (Located RdrName) -- ^ Boolean formula

@@ -171,7 +179,7 @@ p_completeSig

171 -> R ()

179 -> R ()

172p_completeSig cs' mty =

180p_completeSig cs' mty =

173 located cs' $ \cs ->

181 located cs' $ \cs ->

174− pragma "COMPLETE" $ do

182+ pragma "COMPLETE" . inci $ do

175 velt (withSep comma p_rdrName cs)

183 velt (withSep comma p_rdrName cs)

176 forM_ mty $ \ty -> do

184 forM_ mty $ \ty -> do

177 breakpoint

185 breakpoint

@@ -180,7 +188,7 @@ p_completeSig cs' mty =

180 p_rdrName ty

188 p_rdrName ty

181

189

182p_sccSig :: Located (IdP GhcPs) -> Maybe (Located StringLiteral) -> R ()

190p_sccSig :: Located (IdP GhcPs) -> Maybe (Located StringLiteral) -> R ()

183−p_sccSig loc literal = pragma "SCC" $ do

191+p_sccSig loc literal = pragma "SCC" . inci $ do

184 p_rdrName loc

192 p_rdrName loc

185 forM_ literal $ \x -> do

193 forM_ literal $ \x -> do

186 breakpoint

194 breakpoint

src/Ormolu/Printer/Meat/Declaration/Warning.hs+2−2

@@ -32,13 +32,13 @@ p_moduleWarning wtxt = do

32 let (pragmaText, lits) = warningText wtxt

33 switchLayout (listSpan lits) $ do

34 breakpoint

35− inci $ pragma pragmaText (p_lits lits)

35+ inci $ pragma pragmaText (inci $ p_lits lits)

36

37p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()

38p_topLevelWarning fnames wtxt = do

39 let (pragmaText, lits) = warningText wtxt

40 switchLayout (combineSrcSpans (listSpan fnames) (listSpan lits)) $ do

41− pragma pragmaText $ do

41+ pragma pragmaText . inci $ do

42 velt (withSep comma p_rdrName fnames)

43 breakpoint

44 p_lits lits