git.iko.soy/ormolu
on master help sign in
Implemented set cost centre pragma
commit430e0a3620e918ad558d5529deb074166e7e679e authorsphaso <sphaso@gmail.com> dateThu 20 Jun 2019, 20:23 (7 years ago) parent5565311
4 files changed+53−6
compare with master
unifiedsplit
data/examples/declaration/signature/set-cost-centre/set-cost-centre-out.hs+14 data/examples/declaration/signature/set-cost-centre/set-cost-centre.hs+16 src/Ormolu/Printer/Meat/Declaration.hs+15−6 src/Ormolu/Printer/Meat/Declaration/Signature.hs+8
data/examples/declaration/signature/set-cost-centre/set-cost-centre-out.hsnew file+14
@@ -0,0 +1,14 @@
1+f x y = g (x + y)
2+ where
3+ g z = z
4+ {-# SCC g #-}
5+{-# SCC f #-}
6+
7+withString x y = x + y
8+{-# SCC withString "cost_centre_name" #-}
9+
10+withString' x y = x + y
11+{-# SCC
12+ withString'
13+ "cost_centre_name"
14+ #-}
data/examples/declaration/signature/set-cost-centre/set-cost-centre.hsnew file+16
@@ -0,0 +1,16 @@
1+f x y = g (x + y)
2+ where
3+ g z = z
4+ {-# SCC g #-}
5+
6+{-# SCC f #-}
7+
8+withString x y = x + y
9+
10+{-# SCC withString "cost_centre_name" #-}
11+
12+withString' x y = x + y
13+
14+{-# SCC withString'
15+ "cost_centre_name"
16+ #-}
src/Ormolu/Printer/Meat/Declaration.hs+15−6
@@ -95,18 +95,27 @@ separatedDecls
9595 -> HsDecl GhcPs
9696 -> Bool
9797separatedDecls (TypeSignature n) (FunctionBody n') = n /= n'
98−separatedDecls (FunctionBody n) (InlinePragma n') = n /= n'
99−separatedDecls (InlinePragma n) (TypeSignature n') = n /= n'
100−separatedDecls (FunctionBody n) (SpecializePragma n') = n /= n'
101−separatedDecls (SpecializePragma n) (TypeSignature n') = n /= n'
102−separatedDecls (SpecializePragma n) (SpecializePragma n') = n /= n'
98+separatedDecls (FunctionBody n) x | Just n' <- isPragma x = n /= n'
99+separatedDecls x y | Just n <- isPragma x, Just n' <- isPragma y = n /= n'
100+separatedDecls x (TypeSignature n') | Just n <- isPragma x = n /= n'
103101separatedDecls _ _ = True
104102
103+isPragma
104+ :: HsDecl GhcPs
105+ -> (Maybe RdrName)
106+isPragma = \case
107+ InlinePragma n -> Just n
108+ SpecializePragma n -> Just n
109+ SCCPragma n -> Just n
110+ _ -> Nothing
111+
105112pattern TypeSignature
106113 , FunctionBody
107114 , InlinePragma
108− , SpecializePragma :: RdrName -> HsDecl GhcPs
115+ , SpecializePragma
116+ , SCCPragma :: RdrName -> HsDecl GhcPs
109117pattern TypeSignature n <- SigD NoExt (TypeSig NoExt ((L _ n):_) _)
110118pattern FunctionBody n <- ValD NoExt (FunBind NoExt (L _ n) _ _ _)
111119pattern InlinePragma n <- SigD NoExt (InlineSig NoExt (L _ n) _)
112120pattern SpecializePragma n <- SigD NoExt (SpecSig NoExt (L _ n) _ _)
121+pattern SCCPragma n <- SigD NoExt (SCCFunSig NoExt _ (L _ n) _)
src/Ormolu/Printer/Meat/Declaration/Signature.hs+8
@@ -33,6 +33,7 @@ p_sigDecl' = \case
3333 SpecSig NoExt name ts inlinePragma -> p_specSig name ts inlinePragma
3434 MinimalSig NoExt _ booleanFormula -> p_minimalSig booleanFormula
3535 CompleteMatchSig NoExt _sourceText cs ty -> p_completeSig cs ty
36+ SCCFunSig NoExt _ name literal -> p_sccSig name literal
3637 _ -> notImplemented "certain types of signature declarations"
3738
3839p_typeSig
@@ -172,3 +173,10 @@ p_completeSig cs' mty =
172173 inci $ do
173174 txt ":: "
174175 p_rdrName ty
176+
177+p_sccSig :: Located (IdP GhcPs) -> Maybe (Located StringLiteral) -> R ()
178+p_sccSig loc literal = pragma "SCC" $ do
179+ p_rdrName loc
180+ forM_ literal $ \x -> do
181+ breakpoint
182+ atom x