Skip to content

GitLab

Commit 970d5b88 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Implement -X=GADTs and -X=RelaxedPolyRec 

Two new -X flags, one for GADTs and one for relaxed polymorphic recursion

This also fixes a rather confusing error message that the Darcs folk 
tripped over.
parent 5e05865d
Hide whitespace changes
Inline Side-by-side
compiler/typecheck/TcBinds.lhs
View file @ 970d5b88
......@@ -162,9 +162,9 @@ tcValBinds top_lvl (ValBindsOut binds sigs) thing_inside
-- Extend the envt right away with all
-- the Ids declared with type signatures
; gla_exts <- doptM Opt_GlasgowExts
; poly_rec <- doptM Opt_RelaxedPolyRec
; (binds', thing) <- tcExtendIdEnv poly_ids $
tc_val_binds gla_exts top_lvl sig_fn prag_fn
tc_val_binds poly_rec top_lvl sig_fn prag_fn
binds thing_inside
; return (ValBindsOut binds' sigs, thing) }
......@@ -176,14 +176,14 @@ tc_val_binds :: Bool -> TopLevelFlag -> TcSigFun -> TcPragFun
-- Typecheck a whole lot of value bindings,
-- one strongly-connected component at a time
tc_val_binds gla_exts top_lvl sig_fn prag_fn [] thing_inside
tc_val_binds poly_rec top_lvl sig_fn prag_fn [] thing_inside
= do { thing <- thing_inside
; return ([], thing) }
tc_val_binds gla_exts top_lvl sig_fn prag_fn (group : groups) thing_inside
tc_val_binds poly_rec top_lvl sig_fn prag_fn (group : groups) thing_inside
= do { (group', (groups', thing))
<- tc_group gla_exts top_lvl sig_fn prag_fn group $
tc_val_binds gla_exts top_lvl sig_fn prag_fn groups thing_inside
<- tc_group poly_rec top_lvl sig_fn prag_fn group $
tc_val_binds poly_rec top_lvl sig_fn prag_fn groups thing_inside
; return (group' ++ groups', thing) }
------------------------
......@@ -195,15 +195,15 @@ tc_group :: Bool -> TopLevelFlag -> TcSigFun -> TcPragFun
-- We get a list of groups back, because there may
-- be specialisations etc as well
tc_group gla_exts top_lvl sig_fn prag_fn (NonRecursive, binds) thing_inside
tc_group poly_rec top_lvl sig_fn prag_fn (NonRecursive, binds) thing_inside
-- A single non-recursive binding
-- We want to keep non-recursive things non-recursive
-- so that we desugar unlifted bindings correctly
= do { (binds, thing) <- tc_haskell98 top_lvl sig_fn prag_fn NonRecursive binds thing_inside
; return ([(NonRecursive, b) | b <- binds], thing) }
tc_group gla_exts top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
| not gla_exts -- Recursive group, normal Haskell 98 route
tc_group poly_rec top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
| not poly_rec -- Recursive group, normal Haskell 98 route
= do { (binds1, thing) <- tc_haskell98 top_lvl sig_fn prag_fn Recursive binds thing_inside
; return ([(Recursive, unionManyBags binds1)], thing) }
......
compiler/typecheck/TcPat.lhs
View file @ 970d5b88
......@@ -34,6 +34,7 @@ import Type
import StaticFlags
import TyCon
import DataCon
import DynFlags
import PrelNames
import BasicTypes hiding (SuccessFlag(..))
import SrcLoc
......@@ -729,8 +730,11 @@ refineAlt con pstate ex_tvs [] pat_ty
= return pstate -- Common case: no equational constraints
refineAlt con pstate ex_tvs co_vars pat_ty
| not (isRigidTy pat_ty)
= failWithTc (nonRigidMatch con)
= do { opt_gadt <- doptM Opt_GADTs -- No type-refinement unless GADTs are on
; if (not opt_gadt) then return pstate
else do
{ checkTc (isRigidTy pat_ty) (nonRigidMatch con)
-- We are matching against a GADT constructor with non-trivial
-- constraints, but pattern type is wobbly. For now we fail.
-- We can make sense of this, however:
......@@ -745,8 +749,8 @@ refineAlt con pstate ex_tvs co_vars pat_ty
-- then unify these constraints to make pat_ty the right shape;
-- then proceed exactly as in the rigid case
| otherwise -- In the rigid case, we perform type refinement
= case gadtRefine (pat_reft pstate) ex_tvs co_vars of {
-- In the rigid case, we perform type refinement
; case gadtRefine (pat_reft pstate) ex_tvs co_vars of {
Failed msg -> failWithTc (inaccessibleAlt msg) ;
Succeeded reft -> do { traceTc trace_msg
; return (pstate { pat_reft = reft }) }
......@@ -758,7 +762,7 @@ refineAlt con pstate ex_tvs co_vars pat_ty
vcat [ ppr con <+> ppr ex_tvs,
ppr [(v, tyVarKind v) | v <- co_vars],
ppr reft]
}
} } }
\end{code}
......
compiler/typecheck/TcTyClsDecls.lhs
View file @ 970d5b88
......@@ -657,10 +657,11 @@ tcTyClDecl1 calc_isrec
; want_generic <- doptM Opt_Generics
; unbox_strict <- doptM Opt_UnboxStrictFields
; gla_exts <- doptM Opt_GlasgowExts
; gadt_ok <- doptM Opt_GADTs
; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
-- Check that we don't use GADT syntax in H98 world
; checkTc (gla_exts || h98_syntax) (badGadtDecl tc_name)
; checkTc (gadt_ok || h98_syntax) (badGadtDecl tc_name)
-- Check that we don't use kind signatures without Glasgow extensions
; checkTc (gla_exts || isNothing mb_ksig) (badSigTyDecl tc_name)
......@@ -1142,7 +1143,7 @@ badDataConTyCon data_con
badGadtDecl tc_name
= vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+> quotes (ppr tc_name)
, nest 2 (parens $ ptext SLIT("Use -fglasgow-exts to allow GADTs")) ]
, nest 2 (parens $ ptext SLIT("Use -X=GADT to allow GADTs")) ]
badStupidTheta tc_name
= ptext SLIT("A data type declared in GADT style cannot have a context:") <+> quotes (ppr tc_name)
......@@ -1175,7 +1176,7 @@ badSigTyDecl tc_name
badFamInstDecl tc_name
= vcat [ ptext SLIT("Illegal family instance for") <+>
quotes (ppr tc_name)
, nest 2 (parens $ ptext SLIT("Use -ftype-families to allow indexed type families")) ]
, nest 2 (parens $ ptext SLIT("Use -X=TypeFamilies to allow indexed type families")) ]
badGadtIdxTyDecl tc_name
= vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+>
......
docs/users_guide/flags.xml
View file @ 970d5b88
......@@ -677,6 +677,12 @@
<entry>dynamic</entry>
<entry><option>-X=MonoPatBinds</option></entry>
</row>
<row>
<entry><option>-X=RelaxedPolyRed</option></entry>
<entry>Relaxed checking for <link linkend="typing-binds">mutually-recursive polymorphic functions</link></entry>
<entry>dynamic</entry>
<entry><option>-X=NoRelaxedPolyRec</option></entry>
</row>
<row>
<entry><option>-X=ExtendedDefaultRules</option></entry>
<entry>Use GHCi's <link linkend="extended-default-rules">extended default rules</link> in a normal module</entry>
......@@ -688,7 +694,20 @@
<entry>Enable <link linkend="overloaded-strings">overloaded string literals</link>.
</entry>
<entry>dynamic</entry>
<entry><option>-X=OverloadedStrings</option></entry>
<entry><option>-X=NoOverloadedStrings</option></entry>
</row>
<row>
<entry><option>-X=GADTs</option></entry>
<entry>Enable <link linkend="gadts">generalised algebraic data types</link>.
</entry>
<entry>dynamic</entry>
<entry><option>-X=NoGADTs</option></entry>
</row>
<row>
<entry><option>-X=TypeFamilies</option></entry>
<entry>Enable <link linkend="type-families">type families</link>.</entry>
<entry>dynamic</entry>
<entry><option>-X=NoTypeFamilies</option></entry>
</row>
<row>
<entry><option>-X=ScopedTypeVariables</option></entry>
......@@ -704,12 +723,6 @@
<entry>dynamic</entry>
<entry><option>-X=NoTH</option></entry>
</row>
<row>
<entry><option>-X=TypeFamilies</option></entry>
<entry>Enable <link linkend="type-families">type families</link>.</entry>
<entry>dynamic</entry>
<entry><option>-X=NoTypeFamilies</option></entry>
</row>
<row>
<entry><option>-X=BangPtterns</option></entry>
<entry>Enable <link linkend="bang-patterns">bang patterns</link>.</entry>
......
docs/users_guide/glasgow_exts.xml
View file @ 970d5b88
......@@ -4039,7 +4039,7 @@ and all others are monomorphic until the group is generalised
<para>Following a suggestion of Mark Jones, in his paper
<ulink url="http://www.cse.ogi.edu/~mpj/thih/">Typing Haskell in
Haskell</ulink>,
GHC implements a more general scheme. If <option>-fglasgow-exts</option> is
GHC implements a more general scheme. If <option>-X=RelaxedPolyRec</option> is
specified:
<emphasis>the dependency analysis ignores references to variables that have an explicit
type signature</emphasis>.
......@@ -4068,7 +4068,7 @@ Now, the defintion for <literal>f</literal> is typechecked, with this type for
The same refined dependency analysis also allows the type signatures of
mutually-recursive functions to have different contexts, something that is illegal in
Haskell 98 (Section 4.5.2, last sentence). With
<option>-fglasgow-exts</option>
<option>-X=RelaxedPolyRec</option>
GHC only insists that the type signatures of a <emphasis>refined</emphasis> group have identical
type signatures; in practice this means that only variables bound by the same
pattern binding must have the same context. For example, this is fine:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment