[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: JS: refactor jsSaturate to return a saturated JStat (#23328)

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Fri May 12 03:40:58 UTC 2023



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


Commits:
0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00
JS: refactor jsSaturate to return a saturated JStat (#23328)

- - - - -
a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00
Doc: Fix out-of-sync using-optimisation page

- Make explicit that default flag values correspond to their -O0 value.
- Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction,
  -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper.

- - - - -
3e6521f9 by sheaf at 2023-05-11T23:40:27-04:00
Don't panic in mkNewTyConRhs

This function could come across invalid newtype constructors, as we
only perform validity checking of newtypes once we are outside the
knot-tied typechecking loop.
This patch changes this function to fake up a stub type in the case of
an invalid newtype, instead of panicking.

This patch also changes "checkNewDataCon" so that it reports as many
errors as possible at once.

Fixes #23308

- - - - -
1e71df74 by Krzysztof Gogolewski at 2023-05-11T23:40:39-04:00
Allow Core optimizations when interpreting bytecode

Tracking ticket: #23056

MR: !10399

This adds the flag `-funoptimized-core-for-interpreter`, permitting use
of the `-O` flag to enable optimizations when compiling with the
interpreter backend, like in ghci.

- - - - -
62706fd4 by Ben Gamari at 2023-05-11T23:40:40-04:00
hadrian: Fix mention of non-existent removeFiles function

Previously Hadrian's bindist Makefile referred to a `removeFiles`
function that was previously defined by the `make` build system. Since
the `make` build system is no longer around, this function is now
undefined. Naturally, make being make, this appears to be silently
ignored instead of producing an error.

Fix this by rewriting it to `rm -f`.

Closes #23373.

- - - - -
967f1758 by Bodigrim at 2023-05-11T23:40:42-04:00
Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog

- - - - -


29 changed files:

- compiler/GHC/Core/Type.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/JS/Transform.hs
- compiler/GHC/StgToJS/CodeGen.hs
- compiler/GHC/StgToJS/CoreUtils.hs
- compiler/GHC/StgToJS/DataCon.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/FFI.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
- compiler/GHC/StgToJS/Monad.hs
- compiler/GHC/StgToJS/Rts/Rts.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- docs/users_guide/debugging.rst
- docs/users_guide/using-optimisation.rst
- hadrian/bindist/Makefile
- libraries/base/changelog.md
- testsuite/driver/testlib.py
- + testsuite/tests/simplCore/should_compile/T23267.hs
- + testsuite/tests/simplCore/should_compile/T23267.script
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/simplCore/should_run/T23056.hs
- + testsuite/tests/simplCore/should_run/T23056.script
- + testsuite/tests/simplCore/should_run/T23056.stdout
- testsuite/tests/simplCore/should_run/all.T
- + testsuite/tests/typecheck/should_fail/T23308.hs
- + testsuite/tests/typecheck/should_fail/T23308.stderr
- testsuite/tests/typecheck/should_fail/all.T


Changes:

=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -1505,7 +1505,7 @@ piResultTys ty orig_args@(arg:args)
         -- c.f. #15473
         pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args)
 
-applyTysX :: [TyVar] -> Type -> [Type] -> Type
+applyTysX :: HasDebugCallStack => [TyVar] -> Type -> [Type] -> Type
 -- applyTysX beta-reduces (/\tvs. body_ty) arg_tys
 -- Assumes that (/\tvs. body_ty) is closed
 applyTysX tvs body_ty arg_tys


=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -387,6 +387,7 @@ data GeneralFlag
    | Opt_KeepGoing
    | Opt_ByteCode
    | Opt_ByteCodeAndObjectCode
+   | Opt_UnoptimizedCoreForInterpreter
    | Opt_LinkRts
 
    -- output style opts


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3573,6 +3573,7 @@ fFlagsDeps = [
   flagSpec "write-ide-info"                   Opt_WriteHie,
   flagSpec "unbox-small-strict-fields"        Opt_UnboxSmallStrictFields,
   flagSpec "unbox-strict-fields"              Opt_UnboxStrictFields,
+  flagSpec "unoptimized-core-for-interpreter" Opt_UnoptimizedCoreForInterpreter,
   flagSpec "version-macros"                   Opt_VersionMacros,
   flagSpec "worker-wrapper"                   Opt_WorkerWrapper,
   flagSpec "worker-wrapper-cbv"               Opt_WorkerWrapperUnlift, -- See Note [Worker/wrapper for strict arguments]
@@ -3896,7 +3897,8 @@ defaultFlags settings
       Opt_DumpWithWays,
       Opt_CompactUnwind,
       Opt_ShowErrorContext,
-      Opt_SuppressStgReps
+      Opt_SuppressStgReps,
+      Opt_UnoptimizedCoreForInterpreter
     ]
 
     ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
@@ -4976,6 +4978,7 @@ makeDynFlagsConsistent dflags
            "Enabling -fPIC as it is always on for this platform"
 
  | backendForcesOptimization0 (backend dflags)
+ , gopt Opt_UnoptimizedCoreForInterpreter dflags
  , let (dflags', changed) = updOptLevelChanged 0 dflags
  , changed
     = loop dflags' ("Optimization flags are incompatible with the " ++


=====================================
compiler/GHC/JS/Transform.hs
=====================================
@@ -6,13 +6,15 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TupleSections #-}
 
 module GHC.JS.Transform
   ( identsS
   , identsV
   , identsE
   -- * Saturation
-  , jsSaturate
+  , satJStat
+  , satJExpr
   -- * Generic traversal (via compos)
   , JMacro(..)
   , JMGadt(..)
@@ -21,8 +23,6 @@ module GHC.JS.Transform
   , composOpM
   , composOpM_
   , composOpFold
-  , satJExpr
-  , satJStat
   )
 where
 
@@ -33,11 +33,12 @@ import GHC.JS.Unsat.Syntax
 
 import Data.Functor.Identity
 import Control.Monad
-import Control.Arrow ((***))
+import Data.List (sortBy)
 
 import GHC.Data.FastString
 import GHC.Utils.Monad.State.Strict
 import GHC.Types.Unique.Map
+import GHC.Types.Unique.FM
 
 
 {-# INLINE identsS #-}
@@ -205,69 +206,62 @@ jmcompos ret app f' v =
 
 -- | Given an optional prefix, fills in all free variable names with a supply
 -- of names generated by the prefix.
-jsSaturate :: (JMacro a) => Maybe FastString -> a -> a
-jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str)
-
-jsSaturate_ :: (JMacro a) => a -> IdentSupply a
-jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e)
+satJStat :: Maybe FastString -> JStat -> Sat.JStat
+satJStat str x = evalState (jsSaturateS x) (newIdentSupply str)
+
+satJExpr :: Maybe FastString -> JExpr -> Sat.JExpr
+satJExpr str x = evalState (jsSaturateE x) (newIdentSupply str)
+
+jsSaturateS :: JStat -> State [Ident] Sat.JStat
+jsSaturateS  = \case
+  DeclStat i rhs        -> Sat.DeclStat i <$> mapM jsSaturateE rhs
+  ReturnStat e          -> Sat.ReturnStat <$> jsSaturateE e
+  IfStat c t e          -> Sat.IfStat <$> jsSaturateE c <*> jsSaturateS t <*> jsSaturateS e
+  WhileStat is_do c e   -> Sat.WhileStat is_do <$> jsSaturateE c <*> jsSaturateS e
+  ForStat init p step body -> Sat.ForStat <$> jsSaturateS init <*> jsSaturateE p
+                                          <*> jsSaturateS step <*> jsSaturateS body
+  ForInStat is_each i iter body -> Sat.ForInStat is_each i <$> jsSaturateE iter <*> jsSaturateS body
+  SwitchStat struct ps def -> Sat.SwitchStat <$> jsSaturateE struct
+                                             <*> mapM (\(p1, p2) -> (,) <$> jsSaturateE p1 <*> jsSaturateS p2) ps
+                                             <*> jsSaturateS def
+  TryStat t i c f       -> Sat.TryStat <$> jsSaturateS t <*> pure i <*> jsSaturateS c <*> jsSaturateS f
+  BlockStat bs          -> fmap Sat.BlockStat $! mapM jsSaturateS bs
+  ApplStat rator rand   -> Sat.ApplStat <$> jsSaturateE rator <*> mapM jsSaturateE rand
+  UOpStat  rator rand   -> Sat.UOpStat (satJUOp rator) <$> jsSaturateE rand
+  AssignStat lhs rhs    -> Sat.AssignStat <$> jsSaturateE lhs <*> pure Sat.AssignOp <*> jsSaturateE rhs
+  LabelStat lbl stmt    -> Sat.LabelStat lbl <$> jsSaturateS stmt
+  BreakStat m_l         -> return $ Sat.BreakStat $! m_l
+  ContinueStat m_l      -> return $ Sat.ContinueStat $! m_l
+  FuncStat i args body  -> Sat.FuncStat i args <$> jsSaturateS body
+  UnsatBlock us         -> jsSaturateS =<< runIdentSupply us
+
+jsSaturateE :: JExpr -> State [Ident] Sat.JExpr
+jsSaturateE = \case
+  ValExpr v            -> Sat.ValExpr <$> jsSaturateV v
+  SelExpr obj i        -> Sat.SelExpr <$> jsSaturateE obj <*> pure i
+  IdxExpr o i          -> Sat.IdxExpr <$> jsSaturateE o <*> jsSaturateE i
+  InfixExpr op l r     -> Sat.InfixExpr (satJOp op) <$> jsSaturateE l <*> jsSaturateE r
+  UOpExpr op r         -> Sat.UOpExpr (satJUOp op) <$> jsSaturateE r
+  IfExpr c t e         -> Sat.IfExpr <$> jsSaturateE c <*> jsSaturateE t <*> jsSaturateE e
+  ApplExpr rator rands -> Sat.ApplExpr <$> jsSaturateE rator <*> mapM jsSaturateE rands
+  UnsatExpr us         -> jsSaturateE =<< runIdentSupply us
+
+jsSaturateV :: JVal -> State [Ident] Sat.JVal
+jsSaturateV = \case
+  JVar i   -> return $ Sat.JVar i
+  JList xs -> Sat.JList <$> mapM jsSaturateE xs
+  JDouble d -> return $ Sat.JDouble (Sat.SaneDouble (unSaneDouble d))
+  JInt i    -> return $ Sat.JInt   i
+  JStr s    -> return $ Sat.JStr   s
+  JRegEx f  -> return $ Sat.JRegEx f
+  JHash m   -> Sat.JHash <$> mapUniqMapM satHash m
     where
-      go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
-      go v = case v of
-               JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us)
-               JMGExpr (UnsatExpr  us) -> go =<< (JMGExpr <$> runIdentSupply us)
-               JMGVal  (UnsatVal   us) -> go =<< (JMGVal  <$> runIdentSupply us)
-               _ -> composOpM go v
-
-
---------------------------------------------------------------------------------
---                            Translation
---
---------------------------------------------------------------------------------
-satJStat :: JStat -> Sat.JStat
-satJStat = witness . proof
-  where proof = jsSaturate Nothing
-
-        -- This is an Applicative but we can't use it because no type variables :(
-        witness :: JStat -> Sat.JStat
-        witness (DeclStat i rhs)      = Sat.DeclStat i (fmap satJExpr rhs)
-        witness (ReturnStat e)        = Sat.ReturnStat (satJExpr e)
-        witness (IfStat c t e)        = Sat.IfStat (satJExpr c) (witness t) (witness e)
-        witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e)
-        witness (ForStat init p step body) = Sat.ForStat
-                                             (witness init) (satJExpr p)
-                                             (witness step) (witness body)
-        witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i
-                                                  (satJExpr iter)
-                                                  (witness body)
-        witness (SwitchStat struct ps def) = Sat.SwitchStat
-                                             (satJExpr struct)
-                                             (map (satJExpr *** witness) ps)
-                                             (witness def)
-        witness (TryStat t i c f)     = Sat.TryStat (witness t) i (witness c) (witness f)
-        witness (BlockStat bs)        = Sat.BlockStat $! fmap witness bs
-        witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand)
-        witness (UOpStat rator rand)  = Sat.UOpStat  (satJUOp rator) (satJExpr rand)
-        witness (AssignStat lhs rhs)  = Sat.AssignStat (satJExpr lhs) Sat.AssignOp (satJExpr rhs)
-        witness (LabelStat lbl stmt)  = Sat.LabelStat lbl (witness stmt)
-        witness (BreakStat Nothing)   = Sat.BreakStat Nothing
-        witness (BreakStat (Just l))  = Sat.BreakStat $! Just l
-        witness (ContinueStat Nothing)  = Sat.ContinueStat Nothing
-        witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l
-        witness (FuncStat i args body)  = Sat.FuncStat i args (witness body)
-        witness UnsatBlock{}            = error "satJStat: discovered an Unsat...impossibly"
-
-
-satJExpr :: JExpr -> Sat.JExpr
-satJExpr = go
-  where
-    go (ValExpr v)        = Sat.ValExpr (satJVal v)
-    go (SelExpr obj i)    = Sat.SelExpr (satJExpr obj) i
-    go (IdxExpr o i)      = Sat.IdxExpr (satJExpr o) (satJExpr i)
-    go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r)
-    go (UOpExpr op r)     = Sat.UOpExpr (satJUOp op) (satJExpr r)
-    go (IfExpr c t e)     = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e)
-    go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands)
-    go UnsatExpr{}        = error "satJExpr: discovered an Unsat...impossibly"
+      satHash (i, x) = (i,) . (i,) <$> jsSaturateE x
+      compareHash (i,_) (j,_) = lexicalCompareFS i j
+      -- By lexically sorting the elements, the non-determinism introduced by nonDetEltsUFM is avoided
+      mapUniqMapM f (UniqMap m) = UniqMap . listToUFM <$> (mapM f . sortBy compareHash $ nonDetEltsUFM m)
+  JFunc args body   -> Sat.JFunc args <$> jsSaturateS body
+  UnsatVal us       -> jsSaturateV =<< runIdentSupply us
 
 satJOp :: JOp -> Sat.Op
 satJOp = go
@@ -313,15 +307,3 @@ satJUOp = go
     go PreDecOp  = Sat.PreDecOp
     go PostDecOp = Sat.PostDecOp
 
-satJVal :: JVal -> Sat.JVal
-satJVal = go
-  where
-    go (JVar i)    = Sat.JVar i
-    go (JList xs)  = Sat.JList (satJExpr <$> xs)
-    go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d))
-    go (JInt i)    = Sat.JInt   i
-    go (JStr f)    = Sat.JStr   f
-    go (JRegEx f)  = Sat.JRegEx f
-    go (JHash m)   = Sat.JHash (satJExpr <$> m)
-    go (JFunc args body) = Sat.JFunc args (satJStat body)
-    go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly"


=====================================
compiler/GHC/StgToJS/CodeGen.hs
=====================================
@@ -134,10 +134,9 @@ genUnits m ss spt_entries foreign_stubs = do
         glbl <- State.gets gsGlobal
         staticInit <-
           initStaticPtrs spt_entries
-        let stat = ( jsOptimize
-                     . satJStat
-                     . jsSaturate (Just $ modulePrefix m 1)
-                     $ mconcat (reverse glbl) <> staticInit)
+        let stat = ( jsOptimize .
+                     satJStat (Just $ modulePrefix m 1)
+                   $ mconcat (reverse glbl) <> staticInit)
         let syms = [moduleGlobalSymbol m]
         let oi = ObjUnit
                   { oiSymbols  = syms
@@ -210,8 +209,7 @@ genUnits m ss spt_entries foreign_stubs = do
               si        <- State.gets (ggsStatic . gsGroup)
               let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2
               let stat =  jsOptimize
-                          . satJStat
-                          $ jsSaturate (Just $ modulePrefix m n) body
+                          $ satJStat (Just $ modulePrefix m n) body
               let ids = [bnd]
               syms <- (\(TxtI i) -> [i]) <$> identForId bnd
               let oi = ObjUnit
@@ -249,8 +247,7 @@ genUnits m ss spt_entries foreign_stubs = do
               topDeps  = collectTopIds decl
               required = hasExport decl
               stat     = jsOptimize
-                         . satJStat
-                         . jsSaturate (Just $ modulePrefix m n)
+                         . satJStat (Just $ modulePrefix m n)
                          $ mconcat (reverse extraTl) <> tl
           syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps
           let oi = ObjUnit
@@ -339,7 +336,7 @@ genToplevelRhs i rhs = case rhs of
     eid@(TxtI eidt) <- identForEntryId i
     (TxtI idt)   <- identForId i
     body <- genBody (initExprCtx i) R2 args body typ
-    global_occs <- globalOccs (jsSaturate (Just "ghcjs_tmp_sat_") body)
+    global_occs <- globalOccs (satJStat (Just "ghcjs_tmp_sat_") body)
     let lidents = map global_ident global_occs
     let lids    = map global_id    global_occs
     let lidents' = map identFS lidents


=====================================
compiler/GHC/StgToJS/CoreUtils.hs
=====================================
@@ -253,7 +253,7 @@ assocPrimReps (r:rs) vs = case (primRepSize r,vs) of
   (NoSlot,   xs)     -> (r,[])    : assocPrimReps rs xs
   (OneSlot,  x:xs)   -> (r,[x])   : assocPrimReps rs xs
   (TwoSlots, x:y:xs) -> (r,[x,y]) : assocPrimReps rs xs
-  err                -> pprPanic "assocPrimReps" (ppr $ fmap (map satJExpr) $ err)
+  err                -> pprPanic "assocPrimReps" (ppr $ map (satJExpr Nothing) <$> err)
 
 -- | Associate the given values to the Id's PrimReps, taking into account the
 -- number of slots per PrimRep


=====================================
compiler/GHC/StgToJS/DataCon.hs
=====================================
@@ -60,8 +60,8 @@ genCon ctx con args
 
   | xs <- concatMap typex_expr (ctxTarget ctx)
   = pprPanic "genCon: unhandled DataCon" (ppr (con
-                                              , fmap satJExpr args
-                                              , fmap satJExpr xs
+                                              , satJExpr Nothing <$> args
+                                              , satJExpr Nothing <$> xs
                                               ))
 
 -- | Allocate a data constructor. Allocate in this context means bind the data
@@ -90,7 +90,7 @@ allocUnboxedCon con = \case
     | isBoolDataCon con && dataConTag con == 2 -> true_
   [x]
     | isUnboxableCon con -> x
-  xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, fmap satJExpr xs))
+  xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, satJExpr Nothing <$> xs))
 
 -- | Allocate an entry function. See 'GHC.StgToJS.hs' for the object layout.
 allocDynamicE :: Bool          -- ^ csInlineAlloc from StgToJSConfig


=====================================
compiler/GHC/StgToJS/Expr.hs
=====================================
@@ -899,7 +899,7 @@ caseCond = \case
   DataAlt da -> return $ Just (toJExpr $ dataConTag da)
   LitAlt l   -> genLit l >>= \case
     [e] -> pure (Just e)
-    es  -> pprPanic "caseCond: expected single-variable literal" (ppr $ fmap satJExpr es)
+    es  -> pprPanic "caseCond: expected single-variable literal" (ppr $ satJExpr Nothing <$> es)
 
 -- fixme use single tmp var for all branches
 -- | Load parameters from constructor


=====================================
compiler/GHC/StgToJS/FFI.hs
=====================================
@@ -14,6 +14,7 @@ import GHC.Prelude
 import GHC.JS.Unsat.Syntax
 import GHC.JS.Make
 import GHC.JS.Transform
+import qualified GHC.JS.Syntax as Sat
 
 import GHC.StgToJS.Arg
 import GHC.StgToJS.ExprCtx
@@ -176,8 +177,8 @@ genFFIArg isJavaScriptCc a@(StgVarArg i)
      arg_ty = stgArgType a
      r      = uTypeVt arg_ty
 
-saturateFFI :: JMacro a => Int -> a -> a
-saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u)
+saturateFFI :: Int -> JStat -> Sat.JStat
+saturateFFI u = satJStat (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u)
 
 genForeignCall :: HasDebugCallStack
                => ExprCtx


=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -333,7 +333,7 @@ renderLinker h mods jsFiles = do
     pure (mod_mod, mod_size)
 
   -- commoned up metadata
-  !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat meta)
+  !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat Nothing meta)
 
   -- module exports
   mapM_ (putBS . cmc_exports) compacted_mods


=====================================
compiler/GHC/StgToJS/Monad.hs
=====================================
@@ -25,6 +25,7 @@ where
 import GHC.Prelude
 
 import GHC.JS.Unsat.Syntax
+import qualified GHC.JS.Syntax as Sat
 import GHC.JS.Transform
 
 import GHC.StgToJS.Types
@@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc
 
 -- | Return number of occurrences of every global id used in the given JStat.
 -- Sort by increasing occurrence count.
-globalOccs :: JStat -> G [GlobalOcc]
+globalOccs :: Sat.JStat -> G [GlobalOcc]
 globalOccs jst = do
   GlobalIdCache gidc <- getGlobalIdCache
   -- build a map form Ident Unique to (Ident, Id, Count)
@@ -180,4 +181,4 @@ globalOccs jst = do
               let g = GlobalOcc i gid 1
               in go (addToUFM_C inc gids i g) is
 
-  pure $ go emptyUFM (identsS $ satJStat jst)
+  pure $ go emptyUFM (identsS jst)


=====================================
compiler/GHC/StgToJS/Rts/Rts.hs
=====================================
@@ -31,6 +31,7 @@ import GHC.JS.Unsat.Syntax
 import GHC.JS.Make
 import GHC.JS.Transform
 import GHC.JS.Optimizer
+import qualified GHC.JS.Syntax as Sat
 
 import GHC.StgToJS.Apply
 import GHC.StgToJS.Closure
@@ -298,8 +299,8 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo
     ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct)))
 
 -- | JS payload declaring the RTS functions.
-rtsDecls :: JStat
-rtsDecls = jsSaturate (Just "h$RTSD") $
+rtsDecls :: Sat.JStat
+rtsDecls = satJStat (Just "h$RTSD") $
   mconcat [ TxtI "h$currentThread"   ||= null_                   -- thread state object for current thread
           , TxtI "h$stack"           ||= null_                   -- stack for the current thread
           , TxtI "h$sp"              ||= 0                       -- stack pointer for the current thread
@@ -314,15 +315,15 @@ rtsDecls = jsSaturate (Just "h$RTSD") $
 
 -- | print the embedded RTS to a String
 rtsText :: StgToJSConfig -> String
-rtsText = show . pretty . jsOptimize . satJStat . rts
+rtsText = show . pretty . jsOptimize . rts
 
 -- | print the RTS declarations to a String.
 rtsDeclsText :: String
-rtsDeclsText = show . pretty . jsOptimize . satJStat $ rtsDecls
+rtsDeclsText = show . pretty . jsOptimize $ rtsDecls
 
 -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform'
-rts :: StgToJSConfig -> JStat
-rts = jsSaturate (Just "h$RTS") . rts'
+rts :: StgToJSConfig -> Sat.JStat
+rts = satJStat (Just "h$RTS") . rts'
 
 -- | JS Payload which defines the embedded RTS.
 rts' :: StgToJSConfig -> JStat


=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -4516,31 +4516,40 @@ checkNewDataCon :: DataCon -> TcM ()
 -- But they are caught earlier, by GHC.Tc.Gen.HsType.checkDataKindSig
 checkNewDataCon con
   = do  { show_linear_types <- xopt LangExt.LinearTypes <$> getDynFlags
-
-        ; checkTc (isSingleton arg_tys) $
-          TcRnIllegalNewtype con show_linear_types (DoesNotHaveSingleField $ length arg_tys)
-
-        ; checkTc (ok_mult (scaledMult arg_ty1)) $
-          TcRnIllegalNewtype con show_linear_types IsNonLinear
-
-        ; checkTc (null eq_spec) $
-          TcRnIllegalNewtype con show_linear_types IsGADT
-
-        ; checkTc (null theta) $
+        ; checkNoErrs $
+          -- Fail here if the newtype is invalid: subsequent code in
+          -- checkValidDataCon can fall over if it comes across an invalid newtype.
+     do { case arg_tys of
+            [Scaled arg_mult _] ->
+              unless (ok_mult arg_mult) $
+              addErrTc $
+              TcRnIllegalNewtype con show_linear_types IsNonLinear
+            _ ->
+              addErrTc $
+              TcRnIllegalNewtype con show_linear_types (DoesNotHaveSingleField $ length arg_tys)
+
+          -- Add an error if the newtype is a GADt or has existentials.
+          --
+          -- If the newtype is a GADT, the GADT error is enough;
+          -- we don't need to *also* complain about existentials.
+        ; if not (null eq_spec)
+          then addErrTc $ TcRnIllegalNewtype con show_linear_types IsGADT
+          else unless (null ex_tvs) $
+               addErrTc $
+               TcRnIllegalNewtype con show_linear_types HasExistentialTyVar
+
+        ; unless (null theta) $
+          addErrTc $
           TcRnIllegalNewtype con show_linear_types HasConstructorContext
 
-        ; checkTc (null ex_tvs) $
-          TcRnIllegalNewtype con show_linear_types HasExistentialTyVar
-
-        ; checkTc (all ok_bang (dataConSrcBangs con)) $
-          TcRnIllegalNewtype con show_linear_types HasStrictnessAnnotation
-    }
+        ; unless (all ok_bang (dataConSrcBangs con)) $
+          addErrTc $
+          TcRnIllegalNewtype con show_linear_types HasStrictnessAnnotation } }
   where
+
     (_univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty)
       = dataConFullSig con
 
-    (arg_ty1 : _) = arg_tys
-
     ok_bang (HsSrcBang _ _ SrcStrict) = False
     ok_bang (HsSrcBang _ _ SrcLazy)   = False
     ok_bang _                         = True


=====================================
compiler/GHC/Tc/TyCl/Build.hs
=====================================
@@ -18,7 +18,7 @@ module GHC.Tc.TyCl.Build (
 import GHC.Prelude
 
 import GHC.Iface.Env
-import GHC.Builtin.Types( isCTupleTyConName, unboxedUnitTy )
+import GHC.Builtin.Types
 
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Utils.Monad
@@ -65,11 +65,12 @@ mkNewTyConRhs tycon_name tycon con
     tvs      = tyConTyVars tycon
     roles    = tyConRoles tycon
     res_kind = tyConResKind tycon
-    con_arg_ty = case dataConRepArgTys con of
-                   [arg_ty] -> scaledThing arg_ty
-                   tys -> pprPanic "mkNewTyConRhs" (ppr con <+> ppr tys)
-    rhs_ty = substTyWith (dataConUnivTyVars con)
-                         (mkTyVarTys tvs) con_arg_ty
+    rhs_ty
+      -- Only try if the newtype is actually valid (see "otherwise" below).
+      | [Scaled _ arg_ty] <- dataConRepArgTys con
+      , null $ dataConExTyCoVars con
+      = substTyWith (dataConUnivTyVars con)
+                         (mkTyVarTys tvs) arg_ty
         -- Instantiate the newtype's RHS with the
         -- type variables from the tycon
         -- NB: a newtype DataCon has a type that must look like
@@ -78,6 +79,13 @@ mkNewTyConRhs tycon_name tycon con
         -- the newtype arising from   class Foo a => Bar a where {}
         -- has a single argument (Foo a) that is a *type class*, so
         -- dataConInstOrigArgTys returns [].
+      | otherwise
+      -- If the newtype is invalid (e.g. doesn't have a single argument),
+      -- we fake up a type here. The newtype will get rejected once we're
+      -- outside the knot-tied loop, in GHC.Tc.TyCl.checkNewDataCon.
+      -- See the various test cases in T23308.
+      = unitTy -- Might be ill-kinded, but checkNewDataCon should reject this
+               -- whole declaration soon enough, before that causes any problems.
 
     -- Eta-reduce the newtype
     -- See Note [Newtype eta] in GHC.Core.TyCon


=====================================
docs/users_guide/debugging.rst
=====================================
@@ -1146,3 +1146,17 @@ Other
     be terminated. This helps narrowing down if an issue is due to tag inference
     if things go wrong. Which would otherwise be quite difficult.
 
+.. ghc-flag:: -funoptimized-core-for-interpreter
+    :shortdesc: Disable optimizations with the interpreter 
+    :reverse: -fno-unoptimized-core-for-interpreter
+    :type: dynamic
+
+    :since: 9.8.1
+
+    default: enabled
+
+    At the moment, ghci disables optimizations, because not all passes
+    are compatible with the interpreter.
+    This option can be used to override this check, e.g.
+    ``ghci -O2 -fno-unoptimized-core-for-interpreter``.
+    It is not recommended for normal use and can cause a compiler panic.


=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -117,9 +117,9 @@ The easiest way to see what ``-O`` (etc.) “really mean” is to run with
    single: -fno-\* options (GHC)
 
 These flags turn on and off individual optimisations. Flags marked as
-on by default are enabled by ``-O``, and as such you shouldn't
-need to set any of them explicitly. A flag ``-fwombat`` can be negated
-by saying ``-fno-wombat``.
+*on* by default are enabled at all optimisation levels by default, and
+as such you shouldn't need to set any of them explicitly. A flag
+``-fwombat`` can be negated by saying ``-fno-wombat``.
 
 .. ghc-flag:: -fcore-constant-folding
     :shortdesc: Enable constant folding in Core. Implied by :ghc-flag:`-O`.
@@ -127,7 +127,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-core-constant-folding
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Enables Core-level constant folding, i.e. propagation of values
     that can be computed at compile time.
@@ -138,7 +138,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-case-merge
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Merge immediately-nested case expressions that scrutinise the same variable.
     For example, ::
@@ -162,7 +162,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-case-folding
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Allow constant folding in case expressions that scrutinise some primops:
     For example, ::
@@ -185,7 +185,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-call-arity
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Enable call-arity analysis.
 
@@ -195,7 +195,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-exitification
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Enables the floating of exit paths out of recursive functions.
 
@@ -205,7 +205,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-cmm-elim-common-blocks
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Enables the common block elimination optimisation
     in the code generator. This optimisation attempts to find identical
@@ -217,7 +217,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-cmm-sink
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Enables the sinking pass in the code generator.
     This optimisation attempts to find identical Cmm blocks and
@@ -231,7 +231,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-cmm-static-pred
     :category:
 
-    :default: off but enabled with :ghc-flag:`-O`.
+    :default: off but enabled by :ghc-flag:`-O`.
 
     This enables static control flow prediction on the final Cmm
     code. If enabled GHC will apply certain heuristics to identify
@@ -244,7 +244,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-cmm-control-flow
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Enables some control flow optimisations in the Cmm code
     generator, merging basic blocks and avoiding jumps right after jumps.
@@ -255,7 +255,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-asm-shortcutting
     :category:
 
-    :default: off
+    :default: off but enabled by :ghc-flag:`-O2`.
 
     This enables shortcutting at the assembly stage of the code generator.
     In simpler terms shortcutting means if a block of instructions A only consists
@@ -268,12 +268,12 @@ by saying ``-fno-wombat``.
     does nothing on macOS.
 
 .. ghc-flag:: -fblock-layout-cfg
-    :shortdesc: Use the new cfg based block layout algorithm.
+    :shortdesc: Use the new cfg based block layout algorithm. Implied by :ghc-flag:`-O`.
     :type: dynamic
     :reverse: -fno-block-layout-cfg
     :category:
 
-    :default: off but enabled with :ghc-flag:`-O`.
+    :default: off but enabled by :ghc-flag:`-O`.
 
     The new algorithm considers all outgoing edges of a basic blocks for
     code layout instead of only the last jump instruction.
@@ -326,7 +326,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-cpr-anal
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Turn on CPR analysis, which enables the worker/wrapper transformation (cf.
     :ghc-flag:`-fworker-wrapper`) to unbox the result of a function, such as ::
@@ -386,7 +386,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-cse
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Enables the common-sub-expression elimination
     optimisation. Switching this off can be useful if you have some
@@ -394,12 +394,12 @@ by saying ``-fno-wombat``.
 
 .. ghc-flag:: -fstg-cse
     :shortdesc: Enable common sub-expression elimination on the STG
-        intermediate language
+        intermediate language. Implied by :ghc-flag:`-O`.
     :type: dynamic
     :reverse: -fno-stg-cse
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Enables the common-sub-expression elimination optimisation on the STG
     intermediate language, where it is able to common up some subexpressions
@@ -422,7 +422,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-dicts-strict
     :category:
 
-    :default: off
+    :default: off but enabled by :ghc-flag:`-O2`.
 
     Make dictionaries strict.
 
@@ -447,7 +447,7 @@ by saying ``-fno-wombat``.
     Behaviour is unconditionally enabled starting with 9.2
 
 .. ghc-flag:: -fdo-eta-reduction
-    :shortdesc: Enable eta-reduction. Implied by :ghc-flag:`-O`.
+    :shortdesc: Enable eta-reduction. Always enabled by default.
     :type: dynamic
     :reverse: -fno-do-eta-reduction
     :category:
@@ -518,7 +518,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-float-in
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Float let-bindings inwards, nearer their binding
     site. See `Let-floating: moving bindings to give faster programs
@@ -544,7 +544,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-full-laziness
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Run the full laziness optimisation (also known as
     let-floating), which floats let-bindings outside enclosing lambdas,
@@ -591,7 +591,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-ignore-asserts
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Causes GHC to ignore uses of the function ``Exception.assert`` in source
     code (in other words, rewriting ``Exception.assert p e`` to ``e`` (see
@@ -603,7 +603,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-ignore-interface-pragmas
     :category:
 
-    :default: off
+    :default: Implied by :ghc-flag:`-O0`, otherwise off.
 
     Tells GHC to ignore all inessential information when reading
     interface files. That is, even if :file:`M.hi` contains unfolding or
@@ -632,7 +632,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-liberate-case
     :category:
 
-    :default: off but enabled with :ghc-flag:`-O2`.
+    :default: off but enabled by :ghc-flag:`-O2`.
 
     Turn on the liberate-case transformation. This unrolls recursive function
     once in its own RHS, to avoid repeated case analysis of free variables. It's
@@ -657,7 +657,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-loopification
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     When this optimisation is enabled the code generator will turn all
     self-recursive saturated tail calls into local jumps rather than
@@ -1074,7 +1074,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-specialise
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Specialise each type-class-overloaded function
     defined in this module for the types at which it is called in this
@@ -1101,12 +1101,12 @@ by saying ``-fno-wombat``.
 
 .. ghc-flag:: -fcross-module-specialise
     :shortdesc: Turn on specialisation of overloaded functions imported from
-        other modules.
+        other modules. Implied by :ghc-flag:`-O`.
     :type: dynamic
     :reverse: -fno-cross-module-specialise
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Specialise ``INLINABLE`` (:ref:`inlinable-pragma`)
     type-class-overloaded functions imported from other modules for the types at
@@ -1136,7 +1136,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-inline-generics
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
     :since: 9.2.1
 
     .. index::
@@ -1175,12 +1175,12 @@ by saying ``-fno-wombat``.
 
 .. ghc-flag:: -fsolve-constant-dicts
     :shortdesc: When solving constraints, try to eagerly solve
-        super classes using available dictionaries.
+        super classes using available dictionaries. Implied by :ghc-flag:`-O`.
     :type: dynamic
     :reverse: -fno-solve-constant-dicts
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     When solving constraints, try to eagerly solve
     super classes using available dictionaries.
@@ -1229,7 +1229,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-stg-lift-lams
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O2`.
 
     Enables the late lambda lifting optimisation on the STG
     intermediate language. This selectively lifts local functions to
@@ -1281,7 +1281,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-strictness
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     Turn on demand analysis.
 
@@ -1441,7 +1441,7 @@ by saying ``-fno-wombat``.
     :reverse: -fno-unbox-small-strict-fields
     :category:
 
-    :default: on
+    :default: off but enabled by :ghc-flag:`-O`.
 
     .. index::
        single: strict constructor fields
@@ -1654,10 +1654,13 @@ by saying ``-fno-wombat``.
 
 
 .. ghc-flag:: -fworker-wrapper
-    :shortdesc: Enable the worker/wrapper transformation.
+    :shortdesc: Enable the worker/wrapper transformation. Implied by :ghc-flag:`-O`
+        and by :ghc-flag:`-fstrictness`.
     :type: dynamic
     :category:
 
+    :default: off but enabled by :ghc-flag:`-O`.
+
     Enable the worker/wrapper transformation after a demand analysis pass.
 
     Exploits strictness and absence information by unboxing strict arguments


=====================================
hadrian/bindist/Makefile
=====================================
@@ -78,7 +78,7 @@ WrapperBinsDir=${bindir}
 
 # N.B. this is duplicated from includes/ghc.mk.
 lib/settings : config.mk
-	$(call removeFiles,$@)
+	@rm -f $@
 	@echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@
 	@echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@
 	@echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@


=====================================
libraries/base/changelog.md
=====================================
@@ -26,6 +26,7 @@
     which provides a mechanism for custom type errors that reports the errors in
     a more predictable behaviour than `TypeError`.
   * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158))
+  * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139))
 
 ## 4.18.0.0 *March 2023*
   * Shipped with GHC 9.6.1


=====================================
testsuite/driver/testlib.py
=====================================
@@ -387,7 +387,7 @@ def expect_fail_for( ways: List[WayName] ):
 
 def expect_broken( bug: IssueNumber ):
     """
-    This test is a expected not to work due to the indicated issue number.
+    This test is expected not to work due to the indicated issue number.
     """
     def helper( name: TestName, opts ):
         record_broken(name, opts, bug)


=====================================
testsuite/tests/simplCore/should_compile/T23267.hs
=====================================
@@ -0,0 +1,25 @@
+module T23267 where
+
+data N = Z | S N
+
+union :: N -> ()
+union Z = ()
+union t = splitS t
+
+splitS :: N -> ()
+splitS Z = ()
+splitS (S l) = splitS l
+
+{- Results in this error:
+
+*** Core Lint errors : in result of SpecConstr ***
+T23267.hs:10:1: warning:
+    Out of scope: l_aBE :: N
+                  [LclId]
+    In the RHS of $ssplitS_sJx :: N -> ()
+    In the body of lambda with binder sc_sJw :: N
+    Substitution: <InScope = {}
+                   IdSubst   = []
+                   TvSubst   = []
+                   CvSubst   = []>
+-}


=====================================
testsuite/tests/simplCore/should_compile/T23267.script
=====================================
@@ -0,0 +1 @@
+:load T23267


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O'])
 test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques'])
 test('T23024', normal, multimod_compile, ['T23024', '-O -v0'])
 test('T23026', normal, compile, ['-O'])
+test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script'])


=====================================
testsuite/tests/simplCore/should_run/T23056.hs
=====================================
@@ -0,0 +1,10 @@
+module Main where
+
+fun :: IO ()
+fun = pure ()
+{-# noinline fun #-}
+
+{-# rules "fun" fun = putStrLn "fun" #-}
+
+main :: IO ()
+main = fun


=====================================
testsuite/tests/simplCore/should_run/T23056.script
=====================================
@@ -0,0 +1,2 @@
+:load T23056
+main


=====================================
testsuite/tests/simplCore/should_run/T23056.stdout
=====================================
@@ -0,0 +1 @@
+fun


=====================================
testsuite/tests/simplCore/should_run/all.T
=====================================
@@ -112,3 +112,4 @@ test('T22998', normal, compile_and_run, ['-O0 -fspecialise -dcore-lint'])
 test('T23184', normal, compile_and_run, ['-O'])
 test('T23134', normal, compile_and_run, ['-O0 -fcatch-nonexhaustive-cases'])
 test('T23289', normal, compile_and_run, [''])
+test('T23056', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23056.script'])


=====================================
testsuite/tests/typecheck/should_fail/T23308.hs
=====================================
@@ -0,0 +1,39 @@
+{-# LANGUAGE DataKinds, UnliftedNewtypes, TypeFamilies #-}
+
+module T23308 where
+
+import Data.Proxy
+import GHC.Exts
+
+-- Check that we don't panic in the middle of typechecking
+-- when there is an invalid newtype in a knot-tied group of TyCons.
+
+data A1 = A1 !B1
+newtype B1 = B1 C1 C1
+data C1 = C1 A1
+
+
+data A2 = A2 !B2
+newtype B2 where { B2 :: forall (x :: C2). Proxy x -> B2 }
+data C2 = C2 A2
+
+type F2' :: forall {k}. k -> TYPE WordRep
+type family F2' a where {}
+data A2' = A2' !B2'
+newtype B2' where { B2' :: forall (x :: C2'). F2' x -> B2' }
+data C2' = C2' A2'
+
+
+data A3 = A3 !B3
+newtype B3 where { B3 :: forall (x :: C2). B2 }
+data C3 = C3 A3
+
+
+data A4 = A4 !(B4 Int)
+newtype B4 a where { B4 :: C4 -> B4 Int }
+data C4 = C4 A4
+
+
+data A5 = A5 !(B5 Int)
+newtype B5 a where { B5 :: Num a => B5 (a, a) }
+data C5 = C5 A5


=====================================
testsuite/tests/typecheck/should_fail/T23308.stderr
=====================================
@@ -0,0 +1,50 @@
+
+T23308.hs:12:14: error: [GHC-23517]
+    • A newtype constructor must have exactly one field
+        but ‘B1’ has two
+      B1 :: C1 -> C1 -> B1
+    • In the definition of data constructor ‘B1’
+      In the newtype declaration for ‘B1’
+
+T23308.hs:17:20: error: [GHC-07525]
+    • A newtype constructor must not have existential type variables
+      B2 :: forall (x :: C2). Proxy x -> B2
+    • In the definition of data constructor ‘B2’
+      In the newtype declaration for ‘B2’
+
+T23308.hs:23:21: error: [GHC-07525]
+    • A newtype constructor must not have existential type variables
+      B2' :: forall (x :: C2'). F2' x -> B2'
+    • In the definition of data constructor ‘B2'’
+      In the newtype declaration for ‘B2'’
+
+T23308.hs:28:20: error: [GHC-45219]
+    • Data constructor ‘B3’ returns type ‘B2’
+        instead of an instance of its parent type ‘B3’
+    • In the definition of data constructor ‘B3’
+      In the newtype declaration for ‘B3’
+
+T23308.hs:33:22: error: [GHC-89498]
+    • A newtype must not be a GADT
+      B4 :: C4 -> B4 Int
+    • In the definition of data constructor ‘B4’
+      In the newtype declaration for ‘B4’
+
+T23308.hs:38:22: error: [GHC-17440]
+    • A newtype constructor must not have a context in its type
+      B5 :: forall a. Num a => B5 (a, a)
+    • In the definition of data constructor ‘B5’
+      In the newtype declaration for ‘B5’
+
+T23308.hs:38:22: error: [GHC-89498]
+    • A newtype must not be a GADT
+      B5 :: forall a. Num a => B5 (a, a)
+    • In the definition of data constructor ‘B5’
+      In the newtype declaration for ‘B5’
+
+T23308.hs:38:22: error: [GHC-23517]
+    • A newtype constructor must have exactly one field
+        but ‘B5’ has none
+      B5 :: forall a. Num a => B5 (a, a)
+    • In the definition of data constructor ‘B5’
+      In the newtype declaration for ‘B5’


=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -676,6 +676,7 @@ test('PatSynExistential', normal, compile_fail, [''])
 test('PatSynArity', normal, compile_fail, [''])
 test('PatSynUnboundVar', normal, compile_fail, [''])
 test('T21444', normal, compile_fail, [''])
+test('T23308', normal, compile_fail, [''])
 test('MultiAssocDefaults', normal, compile_fail, [''])
 test('LazyFieldsDisabled', normal, compile_fail, [''])
 test('TyfamsDisabled', normal, compile_fail, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd29f72fcda44e644b4dcd7650617affff16eca6...967f1758b97889e6d30ca429b5f07b00ff6ec6e7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd29f72fcda44e644b4dcd7650617affff16eca6...967f1758b97889e6d30ca429b5f07b00ff6ec6e7
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/20230511/49a9fe67/attachment-0001.html>


More information about the ghc-commits mailing list