[Git][ghc/ghc][wip/T24359] fix parsing of expression SPECIALISE INLINE

[sheaf (@sheaf)]

sheaf pushed to branch wip/T24359 at Glasgow Haskell Compiler / GHC


Commits:
d6280b35 by sheaf at 2024-11-29T15:05:56+01:00
fix parsing of expression SPECIALISE INLINE

- - - - -


3 changed files:

- compiler/GHC/Parser.y
- testsuite/tests/th/TH_pragma.hs
- testsuite/tests/th/TH_pragma.stderr


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -2768,15 +2768,18 @@ sigdecl :: { LHsDecl GhcPs }
         | '{-# SPECIALISE' activation rule_foralls infixexp sigtypes_maybe '#-}'
              {% runPV (unECP $4) >>= \ $4 -> do
                 let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
-                                            (NoUserInlinePrag, FunLike)
-                                            (snd $2)
-                spec <- mkSpecSig inl_prag (AnnSpecSig (glR $1) (epTok $6) Nothing (fst $2)) $3 $4 $5
+                                              (NoUserInlinePrag, FunLike)
+                                              (snd $2)
+                spec <- mkSpecSig inl_prag (AnnSpecSig (glR $1) (epTok $6) (fmap fst $5) (fst $2)) $3 $4 $5
                 amsA' $ sLL $1 $> $ SigD noExtField spec }
 
-        | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
-             {% amsA' (sLL $1 $> $ SigD noExtField (SpecSig (AnnSpecSig (glR $1) (epTok $6) (Just $ epUniTok $4) (fst $2)) $3 (fromOL $5)
-                               (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
-                                               (getSPEC_INLINE $1) (snd $2)))) }
+        | '{-# SPECIALISE_INLINE' activation rule_foralls infixexp sigtypes_maybe '#-}'
+             {% runPV (unECP $4) >>= \ $4 -> do
+                let inl_prag = mkInlinePragma (getSPEC_INLINE_PRAGs $1)
+                                              (getSPEC_INLINE $1)
+                                              (snd $2)
+                spec <- mkSpecSig inl_prag (AnnSpecSig (glR $1) (epTok $6) (fmap fst $5) (fst $2)) $3 $4 $5
+                amsA' $ sLL $1 $> $ SigD noExtField spec }
 
         | '{-# SPECIALISE' 'instance' inst_type '#-}'
                 {% amsA' (sLL $1 $> $ SigD noExtField (SpecInstSig ((glR $1,epTok $2,epTok $4), (getSPEC_PRAGs $1)) $3)) }


=====================================
testsuite/tests/th/TH_pragma.hs
=====================================
@@ -10,3 +10,7 @@ $( [d| foo :: Int -> Int
 $( [d| bar :: Num a => a -> a
        {-# SPECIALISE INLINE [~1] bar :: Float -> Float #-}
        bar x = x * 10        |] )
+
+$( [d| baz :: Num a => a -> a
+       {-# SPECIALISE INLINE [~1] baz @Double #-}
+       baz x = x * 10        |] )


=====================================
testsuite/tests/th/TH_pragma.stderr
=====================================
@@ -14,3 +14,11 @@ TH_pragma.hs:(10,2)-(12,33): Splicing declarations
     bar :: Num a => a -> a
     {-# SPECIALISE INLINE [~1] bar :: Float -> Float #-}
     bar x = (x * 10)
+TH_pragma.hs:(14,2)-(16,33): Splicing declarations
+    [d| baz :: Num a => a -> a
+        {-# SPECIALISE INLINE [~1] baz @Double #-}
+        baz x = x * 10 |]
+  ======>
+    baz :: Num a => a -> a
+    {-# SPECIALISE INLINE [~1] baz @Double #-}
+    baz x = (x * 10)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6280b35adf296d327053ae799d76e20d157dfbd

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6280b35adf296d327053ae799d76e20d157dfbd
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241129/2a811483/attachment-0001.html>