[Git][ghc/ghc][ghc-9.10] 4 commits: Revert "ghcup-metadata: Drop output_name field"
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Thu May 9 19:37:13 UTC 2024
Ben Gamari pushed to branch ghc-9.10 at Glasgow Haskell Compiler / GHC
Commits:
c192d254 by Ben Gamari at 2024-05-09T11:49:25-04:00
Revert "ghcup-metadata: Drop output_name field"
This reverts commit 250c5df7875658f172804f511cd7eb325392f347.
- - - - -
923e21bc by Ben Gamari at 2024-05-09T11:49:26-04:00
ghcup-metadata: Drop output_name
This is entirely redundant to the filename of the URL. There is no
compelling reason to name the downloaded file differently from its
source.
- - - - -
78092043 by Ryan Scott at 2024-05-09T11:49:26-04:00
unboxedSum{Type,Data}Name: Use GHC.Types as the module
Unboxed sum constructors are now defined in the `GHC.Types` module, so if you
manually quote an unboxed sum (e.g., `''Sum2#`), you will get a `Name` like:
```hs
GHC.Types.Sum2#
```
The `unboxedSumTypeName` function in `template-haskell`, however, mistakenly
believes that unboxed sum constructors are defined in `GHC.Prim`, so
`unboxedSumTypeName 2` would return an entirely different `Name`:
```hs
GHC.Prim.(#|#)
```
This is a problem for Template Haskell users, as it means that they can't be
sure which `Name` is the correct one. (Similarly for `unboxedSumDataName`.)
This patch fixes the implementations of `unboxedSum{Type,Data}Name` to use
`GHC.Types` as the module. For consistency with `unboxedTupleTypeName`, the
`unboxedSumTypeName` function now uses the non-punned syntax for unboxed sums
(`Sum<N>#`) as the `OccName`.
Fixes #24750.
- - - - -
2cc6968a by Andrei Borzenkov at 2024-05-09T11:51:06-04:00
Fix tuple puns renaming (24702)
Move tuple renaming short cutter from `isBuiltInOcc_maybe` to `isPunOcc_maybe`, so we consider incoming module.
I also fixed some hidden bugs that raised after the change was done.
(cherry picked from commit 94da936507c685aa8101a714e7619b4d428d0187)
- - - - -
8 changed files:
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/Builtin/Types.hs
- libraries/ghc-boot/GHC/Utils/Encoding.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- + testsuite/tests/th/T24702a.hs
- + testsuite/tests/th/T24702b.hs
- testsuite/tests/th/TH_tuple1.stdout
- testsuite/tests/th/all.T
Changes:
=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -65,6 +65,7 @@ eprint(f"Supported platforms: {job_mapping.keys()}")
class Artifact(NamedTuple):
job_name: str
download_name: str
+ output_name: Optional[str]
subdir: str
# Platform spec provides a specification which is agnostic to Job
@@ -75,9 +76,11 @@ class PlatformSpec(NamedTuple):
source_artifact = Artifact('source-tarball'
, 'ghc-{version}-src.tar.xz'
+ , None
, 'ghc-{version}' )
test_artifact = Artifact('source-tarball'
, 'ghc-{version}-testsuite.tar.xz'
+ , None
, 'ghc-{version}/testsuite' )
def debian(arch, n):
@@ -111,8 +114,7 @@ def linux_platform(arch, opsys):
base_url = 'https://gitlab.haskell.org/api/v4/projects/1/jobs/{job_id}/artifacts/{artifact_name}'
-
-hash_cache = {}
+hash_cache = {} # type: Dict[str, str]
# Download a URL and return its hash
def download_and_hash(url):
@@ -166,12 +168,15 @@ def mk_one_metadata(release_mode, version, job_map, artifact):
# Turns a platform into an Artifact respecting pipeline_type
# Looks up the right job to use from the .gitlab/jobs-metadata.json file
-def mk_from_platform(pipeline_type, platform):
+def mk_from_platform(release_mode, pipeline_type, platform):
info = job_mapping[platform.name][pipeline_type]
eprint(f"From {platform.name} / {pipeline_type} selecting {info['name']}")
+ output_name = None
+ if not release_mode:
+ output_name = "ghc-{version}-{pn}.tar.xz".format(version="{version}", pn=platform.name)
return Artifact(info['name']
, f"{info['jobInfo']['bindistName']}.tar.xz"
- , "ghc-{version}-{pn}.tar.xz".format(version="{version}", pn=platform.name)
+ , output_name
, platform.subdir)
@@ -179,7 +184,7 @@ def mk_from_platform(pipeline_type, platform):
def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
def mk(platform):
eprint("\n=== " + platform.name + " " + ('=' * (75 - len(platform.name))))
- return mk_one_metadata(release_mode, version, job_map, mk_from_platform(pipeline_type, platform))
+ return mk_one_metadata(release_mode, version, job_map, mk_from_platform(release_mode, pipeline_type, platform))
ubuntu1804 = mk(ubuntu("18_04"))
ubuntu2004 = mk(ubuntu("20_04"))
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -795,7 +795,7 @@ We make boxed one-tuple names have known keys so that `data Solo a = MkSolo a`,
defined in GHC.Tuple, will be used when one-tuples are spliced in through
Template Haskell. This program (from #18097) crucially relies on this:
- case $( tupE [ [| "ok" |] ] ) of Solo x -> putStrLn x
+ case $( tupE [ [| "ok" |] ] ) of MkSolo x -> putStrLn x
Unless Solo has a known key, the type of `$( tupE [ [| "ok" |] ] )` (an
ExplicitTuple of length 1) will not match the type of Solo (an ordinary
@@ -838,26 +838,10 @@ isBuiltInOcc_maybe occ =
, (commas, rest') <- BS.span (==',') rest
, ")" <- rest'
-> Just $ tup_name Boxed (1+BS.length commas)
- _ | Just rest <- "Tuple" `BS.stripPrefix` name
- , Just (num, trailing) <- BS.readInt rest
- , num >= 2 && num <= 64
- -> if
- | BS.null trailing -> Just $ tup_name Boxed num
- | "#" == trailing -> Just $ tup_name Unboxed num
- | otherwise -> Nothing
-
- "CUnit" -> Just $ choose_ns (cTupleTyConName 0) (cTupleDataConName 0)
- "CSolo" -> Just $ choose_ns (cTupleTyConName 1) (cTupleDataConName 1)
- _ | Just rest <- "CTuple" `BS.stripPrefix` name
- , Just (num, trailing) <- BS.readInt rest
- , BS.null trailing
- , num >= 2 && num <= 64
- -> Just $ choose_ns (cTupleTyConName num) (cTupleDataConName num)
-- unboxed tuple data/tycon
"(##)" -> Just $ tup_name Unboxed 0
- "Unit#" -> Just $ tup_name Unboxed 0
- "Solo#" -> Just $ tup_name Unboxed 1
+ "(# #)" -> Just $ tup_name Unboxed 1
_ | Just rest <- "(#" `BS.stripPrefix` name
, (commas, rest') <- BS.span (==',') rest
, "#)" <- rest'
@@ -878,11 +862,6 @@ isBuiltInOcc_maybe occ =
-> let arity = nb_pipes1 + nb_pipes2 + 1
alt = nb_pipes1 + 1
in Just $ dataConName $ sumDataCon alt arity
- _ | Just rest <- "Sum" `BS.stripPrefix` name
- , Just (num, trailing) <- BS.readInt rest
- , num >= 2 && num <= 64
- , trailing == "#"
- -> Just $ tyConName $ sumTyCon num
_ -> Nothing
where
@@ -920,6 +899,21 @@ isTupleTyOcc_maybe mod occ
| otherwise = isTupleNTyOcc_maybe occ
isTupleTyOcc_maybe _ _ = Nothing
+isCTupleOcc_maybe :: Module -> OccName -> Maybe Name
+isCTupleOcc_maybe mod occ
+ | mod == gHC_CLASSES
+ = match_occ
+ where
+ match_occ
+ | occ == occName (cTupleTyConName 0) = Just (cTupleTyConName 0)
+ | occ == occName (cTupleTyConName 1) = Just (cTupleTyConName 1)
+ | 'C':'T':'u':'p':'l':'e' : rest <- occNameString occ
+ , Just (BoxedTuple, num) <- arity_and_boxity rest
+ , num >= 2 && num <= 64
+ = Just $ cTupleTyConName num
+ | otherwise = Nothing
+
+isCTupleOcc_maybe _ _ = Nothing
-- | This is only for Tuple<n>, not for Unit or Solo
isTupleNTyOcc_maybe :: OccName -> Maybe Name
@@ -985,13 +979,12 @@ isPunOcc_maybe :: Module -> OccName -> Maybe Name
isPunOcc_maybe mod occ
| mod == gHC_TYPES, occ == occName listTyConName
= Just listTyConName
- | mod == gHC_INTERNAL_TUPLE, occ == occName unitTyConName
- = Just unitTyConName
- | mod == gHC_TYPES, occ == occName unboxedUnitTyConName
- = Just unboxedUnitTyConName
- | mod == gHC_INTERNAL_TUPLE || mod == gHC_TYPES
- = isTupleNTyOcc_maybe occ <|> isSumNTyOcc_maybe occ
-isPunOcc_maybe _ _ = Nothing
+ | mod == gHC_TYPES, occ == occName unboxedSoloDataConName
+ = Just unboxedSoloDataConName
+ | otherwise
+ = isTupleTyOcc_maybe mod occ <|>
+ isCTupleOcc_maybe mod occ <|>
+ isSumTyOcc_maybe mod occ
mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
-- No need to cache these, the caching is done in mk_tuple
@@ -1304,6 +1297,8 @@ unboxedSoloTyCon = tupleTyCon Unboxed 1
unboxedSoloTyConName :: Name
unboxedSoloTyConName = tyConName unboxedSoloTyCon
+unboxedSoloDataConName :: Name
+unboxedSoloDataConName = tupleDataConName Unboxed 1
{- *********************************************************************
* *
=====================================
libraries/ghc-boot/GHC/Utils/Encoding.hs
=====================================
@@ -236,7 +236,6 @@ maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
(n, '#' : ')' : _) -> Just ('Z' : shows (n+1) "H")
_ -> Nothing
maybe_tuple "()" = Just("Z0T")
-maybe_tuple "MkSolo" = Just("Z1T")
maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of
(n, ')' : _) -> Just ('Z' : shows (n+1) "T")
_ -> Nothing
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -1924,15 +1924,19 @@ mk_tup_name n space boxed
| boxed = "(" ++ thing ++ ")"
| otherwise = "(#" ++ thing ++ "#)"
tup_occ | n == 0, space == TcClsName = if boxed then "Unit" else "Unit#"
- | n == 1 = if boxed then solo else "Solo#"
+ | n == 1 = if boxed then solo else unboxed_solo
| space == TcClsName = "Tuple" ++ show n ++ if boxed then "" else "#"
| otherwise = withParens (replicate n_commas ',')
n_commas = n - 1
- tup_mod = mkModName (if boxed then "GHC.Tuple" else "GHC.Prim")
+ tup_mod = mkModName (if boxed then "GHC.Tuple" else "GHC.Types")
solo
| space == DataName = "MkSolo"
| otherwise = "Solo"
+ unboxed_solo
+ | space == DataName = "(# #)"
+ | otherwise = "Solo#"
+
-- Unboxed sum data and type constructors
-- | Unboxed sum data constructor
unboxedSumDataName :: SumAlt -> SumArity -> Name
@@ -1951,7 +1955,7 @@ unboxedSumDataName alt arity
| otherwise
= Name (mkOccName sum_occ)
- (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Prim"))
+ (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
where
prefix = "unboxedSumDataName: "
@@ -1970,11 +1974,11 @@ unboxedSumTypeName arity
| otherwise
= Name (mkOccName sum_occ)
- (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Prim"))
+ (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
where
-- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types
- sum_occ = '(' : '#' : replicate (arity - 1) '|' ++ "#)"
+ sum_occ = "Sum" ++ show arity ++ "#"
-----------------------------------------------------
-- Locations
=====================================
testsuite/tests/th/T24702a.hs
=====================================
@@ -0,0 +1,55 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnboxedTuples #-}
+module T24702a where
+
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Syntax
+
+$(do
+ let
+ step = \acc n -> acc `appT` n
+ args n = replicate n (conT ''Int)
+
+ mkTupleTest mkTupTy mkTupCon boxity n = do
+ let
+ nil = conT (mkTupTy n)
+ tup = foldl step nil (args n)
+ f <- newName (boxity <> show n)
+
+ -- f<n> :: (,,..n..,,) t1 t2 .. tn -> ()
+ -- f<n> = \ (_, _, ...n..., _) -> ()
+ sequence $
+ sigD f [t|$(tup) -> ()|] :
+ valD (varP f) (normalB [e| \ $(conP (mkTupCon n) (replicate n wildP)) -> ()|]) [] :
+ []
+
+ mkSumTest n = do
+ let
+ nil = conT (unboxedSumTypeName n)
+ sumTy = foldl step nil (args n)
+ mkSumAlt altN =
+ let sumDataCon = unboxedSumDataName altN n
+ varName = mkName "x" in
+ clause [conP sumDataCon [varP varName]]
+ (normalB (conE sumDataCon `appE` varE varName)) []
+ f <- newName ("sum" <> show n)
+
+ -- f<n> :: (#||...n...||#) -> (#||...n...||#)
+ -- f<n> (x||...n...||) = (x||...n...||)
+ -- f<n> (|x||...n...||) = (|x||...n...||)
+ -- ...n...
+ -- f<n> (||...n...||x) = (||...n...||x)
+ sequence $
+ sigD f [t|$(sumTy) -> $(sumTy)|] :
+ funD f (map mkSumAlt [1 .. n]) :
+ []
+
+ newDeclarationGroup <>
+ mkTupleTest
+ unboxedTupleTypeName unboxedTupleDataName "unboxed"
+ `foldMap` (64 : [0 .. 8]) <>
+ mkTupleTest
+ tupleTypeName tupleDataName "boxed"
+ `foldMap` (64 : [0 .. 8]) <>
+ mkSumTest
+ `foldMap` (63 : [2 .. 8]) )
=====================================
testsuite/tests/th/T24702b.hs
=====================================
@@ -0,0 +1,44 @@
+{-# LANGUAGE TemplateHaskell, MagicHash #-}
+module T24702b where
+
+import Language.Haskell.TH
+
+data Unit = MkUnit
+tup0 :: $(conT (mkName "Unit"))
+tup0 = MkUnit
+
+data Solo = MkSolo
+tup1 :: $(conT (mkName "Solo"))
+tup1 = MkSolo
+
+data Tuple2 = MkTuple2
+tup2 :: $(conT (mkName "Tuple2"))
+tup2 = MkTuple2
+
+data CUnit = MkCUnit
+ctup0 :: $(conT (mkName "CUnit"))
+ctup0 = MkCUnit
+
+data CSolo = MkCSolo
+ctup1 :: $(conT (mkName "CSolo"))
+ctup1 = MkCSolo
+
+data CTuple2 = MkCTuple2
+ctup2 :: $(conT (mkName "CTuple2"))
+ctup2 = MkCTuple2
+
+data Unit# = MkUnit#
+utup0 :: $(conT (mkName "Unit#"))
+utup0 = MkUnit#
+
+data Solo# = MkSolo#
+utup1 :: $(conT (mkName "Solo#"))
+utup1 = MkSolo#
+
+data Tuple2# = MkTuple2#
+utup2 :: $(conT (mkName "Tuple2#"))
+utup2 = MkTuple2#
+
+data Sum2# = MkSum2#
+sum2 :: $(conT (mkName "Sum2#"))
+sum2 = MkSum2#
=====================================
testsuite/tests/th/TH_tuple1.stdout
=====================================
@@ -3,8 +3,8 @@ GHC.Tuple.(,) 1 2 :: GHC.Tuple.Tuple2 GHC.Num.Integer.Integer
GHC.Num.Integer.Integer
SigE (AppE (ConE GHC.Tuple.MkSolo) (LitE (IntegerL 1))) (AppT (ConT GHC.Tuple.Solo) (ConT GHC.Num.Integer.Integer))
GHC.Tuple.MkSolo 1 :: GHC.Tuple.Solo GHC.Num.Integer.Integer
-SigE (AppE (AppE (ConE GHC.Prim.(#,#)) (LitE (IntegerL 1))) (LitE (IntegerL 2))) (AppT (AppT (ConT GHC.Prim.Tuple2#) (ConT GHC.Num.Integer.Integer)) (ConT GHC.Num.Integer.Integer))
-GHC.Prim.(#,#) 1 2 :: GHC.Prim.Tuple2# GHC.Num.Integer.Integer
- GHC.Num.Integer.Integer
-SigE (AppE (ConE GHC.Prim.Solo#) (LitE (IntegerL 1))) (AppT (ConT GHC.Prim.Solo#) (ConT GHC.Num.Integer.Integer))
-GHC.Prim.Solo# 1 :: GHC.Prim.Solo# GHC.Num.Integer.Integer
+SigE (AppE (AppE (ConE GHC.Types.(#,#)) (LitE (IntegerL 1))) (LitE (IntegerL 2))) (AppT (AppT (ConT GHC.Types.Tuple2#) (ConT GHC.Num.Integer.Integer)) (ConT GHC.Num.Integer.Integer))
+GHC.Types.(#,#) 1 2 :: GHC.Types.Tuple2# GHC.Num.Integer.Integer
+ GHC.Num.Integer.Integer
+SigE (AppE (ConE GHC.Types.(# #)) (LitE (IntegerL 1))) (AppT (ConT GHC.Types.Solo#) (ConT GHC.Num.Integer.Integer))
+GHC.Types.(# #) 1 :: GHC.Types.Solo# GHC.Num.Integer.Integer
=====================================
testsuite/tests/th/all.T
=====================================
@@ -611,3 +611,5 @@ test('T24557b', normal, compile_fail, [''])
test('T24557c', normal, compile_fail, [''])
test('T24557d', normal, compile_fail, [''])
test('T24557e', normal, compile, [''])
+test('T24702a', normal, compile, [''])
+test('T24702b', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/776fa6e1722bf1f084ae7cff7ef99c8d10b2ea74...2cc6968a0e70967a0fe906ff27957030eab40889
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/776fa6e1722bf1f084ae7cff7ef99c8d10b2ea74...2cc6968a0e70967a0fe906ff27957030eab40889
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/20240509/ddc527ed/attachment-0001.html>
More information about the ghc-commits
mailing list