diff options
| -rw-r--r-- | compiler/basicTypes/BasicTypes.lhs | 73 | ||||
| -rw-r--r-- | compiler/hsSyn/HsDecls.lhs | 18 | ||||
| -rw-r--r-- | compiler/parser/Lexer.x | 10 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 14 | ||||
| -rw-r--r-- | compiler/typecheck/Inst.lhs | 2 | ||||
| -rw-r--r-- | compiler/types/InstEnv.lhs | 27 | ||||
| -rw-r--r-- | compiler/utils/Binary.hs | 12 | ||||
| -rw-r--r-- | docs/users_guide/glasgow_exts.xml | 53 |
8 files changed, 136 insertions, 73 deletions
diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index f4a7aaf335..0ae47377d7 100644 --- a/compiler/basicTypes/BasicTypes.lhs +++ b/compiler/basicTypes/BasicTypes.lhs @@ -42,6 +42,7 @@ module BasicTypes( TopLevelFlag(..), isTopLevel, isNotTopLevel, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, + hasOverlappingFlag, hasOverlappableFlag, Boxity(..), isBoxed, @@ -456,43 +457,81 @@ setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag setOverlapModeMaybe f Nothing = f setOverlapModeMaybe f (Just m) = f { overlapMode = m } +hasOverlappableFlag :: OverlapMode -> Bool +hasOverlappableFlag mode = + case mode of + Overlappable -> True + Overlaps -> True + _ -> False + +hasOverlappingFlag :: OverlapMode -> Bool +hasOverlappingFlag mode = + case mode of + Overlapping -> True + Overlaps -> True + _ -> False data OverlapMode - -- | This instance must not overlap another + + {- | This instance must not overlap another `NoOverlap` instance. + However, it may be overlapped by `Overlapping` instances, + and it may overlap `Overlappable` instances. -} = NoOverlap - -- | Silently ignore this instance if you find a - -- more specific one that matches the constraint - -- you are trying to resolve - -- - -- Example: constraint (Foo [Int]) - -- instances (Foo [Int]) - -- (Foo [a]) OverlapOk - -- Since the second instance has the OverlapOk flag, - -- the first instance will be chosen (otherwise - -- its ambiguous which to choose) - | OverlapOk + + {- | Silently ignore this instance if you find a + more specific one that matches the constraint + you are trying to resolve + + Example: constraint (Foo [Int]) + instance Foo [Int] + instance {-# OVERLAPPABLE #-} Foo [a] + + Since the second instance has the Overlappable flag, + the first instance will be chosen (otherwise + its ambiguous which to choose) -} + | Overlappable + + + {- | Silently ignore any more general instances that may be + used to solve the constraint. + + Example: constraint (Foo [Int]) + instance {-# OVERLAPPING #-} Foo [Int] + instance Foo [a] + + Since the first instance has the Overlapping flag, + the second---more general---instance will be ignored (otherwise + its ambiguous which to choose) -} + | Overlapping + + + -- | Equiavalent to having both `Overlapping` and `Overlappable` flags. + | Overlaps -- | Silently ignore this instance if you find any other that matches the -- constraing you are trying to resolve, including when checking if there are -- instances that do not match, but unify. -- -- Example: constraint (Foo [b]) - -- instances (Foo [Int]) Incoherent - -- (Foo [a]) + -- instance {-# INCOHERENT -} Foo [Int] + -- instance Foo [a] -- Without the Incoherent flag, we'd complain that -- instantiating 'b' would change which instance -- was chosen. See also note [Incoherent instances] | Incoherent deriving (Eq, Data, Typeable) + instance Outputable OverlapFlag where ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag) instance Outputable OverlapMode where - ppr NoOverlap = empty - ppr OverlapOk = ptext (sLit "[overlap ok]") - ppr Incoherent = ptext (sLit "[incoherent]") + ppr NoOverlap = empty + ppr Overlappable = ptext (sLit "[overlappable]") + ppr Overlapping = ptext (sLit "[overlapping]") + ppr Overlaps = ptext (sLit "[overlap ok]") + ppr Incoherent = ptext (sLit "[incoherent]") pprSafeOverlap :: Bool -> SDoc pprSafeOverlap True = ptext $ sLit "[safe]" diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs index 845c05296c..313dccccd5 100644 --- a/compiler/hsSyn/HsDecls.lhs +++ b/compiler/hsSyn/HsDecls.lhs @@ -1055,16 +1055,18 @@ instance (OutputableBndr name) => Outputable (ClsInstDecl name) where map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++ pprLHsBindsForUser binds sigs ] where - top_matter = ptext (sLit "instance") <+> ppOveralapPragma mbOverlap + top_matter = ptext (sLit "instance") <+> ppOverlapPragma mbOverlap <+> ppr inst_ty -ppOveralapPragma :: Maybe OverlapMode -> SDoc -ppOveralapPragma mb = +ppOverlapPragma :: Maybe OverlapMode -> SDoc +ppOverlapPragma mb = case mb of - Nothing -> empty - Just NoOverlap -> ptext (sLit "{-# NO_OVERLAP #-}") - Just OverlapOk -> ptext (sLit "{-# OVERLAP #-}") - Just Incoherent -> ptext (sLit "{-# INCOHERENT #-}") + Nothing -> empty + Just NoOverlap -> ptext (sLit "{-# NO_OVERLAP #-}") + Just Overlappable -> ptext (sLit "{-# OVERLAPPABLE #-}") + Just Overlapping -> ptext (sLit "{-# OVERLAPPING #-}") + Just Overlaps -> ptext (sLit "{-# OVERLAPS #-}") + Just Incoherent -> ptext (sLit "{-# INCOHERENT #-}") @@ -1102,7 +1104,7 @@ data DerivDecl name = DerivDecl { deriv_type :: LHsType name instance (OutputableBndr name) => Outputable (DerivDecl name) where ppr (DerivDecl ty o) - = hsep [ptext (sLit "deriving instance"), ppOveralapPragma o, ppr ty] + = hsep [ptext (sLit "deriving instance"), ppOverlapPragma o, ppr ty] \end{code} %************************************************************************ diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 3917dcfcfc..88a0f07d90 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -527,8 +527,9 @@ data Token | ITvect_scalar_prag | ITnovect_prag | ITminimal_prag - | ITno_overlap_prag -- instance overlap mode - | IToverlap_prag -- instance overlap mode + | IToverlappable_prag -- instance overlap mode + | IToverlapping_prag -- instance overlap mode + | IToverlaps_prag -- instance overlap mode | ITincoherent_prag -- instance overlap mode | ITctype @@ -2431,8 +2432,9 @@ oneWordPrags = Map.fromList([("rules", rulePrag), ("vectorize", token ITvect_prag), ("novectorize", token ITnovect_prag), ("minimal", token ITminimal_prag), - ("no_overlap", token ITno_overlap_prag), - ("overlap", token IToverlap_prag), + ("overlaps", token IToverlaps_prag), + ("overlappable", token IToverlappable_prag), + ("overlapping", token IToverlapping_prag), ("incoherent", token ITincoherent_prag), ("ctype", token ITctype)]) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index d592510aa6..3fff097d25 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -286,8 +286,9 @@ incorrect. '{-# NOVECTORISE' { L _ ITnovect_prag } '{-# MINIMAL' { L _ ITminimal_prag } '{-# CTYPE' { L _ ITctype } - '{-# NO_OVERLAP' { L _ ITno_overlap_prag } - '{-# OVERLAP' { L _ IToverlap_prag } + '{-# OVERLAPPING' { L _ IToverlapping_prag } + '{-# OVERLAPPABLE' { L _ IToverlappable_prag } + '{-# OVERLAPS' { L _ IToverlaps_prag } '{-# INCOHERENT' { L _ ITincoherent_prag } '#-}' { L _ ITclose_prag } @@ -707,10 +708,11 @@ inst_decl :: { LInstDecl RdrName } (unLoc $5) (unLoc $6) (unLoc $7) } overlap_pragma :: { Maybe OverlapMode } - : '{-# OVERLAP' '#-}' { Just OverlapOk } - | '{-# INCOHERENT' '#-}' { Just Incoherent } - | '{-# NO_OVERLAP' '#-}' { Just NoOverlap } - | {- empty -} { Nothing } + : '{-# OVERLAPPABLE' '#-}' { Just Overlappable } + | '{-# OVERLAPPING' '#-}' { Just Overlapping } + | '{-# OVERLAPS' '#-}' { Just Overlaps } + | '{-# INCOHERENT' '#-}' { Just Incoherent } + | {- empty -} { Nothing } -- Closed type families diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs index dac522803f..723ce0671e 100644 --- a/compiler/typecheck/Inst.lhs +++ b/compiler/typecheck/Inst.lhs @@ -390,7 +390,7 @@ getOverlapFlag use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags , overlapMode = x } overlap_flag | incoherent_ok = use Incoherent - | overlap_ok = use OverlapOk + | overlap_ok = use Overlaps | otherwise = use NoOverlap ; return overlap_flag } diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs index be1cdb1e44..e1ab8da5c7 100644 --- a/compiler/types/InstEnv.lhs +++ b/compiler/types/InstEnv.lhs @@ -638,20 +638,23 @@ insert_overlapping new_item (item:items) incoherent (inst, _) = overlapMode (is_flag inst) == Incoherent + -- `instB` can be instantiated to match `instA` + instA `moreSpecificThan` instB = + isJust (tcMatchTys (mkVarSet (is_tvs instB)) + (is_tys instB) (is_tys instA)) + (instA, _) `beats` (instB, _) - = overlap_ok && - isJust (tcMatchTys (mkVarSet (is_tvs instB)) (is_tys instB) (is_tys instA)) - -- A beats B if A is more specific than B, - -- (ie. if B can be instantiated to match A) - -- and overlap is permitted + = overlap_ok && (instA `moreSpecificThan` instB) where - -- Overlap permitted if *either* instance permits overlap - -- This is a change (Trac #3877, Dec 10). It used to - -- require that instB (the less specific one) permitted overlap. - overlap_ok = case (overlapMode (is_flag instA), - overlapMode (is_flag instB)) of - (NoOverlap, NoOverlap) -> False - _ -> True + {- Overlap permitted if either the more specific instance + is marked as overlapping, or the more general one is + marked as overlappable. + Latest change described in: Trac #9242. + Previous change: Trac #3877, Dec 10. -} + overlap_ok = hasOverlappingFlag (overlapMode (is_flag instA)) + || hasOverlappableFlag (overlapMode (is_flag instB)) + + \end{code} Note [Incoherent instances] diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 82d1497ee6..0aa8c648b8 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -834,15 +834,19 @@ instance Binary RecFlag where _ -> do return NonRecursive instance Binary OverlapMode where - put_ bh NoOverlap = putByte bh 0 - put_ bh OverlapOk = putByte bh 1 - put_ bh Incoherent = putByte bh 2 + put_ bh NoOverlap = putByte bh 0 + put_ bh Overlaps = putByte bh 1 + put_ bh Incoherent = putByte bh 2 + put_ bh Overlapping = putByte bh 3 + put_ bh Overlappable = putByte bh 4 get bh = do h <- getByte bh case h of 0 -> return NoOverlap - 1 -> return OverlapOk + 1 -> return Overlaps 2 -> return Incoherent + 3 -> return Overlapping + 4 -> return Overlappable _ -> panic ("get OverlapMode" ++ show h) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 0163ac95c0..7b49a55dc2 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -5026,12 +5026,12 @@ an <literal>LANGUAGE</literal> pragma if desired (<xref linkend="language-pragma In addition, it is possible to specify the overlap behavior for individual instances with a pragma, written immediately after the <literal>instance</literal> keyword. The pragma may be one of: -<literal>OVERLAP</literal>, <literal>NO_OVERLAP</literal>, +<literal>OVERLAPPING</literal>, +<literal>OVERLAPPABLE</literal>, +<literal>OVERLAPS</literal>, or <literal>INCOHERENT</literal>. An explicit pragma on an instance takes precedence over the default specified with a flag or -a <literal>LANGUAGE</literal> pragma. For example, an instance marked with -<literal>{-# NO_OVERLAP #-}</literal> will be marked as non-overlapping, -even if the module contains <literal>{-# LANGUAGE OverlappingInstances #-}</literal>. +a <literal>LANGUAGE</literal> pragma. </para> @@ -5075,15 +5075,25 @@ instantiated. If all of them were compiled with Eliminate any candidate IX for which both of the following hold: <itemizedlist> -<listitem><para>There is another candidate IY that is strictly more specific; -that is, IY is a substitution instance of IX but not vice versa. -</para></listitem> -<listitem><para>Either IX or IY was compiled with -<option>-XOverlappingInstances</option>. -</para></listitem> -</itemizedlist> - -</para></listitem> + <listitem><para>There is another candidate IY that is strictly more specific; + that is, IY is a substitution instance of IX but not vice versa. + </para></listitem> + <listitem><para> + Either IX is <emphasis>overlappable</emphasis> or IY is + <emphasis>overlapping</emphasis>. + </para></listitem> + </itemizedlist> +</para> +<para> +Instance annotated with an <literal>OVERLAPPABLE</literal> or +<literal>OVERLAPPING</literal> pragma are treated as such. +</para> +<para> +Instances annotated with the <literal>OVERLAPS</literal> pragma, or compiled +with <option>-XOverlappingInstances</option>, are treated as both +<emphasis>overlapping</emphasis> and <emphasis>overlappable</emphasis>. +</para> +</listitem> <listitem><para> If only one candidate remains, pick it. @@ -10785,18 +10795,19 @@ data T = T {-# NOUNPACK #-} !(Int,Int) </sect2> <sect2 id="overlap-pragma"> -<title>OVERLAP, NO_OVERLAP, and INCOHERENT pragmas</title> +<title>OVERLAPPINGP, OVERLAPPABLE, OVERLAPS, and INCOHERENT pragmas</title> <para> -The <literal>OVERLAP</literal>, <literal>NO_OVERLAP</literal>, and -<literal>INCOHERENT</literal> pragmas are used to specify the overlap +The pragmas + <literal>OVERLAPPING</literal>, + <literal>OVERLAPPABLE</literal>, + <literal>OVERLAPS</literal>, + <literal>INCOHERENT</literal> are used to specify the overlap behavior for individual instances, as described in Section -<xref linkend="instance-overlap"/>. They take precedence over the behavior -specified with the corresponding <literal>LANGUAGE</literal> pragmas. -The pragmas are written immediately after the <literal>instance</literal> -keyword. For example: +<xref linkend="instance-overlap"/>. The pragmas are written immediately +after the <literal>instance</literal> keyword, like this: </para> <programlisting> -instance {-# OVERLAP #-} C t where ... +instance {-# OVERLAPPING #-} C t where ... </programlisting> </sect2> |