diff options
| -rw-r--r-- | compiler/GHC/Tc/Types/Evidence.hs | 21 |
1 files changed, 21 insertions, 0 deletions
diff --git a/compiler/GHC/Tc/Types/Evidence.hs b/compiler/GHC/Tc/Types/Evidence.hs index 7dd8dfef67..e260976c38 100644 --- a/compiler/GHC/Tc/Types/Evidence.hs +++ b/compiler/GHC/Tc/Types/Evidence.hs @@ -97,6 +97,8 @@ import Data.IORef( IORef ) import GHC.Types.Unique.Set import GHC.Core.Multiplicity +import qualified Data.Semigroup as S + {- Note [TcCoercions] ~~~~~~~~~~~~~~~~~~ @@ -294,6 +296,25 @@ instance Data.Data HsWrapper where dataTypeOf _ = hsWrapper_dataType +-- | The Semigroup instance is a bit fishy, since @WpCompose@, as a data +-- constructor, is "syntactic" and not associative. Concretely, if @a@, @b@, +-- and @c@ aren't @WpHole@: +-- +-- > (a <> b) <> c ?= a <> (b <> c) +-- +-- ==> +-- +-- > (a `WpCompose` b) `WpCompose` c /= @ a `WpCompose` (b `WpCompose` c) +-- +-- However these two associations are are "semantically equal" in the sense +-- that they produce equal functions when passed to +-- @GHC.HsToCore.Binds.dsHsWrapper@. +instance S.Semigroup HsWrapper where + (<>) = (<.>) + +instance Monoid HsWrapper where + mempty = WpHole + hsWrapper_dataType :: Data.DataType hsWrapper_dataType = Data.mkDataType "HsWrapper" |