Implement specialize pragma

data/examples/declaration/signature/specialize/specialize-out.hs

@@ -0,0 +1,14 @@
+foo :: Num a => a -> a
+foo = id
+{-# SPECIALIZE foo :: Int -> Int #-}
+
+{-# SPECIALIZE [2] bar :: Int -> Int #-}
+bar :: Num a => a -> a
+bar = id
+
+baz :: Num a => a -> a
+baz = id
+{-# SPECIALIZE [~2] baz
+  :: Int
+  -> Int
+  #-}

data/examples/declaration/signature/specialize/specialize.hs

@@ -0,0 +1,15 @@
+foo :: Num a => a -> a
+foo = id
+
+{-# SPECIALIZE foo :: Int -> Int #-}
+
+{-# SPECIALIZE [2] bar :: Int -> Int #-}
+
+bar :: Num a => a -> a
+bar = id
+
+baz :: Num a => a -> a
+baz = id
+{-# SPECIALIZE [~2] baz
+      :: Int
+      -> Int #-}

src/Ormolu/Printer/Meat/Declaration/Signature.hs

@@ -27,6 +27,7 @@ p_sigDecl' = \case
   ClassOpSig NoExt def names hsib -> p_classOpSig def names hsib
   FixSig NoExt sig -> p_fixSig sig
   InlineSig NoExt name inlinePragma -> p_inlineSig name inlinePragma
+  SpecSig NoExt name ts inlinePragma -> p_specSig name ts inlinePragma
   _ -> notImplemented "certain types of signature declarations"
 
 p_typeSig
@@ -76,13 +77,38 @@ p_inlineSig name InlinePragma {..} = pragmaBraces $ do
     NoInline -> "NOINLINE"
     NoUserInline -> notImplemented "NoUserInline"
   space
-  case inl_act of
-    NeverActive -> return ()
-    AlwaysActive -> return ()
-    ActiveBefore _ n -> do
-      brackets (txt "~" >> atom n)
-      space
-    ActiveAfter _ n -> do
-      brackets (atom n)
-      space
+  p_activation inl_act
   p_rdrName name
+
+p_specSig
+  :: Located RdrName            -- ^ Name
+  -> [LHsSigType GhcPs]         -- ^ The types to specialize to
+  -> InlinePragma               -- ^ For specialize inline
+  -> R ()
+p_specSig name ts InlinePragma {..} = pragmaBraces $ do
+  txt "SPECIALIZE"
+  space
+  p_activation inl_act
+  p_rdrName name
+  breakpoint
+  inci $ do
+    txt ":: "
+    -- XXX Not at all sure why ts is a list of @LHsSigType GhcPs@ things, it
+    -- appears that we only can give one type to specialize to per pragma.
+    -- Maybe I'm mistaken.
+    located (hsib_body (head ts)) p_hsType
+
+p_activation :: Activation -> R ()
+p_activation = \case
+  NeverActive -> return ()
+  AlwaysActive -> return ()
+  ActiveBefore _ n -> do
+    txt "[~"
+    atom n
+    txt "]"
+    space
+  ActiveAfter _ n -> do
+    txt "["
+    atom n
+    txt "]"
+    space

src/Ormolu/Printer/Meat/Module.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms   #-}
 {-# LANGUAGE RecordWildCards   #-}
 
 -- | Rendering of modules.
@@ -64,10 +65,18 @@ separatedDecls
   :: HsDecl GhcPs
   -> HsDecl GhcPs
   -> Bool
-separatedDecls (SigD NoExt (TypeSig NoExt (n:_) _)) (ValD NoExt (FunBind NoExt n' _ _ _)) =
-  unL n /= unL n'
-separatedDecls (ValD NoExt (FunBind NoExt n _ _ _)) (SigD NoExt (InlineSig NoExt n' _)) =
-  unL n /= unL n'
-separatedDecls (SigD NoExt (InlineSig NoExt n _)) (SigD NoExt (TypeSig NoExt (n':_) _)) =
-  unL n /= unL n'
+separatedDecls (TypeSignature n) (FunctionBody n') = n /= n'
+separatedDecls (FunctionBody n) (InlinePragma n') = n /= n'
+separatedDecls (InlinePragma n) (TypeSignature n') = n /= n'
+separatedDecls (FunctionBody n) (SpecializePragma n') = n /= n'
+separatedDecls (SpecializePragma n) (TypeSignature n') = n /= n'
 separatedDecls _ _ = True
+
+pattern TypeSignature
+      , FunctionBody
+      , InlinePragma
+      , SpecializePragma :: RdrName -> HsDecl GhcPs
+pattern TypeSignature n <- SigD NoExt (TypeSig NoExt ((L _ n):_) _)
+pattern FunctionBody n <- ValD NoExt (FunBind NoExt (L _ n) _ _ _)
+pattern InlinePragma n <- SigD NoExt (InlineSig NoExt (L _ n) _)
+pattern SpecializePragma n <- SigD NoExt (SpecSig NoExt (L _ n) _ _)