[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Don't allow . in overloaded labels
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Feb 7 17:25:02 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00
Don't allow . in overloaded labels
This patch removes . from the list of allowed characters in a non-quoted
overloaded label, as it was realised this steals syntax, e.g. (#.).
Users who want this functionality will have to add quotes around the
label, e.g. `#"17.28"`.
Fixes #22821
- - - - -
5dce04ee by romes at 2023-02-07T10:52:10-05:00
Update kinds in comments in GHC.Core.TyCon
Use `Type` instead of star kind (*)
Fix comment with incorrect kind * to have kind `Constraint`
- - - - -
92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00
Revert "Use fix-sized equality primops for fixed size boxed types"
This reverts commit 024020c38126f3ce326ff56906d53525bc71690c.
This was never applied to master/9.6 originally.
See #20405 for why using these primops is a bad idea.
(cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865)
- - - - -
c0fd08f5 by Sylvain Henry at 2023-02-07T12:24:47-05:00
JS: avoid head/tail and unpackFS
- - - - -
67696624 by Krzysztof Gogolewski at 2023-02-07T12:24:47-05:00
testsuite: Fix Python warnings (#22856)
- - - - -
10 changed files:
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/StgToJS/Printer.hs
- docs/users_guide/9.6.1-notes.rst
- libraries/base/GHC/Int.hs
- libraries/base/GHC/Word.hs
- testsuite/driver/runtests.py
- testsuite/driver/testlib.py
- testsuite/tests/overloadedrecflds/should_run/T11671_run.hs
- testsuite/tests/printer/Test22771.hs
Changes:
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -194,7 +194,7 @@ Note [Type synonym families]
* Type synonym families, also known as "type functions", map directly
onto the type functions in FC:
- type family F a :: *
+ type family F a :: Type
type instance F Int = Bool
..etc...
@@ -210,11 +210,11 @@ Note [Type synonym families]
type instance F (F Int) = ... -- BAD!
* Translation of type family decl:
- type family F a :: *
+ type family F a :: Type
translates to
a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon
- type family G a :: * where
+ type family G a :: Type where
G Int = Bool
G Bool = Char
G a = ()
@@ -229,7 +229,7 @@ Note [Data type families]
See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make
* Data type families are declared thus
- data family T a :: *
+ data family T a :: Type
data instance T Int = T1 | T2 Bool
Here T is the "family TyCon".
@@ -321,7 +321,7 @@ See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make
should not think of a data family T as a *type function* at all, not
even an injective one! We can't allow even injective type functions
on the LHS of a type function:
- type family injective G a :: *
+ type family injective G a :: Type
type instance F (G Int) = Bool
is no good, even if G is injective, because consider
type instance G Int = Bool
@@ -572,21 +572,21 @@ Since they are user-callable we must get their type-argument visibility
information right; and that info is in the TyConBinders.
Here is an example:
- data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> *
+ data App a b = MkApp (a b) -- App :: forall {k}. (k->Type) -> k -> Type
The TyCon has
- tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ]
+ tyConTyBinders = [ Named (Bndr (k :: Type) Inferred), Anon (k->Type), Anon k ]
The TyConBinders for App line up with App's kind, given above.
But the DataCon MkApp has the type
- MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b
+ MkApp :: forall {k} (a:k->Type) (b:k). a b -> App k a b
That is, its ForAllTyBinders should be
- dataConUnivTyVarBinders = [ Bndr (k:*) Inferred
- , Bndr (a:k->*) Specified
+ dataConUnivTyVarBinders = [ Bndr (k:Type) Inferred
+ , Bndr (a:k->Type) Specified
, Bndr (b:k) Specified ]
So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders:
@@ -620,8 +620,8 @@ They fit together like so:
type App a (b :: k) = a b
- tyConBinders = [ Bndr (k::*) (NamedTCB Inferred)
- , Bndr (a:k->*) AnonTCB
+ tyConBinders = [ Bndr (k::Type) (NamedTCB Inferred)
+ , Bndr (a:k->Type) AnonTCB
, Bndr (b:k) AnonTCB ]
Note that there are three binders here, including the
@@ -636,13 +636,13 @@ They fit together like so:
that TyVar may scope over some other part of the TyCon's definition. Eg
type T a = a -> a
we have
- tyConBinders = [ Bndr (a:*) AnonTCB ]
+ tyConBinders = [ Bndr (a:Type) AnonTCB ]
synTcRhs = a -> a
So the 'a' scopes over the synTcRhs
* From the tyConBinders and tyConResKind we can get the tyConKind
E.g for our App example:
- App :: forall k. (k->*) -> k -> *
+ App :: forall k. (k->Type) -> k -> Type
We get a 'forall' in the kind for each NamedTCB, and an arrow
for each AnonTCB
@@ -725,15 +725,15 @@ instance Binary TyConBndrVis where
-- things such as:
--
-- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of
--- kind @*@
+-- kind @Type@
--
-- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor
--
-- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor
--- of kind @* -> *@
+-- of kind @Type -> Type@
--
-- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor
--- of kind @*@
+-- of kind @Constraint@
--
-- This data type also encodes a number of primitive, built in type constructors
-- such as those for function and tuple types.
@@ -1252,16 +1252,16 @@ data FamTyConFlav
--
-- These are introduced by either a top level declaration:
--
- -- > data family T a :: *
+ -- > data family T a :: Type
--
-- Or an associated data type declaration, within a class declaration:
--
-- > class C a b where
- -- > data T b :: *
+ -- > data T b :: Type
DataFamilyTyCon
TyConRepName
- -- | An open type synonym family e.g. @type family F x y :: * -> *@
+ -- | An open type synonym family e.g. @type family F x y :: Type -> Type@
| OpenSynFamilyTyCon
-- | A closed type synonym family e.g.
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -163,7 +163,6 @@ $small = [$ascsmall $unismall \_]
$uniidchar = \x07 -- Trick Alex into handling Unicode. See Note [Unicode in Alex].
$idchar = [$small $large $digit $uniidchar \']
-$labelchar = [$small $large $digit $uniidchar \' \.]
$unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex].
$graphic = [$small $large $symbol $digit $idchar $special $unigraphic \"\']
@@ -455,7 +454,7 @@ $unigraphic / { isSmartQuote } { smart_quote_error }
}
<0> {
- "#" $labelchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid }
+ "#" $idchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid }
"#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label }
}
=====================================
compiler/GHC/StgToJS/Printer.hs
=====================================
@@ -108,19 +108,17 @@ ghcjsRenderJsV r (JHash m)
where
quoteIfRequired :: FastString -> Doc
quoteIfRequired x
- | isUnquotedKey x' = text x'
- | otherwise = PP.squotes (text x')
- where x' = unpackFS x
-
- isUnquotedKey :: String -> Bool
- isUnquotedKey x | null x = False
- | all isDigit x = True
- | otherwise = validFirstIdent (head x)
- && all validOtherIdent (tail x)
+ | isUnquotedKey x = ftext x
+ | otherwise = PP.squotes (ftext x)
+ isUnquotedKey :: FastString -> Bool
+ isUnquotedKey fs = case unpackFS fs of
+ [] -> False
+ s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs)
validFirstIdent c = c == '_' || c == '$' || isAlpha c
validOtherIdent c = isAlpha c || isDigit c
+
ghcjsRenderJsV r v = renderJsV defaultRenderJs r v
prettyBlock :: RenderJs -> [JStat] -> Doc
=====================================
docs/users_guide/9.6.1-notes.rst
=====================================
@@ -84,7 +84,7 @@ Language
This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`.
Examples of newly allowed syntax:
- Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"`
- - Numeric characters: `#3.14` equivalent to `getLabel @"3.14"`
+ - Numeric characters: `#1728` equivalent to `getLabel @"1728"`
- Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"`
Compiler
=====================================
libraries/base/GHC/Int.hs
=====================================
@@ -69,8 +69,8 @@ instance Eq Int8 where
(/=) = neInt8
eqInt8, neInt8 :: Int8 -> Int8 -> Bool
-eqInt8 (I8# x) (I8# y) = isTrue# (x `eqInt8#` y)
-neInt8 (I8# x) (I8# y) = isTrue# (x `neInt8#` y)
+eqInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) ==# (int8ToInt# y))
+neInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) /=# (int8ToInt# y))
{-# INLINE [1] eqInt8 #-}
{-# INLINE [1] neInt8 #-}
@@ -280,8 +280,8 @@ instance Eq Int16 where
(/=) = neInt16
eqInt16, neInt16 :: Int16 -> Int16 -> Bool
-eqInt16 (I16# x) (I16# y) = isTrue# (x `eqInt16#` y)
-neInt16 (I16# x) (I16# y) = isTrue# (x `neInt16#` y)
+eqInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) ==# (int16ToInt# y))
+neInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) /=# (int16ToInt# y))
{-# INLINE [1] eqInt16 #-}
{-# INLINE [1] neInt16 #-}
@@ -488,8 +488,8 @@ instance Eq Int32 where
(/=) = neInt32
eqInt32, neInt32 :: Int32 -> Int32 -> Bool
-eqInt32 (I32# x) (I32# y) = isTrue# (x `eqInt32#` y)
-neInt32 (I32# x) (I32# y) = isTrue# (x `neInt32#` y)
+eqInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) ==# (int32ToInt# y))
+neInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) /=# (int32ToInt# y))
{-# INLINE [1] eqInt32 #-}
{-# INLINE [1] neInt32 #-}
=====================================
libraries/base/GHC/Word.hs
=====================================
@@ -78,8 +78,8 @@ instance Eq Word8 where
(/=) = neWord8
eqWord8, neWord8 :: Word8 -> Word8 -> Bool
-eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord8#` y)
-neWord8 (W8# x) (W8# y) = isTrue# (x `neWord8#` y)
+eqWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `eqWord#` (word8ToWord# y))
+neWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `neWord#` (word8ToWord# y))
{-# INLINE [1] eqWord8 #-}
{-# INLINE [1] neWord8 #-}
@@ -268,8 +268,8 @@ instance Eq Word16 where
(/=) = neWord16
eqWord16, neWord16 :: Word16 -> Word16 -> Bool
-eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord16#` y)
-neWord16 (W16# x) (W16# y) = isTrue# (x `neWord16#` y)
+eqWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `eqWord#` (word16ToWord# y))
+neWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `neWord#` (word16ToWord# y))
{-# INLINE [1] eqWord16 #-}
{-# INLINE [1] neWord16 #-}
@@ -500,8 +500,8 @@ instance Eq Word32 where
(/=) = neWord32
eqWord32, neWord32 :: Word32 -> Word32 -> Bool
-eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord32#` y)
-neWord32 (W32# x) (W32# y) = isTrue# (x `neWord32#` y)
+eqWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `eqWord#` (word32ToWord# y))
+neWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `neWord#` (word32ToWord# y))
{-# INLINE [1] eqWord32 #-}
{-# INLINE [1] neWord32 #-}
=====================================
testsuite/driver/runtests.py
=====================================
@@ -601,6 +601,7 @@ else:
if args.junit:
junit(t).write(args.junit)
+ args.junit.close()
if config.only_report_hadrian_deps:
print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps)
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1347,7 +1347,7 @@ def do_test(name: TestName,
# if found and instead have the testsuite decide on what to do
# with the output.
def override_options(pre_cmd):
- if config.verbose >= 5 and bool(re.match('\$make', pre_cmd, re.I)):
+ if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)):
return pre_cmd.replace(' -s' , '') \
.replace('--silent', '') \
.replace('--quiet' , '')
@@ -1989,7 +1989,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path):
with out1_fn.open('w', encoding='utf8', newline='') as out1:
with out2_fn.open('w', encoding='utf8', newline='') as out2:
line = infile.readline()
- while re.sub('^\s*','',line) != delimiter and line != '':
+ while re.sub(r'^\s*','',line) != delimiter and line != '':
out1.write(line)
line = infile.readline()
@@ -2399,20 +2399,20 @@ def normalise_errmsg(s: str) -> str:
# warning message to get clean output.
if config.msys:
s = re.sub('Failed to remove file (.*); error= (.*)$', '', s)
- s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s)
+ s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s)
# filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10
# and not understood by older binutils (ar, ranlib, ...)
- s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l))
+ s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l))
- s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
+ s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
# ignore superfluous dylibs passed to the linker.
s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
# ignore LLVM Version mismatch garbage; this will just break tests.
s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
- s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s)
- s = re.sub('We will try though\.\.\..*\n','',s)
+ s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
+ s = re.sub('We will try though\\.\\.\\..*\n','',s)
# ignore warning about strip invalidating signatures
s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s)
# clang may warn about unused argument when used as assembler
@@ -2475,8 +2475,8 @@ def normalise_slashes_( s: str ) -> str:
return s
def normalise_exe_( s: str ) -> str:
- s = re.sub('\.exe', '', s)
- s = re.sub('\.jsexe', '', s)
+ s = re.sub(r'\.exe', '', s)
+ s = re.sub(r'\.jsexe', '', s)
return s
def normalise_output( s: str ) -> str:
@@ -2494,14 +2494,14 @@ def normalise_output( s: str ) -> str:
# ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is
# requires for -fPIC
s = re.sub(' -fexternal-dynamic-refs\n','',s)
- s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
+ s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
# ignore superfluous dylibs passed to the linker.
s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
# ignore LLVM Version mismatch garbage; this will just break tests.
s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
- s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s)
- s = re.sub('We will try though\.\.\..*\n','',s)
+ s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
+ s = re.sub('We will try though\\.\\.\\..*\n','',s)
# ignore warning about strip invalidating signatures
s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s)
# clang may warn about unused argument when used as assembler
=====================================
testsuite/tests/overloadedrecflds/should_run/T11671_run.hs
=====================================
@@ -12,8 +12,9 @@ import GHC.Prim (Addr#)
instance KnownSymbol symbol => IsLabel symbol String where
fromLabel = symbolVal (Proxy :: Proxy symbol)
-(#) :: String -> Int -> String
+(#), (#.) :: String -> Int -> String
(#) _ i = show i
+_ #. i = show i
f :: Addr# -> Int -> String
f _ i = show i
@@ -26,13 +27,13 @@ main = traverse_ putStrLn
, #type
, #Foo
, #3
- , #199.4
+ , #"199.4"
, #17a23b
, #f'a'
, #'a'
, #'
, #''notTHSplice
- , #...
+ , #"..."
, #привет
, #こんにちは
, #"3"
=====================================
testsuite/tests/printer/Test22771.hs
=====================================
@@ -14,8 +14,9 @@ import GHC.Prim (Addr#)
instance KnownSymbol symbol => IsLabel symbol String where
fromLabel = symbolVal (Proxy :: Proxy symbol)
-(#) :: String -> Int -> String
+(#), (#.) :: String -> Int -> String
(#) _ i = show i
+_ #. i = show i
f :: Addr# -> Int -> String
f _ i = show i
@@ -28,13 +29,13 @@ main = traverse_ putStrLn
, #type
, #Foo
, #3
- , #199.4
+ , #"199.4"
, #17a23b
, #f'a'
, #'a'
, #'
, #''notTHSplice
- , #...
+ , #"..."
, #привет
, #こんにちは
, #"3"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b9365d0de5e506ddc9a8cc6ee40c25f36f6485b...6769662417abe3d39cefeca0b97c4601183b0ad0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b9365d0de5e506ddc9a8cc6ee40c25f36f6485b...6769662417abe3d39cefeca0b97c4601183b0ad0
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/20230207/26c59c98/attachment-0001.html>
More information about the ghc-commits
mailing list