[Git][ghc/ghc][wip/T24359] Fix build

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/T24359 at Glasgow Haskell Compiler / GHC


Commits:
6155e4a8 by Simon Peyton Jones at 2024-11-27T15:00:37+00:00
Fix build

- - - - -


2 changed files:

- compiler/GHC/HsToCore/Binds.hs
- libraries/ghc-boot-th/GHC/Internal/TH/Ppr.hs


Changes:

=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -985,12 +985,14 @@ finishSpecPrag poly_rhs rule_bndrs poly_id rule_args
     rule_act | no_act_spec = inl_prag_act    -- Inherit
              | otherwise   = spec_prag_act   -- Specified by user
 
+{-
     is_nop_arg (Type {})     = True
     is_nop_arg (Coercion {}) = True
     is_nop_arg (Cast e _)    = is_nop_arg e
     is_nop_arg (Tick _ e)    = is_nop_arg e
     is_nop_arg (Var x)       = x `elem` spec_bndrs
     is_nop_arg _             = False
+-}
 
 specFunInlinePrag :: Id -> InlinePragma
                   -> InlinePragma -> InlinePragma


=====================================
libraries/ghc-boot-th/GHC/Internal/TH/Ppr.hs
=====================================
@@ -653,21 +653,20 @@ instance Ppr Pragma where
        <+> sep [ pprName' Applied n <+> dcolon
                , nest 2 $ ppr ty ]
        <+> text "#-}"
+    ppr (SpecialiseEP ty_bndrs tm_bndrs spec_e inline phases)
+       = sep [ text "{-# SPECIALISE"
+                 <+> maybe empty ppr inline
+                 <+> ppr phases
+             , nest 2 $ sep [ ppr_ty_forall ty_bndrs <+> ppr_tm_forall ty_bndrs tm_bndrs
+                            , nest 2 (ppr spec_e) ]
+                        <+> text "#-}" ]
     ppr (SpecialiseInstP inst)
        = text "{-# SPECIALISE instance" <+> ppr inst <+> text "#-}"
     ppr (RuleP n ty_bndrs tm_bndrs lhs rhs phases)
        = sep [ text "{-# RULES" <+> pprString n <+> ppr phases
-             , nest 4 $ ppr_ty_forall ty_bndrs <+> ppr_tm_forall ty_bndrs
+             , nest 4 $ ppr_ty_forall ty_bndrs <+> ppr_tm_forall ty_bndrs tm_bndrs
                                                <+> ppr lhs
              , nest 4 $ char '=' <+> ppr rhs <+> text "#-}" ]
-      where ppr_ty_forall Nothing      = empty
-            ppr_ty_forall (Just bndrs) = text "forall"
-                                         <+> fsep (map ppr bndrs)
-                                         <+> char '.'
-            ppr_tm_forall Nothing | null tm_bndrs = empty
-            ppr_tm_forall _ = text "forall"
-                              <+> fsep (map ppr tm_bndrs)
-                              <+> char '.'
     ppr (AnnP tgt expr)
        = text "{-# ANN" <+> target1 tgt <+> ppr expr <+> text "#-}"
       where target1 ModuleAnnotation    = text "module"
@@ -681,6 +680,17 @@ instance Ppr Pragma where
     ppr (SCCP nm str)
        = text "{-# SCC" <+> pprName' Applied nm <+> maybe empty pprString str <+> text "#-}"
 
+ppr_ty_forall :: Maybe [TyVarBndr ()] -> Doc
+ppr_ty_forall Nothing      = empty
+ppr_ty_forall (Just bndrs) = text "forall"
+                             <+> fsep (map ppr bndrs)
+                             <+> char '.'
+
+ppr_tm_forall :: Maybe [TyVarBndr ()] -> [RuleBndr] -> Doc
+ppr_tm_forall Nothing []       = empty
+ppr_tm_forall _       tm_bndrs = text "forall"
+                                 <+> fsep (map ppr tm_bndrs)
+                                 <+> char '.'
 ------------------------------
 instance Ppr Inline where
     ppr NoInline  = text "NOINLINE"



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6155e4a8562f9943f976d4496c95d07651a6a554
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/20241127/b0ea3bca/attachment-0001.html>