[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Use foldl' in unionManyUniqDSets
Marge Bot
gitlab at gitlab.haskell.org
Mon Jun 15 02:39:21 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
45412ba0 by Simon Jakobi at 2020-06-14T22:39:15-04:00
Use foldl' in unionManyUniqDSets
- - - - -
197398db by Moritz Angermann at 2020-06-14T22:39:16-04:00
Load .lo as well.
Some archives contain so called linker objects, with the affectionate
.lo suffic. For example the musl libc.a will come in that form. We
still want to load those objects, hence we should not discard them and
look for .lo as well. Ultimately we might want to fix this proerly by
looking at the file magic.
- - - - -
246f8cd8 by Vladislav Zavialov at 2020-06-14T22:39:16-04:00
User's Guide: KnownNat evidence is Natural
This bit of documentation got outdated after commit
1fcede43d2b30f33b7505e25eb6b1f321be0407f
- - - - -
4 changed files:
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Types/Unique/DSet.hs
- docs/users_guide/exts/type_literals.rst
- rts/linker/LoadArchive.c
Changes:
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -259,12 +259,12 @@ Note [KnownNat & KnownSymbol and EvLit]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A part of the type-level literals implementation are the classes
"KnownNat" and "KnownSymbol", which provide a "smart" constructor for
-defining singleton values. Here is the key stuff from GHC.TypeLits
+defining singleton values. Here is the key stuff from GHC.TypeNats
class KnownNat (n :: Nat) where
natSing :: SNat n
- newtype SNat (n :: Nat) = SNat Integer
+ newtype SNat (n :: Nat) = SNat Natural
Conceptually, this class has infinitely many instances:
@@ -291,10 +291,10 @@ Also note that `natSing` and `SNat` are never actually exposed from the
library---they are just an implementation detail. Instead, users see
a more convenient function, defined in terms of `natSing`:
- natVal :: KnownNat n => proxy n -> Integer
+ natVal :: KnownNat n => proxy n -> Natural
The reason we don't use this directly in the class is that it is simpler
-and more efficient to pass around an integer rather than an entire function,
+and more efficient to pass around a Natural rather than an entire function,
especially when the `KnowNat` evidence is packaged up in an existential.
The story for kind `Symbol` is analogous:
=====================================
compiler/GHC/Types/Unique/DSet.hs
=====================================
@@ -81,8 +81,8 @@ unionUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a
unionUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (plusUDFM s t)
unionManyUniqDSets :: [UniqDSet a] -> UniqDSet a
-unionManyUniqDSets [] = emptyUniqDSet
-unionManyUniqDSets sets = foldr1 unionUniqDSets sets
+unionManyUniqDSets [] = emptyUniqDSet
+unionManyUniqDSets (x:xs) = foldl' unionUniqDSets x xs
minusUniqDSet :: UniqDSet a -> UniqDSet a -> UniqDSet a
minusUniqDSet (UniqDSet s) (UniqDSet t) = UniqDSet (minusUDFM s t)
=====================================
docs/users_guide/exts/type_literals.rst
=====================================
@@ -10,10 +10,10 @@ Numeric literals are of kind ``Nat``, while string literals are of kind
extension.
The kinds of the literals and all other low-level operations for this
-feature are defined in module ``GHC.TypeLits``. Note that the module
-defines some type-level operators that clash with their value-level
-counterparts (e.g. ``(+)``). Import and export declarations referring to
-these operators require an explicit namespace annotation (see
+feature are defined in modules ``GHC.TypeLits`` and ``GHC.TypeNats``.
+Note that these modules define some type-level operators that clash with their
+value-level counterparts (e.g. ``(+)``). Import and export declarations
+referring to these operators require an explicit namespace annotation (see
:ref:`explicit-namespaces`).
Here is an example of using type-level numeric literals to provide a
@@ -59,7 +59,8 @@ a type-level literal. This is done with the functions ``natVal`` and
These functions are overloaded because they need to return a different
result, depending on the type at which they are instantiated. ::
- natVal :: KnownNat n => proxy n -> Integer
+ natVal :: KnownNat n => proxy n -> Natural -- from GHC.TypeNats
+ natVal :: KnownNat n => proxy n -> Integer -- from GHC.TypeLits
-- instance KnownNat 0
-- instance KnownNat 1
@@ -79,7 +80,9 @@ will be unknown at compile-time, so it is hidden in an existential type.
The conversion may be performed using ``someNatVal`` for integers and
``someSymbolVal`` for strings: ::
- someNatVal :: Integer -> Maybe SomeNat
+ someNatVal :: Natural -> Maybe SomeNat -- from GHC.TypeNats
+ someNatVal :: Integer -> Maybe SomeNat -- from GHC.TypeLits
+
SomeNat :: KnownNat n => Proxy n -> SomeNat
The operations on strings are similar.
=====================================
rts/linker/LoadArchive.c
=====================================
@@ -461,6 +461,7 @@ static HsInt loadArchive_ (pathchar *path)
/* TODO: Stop relying on file extensions to determine input formats.
Instead try to match file headers. See #13103. */
isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o" , 2) == 0)
+ || (thisFileNameSize >= 3 && strncmp(fileName + thisFileNameSize - 3, ".lo" , 3) == 0)
|| (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0)
|| (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".obj", 4) == 0);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28c466637ef9a068117059d558615a0e5c5876ca...246f8cd8979d588e4bd4eefa129cefa342dbb096
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28c466637ef9a068117059d558615a0e5c5876ca...246f8cd8979d588e4bd4eefa129cefa342dbb096
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/20200614/504024d9/attachment-0001.html>
More information about the ghc-commits
mailing list