[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: docs: Update INSTALL.md

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Jan 25 13:57:58 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00
docs: Update INSTALL.md

Removes references to make.

Fixes #22480

- - - - -
bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00
compiler: fix handling of MO_F_Neg in wasm NCG

In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an
oversight, there actually exists f32.neg/f64.neg opcodes in the wasm
spec and those should be used instead! The old behavior almost works,
expect when GHC compiles the -0.0 literal, which will incorrectly
become 0.0.

- - - - -
38ee99d8 by Sylvain Henry at 2023-01-25T08:57:18-05:00
Hadrian: correctly detect AR at-file support

Stage0's ar may not support at-files. Take it into account.

Found while cross-compiling from Darwin to Windows.

- - - - -
dce3b396 by Sylvain Henry at 2023-01-25T08:57:18-05:00
Hadrian: fix Windows cross-compilation

Decision to build either unix or Win32 package must be stage specific
for cross-compilation to be supported.

- - - - -
04e29cdd by Sylvain Henry at 2023-01-25T08:57:18-05:00
Fix RTS build on Windows

This change fixes a cross-compilation issue from ArchLinux to Windows
because these symbols weren't found.

- - - - -
9b54abb3 by Sylvain Henry at 2023-01-25T08:57:18-05:00
configure: support "windows" as an OS

- - - - -
5b372ac4 by Simon Peyton Jones at 2023-01-25T08:57:18-05:00
Fix in-scope set in specImports

Nothing deep here; I had failed to bring some
floated dictionary binders into scope.

Exposed by -fspecialise-aggressively

Fixes #22715.

- - - - -
fb963038 by Matthew Pickering at 2023-01-25T08:57:18-05:00
ci: Disable HLint job due to excessive runtime

The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91

Now the CI job will build the stage0 compiler before it generates the necessary RTS headers.

We either need to:

* Fix the linting rules so they take much less time
* Revert the commit
* Remove the linting of base from the hlint job
* Remove the hlint job

This is highest priority as it is affecting all CI pipelines.

For now I am just disabling the job because there are many more pressing
matters at hand.

Ticket #22830

- - - - -


16 changed files:

- .gitlab-ci.yml
- INSTALL.md
- compiler/GHC/CmmToAsm/Wasm/Asm.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/Wasm/Types.hs
- compiler/GHC/Core/Opt/Specialise.hs
- hadrian/cfg/system.config.in
- hadrian/src/Builder.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Settings/Default.hs
- m4/fptools_set_haskell_platform_vars.m4
- m4/ghc_convert_os.m4
- rts/RtsSymbols.c
- + testsuite/tests/simplCore/should_compile/T22715_2.hs
- + testsuite/tests/simplCore/should_compile/T22715_2a.hs
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -329,7 +329,8 @@ lint-submods-branch:
     paths:
       - cabal-cache
 
-hlint-ghc-and-base:
+# Disabled due to #22830
+.hlint-ghc-and-base:
   extends: .lint-params
   image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
   variables:


=====================================
INSTALL.md
=====================================
@@ -20,15 +20,14 @@ Quick start:  the following gives you a default build:
 
     $ ./boot
     $ ./configure
-    $ make
-    $ make install
+    $ ./hadrian/build
 
   On Windows, you need an extra repository containing some build tools.
   These can be downloaded for you by configure. This only needs to be done once by running:
 
     $ ./configure --enable-tarballs-autodownload
 
-You can use Make's `-jN` option to parallelize the build. It's generally best
+You can use `-jN` option to parallelize the build. It's generally best
 to set `N` somewhere around the core count of the build machine.
 
 The `./boot` step is only necessary if this is a tree checked out from


=====================================
compiler/GHC/CmmToAsm/Wasm/Asm.hs
=====================================
@@ -359,6 +359,7 @@ asmTellWasmInstr ty_word instr = case instr of
   WasmF32DemoteF64 -> asmTellLine "f32.demote_f64"
   WasmF64PromoteF32 -> asmTellLine "f64.promote_f32"
   WasmAbs ty -> asmTellLine $ asmFromWasmType ty <> ".abs"
+  WasmNeg ty -> asmTellLine $ asmFromWasmType ty <> ".neg"
   WasmCond t -> do
     asmTellLine "if"
     asmWithTab $ asmTellWasmInstr ty_word t


=====================================
compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
=====================================
@@ -224,6 +224,28 @@ extendSubword W32 TagI64 (WasmExpr instr) =
   WasmExpr $ instr `WasmConcat` WasmI64Extend32S
 extendSubword _ _ expr = expr
 
+-- | Lower an unary homogeneous operation.
+lower_MO_Un_Homo ::
+  ( forall pre t.
+    WasmTypeTag t ->
+    WasmInstr
+      w
+      (t : pre)
+      (t : pre)
+  ) ->
+  CLabel ->
+  CmmType ->
+  [CmmExpr] ->
+  WasmCodeGenM w (SomeWasmExpr w)
+lower_MO_Un_Homo op lbl t0 [x] = case someWasmTypeFromCmmType t0 of
+  SomeWasmType ty -> do
+    WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+    pure $
+      SomeWasmExpr ty $
+        WasmExpr $
+          x_instr `WasmConcat` op ty
+lower_MO_Un_Homo _ _ _ _ = panic "lower_MO_Un_Homo: unreachable"
+
 -- | Lower a binary homogeneous operation. Homogeneous: result type is
 -- the same with operand types.
 lower_MO_Bin_Homo ::
@@ -699,11 +721,12 @@ lower_CmmMachOp lbl (MO_F_Sub w0) xs =
     lbl
     (cmmFloat w0)
     xs
-lower_CmmMachOp lbl (MO_F_Neg w0) [x] =
-  lower_CmmMachOp
+lower_CmmMachOp lbl (MO_F_Neg w0) xs =
+  lower_MO_Un_Homo
+    WasmNeg
     lbl
-    (MO_F_Sub w0)
-    [CmmLit $ CmmFloat 0 w0, x]
+    (cmmFloat w0)
+    xs
 lower_CmmMachOp lbl (MO_F_Mul w0) xs =
   lower_MO_Bin_Homo
     WasmMul


=====================================
compiler/GHC/CmmToAsm/Wasm/Types.hs
=====================================
@@ -305,6 +305,7 @@ data WasmInstr :: WasmType -> [WasmType] -> [WasmType] -> Type where
   WasmF32DemoteF64 :: WasmInstr w ('F64 : pre) ('F32 : pre)
   WasmF64PromoteF32 :: WasmInstr w ('F32 : pre) ('F64 : pre)
   WasmAbs :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
+  WasmNeg :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
   WasmCond :: WasmInstr w pre pre -> WasmInstr w (w : pre) pre
 
 newtype WasmExpr w t = WasmExpr (forall pre. WasmInstr w pre (t : pre))


=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -33,6 +33,7 @@ import GHC.Core.Utils     ( exprIsTrivial
 import GHC.Core.FVs
 import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList )
 import GHC.Core.Opt.Arity( collectBindersPushingCo )
+-- import GHC.Core.Ppr( pprIds )
 
 import GHC.Builtin.Types  ( unboxedUnitTy )
 
@@ -736,7 +737,8 @@ specImports top_env (MkUD { ud_binds = dict_binds, ud_calls = calls })
   = return ([], wrapDictBinds dict_binds [])
 
   | otherwise
-  = do { (_env, spec_rules, spec_binds) <- spec_imports top_env [] dict_binds calls
+  = do { let env_w_dict_bndrs = top_env `bringFloatedDictsIntoScope` dict_binds
+       ; (_env, spec_rules, spec_binds) <- spec_imports env_w_dict_bndrs [] dict_binds calls
 
              -- Don't forget to wrap the specialized bindings with
              -- bindings for the needed dictionaries.
@@ -752,6 +754,7 @@ specImports top_env (MkUD { ud_binds = dict_binds, ud_calls = calls })
 
 -- | Specialise a set of calls to imported bindings
 spec_imports :: SpecEnv          -- Passed in so that all top-level Ids are in scope
+                                 ---In-scope set includes the FloatedDictBinds
              -> [Id]             -- Stack of imported functions being specialised
                                  -- See Note [specImport call stack]
              -> FloatedDictBinds -- Dict bindings, used /only/ for filterCalls
@@ -781,6 +784,7 @@ spec_imports env callers dict_binds calls
            ; return (env, rules1 ++ rules2, spec_binds1 ++ spec_binds2) }
 
 spec_import :: SpecEnv               -- Passed in so that all top-level Ids are in scope
+                                     ---In-scope set includes the FloatedDictBinds
             -> [Id]                  -- Stack of imported functions being specialised
                                      -- See Note [specImport call stack]
             -> FloatedDictBinds      -- Dict bindings, used /only/ for filterCalls
@@ -806,23 +810,35 @@ spec_import env callers dict_binds cis@(CIS fn _)
        ; eps_rules <- getExternalRuleBase
        ; let rule_env = se_rules env `updExternalPackageRules` eps_rules
 
---       ; debugTraceMsg (text "specImport1" <+> vcat [ppr fn, ppr good_calls
---                                                    , ppr (getRules rule_env fn), ppr rhs])
+--       ; debugTraceMsg (text "specImport1" <+> vcat
+--           [ text "function:" <+> ppr fn
+--           , text "good calls:" <+> ppr good_calls
+--           , text "existing rules:" <+> ppr (getRules rule_env fn)
+--           , text "rhs:" <+> ppr rhs
+--           , text "dict_binds:" <+> ppr dict_binds ])
+
        ; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls })
-            <- runSpecM $ specCalls True env dict_binds
-                                    (getRules rule_env fn) good_calls fn rhs
+            <- runSpecM $ specCalls True env (getRules rule_env fn) good_calls fn rhs
 
        ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs]
-             -- After the rules kick in we may get recursion, but
-             -- we rely on a global GlomBinds to sort that out later
+             -- After the rules kick in, via fireRewriteRules, we may get recursion,
+             -- but we rely on a global GlomBinds to sort that out later
              -- See Note [Glom the bindings if imported functions are specialised]
+             -- Meanwhile, though, bring the binders into scope
 
              new_subst = se_subst env `Core.extendSubstInScopeList` map fst spec_pairs
              new_env   = env { se_rules = rule_env `addLocalRules` rules1
                              , se_subst = new_subst }
+                         `bringFloatedDictsIntoScope` dict_binds1
+
+       -- Now specialise any cascaded calls
+--       ; debugTraceMsg (text "specImport 2" <+> vcat
+--           [ text "function:" <+> ppr fn
+--           , text "rules1:" <+> ppr rules1
+--           , text "spec_binds1" <+> ppr spec_binds1
+--           , text "dict_binds1" <+> ppr dict_binds1
+--           , text "new_calls" <+> ppr new_calls ])
 
-              -- Now specialise any cascaded calls
---       ; debugTraceMsg (text "specImport 2" <+> (ppr fn $$ ppr rules1 $$ ppr spec_binds1))
        ; (env, rules2, spec_binds2)
             <- spec_imports new_env (fn:callers)
                                     (dict_binds `thenFDBs` dict_binds1)
@@ -1561,10 +1577,11 @@ specDefn :: SpecEnv
 specDefn env body_uds fn rhs
   = do { let (body_uds_without_me, calls_for_me) = callsForMe fn body_uds
              rules_for_me = idCoreRules fn
-             dict_binds   = ud_binds body_uds
+             -- Bring into scope the binders from the floated dicts
+             env_w_dict_bndrs = bringFloatedDictsIntoScope env (ud_binds body_uds)
 
-       ; (rules, spec_defns, spec_uds) <- specCalls False env dict_binds
-                                               rules_for_me calls_for_me fn rhs
+       ; (rules, spec_defns, spec_uds) <- specCalls False env_w_dict_bndrs
+                                                    rules_for_me calls_for_me fn rhs
 
        ; return ( fn `addIdSpecialisations` rules
                 , spec_defns
@@ -1580,7 +1597,6 @@ specDefn env body_uds fn rhs
 specCalls :: Bool              -- True  =>  specialising imported fn
                                -- False =>  specialising local fn
           -> SpecEnv
-          -> FloatedDictBinds  -- Just so that we can extend the in-scope set
           -> [CoreRule]        -- Existing RULES for the fn
           -> [CallInfo]
           -> OutId -> InExpr
@@ -1594,7 +1610,7 @@ type SpecInfo = ( [CoreRule]       -- Specialisation rules
                 , [(Id,CoreExpr)]  -- Specialised definition
                 , UsageDetails )   -- Usage details from specialised RHSs
 
-specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
+specCalls spec_imp env existing_rules calls_for_me fn rhs
         -- The first case is the interesting one
   |  notNull calls_for_me               -- And there are some calls to specialise
   && not (isNeverActive (idInlineActivation fn))
@@ -1610,8 +1626,11 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
 --      See Note [Inline specialisations] for why we do not
 --      switch off specialisation for inline functions
 
-  = -- pprTrace "specCalls: some" (ppr fn $$ ppr calls_for_me $$ ppr existing_rules) $
-    foldlM spec_call ([], [], emptyUDs) calls_for_me
+  = do { -- debugTraceMsg (text "specCalls: some" <+> vcat
+         --   [ text "function" <+> ppr fn
+         --   , text "calls:" <+> ppr calls_for_me
+         --   , text "subst" <+> ppr (se_subst env) ])
+       ; foldlM spec_call ([], [], emptyUDs) calls_for_me }
 
   | otherwise   -- No calls or RHS doesn't fit our preconceptions
   = warnPprTrace (not (exprIsTrivial rhs) && notNull calls_for_me && not (isClassOpId fn))
@@ -1639,9 +1658,6 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
     (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs
                             -- See Note [Account for casts in binding]
 
-    -- Bring into scope the binders from the floated dicts
-    env_with_dict_bndrs = bringFloatedDictsIntoScope env dict_binds
-
     already_covered :: SpecEnv -> [CoreRule] -> [CoreExpr] -> Bool
     already_covered env new_rules args      -- Note [Specialisations already covered]
        = isJust (specLookupRule env fn args (beginPhase inl_act)
@@ -1667,22 +1683,22 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
 
            ; ( useful, rhs_env2, leftover_bndrs
              , rule_bndrs, rule_lhs_args
-             , spec_bndrs1, dx_binds, spec_args) <- specHeader env_with_dict_bndrs
-                                                               rhs_bndrs all_call_args
-
---           ; pprTrace "spec_call" (vcat [ text "fun:       "  <+> ppr fn
---                                        , text "call info: "  <+> ppr _ci
---                                        , text "useful:    "  <+> ppr useful
---                                        , text "rule_bndrs:"  <+> ppr rule_bndrs
---                                        , text "lhs_args:  "  <+> ppr rule_lhs_args
---                                        , text "spec_bndrs1:" <+> ppr spec_bndrs1
---                                        , text "leftover_bndrs:" <+> pprIds leftover_bndrs
---                                        , text "spec_args: "  <+> ppr spec_args
---                                        , text "dx_binds:  "  <+> ppr dx_binds
---                                        , text "rhs_body"     <+> ppr rhs_body
---                                        , text "rhs_env2:  "  <+> ppr (se_subst rhs_env2)
---                                        , ppr dx_binds ]) $
---             return ()
+             , spec_bndrs1, dx_binds, spec_args) <- specHeader env rhs_bndrs all_call_args
+
+--           ; debugTraceMsg (text "spec_call" <+> vcat
+--                [ text "fun:       "  <+> ppr fn
+--                , text "call info: "  <+> ppr _ci
+--                , text "useful:    "  <+> ppr useful
+--                , text "rule_bndrs:"  <+> ppr rule_bndrs
+--                , text "lhs_args:  "  <+> ppr rule_lhs_args
+--                , text "spec_bndrs1:" <+> ppr spec_bndrs1
+--                , text "leftover_bndrs:" <+> pprIds leftover_bndrs
+--                , text "spec_args: "  <+> ppr spec_args
+--                , text "dx_binds:  "  <+> ppr dx_binds
+--                , text "rhs_bndrs"     <+> ppr rhs_bndrs
+--                , text "rhs_body"     <+> ppr rhs_body
+--                , text "rhs_env2:  "  <+> ppr (se_subst rhs_env2)
+--                , ppr dx_binds ]
 
            ; if not useful  -- No useful specialisation
                 || already_covered rhs_env2 rules_acc rule_lhs_args


=====================================
hadrian/cfg/system.config.in
=====================================
@@ -40,6 +40,7 @@ python         = @PythonCmd@
 #============================
 
 ar-supports-at-file       = @ArSupportsAtFile@
+system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@
 ar-supports-dash-l        = @ArSupportsDashL@
 system-ar-supports-dash-l = @ArSupportsDashL_STAGE0@
 cc-llvm-backend           = @CcLlvmBackend@


=====================================
hadrian/src/Builder.hs
=====================================
@@ -312,8 +312,8 @@ instance H.Builder Builder where
                     -- see Note [Capture stdout as a ByteString]
                     writeFileChangedBS output stdout
             case builder of
-                Ar Pack _ -> do
-                    useTempFile <- flag ArSupportsAtFile
+                Ar Pack stg -> do
+                    useTempFile <- arSupportsAtFile stg
                     if useTempFile then runAr                path buildArgs buildInputs
                                    else runArWithoutTempFile path buildArgs buildInputs
 


=====================================
hadrian/src/Oracles/Flag.hs
=====================================
@@ -7,7 +7,8 @@ module Oracles.Flag (
     targetSupportsThreadedRts,
     targetSupportsSMP,
     useLibffiForAdjustors,
-    arSupportsDashL
+    arSupportsDashL,
+    arSupportsAtFile
     ) where
 
 import Hadrian.Oracles.TextFile
@@ -18,6 +19,7 @@ import Oracles.Setting
 
 data Flag = ArSupportsAtFile
           | ArSupportsDashL
+          | SystemArSupportsAtFile
           | SystemArSupportsDashL
           | CrossCompiling
           | CcLlvmBackend
@@ -48,6 +50,7 @@ flag f = do
     let key = case f of
             ArSupportsAtFile     -> "ar-supports-at-file"
             ArSupportsDashL      -> "ar-supports-dash-l"
+            SystemArSupportsAtFile-> "system-ar-supports-at-file"
             SystemArSupportsDashL-> "system-ar-supports-dash-l"
             CrossCompiling       -> "cross-compiling"
             CcLlvmBackend        -> "cc-llvm-backend"
@@ -89,6 +92,10 @@ arSupportsDashL :: Stage -> Action Bool
 arSupportsDashL (Stage0 {}) = flag SystemArSupportsDashL
 arSupportsDashL _           = flag ArSupportsDashL
 
+arSupportsAtFile :: Stage -> Action Bool
+arSupportsAtFile (Stage0 {}) = flag SystemArSupportsAtFile
+arSupportsAtFile _           = flag ArSupportsAtFile
+
 platformSupportsSharedLibs :: Action Bool
 platformSupportsSharedLibs = do
     windows       <- isWinTarget


=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -72,7 +72,6 @@ stageBootPackages = return [lintersCommon, lintCommitMsg, lintSubmoduleRefs, lin
 stage0Packages :: Action [Package]
 stage0Packages = do
     cross <- flag CrossCompiling
-    winTarget  <- isWinTarget
     return $ [ binary
              , bytestring
              , cabalSyntax
@@ -102,7 +101,7 @@ stage0Packages = do
              , transformers
              , unlit
              , hp2ps
-             , if winTarget then win32 else unix
+             , if windowsHost then win32 else unix
              ]
           ++ [ terminfo | not windowsHost, not cross ]
           ++ [ timeout  | windowsHost                ]
@@ -111,7 +110,15 @@ stage0Packages = do
 -- | Packages built in 'Stage1' by default. You can change this in "UserSettings".
 stage1Packages :: Action [Package]
 stage1Packages = do
-    libraries0 <- filter isLibrary <$> stage0Packages
+    let good_stage0_package p
+          -- we only keep libraries for some reason
+          | not (isLibrary p) = False
+          -- but not win32/unix because it depends on cross-compilation target
+          | p == win32        = False
+          | p == unix         = False
+          | otherwise         = True
+
+    libraries0 <- filter good_stage0_package <$> stage0Packages
     cross      <- flag CrossCompiling
     winTarget  <- isWinTarget
 
@@ -138,6 +145,7 @@ stage1Packages = do
         , stm
         , unlit
         , xhtml
+        , if winTarget then win32 else unix
         ]
       , when (not cross)
         [ haddock


=====================================
m4/fptools_set_haskell_platform_vars.m4
=====================================
@@ -82,7 +82,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS],
         solaris2)
             test -z "[$]2" || eval "[$]2=OSSolaris2"
             ;;
-        mingw32)
+        mingw32|windows)
             test -z "[$]2" || eval "[$]2=OSMinGW32"
             ;;
         freebsd)


=====================================
m4/ghc_convert_os.m4
=====================================
@@ -22,8 +22,11 @@ AC_DEFUN([GHC_CONVERT_OS],[
       openbsd*)
         $3="openbsd"
         ;;
+      windows|mingw32)
+        $3="mingw32"
+        ;;
       # As far as I'm aware, none of these have relevant variants
-      freebsd|dragonfly|hpux|linuxaout|kfreebsdgnu|freebsd2|mingw32|darwin|nextstep2|nextstep3|sunos4|ultrix|haiku)
+      freebsd|dragonfly|hpux|linuxaout|kfreebsdgnu|freebsd2|darwin|nextstep2|nextstep3|sunos4|ultrix|haiku)
         $3="$1"
         ;;
       msys)


=====================================
rts/RtsSymbols.c
=====================================
@@ -170,8 +170,6 @@ extern char **environ;
       SymI_NeedsProto(__mingw_module_is_dll)             \
       RTS_WIN32_ONLY(SymI_NeedsProto(___chkstk_ms))      \
       RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms))      \
-      RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf_s)) \
-      RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf)) \
       RTS_WIN64_ONLY(SymI_HasProto(_errno))  \
       /* see Note [Symbols for MinGW's printf] */        \
       SymI_HasProto(_lock_file)                          \


=====================================
testsuite/tests/simplCore/should_compile/T22715_2.hs
=====================================
@@ -0,0 +1,6 @@
+module T22715_2 where
+
+import T22715_2a
+
+debugTerminalKeys :: (forall m. CommandMonad m => m Char) -> Input IO Char
+debugTerminalKeys eval = runIdT eval


=====================================
testsuite/tests/simplCore/should_compile/T22715_2a.hs
=====================================
@@ -0,0 +1,29 @@
+{-# OPTIONS_GHC -Wno-missing-methods #-}
+
+module T22715_2a where
+
+newtype IdentityT m a = IdentityT (m a) deriving Functor
+newtype IdT m a = IdT {runIdT :: m a} deriving Functor
+
+class Functor m => SillyA m where
+  unused :: m a -> m a
+
+class SillyA m => SillyB m where
+  unused2 :: m a -> m a
+
+instance SillyA m => SillyA (IdentityT m) where
+instance SillyB m => SillyB (IdentityT m) where
+
+instance SillyA m => SillyA (IdT m) where
+instance SillyB m => SillyB (IdT m) where
+
+instance SillyA IO where
+instance SillyB IO where
+
+class Functor m => Special m
+instance Functor m => Special (IdT m)
+
+type Input m = IdentityT (IdentityT m)
+
+class (Special m, SillyB m) => CommandMonad m
+instance SillyB m => CommandMonad (IdT (Input m))


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -469,4 +469,4 @@ test('T22662', normal, compile, [''])
 test('T22725', normal, compile, ['-O'])
 test('T22502', normal, compile, ['-O'])
 test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all'])
-
+test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7daf39c476b9542385b9fd0593468ed3e2be8f7a...fb9630389afbaf408bb3e5027f5966ad9e1defeb

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7daf39c476b9542385b9fd0593468ed3e2be8f7a...fb9630389afbaf408bb3e5027f5966ad9e1defeb
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/20230125/764c993f/attachment-0001.html>


More information about the ghc-commits mailing list