Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
0bdafd5c
Commit
0bdafd5c
authored
Sep 07, 2011
by
Simon Peyton Jones
Browse files
ConstraintKind -> ConstraintKinds
parent
80d19632
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
0bdafd5c
...
...
@@ -383,7 +383,7 @@ data ExtensionFlag
|
Opt_NPlusKPatterns
|
Opt_DoAndIfThenElse
|
Opt_RebindableSyntax
|
Opt_ConstraintKind
|
Opt_ConstraintKind
s
|
Opt_StandaloneDeriving
|
Opt_DeriveDataTypeable
...
...
@@ -1862,7 +1862,7 @@ xFlags = [
(
"NPlusKPatterns"
,
AlwaysAllowed
,
Opt_NPlusKPatterns
,
nop
),
(
"DoAndIfThenElse"
,
AlwaysAllowed
,
Opt_DoAndIfThenElse
,
nop
),
(
"RebindableSyntax"
,
AlwaysAllowed
,
Opt_RebindableSyntax
,
nop
),
(
"ConstraintKind"
,
AlwaysAllowed
,
Opt_ConstraintKind
,
nop
),
(
"ConstraintKind
s
"
,
AlwaysAllowed
,
Opt_ConstraintKind
s
,
nop
),
(
"MonoPatBinds"
,
AlwaysAllowed
,
Opt_MonoPatBinds
,
\
turn_on
->
when
turn_on
$
deprecate
"Experimental feature now removed; has no effect"
),
(
"ExplicitForAll"
,
AlwaysAllowed
,
Opt_ExplicitForAll
,
nop
),
...
...
compiler/parser/RdrHsSyn.lhs
View file @
0bdafd5c
...
...
@@ -787,12 +787,12 @@ checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
checkKindName :: Located FastString -> P (Located Kind)
checkKindName (L l fs) = do
pState <- getPState
let ext_enabled = xopt Opt_ConstraintKind (dflags pState)
let ext_enabled = xopt Opt_ConstraintKind
s
(dflags pState)
is_kosher = fs == occNameFS (nameOccName constraintKindTyConName)
if not ext_enabled || not is_kosher
then parseErrorSDoc l (text "Unexpected named kind:"
$$ nest 4 (ppr fs)
$$ if (not ext_enabled && is_kosher) then text "Perhaps you meant to use -XConstraintKind?" else empty)
$$ if (not ext_enabled && is_kosher) then text "Perhaps you meant to use -XConstraintKind
s
?" else empty)
else return (L l constraintKind)
\end{code}
...
...
compiler/typecheck/TcHsType.lhs
View file @
0bdafd5c
...
...
@@ -50,7 +50,7 @@ import NameSet
import TysWiredIn
import BasicTypes
import SrcLoc
import DynFlags ( ExtensionFlag(Opt_ConstraintKind) )
import DynFlags ( ExtensionFlag(
Opt_ConstraintKind
s
) )
import Util
import UniqSupply
import Outputable
...
...
@@ -373,7 +373,7 @@ kc_hs_type (HsKindSig ty k) = do
return (HsKindSig ty' k, k)
kc_hs_type (HsTupleTy (HsBoxyTuple _) tys) = do
fact_tup_ok <- xoptM Opt_ConstraintKind
fact_tup_ok <- xoptM Opt_ConstraintKind
s
if not fact_tup_ok
then do tys' <- mapM kcLiftedType tys
return (HsTupleTy (HsBoxyTuple liftedTypeKind) tys', liftedTypeKind)
...
...
compiler/typecheck/TcMType.lhs
View file @
0bdafd5c
...
...
@@ -1155,10 +1155,10 @@ check_pred_ty' _ _ctxt (IPPred _ ty) = checkValidMonoType ty
-- Happily this is not an issue in the new constraint solver.
check_pred_ty' dflags ctxt t@(TuplePred ts)
= do { checkTc (xopt Opt_ConstraintKind dflags)
= do { checkTc (xopt Opt_ConstraintKind
s
dflags)
(predTupleErr (predTreePredType t))
; mapM_ (check_pred_ty' dflags ctxt) ts }
-- This case will not normally be executed because without ConstraintKind
-- This case will not normally be executed because without
-X
ConstraintKind
s
-- tuple types are only kind-checked as *
check_pred_ty' dflags ctxt (IrredPred pred)
...
...
@@ -1178,7 +1178,7 @@ check_pred_ty' dflags ctxt (IrredPred pred)
--
-- In both cases it's OK if the predicate is actually a synonym, though.
-- We'll also allow it if
= do checkTc (xopt Opt_ConstraintKind dflags)
= do checkTc (xopt Opt_ConstraintKind
s
dflags)
(predIrredErr pred)
case tcView pred of
Just pred' ->
...
...
@@ -1338,9 +1338,9 @@ eqPredTyErr pred = ptext (sLit "Illegal equational constraint") <+> pprType pre
predTyVarErr pred = sep [ptext (sLit "Non type-variable argument"),
nest 2 (ptext (sLit "in the constraint:") <+> pprType pred)]
predTupleErr pred = ptext (sLit "Illegal tuple constraint") <+> pprType pred $$
parens (ptext (sLit "Use -XConstraintKind to permit this"))
parens (ptext (sLit "Use -XConstraintKind
s
to permit this"))
predIrredErr pred = ptext (sLit "Illegal irreducible constraint") <+> pprType pred $$
parens (ptext (sLit "Use -XConstraintKind to permit this"))
parens (ptext (sLit "Use -XConstraintKind
s
to permit this"))
predIrredBadCtxtErr pred = ptext (sLit "Illegal irreducible constraint") <+> pprType pred $$
ptext (sLit "in superclass/instance head context") <+>
parens (ptext (sLit "Use -XUndecidableInstances to permit this"))
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment