diff options
author | Herbert Valerio Riedel <hvr@gnu.org> | 2017-08-30 01:29:55 +0200 |
---|---|---|
committer | Herbert Valerio Riedel <hvr@gnu.org> | 2017-08-31 09:45:11 +0200 |
commit | c0feee90118333dac817cfad6f2dedc0a886d1bd (patch) | |
tree | f1e7bd59e0c8452d9e51f359d504606a8a346bf0 /compiler/main/Packages.hs | |
parent | 2c133b67df374c73bc8069cefd7d57e1d2a14fc3 (diff) | |
download | haskell-c0feee90118333dac817cfad6f2dedc0a886d1bd.tar.gz |
Add missing Semigroup instances to compiler
This is a pre-requisite for implementing the Semigroup/Monoid proposal.
The instances have been introduced in a way to minimise warnings.
Diffstat (limited to 'compiler/main/Packages.hs')
-rw-r--r-- | compiler/main/Packages.hs | 29 |
1 files changed, 13 insertions, 16 deletions
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 01d66cb740..088f58a675 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -217,14 +217,7 @@ instance Semigroup ModuleOrigin where instance Monoid ModuleOrigin where mempty = ModOrigin Nothing [] [] False - mappend (ModOrigin e res rhs f) (ModOrigin e' res' rhs' f') = - ModOrigin (g e e') (res ++ res') (rhs ++ rhs') (f || f') - where g (Just b) (Just b') - | b == b' = Just b - | otherwise = panic "ModOrigin: package both exposed/hidden" - g Nothing x = x - g x Nothing = x - mappend _ _ = panic "ModOrigin: hidden module redefined" + mappend = (Semigroup.<>) -- | Is the name from the import actually visible? (i.e. does it cause -- ambiguity, or is it only relevant when we're making suggestions?) @@ -283,6 +276,17 @@ instance Outputable UnitVisibility where uv_requirements = reqs, uv_explicit = explicit }) = ppr (b, rns, mb_pn, reqs, explicit) + +instance Semigroup UnitVisibility where + uv1 <> uv2 + = UnitVisibility + { uv_expose_all = uv_expose_all uv1 || uv_expose_all uv2 + , uv_renamings = uv_renamings uv1 ++ uv_renamings uv2 + , uv_package_name = mappend (uv_package_name uv1) (uv_package_name uv2) + , uv_requirements = Map.unionWith Set.union (uv_requirements uv1) (uv_requirements uv2) + , uv_explicit = uv_explicit uv1 || uv_explicit uv2 + } + instance Monoid UnitVisibility where mempty = UnitVisibility { uv_expose_all = False @@ -291,14 +295,7 @@ instance Monoid UnitVisibility where , uv_requirements = Map.empty , uv_explicit = False } - mappend uv1 uv2 - = UnitVisibility - { uv_expose_all = uv_expose_all uv1 || uv_expose_all uv2 - , uv_renamings = uv_renamings uv1 ++ uv_renamings uv2 - , uv_package_name = mappend (uv_package_name uv1) (uv_package_name uv2) - , uv_requirements = Map.unionWith Set.union (uv_requirements uv1) (uv_requirements uv2) - , uv_explicit = uv_explicit uv1 || uv_explicit uv2 - } + mappend = (Semigroup.<>) type WiredUnitId = DefUnitId type PreloadUnitId = InstalledUnitId |