[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: docs: add a section for the wasm backend
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Feb 16 12:16:53 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00
docs: add a section for the wasm backend
Fixes #22658
- - - - -
1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00
tests: Mark T12903 fragile everywhere
See #21184
- - - - -
b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00
Mark all T5435 variants as fragile
See #22970.
- - - - -
df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00
Testsuite: mark T13167 as fragile for JS (#22921)
- - - - -
324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00
JS: disable debugging info for heap objects
- - - - -
6767a2e6 by Josh Meredith at 2023-02-16T07:16:15-05:00
Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching
- - - - -
5c059a03 by Ben Gamari at 2023-02-16T07:16:15-05:00
base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog
Fixes #22883.
- - - - -
17e6fbc7 by Simon Peyton Jones at 2023-02-16T07:16:16-05:00
Narrow the dont-decompose-newtype test
Following #22924 this patch narrows the test that stops
us decomposing newtypes. The key change is the use of
noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp.
We went to and fro on the solution, as you can see in #22924.
The result is carefully documented in
Note [Decomoposing newtype equalities]
On the way I had revert most of
commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date: Mon Dec 5 10:14:02 2022 -0500
Do newtype unwrapping in the canonicaliser and rewriter
See Note [Unwrap newtypes first], which has the details.
It turns out that
(a) 3e827c3f makes GHC behave worse on some recursive newtypes
(see one of the tests on this commit)
(b) the finer-grained test (namely noGivenNewtypeReprEqs) renders
3e827c3f unnecessary
- - - - -
7c701edf by Bodigrim at 2023-02-16T07:16:20-05:00
Documentation: add an example of SPEC usage
- - - - -
25 changed files:
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/JS/Make.hs
- compiler/GHC/StgToJS/Closure.hs
- compiler/GHC/StgToJS/DataCon.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
- compiler/GHC/StgToJS/Rts/Rts.hs
- compiler/GHC/Tc/Solver/Canonical.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- docs/users_guide/index.rst
- + docs/users_guide/wasm.rst
- libraries/base/GHC/Exts.hs
- libraries/base/changelog.md
- libraries/base/tests/all.T
- libraries/ghc-prim/GHC/Types.hs
- testsuite/tests/rts/all.T
- testsuite/tests/rts/linker/all.T
- + testsuite/tests/typecheck/should_compile/T22924.hs
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/typecheck/should_fail/T22924a.hs
- + testsuite/tests/typecheck/should_fail/T22924a.stderr
- + testsuite/tests/typecheck/should_fail/T22924b.hs
- + testsuite/tests/typecheck/should_fail/T22924b.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -1974,7 +1974,7 @@ isInjectiveTyCon :: TyCon -> Role -> Bool
isInjectiveTyCon (TyCon { tyConDetails = details }) role
= go details role
where
- go _ Phantom = True -- Vacuously; (t1 ~P t2) holes for all t1, t2!
+ go _ Phantom = True -- Vacuously; (t1 ~P t2) holds for all t1, t2!
go (AlgTyCon {}) Nominal = True
go (AlgTyCon {algTcRhs = rhs}) Representational
= isGenInjAlgRhs rhs
=====================================
compiler/GHC/JS/Make.hs
=====================================
@@ -126,10 +126,6 @@ module GHC.JS.Make
math_cosh, math_sinh, math_tanh, math_expm1, math_log1p, math_fround
-- * Statement helpers
, decl
- -- * Miscellaneous
- -- $misc
- , allocData, allocClsA
- , dataFieldName, dataFieldNames
)
where
@@ -139,13 +135,10 @@ import GHC.JS.Syntax
import Control.Arrow ((***))
-import Data.Array
import qualified Data.Map as M
-import GHC.Utils.Outputable (Outputable (..))
import GHC.Data.FastString
import GHC.Utils.Monad.State.Strict
-import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Types.Unique.Map
@@ -631,43 +624,6 @@ instance Fractional JExpr where
fromRational x = ValExpr (JDouble (realToFrac x))
---------------------------------------------------------------------------------
--- Miscellaneous
---------------------------------------------------------------------------------
--- $misc
--- Everything else,
-
--- | Cache "dXXX" field names
-dataFieldCache :: Array Int FastString
-dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache])
-
-nFieldCache :: Int
-nFieldCache = 16384
-
-dataFieldName :: Int -> FastString
-dataFieldName i
- | i < 1 || i > nFieldCache = panic "dataFieldName" (ppr i)
- | otherwise = dataFieldCache ! i
-
-dataFieldNames :: [FastString]
-dataFieldNames = fmap dataFieldName [1..nFieldCache]
-
-
--- | Cache "h$dXXX" names
-dataCache :: Array Int FastString
-dataCache = listArray (0,1024) (map (mkFastString . ("h$d"++) . show) [(0::Int)..1024])
-
-allocData :: Int -> JExpr
-allocData i = toJExpr (TxtI (dataCache ! i))
-
--- | Cache "h$cXXX" names
-clsCache :: Array Int FastString
-clsCache = listArray (0,1024) (map (mkFastString . ("h$c"++) . show) [(0::Int)..1024])
-
-allocClsA :: Int -> JExpr
-allocClsA i = toJExpr (TxtI (clsCache ! i))
-
-
--------------------------------------------------------------------------------
-- New Identifiers
--------------------------------------------------------------------------------
=====================================
compiler/GHC/StgToJS/Closure.hs
=====================================
@@ -10,6 +10,15 @@ module GHC.StgToJS.Closure
, assignClosure
, CopyCC (..)
, copyClosure
+ , mkClosure
+ -- $names
+ , allocData
+ , allocClsA
+ , dataName
+ , clsName
+ , dataFieldName
+ , varName
+ , jsClosureCount
)
where
@@ -24,6 +33,9 @@ import GHC.StgToJS.Regs (stack,sp)
import GHC.JS.Make
import GHC.JS.Syntax
+import GHC.Types.Unique.Map
+
+import Data.Array
import Data.Monoid
import qualified Data.Bits as Bits
@@ -154,3 +166,78 @@ copyClosure copy_cc t s = BlockStat
] <> case copy_cc of
DontCopyCC -> mempty
CopyCC -> closureCC t |= closureCC s
+
+mkClosure :: JExpr -> [JExpr] -> JExpr -> Maybe JExpr -> Closure
+mkClosure entry fields meta cc = Closure
+ { clEntry = entry
+ , clField1 = x1
+ , clField2 = x2
+ , clMeta = meta
+ , clCC = cc
+ }
+ where
+ x1 = case fields of
+ [] -> null_
+ x:_ -> x
+ x2 = case fields of
+ [] -> null_
+ [_] -> null_
+ [_,x] -> x
+ _:x:xs -> ValExpr . JHash . listToUniqMap $ zip (map dataFieldName [1..]) (x:xs)
+
+
+-------------------------------------------------------------------------------
+-- Name Caches
+-------------------------------------------------------------------------------
+-- $names
+
+-- | Cache "dXXX" field names
+dataFieldCache :: Array Int FastString
+dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache])
+
+-- | Data names are used in the AST, and logging has determined that 255 is the maximum number we see.
+nFieldCache :: Int
+nFieldCache = 255
+
+-- | We use this in the RTS to determine the number of generated closures. These closures use the names
+-- cached here, so we bind them to the same number.
+jsClosureCount :: Int
+jsClosureCount = 24
+
+dataFieldName :: Int -> FastString
+dataFieldName i
+ | i < 0 || i > nFieldCache = mkFastString ('d' : show i)
+ | otherwise = dataFieldCache ! i
+
+-- | Cache "h$dXXX" names
+dataCache :: Array Int FastString
+dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..jsClosureCount])
+
+dataName :: Int -> FastString
+dataName i
+ | i < 0 || i > nFieldCache = mkFastString ("h$d" ++ show i)
+ | otherwise = dataCache ! i
+
+allocData :: Int -> JExpr
+allocData i = toJExpr (TxtI (dataName i))
+
+-- | Cache "h$cXXX" names
+clsCache :: Array Int FastString
+clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount])
+
+clsName :: Int -> FastString
+clsName i
+ | i < 0 || i > jsClosureCount = mkFastString ("h$c" ++ show i)
+ | otherwise = clsCache ! i
+
+allocClsA :: Int -> JExpr
+allocClsA i = toJExpr (TxtI (clsName i))
+
+-- | Cache "xXXX" names
+varCache :: Array Int Ident
+varCache = listArray (0,jsClosureCount) (map (TxtI . mkFastString . ('x':) . show) [(0::Int)..jsClosureCount])
+
+varName :: Int -> Ident
+varName i
+ | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i)
+ | otherwise = varCache ! i
=====================================
compiler/GHC/StgToJS/DataCon.hs
=====================================
@@ -42,11 +42,9 @@ import GHC.StgToJS.Ids
import GHC.Core.DataCon
import GHC.Types.CostCentre
-import GHC.Types.Unique.Map
import GHC.Utils.Outputable
import GHC.Utils.Panic
-import GHC.Data.FastString
import Data.Maybe
@@ -97,23 +95,11 @@ allocDynamicE :: Bool -- ^ csInlineAlloc from StgToJSConfig
-> Maybe JExpr
-> JExpr
allocDynamicE inline_alloc entry free cc
- | inline_alloc || length free > 24 = newClosure $ Closure
- { clEntry = entry
- , clField1 = fillObj1
- , clField2 = fillObj2
- , clMeta = ValExpr (JInt 0)
- , clCC = cc
- }
+ | inline_alloc || length free > jsClosureCount
+ = newClosure $ mkClosure entry free (ValExpr (JInt 0)) cc
| otherwise = ApplExpr allocFun (toJExpr entry : free ++ maybeToList cc)
where
allocFun = allocClsA (length free)
- (fillObj1,fillObj2)
- = case free of
- [] -> (null_, null_)
- [x] -> (x,null_)
- [x,y] -> (x,y)
- (x:xs) -> (x,toJExpr (JHash $ listToUniqMap (zip dataFields xs)))
- dataFields = map (mkFastString . ('d':) . show) [(1::Int)..]
-- | Allocate a dynamic object
allocDynamic :: StgToJSConfig -> Bool -> Ident -> JExpr -> [JExpr] -> Maybe JExpr -> JStat
=====================================
compiler/GHC/StgToJS/Expr.hs
=====================================
@@ -35,6 +35,7 @@ import GHC.JS.Make
import GHC.StgToJS.Apply
import GHC.StgToJS.Arg
+import GHC.StgToJS.Closure
import GHC.StgToJS.ExprCtx
import GHC.StgToJS.FFI
import GHC.StgToJS.Heap
@@ -1006,7 +1007,7 @@ allocDynAll haveDecl middle cls = do
]
(ex:es) -> mconcat
[ toJExpr i .^ closureField1_ |= toJExpr ex
- , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip dataFieldNames es))
+ , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip (map dataFieldName [1..]) es))
]
| otherwise = case es of
[] -> mempty
=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -867,11 +867,13 @@ linkModules mods = (compact_mods, meta)
statics = nubStaticInfo (concatMap mc_statics mods)
infos = concatMap mc_closures mods
+ debug = False -- TODO: this could be enabled in a debug build.
+ -- It adds debug info to heap objects
meta = mconcat
-- render metadata as individual statements
[ mconcat (map staticDeclStat statics)
, mconcat (map staticInitStat statics)
- , mconcat (map (closureInfoStat True) infos)
+ , mconcat (map (closureInfoStat debug) infos)
]
-- | Only keep a single StaticInfo with a given name
=====================================
compiler/GHC/StgToJS/Rts/Rts.hs
=====================================
@@ -81,36 +81,8 @@ resetResultVar r = toJExpr r |= null_
-- JIT can optimize better.
closureConstructors :: StgToJSConfig -> JStat
closureConstructors s = BlockStat
- [ declClsConstr "h$c" ["f"] $ Closure
- { clEntry = var "f"
- , clField1 = null_
- , clField2 = null_
- , clMeta = 0
- , clCC = ccVal
- }
- , declClsConstr "h$c0" ["f"] $ Closure
- { clEntry = var "f"
- , clField1 = null_
- , clField2 = null_
- , clMeta = 0
- , clCC = ccVal
- }
- , declClsConstr "h$c1" ["f", "x1"] $ Closure
- { clEntry = var "f"
- , clField1 = var "x1"
- , clField2 = null_
- , clMeta = 0
- , clCC = ccVal
- }
- , declClsConstr "h$c2" ["f", "x1", "x2"] $ Closure
- { clEntry = var "f"
- , clField1 = var "x1"
- , clField2 = var "x2"
- , clMeta = 0
- , clCC = ccVal
- }
- , mconcat (map mkClosureCon [3..24])
- , mconcat (map mkDataFill [1..24])
+ [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount]))
+ , mconcat (map mkDataFill [1..jsClosureCount])
]
where
prof = csProf s
@@ -118,19 +90,8 @@ closureConstructors s = BlockStat
-- the cc argument happens to be named just like the cc field...
| prof = ([TxtI closureCC_], Just (var closureCC_))
| otherwise = ([], Nothing)
- addCCArg as = map TxtI as ++ ccArg
addCCArg' as = as ++ ccArg
- declClsConstr i as cl = TxtI i ||= ValExpr (JFunc (addCCArg as)
- ( jVar $ \x ->
- [ checkC
- , x |= newClosure cl
- , notifyAlloc x
- , traceAlloc x
- , returnS x
- ]
- ))
-
traceAlloc x | csTraceRts s = appS "h$traceAlloc" [x]
| otherwise = mempty
@@ -172,29 +133,24 @@ closureConstructors s = BlockStat
| otherwise = mempty
- mkClosureCon :: Int -> JStat
- mkClosureCon n = funName ||= toJExpr fun
+ mkClosureCon :: Maybe Int -> JStat
+ mkClosureCon n0 = funName ||= toJExpr fun
where
- funName = TxtI $ mkFastString ("h$c" ++ show n)
+ n | Just n' <- n0 = n'
+ | Nothing <- n0 = 0
+ funName | Just n' <- n0 = TxtI $ clsName n'
+ | Nothing <- n0 = TxtI $ mkFastString "h$c"
-- args are: f x1 x2 .. xn [cc]
- args = TxtI "f" : addCCArg' (map (TxtI . mkFastString . ('x':) . show) [(1::Int)..n])
+ args = TxtI "f" : addCCArg' (map varName [1..n])
fun = JFunc args funBod
-- x1 goes into closureField1. All the other args are bundled into an
-- object in closureField2: { d1 = x2, d2 = x3, ... }
--
- extra_args = ValExpr . JHash . listToUniqMap $ zip
- (map (mkFastString . ('d':) . show) [(1::Int)..])
- (map (toJExpr . TxtI . mkFastString . ('x':) . show) [2..n])
+ vars = map (toJExpr . varName) [1..n]
funBod = jVar $ \x ->
[ checkC
- , x |= newClosure Closure
- { clEntry = var "f"
- , clField1 = var "x1"
- , clField2 = extra_args
- , clMeta = 0
- , clCC = ccVal
- }
+ , x |= newClosure (mkClosure (var "f") vars 0 ccVal)
, notifyAlloc x
, traceAlloc x
, returnS x
@@ -203,8 +159,8 @@ closureConstructors s = BlockStat
mkDataFill :: Int -> JStat
mkDataFill n = funName ||= toJExpr fun
where
- funName = TxtI $ mkFastString ("h$d" ++ show n)
- ds = map (mkFastString . ('d':) . show) [(1::Int)..n]
+ funName = TxtI $ dataName n
+ ds = map dataFieldName [1..n]
extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds
fun = JFunc (map TxtI ds) (checkD <> returnS extra_args)
@@ -215,7 +171,7 @@ stackManip = mconcat (map mkPush [1..32]) <>
where
mkPush :: Int -> JStat
mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n)
- as = map (TxtI . mkFastString . ('x':) . show) [1..n]
+ as = map varName [1..n]
fun = JFunc as ((sp |= sp + toJExpr n)
<> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a)
[1..] as))
@@ -228,7 +184,7 @@ stackManip = mconcat (map mkPush [1..32]) <>
bits = bitsIdx sig
n = length bits
h = last bits
- args = map (TxtI . mkFastString . ('x':) . show) [1..n]
+ args = map varName [1..n]
fun = JFunc args $
mconcat [ sp |= sp + toJExpr (h+1)
, mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args)
@@ -288,7 +244,7 @@ loadRegs :: JStat
loadRegs = mconcat $ map mkLoad [1..32]
where
mkLoad :: Int -> JStat
- mkLoad n = let args = map (TxtI . mkFastString . ("x"++) . show) [1..n]
+ mkLoad n = let args = map varName [1..n]
assign = zipWith (\a r -> toJExpr r |= toJExpr a)
args (reverse $ take n regsFromR1)
fname = TxtI $ mkFastString ("h$l" ++ show n)
=====================================
compiler/GHC/Tc/Solver/Canonical.hs
=====================================
@@ -1084,7 +1084,7 @@ can_eq_nc' _rewritten _rdr_env _envs ev eq_rel
-- Decompose type constructor applications
-- NB: we have expanded type synonyms already
-can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _
+can_eq_nc' _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _
| Just (tc1, tys1) <- tcSplitTyConApp_maybe ty1
, Just (tc2, tys2) <- tcSplitTyConApp_maybe ty2
-- we want to catch e.g. Maybe Int ~ (Int -> Int) here for better
@@ -1092,7 +1092,7 @@ can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _
-- hence no direct match on TyConApp
, not (isTypeFamilyTyCon tc1)
, not (isTypeFamilyTyCon tc2)
- = canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2
+ = canTyConApp ev eq_rel tc1 tys1 tc2 tys2
can_eq_nc' _rewritten _rdr_env _envs ev eq_rel
s1@(ForAllTy (Bndr _ vis1) _) _
@@ -1114,8 +1114,12 @@ can_eq_nc' True _rdr_env _envs ev NomEq ty1 _ ty2 _
-------------------
-- No similarity in type structure detected. Rewrite and try again.
-can_eq_nc' False _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2
- = rewrite_and_try_again ev eq_rel ps_ty1 ps_ty2
+can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2
+ = -- Rewrite the two types and try again
+ do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ps_ty1
+ ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ps_ty2
+ ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2
+ ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 }
----------------------------
-- Look for a canonical LHS. See Note [Canonical LHS].
@@ -1153,15 +1157,6 @@ can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2
-- No need to call canEqFailure/canEqHardFailure because they
-- rewrite, and the types involved here are already rewritten
--- Rewrite the two types and try again
-rewrite_and_try_again :: CtEvidence -> EqRel -> TcType -> TcType -> TcS (StopOrContinue Ct)
-rewrite_and_try_again ev eq_rel ty1 ty2
- = do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ty1
- ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ty2
- ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2
- ; rdr_env <- getGlobalRdrEnvTcS
- ; envs <- getFamInstEnvs
- ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 }
{- Note [Unsolved equalities]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1407,62 +1402,41 @@ which is easier to satisfy.
Conclusion: we must unwrap newtypes before decomposing them. This happens
in `can_eq_newtype_nc`
-But even this is challenging. Here are two cases to consider:
-
-Case 1:
-
- newtype Age = MkAge Int
- [G] c
- [W] w1 :: IO Age ~R# IO Int
-
-Case 2:
-
- newtype A = MkA [A]
- [W] A ~R# [A]
-
-For Case 1, recall that IO is an abstract newtype. Then read Note
-[Decomposing newtype equalities]. According to that Note, we should not
-decompose w1, because we have an Irred Given. Yet we still want to solve
-the wanted! We can do so by unwrapping the (non-abstract) Age newtype
-underneath the IO, giving
- [W] w2 :: IO Int ~R# IO Int
- w1 = (IO unwrap-Age ; w2)
-where unwrap-Age :: Age ~R# Int. Now we case solve w2 by reflexivity;
-see Note [Eager reflexivity check].
-
-Conclusion: unwrap newtypes (deeply, inside types) in the rewriter:
-specifically in GHC.Tc.Solver.Rewrite.rewrite_newtype_app.
-
-Yet for Case 2, deep rewriting would be a disaster: we would loop.
- [W] A ~R# [A] ---> {unwrap}
- [W] [A] ~R# [[A]]
- ---> {decompose}
- [W] A ~R# [A]
-
-In this case, we just want to unwrap newtypes /at the top level/, allowing us
-to succeed via Note [Eager reflexivity check]:
- [W] A ~R# [A] ---> {unwrap at top level only}
- [W] [A] ~R# [A]
- ---> {reflexivity} success
-
-Conclusion: to satisfy Case 1 and Case 2, we unwrap
-* /both/ at top level, in can_eq_nc'
-* /and/ deeply, in the rewriter, rewrite_newtype_app
-
-The former unwraps outer newtypes (when the data constructor is in scope).
-The latter unwraps deeply -- but it won't be invoked in Case 2, when we can
-recognize an equality between the types [A] and [A] before rewriting
-deeply.
-
-This "before" business is delicate -- there is still a real risk of a loop
-in the type checker with recursive newtypes -- but I think we're doomed to do
-*something* delicate, as we're really trying to solve for equirecursive
-type equality. Bottom line for users: recursive newtypes are dangerous.
-See also Section 5.3.1 and 5.3.4 of
+We did flirt with making the /rewriter/ expand newtypes, rather than
+doing it in `can_eq_newtype_nc`. But with recursive newtypes we want
+to be super-careful about expanding!
+
+ newtype A = MkA [A] -- Recursive!
+
+ f :: A -> [A]
+ f = coerce
+
+We have [W] A ~R# [A]. If we rewrite [A], it'll expand to
+ [[[[[...]]]]]
+and blow the reduction stack. See Note [Newtypes can blow the stack]
+in GHC.Tc.Solver.Rewrite. But if we expand only the /top level/ of
+both sides, we get
+ [W] [A] ~R# [A]
+which we can, just, solve by reflexivity.
+
+So we simply unwrap, on-demand, at top level, in `can_eq_newtype_nc`.
+
+This is all very delicate. There is a real risk of a loop in the type checker
+with recursive newtypes -- but I think we're doomed to do *something*
+delicate, as we're really trying to solve for equirecursive type
+equality. Bottom line for users: recursive newtypes do not play well with type
+inference for representational equality. See also Section 5.3.1 and 5.3.4 of
"Safe Zero-cost Coercions for Haskell" (JFP 2016).
-Another approach -- which we ultimately decided against -- is described in
-Note [Decomposing newtypes a bit more aggressively].
+See also Note [Decomposing newtype equalities].
+
+--- Historical side note ---
+
+We flirted with doing /both/ unwrap-at-top-level /and/ rewrite-deeply;
+see #22519. But that didn't work: see discussion in #22924. Specifically
+we got a loop with a minor variation:
+ f2 :: a -> [A]
+ f2 = coerce
Note [Eager reflexivity check]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1492,6 +1466,24 @@ we do a reflexivity check.
(This would be sound in the nominal case, but unnecessary, and I [Richard
E.] am worried that it would slow down the common case.)
+
+ Note [Newtypes can blow the stack]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we have
+
+ newtype X = MkX (Int -> X)
+ newtype Y = MkY (Int -> Y)
+
+and now wish to prove
+
+ [W] X ~R Y
+
+This Wanted will loop, expanding out the newtypes ever deeper looking
+for a solid match or a solid discrepancy. Indeed, there is something
+appropriate to this looping, because X and Y *do* have the same representation,
+in the limit -- they're both (Fix ((->) Int)). However, no finitely-sized
+coercion will ever witness it. This loop won't actually cause GHC to hang,
+though, because we check our depth in `can_eq_newtype_nc`.
-}
------------------------
@@ -1598,8 +1590,7 @@ canEqCast rewritten ev eq_rel swapped ty1 co1 ty2 ps_ty2
role = eqRelRole eq_rel
------------------------
-canTyConApp :: Bool -- True <=> the types have been rewritten
- -> CtEvidence -> EqRel
+canTyConApp :: CtEvidence -> EqRel
-> TyCon -> [TcType]
-> TyCon -> [TcType]
-> TcS (StopOrContinue Ct)
@@ -1607,17 +1598,13 @@ canTyConApp :: Bool -- True <=> the types have been rewritten
-- See Note [Decomposing Dependent TyCons and Processing Wanted Equalities]
-- Neither tc1 nor tc2 is a saturated funTyCon, nor a type family
-- But they can be data families.
-canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2
+canTyConApp ev eq_rel tc1 tys1 tc2 tys2
| tc1 == tc2
, tys1 `equalLength` tys2
= do { inerts <- getTcSInerts
; if can_decompose inerts
then canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2
- else if rewritten
- then canEqFailure ev eq_rel ty1 ty2
- else rewrite_and_try_again ev eq_rel ty1 ty2 }
- -- Why rewrite and try again? See Case 1
- -- of Note [Unwrap newtypes first]
+ else canEqFailure ev eq_rel ty1 ty2 }
-- See Note [Skolem abstract data] in GHC.Core.Tycon
| tyConSkolem tc1 || tyConSkolem tc2
@@ -1641,7 +1628,7 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2
ty2 = mkTyConApp tc2 tys2
-- See Note [Decomposing TyConApp equalities]
- -- Note [Decomposing newtypes a bit more aggressively]
+ -- and Note [Decomposing newtype equalities]
can_decompose inerts
= isInjectiveTyCon tc1 (eqRelRole eq_rel)
|| (assert (eq_rel == ReprEq) $
@@ -1650,7 +1637,8 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2
-- Moreover isInjectiveTyCon is True for Representational
-- for algebraic data types. So we are down to newtypes
-- and data families.
- ctEvFlavour ev == Wanted && noGivenIrreds inerts)
+ ctEvFlavour ev == Wanted && noGivenNewtypeReprEqs tc1 inerts)
+ -- See Note [Decomposing newtype equalities] (EX2)
{-
Note [Use canEqFailure in canDecomposableTyConApp]
@@ -1838,13 +1826,13 @@ Example is wrinkle {1} in Note [Decomposing TyConApp equalities].
For a Wanted with r=R, since newtypes are not injective at representational
role, decomposition is sound, but we may lose completeness. Nevertheless,
-if the newtype is abstraction (so can't be unwrapped) we can only solve
+if the newtype is abstract (so can't be unwrapped) we can only solve
the equality by (a) using a Given or (b) decomposition. If (a) is impossible
-(e.g. no Givens) then (b) is safe.
+(e.g. no Givens) then (b) is safe albeit potentially incomplete.
-Conclusion: decompose newtypes (at role R) only if there are no usable Givens.
+There are two ways in which decomposing (N ty1) ~r (N ty2) could be incomplete:
-* Incompleteness example (EX1)
+* Incompleteness example (EX1): unwrap first
newtype Nt a = MkNt (Id a)
type family Id a where Id a = a
@@ -1856,39 +1844,68 @@ Conclusion: decompose newtypes (at role R) only if there are no usable Givens.
Conclusion: always unwrap newtypes before attempting to decompose
them. This is done in can_eq_nc'. Of course, we can't unwrap if the data
- constructor isn't in scope. See See Note [Unwrap newtypes first].
+ constructor isn't in scope. See Note [Unwrap newtypes first].
-* Incompleteness example (EX2)
+* Incompleteness example (EX2): available Givens
newtype Nt a = Mk Bool -- NB: a is not used in the RHS,
type role Nt representational -- but the user gives it an R role anyway
- If we have [W] Nt alpha ~R Nt beta, we *don't* want to decompose to
- [W] alpha ~R beta, because it's possible that alpha and beta aren't
- representationally equal.
+ [G] Nt t1 ~R Nt t2
+ [W] Nt alpha ~R Nt beta
- and maybe there is a Given (Nt t1 ~R Nt t2), just waiting to be used, if we
- figure out (elsewhere) that alpha:=t1 and beta:=t2. This is somewhat
- similar to the question of overlapping Givens for class constraints: see
- Note [Instance and Given overlap] in GHC.Tc.Solver.Interact.
+ We *don't* want to decompose to [W] alpha ~R beta, because it's possible
+ that alpha and beta aren't representationally equal. And if we figure
+ out (elsewhere) that alpha:=t1 and beta:=t2, we can solve the Wanted
+ from the Given. This is somewhat similar to the question of overlapping
+ Givens for class constraints: see Note [Instance and Given overlap] in
+ GHC.Tc.Solver.Interact.
Conclusion: don't decompose [W] N s ~R N t, if there are any Given
equalities that could later solve it.
- But what does "any Given equalities that could later solve it" mean, precisely?
- It must be a Given constraint that could turn into N s ~ N t. But that
- could include [G] (a b) ~ (c d), or even just [G] c. But it'll definitely
- be an CIrredCan. So we settle for having no CIrredCans at all, which is
- conservative but safe. See noGivenIrreds and #22331.
+ But what precisely does it mean to say "any Given equalities that could
+ later solve it"?
+
+ In #22924 we had
+ [G] f a ~R# a [W] Const (f a) a ~R# Const a a
+ where Const is an abstract newtype. If we decomposed the newtype, we
+ could solve. Not-decomposing on the grounds that (f a ~R# a) might turn
+ into (Const (f a) a ~R# Const a a) seems a bit silly.
+
+ In #22331 we had
+ [G] N a ~R# N b [W] N b ~R# N a
+ (where N is abstract so we can't unwrap). Here we really /don't/ want to
+ decompose, because the /only/ way to solve the Wanted is from that Given
+ (with a Sym).
+
+ In #22519 we had
+ [G] a <= b [W] IO Age ~R# IO Int
+
+ (where IO is abstract so we can't unwrap, and newtype Age = Int; and (<=)
+ is a type-level comparison on Nats). Here we /must/ decompose, despite the
+ existence of an Irred Given, or we will simply be stuck. (Side note: We
+ flirted with deep-rewriting of newtypes (see discussion on #22519 and
+ !9623) but that turned out not to solve #22924, and also makes type
+ inference loop more often on recursive newtypes.)
+
+ The currently-implemented compromise is this:
+
+ we decompose [W] N s ~R# N t unless there is a [G] N s' ~ N t'
+
+ that is, a Given Irred equality with both sides headed with N.
+ See the call to noGivenNewtypeReprEqs in canTyConApp.
+
+ This is not perfect. In principle a Given like [G] (a b) ~ (c d), or
+ even just [G] c, could later turn into N s ~ N t. But since the free
+ vars of a Given are skolems, or at least untouchable unification
+ variables, this is extremely unlikely to happen.
- Well not 100.0% safe. There could be a CDictCan with some un-expanded
- superclasses; but only in some very obscure recursive-superclass
- situations.
+ Another worry: there could, just, be a CDictCan with some
+ un-expanded equality superclasses; but only in some very obscure
+ recursive-superclass situations.
-If there are no Irred Givens (which is quite common) then we will
-successfuly decompose [W] (IO Age) ~R (IO Int), and solve it. But
-that won't happen and [W] (IO Age) ~R (IO Int) will be stuck.
-We /could/, however, be a bit more aggressive about decomposition;
-see Note [Decomposing newtypes a bit more aggressively].
+ Yet another approach (!) is desribed in
+ Note [Decomposing newtypes a bit more aggressively].
Remember: decomposing Wanteds is always /sound/. This Note is
only about /completeness/.
@@ -1896,7 +1913,8 @@ only about /completeness/.
Note [Decomposing newtypes a bit more aggressively]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
IMPORTANT: the ideas in this Note are *not* implemented. Instead, the
-current approach is detailed in Note [Unwrap newtypes first].
+current approach is detailed in Note [Decomposing newtype equalities]
+and Note [Unwrap newtypes first].
For more details about the ideas in this Note see
* GHC propoosal: https://github.com/ghc-proposals/ghc-proposals/pull/549
* issue #22441
=====================================
compiler/GHC/Tc/Solver/InertSet.hs
=====================================
@@ -21,7 +21,7 @@ module GHC.Tc.Solver.InertSet (
addInertItem,
noMatchableGivenDicts,
- noGivenIrreds,
+ noGivenNewtypeReprEqs,
mightEqualLater,
prohibitedSuperClassSolve,
@@ -1537,9 +1537,22 @@ isOuterTyVar tclvl tv
-- becomes "outer" even though its level numbers says it isn't.
| otherwise = False -- Coercion variables; doesn't much matter
-noGivenIrreds :: InertSet -> Bool
-noGivenIrreds (IS { inert_cans = inert_cans })
- = isEmptyBag (inert_irreds inert_cans)
+noGivenNewtypeReprEqs :: TyCon -> InertSet -> Bool
+-- True <=> there is no Irred looking like (N tys1 ~ N tys2)
+-- See Note [Decomposing newtype equalities] (EX2) in GHC.Tc.Solver.Canonical
+-- This is the only call site.
+noGivenNewtypeReprEqs tc inerts
+ = not (anyBag might_help (inert_irreds (inert_cans inerts)))
+ where
+ might_help ct
+ = case classifyPredType (ctPred ct) of
+ EqPred ReprEq t1 t2
+ | Just (tc1,_) <- tcSplitTyConApp_maybe t1
+ , tc == tc1
+ , Just (tc2,_) <- tcSplitTyConApp_maybe t2
+ , tc == tc2
+ -> True
+ _ -> False
-- | Returns True iff there are no Given constraints that might,
-- potentially, match the given class consraint. This is used when checking to see if a
=====================================
compiler/GHC/Tc/Solver/Rewrite.hs
=====================================
@@ -42,7 +42,6 @@ import GHC.Builtin.Types (tYPETyCon)
import Data.List ( find )
import GHC.Data.List.Infinite (Infinite)
import qualified GHC.Data.List.Infinite as Inf
-import GHC.Tc.Instance.Family (tcTopNormaliseNewTypeTF_maybe)
{-
************************************************************************
@@ -225,10 +224,10 @@ rewrite ev ty
; return result }
-- | See Note [Rewriting]
--- This variant of 'rewrite' rewrites w.r.t. nominal equality only,
--- as this is better than full rewriting for error messages. Specifically,
--- we want to avoid unwrapping newtypes, as doing so can end up causing
--- an otherwise-unnecessary stack overflow.
+-- `rewriteForErrors` is a variant of 'rewrite' that rewrites
+-- w.r.t. nominal equality only, as this is better than full rewriting
+-- for error messages. (This was important when we flirted with rewriting
+-- newtypes but perhaps less so now.)
rewriteForErrors :: CtEvidence -> TcType
-> TcS (Reduction, RewriterSet)
rewriteForErrors ev ty
@@ -499,27 +498,14 @@ rewrite_one (TyVarTy tv)
rewrite_one (AppTy ty1 ty2)
= rewrite_app_tys ty1 [ty2]
-rewrite_one ty@(TyConApp tc tys)
+rewrite_one (TyConApp tc tys)
-- If it's a type family application, try to reduce it
| isTypeFamilyTyCon tc
= rewrite_fam_app tc tys
- | otherwise
- = do { eq_rel <- getEqRel
- ; if eq_rel == ReprEq
-
- then -- Rewriting w.r.t. representational equality requires
- -- unwrapping newtypes; see GHC.Tc.Solver.Canonical.
- -- Note [Unwrap newtypes first]
- -- NB: try rewrite_newtype_app even when tc isn't a newtype;
- -- the allows the possibility of having a newtype buried under
- -- a synonym. Needed for e.g. T12067.
- rewrite_newtype_app ty
-
- else -- For * a normal data type application
- -- * data family application
- -- we just recursively rewrite the arguments.
- rewrite_ty_con_app tc tys }
+ | otherwise -- We just recursively rewrite the arguments.
+ -- See Note [Do not rewrite newtypes]
+ = rewrite_ty_con_app tc tys
rewrite_one (FunTy { ft_af = vis, ft_mult = mult, ft_arg = ty1, ft_res = ty2 })
= do { arg_redn <- rewrite_one ty1
@@ -678,42 +664,12 @@ rewrite_vector ki roles tys
fvs = tyCoVarsOfType ki
{-# INLINE rewrite_vector #-}
--- Rewrite a (potential) newtype application
--- Precondition: the ambient EqRel is ReprEq
--- Precondition: the type is a TyConApp
--- See Note [Newtypes can blow the stack]
-rewrite_newtype_app :: TcType -> RewriteM Reduction
-rewrite_newtype_app ty@(TyConApp tc tys)
- = do { rdr_env <- liftTcS getGlobalRdrEnvTcS
- ; tf_envs <- liftTcS getFamInstEnvs
- ; case (tcTopNormaliseNewTypeTF_maybe tf_envs rdr_env ty) of
- Nothing -> -- Non-newtype or abstract newtype
- rewrite_ty_con_app tc tys
-
- Just ((used_ctors, co), ty') -- co :: ty ~ ty'
- -> do { liftTcS $ recordUsedGREs used_ctors
- ; checkStackDepth ty
- ; rewrite_reduction (Reduction co ty') } }
-
-rewrite_newtype_app other_ty = pprPanic "rewrite_newtype_app" (ppr other_ty)
-
-{- Note [Newtypes can blow the stack]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Suppose we have
-
- newtype X = MkX (Int -> X)
- newtype Y = MkY (Int -> Y)
-
-and now wish to prove
-
- [W] X ~R Y
-This Wanted will loop, expanding out the newtypes ever deeper looking
-for a solid match or a solid discrepancy. Indeed, there is something
-appropriate to this looping, because X and Y *do* have the same representation,
-in the limit -- they're both (Fix ((->) Int)). However, no finitely-sized
-coercion will ever witness it. This loop won't actually cause GHC to hang,
-though, because we check our depth when unwrapping newtypes.
+{- Note [Do not rewrite newtypes]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We flirted with unwrapping newtypes in the rewriter -- see GHC.Tc.Solver.Canonical
+Note [Unwrap newtypes first]. But that turned out to be a bad idea because
+of recursive newtypes, as that Note says. So be careful if you re-add it!
Note [Rewriting synonyms]
~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/index.rst
=====================================
@@ -23,6 +23,7 @@ Contents:
hints
utils
win32-dlls
+ wasm
bugs
eventlog-formats
editing-guide
@@ -33,4 +34,3 @@ Indices and tables
* :ref:`genindex`
* :ref:`search`
-
=====================================
docs/users_guide/wasm.rst
=====================================
@@ -0,0 +1,101 @@
+.. _wasm:
+
+Using the GHC WebAssembly backend
+=================================
+
+.. _wasm-clarify:
+
+What does the WebAssembly “backend” mean
+----------------------------------------
+
+In order to compile Haskell to wasm, you need a custom GHC build that
+targets wasm. There isn't a GHC option which allows you to use a
+stock GHC installed via ``ghcup`` or ``stack`` to generate wasm. That’s
+because GHC is still a single-target compiler, so each GHC build is only
+capable of compiling code that runs on a single architecture and operating
+system.
+
+So, the term GHC wasm backend isn’t the same sense as the
+unregisterised/LLVM/NCG backends. It merely describes GHC’s support as a
+cross compiler that targets wasm, and more specifically,
+``wasm32-wasi``.
+
+The generated wasm module makes use of a few post-MVP extensions that
+are supported by default in latest releases of
+Chrome/Firefox/Safari/`wasmtime <https://wasmtime.dev>`__. The wasm
+module uses `WASI <https://wasi.dev>`__ as the system call layer, so
+it’s supported by any wasm engine that implements WASI (including
+browsers, which can provide the WASI layer via JavaScript).
+
+.. _wasm-setup:
+
+Setting up the GHC wasm backend
+-------------------------------
+
+The wasm backend is still a tech preview and not included in the
+official bindists yet. If you are using x86_64-linux, you can follow the
+“getting started” subsections in
+`ghc-wasm-meta <https://gitlab.haskell.org/ghc/ghc-wasm-meta>`__ to
+quickly set up the GHC wasm backend using the nightly artifacts.
+
+It’s also possible to build the GHC wasm backend manually, if your host
+system is one of {x86_64,aarch64}-{linux,darwin}. Refer to the
+``ghc-wasm-meta`` readme for detailed instructions.
+
+.. _wasm-compile:
+
+Using the GHC wasm backend to compile & link code
+-------------------------------------------------
+
+Once the GHC wasm backend is set up, you can use it to compile and link
+code. The compiler executables follow the cross compiler linking
+convention, so you need to call ``wasm32-wasi-ghc``,
+``wasm32-wasi-ghc-pkg`` and ``wasm32-wasi-hsc2hs`` instead of ``ghc``,
+``ghc-pkg`` and ``hsc2hs``.
+
+You can also use the ``--with-compiler=``, ``--with-hc-pkg=`` and
+``--with-hsc2hs`` flags of ``cabal`` to build cabal projects. The
+``wasm32-wasi-cabal`` wrapper script set up by the ``ghc-wasm-meta``
+installer does this automatically for you, but using flags manually also
+works with stock ``cabal`` installations. When ``cabal`` builds an
+executable component, that executable will be built as a wasm module,
+and you can use ``cabal list-bin exe:foo`` to find the wasm module’s
+location in the build directory.
+
+.. _wasm-run:
+
+Running the GHC wasm backend’s output
+-------------------------------------
+
+Once you have a wasm module, you can run it with a dedicated wasm engine
+like ``wasmtime``, or inside the browsers.
+
+To run it with ``wasmtime``, you can simply do:
+
+.. code:: sh
+
+ $ wasmtime run foo.wasm
+
+Just like native executables, you can pass command line arguments, and
+also RTS options, as long as it’s built with ``-rtsopts``:
+
+.. code:: sh
+
+ $ wasmtime run foo.wasm --bar +RTS --nonmoving-gc -RTS
+
+You can also mount some host directory into it:
+
+.. code:: sh
+
+ $ wasmtime run --mapdir /::$PWD foo.wasm
+
+As long as the filesystem capability is provided, in addition to
+filesystem I/O in Haskell code, you can use the RTS eventlog and
+profiling functionality, then inspect the report files:
+
+.. code:: sh
+
+ $ wasmtime run --mapdir /::$PWD foo.wasm +RTS -hc -l -RTS
+
+To run the wasm module in the browsers, refer to the ``ghc-wasm-meta``
+documentation for more details.
=====================================
libraries/base/GHC/Exts.hs
=====================================
@@ -203,8 +203,11 @@ traceEvent = Debug.Trace.traceEventIO
* *
********************************************************************** -}
--- Annotating a type with NoSpecConstr will make SpecConstr
--- not specialise for arguments of that type.
+-- | Deprecated, use 'SPEC' directly instead.
+--
+-- Annotating a type with 'NoSpecConstr' will make @SpecConstr@
+-- not specialise for arguments of that type,
+-- e. g., @{-# ANN type SPEC ForceSpecConstr #-}@.
-- This data type is defined here, rather than in the SpecConstr module
-- itself, so that importing it doesn't force stupidly linking the
=====================================
libraries/base/changelog.md
=====================================
@@ -6,6 +6,7 @@
types significantly.
## 4.18.0.0 *TBA*
+
* `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified
pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117))
* Add `forall a. Functor (p a)` superclass for `Bifunctor p` ([CLC proposal #91](https://github.com/haskell/core-libraries-committee/issues/91))
@@ -68,6 +69,13 @@
* Add `Data.Typeable.heqT`, a kind-heterogeneous version of
`Data.Typeable.eqT`
([CLC proposal #99](https://github.com/haskell/core-libraries-committee/issues/99))
+ * Various declarations GHC's new info-table provenance feature have been
+ moved from `GHC.Stack.CCS` to a new `GHC.InfoProv` module:
+ * The `InfoProv`, along its `ipName`, `ipDesc`, `ipTyDesc`, `ipLabel`,
+ `ipMod`, and `ipLoc` fields, have been moved.
+ * `InfoProv` now has additional `ipSrcFile` and `ipSrcSpan` fields. `ipLoc`
+ is now a function computed from these fields.
+ * The `whereFrom` function has been moved
## 4.17.0.0 *August 2022*
=====================================
libraries/base/tests/all.T
=====================================
@@ -271,7 +271,8 @@ test('T13167',
[ when(opsys('mingw32')
, only_ways(['winio', 'winio_threaded']))
, fragile_for(16536, concurrent_ways)
- , js_broken(22261)
+ # fragile on JS
+ , when(js_arch(), fragile(22921))
],
compile_and_run, [''])
test('T15183', normal, compile_and_run, [''])
=====================================
libraries/ghc-prim/GHC/Types.hs
=====================================
@@ -435,7 +435,25 @@ you're reading this in 2023 then things went wrong). See #8326.
-- specializations. However, not all loops fall into this category.
--
-- Libraries can specify this by using 'SPEC' data type to inform which
--- loops should be aggressively specialized.
+-- loops should be aggressively specialized. For example,
+-- instead of
+--
+-- > loop x where loop arg = ...
+--
+-- write
+--
+-- > loop SPEC x where loop !_ arg = ...
+--
+-- There is no semantic difference between 'SPEC' and 'SPEC2',
+-- we just need a type with two contructors lest it is optimised away
+-- before @SpecConstr at .
+--
+-- This type is reexported from "GHC.Exts" since GHC 9.0 and @base-4.15 at .
+-- For compatibility with earlier releases import it from "GHC.Types"
+-- in @ghc-prim@ package.
+--
+-- @since 0.3.1.0
+--
data SPEC = SPEC | SPEC2
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -418,13 +418,9 @@ test('T12497', [ unless(opsys('mingw32'), skip), expect_broken(22694)
test('T13617', [ unless(opsys('mingw32'), skip)],
makefile_test, ['T13617'])
-# This test sometimes produces out of sequence samples in the profasm way, but
-# not reliably, so we just skip it. See ticket #15065.
-# Test is being skipped on darwin due to it's flakiness.
-test('T12903', [ when(opsys('mingw32'), skip)
- , when(opsys('darwin'), skip)
- , when(arch('i386'), fragile(20377))
- , omit_ways(['ghci', 'profasm'])
+# Test is fragile on all systems. #21184 links to various other reports through
+# its history.
+test('T12903', [ fragile(21184)
, js_broken(22374)]
, compile_and_run, [''])
=====================================
testsuite/tests/rts/linker/all.T
=====================================
@@ -59,6 +59,7 @@ def checkDynAsm(actual_file, normaliser):
test('T5435_v_asm_a',
[extra_files(['T5435.hs', 'T5435_asm.c']),
req_rts_linker,
+ fragile(22970),
when(arch('arm'), expect_broken(17559)),
when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))],
makefile_test, ['T5435_v_asm_a'])
@@ -67,6 +68,7 @@ test('T5435_v_asm_a',
test('T5435_v_asm_b',
[extra_files(['T5435.hs', 'T5435_asm.c']),
req_rts_linker,
+ fragile(22970),
when(arch('arm'), expect_broken(17559)),
when(opsys('darwin') or opsys('mingw32'), skip),
when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))],
@@ -74,16 +76,19 @@ test('T5435_v_asm_b',
test('T5435_v_gcc',
[extra_files(['T5435.hs', 'T5435_gcc.c']),
req_rts_linker,
+ fragile(22970),
when(arch('arm'), expect_broken(17559)),
when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))],
makefile_test, ['T5435_v_gcc'])
test('T5435_dyn_asm',
[extra_files(['T5435.hs', 'T5435_asm.c']),
+ fragile(22970),
js_skip, # dynamic linking not supported by the JS backend
check_stdout(checkDynAsm)],
makefile_test, ['T5435_dyn_asm'])
test('T5435_dyn_gcc',
[extra_files(['T5435.hs', 'T5435_gcc.c']),
+ fragile(22970),
js_skip], # dynamic linking not supported by the JS backend
makefile_test, ['T5435_dyn_gcc'])
=====================================
testsuite/tests/typecheck/should_compile/T22924.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE FlexibleInstances #-}
+module G where
+
+import Data.Functor.Const( Const )
+import Data.Coerce
+
+f :: Coercible (f a) a => Const a () -> Const (f a) ()
+f = coerce
+
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -860,3 +860,5 @@ test('T21501', normal, compile, [''])
test('T20666b', normal, compile, [''])
test('T22891', normal, compile, [''])
test('T22912', normal, compile, [''])
+test('T22924', normal, compile, [''])
+
=====================================
testsuite/tests/typecheck/should_fail/T22924a.hs
=====================================
@@ -0,0 +1,9 @@
+module T22924a where
+
+import Data.Coerce
+
+newtype R = MkR [R]
+
+f :: a -> [R]
+-- Should give a civilised error
+f = coerce
=====================================
testsuite/tests/typecheck/should_fail/T22924a.stderr
=====================================
@@ -0,0 +1,11 @@
+
+T22924a.hs:9:5: error: [GHC-10283]
+ • Couldn't match representation of type ‘a’ with that of ‘[R]’
+ arising from a use of ‘coerce’
+ ‘a’ is a rigid type variable bound by
+ the type signature for:
+ f :: forall a. a -> [R]
+ at T22924a.hs:7:1-13
+ • In the expression: coerce
+ In an equation for ‘f’: f = coerce
+ • Relevant bindings include f :: a -> [R] (bound at T22924a.hs:9:1)
=====================================
testsuite/tests/typecheck/should_fail/T22924b.hs
=====================================
@@ -0,0 +1,10 @@
+module T22924b where
+
+import Data.Coerce
+
+newtype R = MkR [R]
+newtype S = MkS [S]
+
+f :: R -> S
+-- Blows the typechecker reduction stack
+f = coerce
=====================================
testsuite/tests/typecheck/should_fail/T22924b.stderr
=====================================
@@ -0,0 +1,10 @@
+
+T22924b.hs:10:5: error:
+ • Reduction stack overflow; size = 201
+ When simplifying the following type: R
+ Use -freduction-depth=0 to disable this check
+ (any upper bound you could choose might fail unpredictably with
+ minor updates to GHC, so disabling the check is recommended if
+ you're sure that type checking should terminate)
+ • In the expression: coerce
+ In an equation for ‘f’: f = coerce
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -667,3 +667,6 @@ test('T22570', normal, compile_fail, [''])
test('T22645', normal, compile_fail, [''])
test('T20666', normal, compile, ['']) # To become compile_fail after migration period (see #22912)
test('T20666a', normal, compile, ['']) # To become compile_fail after migration period (see #22912)
+test('T22924a', normal, compile_fail, [''])
+test('T22924b', normal, compile_fail, [''])
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ca8be00c150fb25cfc29558a6f91675968abb7c...7c701edf86a175d72b620fd00b948a47071a8176
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ca8be00c150fb25cfc29558a6f91675968abb7c...7c701edf86a175d72b620fd00b948a47071a8176
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/20230216/0ed6ef44/attachment-0001.html>
More information about the ghc-commits
mailing list