[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: testsuite: Delay querying ghc-pkg to find .so dirs until test is run
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Jul 20 07:24:02 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
bace981e by Matthew Pickering at 2024-07-19T10:14:02-04:00
testsuite: Delay querying ghc-pkg to find .so dirs until test is run
The tests which relied on find_so would fail when `test` was run
before the tree was built. This was because `find_so` was evaluated too
eagerly.
We can fix this by waiting to query the location of the libraries until
after the compiler has built them.
- - - - -
478de1ab by Torsten Schmits at 2024-07-19T10:14:37-04:00
Add `complete` pragmas for backwards compat patsyns `ModLocation` and `ModIface`
!12347 and !12582 introduced breaking changes to these two constructors
and mitigated that with pattern synonyms.
- - - - -
b57792a8 by Matthew Pickering at 2024-07-19T10:15:13-04:00
ci: Fix ghcup-metadata generation (again)
I made some mistakes in 203830065b81fe29003c1640a354f11661ffc604
* Syntax error
* The aarch-deb11 bindist doesn't exist
I tested against the latest nightly pipeline locally:
```
nix run .gitlab/generate-ci#generate-job-metadata
nix shell -f .gitlab/rel_eng/ -c ghcup-metadata --pipeline-id 98286 --version 9.11.20240715 --fragment --date 2024-07-17 --metadata=/tmp/meta
```
- - - - -
7c5b9cdd by Matthew Pickering at 2024-07-19T15:39:14+01:00
Revert "Make type-equality on synonyms a bit faster"
This reverts commit 280e4bf5ca62ec51eaeedd04b0db78b085257ab8.
This patch causes core lint errors, hasty revert as it is purely a
performance commit.
Ticket #25094
- - - - -
557235ae by Matthew Pickering at 2024-07-19T16:10:39+01:00
Add test for T25094
This test is minimised from hashtables library, before the revert it
fails with:
```
T25094.hs:84:18: warning:
Type of case alternatives not the same as the annotation on case:
Actual type: ST s_a12L (Bucket s_a12L Any Any)
Annotation on case: ST s_a12L (Bucket s_a12L k_a12M v_a12N)
```
See #25094
- - - - -
1fda29d1 by Andreas Klebinger at 2024-07-20T03:23:47-04:00
Revert "Allow non-absolute values for bootstrap GHC variable"
This broke configure in subtle ways resulting in #25076 where hadrian
didn't end up the boot compiler it was configured to use.
This reverts commit 209d09f52363b261b900cf042934ae1e81e2caa7.
- - - - -
14 changed files:
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/Core/Map/Type.hs
- compiler/GHC/Core/TyCo/Compare.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModIface.hs
- configure.ac
- testsuite/driver/testlib.py
- + testsuite/tests/deSugar/should_compile/T25094.hs
- testsuite/tests/deSugar/should_compile/all.T
Changes:
=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -205,7 +205,6 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
deb11 = mk(debian(11, "x86_64"))
deb12 = mk(debian(12, "x86_64"))
deb10_arm64 = mk(debian(10, "aarch64"))
- deb11_arm64 = mk(debian(11, "aarch64"))
deb12_arm64 = mk(debian(12, "aarch64"))
deb10_i386 = mk(debian(10, "i386"))
deb12_i386 = mk(debian(12, "i386"))
@@ -243,7 +242,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
a32 = { "Linux_Debian": { "( >= 10 && < 12 )": deb10_i386
, ">= 12": deb12_i386
- , "unknown versioning": deb10_i386 }}
+ , "unknown versioning": deb10_i386 }
, "Linux_Ubuntu": { "unknown_versioning": deb10_i386 }
, "Linux_Mint" : { "unknown_versioning": deb10_i386 }
, "Linux_UnknownLinux" : { "unknown_versioning": deb10_i386 }
@@ -251,8 +250,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
arm64 = { "Linux_UnknownLinux": { "unknown_versioning": deb10_arm64 }
, "Linux_Alpine" : { "unknown_versioning": alpine3_18_arm64 }
- , "Linux_Debian": { "( >= 10 && < 11 )": deb10_arm64
- , "( >= 11 && < 12 )": deb11_arm64
+ , "Linux_Debian": { "( >= 10 && < 12 )": deb10_arm64
, "( >= 12 )": deb12_arm64
, "unknown_versioning": deb10_arm64
}
=====================================
compiler/GHC/Core/Map/Type.hs
=====================================
@@ -38,7 +38,6 @@ import GHC.Prelude
import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Core.TyCo.Rep
-import GHC.Core.TyCon( isForgetfulSynTyCon )
import GHC.Core.TyCo.Compare( eqForAllVis )
import GHC.Data.TrieMap
@@ -229,11 +228,10 @@ eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) =
andEq TEQX e = hasCast e
andEq TEQ e = e
- -- See Note [Comparing type synonyms] in GHC.Core.TyCo.Compare
- go (D env1 (TyConApp tc1 tys1)) (D env2 (TyConApp tc2 tys2))
- | tc1 == tc2, not (isForgetfulSynTyCon tc1)
- = gos env1 env2 tys1 tys2
-
+ -- See Note [Comparing nullary type synonyms] in GHC.Core.TyCo.Compare
+ go (D _ (TyConApp tc1 [])) (D _ (TyConApp tc2 []))
+ | tc1 == tc2
+ = TEQ
go env_t@(D env t) env_t'@(D env' t')
| Just new_t <- coreView t = go (D env new_t) env_t'
| Just new_t' <- coreView t' = go env_t (D env' new_t')
=====================================
compiler/GHC/Core/TyCo/Compare.hs
=====================================
@@ -138,52 +138,35 @@ But the left is an AppTy while the right is a TyConApp. The solution is
to use splitAppTyNoView_maybe to break up the TyConApp into its pieces and
then continue. Easy to do, but also easy to forget to do.
-Note [Comparing type synonyms]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Comparing nullary type synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the task of testing equality between two 'Type's of the form
- TyConApp tc tys1 = TyConApp tc tys2
+ TyConApp tc []
-where `tc` is a type synonym. A naive way to perform this comparison these
+where @tc@ is a type synonym. A naive way to perform this comparison these
would first expand the synonym and then compare the resulting expansions.
-However, this is obviously wasteful and the RHS of `tc` may be large. We'd
-prefer to compare `tys1 = tys2`. When is that sound? Precisely when the
-synonym is not /forgetful/; that is, all its type variables appear in its
-RHS -- see `GHC.Core.TyCon.isForgetfulSynTyCon`.
-
-Of course, if we find that the TyCons are *not* equal then we still need to
-perform the expansion as their RHSs may still be equal.
-
-This works fine for /equality/, but not for /comparison/. Consider
- type S a b = (b, a)
-Now consider
- S Int Bool `compare` S Char Char
-The ordering may depend on whether we expand the synonym or not, and we
-don't want the result to depend on that. So for comparison we stick to
-/nullary/ synonyms only, which is still useful.
+However, this is obviously wasteful and the RHS of @tc@ may be large; it is
+much better to rather compare the TyCons directly. Consequently, before
+expanding type synonyms in type comparisons we first look for a nullary
+TyConApp and simply compare the TyCons if we find one. Of course, if we find
+that the TyCons are *not* equal then we still need to perform the expansion as
+their RHSs may still be equal.
We perform this optimisation in a number of places:
- * GHC.Core.TyCo.Compare.eqType (works for non-nullary synonyms)
- * GHC.Core.Map.TYpe.eqDeBruijnType (works for non-nullary synonyms)
- * GHC.Core.Types.nonDetCmpType (nullary only)
+ * GHC.Core.Types.eqType
+ * GHC.Core.Types.nonDetCmpType
+ * GHC.Core.Unify.unify_ty
+ * GHC.Tc.Solver.Equality.can_eq_nc'
+ * TcUnify.uType
This optimisation is especially helpful for the ubiquitous GHC.Types.Type,
since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications
whenever possible. See Note [Using synonyms to compress types] in
GHC.Core.Type for details.
-Currently-missed opportunity (#25009):
-* In the case of forgetful synonyms, we could still compare the args, pairwise,
- and then compare the RHS's with a suitably extended RnEnv2. That would avoid
- comparing the same arg repeatedly. e.g.
- type S a b = (a,a)
- Compare S <big> y ~ S <big> y
- If we expand, we end up compare <big> with itself twice.
-
- But since forgetful synonyms are rare, we have not tried this.
-
Note [Type comparisons using object pointer comparisons]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Quite often we substitute the type from a definition site into
@@ -358,26 +341,16 @@ inline_generic_eq_type_x syn_flag mult_flag mb_env
= \ t1 t2 -> t1 `seq` t2 `seq`
let go = generic_eq_type_x syn_flag mult_flag mb_env
-- Abbreviation for recursive calls
-
- gos [] [] = True
- gos (t1:ts1) (t2:ts2) = go t1 t2 && gos ts1 ts2
- gos _ _ = False
-
in case (t1,t2) of
_ | 1# <- reallyUnsafePtrEquality# t1 t2 -> True
-- See Note [Type comparisons using object pointer comparisons]
- (TyConApp tc1 tys1, TyConApp tc2 tys2)
- | tc1 == tc2, not (isForgetfulSynTyCon tc1) -- See Note [Comparing type synonyms]
- -> gos tys1 tys2
+ (TyConApp tc1 [], TyConApp tc2 []) | tc1 == tc2 -> True
+ -- See Note [Comparing nullary type synonyms]
_ | ExpandSynonyms <- syn_flag, Just t1' <- coreView t1 -> go t1' t2
| ExpandSynonyms <- syn_flag, Just t2' <- coreView t2 -> go t1 t2'
- (TyConApp tc1 ts1, TyConApp tc2 ts2)
- | tc1 == tc2 -> gos ts1 ts2
- | otherwise -> False
-
(TyVarTy tv1, TyVarTy tv2)
-> case mb_env of
Nothing -> tv1 == tv2
@@ -408,6 +381,14 @@ inline_generic_eq_type_x syn_flag mult_flag mb_env
| Just (s1, t1') <- tcSplitAppTyNoView_maybe t1
-> go s1 s2 && go t1' t2'
+ (TyConApp tc1 ts1, TyConApp tc2 ts2)
+ | tc1 == tc2 -> gos ts1 ts2
+ | otherwise -> False
+ where
+ gos [] [] = True
+ gos (t1:ts1) (t2:ts2) = go t1 t2 && gos ts1 ts2
+ gos _ _ = False
+
(ForAllTy (Bndr tv1 vis1) body1, ForAllTy (Bndr tv2 vis2) body2)
-> case mb_env of
Nothing -> generic_eq_type_x syn_flag mult_flag
@@ -685,11 +666,10 @@ nonDetCmpTypeX env orig_t1 orig_t2 =
-- Returns both the resulting ordering relation between
-- the two types and whether either contains a cast.
go :: RnEnv2 -> Type -> Type -> TypeOrdering
-
+ -- See Note [Comparing nullary type synonyms]
go _ (TyConApp tc1 []) (TyConApp tc2 [])
| tc1 == tc2
- = TEQ -- See Note [Comparing type synonyms]
-
+ = TEQ
go env t1 t2
| Just t1' <- coreView t1 = go env t1' t2
| Just t2' <- coreView t2 = go env t1 t2'
@@ -778,10 +758,8 @@ mayLookIdentical orig_ty1 orig_ty2
orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]
go :: RnEnv2 -> Type -> Type -> Bool
-
- go env (TyConApp tc1 ts1) (TyConApp tc2 ts2)
- | tc1 == tc2, not (isForgetfulSynTyCon tc1) -- See Note [Comparing type synonyms]
- = gos env (tyConBinders tc1) ts1 ts2
+ -- See Note [Comparing nullary type synonyms]
+ go _ (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 = True
go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2
go env t1 t2 | Just t2' <- coreView t2 = go env t1 t2'
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -841,8 +841,7 @@ data TyConDetails =
-- are fine), again after expanding any
-- nested synonyms
- synIsForgetful :: Bool, -- See Note [Forgetful type synonyms]
- -- True <= at least one argument is not mentioned
+ synIsForgetful :: Bool, -- True <= at least one argument is not mentioned
-- in the RHS (or is mentioned only under
-- forgetful synonyms)
-- Test is conservative, so True does not guarantee
@@ -2122,43 +2121,11 @@ isFamFreeTyCon (TyCon { tyConDetails = details })
-- True. Thus, False means that all bound variables appear on the RHS;
-- True may not mean anything, as the test to set this flag is
-- conservative.
---
--- See Note [Forgetful type synonyms]
isForgetfulSynTyCon :: TyCon -> Bool
isForgetfulSynTyCon (TyCon { tyConDetails = details })
| SynonymTyCon { synIsForgetful = forget } <- details = forget
| otherwise = False
-{- Note [Forgetful type synonyms]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A type synonyms is /forgetful/ if its RHS fails to mention one (or more) of its bound variables.
-
-Forgetfulness is conservative:
- * A non-forgetful synonym /guarantees/ to mention all its bound variables in its RHS.
- * It is always safe to classify a synonym as forgetful.
-
-Examples:
- type R = Int -- Not forgetful
- type S a = Int -- Forgetful
- type T1 a = Int -> S a -- Forgetful
- type T2 a = a -> S a -- Not forgetful
- type T3 a = Int -> F a -- Not forgetful
- where type family F a
-
-* R shows that nullary synonyms are not forgetful.
-
-* T2 shows that forgetfulness needs to account for uses of forgetful
- synonyms. `a` appears on the RHS, but only under a forgetful S
-
-* T3 shows that non-forgetfulness is not the same as injectivity. T3 mentions its
- bound variable on its RHS, but under a type family. So it is entirely possible
- that T3 Int ~ T3 Bool
-
-* Since type synonyms are non-recursive, we don't need a fixpoint analysis to
- determine forgetfulness. It's rather easy -- see `GHC.Core.Type.buildSynTyCon`,
- which is a bit over-conservative for over-saturated synonyms.
--}
-
-- As for newtypes, it is in some contexts important to distinguish between
-- closed synonyms and synonym families, as synonym families have no unique
-- right hand side to which a synonym family application can expand.
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -2327,7 +2327,7 @@ buildSynTyCon name binders res_kind roles rhs
is_forgetful = not (all ((`elemVarSet` rhs_tyvars) . binderVar) binders) ||
uniqSetAny isForgetfulSynTyCon rhs_tycons
-- NB: is_forgetful is allowed to be conservative, returning True more often
- -- than it should. See Note [Forgetful type synonyms] in GHC.Core.TyCon
+ -- than it should. See comments on GHC.Core.TyCon.isForgetfulSynTyCon
rhs_tycons = tyConsOfType rhs
rhs_tyvars = tyCoVarsOfType rhs
@@ -3275,9 +3275,8 @@ efficient. Specifically, we strive to
Goal (b) is particularly useful as it makes traversals (e.g. free variable
traversal, substitution, and comparison) more efficient.
Comparison in particular takes special advantage of nullary type synonym
-applications (e.g. things like @TyConApp typeTyCon []@). See
-* Note [Comparing type synonyms] in "GHC.Core.TyCo.Compare"
-* Note [Unifying type synonyms] in "GHC.Core.Unify"
+applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing
+nullary type synonyms] in "GHC.Core.Type".
To accomplish these we use a number of tricks, implemented by mkTyConApp.
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -1089,47 +1089,6 @@ of arity n:
If we couldn't decompose in the previous step, we return SurelyApart.
Afterwards, the rest of the code doesn't have to worry about type families.
-
-Note [Unifying type synonyms]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider the task of unifying two 'Type's of the form
-
- TyConApp tc [] ~ TyConApp tc []
-
-where `tc` is a type synonym. A naive way to perform this comparison these
-would first expand the synonym and then compare the resulting expansions.
-
-However, this is obviously wasteful and the RHS of `tc` may be large; it is
-much better to rather compare the TyCons directly. Consequently, before
-expanding type synonyms in type comparisons we first look for a nullary
-TyConApp and simply compare the TyCons if we find one.
-
-Of course, if we find that the TyCons are *not* equal then we still need to
-perform the expansion as their RHSs may still be unifiable. E.g
- type T = S (a->a)
- type S a = [a]
-and consider
- T Int ~ S (Int -> Int)
-
-We can't decompose non-nullary synonyms. E.g.
- type R a = F a -- Where F is a type family
-and consider
- R (a->a) ~ R Int
-We can't conclude that (a->) ~ Int. (There is a currently-missed opportunity
-here; if we knew that R was /injective/, perhaps we could decompose.)
-
-We perform the nullary-type-synonym optimisation in a number of places:
-
- * GHC.Core.Unify.unify_ty
- * GHC.Tc.Solver.Equality.can_eq_nc'
- * GHC.Tc.Utils.Unify.uType
-
-This optimisation is especially helpful for the ubiquitous GHC.Types.Type,
-since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications
-whenever possible. See Note [Using synonyms to compress types] in
-GHC.Core.Type for details.
-
-c.f. Note [Comparing type synonyms] in GHC.Core.TyCo.Compare
-}
-------------- unify_ty: the main workhorse -----------
@@ -1148,7 +1107,7 @@ unify_ty :: UMEnv
-- Respects newtypes, PredTypes
-- See Note [Computing equality on types] in GHC.Core.Type
unify_ty _env (TyConApp tc1 []) (TyConApp tc2 []) _kco
- -- See Note [Unifying type synonyms]
+ -- See Note [Comparing nullary type synonyms] in GHC.Core.TyCo.Compare
| tc1 == tc2
= return ()
=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -305,7 +305,7 @@ can_eq_nc
-> Type -> Type -- RHS, after and before type-synonym expansion, resp
-> TcS (StopOrContinue (Either IrredCt EqCt))
--- See Note [Unifying type synonyms] in GHC.Core.Unify
+-- See Note [Comparing nullary type synonyms] in GHC.Core.TyCo.Compare
can_eq_nc _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2
| tc1 == tc2
= canEqReflexive ev eq_rel ty1
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -2187,12 +2187,11 @@ uType env@(UE { u_role = role }) orig_ty1 orig_ty2
; uType env orig_ty1 ty2 }
Nothing -> uUnfilledVar env IsSwapped tv2 ty1 }
- -- See Note [Unifying type synonyms] in GHC.Core.Unify
+ -- See Note [Expanding synonyms during unification]
go ty1@(TyConApp tc1 []) (TyConApp tc2 [])
| tc1 == tc2
= return $ mkReflCo role ty1
- -- Now expand synonyms
-- See Note [Expanding synonyms during unification]
--
-- Also NB that we recurse to 'go' so that we don't push a
@@ -2350,7 +2349,7 @@ We expand synonyms during unification, but:
* The problem case immediately above can happen only with arguments
to the tycon. So we check for nullary tycons *before* expanding.
This is particularly helpful when checking (* ~ *), because * is
- now a type synonym. See Note [Unifying type synonyms] in GHC.Core.Unify.
+ now a type synonym.
Note [Deferred unification]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -142,6 +142,8 @@ mkFileSrcSpan mod_loc
-- Helpers for backwards compatibility
-- ----------------------------------------------------------------------------
+{-# COMPLETE ModLocation #-}
+
pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
pattern ModLocation
{ ml_hs_file
=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -953,6 +953,7 @@ However, with the pragma, the correct core is generated:
{-# INLINE mi_ext_fields #-}
{-# INLINE mi_src_hash #-}
{-# INLINE mi_hi_bytes #-}
+{-# COMPLETE ModIface #-}
pattern ModIface ::
Module -> Maybe Module -> HscSource -> Dependencies -> [Usage] ->
=====================================
configure.ac
=====================================
@@ -97,11 +97,11 @@ dnl use either is considered a Feature.
dnl ** What command to use to compile compiler sources ?
dnl --------------------------------------------------------------
-AC_ARG_VAR(GHC,[Use as the bootstrap GHC. [default=autodetect]])
-AC_CHECK_PROG([GHC], [ghc], [ghc])
+AC_ARG_VAR(GHC,[Use as the full path to GHC. [default=autodetect]])
+AC_PATH_PROG([GHC], [ghc])
AC_ARG_WITH([ghc],
- AS_HELP_STRING([--with-ghc=PATH], [Use PATH as the bootstrap ghc (obsolete, use GHC=PATH instead) [default=autodetect]]),
- AC_MSG_ERROR([--with-ghc=$withval is obsolete (use './configure GHC=$withval' instead)]))
+ AS_HELP_STRING([--with-ghc=PATH], [Use PATH as the full path to ghc (obsolete, use GHC=PATH instead) [default=autodetect]]),
+ AC_MSG_ERROR([--with-ghc=$withval is obsolete (use './configure GHC=$withval' or 'GHC=$withval ./configure' instead)]))
AC_SUBST(WithGhc,$GHC)
AC_ARG_ENABLE(bootstrap-with-devel-snapshot,
=====================================
testsuite/driver/testlib.py
=====================================
@@ -621,7 +621,10 @@ def _extra_files(name, opts, files):
# Record the size of a specific file
def collect_size ( deviation, path ):
- return collect_generic_stat ( 'size', deviation, lambda way: os.path.getsize(in_testdir(path)) )
+ return collect_size_func(deviation, lambda: path)
+
+def collect_size_func ( deviation, path_func ):
+ return collect_generic_stat ( 'size', deviation, lambda way: os.path.getsize(in_testdir(path_func())) )
def get_dir_size(path):
total = 0
@@ -637,13 +640,11 @@ def get_dir_size(path):
print("Exception: Could not find: " + path)
def collect_size_dir ( deviation, path ):
+ return collect_size_dir_func ( deviation, lambda: path )
- ## os.path.join joins the path with slashes (not backslashes) on windows
- ## CI...for some reason, so we manually detect it here
- sep = r"/"
- if on_windows():
- sep = r"\\"
- return collect_generic_stat ( 'size', deviation, lambda way: get_dir_size(path) )
+# Like collect_size_dir but the path is passed as a function which can be evaluated later.
+def collect_size_dir_func( deviation, path_func ):
+ return collect_generic_stat ( 'size', deviation, lambda way: get_dir_size(path_func()) )
# Read a number from a specific file
def stat_from_file ( metric, deviation, path ):
@@ -663,14 +664,14 @@ def collect_generic_stats ( metric_info ):
# is call-by-value so if we placed the call in an all.T file then the python
# interpreter would evaluate the call to path_from_ghcPkg
def collect_size_ghc_pkg (deviation, library):
- return collect_size_dir(deviation, path_from_ghcPkg(library, "library-dirs"))
+ return collect_size_dir_func(deviation, lambda: path_from_ghcPkg(library, "library-dirs"))
# same for collect_size and find_so
def collect_object_size (deviation, library, use_non_inplace=False):
if use_non_inplace:
- return collect_size(deviation, find_non_inplace_so(library))
+ return collect_size_func(deviation, lambda: find_non_inplace_so(library))
else:
- return collect_size(deviation, find_so(library))
+ return collect_size_func(deviation, lambda: find_so(library))
def path_from_ghcPkg (library, field):
"""Find the field as a path for a library via a call to ghc-pkg. This is a
=====================================
testsuite/tests/deSugar/should_compile/T25094.hs
=====================================
@@ -0,0 +1,99 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+
+module T29054 where
+
+
+------------------------------------------------------------------------------
+import Control.Monad.ST (ST)
+import Data.Maybe (fromMaybe)
+import Data.STRef
+import GHC.Exts (Any, reallyUnsafePtrEquality#, (==#), isTrue#)
+import Unsafe.Coerce
+import Control.Monad.ST
+
+data MutableArray s a = MutableArray
+
+newArray :: Int -> a -> ST s (MutableArray s a)
+newArray = undefined
+
+readArray :: MutableArray s a -> Int -> ST s a
+readArray = undefined
+
+writeArray :: MutableArray s a -> Int -> a -> ST s ()
+writeArray = undefined
+
+
+type Key a = Any
+
+------------------------------------------------------------------------------
+-- Type signatures
+emptyRecord :: Key a
+deletedRecord :: Key a
+keyIsEmpty :: Key a -> Bool
+toKey :: a -> Key a
+fromKey :: Key a -> a
+
+
+data TombStone = EmptyElement
+ | DeletedElement
+
+{-# NOINLINE emptyRecord #-}
+emptyRecord = unsafeCoerce EmptyElement
+
+{-# NOINLINE deletedRecord #-}
+deletedRecord = unsafeCoerce DeletedElement
+
+{-# INLINE keyIsEmpty #-}
+keyIsEmpty a = isTrue# (x# ==# 1#)
+ where
+ !x# = reallyUnsafePtrEquality# a emptyRecord
+
+{-# INLINE toKey #-}
+toKey = unsafeCoerce
+
+{-# INLINE fromKey #-}
+fromKey = unsafeCoerce
+
+
+type Bucket s k v = Key (Bucket_ s k v)
+
+------------------------------------------------------------------------------
+data Bucket_ s k v = Bucket { _bucketSize :: {-# UNPACK #-} !Int
+ , _highwater :: {-# UNPACK #-} !(STRef s Int)
+ , _keys :: {-# UNPACK #-} !(MutableArray s k)
+ , _values :: {-# UNPACK #-} !(MutableArray s v)
+ }
+
+
+------------------------------------------------------------------------------
+emptyWithSize :: Int -> ST s (Bucket s k v)
+emptyWithSize !sz = undefined
+
+------------------------------------------------------------------------------
+expandArray :: a -- ^ default value
+ -> Int -- ^ new size
+ -> Int -- ^ number of elements to copy
+ -> MutableArray s a -- ^ old array
+ -> ST s (MutableArray s a)
+expandArray def !sz !hw !arr = undefined
+
+------------------------------------------------------------------------------
+growBucketTo :: Int -> Bucket s k v -> ST s (Bucket s k v)
+growBucketTo !sz bk | keyIsEmpty bk = emptyWithSize sz
+ | otherwise = do
+ if osz >= sz
+ then return bk
+ else do
+ hw <- readSTRef hwRef
+ k' <- expandArray undefined sz hw keys
+ v' <- expandArray undefined sz hw values
+ return $ toKey $ Bucket sz hwRef k' v'
+
+ where
+ bucket = fromKey bk
+ osz = _bucketSize bucket
+ hwRef = _highwater bucket
+ keys = _keys bucket
+ values = _values bucket
+
=====================================
testsuite/tests/deSugar/should_compile/all.T
=====================================
@@ -115,3 +115,4 @@ test('T19883', normal, compile, [''])
test('T22719', normal, compile, ['-ddump-simpl -dsuppress-uniques -dno-typeable-binds'])
test('T23550', normal, compile, [''])
test('T24489', normal, compile, ['-O'])
+test('T25094', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/223e66bbf157639b7c4d1a3f73f6034dd0b2ea73...1fda29d1f29111e33d10d51caa956cf8ed6f7810
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/223e66bbf157639b7c4d1a3f73f6034dd0b2ea73...1fda29d1f29111e33d10d51caa956cf8ed6f7810
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/20240720/76671d6d/attachment-0001.html>
More information about the ghc-commits
mailing list