Refactor tuple constraints
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 11 May 2015 22:19:14 +0000 (23:19 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 13 May 2015 08:02:13 +0000 (09:02 +0100)
Make tuple constraints be handled by a perfectly ordinary
type class, with the component constraints being the
superclasses:
    class (c1, c2) => (c2, c2)

This change was provoked by

  #10359  inability to re-use a given tuple
          constraint as a whole

  #9858   confusion between term tuples
          and constraint tuples

but it's generally a very nice simplification. We get rid of
 -  In Type, the TuplePred constructor of PredTree,
    and all the code that dealt with TuplePreds
 -  In TcEvidence, the constructors EvTupleMk, EvTupleSel

See Note [How tuples work] in TysWiredIn.

Of course, nothing is ever entirely simple. This one
proved quite fiddly.

- I did quite a bit of renaming, which makes this patch
  touch a lot of modules. In partiuclar tupleCon -> tupleDataCon.

- I made constraint tuples known-key rather than wired-in.
  This is different to boxed/unboxed tuples, but it proved
  awkward to have all the superclass selectors wired-in.
  Easier just to use the standard mechanims.

- While I was fiddling with known-key names, I split the TH Name
  definitions out of DsMeta into a new module THNames.  That meant
  that the known-key names can all be gathered in PrelInfo, without
  causing module loops.

- I found that the parser was parsing an import item like
      T( .. )
  as a *data constructor* T, and then using setRdrNameSpace to
  fix it.  Stupid!  So I changed the parser to parse a *type
  constructor* T, which means less use of setRdrNameSpace.

  I also improved setRdrNameSpace to behave better on Exact Names.
  Largely on priciple; I don't think it matters a lot.

- When compiling a data type declaration for a wired-in thing like
  tuples (,), or lists, we don't really need to look at the
  declaration.  We have the wired-in thing!  And not doing so avoids
  having to line up the uniques for data constructor workers etc.
  See Note [Declarations for wired-in things]

- I found that FunDeps.oclose wasn't taking superclasses into
  account; easily fixed.

- Some error message refactoring for invalid constraints in TcValidity

83 files changed:
compiler/basicTypes/BasicTypes.hs
compiler/basicTypes/DataCon.hs
compiler/basicTypes/RdrName.hs
compiler/basicTypes/Unique.hs
compiler/coreSyn/CoreLint.hs
compiler/coreSyn/MkCore.hs
compiler/coreSyn/PprCore.hs
compiler/deSugar/Check.hs
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsBinds.hs
compiler/deSugar/DsCCall.hs
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsMeta.hs
compiler/deSugar/Match.hs
compiler/ghc.cabal.in
compiler/ghci/RtClosureInspect.hs
compiler/hsSyn/Convert.hs
compiler/hsSyn/HsExpr.hs
compiler/hsSyn/HsPat.hs
compiler/hsSyn/HsTypes.hs
compiler/iface/BinIface.hs
compiler/iface/BuildTyCl.hs
compiler/iface/IfaceSyn.hs
compiler/iface/IfaceType.hs
compiler/iface/TcIface.hs
compiler/main/Constants.hs
compiler/main/HscMain.hs
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/prelude/PrelInfo.hs
compiler/prelude/PrelNames.hs
compiler/prelude/PrelRules.hs
compiler/prelude/PrimOp.hs
compiler/prelude/THNames.hs [new file with mode: 0644]
compiler/prelude/TysWiredIn.hs
compiler/rename/RnEnv.hs
compiler/rename/RnNames.hs
compiler/rename/RnSplice.hs
compiler/simplStg/UnariseStg.hs
compiler/specialise/Specialise.hs
compiler/stranal/WwLib.hs
compiler/typecheck/FunDeps.hs
compiler/typecheck/TcCanonical.hs
compiler/typecheck/TcErrors.hs
compiler/typecheck/TcEvidence.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcGenDeriv.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcInteract.hs
compiler/typecheck/TcMType.hs
compiler/typecheck/TcPat.hs
compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcSimplify.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcType.hs
compiler/typecheck/TcValidity.hs
compiler/types/TyCon.hs
compiler/types/Type.hs
compiler/types/TypeRep.hs
compiler/vectorise/Vectorise/Builtins/Base.hs
compiler/vectorise/Vectorise/Builtins/Initialise.hs
compiler/vectorise/Vectorise/Utils/Closure.hs
libraries/ghc-prim/GHC/Classes.hs
libraries/ghc-prim/GHC/Tuple.hs
libraries/ghc-prim/GHC/Types.hs
testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr
testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr
testsuite/tests/module/all.T
testsuite/tests/module/mod89.hs
testsuite/tests/module/mod89.stderr
testsuite/tests/typecheck/should_fail/T9858a.stderr
testsuite/tests/typecheck/should_fail/fd-loop.stderr
testsuite/tests/typecheck/should_fail/tcfail108.stderr
testsuite/tests/typecheck/should_fail/tcfail154.stderr
testsuite/tests/typecheck/should_fail/tcfail157.stderr
testsuite/tests/typecheck/should_fail/tcfail213.stderr
testsuite/tests/typecheck/should_fail/tcfail214.stderr
testsuite/tests/typecheck/should_fail/tcfail220.hsig
testsuite/tests/typecheck/should_fail/tcfail220.stderr
utils/genprimopcode/Main.hs

index cf1bf58..682317b 100644 (file)
@@ -46,7 +46,7 @@ module BasicTypes(
 
         Boxity(..), isBoxed,
 
-        TupleSort(..), tupleSortBoxity, boxityNormalTupleSort,
+        TupleSort(..), tupleSortBoxity, boxityTupleSort,
         tupleParens,
 
         -- ** The OneShotInfo type
@@ -94,7 +94,7 @@ module BasicTypes(
 import FastString
 import Outputable
 import SrcLoc ( Located,unLoc )
-
+import StaticFlags( opt_PprStyle_Debug )
 import Data.Data hiding (Fixity)
 import Data.Function (on)
 import GHC.Exts (Any)
@@ -573,19 +573,20 @@ data TupleSort
   deriving( Eq, Data, Typeable )
 
 tupleSortBoxity :: TupleSort -> Boxity
-tupleSortBoxity BoxedTuple     = Boxed
-tupleSortBoxity UnboxedTuple   = Unboxed
+tupleSortBoxity BoxedTuple      = Boxed
+tupleSortBoxity UnboxedTuple    = Unboxed
 tupleSortBoxity ConstraintTuple = Boxed
 
-boxityNormalTupleSort :: Boxity -> TupleSort
-boxityNormalTupleSort Boxed   = BoxedTuple
-boxityNormalTupleSort Unboxed = UnboxedTuple
+boxityTupleSort :: Boxity -> TupleSort
+boxityTupleSort Boxed   = BoxedTuple
+boxityTupleSort Unboxed = UnboxedTuple
 
 tupleParens :: TupleSort -> SDoc -> SDoc
 tupleParens BoxedTuple      p = parens p
-tupleParens ConstraintTuple p = parens p -- The user can't write fact tuples
-                                         -- directly, we overload the (,,) syntax
-tupleParens UnboxedTuple p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
+tupleParens UnboxedTuple    p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
+tupleParens ConstraintTuple p   -- In debug-style write (% Eq a, Ord b %)
+  | opt_PprStyle_Debug        = ptext (sLit "(%") <+> p <+> ptext (sLit "%)")
+  | otherwise                 = parens p
 
 {-
 ************************************************************************
index 46d79d8..79c1472 100644 (file)
@@ -1015,7 +1015,6 @@ dataConCannotMatch tys con
     -- TODO: could gather equalities from superclasses too
     predEqs pred = case classifyPredType pred of
                      EqPred NomEq ty1 ty2 -> [(ty1, ty2)]
-                     TuplePred ts         -> concatMap predEqs ts
                      _                    -> []
 
 {-
index 094347a..4ebeeca 100644 (file)
@@ -32,7 +32,7 @@ module RdrName (
         nameRdrName, getRdrName,
 
         -- ** Destruction
-        rdrNameOcc, rdrNameSpace, setRdrNameSpace, demoteRdrName,
+        rdrNameOcc, rdrNameSpace, demoteRdrName,
         isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
         isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
 
@@ -153,32 +153,6 @@ rdrNameOcc (Exact name) = nameOccName name
 rdrNameSpace :: RdrName -> NameSpace
 rdrNameSpace = occNameSpace . rdrNameOcc
 
-setRdrNameSpace :: RdrName -> NameSpace -> RdrName
--- ^ This rather gruesome function is used mainly by the parser.
--- When parsing:
---
--- > data T a = T | T1 Int
---
--- we parse the data constructors as /types/ because of parser ambiguities,
--- so then we need to change the /type constr/ to a /data constr/
---
--- The exact-name case /can/ occur when parsing:
---
--- > data [] a = [] | a : [a]
---
--- For the exact-name case we return an original name.
-setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
-setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
-setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
-setRdrNameSpace (Exact n)    ns
-  | isExternalName n
-  = Orig (nameModule n) occ
-  | otherwise   -- This can happen when quoting and then splicing a fixity
-                -- declaration for a type
-  = Exact $ mkSystemNameAt (nameUnique n) occ (nameSrcSpan n)
-  where
-    occ = setOccNameSpace ns (nameOccName n)
-
 -- demoteRdrName lowers the NameSpace of RdrName.
 -- see Note [Demotion] in OccName
 demoteRdrName :: RdrName -> Maybe RdrName
index ecff80f..70600d8 100644 (file)
@@ -43,6 +43,7 @@ module Unique (
         mkAlphaTyVarUnique,
         mkPrimOpIdUnique,
         mkTupleTyConUnique, mkTupleDataConUnique,
+        mkCTupleTyConUnique,
         mkPreludeMiscIdUnique, mkPreludeDataConUnique,
         mkPreludeTyConUnique, mkPreludeClassUnique,
         mkPArrDataConUnique,
@@ -283,25 +284,25 @@ Allocation of unique supply characters:
 mkAlphaTyVarUnique     :: Int -> Unique
 mkPreludeClassUnique   :: Int -> Unique
 mkPreludeTyConUnique   :: Int -> Unique
-mkTupleTyConUnique     :: TupleSort -> Int -> Unique
-mkPreludeDataConUnique :: Int -> Unique
-mkTupleDataConUnique   :: TupleSort -> Int -> Unique
+mkTupleTyConUnique     :: Boxity -> Arity -> Unique
+mkCTupleTyConUnique    :: Arity -> Unique
+mkPreludeDataConUnique :: Arity -> Unique
+mkTupleDataConUnique   :: Boxity -> Arity -> Unique
 mkPrimOpIdUnique       :: Int -> Unique
 mkPreludeMiscIdUnique  :: Int -> Unique
 mkPArrDataConUnique    :: Int -> Unique
 
-mkAlphaTyVarUnique i            = mkUnique '1' i
-
-mkPreludeClassUnique i          = mkUnique '2' i
+mkAlphaTyVarUnique   i = mkUnique '1' i
+mkPreludeClassUnique i = mkUnique '2' i
 
 -- Prelude type constructors occupy *three* slots.
 -- The first is for the tycon itself; the latter two
 -- are for the generic to/from Ids.  See TysWiredIn.mk_tc_gen_info.
 
-mkPreludeTyConUnique i          = mkUnique '3' (3*i)
-mkTupleTyConUnique BoxedTuple   a       = mkUnique '4' (3*a)
-mkTupleTyConUnique UnboxedTuple a       = mkUnique '5' (3*a)
-mkTupleTyConUnique ConstraintTuple a    = mkUnique 'k' (3*a)
+mkPreludeTyConUnique i       = mkUnique '3' (3*i)
+mkTupleTyConUnique Boxed   a = mkUnique '4' (3*a)
+mkTupleTyConUnique Unboxed a = mkUnique '5' (3*a)
+mkCTupleTyConUnique        a = mkUnique 'k' (3*a)
 
 -- Data constructor keys occupy *two* slots.  The first is used for the
 -- data constructor itself and its wrapper function (the function that
@@ -309,10 +310,9 @@ mkTupleTyConUnique ConstraintTuple a    = mkUnique 'k' (3*a)
 -- used for the worker function (the function that builds the constructor
 -- representation).
 
-mkPreludeDataConUnique i        = mkUnique '6' (2*i)    -- Must be alphabetic
-mkTupleDataConUnique BoxedTuple   a = mkUnique '7' (2*a)        -- ditto (*may* be used in C labels)
-mkTupleDataConUnique UnboxedTuple    a = mkUnique '8' (2*a)
-mkTupleDataConUnique ConstraintTuple a = mkUnique 'h' (2*a)
+mkPreludeDataConUnique i       = mkUnique '6' (2*i)    -- Must be alphabetic
+mkTupleDataConUnique Boxed   a = mkUnique '7' (2*a)        -- ditto (*may* be used in C labels)
+mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a)
 
 mkPrimOpIdUnique op         = mkUnique '9' op
 mkPreludeMiscIdUnique  i    = mkUnique '0' i
index ec0bb5e..13285a5 100644 (file)
@@ -1570,7 +1570,7 @@ lookupIdInScope id
 
 
 oneTupleDataConId :: Id -- Should not happen
-oneTupleDataConId = dataConWorkId (tupleCon BoxedTuple 1)
+oneTupleDataConId = dataConWorkId (tupleDataCon Boxed 1)
 
 checkBndrIdInScope :: Var -> Var -> LintM ()
 checkBndrIdInScope binder id
index 6905641..3b76aef 100644 (file)
@@ -379,7 +379,7 @@ mkCoreVarTupTy ids = mkBoxedTupleTy (map idType ids)
 mkCoreTup :: [CoreExpr] -> CoreExpr
 mkCoreTup []  = Var unitDataConId
 mkCoreTup [c] = c
-mkCoreTup cs  = mkConApp (tupleCon BoxedTuple (length cs))
+mkCoreTup cs  = mkConApp (tupleDataCon Boxed (length cs))
                          (map (Type . exprType) cs ++ cs)
 
 -- | Build a big tuple holding the specified variables
@@ -484,7 +484,7 @@ mkSmallTupleSelector [var] should_be_the_same_var _ scrut
 mkSmallTupleSelector vars the_var scrut_var scrut
   = ASSERT( notNull vars )
     Case scrut scrut_var (idType the_var)
-         [(DataAlt (tupleCon BoxedTuple (length vars)), vars, Var the_var)]
+         [(DataAlt (tupleDataCon Boxed (length vars)), vars, Var the_var)]
 
 -- | A generalization of 'mkTupleSelector', allowing the body
 -- of the case to be an arbitrary expression.
@@ -537,7 +537,8 @@ mkSmallTupleCase [var] body _scrut_var scrut
   = bindNonRec var scrut body
 mkSmallTupleCase vars body scrut_var scrut
 -- One branch no refinement?
-  = Case scrut scrut_var (exprType body) [(DataAlt (tupleCon BoxedTuple (length vars)), vars, body)]
+  = Case scrut scrut_var (exprType body)
+         [(DataAlt (tupleDataCon Boxed (length vars)), vars, body)]
 
 {-
 ************************************************************************
index 24abf18..ecea850 100644 (file)
@@ -131,7 +131,7 @@ ppr_expr add_par expr@(App {})
     let
         pp_args     = sep (map pprArg args)
         val_args    = dropWhile isTypeArg args   -- Drop the type arguments for tuples
-        pp_tup_args = sep (punctuate comma (map pprCoreExpr val_args))
+        pp_tup_args = pprWithCommas pprCoreExpr val_args
     in
     case fun of
         Var f -> case isDataConWorkId_maybe f of
@@ -230,7 +230,7 @@ pprCoreAlt (con, args, rhs)
 ppr_case_pat :: OutputableBndr a => AltCon -> [a] -> SDoc
 ppr_case_pat (DataAlt dc) args
   | Just sort <- tyConTuple_maybe tc
-  = tupleParens sort (hsep (punctuate comma (map ppr_bndr args)))
+  = tupleParens sort (pprWithCommas ppr_bndr args)
   where
     ppr_bndr = pprBndr CaseBind
     tc = dataConTyCon dc
index 3d855d4..af72f74 100644 (file)
@@ -722,7 +722,7 @@ tidy_pat (PArrPat ps ty)
                            [ty]
 
 tidy_pat (TuplePat ps boxity tys)
-  = unLoc $ mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity)
+  = unLoc $ mkPrefixConPat (tupleDataCon boxity arity)
                            (map tidy_lpat ps) tys
   where
     arity = length ps
index 55cd7d2..44795b9 100644 (file)
@@ -152,7 +152,7 @@ coreCaseTuple uniqs scrut_var vars body
 coreCasePair :: Id -> Id -> Id -> CoreExpr -> CoreExpr
 coreCasePair scrut_var var1 var2 body
   = Case (Var scrut_var) scrut_var (exprType body)
-         [(DataAlt (tupleCon BoxedTuple 2), [var1, var2], body)]
+         [(DataAlt (tupleDataCon Boxed 2), [var1, var2], body)]
 
 mkCorePairTy :: Type -> Type -> Type
 mkCorePairTy t1 t2 = mkBoxedTupleTy [t1, t2]
index 8e56fb5..f67ffac 100644 (file)
@@ -40,19 +40,18 @@ import Digraph
 
 import PrelNames
 import TysPrim ( mkProxyPrimTy )
-import TyCon      ( isTupleTyCon, tyConDataCons_maybe
-                  , tyConName, isPromotedTyCon, isPromotedDataCon, tyConKind )
+import TyCon
 import TcEvidence
 import TcType
 import Type
 import Kind (returnsConstraintKind)
 import Coercion hiding (substCo)
-import TysWiredIn ( eqBoxDataCon, coercibleDataCon, tupleCon, mkListTy
+import TysWiredIn ( eqBoxDataCon, coercibleDataCon, mkListTy
                   , mkBoxedTupleTy, stringTy )
 import Id
 import MkId(proxyHashId)
 import Class
-import DataCon  ( dataConTyCon, dataConWorkId )
+import DataCon  ( dataConTyCon )
 import Name
 import MkId     ( seqId )
 import IdInfo   ( IdDetails(..) )
@@ -70,7 +69,6 @@ import BasicTypes hiding ( TopLevel )
 import DynFlags
 import FastString
 import ErrUtils( MsgDoc )
-import ListSetOps( getNth )
 import Util
 import Control.Monad( when )
 import MonadUtils
@@ -853,23 +851,6 @@ dsEvTerm (EvCast tm co)
 dsEvTerm (EvDFunApp df tys tms)     = return (Var df `mkTyApps` tys `mkApps` (map Var tms))
 dsEvTerm (EvCoercion (TcCoVarCo v)) = return (Var v)  -- See Note [Simple coercions]
 dsEvTerm (EvCoercion co)            = dsTcCoercion co mkEqBox
-
-dsEvTerm (EvTupleSel tm n)
-   = do { tup <- dsEvTerm tm
-        ; let scrut_ty  = exprType tup
-              (tc, tys) = splitTyConApp scrut_ty
-              Just [dc] = tyConDataCons_maybe tc
-              xs = mkTemplateLocals tys
-              the_x = getNth xs n
-        ; ASSERT( isTupleTyCon tc )
-          return $
-          Case tup (mkWildValBinder scrut_ty) (idType the_x) [(DataAlt dc, xs, Var the_x)] }
-
-dsEvTerm (EvTupleMk tms)
-  = return (Var (dataConWorkId dc) `mkTyApps` map idType tms `mkApps` map Var tms)
-  where
-    dc = tupleCon ConstraintTuple (length tms)
-
 dsEvTerm (EvSuperClass d n)
   = do { d' <- dsEvTerm d
        ; let (cls, tys) = getClassPredTys (exprType d')
index 5c5fde0..90121a0 100644 (file)
@@ -226,7 +226,7 @@ boxResult result_ty
                      _ -> []
 
               return_result state anss
-                = mkCoreConApps (tupleCon UnboxedTuple (2 + length extra_result_tys))
+                = mkCoreConApps (tupleDataCon Unboxed (2 + length extra_result_tys))
                                 (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys)
                                  ++ (state : anss))
 
@@ -290,9 +290,9 @@ mk_alt return_result (Just prim_res_ty, wrap_result)
     let
         the_rhs = return_result (Var state_id)
                                 (wrap_result (Var result_id) : map Var as)
-        ccall_res_ty = mkTyConApp (tupleTyCon UnboxedTuple arity)
+        ccall_res_ty = mkTyConApp (tupleTyCon Unboxed arity)
                                   (realWorldStatePrimTy : ls)
-        the_alt      = ( DataAlt (tupleCon UnboxedTuple arity)
+        the_alt      = ( DataAlt (tupleDataCon Unboxed arity)
                        , (state_id : args_ids)
                        , the_rhs
                        )
index 78a6d11..37c927d 100644 (file)
@@ -23,7 +23,6 @@ import DsMonad
 import Name
 import NameEnv
 import FamInstEnv( topNormaliseType )
-
 import DsMeta
 import HsSyn
 
@@ -293,7 +292,7 @@ dsExpr (ExplicitTuple tup_args boxity)
                 -- The reverse is because foldM goes left-to-right
 
        ; return $ mkCoreLams lam_vars $
-                  mkCoreConApps (tupleCon (boxityNormalTupleSort boxity) (length tup_args))
+                  mkCoreConApps (tupleDataCon boxity (length tup_args))
                                 (map (Type . exprType) args ++ args) }
 
 dsExpr (HsSCC _ cc expr@(L loc _)) = do
@@ -428,7 +427,7 @@ dsExpr (HsStatic expr@(L loc _)) = do
                             , srcLocCol  $ realSrcSpanStart r
                             )
            _             -> (0, 0)
-        srcLoc = mkCoreConApps (tupleCon BoxedTuple 2)
+        srcLoc = mkCoreConApps (tupleDataCon Boxed 2)
                      [ Type intTy              , Type intTy
                      , mkIntExprInt dflags line, mkIntExprInt dflags col
                      ]
index 9eb37a9..34ef0e8 100644 (file)
 -- a Royal Pain (triggers other recompilation).
 -----------------------------------------------------------------------------
 
-module DsMeta( dsBracket,
-               templateHaskellNames, qTyConName, nameTyConName,
-               liftName, liftStringName, expQTyConName, patQTyConName,
-               decQTyConName, decsQTyConName, typeQTyConName,
-               decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName,
-               quoteExpName, quotePatName, quoteDecName, quoteTypeName,
-               tExpTyConName, tExpDataConName, unTypeName, unTypeQName,
-               unsafeTExpCoerceName
-                ) where
+module DsMeta( dsBracket ) where
 
 #include "HsVersions.h"
 
@@ -41,11 +33,12 @@ import PrelNames
 -- OccName.varName we do this by removing varName from the import of
 -- OccName above, making a qualified instance of OccName and using
 -- OccNameAlias.varName where varName ws previously used in this file.
-import qualified OccName( isDataOcc, isVarOcc, isTcOcc, varName, tcName, dataName )
+import qualified OccName( isDataOcc, isVarOcc, isTcOcc )
 
 import Module
 import Id
 import Name hiding( isVarOcc, isTcOcc, varName, tcName )
+import THNames
 import NameEnv
 import TcType
 import TyCon
@@ -2095,830 +2088,3 @@ notHandled what doc = failWithDs msg
              2 doc
 
 
--- %************************************************************************
--- %*                                                                   *
---              The known-key names for Template Haskell
--- %*                                                                   *
--- %************************************************************************
-
--- To add a name, do three things
---
---  1) Allocate a key
---  2) Make a "Name"
---  3) Add the name to knownKeyNames
-
-templateHaskellNames :: [Name]
--- The names that are implicitly mentioned by ``bracket''
--- Should stay in sync with the import list of DsMeta
-
-templateHaskellNames = [
-    returnQName, bindQName, sequenceQName, newNameName, liftName,
-    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
-    liftStringName,
-    unTypeName,
-    unTypeQName,
-    unsafeTExpCoerceName,
-
-    -- Lit
-    charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
-    floatPrimLName, doublePrimLName, rationalLName,
-    -- Pat
-    litPName, varPName, tupPName, unboxedTupPName,
-    conPName, tildePName, bangPName, infixPName,
-    asPName, wildPName, recPName, listPName, sigPName, viewPName,
-    -- FieldPat
-    fieldPatName,
-    -- Match
-    matchName,
-    -- Clause
-    clauseName,
-    -- Exp
-    varEName, conEName, litEName, appEName, infixEName,
-    infixAppName, sectionLName, sectionRName, lamEName, lamCaseEName,
-    tupEName, unboxedTupEName,
-    condEName, multiIfEName, letEName, caseEName, doEName, compEName,
-    fromEName, fromThenEName, fromToEName, fromThenToEName,
-    listEName, sigEName, recConEName, recUpdEName, staticEName,
-    -- FieldExp
-    fieldExpName,
-    -- Body
-    guardedBName, normalBName,
-    -- Guard
-    normalGEName, patGEName,
-    -- Stmt
-    bindSName, letSName, noBindSName, parSName,
-    -- Dec
-    funDName, valDName, dataDName, newtypeDName, tySynDName,
-    classDName, instanceDName, standaloneDerivDName, sigDName, forImpDName,
-    pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,
-    pragRuleDName, pragAnnDName, defaultSigDName,
-    familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName,
-    tySynInstDName, closedTypeFamilyKindDName, closedTypeFamilyNoKindDName,
-    infixLDName, infixRDName, infixNDName,
-    roleAnnotDName,
-    -- Cxt
-    cxtName,
-    -- Strict
-    isStrictName, notStrictName, unpackedName,
-    -- Con
-    normalCName, recCName, infixCName, forallCName,
-    -- StrictType
-    strictTypeName,
-    -- VarStrictType
-    varStrictTypeName,
-    -- Type
-    forallTName, varTName, conTName, appTName, equalityTName,
-    tupleTName, unboxedTupleTName, arrowTName, listTName, sigTName, litTName,
-    promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
-    -- TyLit
-    numTyLitName, strTyLitName,
-    -- TyVarBndr
-    plainTVName, kindedTVName,
-    -- Role
-    nominalRName, representationalRName, phantomRName, inferRName,
-    -- Kind
-    varKName, conKName, tupleKName, arrowKName, listKName, appKName,
-    starKName, constraintKName,
-    -- Callconv
-    cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName,
-    -- Safety
-    unsafeName,
-    safeName,
-    interruptibleName,
-    -- Inline
-    noInlineDataConName, inlineDataConName, inlinableDataConName,
-    -- RuleMatch
-    conLikeDataConName, funLikeDataConName,
-    -- Phases
-    allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName,
-    -- TExp
-    tExpDataConName,
-    -- RuleBndr
-    ruleVarName, typedRuleVarName,
-    -- FunDep
-    funDepName,
-    -- FamFlavour
-    typeFamName, dataFamName,
-    -- TySynEqn
-    tySynEqnName,
-    -- AnnTarget
-    valueAnnotationName, typeAnnotationName, moduleAnnotationName,
-
-    -- And the tycons
-    qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
-    clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
-    stmtQTyConName, decQTyConName, conQTyConName, strictTypeQTyConName,
-    varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
-    typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
-    patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
-    predQTyConName, decsQTyConName, ruleBndrQTyConName, tySynEqnQTyConName,
-    roleTyConName, tExpTyConName,
-
-    -- Quasiquoting
-    quoteDecName, quoteTypeName, quoteExpName, quotePatName]
-
-thSyn, thLib, qqLib :: Module
-thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax")
-thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
-qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
-
-mkTHModule :: FastString -> Module
-mkTHModule m = mkModule thPackageKey (mkModuleNameFS m)
-
-libFun, libTc, thFun, thTc, thCon, qqFun :: FastString -> Unique -> Name
-libFun = mk_known_key_name OccName.varName  thLib
-libTc  = mk_known_key_name OccName.tcName   thLib
-thFun  = mk_known_key_name OccName.varName  thSyn
-thTc   = mk_known_key_name OccName.tcName   thSyn
-thCon  = mk_known_key_name OccName.dataName thSyn
-qqFun  = mk_known_key_name OccName.varName  qqLib
-
--------------------- TH.Syntax -----------------------
-qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
-    fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
-    tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
-    predTyConName, tExpTyConName :: Name
-qTyConName        = thTc (fsLit "Q")            qTyConKey
-nameTyConName     = thTc (fsLit "Name")         nameTyConKey
-fieldExpTyConName = thTc (fsLit "FieldExp")     fieldExpTyConKey
-patTyConName      = thTc (fsLit "Pat")          patTyConKey
-fieldPatTyConName = thTc (fsLit "FieldPat")     fieldPatTyConKey
-expTyConName      = thTc (fsLit "Exp")          expTyConKey
-decTyConName      = thTc (fsLit "Dec")          decTyConKey
-typeTyConName     = thTc (fsLit "Type")         typeTyConKey
-tyVarBndrTyConName= thTc (fsLit "TyVarBndr")    tyVarBndrTyConKey
-matchTyConName    = thTc (fsLit "Match")        matchTyConKey
-clauseTyConName   = thTc (fsLit "Clause")       clauseTyConKey
-funDepTyConName   = thTc (fsLit "FunDep")       funDepTyConKey
-predTyConName     = thTc (fsLit "Pred")         predTyConKey
-tExpTyConName     = thTc (fsLit "TExp")         tExpTyConKey
-
-returnQName, bindQName, sequenceQName, newNameName, liftName,
-    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
-    mkNameLName, liftStringName, unTypeName, unTypeQName,
-    unsafeTExpCoerceName :: Name
-returnQName    = thFun (fsLit "returnQ")   returnQIdKey
-bindQName      = thFun (fsLit "bindQ")     bindQIdKey
-sequenceQName  = thFun (fsLit "sequenceQ") sequenceQIdKey
-newNameName    = thFun (fsLit "newName")   newNameIdKey
-liftName       = thFun (fsLit "lift")      liftIdKey
-liftStringName = thFun (fsLit "liftString")  liftStringIdKey
-mkNameName     = thFun (fsLit "mkName")     mkNameIdKey
-mkNameG_vName  = thFun (fsLit "mkNameG_v")  mkNameG_vIdKey
-mkNameG_dName  = thFun (fsLit "mkNameG_d")  mkNameG_dIdKey
-mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
-mkNameLName    = thFun (fsLit "mkNameL")    mkNameLIdKey
-unTypeName     = thFun (fsLit "unType")     unTypeIdKey
-unTypeQName    = thFun (fsLit "unTypeQ")    unTypeQIdKey
-unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey
-
-
--------------------- TH.Lib -----------------------
--- data Lit = ...
-charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
-    floatPrimLName, doublePrimLName, rationalLName :: Name
-charLName       = libFun (fsLit "charL")       charLIdKey
-stringLName     = libFun (fsLit "stringL")     stringLIdKey
-integerLName    = libFun (fsLit "integerL")    integerLIdKey
-intPrimLName    = libFun (fsLit "intPrimL")    intPrimLIdKey
-wordPrimLName   = libFun (fsLit "wordPrimL")   wordPrimLIdKey
-floatPrimLName  = libFun (fsLit "floatPrimL")  floatPrimLIdKey
-doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey
-rationalLName   = libFun (fsLit "rationalL")     rationalLIdKey
-
--- data Pat = ...
-litPName, varPName, tupPName, unboxedTupPName, conPName, infixPName, tildePName, bangPName,
-    asPName, wildPName, recPName, listPName, sigPName, viewPName :: Name
-litPName   = libFun (fsLit "litP")   litPIdKey
-varPName   = libFun (fsLit "varP")   varPIdKey
-tupPName   = libFun (fsLit "tupP")   tupPIdKey
-unboxedTupPName = libFun (fsLit "unboxedTupP") unboxedTupPIdKey
-conPName   = libFun (fsLit "conP")   conPIdKey
-infixPName = libFun (fsLit "infixP") infixPIdKey
-tildePName = libFun (fsLit "tildeP") tildePIdKey
-bangPName  = libFun (fsLit "bangP")  bangPIdKey
-asPName    = libFun (fsLit "asP")    asPIdKey
-wildPName  = libFun (fsLit "wildP")  wildPIdKey
-recPName   = libFun (fsLit "recP")   recPIdKey
-listPName  = libFun (fsLit "listP")  listPIdKey
-sigPName   = libFun (fsLit "sigP")   sigPIdKey
-viewPName  = libFun (fsLit "viewP")  viewPIdKey
-
--- type FieldPat = ...
-fieldPatName :: Name
-fieldPatName = libFun (fsLit "fieldPat") fieldPatIdKey
-
--- data Match = ...
-matchName :: Name
-matchName = libFun (fsLit "match") matchIdKey
-
--- data Clause = ...
-clauseName :: Name
-clauseName = libFun (fsLit "clause") clauseIdKey
-
--- data Exp = ...
-varEName, conEName, litEName, appEName, infixEName, infixAppName,
-    sectionLName, sectionRName, lamEName, lamCaseEName, tupEName,
-    unboxedTupEName, condEName, multiIfEName, letEName, caseEName,
-    doEName, compEName, staticEName :: Name
-varEName        = libFun (fsLit "varE")        varEIdKey
-conEName        = libFun (fsLit "conE")        conEIdKey
-litEName        = libFun (fsLit "litE")        litEIdKey
-appEName        = libFun (fsLit "appE")        appEIdKey
-infixEName      = libFun (fsLit "infixE")      infixEIdKey
-infixAppName    = libFun (fsLit "infixApp")    infixAppIdKey
-sectionLName    = libFun (fsLit "sectionL")    sectionLIdKey
-sectionRName    = libFun (fsLit "sectionR")    sectionRIdKey
-lamEName        = libFun (fsLit "lamE")        lamEIdKey
-lamCaseEName    = libFun (fsLit "lamCaseE")    lamCaseEIdKey
-tupEName        = libFun (fsLit "tupE")        tupEIdKey
-unboxedTupEName = libFun (fsLit "unboxedTupE") unboxedTupEIdKey
-condEName       = libFun (fsLit "condE")       condEIdKey
-multiIfEName    = libFun (fsLit "multiIfE")    multiIfEIdKey
-letEName        = libFun (fsLit "letE")        letEIdKey
-caseEName       = libFun (fsLit "caseE")       caseEIdKey
-doEName         = libFun (fsLit "doE")         doEIdKey
-compEName       = libFun (fsLit "compE")       compEIdKey
--- ArithSeq skips a level
-fromEName, fromThenEName, fromToEName, fromThenToEName :: Name
-fromEName       = libFun (fsLit "fromE")       fromEIdKey
-fromThenEName   = libFun (fsLit "fromThenE")   fromThenEIdKey
-fromToEName     = libFun (fsLit "fromToE")     fromToEIdKey
-fromThenToEName = libFun (fsLit "fromThenToE") fromThenToEIdKey
--- end ArithSeq
-listEName, sigEName, recConEName, recUpdEName :: Name
-listEName       = libFun (fsLit "listE")       listEIdKey
-sigEName        = libFun (fsLit "sigE")        sigEIdKey
-recConEName     = libFun (fsLit "recConE")     recConEIdKey
-recUpdEName     = libFun (fsLit "recUpdE")     recUpdEIdKey
-staticEName     = libFun (fsLit "staticE")     staticEIdKey
-
--- type FieldExp = ...
-fieldExpName :: Name
-fieldExpName = libFun (fsLit "fieldExp") fieldExpIdKey
-
--- data Body = ...
-guardedBName, normalBName :: Name
-guardedBName = libFun (fsLit "guardedB") guardedBIdKey
-normalBName  = libFun (fsLit "normalB")  normalBIdKey
-
--- data Guard = ...
-normalGEName, patGEName :: Name
-normalGEName = libFun (fsLit "normalGE") normalGEIdKey
-patGEName    = libFun (fsLit "patGE")    patGEIdKey
-
--- data Stmt = ...
-bindSName, letSName, noBindSName, parSName :: Name
-bindSName   = libFun (fsLit "bindS")   bindSIdKey
-letSName    = libFun (fsLit "letS")    letSIdKey
-noBindSName = libFun (fsLit "noBindS") noBindSIdKey
-parSName    = libFun (fsLit "parS")    parSIdKey
-
--- data Dec = ...
-funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
-    instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
-    pragSpecInlDName, pragSpecInstDName, pragRuleDName, pragAnnDName,
-    familyNoKindDName, standaloneDerivDName, defaultSigDName,
-    familyKindDName, dataInstDName, newtypeInstDName, tySynInstDName,
-    closedTypeFamilyKindDName, closedTypeFamilyNoKindDName,
-    infixLDName, infixRDName, infixNDName, roleAnnotDName :: Name
-funDName          = libFun (fsLit "funD")          funDIdKey
-valDName          = libFun (fsLit "valD")          valDIdKey
-dataDName         = libFun (fsLit "dataD")         dataDIdKey
-newtypeDName      = libFun (fsLit "newtypeD")      newtypeDIdKey
-tySynDName        = libFun (fsLit "tySynD")        tySynDIdKey
-classDName        = libFun (fsLit "classD")        classDIdKey
-instanceDName     = libFun (fsLit "instanceD")     instanceDIdKey
-standaloneDerivDName
-                  = libFun (fsLit "standaloneDerivD") standaloneDerivDIdKey
-sigDName          = libFun (fsLit "sigD")          sigDIdKey
-defaultSigDName   = libFun (fsLit "defaultSigD")   defaultSigDIdKey
-forImpDName       = libFun (fsLit "forImpD")       forImpDIdKey
-pragInlDName      = libFun (fsLit "pragInlD")      pragInlDIdKey
-pragSpecDName     = libFun (fsLit "pragSpecD")     pragSpecDIdKey
-pragSpecInlDName  = libFun (fsLit "pragSpecInlD")  pragSpecInlDIdKey
-pragSpecInstDName = libFun (fsLit "pragSpecInstD") pragSpecInstDIdKey
-pragRuleDName     = libFun (fsLit "pragRuleD")     pragRuleDIdKey
-pragAnnDName      = libFun (fsLit "pragAnnD")      pragAnnDIdKey
-familyNoKindDName = libFun (fsLit "familyNoKindD") familyNoKindDIdKey
-familyKindDName   = libFun (fsLit "familyKindD")   familyKindDIdKey
-dataInstDName     = libFun (fsLit "dataInstD")     dataInstDIdKey
-newtypeInstDName  = libFun (fsLit "newtypeInstD")  newtypeInstDIdKey
-tySynInstDName    = libFun (fsLit "tySynInstD")    tySynInstDIdKey
-closedTypeFamilyKindDName
-                  = libFun (fsLit "closedTypeFamilyKindD") closedTypeFamilyKindDIdKey
-closedTypeFamilyNoKindDName
-                  = libFun (fsLit "closedTypeFamilyNoKindD") closedTypeFamilyNoKindDIdKey
-infixLDName       = libFun (fsLit "infixLD")       infixLDIdKey
-infixRDName       = libFun (fsLit "infixRD")       infixRDIdKey
-infixNDName       = libFun (fsLit "infixND")       infixNDIdKey
-roleAnnotDName    = libFun (fsLit "roleAnnotD")    roleAnnotDIdKey
-
--- type Ctxt = ...
-cxtName :: Name
-cxtName = libFun (fsLit "cxt") cxtIdKey
-
--- data Strict = ...
-isStrictName, notStrictName, unpackedName :: Name
-isStrictName      = libFun  (fsLit "isStrict")      isStrictKey
-notStrictName     = libFun  (fsLit "notStrict")     notStrictKey
-unpackedName      = libFun  (fsLit "unpacked")      unpackedKey
-
--- data Con = ...
-normalCName, recCName, infixCName, forallCName :: Name
-normalCName = libFun (fsLit "normalC") normalCIdKey
-recCName    = libFun (fsLit "recC")    recCIdKey
-infixCName  = libFun (fsLit "infixC")  infixCIdKey
-forallCName  = libFun (fsLit "forallC")  forallCIdKey
-
--- type StrictType = ...
-strictTypeName :: Name
-strictTypeName    = libFun  (fsLit "strictType")    strictTKey
-
--- type VarStrictType = ...
-varStrictTypeName :: Name
-varStrictTypeName = libFun  (fsLit "varStrictType") varStrictTKey
-
--- data Type = ...
-forallTName, varTName, conTName, tupleTName, unboxedTupleTName, arrowTName,
-    listTName, appTName, sigTName, equalityTName, litTName,
-    promotedTName, promotedTupleTName,
-    promotedNilTName, promotedConsTName :: Name
-forallTName         = libFun (fsLit "forallT")        forallTIdKey
-varTName            = libFun (fsLit "varT")           varTIdKey
-conTName            = libFun (fsLit "conT")           conTIdKey
-tupleTName          = libFun (fsLit "tupleT")         tupleTIdKey
-unboxedTupleTName   = libFun (fsLit "unboxedTupleT")  unboxedTupleTIdKey
-arrowTName          = libFun (fsLit "arrowT")         arrowTIdKey
-listTName           = libFun (fsLit "listT")          listTIdKey
-appTName            = libFun (fsLit "appT")           appTIdKey
-sigTName            = libFun (fsLit "sigT")           sigTIdKey
-equalityTName       = libFun (fsLit "equalityT")      equalityTIdKey
-litTName            = libFun (fsLit "litT")           litTIdKey
-promotedTName       = libFun (fsLit "promotedT")      promotedTIdKey
-promotedTupleTName  = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
-promotedNilTName    = libFun (fsLit "promotedNilT")   promotedNilTIdKey
-promotedConsTName   = libFun (fsLit "promotedConsT")  promotedConsTIdKey
-
--- data TyLit = ...
-numTyLitName, strTyLitName :: Name
-numTyLitName = libFun (fsLit "numTyLit") numTyLitIdKey
-strTyLitName = libFun (fsLit "strTyLit") strTyLitIdKey
-
--- data TyVarBndr = ...
-plainTVName, kindedTVName :: Name
-plainTVName       = libFun (fsLit "plainTV")       plainTVIdKey
-kindedTVName      = libFun (fsLit "kindedTV")      kindedTVIdKey
-
--- data Role = ...
-nominalRName, representationalRName, phantomRName, inferRName :: Name
-nominalRName          = libFun (fsLit "nominalR")          nominalRIdKey
-representationalRName = libFun (fsLit "representationalR") representationalRIdKey
-phantomRName          = libFun (fsLit "phantomR")          phantomRIdKey
-inferRName            = libFun (fsLit "inferR")            inferRIdKey
-
--- data Kind = ...
-varKName, conKName, tupleKName, arrowKName, listKName, appKName,
-  starKName, constraintKName :: Name
-varKName        = libFun (fsLit "varK")         varKIdKey
-conKName        = libFun (fsLit "conK")         conKIdKey
-tupleKName      = libFun (fsLit "tupleK")       tupleKIdKey
-arrowKName      = libFun (fsLit "arrowK")       arrowKIdKey
-listKName       = libFun (fsLit "listK")        listKIdKey
-appKName        = libFun (fsLit "appK")         appKIdKey
-starKName       = libFun (fsLit "starK")        starKIdKey
-constraintKName = libFun (fsLit "constraintK")  constraintKIdKey
-
--- data Callconv = ...
-cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName :: Name
-cCallName = libFun (fsLit "cCall") cCallIdKey
-stdCallName = libFun (fsLit "stdCall") stdCallIdKey
-cApiCallName = libFun (fsLit "cApi") cApiCallIdKey
-primCallName = libFun (fsLit "prim") primCallIdKey
-javaScriptCallName = libFun (fsLit "javaScript") javaScriptCallIdKey
-
--- data Safety = ...
-unsafeName, safeName, interruptibleName :: Name
-unsafeName     = libFun (fsLit "unsafe") unsafeIdKey
-safeName       = libFun (fsLit "safe") safeIdKey
-interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
-
--- data Inline = ...
-noInlineDataConName, inlineDataConName, inlinableDataConName :: Name
-noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
-inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
-inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
-
--- data RuleMatch = ...
-conLikeDataConName, funLikeDataConName :: Name
-conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
-funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
-
--- data Phases = ...
-allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name
-allPhasesDataConName   = thCon (fsLit "AllPhases")   allPhasesDataConKey
-fromPhaseDataConName   = thCon (fsLit "FromPhase")   fromPhaseDataConKey
-beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
-
--- newtype TExp a = ...
-tExpDataConName :: Name
-tExpDataConName = thCon (fsLit "TExp") tExpDataConKey
-
--- data RuleBndr = ...
-ruleVarName, typedRuleVarName :: Name
-ruleVarName      = libFun (fsLit ("ruleVar"))      ruleVarIdKey
-typedRuleVarName = libFun (fsLit ("typedRuleVar")) typedRuleVarIdKey
-
--- data FunDep = ...
-funDepName :: Name
-funDepName     = libFun (fsLit "funDep") funDepIdKey
-
--- data FamFlavour = ...
-typeFamName, dataFamName :: Name
-typeFamName = libFun (fsLit "typeFam") typeFamIdKey
-dataFamName = libFun (fsLit "dataFam") dataFamIdKey
-
--- data TySynEqn = ...
-tySynEqnName :: Name
-tySynEqnName = libFun (fsLit "tySynEqn") tySynEqnIdKey
-
--- data AnnTarget = ...
-valueAnnotationName, typeAnnotationName, moduleAnnotationName :: Name
-valueAnnotationName  = libFun (fsLit "valueAnnotation")  valueAnnotationIdKey
-typeAnnotationName   = libFun (fsLit "typeAnnotation")   typeAnnotationIdKey
-moduleAnnotationName = libFun (fsLit "moduleAnnotation") moduleAnnotationIdKey
-
-matchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,
-    decQTyConName, conQTyConName, strictTypeQTyConName,
-    varStrictTypeQTyConName, typeQTyConName, fieldExpQTyConName,
-    patQTyConName, fieldPatQTyConName, predQTyConName, decsQTyConName,
-    ruleBndrQTyConName, tySynEqnQTyConName, roleTyConName :: Name
-matchQTyConName         = libTc (fsLit "MatchQ")         matchQTyConKey
-clauseQTyConName        = libTc (fsLit "ClauseQ")        clauseQTyConKey
-expQTyConName           = libTc (fsLit "ExpQ")           expQTyConKey
-stmtQTyConName          = libTc (fsLit "StmtQ")          stmtQTyConKey
-decQTyConName           = libTc (fsLit "DecQ")           decQTyConKey
-decsQTyConName          = libTc (fsLit "DecsQ")          decsQTyConKey  -- Q [Dec]
-conQTyConName           = libTc (fsLit "ConQ")           conQTyConKey
-strictTypeQTyConName    = libTc (fsLit "StrictTypeQ")    strictTypeQTyConKey
-varStrictTypeQTyConName = libTc (fsLit "VarStrictTypeQ") varStrictTypeQTyConKey
-typeQTyConName          = libTc (fsLit "TypeQ")          typeQTyConKey
-fieldExpQTyConName      = libTc (fsLit "FieldExpQ")      fieldExpQTyConKey
-patQTyConName           = libTc (fsLit "PatQ")           patQTyConKey
-fieldPatQTyConName      = libTc (fsLit "FieldPatQ")      fieldPatQTyConKey
-predQTyConName          = libTc (fsLit "PredQ")          predQTyConKey
-ruleBndrQTyConName      = libTc (fsLit "RuleBndrQ")      ruleBndrQTyConKey
-tySynEqnQTyConName      = libTc (fsLit "TySynEqnQ")      tySynEqnQTyConKey
-roleTyConName           = libTc (fsLit "Role")           roleTyConKey
-
--- quasiquoting
-quoteExpName, quotePatName, quoteDecName, quoteTypeName :: Name
-quoteExpName        = qqFun (fsLit "quoteExp")  quoteExpKey
-quotePatName        = qqFun (fsLit "quotePat")  quotePatKey
-quoteDecName        = qqFun (fsLit "quoteDec")  quoteDecKey
-quoteTypeName       = qqFun (fsLit "quoteType") quoteTypeKey
-
--- TyConUniques available: 200-299
--- Check in PrelNames if you want to change this
-
-expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
-    decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,
-    stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey, tyVarBndrTyConKey,
-    decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
-    fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
-    fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
-    predQTyConKey, decsQTyConKey, ruleBndrQTyConKey, tySynEqnQTyConKey,
-    roleTyConKey, tExpTyConKey :: Unique
-expTyConKey             = mkPreludeTyConUnique 200
-matchTyConKey           = mkPreludeTyConUnique 201
-clauseTyConKey          = mkPreludeTyConUnique 202
-qTyConKey               = mkPreludeTyConUnique 203
-expQTyConKey            = mkPreludeTyConUnique 204
-decQTyConKey            = mkPreludeTyConUnique 205
-patTyConKey             = mkPreludeTyConUnique 206
-matchQTyConKey          = mkPreludeTyConUnique 207
-clauseQTyConKey         = mkPreludeTyConUnique 208
-stmtQTyConKey           = mkPreludeTyConUnique 209
-conQTyConKey            = mkPreludeTyConUnique 210
-typeQTyConKey           = mkPreludeTyConUnique 211
-typeTyConKey            = mkPreludeTyConUnique 212
-decTyConKey             = mkPreludeTyConUnique 213
-varStrictTypeQTyConKey  = mkPreludeTyConUnique 214
-strictTypeQTyConKey     = mkPreludeTyConUnique 215
-fieldExpTyConKey        = mkPreludeTyConUnique 216
-fieldPatTyConKey        = mkPreludeTyConUnique 217
-nameTyConKey            = mkPreludeTyConUnique 218
-patQTyConKey            = mkPreludeTyConUnique 219
-fieldPatQTyConKey       = mkPreludeTyConUnique 220
-fieldExpQTyConKey       = mkPreludeTyConUnique 221
-funDepTyConKey          = mkPreludeTyConUnique 222
-predTyConKey            = mkPreludeTyConUnique 223
-predQTyConKey           = mkPreludeTyConUnique 224
-tyVarBndrTyConKey       = mkPreludeTyConUnique 225
-decsQTyConKey           = mkPreludeTyConUnique 226
-ruleBndrQTyConKey       = mkPreludeTyConUnique 227
-tySynEqnQTyConKey       = mkPreludeTyConUnique 228
-roleTyConKey            = mkPreludeTyConUnique 229
-tExpTyConKey            = mkPreludeTyConUnique 230
-
--- IdUniques available: 200-499
--- If you want to change this, make sure you check in PrelNames
-
-returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
-    mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
-    mkNameLIdKey, unTypeIdKey, unTypeQIdKey, unsafeTExpCoerceIdKey :: Unique
-returnQIdKey        = mkPreludeMiscIdUnique 200
-bindQIdKey          = mkPreludeMiscIdUnique 201
-sequenceQIdKey      = mkPreludeMiscIdUnique 202
-liftIdKey           = mkPreludeMiscIdUnique 203
-newNameIdKey         = mkPreludeMiscIdUnique 204
-mkNameIdKey          = mkPreludeMiscIdUnique 205
-mkNameG_vIdKey       = mkPreludeMiscIdUnique 206
-mkNameG_dIdKey       = mkPreludeMiscIdUnique 207
-mkNameG_tcIdKey      = mkPreludeMiscIdUnique 208
-mkNameLIdKey         = mkPreludeMiscIdUnique 209
-unTypeIdKey          = mkPreludeMiscIdUnique 210
-unTypeQIdKey         = mkPreludeMiscIdUnique 211
-unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 212
-
-
--- data Lit = ...
-charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey,
-    floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey :: Unique
-charLIdKey        = mkPreludeMiscIdUnique 220
-stringLIdKey      = mkPreludeMiscIdUnique 221
-integerLIdKey     = mkPreludeMiscIdUnique 222
-intPrimLIdKey     = mkPreludeMiscIdUnique 223
-wordPrimLIdKey    = mkPreludeMiscIdUnique 224
-floatPrimLIdKey   = mkPreludeMiscIdUnique 225
-doublePrimLIdKey  = mkPreludeMiscIdUnique 226
-rationalLIdKey    = mkPreludeMiscIdUnique 227
-
-liftStringIdKey :: Unique
-liftStringIdKey     = mkPreludeMiscIdUnique 228
-
--- data Pat = ...
-litPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, bangPIdKey,
-    asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey, viewPIdKey :: Unique
-litPIdKey         = mkPreludeMiscIdUnique 240
-varPIdKey         = mkPreludeMiscIdUnique 241
-tupPIdKey         = mkPreludeMiscIdUnique 242
-unboxedTupPIdKey  = mkPreludeMiscIdUnique 243
-conPIdKey         = mkPreludeMiscIdUnique 244
-infixPIdKey       = mkPreludeMiscIdUnique 245
-tildePIdKey       = mkPreludeMiscIdUnique 246
-bangPIdKey        = mkPreludeMiscIdUnique 247
-asPIdKey          = mkPreludeMiscIdUnique 248
-wildPIdKey        = mkPreludeMiscIdUnique 249
-recPIdKey         = mkPreludeMiscIdUnique 250
-listPIdKey        = mkPreludeMiscIdUnique 251
-sigPIdKey         = mkPreludeMiscIdUnique 252
-viewPIdKey        = mkPreludeMiscIdUnique 253
-
--- type FieldPat = ...
-fieldPatIdKey :: Unique
-fieldPatIdKey       = mkPreludeMiscIdUnique 260
-
--- data Match = ...
-matchIdKey :: Unique
-matchIdKey          = mkPreludeMiscIdUnique 261
-
--- data Clause = ...
-clauseIdKey :: Unique
-clauseIdKey         = mkPreludeMiscIdUnique 262
-
-
--- data Exp = ...
-varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
-    sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey, tupEIdKey,
-    unboxedTupEIdKey, condEIdKey, multiIfEIdKey,
-    letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
-    fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
-    listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey :: Unique
-varEIdKey         = mkPreludeMiscIdUnique 270
-conEIdKey         = mkPreludeMiscIdUnique 271
-litEIdKey         = mkPreludeMiscIdUnique 272
-appEIdKey         = mkPreludeMiscIdUnique 273
-infixEIdKey       = mkPreludeMiscIdUnique 274
-infixAppIdKey     = mkPreludeMiscIdUnique 275
-sectionLIdKey     = mkPreludeMiscIdUnique 276
-sectionRIdKey     = mkPreludeMiscIdUnique 277
-lamEIdKey         = mkPreludeMiscIdUnique 278
-lamCaseEIdKey     = mkPreludeMiscIdUnique 279
-tupEIdKey         = mkPreludeMiscIdUnique 280
-unboxedTupEIdKey  = mkPreludeMiscIdUnique 281
-condEIdKey        = mkPreludeMiscIdUnique 282
-multiIfEIdKey     = mkPreludeMiscIdUnique 283
-letEIdKey         = mkPreludeMiscIdUnique 284
-caseEIdKey        = mkPreludeMiscIdUnique 285
-doEIdKey          = mkPreludeMiscIdUnique 286
-compEIdKey        = mkPreludeMiscIdUnique 287
-fromEIdKey        = mkPreludeMiscIdUnique 288
-fromThenEIdKey    = mkPreludeMiscIdUnique 289
-fromToEIdKey      = mkPreludeMiscIdUnique 290
-fromThenToEIdKey  = mkPreludeMiscIdUnique 291
-listEIdKey        = mkPreludeMiscIdUnique 292
-sigEIdKey         = mkPreludeMiscIdUnique 293
-recConEIdKey      = mkPreludeMiscIdUnique 294
-recUpdEIdKey      = mkPreludeMiscIdUnique 295
-staticEIdKey      = mkPreludeMiscIdUnique 296
-
--- type FieldExp = ...
-fieldExpIdKey :: Unique
-fieldExpIdKey       = mkPreludeMiscIdUnique 310
-
--- data Body = ...
-guardedBIdKey, normalBIdKey :: Unique
-guardedBIdKey     = mkPreludeMiscIdUnique 311
-normalBIdKey      = mkPreludeMiscIdUnique 312
-
--- data Guard = ...
-normalGEIdKey, patGEIdKey :: Unique
-normalGEIdKey     = mkPreludeMiscIdUnique 313
-patGEIdKey        = mkPreludeMiscIdUnique 314
-
--- data Stmt = ...
-bindSIdKey, letSIdKey, noBindSIdKey, parSIdKey :: Unique
-bindSIdKey       = mkPreludeMiscIdUnique 320
-letSIdKey        = mkPreludeMiscIdUnique 321
-noBindSIdKey     = mkPreludeMiscIdUnique 322
-parSIdKey        = mkPreludeMiscIdUnique 323
-
--- data Dec = ...
-funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
-    classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,
-    pragSpecDIdKey, pragSpecInlDIdKey, pragSpecInstDIdKey, pragRuleDIdKey,
-    pragAnnDIdKey, familyNoKindDIdKey, familyKindDIdKey, defaultSigDIdKey,
-    dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivDIdKey,
-    closedTypeFamilyKindDIdKey, closedTypeFamilyNoKindDIdKey,
-    infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey :: Unique
-funDIdKey                    = mkPreludeMiscIdUnique 330
-valDIdKey                    = mkPreludeMiscIdUnique 331
-dataDIdKey                   = mkPreludeMiscIdUnique 332
-newtypeDIdKey                = mkPreludeMiscIdUnique 333
-tySynDIdKey                  = mkPreludeMiscIdUnique 334
-classDIdKey                  = mkPreludeMiscIdUnique 335
-instanceDIdKey               = mkPreludeMiscIdUnique 336
-sigDIdKey                    = mkPreludeMiscIdUnique 337
-forImpDIdKey                 = mkPreludeMiscIdUnique 338
-pragInlDIdKey                = mkPreludeMiscIdUnique 339
-pragSpecDIdKey               = mkPreludeMiscIdUnique 340
-pragSpecInlDIdKey            = mkPreludeMiscIdUnique 341
-pragSpecInstDIdKey           = mkPreludeMiscIdUnique 342
-pragRuleDIdKey               = mkPreludeMiscIdUnique 343
-pragAnnDIdKey                = mkPreludeMiscIdUnique 344
-familyNoKindDIdKey           = mkPreludeMiscIdUnique 345
-familyKindDIdKey             = mkPreludeMiscIdUnique 346
-dataInstDIdKey               = mkPreludeMiscIdUnique 347
-newtypeInstDIdKey            = mkPreludeMiscIdUnique 348
-tySynInstDIdKey              = mkPreludeMiscIdUnique 349
-closedTypeFamilyKindDIdKey   = mkPreludeMiscIdUnique 350
-closedTypeFamilyNoKindDIdKey = mkPreludeMiscIdUnique 351
-infixLDIdKey                 = mkPreludeMiscIdUnique 352
-infixRDIdKey                 = mkPreludeMiscIdUnique 353
-infixNDIdKey                 = mkPreludeMiscIdUnique 354
-roleAnnotDIdKey              = mkPreludeMiscIdUnique 355
-standaloneDerivDIdKey        = mkPreludeMiscIdUnique 356
-defaultSigDIdKey             = mkPreludeMiscIdUnique 357
-
--- type Cxt = ...
-cxtIdKey :: Unique
-cxtIdKey            = mkPreludeMiscIdUnique 360
-
--- data Strict = ...
-isStrictKey, notStrictKey, unpackedKey :: Unique
-isStrictKey         = mkPreludeMiscIdUnique 363
-notStrictKey        = mkPreludeMiscIdUnique 364
-unpackedKey         = mkPreludeMiscIdUnique 365
-
--- data Con = ...
-normalCIdKey, recCIdKey, infixCIdKey, forallCIdKey :: Unique
-normalCIdKey      = mkPreludeMiscIdUnique 370
-recCIdKey         = mkPreludeMiscIdUnique 371
-infixCIdKey       = mkPreludeMiscIdUnique 372
-forallCIdKey      = mkPreludeMiscIdUnique 373
-
--- type StrictType = ...
-strictTKey :: Unique
-strictTKey        = mkPreludeMiscIdUnique 374
-
--- type VarStrictType = ...
-varStrictTKey :: Unique
-varStrictTKey     = mkPreludeMiscIdUnique 375
-
--- data Type = ...
-forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey, arrowTIdKey,
-    listTIdKey, appTIdKey, sigTIdKey, equalityTIdKey, litTIdKey,
-    promotedTIdKey, promotedTupleTIdKey,
-    promotedNilTIdKey, promotedConsTIdKey :: Unique
-forallTIdKey        = mkPreludeMiscIdUnique 380
-varTIdKey           = mkPreludeMiscIdUnique 381
-conTIdKey           = mkPreludeMiscIdUnique 382
-tupleTIdKey         = mkPreludeMiscIdUnique 383
-unboxedTupleTIdKey  = mkPreludeMiscIdUnique 384
-arrowTIdKey         = mkPreludeMiscIdUnique 385
-listTIdKey          = mkPreludeMiscIdUnique 386
-appTIdKey           = mkPreludeMiscIdUnique 387
-sigTIdKey           = mkPreludeMiscIdUnique 388
-equalityTIdKey      = mkPreludeMiscIdUnique 389
-litTIdKey           = mkPreludeMiscIdUnique 390
-promotedTIdKey      = mkPreludeMiscIdUnique 391
-promotedTupleTIdKey = mkPreludeMiscIdUnique 392
-promotedNilTIdKey   = mkPreludeMiscIdUnique 393
-promotedConsTIdKey  = mkPreludeMiscIdUnique 394
-
--- data TyLit = ...
-numTyLitIdKey, strTyLitIdKey :: Unique
-numTyLitIdKey = mkPreludeMiscIdUnique 395
-strTyLitIdKey = mkPreludeMiscIdUnique 396
-
--- data TyVarBndr = ...
-plainTVIdKey, kindedTVIdKey :: Unique
-plainTVIdKey       = mkPreludeMiscIdUnique 397
-kindedTVIdKey      = mkPreludeMiscIdUnique 398
-
--- data Role = ...
-nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
-nominalRIdKey          = mkPreludeMiscIdUnique 400
-representationalRIdKey = mkPreludeMiscIdUnique 401
-phantomRIdKey          = mkPreludeMiscIdUnique 402
-inferRIdKey            = mkPreludeMiscIdUnique 403
-
--- data Kind = ...
-varKIdKey, conKIdKey, tupleKIdKey, arrowKIdKey, listKIdKey, appKIdKey,
-  starKIdKey, constraintKIdKey :: Unique
-varKIdKey         = mkPreludeMiscIdUnique 404
-conKIdKey         = mkPreludeMiscIdUnique 405
-tupleKIdKey       = mkPreludeMiscIdUnique 406
-arrowKIdKey       = mkPreludeMiscIdUnique 407
-listKIdKey        = mkPreludeMiscIdUnique 408
-appKIdKey         = mkPreludeMiscIdUnique 409
-starKIdKey        = mkPreludeMiscIdUnique 410
-constraintKIdKey  = mkPreludeMiscIdUnique 411
-
--- data Callconv = ...
-cCallIdKey, stdCallIdKey, cApiCallIdKey, primCallIdKey,
-  javaScriptCallIdKey :: Unique
-cCallIdKey          = mkPreludeMiscIdUnique 420
-stdCallIdKey        = mkPreludeMiscIdUnique 421
-cApiCallIdKey       = mkPreludeMiscIdUnique 422
-primCallIdKey       = mkPreludeMiscIdUnique 423
-javaScriptCallIdKey = mkPreludeMiscIdUnique 424
-
--- data Safety = ...
-unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique
-unsafeIdKey        = mkPreludeMiscIdUnique 430
-safeIdKey          = mkPreludeMiscIdUnique 431
-interruptibleIdKey = mkPreludeMiscIdUnique 432
-
--- data Inline = ...
-noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
-noInlineDataConKey  = mkPreludeDataConUnique 40
-inlineDataConKey    = mkPreludeDataConUnique 41
-inlinableDataConKey = mkPreludeDataConUnique 42
-
--- data RuleMatch = ...
-conLikeDataConKey, funLikeDataConKey :: Unique
-conLikeDataConKey = mkPreludeDataConUnique 43
-funLikeDataConKey = mkPreludeDataConUnique 44
-
--- data Phases = ...
-allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
-allPhasesDataConKey   = mkPreludeDataConUnique 45
-fromPhaseDataConKey   = mkPreludeDataConUnique 46
-beforePhaseDataConKey = mkPreludeDataConUnique 47
-
--- newtype TExp a = ...
-tExpDataConKey :: Unique
-tExpDataConKey = mkPreludeDataConUnique 48
-
--- data FunDep = ...
-funDepIdKey :: Unique
-funDepIdKey = mkPreludeMiscIdUnique 440
-
--- data FamFlavour = ...
-typeFamIdKey, dataFamIdKey :: Unique
-typeFamIdKey = mkPreludeMiscIdUnique 450
-dataFamIdKey = mkPreludeMiscIdUnique 451
-
--- data TySynEqn = ...
-tySynEqnIdKey :: Unique
-tySynEqnIdKey = mkPreludeMiscIdUnique 460
-
--- quasiquoting
-quoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique
-quoteExpKey  = mkPreludeMiscIdUnique 470
-quotePatKey  = mkPreludeMiscIdUnique 471
-quoteDecKey  = mkPreludeMiscIdUnique 472
-quoteTypeKey = mkPreludeMiscIdUnique 473
-
--- data RuleBndr = ...
-ruleVarIdKey, typedRuleVarIdKey :: Unique
-ruleVarIdKey      = mkPreludeMiscIdUnique 480
-typedRuleVarIdKey = mkPreludeMiscIdUnique 481
-
--- data AnnTarget = ...
-valueAnnotationIdKey, typeAnnotationIdKey, moduleAnnotationIdKey :: Unique
-valueAnnotationIdKey  = mkPreludeMiscIdUnique 490
-typeAnnotationIdKey   = mkPreludeMiscIdUnique 491
-moduleAnnotationIdKey = mkPreludeMiscIdUnique 492
index c8e30f1..5840578 100644 (file)
@@ -43,7 +43,7 @@ import Maybes
 import Util
 import Name
 import Outputable
-import BasicTypes ( boxityNormalTupleSort, isGenerated )
+import BasicTypes ( isGenerated )
 import FastString
 
 import Control.Monad( when )
@@ -568,7 +568,7 @@ tidy1 _ (TuplePat pats boxity tys)
   = return (idDsWrapper, unLoc tuple_ConPat)
   where
     arity = length pats
-    tuple_ConPat = mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity) pats tys
+    tuple_ConPat = mkPrefixConPat (tupleDataCon boxity arity) pats tys
 
 -- LitPats: we *might* be able to replace these w/ a simpler form
 tidy1 _ (LitPat lit)
index 09c252b..4934d18 100644 (file)
@@ -164,7 +164,6 @@ Library
         IdInfo
         Lexeme
         Literal
-        DsMeta
         Llvm
         Llvm.AbsSyn
         Llvm.MetaData
@@ -422,6 +421,8 @@ Library
         TcSplice
         Class
         Coercion
+        DsMeta
+        THNames
         FamInstEnv
         FunDeps
         InstEnv
index 56efbb8..b95d053 100644 (file)
@@ -48,7 +48,7 @@ import Name
 import VarEnv
 import Util
 import VarSet
-import BasicTypes       ( TupleSort(UnboxedTuple) )
+import BasicTypes       ( Boxity(..) )
 import TysPrim
 import PrelNames
 import TysWiredIn
@@ -832,8 +832,9 @@ extractSubTerms recurse clos = liftM thirdOf3 . go 0 (nonPtrs clos)
         let (ws0, ws1) = splitAt (primRepSizeW dflags rep) ws
         return (ptr_i, ws1, Prim ty ws0)
 
-    unboxedTupleTerm ty terms = Term ty (Right (tupleCon UnboxedTuple (length terms)))
-                                        (error "unboxedTupleTerm: no HValue for unboxed tuple") terms
+    unboxedTupleTerm ty terms
+      = Term ty (Right (tupleDataCon Unboxed (length terms)))
+                (error "unboxedTupleTerm: no HValue for unboxed tuple") terms
 
 
 -- Fast, breadth-first Type reconstruction
index 031a340..20cb234 100644 (file)
@@ -993,14 +993,14 @@ cvtTypeKind ty_str ty
              | n == 1
              -> failWith (ptext (sLit ("Illegal 1-tuple " ++ ty_str ++ " constructor")))
              | otherwise
-             -> mk_apps (HsTyVar (getRdrName (tupleTyCon BoxedTuple n))) tys'
+             -> mk_apps (HsTyVar (getRdrName (tupleTyCon Boxed n))) tys'
            UnboxedTupleT n
              | length tys' == n         -- Saturated
              -> if n==1 then return (head tys') -- Singleton tuples treated
                                                 -- like nothing (ie just parens)
                         else returnL (HsTupleTy HsUnboxedTuple tys')
              | otherwise
-             -> mk_apps (HsTyVar (getRdrName (tupleTyCon UnboxedTuple n))) tys'
+             -> mk_apps (HsTyVar (getRdrName (tupleTyCon Unboxed n))) tys'
            ArrowT
              | [x',y'] <- tys' -> returnL (HsFunTy x' y')
              | otherwise       -> mk_apps (HsTyVar (getRdrName funTyCon)) tys'
index efefd17..e9171a4 100644 (file)
@@ -636,8 +636,7 @@ ppr_expr (SectionR op expr)
     pp_infixly v = sep [pprInfixOcc v, pp_expr]
 
 ppr_expr (ExplicitTuple exprs boxity)
-  = tupleParens (boxityNormalTupleSort boxity)
-                (fcat (ppr_tup_args $ map unLoc exprs))
+  = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))
   where
     ppr_tup_args []               = []
     ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
index 6cde908..5d74edf 100644 (file)
@@ -302,17 +302,24 @@ pprParendPat p | hsPatNeedsParens p = parens (pprPat p)
                | otherwise          = pprPat p
 
 pprPat :: (OutputableBndr name) => Pat name -> SDoc
-pprPat (VarPat var)       = pprPatBndr var
-pprPat (WildPat _)        = char '_'
-pprPat (LazyPat pat)      = char '~' <> pprParendLPat pat
-pprPat (BangPat pat)      = char '!' <> pprParendLPat pat
-pprPat (AsPat name pat)   = hcat [pprPrefixOcc (unLoc name), char '@', pprParendLPat pat]
-pprPat (ViewPat expr pat _) = hcat [pprLExpr expr, text " -> ", ppr pat]
-pprPat (ParPat pat)         = parens (ppr pat)
+pprPat (VarPat var)           = pprPatBndr var
+pprPat (WildPat _)            = char '_'
+pprPat (LazyPat pat)          = char '~' <> pprParendLPat pat
+pprPat (BangPat pat)          = char '!' <> pprParendLPat pat
+pprPat (AsPat name pat)       = hcat [pprPrefixOcc (unLoc name), char '@', pprParendLPat pat]
+pprPat (ViewPat expr pat _)   = hcat [pprLExpr expr, text " -> ", ppr pat]
+pprPat (ParPat pat)           = parens (ppr pat)
+pprPat (LitPat s)             = ppr s
+pprPat (NPat l Nothing  _)    = ppr l
+pprPat (NPat l (Just _) _)    = char '-' <> ppr l
+pprPat (NPlusKPat n k _ _)    = hcat [ppr n, char '+', ppr k]
+pprPat (SplicePat splice)     = pprSplice splice
+pprPat (CoPat co pat _)       = pprHsWrapper (ppr pat) co
+pprPat (SigPatIn pat ty)      = ppr pat <+> dcolon <+> ppr ty
+pprPat (SigPatOut pat ty)     = ppr pat <+> dcolon <+> ppr ty
 pprPat (ListPat pats _ _)     = brackets (interpp'SP pats)
-pprPat (PArrPat pats _)     = paBrackets (interpp'SP pats)
-pprPat (TuplePat pats bx _) = tupleParens (boxityNormalTupleSort bx) (interpp'SP pats)
-
+pprPat (PArrPat pats _)       = paBrackets (interpp'SP pats)
+pprPat (TuplePat pats bx _)   = tupleParens (boxityTupleSort bx) (pprWithCommas ppr pats)
 pprPat (ConPatIn con details) = pprUserCon (unLoc con) details
 pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
                     pat_binds = binds, pat_args = details })
@@ -325,14 +332,6 @@ pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
           <+> pprConArgs details
     else pprUserCon (unLoc con) details
 
-pprPat (LitPat s)           = ppr s
-pprPat (NPat l Nothing  _)  = ppr l
-pprPat (NPat l (Just _) _)  = char '-' <> ppr l
-pprPat (NPlusKPat n k _ _)  = hcat [ppr n, char '+', ppr k]
-pprPat (SplicePat splice)   = pprSplice splice
-pprPat (CoPat co pat _)     = pprHsWrapper (ppr pat) co
-pprPat (SigPatIn pat ty)    = ppr pat <+> dcolon <+> ppr ty
-pprPat (SigPatOut pat ty)   = ppr pat <+> dcolon <+> ppr ty
 
 pprUserCon :: (OutputableBndr con, OutputableBndr id) => con -> HsConPatDetails id -> SDoc
 pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2
index ebd3bd4..caa8301 100644 (file)
@@ -825,7 +825,7 @@ ppr_mono_ty _    (HsBangTy b ty)     = ppr b <> ppr_mono_lty TyConPrec ty
 ppr_mono_ty _    (HsRecTy flds)      = pprConDeclFields flds
 ppr_mono_ty _    (HsTyVar name)      = pprPrefixOcc name
 ppr_mono_ty prec (HsFunTy ty1 ty2)   = ppr_fun_ty prec ty1 ty2
-ppr_mono_ty _    (HsTupleTy con tys) = tupleParens std_con (interpp'SP tys)
+ppr_mono_ty _    (HsTupleTy con tys) = tupleParens std_con (pprWithCommas ppr tys)
   where std_con = case con of
                     HsUnboxedTuple -> UnboxedTuple
                     _              -> BoxedTuple
index e99ad4d..9d3ef75 100644 (file)
@@ -24,7 +24,7 @@ import TcRnMonad
 import TyCon
 import ConLike
 import DataCon    (dataConName, dataConWorkId, dataConTyCon)
-import PrelInfo   (wiredInThings, basicKnownKeyNames)
+import PrelInfo   ( knownKeyNames )
 import Id         (idName, isDataConWorkId_maybe)
 import TysWiredIn
 import IfaceEnv
@@ -303,14 +303,11 @@ serialiseName bh name _ = do
 
 knownKeyNamesMap :: UniqFM Name
 knownKeyNamesMap = listToUFM_Directly [(nameUnique n, n) | n <- knownKeyNames]
-  where
-    knownKeyNames :: [Name]
-    knownKeyNames = map getName wiredInThings ++ basicKnownKeyNames
 
 
 -- See Note [Symbol table representation of names]
 putName :: BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO ()
-putName _dict BinSymbolTable{ 
+putName _dict BinSymbolTable{
                bin_symtab_map = symtab_map_ref,
                bin_symtab_next = symtab_next }    bh name
   | name `elemUFM` knownKeyNamesMap
@@ -349,7 +346,7 @@ putTupleName_ bh tc tup_sort thing_tag
     sort_tag = case tup_sort of
                  BoxedTuple      -> 0
                  UnboxedTuple    -> 1
-                 ConstraintTuple -> 2
+                 ConstraintTuple -> pprPanic "putTupleName:ConstraintTuple" (ppr tc)
 
 -- See Note [Symbol table representation of names]
 getSymtabName :: NameCacheUpdater
@@ -370,11 +367,10 @@ getSymtabName _ncu _dict symtab bh = do
                         2 -> idName (dataConWorkId dc)
                         _ -> pprPanic "getSymtabName:unknown tuple thing" (ppr i)
           where
-            dc = tupleCon sort arity
+            dc = tupleDataCon sort arity
             sort = case (i .&. 0x30000000) `shiftR` 28 of
-                     0 -> BoxedTuple
-                     1 -> UnboxedTuple
-                     2 -> ConstraintTuple
+                     0 -> Boxed
+                     1 -> Unboxed
                      _ -> pprPanic "getSymtabName:unknown tuple sort" (ppr i)
             thing_tag = (i .&. 0x0CFFFFFF) `shiftR` 26
             arity = fromIntegral (i .&. 0x03FFFFFF)
index 6e14700..b6db5dc 100644 (file)
@@ -21,6 +21,7 @@ module BuildTyCl (
 
 import IfaceEnv
 import FamInstEnv( FamInstEnvs )
+import TysWiredIn( isCTupleTyConName )
 import DataCon
 import PatSyn
 import Var
@@ -282,6 +283,9 @@ buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
 
         ; rhs <- if use_newtype
                  then mkNewTyConRhs tycon_name rec_tycon dict_con
+                 else if isCTupleTyConName tycon_name
+                 then return (TupleTyCon { data_con = dict_con
+                                         , tup_sort = ConstraintTuple })
                  else return (mkDataTyConRhs [dict_con])
 
         ; let { clas_kind = mkPiKinds tvs constraintKind
index 0838cb8..c5aa1a5 100644 (file)
@@ -911,7 +911,7 @@ pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 pprIfaceExpr _       (IfaceCo co)       = text "@~" <+> pprParendIfaceCoercion co
 
 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
-pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
+pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (pprWithCommas ppr as)
 
 pprIfaceExpr add_par i@(IfaceLam _ _)
   = add_par (sep [char '\\' <+> sep (map pprIfaceLamBndr bndrs) <+> arrow,
@@ -1136,11 +1136,10 @@ freeNamesIfTcArgs ITC_Nil         = emptyNameSet
 freeNamesIfType :: IfaceType -> NameSet
 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
-freeNamesIfType (IfaceTyConApp tc ts) =
-   freeNamesIfTc tc &&& freeNamesIfTcArgs ts
+freeNamesIfType (IfaceTyConApp tc ts) = freeNamesIfTc tc &&& freeNamesIfTcArgs ts
+freeNamesIfType (IfaceTupleTy _ _ ts) = freeNamesIfTcArgs ts
 freeNamesIfType (IfaceLitTy _)        = emptyNameSet
-freeNamesIfType (IfaceForAllTy tv t)  =
-   freeNamesIfTvBndr tv &&& freeNamesIfType t
+freeNamesIfType (IfaceForAllTy tv t)  = freeNamesIfTvBndr tv &&& freeNamesIfType t
 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfaceDFunTy s t)     = freeNamesIfType s &&& freeNamesIfType t
 
index dc3c5c5..6dfff6e 100644 (file)
@@ -10,7 +10,8 @@ This module defines interface types and binders
 module IfaceType (
         IfExtName, IfLclName,
 
-        IfaceType(..), IfacePredType, IfaceKind, IfaceTyCon(..), IfaceCoercion(..),
+        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
+        IfaceTyCon(..), IfaceTyConInfo(..),
         IfaceTyLit(..), IfaceTcArgs(..),
         IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr, IfaceTvBndr, IfaceIdBndr,
 
@@ -44,12 +45,12 @@ module IfaceType (
 #include "HsVersions.h"
 
 import Coercion
-import DataCon ( dataConTyCon )
+import DataCon ( isTupleDataCon )
 import TcType
 import DynFlags
 import TypeRep
 import Unique( hasKey )
-import Util ( filterOut, lengthIs, zipWithEqual )
+import Util ( filterOut, zipWithEqual )
 import TyCon hiding ( pprPromotionQuote )
 import CoAxiom
 import Id
@@ -99,13 +100,19 @@ type IfaceKind     = IfaceType
 
 data IfaceType     -- A kind of universal type, used for types and kinds
   = IfaceTyVar    IfLclName               -- Type/coercion variable only, not tycon
+  | IfaceLitTy    IfaceTyLit
   | IfaceAppTy    IfaceType IfaceType
   | IfaceFunTy    IfaceType IfaceType
   | IfaceDFunTy   IfaceType IfaceType
   | IfaceForAllTy IfaceTvBndr IfaceType
+
   | IfaceTyConApp IfaceTyCon IfaceTcArgs  -- Not necessarily saturated
-                                          -- Includes newtypes, synonyms, tuples
-  | IfaceLitTy IfaceTyLit
+                                          -- Includes newtypes, synonyms
+
+  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)
+       TupleSort IfaceTyConInfo   -- A bit like IfaceTyCon
+       IfaceTcArgs                -- arity = length args
+          -- For promoted data cons, the kind args are omitted
 
 type IfacePredType = IfaceType
 type IfaceContext = [IfacePredType]
@@ -128,10 +135,14 @@ data IfaceTcArgs
 -- coercion constructors, the lot.
 -- We have to tag them in order to pretty print them
 -- properly.
-data IfaceTyCon
-  = IfaceTc              { ifaceTyConName :: IfExtName }
-  | IfacePromotedDataCon { ifaceTyConName :: IfExtName }
-  | IfacePromotedTyCon   { ifaceTyConName :: IfExtName }
+data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName
+                             , ifaceTyConInfo :: IfaceTyConInfo }
+
+data IfaceTyConInfo   -- Used to guide pretty-printing
+                      -- and to disambiguate D from 'D (they share a name)
+  = NoIfaceTyConInfo
+  | IfacePromotedDataCon
+  | IfacePromotedTyCon
 
 data IfaceCoercion
   = IfaceReflCo      Role IfaceType
@@ -207,8 +218,9 @@ ifTyVarsOfType ty
       IfaceForAllTy (var,t) ty
         -> delOneFromUniqSet (ifTyVarsOfType ty) var `unionUniqSets`
            ifTyVarsOfType t
-      IfaceTyConApp _ args -> ifTyVarsOfArgs args
-      IfaceLitTy    _      -> emptyUniqSet
+      IfaceTyConApp _ args  -> ifTyVarsOfArgs args
+      IfaceTupleTy _ _ args -> ifTyVarsOfArgs args
+      IfaceLitTy    _       -> emptyUniqSet
 
 ifTyVarsOfArgs :: IfaceTcArgs -> UniqSet IfLclName
 ifTyVarsOfArgs args = argv emptyUniqSet args
@@ -238,6 +250,7 @@ substIfaceType env ty
     go (IfaceDFunTy t1 t2)    = IfaceDFunTy (go t1) (go t2)
     go ty@(IfaceLitTy {})     = ty
     go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceTcArgs env tys)
+    go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceTcArgs env tys)
     go (IfaceForAllTy {})     = pprPanic "substIfaceType" (ppr ty)
 
 substIfaceTcArgs :: IfaceTySubst -> IfaceTcArgs -> IfaceTcArgs
@@ -304,18 +317,6 @@ we want
 
 ************************************************************************
 *                                                                      *
-                Functions over IFaceTyCon
-*                                                                      *
-************************************************************************
--}
-
---isPromotedIfaceTyCon :: IfaceTyCon -> Bool
---isPromotedIfaceTyCon (IfacePromotedTyCon _) = True
---isPromotedIfaceTyCon _ = False
-
-{-
-************************************************************************
-*                                                                      *
                 Pretty-printing
 *                                                                      *
 ************************************************************************
@@ -395,6 +396,7 @@ pprParendIfaceType = ppr_ty TyConPrec
 ppr_ty :: TyPrec -> IfaceType -> SDoc
 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = sdocWithDynFlags (pprTyTcApp ctxt_prec tc tys)
+ppr_ty _         (IfaceTupleTy s i tys) = pprTuple s i tys
 ppr_ty _         (IfaceLitTy n)         = ppr_tylit n
         -- Function types
 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
@@ -521,10 +523,6 @@ ppr_iface_tc_app pp _ tc [ty]
     n = ifaceTyConName tc
 
 ppr_iface_tc_app pp ctxt_prec tc tys
-  | Just (tup_sort, tup_args) <- is_tuple
-  = pprPromotionQuote tc <>
-    tupleParens tup_sort (sep (punctuate comma (map (pp TopPrec) tup_args)))
-
   | not (isSymOcc (nameOccName tc_name))
   = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp TyConPrec) tys)
 
@@ -540,22 +538,10 @@ ppr_iface_tc_app pp ctxt_prec tc tys
   where
     tc_name = ifaceTyConName tc
 
-    is_tuple = case wiredInNameTyThing_maybe tc_name of
-                 Just (ATyCon tc)
-                   | Just sort <- tyConTuple_maybe tc
-                   , tyConArity tc == length tys
-                   -> Just (sort, tys)
-
-                   | Just dc <- isPromotedDataCon_maybe tc
-                   , let dc_tc = dataConTyCon dc
-                   , Just tup_sort <- tyConTuple_maybe dc_tc
-                   , let arity = tyConArity dc_tc
-                         ty_args = drop arity tys
-                   , ty_args `lengthIs` arity
-                   -> Just (tup_sort, ty_args)
-
-                 _ -> Nothing
-
+pprTuple :: TupleSort -> IfaceTyConInfo -> IfaceTcArgs -> SDoc
+pprTuple sort info args
+  = pprPromotionQuoteI info <>
+    tupleParens sort (pprWithCommas pprIfaceType (tcArgsIfaceTypes args))
 
 ppr_tylit :: IfaceTyLit -> SDoc
 ppr_tylit (IfaceNumTyLit n) = integer n
@@ -635,27 +621,34 @@ instance Outputable IfaceTyCon where
   ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
 
 pprPromotionQuote :: IfaceTyCon -> SDoc
-pprPromotionQuote (IfacePromotedDataCon _ ) = char '\''
-pprPromotionQuote (IfacePromotedTyCon _)    = ifPprDebug (char '\'')
-pprPromotionQuote _                         = empty
+pprPromotionQuote tc = pprPromotionQuoteI (ifaceTyConInfo tc)
+
+pprPromotionQuoteI  :: IfaceTyConInfo -> SDoc
+pprPromotionQuoteI NoIfaceTyConInfo     = empty
+pprPromotionQuoteI IfacePromotedDataCon = char '\''
+pprPromotionQuoteI IfacePromotedTyCon   = ifPprDebug (char '\'')
 
 instance Outputable IfaceCoercion where
   ppr = pprIfaceCoercion
 
 instance Binary IfaceTyCon where
-   put_ bh tc =
-     case tc of
-       IfaceTc n              -> putByte bh 0 >> put_ bh n
-       IfacePromotedDataCon n -> putByte bh 1 >> put_ bh n
-       IfacePromotedTyCon   n -> putByte bh 2 >> put_ bh n
+   put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i
+
+   get bh = do n <- get bh
+               i <- get bh
+               return (IfaceTyCon n i)
+
+instance Binary IfaceTyConInfo where
+   put_ bh NoIfaceTyConInfo     = putByte bh 0
+   put_ bh IfacePromotedDataCon = putByte bh 1
+   put_ bh IfacePromotedTyCon   = putByte bh 2
 
    get bh =
-     do tc <- getByte bh
-        case tc of
-          0 -> get bh >>= return . IfaceTc
-          1 -> get bh >>= return . IfacePromotedDataCon
-          2 -> get bh >>= return . IfacePromotedTyCon
-          _ -> panic ("get IfaceTyCon " ++ show tc)
+     do i <- getByte bh
+        case i of
+          0 -> return NoIfaceTyConInfo
+          1 -> return IfacePromotedDataCon
+          _ -> return IfacePromotedTyCon
 
 instance Outputable IfaceTyLit where
   ppr = ppr_tylit
@@ -729,9 +722,10 @@ instance Binary IfaceType where
             put_ bh ah
     put_ bh (IfaceTyConApp tc tys)
       = do { putByte bh 5; put_ bh tc; put_ bh tys }
-
+    put_ bh (IfaceTupleTy s i tys)
+      = do { putByte bh 6; put_ bh s; put_ bh i; put_ bh tys }
     put_ bh (IfaceLitTy n)
-      = do { putByte bh 30; put_ bh n }
+      = do { putByte bh 7; put_ bh n }
 
     get bh = do
             h <- getByte bh
@@ -752,6 +746,8 @@ instance Binary IfaceType where
                       return (IfaceDFunTy ag ah)
               5 -> do { tc <- get bh; tys <- get bh
                       ; return (IfaceTyConApp tc tys) }
+              6 -> do { s <- get bh; i <- get bh; tys <- get bh
+                      ; return (IfaceTupleTy s i tys) }
               30 -> do n <- get bh
                        return (IfaceLitTy n)
 
@@ -904,12 +900,32 @@ toIfaceType :: Type -> IfaceType
 -- Synonyms are retained in the interface type
 toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyVar tv)
 toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
+toIfaceType (LitTy n)         = IfaceLitTy (toIfaceTyLit n)
+toIfaceType (ForAllTy tv t)   = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
 toIfaceType (FunTy t1 t2)
   | isPredTy t1 = IfaceDFunTy (toIfaceType t1) (toIfaceType t2)
   | otherwise   = IfaceFunTy  (toIfaceType t1) (toIfaceType t2)
-toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgs tc tys)
-toIfaceType (LitTy n)         = IfaceLitTy (toIfaceTyLit n)
-toIfaceType (ForAllTy tv t)   = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
+
+toIfaceType (TyConApp tc tys)  -- Look for the three sorts of saturated tuple
+  | Just sort <- tyConTuple_maybe tc
+  , n_tys == arity
+  = IfaceTupleTy sort NoIfaceTyConInfo (toIfaceTcArgs tc tys)
+
+  | Just tc' <- isPromotedTyCon_maybe tc
+  , Just sort <- tyConTuple_maybe tc'
+  , n_tys == arity
+  = IfaceTupleTy sort IfacePromotedTyCon (toIfaceTcArgs tc tys)
+
+  | Just dc <- isPromotedDataCon_maybe tc
+  , isTupleDataCon dc
+  , n_tys == 2*arity
+  = IfaceTupleTy BoxedTuple IfacePromotedDataCon (toIfaceTcArgs tc (drop arity tys))
+
+  | otherwise
+  = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgs tc tys)
+  where
+    arity = tyConArity tc
+    n_tys = length tys
 
 toIfaceTyVar :: TyVar -> FastString
 toIfaceTyVar = occNameFS . getOccName
@@ -920,13 +936,17 @@ toIfaceCoVar = occNameFS . getOccName
 ----------------
 toIfaceTyCon :: TyCon -> IfaceTyCon
 toIfaceTyCon tc
-  | isPromotedDataCon tc = IfacePromotedDataCon tc_name
-  | isPromotedTyCon tc   = IfacePromotedTyCon tc_name
-  | otherwise            = IfaceTc tc_name
-    where tc_name = tyConName tc
+  = IfaceTyCon tc_name info
+  where
+    tc_name = tyConName tc
+    info | isPromotedDataCon tc = IfacePromotedDataCon
+         | isPromotedTyCon tc   = IfacePromotedTyCon
+         | otherwise            = NoIfaceTyConInfo
 
 toIfaceTyCon_name :: Name -> IfaceTyCon
-toIfaceTyCon_name = IfaceTc
+toIfaceTyCon_name n = IfaceTyCon n NoIfaceTyConInfo
+  -- Used for the "rough-match" tycon stuff,
+  -- where pretty-printing is not an issue
 
 toIfaceTyLit :: TyLit -> IfaceTyLit
 toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x
index 1beae57..2553643 100644 (file)
@@ -49,7 +49,7 @@ import DataCon
 import PrelNames
 import TysWiredIn
 import TysPrim          ( superKindTyConName )
-import BasicTypes       ( strongLoopBreaker )
+import BasicTypes       ( strongLoopBreaker, Arity, TupleSort(..), Boxity(..) )
 import Literal
 import qualified Var
 import VarEnv
@@ -643,7 +643,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
                                                 -- or, even if it is (module loop, perhaps)
                                                 -- we'll just leave it in the non-local set
   where
-        -- This function *must* mirror exactly what Rules.topFreeName does
+        -- This function *must* mirror exactly what Rules.roughTopNames does
         -- We could have stored the ru_rough field in the iface file
         -- but that would be redundant, I think.
         -- The only wrinkle is that we must not be deceived by
@@ -652,6 +652,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
         -- to write them out in coreRuleToIfaceRule
     ifTopFreeName :: IfaceExpr -> Maybe Name
     ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
+    ifTopFreeName (IfaceType (IfaceTupleTy s _ ts)) = Just (tupleTyConName s (length (tcArgsIfaceTypes ts)))
     ifTopFreeName (IfaceApp f _)                    = ifTopFreeName f
     ifTopFreeName (IfaceExt n)                      = Just n
     ifTopFreeName _                                 = Nothing
@@ -805,7 +806,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
                      -- name is not a tycon => internal inconsistency
                    Just _              -> notATyConErr
                      -- tycon is external
-                   Nothing             -> tcIfaceTyCon (IfaceTc name)
+                   Nothing             -> tcIfaceTyConByName name
                }
 
         notATyConErr = pprPanic "TcIface.tcIfaceVectInfo: not a tycon" (ppr name)
@@ -824,6 +825,7 @@ tcIfaceType (IfaceAppTy t1 t2)     = do { t1' <- tcIfaceType t1; t2' <- tcIfaceT
 tcIfaceType (IfaceLitTy l)         = do { l1 <- tcIfaceTyLit l; return (LitTy l1) }
 tcIfaceType (IfaceFunTy t1 t2)     = tcIfaceTypeFun t1 t2
 tcIfaceType (IfaceDFunTy t1 t2)    = tcIfaceTypeFun t1 t2
+tcIfaceType (IfaceTupleTy s i tks) = tcIfaceTupleTy s i tks
 tcIfaceType (IfaceTyConApp tc tks) = do { tc' <- tcIfaceTyCon tc
                                         ; tks' <- tcIfaceTcArgs tks
                                         ; return (mkTyConApp tc' tks') }
@@ -842,6 +844,34 @@ tcIfaceKind k                   = tcIfaceType k
 tcIfaceKindFun :: IfaceKind -> IfaceKind -> IfL Type
 tcIfaceKindFun t1 t2 = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (FunTy t1' t2') }
 
+tcIfaceTupleTy :: TupleSort -> IfaceTyConInfo -> IfaceTcArgs -> IfL Type
+tcIfaceTupleTy sort info args
+ = do { args' <- tcIfaceTcArgs args
+      ; let arity = length args'
+      ; base_tc <- tcTupleTyCon sort arity
+      ; case info of
+          NoIfaceTyConInfo
+            -> return (mkTyConApp base_tc args')
+
+          IfacePromotedTyCon
+            | Just tc <- promotableTyCon_maybe base_tc
+            -> return (mkTyConApp tc args')
+            | otherwise
+            -> panic "tcIfaceTupleTy" (ppr base_tc)
+
+          IfacePromotedDataCon
+            -> do { let tc        = promoteDataCon (tyConSingleDataCon base_tc)
+                        kind_args = map typeKind args'
+                  ; return (mkTyConApp tc (kind_args ++ args')) } }
+
+tcTupleTyCon :: TupleSort -> Arity -> IfL TyCon
+tcTupleTyCon sort arity
+  = case sort of
+      ConstraintTuple -> do { thing <- tcIfaceGlobal (cTupleTyConName arity)
+                            ; return (tyThingTyCon thing) }
+      BoxedTuple   -> return (tupleTyCon Boxed   arity)
+      UnboxedTuple -> return (tupleTyCon Unboxed arity)
+
 tcIfaceTcArgs :: IfaceTcArgs -> IfL [Type]
 tcIfaceTcArgs args
   = case args of
@@ -942,15 +972,15 @@ tcIfaceExpr (IfaceFCall cc ty) = do
     dflags <- getDynFlags
     return (Var (mkFCallId dflags u cc ty'))
 
-tcIfaceExpr (IfaceTuple boxity args)  = do
-    args' <- mapM tcIfaceExpr args
-    -- Put the missing type arguments back in
-    let con_args = map (Type . exprType) args' ++ args'
-    return (mkApps (Var con_id) con_args)
+tcIfaceExpr (IfaceTuple sort args)
+  = do { args' <- mapM tcIfaceExpr args
+       ; tc <- tcTupleTyCon sort arity
+       ; let con_args = map (Type . exprType) args' ++ args'
+                        -- Put the missing type arguments back in
+             con_id   = dataConWorkId (tyConSingleDataCon tc)
+       ; return (mkApps (Var con_id) con_args) }
   where
     arity = length args
-    con_id = dataConWorkId (tupleCon boxity arity)
-
 
 tcIfaceExpr (IfaceLam (bndr, os) body)
   = bindIfaceBndr bndr $ \bndr' ->
@@ -1059,7 +1089,7 @@ tcIfaceLit :: Literal -> IfL Literal
 -- so tcIfaceLit just fills in the type.
 -- See Note [Integer literals] in Literal
 tcIfaceLit (LitInteger i _)
-  = do t <- tcIfaceTyCon (IfaceTc integerTyConName)
+  = do t <- tcIfaceTyConByName integerTyConName
        return (mkLitInteger i (mkTyConTy t))
 tcIfaceLit lit = return lit
 
@@ -1237,6 +1267,7 @@ tcIfaceGlobal name
         -- sure the instances and RULES of this thing (particularly TyCon) are loaded
         -- Imagine: f :: Double -> Double
   = do { ifCheckWiredInThing thing; return thing }
+
   | otherwise
   = do  { env <- getGblEnv
         ; case if_rec_types env of {    -- Note [Tying the knot]
@@ -1279,20 +1310,25 @@ tcIfaceGlobal name
 -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
 -- emasculated form (e.g. lacking data constructors).
 
+tcIfaceTyConByName :: IfExtName -> IfL TyCon
+tcIfaceTyConByName name
+  = do { thing <- tcIfaceGlobal name
+       ; return (tyThingTyCon thing) }
+
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
-tcIfaceTyCon itc
-  = do {
-    ; thing <- tcIfaceGlobal (ifaceTyConName itc)
-    ; case itc of
-        IfaceTc _ -> return $ tyThingTyCon thing
-        IfacePromotedDataCon _ -> return $ promoteDataCon $ tyThingDataCon thing
-        IfacePromotedTyCon name ->
-          let ktycon tc
-                | isSuperKind (tyConKind tc) = return tc
-                | Just prom_tc <- promotableTyCon_maybe tc = return prom_tc
-                | otherwise = pprPanic "tcIfaceTyCon" (ppr name $$ ppr thing)
-          in ktycon (tyThingTyCon thing)
-    }
+tcIfaceTyCon (IfaceTyCon name info)
+  = do { thing <- tcIfaceGlobal name
+       ; case info of
+           NoIfaceTyConInfo     -> return (tyThingTyCon thing)
+           IfacePromotedDataCon -> return (promoteDataCon (tyThingDataCon thing))
+                                   -- Same Name as its underlying DataCon
+           IfacePromotedTyCon   -> return (promote_tc (tyThingTyCon thing)) }
+                                   -- Same Name as its underlying TyCon
+  where
+    promote_tc tc
+      | Just prom_tc <- promotableTyCon_maybe tc = prom_tc
+      | isSuperKind (tyConKind tc)               = tc
+      | otherwise = pprPanic "tcIfaceTyCon" (ppr name $$ ppr tc)
 
 tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
index 0f23fc2..22bd4e6 100644 (file)
@@ -17,6 +17,9 @@ mAX_TUPLE_SIZE :: Int
 mAX_TUPLE_SIZE = 62 -- Should really match the number
                     -- of decls in Data.Tuple
 
+mAX_CTUPLE_SIZE :: Int   -- Constraint tuples
+mAX_CTUPLE_SIZE = 8      -- Should match the number of decls in GHC.Classes
+
 -- | Default maximum depth for both class instance search and type family
 -- reduction. See also Trac #5395.
 mAX_REDUCTION_DEPTH :: Int
index 0acbdff..47d4515 100644 (file)
@@ -101,7 +101,6 @@ import ConLike
 import GHC.Exts
 #endif
 
-import DsMeta           ( templateHaskellNames )
 import Module
 import Packages
 import RdrName
@@ -192,12 +191,6 @@ newHscEnv dflags = do
                      hsc_type_env_var = Nothing }
 
 
-knownKeyNames :: [Name]      -- Put here to avoid loops involving DsMeta,
-knownKeyNames =              -- where templateHaskellNames are defined
-    map getName wiredInThings
-        ++ basicKnownKeyNames
-        ++ templateHaskellNames
-
 -- -----------------------------------------------------------------------------
 
 getWarnings :: Hsc WarningMessages
index eb2aa0c..7ffa6b6 100644 (file)
@@ -80,7 +80,7 @@ import TcEvidence       ( emptyTcEvBinds )
 -- compiler/prelude
 import ForeignCall
 import TysPrim          ( liftedTypeKindTyConName, eqPrimTyCon )
-import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
+import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
                           unboxedUnitTyCon, unboxedUnitDataCon,
                           listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
 
@@ -728,10 +728,9 @@ qcname_ext :: { Located RdrName }       -- Variable or data constructor
         |  'type' qcname            {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
                                             [mj AnnType $1,mj AnnVal $2] }
 
--- Cannot pull into qcname_ext, as qcname is also used in expression.
-qcname  :: { Located RdrName }  -- Variable or data constructor
+qcname  :: { Located RdrName }  -- Variable or type constructor
         :  qvar                         { $1 }
-        |  qcon                         { $1 }
+        |  oqtycon                      { $1 }
 
 -----------------------------------------------------------------------------
 -- Import Declarations
@@ -2277,8 +2276,9 @@ aexp1   :: { LHsExpr RdrName }
         | aexp2                { $1 }
 
 aexp2   :: { LHsExpr RdrName }
-        : ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
-        | qcname                        { sL1 $1 (HsVar   $! unLoc $1) }
+        : qvar                          { sL1 $1 (HsVar   $! unLoc $1) }
+        | qcon                          { sL1 $1 (HsVar   $! unLoc $1) }
+        | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
 -- into HsOverLit when -foverloaded-strings is on.
@@ -2803,10 +2803,10 @@ con_list : con                  { sL1 $1 [$1] }
 
 sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
-        | '(' commas ')'        {% ams (sLL $1 $> $ tupleCon BoxedTuple (snd $2 + 1))
+        | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
                                        (mop $1:mcp $3:(mcommas (fst $2))) }
         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
-        | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleCon UnboxedTuple (snd $2 + 1))
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
                                        (mo $1:mc $3:(mcommas (fst $2))) }
 
 sysdcon :: { Located DataCon }
@@ -2840,10 +2840,10 @@ gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tu
 
 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
         : oqtycon               { $1 }
-        | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon BoxedTuple
+        | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
                                                         (snd $2 + 1)))
                                        (mop $1:mcp $3:(mcommas (fst $2))) }
-        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon UnboxedTuple
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
                                                         (snd $2 + 1)))
                                        (mo $1:mc $3:(mcommas (fst $2))) }
         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
index f0dc1ea..39589fe 100644 (file)
@@ -21,6 +21,7 @@ module RdrHsSyn (
         mkPatSynMatchGroup,
         mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
         mkTyClD, mkInstD,
+        setRdrNameSpace,
 
         cvBindGroup,
         cvBindsAndSigs,
@@ -65,24 +66,24 @@ module RdrHsSyn (
 
 import HsSyn            -- Lots of it
 import Class            ( FunDep )
+import TyCon            ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )
+import DataCon          ( DataCon, dataConTyCon )
+import ConLike          ( ConLike(..) )
 import CoAxiom          ( Role, fsFromRole )
-import RdrName          ( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc,
-                          isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace,
-                          rdrNameSpace )
-import OccName          ( tcClsName, isVarNameSpace )
-import Name             ( Name )
-import BasicTypes       ( maxPrecedence, Activation(..), RuleMatchInfo,
-                          InlinePragma(..), InlineSpec(..), Origin(..),
-                          SourceText )
+import RdrName
+import Name
+import BasicTypes
 import TcEvidence       ( idHsWrapper )
 import Lexer
-import TysWiredIn       ( unitTyCon, unitDataCon )
+import Type             ( TyThing(..) )
+import TysWiredIn       ( cTupleTyConName, tupleTyCon, tupleDataCon,
+                          nilDataConName, nilDataConKey,
+                          listTyConName, listTyConKey )
 import ForeignCall
-import OccName          ( srcDataName, varName, isDataOcc, isTcOcc,
-                          occNameString )
 import PrelNames        ( forall_tv_RDR, allNameStrings )
 import DynFlags
 import SrcLoc
+import Unique           ( hasKey )
 import OrdList          ( OrdList, fromOL )
 import Bag              ( emptyBag, consBag )
 import Outputable
@@ -137,7 +138,7 @@ mkClassDecl :: SrcSpan
 mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
   = do { (binds, sigs, ats, at_insts, _, docs) <- cvBindsAndSigs where_cls
        ; let cxt = fromMaybe (noLoc []) mcxt
-       ; (cls, tparams,ann) <- checkTyClHdr tycl_hdr
+       ; (cls, tparams,ann) <- checkTyClHdr True tycl_hdr
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        -- Partial type signatures are not allowed in a class definition
        ; checkNoPartialSigs sigs cls
@@ -271,7 +272,7 @@ mkTyData :: SrcSpan
          -> Maybe (Located [LHsType RdrName])
          -> P (LTyClDecl RdrName)
 mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
-  = do { (tc, tparams,ann) <- checkTyClHdr tycl_hdr
+  = do { (tc, tparams,ann) <- checkTyClHdr False tycl_hdr
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        ; tyvars <- checkTyVarsP (ppr new_or_data) equalsDots tc tparams
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
@@ -306,7 +307,7 @@ mkTySynonym :: SrcSpan
             -> LHsType RdrName  -- RHS
             -> P (LTyClDecl RdrName)
 mkTySynonym loc lhs rhs
-  = do { (tc, tparams,ann) <- checkTyClHdr lhs
+  = do { (tc, tparams,ann) <- checkTyClHdr False lhs
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        ; tyvars <- checkTyVarsP (ptext (sLit "type")) equalsDots tc tparams
        ; let err = text "In type synonym" <+> quotes (ppr tc) <>
@@ -319,7 +320,7 @@ mkTyFamInstEqn :: LHsType RdrName
                -> LHsType RdrName
                -> P (TyFamInstEqn RdrName,[AddAnn])
 mkTyFamInstEqn lhs rhs
-  = do { (tc, tparams,ann) <- checkTyClHdr lhs
+  = do { (tc, tparams,ann) <- checkTyClHdr False lhs
        ; let err xhs = hang (text "In type family instance equation of" <+>
                              quotes (ppr tc) <> colon)
                        2 (ppr xhs)
@@ -339,7 +340,7 @@ mkDataFamInst :: SrcSpan
          -> Maybe (Located [LHsType RdrName])
          -> P (LInstDecl RdrName)
 mkDataFamInst loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
-  = do { (tc, tparams,ann) <- checkTyClHdr tycl_hdr
+  = do { (tc, tparams,ann) <- checkTyClHdr False tycl_hdr
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
        ; return (L loc (DataFamInstD (
@@ -359,7 +360,7 @@ mkFamDecl :: SrcSpan
           -> Maybe (LHsKind RdrName) -- Optional kind signature
           -> P (LTyClDecl RdrName)
 mkFamDecl loc info lhs ksig
-  = do { (tc, tparams,ann) <- checkTyClHdr lhs
+  = do { (tc, tparams,ann) <- checkTyClHdr False lhs
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        ; tyvars <- checkTyVarsP (ppr info) equals_or_where tc tparams
        ; return (L loc (FamDecl (FamilyDecl { fdInfo = info, fdLName = tc
@@ -545,9 +546,9 @@ splitCon ty
    split (L _ (HsAppTy t u)) ts    = split t (u : ts)
    split (L l (HsTyVar tc))  ts    = do data_con <- tyConToDataCon l tc
                                         return (data_con, mk_rest ts)
-   split (L l (HsTupleTy _ [])) [] = return (L l (getRdrName unitDataCon), PrefixCon [])
-                                         -- See Note [Unit tuples] in HsTypes
-   split (L l _) _                 = parseErrorSDoc l (text "Cannot parse data constructor in a data/newtype declaration:" <+> ppr ty)
+   split (L l (HsTupleTy HsBoxedOrConstraintTuple ts)) []
+      = return (L l (getRdrName (tupleDataCon Boxed (length ts))), PrefixCon ts)
+   split (L l _) _ = parseErrorSDoc l (text "Cannot parse data constructor in a data/newtype declaration:" <+> ppr ty)
 
    mk_rest [L l (HsRecTy flds)] = RecCon (L l flds)
    mk_rest ts                   = PrefixCon ts
@@ -662,6 +663,91 @@ tyConToDataCon loc tc
           = text "Perhaps you intended to use ExistentialQuantification"
           | otherwise = empty
 
+setRdrNameSpace :: RdrName -> NameSpace -> RdrName
+-- ^ This rather gruesome function is used mainly by the parser.
+-- When parsing:
+--
+-- > data T a = T | T1 Int
+--
+-- we parse the data constructors as /types/ because of parser ambiguities,
+-- so then we need to change the /type constr/ to a /data constr/
+--
+-- The exact-name case /can/ occur when parsing:
+--
+-- > data [] a = [] | a : [a]
+--
+-- For the exact-name case we return an original name.
+setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
+setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
+setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
+setRdrNameSpace (Exact n)    ns
+  | Just thing <- wiredInNameTyThing_maybe n
+  = setWiredInNameSpace thing ns
+    -- Preserve Exact Names for wired-in things,
+    -- notably tuples and lists
+
+  | isExternalName n
+  = Orig (nameModule n) occ
+
+  | otherwise   -- This can happen when quoting and then
+                -- splicing a fixity declaration for a type
+  = Exact (mkSystemNameAt (nameUnique n) occ (nameSrcSpan n))
+  where
+    occ = setOccNameSpace ns (nameOccName n)
+
+setWiredInNameSpace :: TyThing -> NameSpace -> RdrName
+setWiredInNameSpace (ATyCon tc) ns
+  | isDataConNameSpace ns
+  = ty_con_data_con tc
+  | isTcClsNameSpace ns
+  = Exact (getName tc)      -- No-op
+
+setWiredInNameSpace (AConLike (RealDataCon dc)) ns
+  | isTcClsNameSpace ns
+  = data_con_ty_con dc
+  | isDataConNameSpace ns
+  = Exact (getName dc)      -- No-op
+
+setWiredInNameSpace thing ns
+  = pprPanic "setWiredinNameSpace" (pprNameSpace ns <+> ppr thing)
+
+ty_con_data_con :: TyCon -> RdrName
+ty_con_data_con tc
+  | isTupleTyCon tc
+  , Just dc <- tyConSingleDataCon_maybe tc
+  = Exact (getName dc)
+
+  | tc `hasKey` listTyConKey
+  = Exact nilDataConName
+
+  | otherwise  -- See Note [setRdrNameSpace for wired-in names]
+  = Unqual (setOccNameSpace srcDataName (getOccName tc))
+
+data_con_ty_con :: DataCon -> RdrName
+data_con_ty_con dc
+  | let tc = dataConTyCon dc
+  , isTupleTyCon tc
+  = Exact (getName tc)
+
+  | dc `hasKey` nilDataConKey
+  = Exact listTyConName
+
+  | otherwise  -- See Note [setRdrNameSpace for wired-in names]
+  = Unqual (setOccNameSpace tcClsName (getOccName dc))
+
+
+{- Note [setRdrNameSpace for wired-in names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In GHC.Types, which declares (:), we have
+  infixr 5 :
+The ambiguity about which ":" is meant is resolved by parsing it as a
+data constructor, but then using dataTcOccs to try the type constructor too;
+and that in turn calls setRdrNameSpace to change the name-space of ":" to
+tcClsName.  There isn't a corresponding ":" type constructor, but it's painful
+to make setRdrNameSpace partial, so we just make an Unqual name instead. It
+really doesn't matter!
+-}
+
 -- | Note [Sorting out the result type]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- In a GADT declaration which is not a record, we put the whole constr
@@ -738,7 +824,9 @@ checkRecordSyntax lr@(L loc r)
                       (text "Illegal record syntax (use TraditionalRecordSyntax):" <+>
                        ppr r)
 
-checkTyClHdr :: LHsType RdrName
+checkTyClHdr :: Bool               -- True  <=> class header
+                                   -- False <=> type header
+             -> LHsType RdrName
              -> P (Located RdrName,          -- the head symbol (type or class name)
                    [LHsType RdrName],        -- parameters of head symbol
                    [AddAnn]) -- API Annotation for HsParTy when stripping parens
@@ -746,22 +834,28 @@ checkTyClHdr :: LHsType RdrName
 -- Decomposes   T ty1 .. tyn   into    (T, [ty1, ..., tyn])
 --              Int :*: Bool   into    (:*:, [Int, Bool])
 -- returning the pieces
-checkTyClHdr ty
+checkTyClHdr is_cls ty
   = goL ty [] []
   where
     goL (L l ty) acc ann = go l ty acc ann
 
     go l (HsTyVar tc) acc ann
-        | isRdrTc tc             = return (L l tc, acc, ann)
+      | isRdrTc tc               = return (L l tc, acc, ann)
     go _ (HsOpTy t1 (_, ltc@(L _ tc)) t2) acc ann
-        | isRdrTc tc             = return (ltc, t1:t2:acc, ann)
+      | isRdrTc tc               = return (ltc, t1:t2:acc, ann)
     go l (HsParTy ty)    acc ann = goL ty acc (ann ++ mkParensApiAnn l)
     go _ (HsAppTy t1 t2) acc ann = goL t1 (t2:acc) ann
-    go l (HsTupleTy _ []) [] ann = return (L l (getRdrName unitTyCon), [],ann)
-                                   -- See Note [Unit tuples] in HsTypes
-    go l _               _   _
-         = parseErrorSDoc l (text "Malformed head of type or class declaration:"
-                             <+> ppr ty)
+
+    go l (HsTupleTy HsBoxedOrConstraintTuple ts) [] ann
+      = return (L l (nameRdrName tup_name), ts, ann)
+      where
+        arity = length ts
+        tup_name | is_cls    = cTupleTyConName arity
+                 | otherwise = getName (tupleTyCon Boxed arity)
+                 -- See Note [Unit tuples] in HsTypes  (TODO: is this still relevant?)
+    go l _  _  _
+      = parseErrorSDoc l (text "Malformed head of type or class declaration:"
+                          <+> ppr ty)
 
 checkContext :: LHsType RdrName -> P (LHsContext RdrName)
 checkContext (L l orig_t)
@@ -1481,14 +1575,12 @@ mkModuleImpExp n@(L l name) subs =
   case subs of
     ImpExpAbs
       | isVarNameSpace (rdrNameSpace name) -> IEVar       n
-      | otherwise                          -> IEThingAbs  (L l nameT)
-    ImpExpAll                              -> IEThingAll  (L l nameT)
-    ImpExpList xs                          -> IEThingWith (L l nameT) xs
-
-  where
-    nameT = setRdrNameSpace name tcClsName
+      | otherwise                          -> IEThingAbs  (L l name)
+    ImpExpAll                              -> IEThingAll  (L l name)
+    ImpExpList xs                          -> IEThingWith (L l name) xs
 
-mkTypeImpExp :: Located RdrName -> P (Located RdrName)
+mkTypeImpExp :: Located RdrName   -- TcCls or Var name space
+             -> P (Located RdrName)
 mkTypeImpExp name =
   do allowed <- extension explicitNamespacesEnabled
      if allowed
index 2303a8e..4d1cd9a 100644 (file)
@@ -10,7 +10,7 @@ module PrelInfo (
         primOpRules, builtinRules,
 
         ghcPrimExports,
-        wiredInThings, basicKnownKeyNames,
+        wiredInThings, knownKeyNames,
         primOpId,
 
         -- Random other things
@@ -30,6 +30,7 @@ import PrimOp
 import DataCon
 import Id
 import MkId
+import Name( Name, getName )
 import TysPrim
 import TysWiredIn
 import HscTypes
@@ -38,12 +39,31 @@ import TyCon
 import Util
 import {-# SOURCE #-} TcTypeNats ( typeNatTyCons )
 
+#ifdef GHCI
+import THNames
+#endif
+
 import Data.Array
 
-{-
-************************************************************************
+
+{- *********************************************************************
+*                                                                      *
+                Known key things
+*                                                                      *
+********************************************************************* -}
+
+knownKeyNames :: [Name]
+knownKeyNames
+  = map getName wiredInThings
+    ++ cTupleTyConNames
+    ++ basicKnownKeyNames
+#ifdef GHCI
+    ++ templateHaskellNames
+#endif
+
+{- *********************************************************************
 *                                                                      *
-\subsection[builtinNameInfo]{Lookup built-in names}
+                Wired in things
 *                                                                      *
 ************************************************************************
 
index 113dfdc..ded9583 100644 (file)
@@ -121,7 +121,6 @@ import Module
 import OccName
 import RdrName
 import Unique
-import BasicTypes
 import Name
 import SrcLoc
 import FastString
@@ -520,19 +519,6 @@ mkMainModule_ m = mkModule mainPackageKey m
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Constructing the names of tuples
-*                                                                      *
-************************************************************************
--}
-
-mkTupleModule :: TupleSort -> Module
-mkTupleModule BoxedTuple      = gHC_TUPLE
-mkTupleModule ConstraintTuple = gHC_TUPLE
-mkTupleModule UnboxedTuple    = gHC_PRIM
-
-{-
-************************************************************************
-*                                                                      *
                         RdrNames
 *                                                                      *
 ************************************************************************
@@ -1572,9 +1558,6 @@ typeRepTyConKey = mkPreludeTyConUnique 183
 
 #include "primop-vector-uniques.hs-incl"
 
-unitTyConKey :: Unique
-unitTyConKey = mkTupleTyConUnique BoxedTuple 0
-
 {-
 ************************************************************************
 *                                                                      *
index 5c6b700..1ab8543 100644 (file)
@@ -907,7 +907,7 @@ seqRule :: RuleM CoreExpr
 seqRule = do
   [ty_a, Type ty_s, a, s] <- getArgs
   guard $ exprIsHNF a
-  return $ mkConApp (tupleCon UnboxedTuple 2)
+  return $ mkConApp (tupleDataCon Unboxed 2)
     [Type (mkStatePrimTy ty_s), ty_a, s, a]
 
 -- spark# :: forall a s . a -> State# s -> (# State# s, a #)
@@ -1224,7 +1224,7 @@ match_Integer_divop_both divop _ id_unf _ [xl,yl]
   , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
   , y /= 0
   , (r,s) <- x `divop` y
-  = Just $ mkConApp (tupleCon UnboxedTuple 2)
+  = Just $ mkConApp (tupleDataCon Unboxed 2)
                     [Type t,
                      Type t,
                      Lit (LitInteger r t),
@@ -1300,7 +1300,7 @@ match_decodeDouble _ id_unf fn [xl]
     FunTy _ (TyConApp _ [integerTy, intHashTy]) ->
         case decodeFloat (fromRational x :: Double) of
         (y, z) ->
-            Just $ mkConApp (tupleCon UnboxedTuple 2)
+            Just $ mkConApp (tupleDataCon Unboxed 2)
                             [Type integerTy,
                              Type intHashTy,
                              Lit (LitInteger y integerTy),
index de6d49b..dbeade2 100644 (file)
@@ -34,7 +34,7 @@ import OccName          ( OccName, pprOccName, mkVarOccFS )
 import TyCon            ( TyCon, isPrimTyCon, tyConPrimRep, PrimRep(..) )
 import Type             ( Type, mkForAllTys, mkFunTy, mkFunTys, tyConAppTyCon,
                           typePrimRep )
-import BasicTypes       ( Arity, Fixity(..), FixityDirection(..), TupleSort(..) )
+import BasicTypes       ( Arity, Fixity(..), FixityDirection(..), Boxity(..) )
 import ForeignCall      ( CLabelString )
 import Unique           ( Unique, mkPrimOpIdUnique )
 import Outputable
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
new file mode 100644 (file)
index 0000000..5ccfaeb
--- /dev/null
@@ -0,0 +1,836 @@
+-- %************************************************************************
+-- %*                                                                   *
+--              The known-key names for Template Haskell
+-- %*                                                                   *
+-- %************************************************************************
+
+module THNames where
+
+import PrelNames( mk_known_key_name )
+import Module( Module, mkModuleNameFS, mkModule, thPackageKey )
+import Name( Name )
+import OccName( tcName, dataName, varName )
+import Unique
+import FastString
+
+-- To add a name, do three things
+--
+--  1) Allocate a key
+--  2) Make a "Name"
+--  3) Add the name to knownKeyNames
+
+templateHaskellNames :: [Name]
+-- The names that are implicitly mentioned by ``bracket''
+-- Should stay in sync with the import list of DsMeta
+
+templateHaskellNames = [
+    returnQName, bindQName, sequenceQName, newNameName, liftName,
+    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
+    liftStringName,
+    unTypeName,
+    unTypeQName,
+    unsafeTExpCoerceName,
+
+    -- Lit
+    charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
+    floatPrimLName, doublePrimLName, rationalLName,
+    -- Pat
+    litPName, varPName, tupPName, unboxedTupPName,
+    conPName, tildePName, bangPName, infixPName,
+    asPName, wildPName, recPName, listPName, sigPName, viewPName,
+    -- FieldPat
+    fieldPatName,
+    -- Match
+    matchName,
+    -- Clause
+    clauseName,
+    -- Exp
+    varEName, conEName, litEName, appEName, infixEName,
+    infixAppName, sectionLName, sectionRName, lamEName, lamCaseEName,
+    tupEName, unboxedTupEName,
+    condEName, multiIfEName, letEName, caseEName, doEName, compEName,
+    fromEName, fromThenEName, fromToEName, fromThenToEName,
+    listEName, sigEName, recConEName, recUpdEName, staticEName,
+    -- FieldExp
+    fieldExpName,
+    -- Body
+    guardedBName, normalBName,
+    -- Guard
+    normalGEName, patGEName,
+    -- Stmt
+    bindSName, letSName, noBindSName, parSName,
+    -- Dec
+    funDName, valDName, dataDName, newtypeDName, tySynDName,
+    classDName, instanceDName, standaloneDerivDName, sigDName, forImpDName,
+    pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,
+    pragRuleDName, pragAnnDName, defaultSigDName,
+    familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName,
+    tySynInstDName, closedTypeFamilyKindDName, closedTypeFamilyNoKindDName,
+    infixLDName, infixRDName, infixNDName,
+    roleAnnotDName,
+    -- Cxt
+    cxtName,
+    -- Strict
+    isStrictName, notStrictName, unpackedName,
+    -- Con
+    normalCName, recCName, infixCName, forallCName,
+    -- StrictType
+    strictTypeName,
+    -- VarStrictType
+    varStrictTypeName,
+    -- Type
+    forallTName, varTName, conTName, appTName, equalityTName,
+    tupleTName, unboxedTupleTName, arrowTName, listTName, sigTName, litTName,
+    promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
+    -- TyLit
+    numTyLitName, strTyLitName,
+    -- TyVarBndr
+    plainTVName, kindedTVName,
+    -- Role
+    nominalRName, representationalRName, phantomRName, inferRName,
+    -- Kind
+    varKName, conKName, tupleKName, arrowKName, listKName, appKName,
+    starKName, constraintKName,
+    -- Callconv
+    cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName,
+    -- Safety
+    unsafeName,
+    safeName,
+    interruptibleName,
+    -- Inline
+    noInlineDataConName, inlineDataConName, inlinableDataConName,
+    -- RuleMatch
+    conLikeDataConName, funLikeDataConName,
+    -- Phases
+    allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName,
+    -- TExp
+    tExpDataConName,
+    -- RuleBndr
+    ruleVarName, typedRuleVarName,
+    -- FunDep
+    funDepName,
+    -- FamFlavour
+    typeFamName, dataFamName,
+    -- TySynEqn
+    tySynEqnName,
+    -- AnnTarget
+    valueAnnotationName, typeAnnotationName, moduleAnnotationName,
+
+    -- And the tycons
+    qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
+    clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
+    stmtQTyConName, decQTyConName, conQTyConName, strictTypeQTyConName,
+    varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
+    typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
+    patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
+    predQTyConName, decsQTyConName, ruleBndrQTyConName, tySynEqnQTyConName,
+    roleTyConName, tExpTyConName,
+
+    -- Quasiquoting
+    quoteDecName, quoteTypeName, quoteExpName, quotePatName]
+
+thSyn, thLib, qqLib :: Module
+thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax")
+thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
+qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
+
+mkTHModule :: FastString -> Module
+mkTHModule m = mkModule thPackageKey (mkModuleNameFS m)
+
+libFun, libTc, thFun, thTc, thCon, qqFun :: FastString -> Unique -> Name
+libFun = mk_known_key_name OccName.varName  thLib
+libTc  = mk_known_key_name OccName.tcName   thLib
+thFun  = mk_known_key_name OccName.varName  thSyn
+thTc   = mk_known_key_name OccName.tcName   thSyn
+thCon  = mk_known_key_name OccName.dataName thSyn
+qqFun  = mk_known_key_name OccName.varName  qqLib
+
+-------------------- TH.Syntax -----------------------
+qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
+    fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
+    tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
+    predTyConName, tExpTyConName :: Name
+qTyConName        = thTc (fsLit "Q")            qTyConKey
+nameTyConName     = thTc (fsLit "Name")         nameTyConKey
+fieldExpTyConName = thTc (fsLit "FieldExp")     fieldExpTyConKey
+patTyConName      = thTc (fsLit "Pat")          patTyConKey
+fieldPatTyConName = thTc (fsLit "FieldPat")     fieldPatTyConKey
+expTyConName      = thTc (fsLit "Exp")          expTyConKey
+decTyConName      = thTc (fsLit "Dec")          decTyConKey
+typeTyConName     = thTc (fsLit "Type")         typeTyConKey
+tyVarBndrTyConName= thTc (fsLit "TyVarBndr")    tyVarBndrTyConKey
+matchTyConName    = thTc (fsLit "Match")        matchTyConKey
+clauseTyConName   = thTc (fsLit "Clause")       clauseTyConKey
+funDepTyConName   = thTc (fsLit "FunDep")       funDepTyConKey
+predTyConName     = thTc (fsLit "Pred")         predTyConKey
+tExpTyConName     = thTc (fsLit "TExp")         tExpTyConKey
+
+returnQName, bindQName, sequenceQName, newNameName, liftName,
+    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
+    mkNameLName, liftStringName, unTypeName, unTypeQName,
+    unsafeTExpCoerceName :: Name
+returnQName    = thFun (fsLit "returnQ")   returnQIdKey
+bindQName      = thFun (fsLit "bindQ")     bindQIdKey
+sequenceQName  = thFun (fsLit "sequenceQ") sequenceQIdKey
+newNameName    = thFun (fsLit "newName")   newNameIdKey
+liftName       = thFun (fsLit "lift")      liftIdKey
+liftStringName = thFun (fsLit "liftString")  liftStringIdKey
+mkNameName     = thFun (fsLit "mkName")     mkNameIdKey
+mkNameG_vName  = thFun (fsLit "mkNameG_v")  mkNameG_vIdKey
+mkNameG_dName  = thFun (fsLit "mkNameG_d")  mkNameG_dIdKey
+mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
+mkNameLName    = thFun (fsLit "mkNameL")    mkNameLIdKey
+unTypeName     = thFun (fsLit "unType")     unTypeIdKey
+unTypeQName    = thFun (fsLit "unTypeQ")    unTypeQIdKey
+unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey
+
+
+-------------------- TH.Lib -----------------------
+-- data Lit = ...
+charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
+    floatPrimLName, doublePrimLName, rationalLName :: Name
+charLName       = libFun (fsLit "charL")       charLIdKey
+stringLName     = libFun (fsLit "stringL")     stringLIdKey
+integerLName    = libFun (fsLit "integerL")    integerLIdKey
+intPrimLName    = libFun (fsLit "intPrimL")    intPrimLIdKey
+wordPrimLName   = libFun (fsLit "wordPrimL")   wordPrimLIdKey
+floatPrimLName  = libFun (fsLit "floatPrimL")  floatPrimLIdKey
+doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey
+rationalLName   = libFun (fsLit "rationalL")     rationalLIdKey
+
+-- data Pat = ...
+litPName, varPName, tupPName, unboxedTupPName, conPName, infixPName, tildePName, bangPName,
+    asPName, wildPName, recPName, listPName, sigPName, viewPName :: Name
+litPName   = libFun (fsLit "litP")   litPIdKey
+varPName   = libFun (fsLit "varP")   varPIdKey
+tupPName   = libFun (fsLit "tupP")   tupPIdKey
+unboxedTupPName = libFun (fsLit "unboxedTupP") unboxedTupPIdKey
+conPName   = libFun (fsLit "conP")   conPIdKey
+infixPName = libFun (fsLit "infixP") infixPIdKey
+tildePName = libFun (fsLit "tildeP") tildePIdKey
+bangPName  = libFun (fsLit "bangP")  bangPIdKey
+asPName    = libFun (fsLit "asP")    asPIdKey
+wildPName  = libFun (fsLit "wildP")  wildPIdKey
+recPName   = libFun (fsLit "recP")   recPIdKey
+listPName  = libFun (fsLit "listP")  listPIdKey
+sigPName   = libFun (fsLit "sigP")   sigPIdKey
+viewPName  = libFun (fsLit "viewP")  viewPIdKey
+
+-- type FieldPat = ...
+fieldPatName :: Name
+fieldPatName = libFun (fsLit "fieldPat") fieldPatIdKey
+
+-- data Match = ...
+matchName :: Name
+matchName = libFun (fsLit "match") matchIdKey
+
+-- data Clause = ...
+clauseName :: Name
+clauseName = libFun (fsLit "clause") clauseIdKey
+
+-- data Exp = ...
+varEName, conEName, litEName, appEName, infixEName, infixAppName,
+    sectionLName, sectionRName, lamEName, lamCaseEName, tupEName,
+    unboxedTupEName, condEName, multiIfEName, letEName, caseEName,
+    doEName, compEName, staticEName :: Name
+varEName        = libFun (fsLit "varE")        varEIdKey
+conEName        = libFun (fsLit "conE")        conEIdKey
+litEName        = libFun (fsLit "litE")        litEIdKey
+appEName        = libFun (fsLit "appE")        appEIdKey
+infixEName      = libFun (fsLit "infixE")      infixEIdKey
+infixAppName    = libFun (fsLit "infixApp")    infixAppIdKey
+sectionLName    = libFun (fsLit "sectionL")    sectionLIdKey
+sectionRName    = libFun (fsLit "sectionR")    sectionRIdKey
+lamEName        = libFun (fsLit "lamE")        lamEIdKey
+lamCaseEName    = libFun (fsLit "lamCaseE")    lamCaseEIdKey
+tupEName        = libFun (fsLit "tupE")        tupEIdKey
+unboxedTupEName = libFun (fsLit "unboxedTupE") unboxedTupEIdKey
+condEName       = libFun (fsLit "condE")       condEIdKey
+multiIfEName    = libFun (fsLit "multiIfE")    multiIfEIdKey
+letEName        = libFun (fsLit "letE")        letEIdKey
+caseEName       = libFun (fsLit "caseE")       caseEIdKey
+doEName         = libFun (fsLit "doE")         doEIdKey
+compEName       = libFun (fsLit "compE")       compEIdKey
+-- ArithSeq skips a level
+fromEName, fromThenEName, fromToEName, fromThenToEName :: Name
+fromEName       = libFun (fsLit "fromE")       fromEIdKey
+fromThenEName   = libFun (fsLit "fromThenE")   fromThenEIdKey
+fromToEName     = libFun (fsLit "fromToE")     fromToEIdKey
+fromThenToEName = libFun (fsLit "fromThenToE") fromThenToEIdKey
+-- end ArithSeq
+listEName, sigEName, recConEName, recUpdEName :: Name
+listEName       = libFun (fsLit "listE")       listEIdKey
+sigEName        = libFun (fsLit "sigE")        sigEIdKey
+recConEName     = libFun (fsLit "recConE")     recConEIdKey
+recUpdEName     = libFun (fsLit "recUpdE")     recUpdEIdKey
+staticEName     = libFun (fsLit "staticE")     staticEIdKey
+
+-- type FieldExp = ...
+fieldExpName :: Name
+fieldExpName = libFun (fsLit "fieldExp") fieldExpIdKey
+
+-- data Body = ...
+guardedBName, normalBName :: Name
+guardedBName = libFun (fsLit "guardedB") guardedBIdKey
+normalBName  = libFun (fsLit "normalB")  normalBIdKey
+
+-- data Guard = ...
+normalGEName, patGEName :: Name
+normalGEName = libFun (fsLit "normalGE") normalGEIdKey
+patGEName    = libFun (fsLit "patGE")    patGEIdKey
+
+-- data Stmt = ...
+bindSName, letSName, noBindSName, parSName :: Name
+bindSName   = libFun (fsLit "bindS")   bindSIdKey
+letSName    = libFun (fsLit "letS")    letSIdKey
+noBindSName = libFun (fsLit "noBindS") noBindSIdKey
+parSName    = libFun (fsLit "parS")    parSIdKey
+
+-- data Dec = ...
+funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
+    instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
+    pragSpecInlDName, pragSpecInstDName, pragRuleDName, pragAnnDName,
+    familyNoKindDName, standaloneDerivDName, defaultSigDName,
+    familyKindDName, dataInstDName, newtypeInstDName, tySynInstDName,
+    closedTypeFamilyKindDName, closedTypeFamilyNoKindDName,
+    infixLDName, infixRDName, infixNDName, roleAnnotDName :: Name
+funDName          = libFun (fsLit "funD")          funDIdKey
+valDName          = libFun (fsLit "valD")          valDIdKey
+dataDName         = libFun (fsLit "dataD")         dataDIdKey
+newtypeDName      = libFun (fsLit "newtypeD")      newtypeDIdKey
+tySynDName        = libFun (fsLit "tySynD")        tySynDIdKey
+classDName        = libFun (fsLit "classD")        classDIdKey
+instanceDName     = libFun (fsLit "instanceD")     instanceDIdKey
+standaloneDerivDName
+                  = libFun (fsLit "standaloneDerivD") standaloneDerivDIdKey
+sigDName          = libFun (fsLit "sigD")          sigDIdKey
+defaultSigDName   = libFun (fsLit "defaultSigD")   defaultSigDIdKey
+forImpDName       = libFun (fsLit "forImpD")       forImpDIdKey
+pragInlDName      = libFun (fsLit "pragInlD")      pragInlDIdKey
+pragSpecDName     = libFun (fsLit "pragSpecD")     pragSpecDIdKey
+pragSpecInlDName  = libFun (fsLit "pragSpecInlD")  pragSpecInlDIdKey
+pragSpecInstDName = libFun (fsLit "pragSpecInstD") pragSpecInstDIdKey
+pragRuleDName     = libFun (fsLit "pragRuleD")     pragRuleDIdKey
+pragAnnDName      = libFun (fsLit "pragAnnD")      pragAnnDIdKey
+familyNoKindDName = libFun (fsLit "familyNoKindD") familyNoKindDIdKey
+familyKindDName   = libFun (fsLit "familyKindD")   familyKindDIdKey
+dataInstDName     = libFun (fsLit "dataInstD")     dataInstDIdKey
+newtypeInstDName  = libFun (fsLit "newtypeInstD")  newtypeInstDIdKey
+tySynInstDName    = libFun (fsLit "tySynInstD")    tySynInstDIdKey
+closedTypeFamilyKindDName
+                  = libFun (fsLit "closedTypeFamilyKindD") closedTypeFamilyKindDIdKey
+closedTypeFamilyNoKindDName
+                  = libFun (fsLit "closedTypeFamilyNoKindD") closedTypeFamilyNoKindDIdKey
+infixLDName       = libFun (fsLit "infixLD")       infixLDIdKey
+infixRDName       = libFun (fsLit "infixRD")       infixRDIdKey
+infixNDName       = libFun (fsLit "infixND")       infixNDIdKey
+roleAnnotDName    = libFun (fsLit "roleAnnotD")    roleAnnotDIdKey
+
+-- type Ctxt = ...
+cxtName :: Name
+cxtName = libFun (fsLit "cxt") cxtIdKey
+
+-- data Strict = ...
+isStrictName, notStrictName, unpackedName :: Name
+isStrictName      = libFun  (fsLit "isStrict")      isStrictKey
+notStrictName     = libFun  (fsLit "notStrict")     notStrictKey
+unpackedName      = libFun  (fsLit "unpacked")      unpackedKey
+
+-- data Con = ...
+normalCName, recCName, infixCName, forallCName :: Name
+normalCName = libFun (fsLit "normalC") normalCIdKey
+recCName    = libFun (fsLit "recC")    recCIdKey
+infixCName  = libFun (fsLit "infixC")  infixCIdKey
+forallCName  = libFun (fsLit "forallC")  forallCIdKey
+
+-- type StrictType = ...
+strictTypeName :: Name
+strictTypeName    = libFun  (fsLit "strictType")    strictTKey
+
+-- type VarStrictType = ...
+varStrictTypeName :: Name
+varStrictTypeName = libFun  (fsLit "varStrictType") varStrictTKey
+
+-- data Type = ...
+forallTName, varTName, conTName, tupleTName, unboxedTupleTName, arrowTName,
+    listTName, appTName, sigTName, equalityTName, litTName,
+    promotedTName, promotedTupleTName,
+    promotedNilTName, promotedConsTName :: Name
+forallTName         = libFun (fsLit "forallT")        forallTIdKey
+varTName            = libFun (fsLit "varT")           varTIdKey
+conTName            = libFun (fsLit "conT")           conTIdKey
+tupleTName          = libFun (fsLit "tupleT")         tupleTIdKey
+unboxedTupleTName   = libFun (fsLit "unboxedTupleT")  unboxedTupleTIdKey
+arrowTName          = libFun (fsLit "arrowT")         arrowTIdKey
+listTName           = libFun (fsLit "listT")          listTIdKey
+appTName            = libFun (fsLit "appT")           appTIdKey
+sigTName            = libFun (fsLit "sigT")           sigTIdKey
+equalityTName       = libFun (fsLit "equalityT")      equalityTIdKey
+litTName            = libFun (fsLit "litT")           litTIdKey
+promotedTName       = libFun (fsLit "promotedT")      promotedTIdKey
+promotedTupleTName  = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
+promotedNilTName    = libFun (fsLit "promotedNilT")   promotedNilTIdKey
+promotedConsTName   = libFun (fsLit "promotedConsT")  promotedConsTIdKey
+
+-- data TyLit = ...
+numTyLitName, strTyLitName :: Name
+numTyLitName = libFun (fsLit "numTyLit") numTyLitIdKey
+strTyLitName = libFun (fsLit "strTyLit") strTyLitIdKey
+
+-- data TyVarBndr = ...
+plainTVName, kindedTVName :: Name
+plainTVName       = libFun (fsLit "plainTV")       plainTVIdKey
+kindedTVName      = libFun (fsLit "kindedTV")      kindedTVIdKey
+
+-- data Role = ...
+nominalRName, representationalRName, phantomRName, inferRName :: Name
+nominalRName          = libFun (fsLit "nominalR")          nominalRIdKey
+representationalRName = libFun (fsLit "representationalR") representationalRIdKey
+phantomRName          = libFun (fsLit "phantomR")          phantomRIdKey
+inferRName            = libFun (fsLit "inferR")            inferRIdKey
+
+-- data Kind = ...
+varKName, conKName, tupleKName, arrowKName, listKName, appKName,
+  starKName, constraintKName :: Name
+varKName        = libFun (fsLit "varK")         varKIdKey
+conKName        = libFun (fsLit "conK")         conKIdKey
+tupleKName      = libFun (fsLit "tupleK")       tupleKIdKey
+arrowKName      = libFun (fsLit "arrowK")       arrowKIdKey
+listKName       = libFun (fsLit "listK")        listKIdKey
+appKName        = libFun (fsLit "appK")         appKIdKey
+starKName       = libFun (fsLit "starK")        starKIdKey
+constraintKName = libFun (fsLit "constraintK")  constraintKIdKey
+
+-- data Callconv = ...
+cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName :: Name
+cCallName = libFun (fsLit "cCall") cCallIdKey
+stdCallName = libFun (fsLit "stdCall") stdCallIdKey
+cApiCallName = libFun (fsLit "cApi") cApiCallIdKey
+primCallName = libFun (fsLit "prim") primCallIdKey
+javaScriptCallName = libFun (fsLit "javaScript") javaScriptCallIdKey
+
+-- data Safety = ...
+unsafeName, safeName, interruptibleName :: Name
+unsafeName     = libFun (fsLit "unsafe") unsafeIdKey
+safeName       = libFun (fsLit "safe") safeIdKey
+interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
+
+-- data Inline = ...
+noInlineDataConName, inlineDataConName, inlinableDataConName :: Name
+noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
+inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
+inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
+
+-- data RuleMatch = ...
+conLikeDataConName, funLikeDataConName :: Name
+conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
+funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
+
+-- data Phases = ...
+allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name
+allPhasesDataConName   = thCon (fsLit "AllPhases")   allPhasesDataConKey
+fromPhaseDataConName   = thCon (fsLit "FromPhase")   fromPhaseDataConKey
+beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
+
+-- newtype TExp a = ...
+tExpDataConName :: Name
+tExpDataConName = thCon (fsLit "TExp") tExpDataConKey
+
+-- data RuleBndr = ...
+ruleVarName, typedRuleVarName :: Name
+ruleVarName      = libFun (fsLit ("ruleVar"))      ruleVarIdKey
+typedRuleVarName = libFun (fsLit ("typedRuleVar")) typedRuleVarIdKey
+
+-- data FunDep = ...
+funDepName :: Name
+funDepName     = libFun (fsLit "funDep") funDepIdKey
+
+-- data FamFlavour = ...
+typeFamName, dataFamName :: Name
+typeFamName = libFun (fsLit "typeFam") typeFamIdKey
+dataFamName = libFun (fsLit "dataFam") dataFamIdKey
+
+-- data TySynEqn = ...
+tySynEqnName :: Name
+tySynEqnName = libFun (fsLit "tySynEqn") tySynEqnIdKey
+
+-- data AnnTarget = ...
+valueAnnotationName, typeAnnotationName, moduleAnnotationName :: Name
+valueAnnotationName  = libFun (fsLit "valueAnnotation")  valueAnnotationIdKey
+typeAnnotationName   = libFun (fsLit "typeAnnotation")   typeAnnotationIdKey
+moduleAnnotationName = libFun (fsLit "moduleAnnotation") moduleAnnotationIdKey
+
+matchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,
+    decQTyConName, conQTyConName, strictTypeQTyConName,
+    varStrictTypeQTyConName, typeQTyConName, fieldExpQTyConName,
+    patQTyConName, fieldPatQTyConName, predQTyConName, decsQTyConName,
+    ruleBndrQTyConName, tySynEqnQTyConName, roleTyConName :: Name
+matchQTyConName         = libTc (fsLit "MatchQ")         matchQTyConKey
+clauseQTyConName        = libTc (fsLit "ClauseQ")        clauseQTyConKey
+expQTyConName           = libTc (fsLit "ExpQ")           expQTyConKey
+stmtQTyConName          = libTc (fsLit "StmtQ")          stmtQTyConKey
+decQTyConName           = libTc (fsLit "DecQ")           decQTyConKey
+decsQTyConName          = libTc (fsLit "DecsQ")          decsQTyConKey  -- Q [Dec]
+conQTyConName           = libTc (fsLit "ConQ")           conQTyConKey
+strictTypeQTyConName    = libTc (fsLit "StrictTypeQ")    strictTypeQTyConKey
+varStrictTypeQTyConName = libTc (fsLit "VarStrictTypeQ") varStrictTypeQTyConKey
+typeQTyConName          = libTc (fsLit "TypeQ")          typeQTyConKey
+fieldExpQTyConName      = libTc (fsLit "FieldExpQ")      fieldExpQTyConKey
+patQTyConName           = libTc (fsLit "PatQ")           patQTyConKey
+fieldPatQTyConName      = libTc (fsLit "FieldPatQ")      fieldPatQTyConKey
+predQTyConName          = libTc (fsLit "PredQ")          predQTyConKey
+ruleBndrQTyConName      = libTc (fsLit "RuleBndrQ")      ruleBndrQTyConKey
+tySynEqnQTyConName      = libTc (fsLit "TySynEqnQ")      tySynEqnQTyConKey
+roleTyConName           = libTc (fsLit "Role")           roleTyConKey
+
+-- quasiquoting
+quoteExpName, quotePatName, quoteDecName, quoteTypeName :: Name
+quoteExpName        = qqFun (fsLit "quoteExp")  quoteExpKey
+quotePatName        = qqFun (fsLit "quotePat")  quotePatKey
+quoteDecName        = qqFun (fsLit "quoteDec")  quoteDecKey
+quoteTypeName       = qqFun (fsLit "quoteType") quoteTypeKey
+
+-- TyConUniques available: 200-299
+-- Check in PrelNames if you want to change this
+
+expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
+    decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,
+    stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey, tyVarBndrTyConKey,
+    decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
+    fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
+    fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
+    predQTyConKey, decsQTyConKey, ruleBndrQTyConKey, tySynEqnQTyConKey,
+    roleTyConKey, tExpTyConKey :: Unique
+expTyConKey             = mkPreludeTyConUnique 200
+matchTyConKey           = mkPreludeTyConUnique 201
+clauseTyConKey          = mkPreludeTyConUnique 202
+qTyConKey               = mkPreludeTyConUnique 203
+expQTyConKey            = mkPreludeTyConUnique 204
+decQTyConKey            = mkPreludeTyConUnique 205
+patTyConKey             = mkPreludeTyConUnique 206
+matchQTyConKey          = mkPreludeTyConUnique 207
+clauseQTyConKey         = mkPreludeTyConUnique 208
+stmtQTyConKey           = mkPreludeTyConUnique 209
+conQTyConKey            = mkPreludeTyConUnique 210
+typeQTyConKey           = mkPreludeTyConUnique 211
+typeTyConKey            = mkPreludeTyConUnique 212
+decTyConKey             = mkPreludeTyConUnique 213
+varStrictTypeQTyConKey  = mkPreludeTyConUnique 214
+strictTypeQTyConKey     = mkPreludeTyConUnique 215
+fieldExpTyConKey        = mkPreludeTyConUnique 216
+fieldPatTyConKey        = mkPreludeTyConUnique 217
+nameTyConKey            = mkPreludeTyConUnique 218
+patQTyConKey            = mkPreludeTyConUnique 219
+fieldPatQTyConKey       = mkPreludeTyConUnique 220
+fieldExpQTyConKey       = mkPreludeTyConUnique 221
+funDepTyConKey          = mkPreludeTyConUnique 222
+predTyConKey            = mkPreludeTyConUnique 223
+predQTyConKey           = mkPreludeTyConUnique 224
+tyVarBndrTyConKey       = mkPreludeTyConUnique 225
+decsQTyConKey           = mkPreludeTyConUnique 226
+ruleBndrQTyConKey       = mkPreludeTyConUnique 227
+tySynEqnQTyConKey       = mkPreludeTyConUnique 228
+roleTyConKey            = mkPreludeTyConUnique 229
+tExpTyConKey            = mkPreludeTyConUnique 230
+
+-- IdUniques available: 200-499
+-- If you want to change this, make sure you check in PrelNames
+
+returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
+    mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
+    mkNameLIdKey, unTypeIdKey, unTypeQIdKey, unsafeTExpCoerceIdKey :: Unique
+returnQIdKey        = mkPreludeMiscIdUnique 200
+bindQIdKey          = mkPreludeMiscIdUnique 201
+sequenceQIdKey      = mkPreludeMiscIdUnique 202
+liftIdKey           = mkPreludeMiscIdUnique 203
+newNameIdKey         = mkPreludeMiscIdUnique 204
+mkNameIdKey          = mkPreludeMiscIdUnique 205
+mkNameG_vIdKey       = mkPreludeMiscIdUnique 206
+mkNameG_dIdKey       = mkPreludeMiscIdUnique 207
+mkNameG_tcIdKey      = mkPreludeMiscIdUnique 208
+mkNameLIdKey         = mkPreludeMiscIdUnique 209
+unTypeIdKey          = mkPreludeMiscIdUnique 210
+unTypeQIdKey         = mkPreludeMiscIdUnique 211
+unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 212
+
+
+-- data Lit = ...
+charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey,
+    floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey :: Unique
+charLIdKey        = mkPreludeMiscIdUnique 220
+stringLIdKey      = mkPreludeMiscIdUnique 221
+integerLIdKey     = mkPreludeMiscIdUnique 222
+intPrimLIdKey     = mkPreludeMiscIdUnique 223
+wordPrimLIdKey    = mkPreludeMiscIdUnique 224
+floatPrimLIdKey   = mkPreludeMiscIdUnique 225
+doublePrimLIdKey  = mkPreludeMiscIdUnique 226
+rationalLIdKey    = mkPreludeMiscIdUnique 227
+
+liftStringIdKey :: Unique
+liftStringIdKey     = mkPreludeMiscIdUnique 228
+
+-- data Pat = ...
+litPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, bangPIdKey,
+    asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey, viewPIdKey :: Unique
+litPIdKey         = mkPreludeMiscIdUnique 240
+varPIdKey         = mkPreludeMiscIdUnique 241
+tupPIdKey         = mkPreludeMiscIdUnique 242
+unboxedTupPIdKey  = mkPreludeMiscIdUnique 243
+conPIdKey         = mkPreludeMiscIdUnique 244
+infixPIdKey       = mkPreludeMiscIdUnique 245
+tildePIdKey       = mkPreludeMiscIdUnique 246
+bangPIdKey        = mkPreludeMiscIdUnique 247
+asPIdKey          = mkPreludeMiscIdUnique 248
+wildPIdKey        = mkPreludeMiscIdUnique 249
+recPIdKey         = mkPreludeMiscIdUnique 250
+listPIdKey        = mkPreludeMiscIdUnique 251
+sigPIdKey         = mkPreludeMiscIdUnique 252
+viewPIdKey        = mkPreludeMiscIdUnique 253
+
+-- type FieldPat = ...
+fieldPatIdKey :: Unique
+fieldPatIdKey       = mkPreludeMiscIdUnique 260
+
+-- data Match = ...
+matchIdKey :: Unique
+matchIdKey          = mkPreludeMiscIdUnique 261
+
+-- data Clause = ...
+clauseIdKey :: Unique
+clauseIdKey         = mkPreludeMiscIdUnique 262
+
+
+-- data Exp = ...
+varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
+    sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey, tupEIdKey,
+    unboxedTupEIdKey, condEIdKey, multiIfEIdKey,
+    letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
+    fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
+    listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey :: Unique
+varEIdKey         = mkPreludeMiscIdUnique 270
+conEIdKey         = mkPreludeMiscIdUnique 271
+litEIdKey         = mkPreludeMiscIdUnique 272
+appEIdKey         = mkPreludeMiscIdUnique 273
+infixEIdKey       = mkPreludeMiscIdUnique 274
+infixAppIdKey     = mkPreludeMiscIdUnique 275
+sectionLIdKey     = mkPreludeMiscIdUnique 276
+sectionRIdKey     = mkPreludeMiscIdUnique 277
+lamEIdKey         = mkPreludeMiscIdUnique 278
+lamCaseEIdKey     = mkPreludeMiscIdUnique 279
+tupEIdKey         = mkPreludeMiscIdUnique 280
+unboxedTupEIdKey  = mkPreludeMiscIdUnique 281
+condEIdKey        = mkPreludeMiscIdUnique 282
+multiIfEIdKey     = mkPreludeMiscIdUnique 283
+letEIdKey         = mkPreludeMiscIdUnique 284
+caseEIdKey        = mkPreludeMiscIdUnique 285
+doEIdKey          = mkPreludeMiscIdUnique 286
+compEIdKey        = mkPreludeMiscIdUnique 287
+fromEIdKey        = mkPreludeMiscIdUnique 288
+fromThenEIdKey    = mkPreludeMiscIdUnique 289
+fromToEIdKey      = mkPreludeMiscIdUnique 290
+fromThenToEIdKey  = mkPreludeMiscIdUnique 291
+listEIdKey        = mkPreludeMiscIdUnique 292
+sigEIdKey         = mkPreludeMiscIdUnique 293
+recConEIdKey      = mkPreludeMiscIdUnique 294
+recUpdEIdKey      = mkPreludeMiscIdUnique 295
+staticEIdKey      = mkPreludeMiscIdUnique 296
+
+-- type FieldExp = ...
+fieldExpIdKey :: Unique
+fieldExpIdKey       = mkPreludeMiscIdUnique 310
+
+-- data Body = ...
+guardedBIdKey, normalBIdKey :: Unique
+guardedBIdKey     = mkPreludeMiscIdUnique 311
+normalBIdKey      = mkPreludeMiscIdUnique 312
+
+-- data Guard = ...
+normalGEIdKey, patGEIdKey :: Unique
+normalGEIdKey     = mkPreludeMiscIdUnique 313
+patGEIdKey        = mkPreludeMiscIdUnique 314
+
+-- data Stmt = ...
+bindSIdKey, letSIdKey, noBindSIdKey, parSIdKey :: Unique
+bindSIdKey       = mkPreludeMiscIdUnique 320
+letSIdKey        = mkPreludeMiscIdUnique 321
+noBindSIdKey     = mkPreludeMiscIdUnique 322
+parSIdKey        = mkPreludeMiscIdUnique 323
+
+-- data Dec = ...
+funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
+    classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,
+    pragSpecDIdKey, pragSpecInlDIdKey, pragSpecInstDIdKey, pragRuleDIdKey,
+    pragAnnDIdKey, familyNoKindDIdKey, familyKindDIdKey, defaultSigDIdKey,
+    dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivDIdKey,
+    closedTypeFamilyKindDIdKey, closedTypeFamilyNoKindDIdKey,
+    infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey :: Unique
+funDIdKey                    = mkPreludeMiscIdUnique 330
+valDIdKey                    = mkPreludeMiscIdUnique 331
+dataDIdKey                   = mkPreludeMiscIdUnique 332
+newtypeDIdKey                = mkPreludeMiscIdUnique 333
+tySynDIdKey                  = mkPreludeMiscIdUnique 334
+classDIdKey                  = mkPreludeMiscIdUnique 335
+instanceDIdKey               = mkPreludeMiscIdUnique 336
+sigDIdKey                    = mkPreludeMiscIdUnique 337
+forImpDIdKey                 = mkPreludeMiscIdUnique 338
+pragInlDIdKey                = mkPreludeMiscIdUnique 339
+pragSpecDIdKey               = mkPreludeMiscIdUnique 340
+pragSpecInlDIdKey            = mkPreludeMiscIdUnique 341
+pragSpecInstDIdKey           = mkPreludeMiscIdUnique 342
+pragRuleDIdKey               = mkPreludeMiscIdUnique 343
+pragAnnDIdKey                = mkPreludeMiscIdUnique 344
+familyNoKindDIdKey           = mkPreludeMiscIdUnique 345
+familyKindDIdKey             = mkPreludeMiscIdUnique 346
+dataInstDIdKey               = mkPreludeMiscIdUnique 347
+newtypeInstDIdKey            = mkPreludeMiscIdUnique 348
+tySynInstDIdKey              = mkPreludeMiscIdUnique 349
+closedTypeFamilyKindDIdKey   = mkPreludeMiscIdUnique 350
+closedTypeFamilyNoKindDIdKey = mkPreludeMiscIdUnique 351
+infixLDIdKey                 = mkPreludeMiscIdUnique 352
+infixRDIdKey                 = mkPreludeMiscIdUnique 353
+infixNDIdKey                 = mkPreludeMiscIdUnique 354
+roleAnnotDIdKey              = mkPreludeMiscIdUnique 355
+standaloneDerivDIdKey        = mkPreludeMiscIdUnique 356
+defaultSigDIdKey             = mkPreludeMiscIdUnique 357
+
+-- type Cxt = ...
+cxtIdKey :: Unique
+cxtIdKey            = mkPreludeMiscIdUnique 360
+
+-- data Strict = ...
+isStrictKey, notStrictKey, unpackedKey :: Unique
+isStrictKey         = mkPreludeMiscIdUnique 363
+notStrictKey        = mkPreludeMiscIdUnique 364
+unpackedKey         = mkPreludeMiscIdUnique 365
+
+-- data Con = ...
+normalCIdKey, recCIdKey, infixCIdKey, forallCIdKey :: Unique
+normalCIdKey      = mkPreludeMiscIdUnique 370
+recCIdKey         = mkPreludeMiscIdUnique 371
+infixCIdKey       = mkPreludeMiscIdUnique 372
+forallCIdKey      = mkPreludeMiscIdUnique 373
+
+-- type StrictType = ...
+strictTKey :: Unique
+strictTKey        = mkPreludeMiscIdUnique 374
+
+-- type VarStrictType = ...
+varStrictTKey :: Unique
+varStrictTKey     = mkPreludeMiscIdUnique 375
+
+-- data Type = ...
+forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey, arrowTIdKey,
+    listTIdKey, appTIdKey, sigTIdKey, equalityTIdKey, litTIdKey,
+    promotedTIdKey, promotedTupleTIdKey,
+    promotedNilTIdKey, promotedConsTIdKey :: Unique
+forallTIdKey        = mkPreludeMiscIdUnique 380
+varTIdKey           = mkPreludeMiscIdUnique 381
+conTIdKey           = mkPreludeMiscIdUnique 382
+tupleTIdKey         = mkPreludeMiscIdUnique 383
+unboxedTupleTIdKey  = mkPreludeMiscIdUnique 384
+arrowTIdKey         = mkPreludeMiscIdUnique 385
+listTIdKey          = mkPreludeMiscIdUnique 386
+appTIdKey           = mkPreludeMiscIdUnique 387
+sigTIdKey           = mkPreludeMiscIdUnique 388
+equalityTIdKey      = mkPreludeMiscIdUnique 389
+litTIdKey           = mkPreludeMiscIdUnique 390
+promotedTIdKey      = mkPreludeMiscIdUnique 391
+promotedTupleTIdKey = mkPreludeMiscIdUnique 392
+promotedNilTIdKey   = mkPreludeMiscIdUnique 393
+promotedConsTIdKey  = mkPreludeMiscIdUnique 394
+
+-- data TyLit = ...
+numTyLitIdKey, strTyLitIdKey :: Unique
+numTyLitIdKey = mkPreludeMiscIdUnique 395
+strTyLitIdKey = mkPreludeMiscIdUnique 396
+
+-- data TyVarBndr = ...
+plainTVIdKey, kindedTVIdKey :: Unique
+plainTVIdKey       = mkPreludeMiscIdUnique 397
+kindedTVIdKey      = mkPreludeMiscIdUnique 398
+
+-- data Role = ...
+nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
+nominalRIdKey          = mkPreludeMiscIdUnique 400
+representationalRIdKey = mkPreludeMiscIdUnique 401
+phantomRIdKey          = mkPreludeMiscIdUnique 402
+inferRIdKey            = mkPreludeMiscIdUnique 403
+
+-- data Kind = ...
+varKIdKey, conKIdKey, tupleKIdKey, arrowKIdKey, listKIdKey, appKIdKey,
+  starKIdKey, constraintKIdKey :: Unique
+varKIdKey         = mkPreludeMiscIdUnique 404
+conKIdKey         = mkPreludeMiscIdUnique 405
+tupleKIdKey       = mkPreludeMiscIdUnique 406
+arrowKIdKey       = mkPreludeMiscIdUnique 407
+listKIdKey        = mkPreludeMiscIdUnique 408
+appKIdKey         = mkPreludeMiscIdUnique 409
+starKIdKey        = mkPreludeMiscIdUnique 410
+constraintKIdKey  = mkPreludeMiscIdUnique 411
+
+-- data Callconv = ...
+cCallIdKey, stdCallIdKey, cApiCallIdKey, primCallIdKey,
+  javaScriptCallIdKey :: Unique
+cCallIdKey          = mkPreludeMiscIdUnique 420
+stdCallIdKey        = mkPreludeMiscIdUnique 421
+cApiCallIdKey       = mkPreludeMiscIdUnique 422
+primCallIdKey       = mkPreludeMiscIdUnique 423
+javaScriptCallIdKey = mkPreludeMiscIdUnique 424
+
+-- data Safety = ...
+unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique
+unsafeIdKey        = mkPreludeMiscIdUnique 430
+safeIdKey          = mkPreludeMiscIdUnique 431
+interruptibleIdKey = mkPreludeMiscIdUnique 432
+
+-- data Inline = ...
+noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
+noInlineDataConKey  = mkPreludeDataConUnique 40
+inlineDataConKey    = mkPreludeDataConUnique 41
+inlinableDataConKey = mkPreludeDataConUnique 42
+
+-- data RuleMatch = ...
+conLikeDataConKey, funLikeDataConKey :: Unique
+conLikeDataConKey = mkPreludeDataConUnique 43
+funLikeDataConKey = mkPreludeDataConUnique 44
+
+-- data Phases = ...
+allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
+allPhasesDataConKey   = mkPreludeDataConUnique 45
+fromPhaseDataConKey   = mkPreludeDataConUnique 46
+beforePhaseDataConKey = mkPreludeDataConUnique 47
+
+-- newtype TExp a = ...
+tExpDataConKey :: Unique
+tExpDataConKey = mkPreludeDataConUnique 48
+
+-- data FunDep = ...
+funDepIdKey :: Unique
+funDepIdKey = mkPreludeMiscIdUnique 440
+
+-- data FamFlavour = ...
+typeFamIdKey, dataFamIdKey :: Unique
+typeFamIdKey = mkPreludeMiscIdUnique 450
+dataFamIdKey = mkPreludeMiscIdUnique 451
+
+-- data TySynEqn = ...
+tySynEqnIdKey :: Unique
+tySynEqnIdKey = mkPreludeMiscIdUnique 460
+
+-- quasiquoting
+quoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique
+quoteExpKey  = mkPreludeMiscIdUnique 470
+quotePatKey  = mkPreludeMiscIdUnique 471
+quoteDecKey  = mkPreludeMiscIdUnique 472
+quoteTypeKey = mkPreludeMiscIdUnique 473
+
+-- data RuleBndr = ...
+ruleVarIdKey, typedRuleVarIdKey :: Unique
+ruleVarIdKey      = mkPreludeMiscIdUnique 480
+typedRuleVarIdKey = mkPreludeMiscIdUnique 481
+
+-- data AnnTarget = ...
+valueAnnotationIdKey, typeAnnotationIdKey, moduleAnnotationIdKey :: Unique
+valueAnnotationIdKey  = mkPreludeMiscIdUnique 490
+typeAnnotationIdKey   = mkPreludeMiscIdUnique 491
+moduleAnnotationIdKey = mkPreludeMiscIdUnique 492
index 6c2ffb7..34c1838 100644 (file)
@@ -43,21 +43,22 @@ module TysWiredIn (
         wordTyCon, wordDataCon, wordTyConName, wordTy,
 
         -- * List
-        listTyCon, nilDataCon, nilDataConName, consDataCon, consDataConName,
-        listTyCon_RDR, consDataCon_RDR, listTyConName,
+        listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
+        nilDataCon, nilDataConName, nilDataConKey,
+        consDataCon_RDR, consDataCon, consDataConName,
+
         mkListTy, mkPromotedListTy,
 
         -- * Tuples
         mkTupleTy, mkBoxedTupleTy,
-        tupleTyCon, tupleCon,
+        tupleTyCon, tupleDataCon, tupleTyConName,
         promotedTupleTyCon, promotedTupleDataCon,
-        unitTyCon, unitDataCon, unitDataConId, pairTyCon,
+        unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
+        pairTyCon,
         unboxedUnitTyCon, unboxedUnitDataCon,
         unboxedSingletonTyCon, unboxedSingletonDataCon,
         unboxedPairTyCon, unboxedPairDataCon,
-
-        -- * Unit
-        unitTy,
+        cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
 
         -- * Kinds
         typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,
@@ -84,7 +85,7 @@ import PrelNames
 import TysPrim
 
 -- others:
-import Constants        ( mAX_TUPLE_SIZE )
+import Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
 import Module           ( Module )
 import Type             ( mkTyConApp )
 import DataCon
@@ -95,11 +96,14 @@ import Class            ( Class, mkClass )
 import TypeRep
 import RdrName
 import Name
-import BasicTypes       ( TupleSort(..), tupleSortBoxity,
-                          Arity, RecFlag(..), Boxity(..) )
+import NameSet          ( NameSet, mkNameSet, elemNameSet )
+import BasicTypes       ( Arity, RecFlag(..), Boxity(..),
+                           TupleSort(..) )
 import ForeignCall
-import Unique           ( incrUnique, mkTupleTyConUnique,
-                          mkTupleDataConUnique, mkPArrDataConUnique )
+import Unique           ( incrUnique,
+                          mkTupleTyConUnique, mkTupleDataConUnique,
+                          mkCTupleTyConUnique, mkPArrDataConUnique )
+import SrcLoc           ( noSrcSpan )
 import Data.Array
 import FastString
 import Outputable
@@ -319,14 +323,39 @@ typeSymbolKind = TyConApp (promoteTyCon typeSymbolKindCon) []
 Note [How tuples work]  See also Note [Known-key names] in PrelNames
 ~~~~~~~~~~~~~~~~~~~~~~
 * There are three families of tuple TyCons and corresponding
-  DataCons, (boxed, unboxed, and constraint tuples), expressed by the
-  type BasicTypes.TupleSort.
-
-* DataCons (and workers etc) for BoxedTuple and ConstraintTuple have
-    - distinct Uniques
-    - the same OccName
-  Using the same OccName means (hack!) that a single copy of the
-  runtime library code (info tables etc) works for both.
+  DataCons, expressed by the type BasicTypes.TupleSort:
+    data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple
+
+* All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon
+
+* BoxedTuples
+    - A wired-in type
+    - Data type declarations in GHC.Tuple
+    - The data constructors really have an info table
+
+* UnboxedTuples
+    - A wired-in type
+    - Have a pretend DataCon, defined in GHC.Prim,
+      but no actual declaration and no info table
+
+* ConstraintTuples
+    - Are known-key rather than wired-in. Reason: it's awkward to
+      have all the superclass selectors wired-in.
+    - Declared as classes in GHC.Classes, e.g.
+         class (c1,c2) => (c1,c2)
+    - Given constraints: the superclasses automatically become available
+    - Wanted constraints: there is a built-in instance
+         instance (c1,c2) => (c1,c2)
+    - Currently just go up to 16; beyond that
+      you have to use manual nesting
+    - Their OccNames look like (%,,,%), so they can easily be
+      distinguished from term tuples.  But (following Haskell) we
+      pretty-print saturated constraint tuples with round parens; see
+      BasicTypes.tupleParens.
+
+* In quite a lot of places things are restrcted just to
+  BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish
+  E.g. tupleTyCon has a Boxity argument
 
 * When looking up an OccName in the original-name cache
   (IfaceEnv.lookupOrigNameCache), we spot the tuple OccName to make sure
@@ -340,140 +369,164 @@ isBuiltInOcc_maybe :: OccName -> Maybe Name
 -- map to wired-in Names with BuiltInSyntax
 isBuiltInOcc_maybe occ
   = case occNameString occ of
-        "[]"             -> choose_ns listTyCon nilDataCon
+        "[]"             -> choose_ns listTyConName nilDataConName
         ":"              -> Just consDataConName
         "[::]"           -> Just parrTyConName
-        "(##)"           -> choose_ns unboxedUnitTyCon unboxedUnitDataCon
-        "()"             -> choose_ns unitTyCon        unitDataCon
-        '(':'#':',':rest -> parse_tuple UnboxedTuple 2 rest
-        '(':',':rest     -> parse_tuple BoxedTuple   2 rest
+        "()"             -> tup_name Boxed      0
+        "(##)"           -> tup_name Unboxed    0
+        '(':',':rest     -> parse_tuple Boxed   2 rest
+        '(':'#':',':rest -> parse_tuple Unboxed 2 rest
         _other           -> Nothing
   where
     ns = occNameSpace occ
 
     parse_tuple sort n rest
       | (',' : rest2) <- rest   = parse_tuple sort (n+1) rest2
-      | tail_matches sort rest  = choose_ns (tupleTyCon sort n)
-                                            (tupleCon   sort n)
+      | tail_matches sort rest  = tup_name sort n
       | otherwise               = Nothing
 
-    tail_matches BoxedTuple   ")"  = True
-    tail_matches UnboxedTuple "#)" = True
-    tail_matches _            _    = False
+    tail_matches Boxed   ")" = True
+    tail_matches Unboxed "#)" = True
+    tail_matches _       _    = False
+
+    tup_name boxity arity
+      = choose_ns (getName (tupleTyCon   boxity arity))
+                  (getName (tupleDataCon boxity arity))
 
     choose_ns tc dc
-      | isTcClsNameSpace ns   = Just (getName tc)
-      | isDataConNameSpace ns = Just (getName dc)
-      | otherwise             = Just (getName (dataConWorkId dc))
+      | isTcClsNameSpace ns   = Just tc
+      | isDataConNameSpace ns = Just dc
+      | otherwise             = pprPanic "tup_name" (ppr occ)
 
-mkTupleOcc :: NameSpace -> TupleSort -> Arity -> OccName
+mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
 mkTupleOcc ns sort ar = mkOccName ns str
   where
     -- No need to cache these, the caching is done in mk_tuple
     str = case sort of
-                UnboxedTuple    -> '(' : '#' : commas ++ "#)"
-                BoxedTuple      -> '(' : commas ++ ")"
-                ConstraintTuple -> '(' : commas ++ ")"
+                Unboxed    -> '(' : '#' : commas ++ "#)"
+                Boxed      -> '(' : commas ++ ")"
+
+    commas = take (ar-1) (repeat ',')
 
+mkCTupleOcc :: NameSpace -> Arity -> OccName
+mkCTupleOcc ns ar = mkOccName ns str
+  where
+    str    = "(%" ++ commas ++ "%)"
     commas = take (ar-1) (repeat ',')
 
-    -- Cute hack: we reuse the standard tuple OccNames (and hence code)
-    -- for fact tuples, but give them different Uniques so they are not equal.
-    --
-    -- You might think that this will go wrong because isBuiltInOcc_maybe won't
-    -- be able to tell the difference between boxed tuples and constraint tuples. BUT:
-    --  1. Constraint tuples never occur directly in user code, so it doesn't matter
-    --     that we can't detect them in Orig OccNames originating from the user
-    --     programs (or those built by setRdrNameSpace used on an Exact tuple Name)
-    --  2. Interface files have a special representation for tuple *occurrences*
-    --     in IfaceTyCons, their workers (in IfaceSyn) and their DataCons (in case
-    --     alternatives). Thus we don't rely on the OccName to figure out what kind
-    --     of tuple an occurrence was trying to use in these situations.
-    --  3. We *don't* represent tuple data type declarations specially, so those
-    --     are still turned into wired-in names via isBuiltInOcc_maybe. But that's OK
-    --     because we don't actually need to declare constraint tuples thanks to this hack.
-    --
-    -- So basically any OccName like (,,) flowing to isBuiltInOcc_maybe will always
-    -- refer to the standard boxed tuple. Cool :-)
-
-
-tupleTyCon :: TupleSort -> Arity -> TyCon
+cTupleTyConName :: Arity -> Name
+cTupleTyConName arity
+  = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES
+                   (mkCTupleOcc tcName arity) noSrcSpan
+  -- The corresponding DataCon does not have a known-key name
+
+cTupleTyConNames :: [Name]
+cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])
+
+cTupleTyConNameSet :: NameSet
+cTupleTyConNameSet = mkNameSet cTupleTyConNames
+
+isCTupleTyConName :: Name -> Bool
+isCTupleTyConName n
+ = ASSERT2( isExternalName n, ppr n )
+   nameModule n == gHC_CLASSES
+   && n `elemNameSet` cTupleTyConNameSet
+
+tupleTyCon :: Boxity -> Arity -> TyCon
 tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)  -- Build one specially
-tupleTyCon BoxedTuple      i = fst (boxedTupleArr   ! i)
-tupleTyCon UnboxedTuple    i = fst (unboxedTupleArr ! i)
-tupleTyCon ConstraintTuple i = fst (factTupleArr    ! i)
+tupleTyCon Boxed   i = fst (boxedTupleArr   ! i)
+tupleTyCon Unboxed i = fst (unboxedTupleArr ! i)
+
+tupleTyConName :: TupleSort -> Arity -> Name
+tupleTyConName ConstraintTuple a = cTupleTyConName a
+tupleTyConName BoxedTuple      a = tyConName (tupleTyCon Boxed a)
+tupleTyConName UnboxedTuple    a = tyConName (tupleTyCon Unboxed a)
 
-promotedTupleTyCon :: TupleSort -> Arity -> TyCon
-promotedTupleTyCon sort i = promoteTyCon (tupleTyCon sort i)
+promotedTupleTyCon :: Boxity -> Arity -> TyCon
+promotedTupleTyCon boxity i = promoteTyCon (tupleTyCon boxity i)
 
-promotedTupleDataCon :: TupleSort -> Arity -> TyCon
-promotedTupleDataCon sort i = promoteDataCon (tupleCon sort i)
+promotedTupleDataCon :: Boxity -> Arity -> TyCon
+promotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i)
 
-tupleCon :: TupleSort -> Arity -> DataCon
-tupleCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i)    -- Build one specially
-tupleCon BoxedTuple   i = snd (boxedTupleArr   ! i)
-tupleCon UnboxedTuple i = snd (unboxedTupleArr ! i)
-tupleCon ConstraintTuple    i = snd (factTupleArr    ! i)
+tupleDataCon :: Boxity -> Arity -> DataCon
+tupleDataCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i)    -- Build one specially
+tupleDataCon Boxed   i = snd (boxedTupleArr   ! i)
+tupleDataCon Unboxed i = snd (unboxedTupleArr ! i)
 
-boxedTupleArr, unboxedTupleArr, factTupleArr :: Array Int (TyCon,DataCon)
-boxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple BoxedTuple      i | i <- [0..mAX_TUPLE_SIZE]]
-unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple UnboxedTuple    i | i <- [0..mAX_TUPLE_SIZE]]
-factTupleArr    = listArray (0,mAX_TUPLE_SIZE) [mk_tuple ConstraintTuple i | i <- [0..mAX_TUPLE_SIZE]]
+boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
+boxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed   i | i <- [0..mAX_TUPLE_SIZE]]
+unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]
 
-mk_tuple :: TupleSort -> Int -> (TyCon,DataCon)
-mk_tuple sort arity = (tycon, tuple_con)
+mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
+mk_tuple boxity arity = (tycon, tuple_con)
   where
-        tycon   = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con sort prom_tc
-        prom_tc = case sort of
-          BoxedTuple      -> Just (mkPromotedTyCon tycon (promoteKind tc_kind))
-          UnboxedTuple    -> Nothing
-          ConstraintTuple -> Nothing
-
-        modu    = mkTupleModule sort
-        tc_name = mkWiredInName modu (mkTupleOcc tcName sort arity) tc_uniq
+        tycon   = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con
+                               tup_sort
+                               prom_tc NoParentTyCon
+
+        tup_sort = case boxity of
+                      Boxed   -> BoxedTuple
+                      Unboxed -> UnboxedTuple
+
+        prom_tc = case boxity of
+                    Boxed   -> Just (mkPromotedTyCon tycon (promoteKind tc_kind))
+                    Unboxed -> Nothing
+
+        modu = case boxity of
+                    Boxed -> gHC_TUPLE
+                    Unboxed -> gHC_PRIM
+
+        tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
                                 (ATyCon tycon) BuiltInSyntax
         tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
-        res_kind = case sort of
-          BoxedTuple      -> liftedTypeKind
-          UnboxedTuple    -> unliftedTypeKind
-          ConstraintTuple -> constraintKind
 
-        tyvars = take arity $ case sort of
-          BoxedTuple      -> alphaTyVars
-          UnboxedTuple    -> openAlphaTyVars
-          ConstraintTuple -> tyVarList constraintKind
+        res_kind = case boxity of
+                     Boxed   -> liftedTypeKind
+                     Unboxed -> unliftedTypeKind
+
+        tyvars = take arity $ case boxity of
+                   Boxed   -> alphaTyVars
+                   Unboxed -> openAlphaTyVars
 
         tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
         tyvar_tys = mkTyVarTys tyvars
-        dc_name   = mkWiredInName modu (mkTupleOcc dataName sort arity) dc_uniq
+        dc_name   = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
                                   (AConLike (RealDataCon tuple_con)) BuiltInSyntax
-        tc_uniq   = mkTupleTyConUnique   sort arity
-        dc_uniq   = mkTupleDataConUnique sort arity
+        tc_uniq   = mkTupleTyConUnique   boxity arity
+        dc_uniq   = mkTupleDataConUnique boxity arity
 
 unitTyCon :: TyCon
-unitTyCon     = tupleTyCon BoxedTuple 0
+unitTyCon = tupleTyCon Boxed 0
+
+unitTyConKey :: Unique
+unitTyConKey = getUnique unitTyCon
+
 unitDataCon :: DataCon
 unitDataCon   = head (tyConDataCons unitTyCon)
+
 unitDataConId :: Id
 unitDataConId = dataConWorkId unitDataCon
 
 pairTyCon :: TyCon
-pairTyCon = tupleTyCon BoxedTuple 2
+pairTyCon = tupleTyCon Boxed 2
 
 unboxedUnitTyCon :: TyCon
-unboxedUnitTyCon   = tupleTyCon UnboxedTuple 0
+unboxedUnitTyCon = tupleTyCon Unboxed 0
+
 unboxedUnitDataCon :: DataCon
-unboxedUnitDataCon = tupleCon   UnboxedTuple 0
+unboxedUnitDataCon = tupleDataCon   Unboxed 0
 
 unboxedSingletonTyCon :: TyCon
-unboxedSingletonTyCon   = tupleTyCon UnboxedTuple 1
+unboxedSingletonTyCon = tupleTyCon Unboxed 1
+
 unboxedSingletonDataCon :: DataCon
-unboxedSingletonDataCon = tupleCon   UnboxedTuple 1
+unboxedSingletonDataCon = tupleDataCon Unboxed 1
 
 unboxedPairTyCon :: TyCon
-unboxedPairTyCon   = tupleTyCon UnboxedTuple 2
+unboxedPairTyCon = tupleTyCon Unboxed 2
+
 unboxedPairDataCon :: DataCon
-unboxedPairDataCon = tupleCon   UnboxedTuple 2
+unboxedPairDataCon = tupleDataCon Unboxed 2
 
 {-
 ************************************************************************
@@ -754,17 +807,17 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 \end{itemize}
 -}
 
-mkTupleTy :: TupleSort -> [Type] -> Type
+mkTupleTy :: Boxity -> [Type] -> Type
 -- Special case for *boxed* 1-tuples, which are represented by the type itself
-mkTupleTy sort [ty] | Boxed <- tupleSortBoxity sort = ty
-mkTupleTy sort tys = mkTyConApp (tupleTyCon sort (length tys)) tys
+mkTupleTy Boxed  [ty] = ty
+mkTupleTy boxity tys  = mkTyConApp (tupleTyCon boxity (length tys)) tys
 
 -- | Build the type of a small tuple that holds the specified type of thing
 mkBoxedTupleTy :: [Type] -> Type
-mkBoxedTupleTy tys = mkTupleTy BoxedTuple tys
+mkBoxedTupleTy tys = mkTupleTy Boxed tys
 
 unitTy :: Type
-unitTy = mkTupleTy BoxedTuple []
+unitTy = mkTupleTy Boxed []
 
 {-
 ************************************************************************
index 0794412..28da6cb 100644 (file)
@@ -53,6 +53,7 @@ import RdrName
 import HscTypes
 import TcEnv            ( tcLookupDataCon, tcLookupField, isBrackStage )
 import TcRnMonad
+import RdrHsSyn         ( setRdrNameSpace )
 import Id               ( isRecordSelector )
 import Name
 import NameSet
index 036d652..00381b3 100644 (file)
@@ -32,6 +32,7 @@ import NameSet
 import Avail
 import HscTypes
 import RdrName
+import RdrHsSyn        ( setRdrNameSpace )
 import Outputable
 import Maybes
 import SrcLoc
@@ -652,10 +653,14 @@ Then M's export_avails are (recall the AvailTC invariant from Avails.hs)
   C(C,T), T(T,T1,T2,T3)
 Notice that T appears *twice*, once as a child and once as a parent.
 From this we construct the imp_occ_env
-   C  -> (C,  C(C,T),        Nothing
+   C  -> (C,  C(C,T),        Nothing)
    T  -> (T,  T(T,T1,T2,T3), Just C)
    T1 -> (T1, T(T1,T2,T3),   Nothing)   -- similarly T2,T3
 
+If we say
+   import M( T(T1,T2) )
+then we get *two* Avails:  C(T), T(T1,T2)
+
 Note that the imp_occ_env will have entries for data constructors too,
 although we never look up data constructors.
 -}
@@ -763,19 +768,30 @@ filterImports ifaces decl_spec (Just (want_hiding, L l import_items))
             return ([(IEVar (L l name), trimAvail avail name)], [])
 
         IEThingAll (L l tc) -> do
-            (name, avail@(AvailTC name2 subs), mb_parent) <- lookup_name tc
-            let warns | null (drop 1 subs)      = [DodgyImport tc]
-                      | not (is_qual decl_spec) = [MissingImportList]
-                      | otherwise               = []
+            (name, avail, mb_parent) <- lookup_name tc
+            let warns = case avail of
+                          Avail {}                     -- e.g. f(..)
+                            -> [DodgyImport tc]
+
+                          AvailTC _ subs
+                            | null (drop 1 subs)       -- e.g. T(..) where T is a synonym
+                            -> [DodgyImport tc]
+
+                            | not (is_qual decl_spec)  -- e.g. import M( T(..) )
+                            -> [MissingImportList]
+
+                            | otherwise
+                            -> []
+
+                renamed_ie = IEThingAll (L l name)
+                sub_avails = case avail of
+                               Avail {}           -> []
+                               AvailTC name2 subs -> [(renamed_ie, AvailTC name2 (subs \\ [name]))]
             case mb_parent of
-              -- non-associated ty/cls
-              Nothing     -> return ([(IEThingAll (L l name), avail)], warns)
-              -- associated ty
-              Just parent -> return ([(IEThingAll (L l name),
-                                       AvailTC name2 (subs \\ [name])),
-                                      (IEThingAll (L l name),
-                                       AvailTC parent [name])],
-                                     warns)
+              Nothing     -> return ([(renamed_ie, avail)], warns)
+                             -- non-associated ty/cls
+              Just parent -> return ((renamed_ie, AvailTC parent [name]) : sub_avails, warns)
+                             -- associated type
 
         IEThingAbs (L l tc)
             | want_hiding   -- hiding ( C )
index 5d12720..737dcc9 100644 (file)
@@ -37,15 +37,15 @@ import {-# SOURCE #-} RnExpr   ( rnLExpr )
 
 import PrelNames        ( isUnboundName )
 import TcEnv            ( checkWellStaged )
-import DsMeta           ( liftName )
+import THNames          ( liftName )
 
 #ifdef GHCI
 import ErrUtils         ( dumpIfSet_dyn_printer )
-import DsMeta           ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
 import TcEnv            ( tcMetaTy )
 import Hooks
 import Var              ( Id )
-import DsMeta           ( quoteExpName, quotePatName, quoteDecName, quoteTypeName )
+import THNames          ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
+                        , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
 import Util
 
 import {-# SOURCE #-} TcExpr   ( tcMonoExpr )
index 0fc6ccf..f3d592f 100644 (file)
@@ -59,7 +59,7 @@ import BasicTypes
 type UnariseEnv = VarEnv [Id]
 
 ubxTupleId0 :: Id
-ubxTupleId0 = dataConWorkId (tupleCon UnboxedTuple 0)
+ubxTupleId0 = dataConWorkId (tupleDataCon Unboxed 0)
 
 unarise :: UniqSupply -> [StgBinding] -> [StgBinding]
 unarise us binds = zipWith (\us -> unariseBinding us init_env) (listSplitUniqSupply us) binds
@@ -88,7 +88,7 @@ unariseExpr _ rho (StgApp f args)
   , UbxTupleRep tys <- repType (idType f)
   =  -- Particularly important where (##) is concerned
      -- See Note [Nullary unboxed tuple]
-    StgConApp (tupleCon UnboxedTuple (length tys))
+    StgConApp (tupleDataCon Unboxed (length tys))
               (map StgVarArg (unariseId rho f))
 
   | otherwise
@@ -98,7 +98,7 @@ unariseExpr _ _ (StgLit l)
   = StgLit l
 
 unariseExpr _ rho (StgConApp dc args)
-  | isUnboxedTupleCon dc = StgConApp (tupleCon UnboxedTuple (length args')) args'
+  | isUnboxedTupleCon dc = StgConApp (tupleDataCon Unboxed (length args')) args'
   | otherwise            = StgConApp dc args'
   where
     args' = unariseArgs rho args
@@ -139,14 +139,14 @@ unariseAlts us rho alt_ty _ (UnaryRep _) alts
   = (alt_ty, zipWith (\us alt -> unariseAlt us rho alt) (listSplitUniqSupply us) alts)
 
 unariseAlts us rho _ bndr (UbxTupleRep tys) ((DEFAULT, [], [], e) : _)
-  = (UbxTupAlt n, [(DataAlt (tupleCon UnboxedTuple n), ys, uses, unariseExpr us2' rho' e)])
+  = (UbxTupAlt n, [(DataAlt (tupleDataCon Unboxed n), ys, uses, unariseExpr us2' rho' e)])
   where
     (us2', rho', ys) = unariseIdBinder us rho bndr
     uses = replicate (length ys) (not (isDeadBinder bndr))
     n = length tys
 
 unariseAlts us rho _ bndr (UbxTupleRep _) [(DataAlt _, ys, uses, e)]
-  = (UbxTupAlt n, [(DataAlt (tupleCon UnboxedTuple n), ys', uses', unariseExpr us2' rho'' e)])
+  = (UbxTupAlt n, [(DataAlt (tupleDataCon Unboxed n), ys', uses', unariseExpr us2' rho'' e)])
   where
     (us2', rho', ys', uses') = unariseUsedIdBinders us rho ys uses
     rho'' = extendVarEnv rho' bndr ys'
index de1bf08..61633f9 100644 (file)
@@ -1725,8 +1725,7 @@ mkCallUDs' env f args
 
     type_determines_value pred    -- See Note [Type determines value]
         = case classifyPredType pred of
-            ClassPred cls _ -> not (isIPClass cls)
-            TuplePred ps    -> all type_determines_value ps
+            ClassPred cls _ -> not (isIPClass cls)  -- Superclasses can't be IPs
             EqPred {}       -> True
             IrredPred {}    -> True   -- Things like (D []) where D is a
                                       -- Constraint-ranged family; Trac #7785
index 8c96afa..304a3cb 100644 (file)
@@ -24,11 +24,11 @@ import Demand
 import MkCore           ( mkRuntimeErrorApp, aBSENT_ERROR_ID )
 import MkId             ( voidArgId, voidPrimId )
 import TysPrim          ( voidPrimTy )
-import TysWiredIn       ( tupleCon )
+import TysWiredIn       ( tupleDataCon )
 import Type
 import Coercion hiding  ( substTy, substTyVarBndr )
 import FamInstEnv
-import BasicTypes       ( TupleSort(..), OneShotInfo(..), worstOneShot )
+import BasicTypes       ( Boxity(..), OneShotInfo(..), worstOneShot )
 import Literal          ( absentLiteralOf )
 import TyCon
 import UniqSupply
@@ -643,7 +643,7 @@ mkWWcpr_help (data_con, inst_tys, arg_tys, co)
         -- Worker:  case (   ...body...  ) of C a b -> (# a, b #)
   = do { (work_uniq : uniqs) <- getUniquesM
        ; let (wrap_wild : args) = zipWith mk_ww_local uniqs (ubx_tup_ty : arg_tys)
-             ubx_tup_con  = tupleCon UnboxedTuple (length arg_tys)
+             ubx_tup_con  = tupleDataCon Unboxed (length arg_tys)
              ubx_tup_ty   = exprType ubx_tup_app
              ubx_tup_app  = mkConApp2 ubx_tup_con arg_tys args
              con_app      = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co
index 53ecb48..3e07f6b 100644 (file)
@@ -23,6 +23,7 @@ import Name
 import Var
 import Class
 import Type
+import TcType( immSuperClasses )
 import Unify
 import InstEnv
 import VarSet
@@ -445,32 +446,29 @@ oclose :: [PredType] -> TyVarSet -> TyVarSet
 -- See Note [The liberal coverage condition]
 oclose preds fixed_tvs
   | null tv_fds = fixed_tvs -- Fast escape hatch for common case.
-  | otherwise   = loop fixed_tvs
+  | otherwise   = transCloVarSet extend fixed_tvs
   where
-    loop fixed_tvs
-      | new_fixed_tvs `subVarSet` fixed_tvs = fixed_tvs
-      | otherwise                           = loop new_fixed_tvs
-      where new_fixed_tvs = foldl extend fixed_tvs tv_fds
-
-    extend fixed_tvs (ls,rs)
-        | ls `subVarSet` fixed_tvs = fixed_tvs `unionVarSet` rs
-        | otherwise                = fixed_tvs
+    extend fixed_tvs = foldl add fixed_tvs tv_fds
+       where
+          add fixed_tvs (ls,rs)
+            | ls `subVarSet` fixed_tvs = fixed_tvs `unionVarSet` rs
+            | otherwise                = fixed_tvs
 
     tv_fds  :: [(TyVarSet,TyVarSet)]
     tv_fds  = [ (tyVarsOfTypes xs, tyVarsOfTypes ys)
-              | (xs, ys) <- concatMap determined preds
-              ]
+              | (xs, ys) <- concatMap determined preds ]
 
     determined :: PredType -> [([Type],[Type])]
     determined pred
        = case classifyPredType pred of
-            ClassPred cls tys ->
-               do let (cls_tvs, cls_fds) = classTvsFds cls
-                  fd <- cls_fds
-                  return (instFD fd cls_tvs tys)
             EqPred NomEq t1 t2 -> [([t1],[t2]), ([t2],[t1])]
-            TuplePred ts       -> concatMap determined ts
-            _                  -> []
+            ClassPred cls tys -> local_fds ++ concatMap determined superclasses
+              where
+               local_fds = [ instFD fd cls_tvs tys
+                           | fd <- cls_fds ]
+               (cls_tvs, cls_fds) = classTvsFds cls
+               superclasses = immSuperClasses cls tys
+            _ -> []
 
 {-
 ************************************************************************
index 78a53fb..1383bdd 100644 (file)
@@ -173,42 +173,11 @@ canEvNC ev
                                   canClassNC ev cls tys
       EqPred eq_rel ty1 ty2 -> do traceTcS "canEvNC:eq" (ppr ty1 $$ ppr ty2)
                                   canEqNC    ev eq_rel ty1 ty2
-      TuplePred tys         -> do traceTcS "canEvNC:tup" (ppr tys)
-                                  canTuple   ev tys
       IrredPred {}          -> do traceTcS "canEvNC:irred" (ppr (ctEvPred ev))
                                   canIrred   ev
 {-
 ************************************************************************
 *                                                                      *
-*                      Tuple Canonicalization
-*                                                                      *
-************************************************************************
--}
-
-canTuple :: CtEvidence -> [PredType] -> TcS (StopOrContinue Ct)
-canTuple ev preds
-  | CtWanted { ctev_evar = evar, ctev_loc = loc } <- ev
-  = do { new_evars <- mapM (newWantedEvVar loc) preds
-       ; setWantedEvBind evar (EvTupleMk (map (ctEvId . fst) new_evars))
-       ; emitWorkNC (freshGoals new_evars)
-         -- Note the "NC": these are fresh goals, not necessarily canonical
-       ; stopWith ev "Decomposed tuple constraint" }
-
-  | CtGiven { ctev_evar = evar, ctev_loc = loc } <- ev
-  = do { given_evs <- newGivenEvVars loc (mkEvTupleSelectors (EvId evar) preds)
-       ; emitWorkNC given_evs
-       ; stopWith ev "Decomposed tuple constraint" }
-
-  | CtDerived { ctev_loc = loc } <- ev
-  = do { mapM_ (emitNewDerived loc) preds
-       ; stopWith ev "Decomposed tuple constraint" }
-
-  | otherwise = panic "canTuple"
-
-
-{-
-************************************************************************
-*                                                                      *
 *                      Class Canonicalization
 *                                                                      *
 ************************************************************************
@@ -384,7 +353,6 @@ canIrred old_ev
     do { -- Re-classify, in case flattening has improved its shape
        ; case classifyPredType (ctEvPred new_ev) of
            ClassPred cls tys     -> canClassNC new_ev cls tys
-           TuplePred tys         -> canTuple   new_ev tys
            EqPred eq_rel ty1 ty2 -> canEqNC new_ev eq_rel ty1 ty2
            _                     -> continueWith $
                                     CIrredEvCan { cc_ev = new_ev } } }
index 88c88bd..a4c4703 100644 (file)
@@ -320,8 +320,6 @@ reportWanteds ctxt (WC { wc_simple = simples, wc_insol = insols, wc_impl = impli
        ; (_, leftovers) <- tryReporters ctxt2' reporters (insols2 ++ tidy_simples)
        ; MASSERT2( null leftovers, ppr leftovers )
 
-            -- TuplePreds should have been expanded away by the constraint
-            -- simplifier, so they shouldn't show up at this point
             -- All the Derived ones have been filtered out of simples
             -- by the constraint solver. This is ok; we don't want
             -- to report unsolved Derived goals as errors
index 6dd01f9..6e02694 100644 (file)
@@ -14,7 +14,7 @@ module TcEvidence (
   EvBindMap(..), emptyEvBindMap, extendEvBinds,
                  lookupEvBind, evBindMapBinds, foldEvBindMap,
   EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,
-  EvTerm(..), mkEvCast, evVarsOfTerm, mkEvTupleSelectors, mkEvScSelectors,
+  EvTerm(..), mkEvCast, evVarsOfTerm, mkEvScSelectors,
   EvLit(..), evTermCoercion,
   EvCallStack(..),
   EvTypeable(..),
@@ -712,10 +712,6 @@ data EvTerm
   | EvDFunApp DFunId             -- Dictionary instance application
        [Type] [EvId]
 
-  | EvTupleSel EvTerm Int        -- n'th component of the tuple, 0-indexed
-
-  | EvTupleMk [EvId]             -- tuple built from this stuff
-
   | EvDelayedError Type FastString  -- Used with Opt_DeferTypeErrors
                                -- See Note [Deferring coercion errors to runtime]
                                -- in TcSimplify
@@ -975,11 +971,6 @@ mkEvCast ev lco
     isTcReflCo lco = ev
   | otherwise      = EvCast ev lco
 
-mkEvTupleSelectors :: EvTerm -> [TcPredType] -> [(TcPredType, EvTerm)]
-mkEvTupleSelectors ev preds = zipWith mk_pr preds [0..]
-  where
-    mk_pr pred i = (pred, EvTupleSel ev i)
-
 mkEvScSelectors :: EvTerm -> Class -> [TcType] -> [(TcPredType, EvTerm)]
 mkEvScSelectors ev cls tys
    = zipWith mk_pr (immSuperClasses cls tys) [0..]
@@ -1006,10 +997,8 @@ evVarsOfTerm :: EvTerm -> VarSet
 evVarsOfTerm (EvId v)             = unitVarSet v
 evVarsOfTerm (EvCoercion co)      = coVarsOfTcCo co
 evVarsOfTerm (EvDFunApp _ _ evs)  = mkVarSet evs
-evVarsOfTerm (EvTupleSel ev _)    = evVarsOfTerm ev
 evVarsOfTerm (EvSuperClass v _)   = evVarsOfTerm v
 evVarsOfTerm (EvCast tm co)       = evVarsOfTerm tm `unionVarSet` coVarsOfTcCo co
-evVarsOfTerm (EvTupleMk evs)      = mkVarSet evs
 evVarsOfTerm (EvDelayedError _ _) = emptyVarSet
 evVarsOfTerm (EvLit _)            = emptyVarSet
 evVarsOfTerm (EvCallStack cs)     = evVarsOfCallStack cs
@@ -1089,8 +1078,6 @@ instance Outputable EvTerm where
   ppr (EvId v)              = ppr v
   ppr (EvCast v co)         = ppr v <+> (ptext (sLit "`cast`")) <+> pprParendTcCo co
   ppr (EvCoercion co)       = ptext (sLit "CO") <+> ppr co
-  ppr (EvTupleSel v n)      = ptext (sLit "tupsel") <> parens (ppr (v,n))
-  ppr (EvTupleMk vs)        = ptext (sLit "tupmk") <+> ppr vs
   ppr (EvSuperClass d n)    = ptext (sLit "sc") <> parens (ppr (d,n))
   ppr (EvDFunApp df tys ts) = ppr df <+> sep [ char '@' <> ppr tys, ppr ts ]
   ppr (EvLit l)             = ppr l
index 155cdb4..a962258 100644 (file)
@@ -16,7 +16,7 @@ module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC,
 #include "HsVersions.h"
 
 import {-# SOURCE #-}   TcSplice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket )
-import DsMeta( liftStringName, liftName )
+import THNames( liftStringName, liftName )
 
 import HsSyn
 import TcHsSyn
@@ -373,7 +373,7 @@ tcExpr (SectionL arg1 op) res_ty
 
 tcExpr (ExplicitTuple tup_args boxity) res_ty
   | all tupArgPresent tup_args
-  = do { let tup_tc = tupleTyCon (boxityNormalTupleSort boxity) (length tup_args)
+  = do { let tup_tc = tupleTyCon boxity (length tup_args)
        ; (coi, arg_tys) <- matchExpectedTyConApp tup_tc res_ty
        ; tup_args1 <- tcTupArgs tup_args arg_tys
        ; return $ mkHsWrapCo coi (ExplicitTuple tup_args1 boxity) }
@@ -383,7 +383,7 @@ tcExpr (ExplicitTuple tup_args boxity) res_ty
     do { let kind = case boxity of { Boxed   -> liftedTypeKind
                                    ; Unboxed -> openTypeKind }
              arity = length tup_args
-             tup_tc = tupleTyCon (boxityNormalTupleSort boxity) arity
+             tup_tc = tupleTyCon boxity arity
 
        ; arg_tys <- newFlexiTyVarTys (tyConArity tup_tc) kind
        ; let actual_res_ty
@@ -1273,14 +1273,14 @@ checkCrossStageLifting id (Brack _ (TcPending ps_var lie_var))
                -- just going to flag an error for now
 
         ; lift <- if isStringTy id_ty then
-                     do { sid <- tcLookupId DsMeta.liftStringName
+                     do { sid <- tcLookupId THNames.liftStringName
                                      -- See Note [Lifting strings]
                         ; return (HsVar sid) }
                   else
                      setConstraintVar lie_var   $
                           -- Put the 'lift' constraint into the right LIE
                      newMethodFromName (OccurrenceOf (idName id))
-                                       DsMeta.liftName id_ty
+                                       THNames.liftName id_ty
 
                    -- Update the pending splices
         ; ps <- readMutVar ps_var
index d18e6ed..d30c1ca 100644 (file)
@@ -1608,7 +1608,7 @@ data FFoldType a      -- Describes how to fold over a Type in a functor like way
         , ft_var     :: a                   -- The variable itself
         , ft_co_var  :: a                   -- The variable itself, contravariantly
         , ft_fun     :: a -> a -> a         -- Function type
-        , ft_tup     :: TupleSort -> [a] -> a  -- Tuple type
+        , ft_tup     :: TyCon -> [a] -> a   -- Tuple type
         , ft_ty_app  :: Type -> a -> a      -- Type app, variable only in last argument
         , ft_bad_app :: a                   -- Type app, variable other than in last argument
         , ft_forall  :: TcTyVar -> a -> a   -- Forall type
@@ -1644,8 +1644,7 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial,     ft_var = caseVar
        | not (or xcs)     = (caseTrivial, False)   -- Variable does not occur
        -- At this point we know that xrs, xcs is not empty,
        -- and at least one xr is True
-       | Just sort <- tyConTuple_maybe con
-                          = (caseTuple sort xrs, True)
+       | isTupleTyCon con = (caseTuple con xrs, True)
        | or (init xcs)    = (caseWrongArg, True)         -- T (..var..)    ty
        | Just (fun_ty, _) <- splitAppTy_maybe ty         -- T (..no var..) ty
                           = (caseTyApp fun_ty (last xrs), True)
@@ -1716,11 +1715,11 @@ mkSimpleConMatch fold extra_pats con insides = do
 -- "case x of (a1,a2,a3) -> fold [x1 a1, x2 a2, x3 a3]"
 mkSimpleTupleCase :: Monad m => ([LPat RdrName] -> DataCon -> [a]
                                  -> m (LMatch RdrName (LHsExpr RdrName)))
-                  -> TupleSort -> [a] -> LHsExpr RdrName -> m (LHsExpr RdrName)
-mkSimpleTupleCase match_for_con sort insides x = do
-    let con = tupleCon sort (length insides)
-    match <- match_for_con [] con insides
-    return $ nlHsCase x [match]
+                  -> TyCon -> [a] -> LHsExpr RdrName -> m (LHsExpr RdrName)
+mkSimpleTupleCase match_for_con tc insides x
+  = do { let data_con = tyConSingleDataCon tc
+       ; match <- match_for_con [] data_con insides
+       ; return $ nlHsCase x [match] }
 
 {-
 ************************************************************************
index 80dd175..02d993f 100644 (file)
@@ -90,7 +90,7 @@ hsPatType (ViewPat _ _ ty)            = ty
 hsPatType (ListPat _ ty Nothing)      = mkListTy ty
 hsPatType (ListPat _ _ (Just (ty,_))) = ty
 hsPatType (PArrPat _ ty)              = mkPArrTy ty
-hsPatType (TuplePat _ bx tys)         = mkTupleTy (boxityNormalTupleSort bx) tys
+hsPatType (TuplePat _ bx tys)         = mkTupleTy bx tys
 hsPatType (ConPatOut { pat_con = L _ con, pat_arg_tys = tys })
                                       = conLikeResTy con tys
 hsPatType (SigPatOut _ ty)            = ty
@@ -1247,7 +1247,6 @@ zonkEvTerm env (EvCoercion co)    = do { co' <- zonkTcCoToCo env co
 zonkEvTerm env (EvCast tm co)     = do { tm' <- zonkEvTerm env tm
                                        ; co' <- zonkTcCoToCo env co
                                        ; return (mkEvCast tm' co') }
-zonkEvTerm env (EvTupleMk tms)    = return (EvTupleMk (zonkIdOccs env tms))
 zonkEvTerm _   (EvLit l)          = return (EvLit l)
 
 zonkEvTerm env (EvTypeable ev) =
@@ -1271,8 +1270,6 @@ zonkEvTerm env (EvCallStack cs)
       EvCsPushCall n l tm -> do { tm' <- zonkEvTerm env tm
                                 ; return (EvCallStack (EvCsPushCall n l tm')) }
 
-zonkEvTerm env (EvTupleSel tm n)  = do { tm' <- zonkEvTerm env tm
-                                       ; return (EvTupleSel tm' n) }
 zonkEvTerm env (EvSuperClass d n) = do { d' <- zonkEvTerm env d
                                        ; return (EvSuperClass d' n) }
 zonkEvTerm env (EvDFunApp df tys tms)
index fbd21b2..785dce7 100644 (file)
@@ -476,8 +476,8 @@ tc_hs_type hs_ty@(HsExplicitListTy _k tys) exp_kind
 tc_hs_type hs_ty@(HsExplicitTupleTy _ tys) exp_kind
   = do { tks <- mapM tc_infer_lhs_type tys
        ; let n          = length tys
-             kind_con   = promotedTupleTyCon   BoxedTuple n
-             ty_con     = promotedTupleDataCon BoxedTuple n
+             kind_con   = promotedTupleTyCon   Boxed n
+             ty_con     = promotedTupleDataCon Boxed n
              (taus, ks) = unzip tks
              tup_k      = mkTyConApp kind_con ks
        ; checkExpectedKind hs_ty tup_k exp_kind
@@ -568,10 +568,15 @@ finish_tuple :: HsType Name -> TupleSort -> [TcType] -> ExpKind -> TcM TcType
 finish_tuple hs_ty tup_sort tau_tys exp_kind
   = do { traceTc "finish_tuple" (ppr res_kind $$ ppr exp_kind $$ ppr exp_kind)
        ; checkExpectedKind hs_ty res_kind exp_kind
-       ; checkWiredInTyCon tycon
+       ; tycon <- case tup_sort of
+           ConstraintTuple -> tcLookupTyCon (cTupleTyConName arity)
+           BoxedTuple      -> do { let tc = tupleTyCon Boxed arity
+                                 ; checkWiredInTyCon tc
+                                 ; return tc }
+           UnboxedTuple    -> return (tupleTyCon Unboxed arity)
        ; return (mkTyConApp tycon tau_tys) }
   where
-    tycon = tupleTyCon tup_sort (length tau_tys)
+    arity = length tau_tys
     res_kind = case tup_sort of
                  UnboxedTuple    -> unliftedTypeKind
                  BoxedTuple      -> liftedTypeKind
@@ -1558,7 +1563,7 @@ tc_hs_kind (HsTupleTy _ kis) =
      checkWiredInTyCon tycon
      return $ mkTyConApp tycon kappas
   where
-     tycon = promotedTupleTyCon BoxedTuple (length kis)
+     tycon = promotedTupleTyCon Boxed (length kis)
 
 -- Argument not kind-shaped
 tc_hs_kind k = pprPanic "tc_hs_kind" (ppr k)
index ed4fd91..de5df6a 100644 (file)
@@ -1015,7 +1015,6 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds fam_envs sc_th
     super_classes ev_pair
       = case classifyPredType pred of
           ClassPred cls tys -> (pred, ev_tm) : super_classes_help ev_tm cls tys
-          TuplePred preds   -> concatMap super_classes (mkEvTupleSelectors ev_tm preds)
           _                 -> []
       where
         (pred, ev_tm) = normalise_pr ev_pair
@@ -1023,7 +1022,8 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds fam_envs sc_th
     ------------
     super_classes_help :: EvTerm -> Class -> [TcType] -> [(TcPredType, EvTerm)]
     super_classes_help ev_tm cls tys  -- ev_tm :: cls tys
-      | sizeTypes tys >= head_size  -- Here is where we test for
+      | not (isCTupleClass cls)
+      , sizeTypes tys >= head_size  -- Here is where we test for
       = []                          -- a smaller dictionary
       | otherwise
       = concatMap super_classes (mkEvScSelectors ev_tm cls tys)
index 95715fe..ce51b0d 100644 (file)
@@ -27,6 +27,7 @@ import PrelNames ( knownNatClassName, knownSymbolClassName, ipClassNameKey,
 import Id( idType )
 import Class
 import TyCon
+import DataCon( dataConWrapId )
 import FunDeps
 import FamInst
 import Inst( tyVarsOfCt )
@@ -2022,8 +2023,15 @@ matchClassInst _ clas [ ty ] _
     = panicTcS (text "Unexpected evidence for" <+> ppr (className clas)
                      $$ vcat (map (ppr . idType) (classMethods clas)))
 
+matchClassInst _ clas ts _
+  | isCTupleClass clas
+  , let data_con = tyConSingleDataCon (classTyCon clas)
+  = return (GenInst ts (EvDFunApp (dataConWrapId data_con) ts))
+            -- The dfun is the data constructor!
+
 matchClassInst _ clas [k,t] _
-  | className clas == typeableClassName = matchTypeableClass clas k t
+  | className clas == typeableClassName
+  = matchTypeableClass clas k t
 
 matchClassInst inerts clas tys loc
    = do { dflags <- getDynFlags
index 0eaae8f..a5d5555 100644 (file)
@@ -143,7 +143,6 @@ predTypeOccName :: PredType -> OccName
 predTypeOccName ty = case classifyPredType ty of
     ClassPred cls _ -> mkDictOcc (getOccName cls)
     EqPred _ _ _    -> mkVarOccFS (fsLit "cobox")
-    TuplePred _     -> mkVarOccFS (fsLit "tup")
     IrredPred _     -> mkVarOccFS (fsLit "irred")
 
 
index 93c4728..df2ad18 100644 (file)
@@ -589,7 +589,7 @@ tc_pat penv (PArrPat pats _) pat_ty thing_inside
         }
 
 tc_pat penv (TuplePat pats boxity _) pat_ty thing_inside
-  = do  { let tc = tupleTyCon (boxityNormalTupleSort boxity) (length pats)
+  = do  { let tc = tupleTyCon boxity (length pats)
         ; (coi, arg_tys) <- matchExpectedPatTy (matchExpectedTyConApp tc) pat_ty
         ; (pats', res) <- tc_lpats penv pats arg_tys thing_inside
 
index ea454d5..820e969 100644 (file)
@@ -1016,6 +1016,10 @@ checkTc :: Bool -> MsgDoc -> TcM ()         -- Check that the boolean is true
 checkTc True  _   = return ()
 checkTc False err = failWithTc err
 
+failIfTc :: Bool -> MsgDoc -> TcM ()         -- Check that the boolean is false
+failIfTc False _   = return ()
+failIfTc True  err = failWithTc err
+
 --         Warnings have no 'M' variant, nor failure
 
 warnTc :: Bool -> MsgDoc -> TcM ()
index e970579..ee0740f 100644 (file)
@@ -614,7 +614,6 @@ pickQuantifiablePreds qtvs theta
 
           EqPred NomEq ty1 ty2  -> quant_fun ty1 || quant_fun ty2
           IrredPred ty          -> tyVarsOfType ty `intersectsVarSet` qtvs
-          TuplePred {}          -> False
 
     pick_cls_pred flex_ctxt tys
       = tyVarsOfTypes tys `intersectsVarSet` qtvs
index 4ecbd50..a7363d8 100644 (file)
@@ -38,7 +38,7 @@ import Outputable
 import TcExpr
 import SrcLoc
 import FastString
-import DsMeta
+import THNames
 import TcUnify
 import TcEnv
 
index 6ac8720..59ff6cb 100644 (file)
@@ -581,13 +581,24 @@ Then:
 This fancy footwork (with two bindings for T) is only necesary for the
 TyCons or Classes of this recursive group.  Earlier, finished groups,
 live in the global env only.
+
+Note [Declarations for wired-in things]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For wired-in things we simply ignore the declaration
+and take the wired-in information.  That avoids complications.
+e.g. the need to make the data constructor worker name for
+     a constraint tuple match the wired-in one
 -}
 
 tcTyClDecl :: RecTyInfo -> LTyClDecl Name -> TcM [TyThing]
 tcTyClDecl rec_info (L loc decl)
+  | Just thing <- wiredInNameTyThing_maybe (tcdName decl)
+  = return [thing]  -- See Note [Declarations for wired-in things]
+
+  | otherwise
   = setSrcSpan loc $ tcAddDeclCtxt decl $
-    traceTc "tcTyAndCl-x" (ppr decl) >>
-    tcTyClDecl1 NoParentTyCon rec_info decl
+    do { traceTc "tcTyAndCl-x" (ppr decl)
+       ; tcTyClDecl1 NoParentTyCon rec_info decl }
 
   -- "type family" declarations
 tcTyClDecl1 :: TyConParent -> RecTyInfo -> TyClDecl Name -> TcM [TyThing]
@@ -788,7 +799,7 @@ tcDataDefn rec_info tc_name tvs kind
                  else case new_or_data of
                    DataType -> return (mkDataTyConRhs data_cons)
                    NewType  -> ASSERT( not (null data_cons) )
-                                    mkNewTyConRhs tc_name tycon (head data_cons)
+                               mkNewTyConRhs tc_name tycon (head data_cons)
              ; return (buildAlgTyCon tc_name final_tvs roles (fmap unLoc cType)
                                      stupid_theta tc_rhs
                                      (rti_is_rec rec_info tc_name)
index 4d4f682..9ce1449 100644 (file)
@@ -1377,7 +1377,6 @@ mkMinimalBySCs ptys = [ ploc |  ploc <- ptys
    trans_super_classes pred   -- Superclasses of pred, excluding pred itself
      = case classifyPredType pred of
          ClassPred cls tys -> transSuperClasses cls tys
-         TuplePred ts      -> concatMap trans_super_classes ts
          _                 -> []
 
 transSuperClasses :: Class -> [Type] -> [PredType]
@@ -1387,10 +1386,9 @@ transSuperClasses cls tys    -- Superclasses of (cls tys),
 
 transSuperClassesPred :: PredType -> [PredType]
 -- (transSuperClassesPred p) returns (p : p's superclasses)
-transSuperClassesPred p 
+transSuperClassesPred p
   = case classifyPredType p of
       ClassPred cls tys -> p : transSuperClasses cls tys
-      TuplePred ps      -> concatMap transSuperClassesPred ps
       _                 -> [p]
 
 immSuperClasses :: Class -> [Type] -> [PredType]
@@ -1406,7 +1404,6 @@ isImprovementPred ty
       EqPred NomEq t1 t2 -> not (t1 `tcEqType` t2)
       EqPred ReprEq _ _  -> False
       ClassPred cls _    -> classHasFds cls
-      TuplePred ts       -> any isImprovementPred ts
       IrredPred {}       -> True -- Might have equalities after reduction?
 
 {-
index 3225b28..16059e6 100644 (file)
@@ -24,13 +24,13 @@ import TypeRep
 import TcType
 import TcMType
 import TysWiredIn ( coercibleClass, eqTyConName )
+import PrelNames
 import Type
 import Unify( tcMatchTyX )
 import Kind
 import CoAxiom
 import Class
 import TyCon
-import PrelNames( eqTyConKey )
 
 -- others:
 import HsSyn            -- HsType
@@ -45,7 +45,6 @@ import Util
 import ListSetOps
 import SrcLoc
 import Outputable
-import Unique           ( hasKey )
 import BasicTypes       ( IntWithInf, infinity )
 import FastString
 
@@ -396,7 +395,11 @@ check_type ctxt rank ty
   = do  { checkTc (forAllAllowed rank) (forAllTyErr rank ty)
                 -- Reject e.g. (Maybe (?x::Int => Int)),
                 -- with a decent error message
-        ; check_valid_theta ctxt theta
+
+        ; check_valid_theta SigmaCtxt theta
+                -- Allow     type T = ?x::Int => Int -> Int
+                -- but not   type T = ?x::Int
+
         ; check_type ctxt rank tau }      -- Allow foralls to right of arrow
   where
     (tvs, theta, tau) = tcSplitSigmaTy ty
@@ -617,15 +620,16 @@ check_pred_help :: Bool    -- True <=> under a type synonym
 check_pred_help under_syn dflags ctxt pred
   | Just pred' <- coreView pred  -- Switch on under_syn when going under a
                                  -- synonym (Trac #9838, yuk)
-  = check_pred_help True dflags ctxt pred'  
+  = check_pred_help True dflags ctxt pred'
   | otherwise
   = case splitTyConApp_maybe pred of
-      Just (tc, tys) | Just cls <- tyConClass_maybe tc
-                     -> check_class_pred dflags ctxt pred cls tys  -- Includes Coercible
-                     | tc `hasKey` eqTyConKey
-                     -> check_eq_pred dflags pred tys
-                     | isTupleTyCon tc
-                     -> check_tuple_pred under_syn dflags ctxt pred tys
+      Just (tc, tys)
+        | isTupleTyCon tc
+        -> check_tuple_pred under_syn dflags ctxt pred tys
+        | Just cls <- tyConClass_maybe tc
+        -> check_class_pred dflags ctxt pred cls tys  -- Includes Coercible
+        | tc `hasKey` eqTyConKey
+        -> check_eq_pred dflags pred tys
       _ -> check_irred_pred under_syn dflags ctxt pred
 
 check_eq_pred :: DynFlags -> PredType -> [TcType] -> TcM ()
@@ -656,16 +660,22 @@ check_irred_pred under_syn dflags ctxt pred
          --   see Note [ConstraintKinds in predicates]
          -- But (X t1 t2) is always ok because we just require ConstraintKinds
          -- at the definition site (Trac #9838)
-        checkTc (under_syn || xopt Opt_ConstraintKinds dflags || not (hasTyVarHead pred))
-                (predIrredErr pred)
+        failIfTc (not under_syn && not (xopt Opt_ConstraintKinds dflags)
+                                && hasTyVarHead pred)
+                 (predIrredErr pred)
 
          -- Make sure it is OK to have an irred pred in this context
          -- See Note [Irreducible predicates in superclasses]
-       ; checkTc (xopt Opt_UndecidableInstances dflags || not (dodgy_superclass ctxt))
-                 (predIrredBadCtxtErr pred) }
+       ; failIfTc (is_superclass ctxt
+                   && not (xopt Opt_UndecidableInstances dflags)
+                   && has_tyfun_head pred)
+                  (predSuperClassErr pred) }
   where
-    dodgy_superclass ctxt
-       = case ctxt of { ClassSCCtxt _ -> True; InstDeclCtxt -> True; _ -> False }
+    is_superclass ctxt = case ctxt of { ClassSCCtxt _ -> True; _ -> False }
+    has_tyfun_head ty
+      = case tcSplitTyConApp_maybe ty of
+          Just (tc, _) -> isTypeFamilyTyCon tc
+          Nothing      -> False
 
 {- Note [ConstraintKinds in predicates]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -679,7 +689,7 @@ e.g.   module A where
 
 Note [Irreducible predicates in superclasses]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Allowing irreducible predicates in class superclasses is somewhat dangerous
+Allowing type-family calls in class superclasses is somewhat dangerous
 because we can write:
 
  type family Fooish x :: * -> Constraint
@@ -688,10 +698,7 @@ because we can write:
 
 This will cause the constraint simplifier to loop because every time we canonicalise a
 (Foo a) class constraint we add a (Fooish () a) constraint which will be immediately
-solved to add+canonicalise another (Foo a) constraint.
-
-It is equally dangerous to allow them in instance heads because in that case the
-Paterson conditions may not detect duplication of a type variable or size change. -}
+solved to add+canonicalise another (Foo a) constraint.  -}
 
 -------------------------
 check_class_pred :: DynFlags -> UserTypeCtxt -> PredType -> Class -> [TcType] -> TcM ()
@@ -722,10 +729,25 @@ check_class_pred dflags ctxt pred cls tys
 -------------------------
 okIPCtxt :: UserTypeCtxt -> Bool
   -- See Note [Implicit parameters in instance decls]
+okIPCtxt (FunSigCtxt {})    = True
+okIPCtxt (InfSigCtxt {})    = True
+okIPCtxt ExprSigCtxt        = True
+okIPCtxt PatSigCtxt         = True
+okIPCtxt ResSigCtxt         = True
+okIPCtxt GenSigCtxt         = True
+okIPCtxt (ConArgCtxt {})    = True
+okIPCtxt (ForSigCtxt {})    = True  -- ??
+okIPCtxt ThBrackCtxt        = True
+okIPCtxt GhciCtxt           = True
+okIPCtxt SigmaCtxt          = True
+okIPCtxt (DataTyCtxt {})    = True
+
 okIPCtxt (ClassSCCtxt {})  = False
 okIPCtxt (InstDeclCtxt {}) = False
 okIPCtxt (SpecInstCtxt {}) = False
-okIPCtxt _                 = True
+okIPCtxt (TySynCtxt {})    = False
+okIPCtxt (RuleSigCtxt {})  = False
+okIPCtxt DefaultDeclCtxt   = False
 
 badIPPred :: PredType -> SDoc
 badIPPred pred = ptext (sLit "Illegal implicit parameter") <+> quotes (ppr pred)
@@ -756,10 +778,9 @@ checkThetaCtxt ctxt theta
   = vcat [ptext (sLit "In the context:") <+> pprTheta theta,
           ptext (sLit "While checking") <+> pprUserTypeCtxt ctxt ]
 
-eqPredTyErr, predTyVarErr, predTupleErr, predIrredErr, predIrredBadCtxtErr :: PredType -> SDoc
-eqPredTyErr  pred = ptext (sLit "Illegal equational constraint") <+> pprType pred
-                    $$
-                    parens (ptext (sLit "Use GADTs or TypeFamilies to permit this"))
+eqPredTyErr, predTyVarErr, predTupleErr, predIrredErr, predSuperClassErr :: PredType -> SDoc
+eqPredTyErr  pred  = vcat [ ptext (sLit "Illegal equational constraint") <+> pprType pred
+                          , parens (ptext (sLit "Use GADTs or TypeFamilies to permit this")) ]
 predTyVarErr pred  = vcat [ hang (ptext (sLit "Non type-variable argument"))
                                2 (ptext (sLit "in the constraint:") <+> pprType pred)
                           , parens (ptext (sLit "Use FlexibleContexts to permit this")) ]
@@ -767,9 +788,10 @@ predTupleErr pred  = hang (ptext (sLit "Illegal tuple constraint:") <+> pprType
                         2 (parens constraintKindsMsg)
 predIrredErr pred  = hang (ptext (sLit "Illegal constraint:") <+> pprType pred)
                         2 (parens constraintKindsMsg)
-predIrredBadCtxtErr pred = hang (ptext (sLit "Illegal constraint") <+> quotes (pprType pred)
-                                 <+> ptext (sLit "in a superclass/instance context"))
-                               2 (parens undecidableMsg)
+predSuperClassErr pred
+  = hang (ptext (sLit "Illegal constraint") <+> quotes (pprType pred)
+          <+> ptext (sLit "in a superclass context"))
+       2 (parens undecidableMsg)
 
 constraintSynErr :: Type -> SDoc
 constraintSynErr kind = hang (ptext (sLit "Illegal constraint synonym of kind:") <+> quotes (ppr kind))
@@ -886,10 +908,9 @@ not converge.  See Trac #5287.
 validDerivPred :: TyVarSet -> PredType -> Bool
 validDerivPred tv_set pred
   = case classifyPredType pred of
-       ClassPred _ tys       -> check_tys tys
-       TuplePred ps          -> all (validDerivPred tv_set) ps
-       EqPred {}             -> False  -- reject equality constraints
-       _                     -> True   -- Non-class predicates are ok
+       ClassPred _ tys -> check_tys tys
+       EqPred {}       -> False  -- reject equality constraints
+       _               -> True   -- Non-class predicates are ok
   where
     check_tys tys = hasNoDups fvs
                     && sizeTypes tys == fromIntegral (length fvs)
@@ -963,6 +984,9 @@ The underlying idea is that
     context has fewer type constructors than the head.
 -}
 
+leafTyConKeys :: [Unique]
+leafTyConKeys = [eqTyConKey, coercibleTyConKey, ipClassNameKey]
+
 checkInstTermination :: [TcType] -> ThetaType -> TcM ()
 -- See Note [Paterson conditions]
 checkInstTermination tys theta
@@ -976,36 +1000,45 @@ checkInstTermination tys theta
 
    check :: PredType -> TcM ()
    check pred
-     = case classifyPredType pred of
-         TuplePred preds -> check_preds preds  -- Look inside tuple predicates; Trac #8359
-         EqPred {}       -> return ()          -- You can't get from equalities
-                                               -- to class predicates, so this is safe
-         _other      -- ClassPred, IrredPred
-           | not (null bad_tvs)
-           -> addErrTc (predUndecErr pred (nomoreMsg bad_tvs) $$ parens undecidableMsg)
-           | sizePred pred >= size
-           -> addErrTc (predUndecErr pred smallerMsg $$ parens undecidableMsg)
-           | otherwise
-           -> return ()
+     = case tcSplitTyConApp_maybe pred of
+         Just (tc, tys)
+           | getUnique tc `elem` leafTyConKeys
+           -> return ()  -- You can't get from equalities or implicit
+                         -- params to class predicates, so this is safe
+
+           | isTupleTyCon tc
+           -> check_preds tys
+              -- Look inside tuple predicates; Trac #8359
+
+         _other      -- All others: other ClassPreds, IrredPred
+           | not (null bad_tvs)    -> addErrTc (noMoreMsg bad_tvs what)
+           | sizePred pred >= size -> addErrTc (smallerMsg what)
+           | otherwise             -> return ()
      where
+        what    = ptext (sLit "constraint") <+> quotes (ppr pred)
         bad_tvs = filterOut isKindVar (fvType pred \\ fvs)
              -- Rightly or wrongly, we only check for
              -- excessive occurrences of *type* variables.
              -- e.g. type instance Demote {T k} a = T (Demote {k} (Any {k}))
 
-predUndecErr :: PredType -> SDoc -> SDoc
-predUndecErr pred msg = sep [msg,
-                        nest 2 (ptext (sLit "in the constraint:") <+> pprType pred)]
-
-nomoreMsg :: [TcTyVar] -> SDoc
-nomoreMsg tvs
-  = sep [ ptext (sLit "Variable") <> plural tvs <+> quotes (pprWithCommas ppr tvs)
-        , (if isSingleton tvs then ptext (sLit "occurs")
-                                  else ptext (sLit "occur"))
-          <+> ptext (sLit "more often than in the instance head") ]
+smallerMsg :: SDoc -> SDoc
+smallerMsg what
+  = vcat [ hang (ptext (sLit "The") <+> what)
+              2 (ptext (sLit "is no smaller than the instance head"))
+         , parens undecidableMsg ]
+
+noMoreMsg :: [TcTyVar] -> SDoc -> SDoc
+noMoreMsg tvs what
+  = vcat [ hang (ptext (sLit "Variable") <> plural tvs <+> quotes (pprWithCommas ppr tvs)
+                <+> occurs <+> ptext (sLit "more often"))
+              2 (sep [ ptext (sLit "in the") <+> what
+                     , ptext (sLit "than in the instance head") ])
+         , parens undecidableMsg ]
+  where
+   occurs = if isSingleton tvs then ptext (sLit "occurs")
+                               else ptext (sLit "occur")
 
-smallerMsg, undecidableMsg, constraintKindsMsg :: SDoc
-smallerMsg         = ptext (sLit "Constraint is no smaller than the instance head")
+undecidableMsg, constraintKindsMsg :: SDoc
 undecidableMsg     = ptext (sLit "Use UndecidableInstances to permit this")
 constraintKindsMsg = ptext (sLit "Use ConstraintKinds to permit this")
 
@@ -1192,16 +1225,12 @@ checkFamInstRhs lhsTys famInsts
    size = sizeTypes lhsTys
    fvs  = fvTypes lhsTys
    check (tc, tys)
-      | not (all isTyFamFree tys)
-      = Just (famInstUndecErr famInst nestedMsg $$ parens undecidableMsg)
-      | not (null bad_tvs)
-      = Just (famInstUndecErr famInst (nomoreMsg bad_tvs) $$ parens undecidableMsg)
-      | size <= sizeTypes tys
-      = Just (famInstUndecErr famInst smallerAppMsg $$ parens undecidableMsg)
-      | otherwise
-      = Nothing
+      | not (all isTyFamFree tys) = Just (nestedMsg what)
+      | not (null bad_tvs)        = Just (noMoreMsg bad_tvs what)
+      | size <= sizeTypes tys     = Just (smallerMsg what)
+      | otherwise                 = Nothing
       where
-        famInst = TyConApp tc tys
+        what    = ptext (sLit "type family application") <+> quotes (pprType (TyConApp tc tys))
         bad_tvs = filterOut isKindVar (fvTypes tys \\ fvs)
              -- Rightly or wrongly, we only check for
              -- excessive occurrences of *type* variables.
@@ -1247,11 +1276,10 @@ tyFamInstIllegalErr ty
          colon) 2 $
       ppr ty
 
-famInstUndecErr :: Type -> SDoc -> SDoc
-famInstUndecErr ty msg
-  = sep [msg,
-         nest 2 (ptext (sLit "in the type family application:") <+>
-                 pprType ty)]
+nestedMsg :: SDoc -> SDoc
+nestedMsg what
+  = sep [ ptext (sLit "Illegal nested") <+> what
+        , parens undecidableMsg ]
 
 famPatErr :: TyCon -> [TyVar] -> [Type] -> SDoc
 famPatErr fam_tc tvs pats
@@ -1260,10 +1288,6 @@ famPatErr fam_tc tvs pats
        2 (hang (ptext (sLit "but the real LHS (expanding synonyms) is:"))
              2 (pprTypeApp fam_tc (map expandTypeSynonyms pats) <+> ptext (sLit "= ...")))
 
-nestedMsg, smallerAppMsg :: SDoc
-nestedMsg     = ptext (sLit "Nested type family application")
-smallerAppMsg = ptext (sLit "Application is no smaller than the instance head")
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1331,14 +1355,14 @@ sizeTypes xs = sum (map sizeType tys)
 -- "local instances" in expressions).
 -- See Trac #4200.
 sizePred :: PredType -> TypeSize
-sizePred p = go (classifyPredType p)
-  where
-    go (ClassPred cls tys')
-      | isIPClass cls     = 0  -- See Note [Size of a predicate]
-      | otherwise         = sizeTypes tys'
-    go (EqPred {})        = 0  -- See Note [Size of a predicate]
-    go (TuplePred ts)     = sum (map sizePred ts)
-    go (IrredPred ty)     = sizeType ty
+sizePred p
+  = case classifyPredType p of
+      ClassPred cls tys
+        | isIPClass cls     -> 0  -- See Note [Size of a predicate]
+        | isCTupleClass cls -> maximum (0 : map sizePred tys)
+        | otherwise         -> sizeTypes tys
+      EqPred {}             -> 0  -- See Note [Size of a predicate]
+      IrredPred ty          -> sizeType ty
 
 {-
 ************************************************************************
index 1861343..827c076 100644 (file)
@@ -61,7 +61,8 @@ module TyCon(
         tyConTyVars,
         tyConCType, tyConCType_maybe,
         tyConDataCons, tyConDataCons_maybe,
-        tyConSingleDataCon_maybe, tyConSingleAlgDataCon_maybe,
+        tyConSingleDataCon_maybe, tyConSingleDataCon,
+        tyConSingleAlgDataCon_maybe,
         tyConFamilySize,
         tyConStupidTheta,
         tyConArity,
@@ -1038,7 +1039,7 @@ mkClassTyCon :: Name -> Kind -> [TyVar] -> [Role] -> AlgTyConRhs -> Class
 mkClassTyCon name kind tyvars roles rhs clas is_rec
   = mkAlgTyCon name kind tyvars roles Nothing [] rhs (ClassTyCon clas)
                is_rec False
-               Nothing    -- Class TyCons are not pormoted
+               Nothing    -- Class TyCons are not promoted
 
 mkTupleTyCon :: Name
              -> Kind    -- ^ Kind of the resulting 'TyCon'
@@ -1047,8 +1048,9 @@ mkTupleTyCon :: Name
              -> DataCon
              -> TupleSort    -- ^ Whether the tuple is boxed or unboxed
              -> Maybe TyCon  -- ^ Promoted version
+             -> TyConParent
              -> TyCon
-mkTupleTyCon name kind arity tyvars con sort prom_tc
+mkTupleTyCon name kind arity tyvars con sort prom_tc parent
   = AlgTyCon {
         tyConName        = name,
         tyConUnique      = nameUnique name,
@@ -1059,7 +1061,7 @@ mkTupleTyCon name kind arity tyvars con sort prom_tc
         tyConCType       = Nothing,
         algTcStupidTheta = [],
         algTcRhs         = TupleTyCon { data_con = con, tup_sort = sort },
-        algTcParent      = NoParentTyCon,
+        algTcParent      = parent,
         algTcRec         = NonRecursive,
         algTcGadtSyntax  = False,
         tcPromoted       = prom_tc
@@ -1470,17 +1472,23 @@ isPromotedDataCon_maybe _ = Nothing
 --
 -- * Family instances are /not/ implicit as they represent the instance body
 --   (similar to a @dfun@ does that for a class instance).
+--
+-- * Tuples are implicit iff they have a wired-in name
+--   (namely: boxed and unboxed tupeles are wired-in and implicit,
+--            but constraint tuples are not)
 isImplicitTyCon :: TyCon -> Bool
 isImplicitTyCon (FunTyCon {})        = True
 isImplicitTyCon (PrimTyCon {})       = True
 isImplicitTyCon (PromotedDataCon {}) = True
 isImplicitTyCon (PromotedTyCon {})   = True
-isImplicitTyCon (AlgTyCon { algTcRhs = TupleTyCon {} })             = True
-isImplicitTyCon (AlgTyCon { algTcParent = AssocFamilyTyCon {} })    = True
-isImplicitTyCon (AlgTyCon {})                                       = False
-isImplicitTyCon (FamilyTyCon { famTcParent = AssocFamilyTyCon {} }) = True
-isImplicitTyCon (FamilyTyCon {})                                    = False
-isImplicitTyCon (SynonymTyCon {})                                   = False
+isImplicitTyCon (AlgTyCon { algTcRhs = rhs, algTcParent = parent, tyConName = name })
+  | TupleTyCon {} <- rhs             = isWiredInName name
+  | AssocFamilyTyCon {} <- parent    = True
+  | otherwise                        = False
+isImplicitTyCon (FamilyTyCon { famTcParent = parent })
+  | AssocFamilyTyCon {} <- parent    = True
+  | otherwise                        = False
+isImplicitTyCon (SynonymTyCon {})    = False
 
 tyConCType_maybe :: TyCon -> Maybe CType
 tyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc
@@ -1548,6 +1556,12 @@ tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs })
       _                             -> Nothing
 tyConSingleDataCon_maybe _           = Nothing
 
+tyConSingleDataCon :: TyCon -> DataCon
+tyConSingleDataCon tc
+  = case tyConSingleDataCon_maybe tc of
+      Just c  -> c
+      Nothing -> pprPanic "tyConDataCon" (ppr tc)
+
 tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon
 -- Returns (Just con) for single-constructor
 -- *algebraic* data types *not* newtypes
index f29791c..41b6b2d 100644 (file)
@@ -50,6 +50,7 @@ module Type (
         mkClassPred,
         isClassPred, isEqPred,
         isIPPred, isIPPred_maybe, isIPTyCon, isIPClass,
+        isCTupleClass,
 
         -- Deconstructing predicate types
         PredTree(..), EqRel(..), eqRelRole, classifyPredType,
@@ -913,6 +914,9 @@ isIPClass :: Class -> Bool
 isIPClass cls = cls `hasKey` ipClassNameKey
   -- Class and it corresponding TyCon have the same Unique
 
+isCTupleClass :: Class -> Bool
+isCTupleClass cls = isTupleTyCon (classTyCon cls)
+
 isIPPred_maybe :: Type -> Maybe (FastString, Type)
 isIPPred_maybe ty =
   do (tc,[t1,t2]) <- splitTyConApp_maybe ty
@@ -1020,7 +1024,6 @@ eqRelRole ReprEq = Representational
 
 data PredTree = ClassPred Class [Type]
               | EqPred EqRel Type Type
-              | TuplePred [PredType]
               | IrredPred PredType
 
 classifyPredType :: PredType -> PredTree
@@ -1035,8 +1038,6 @@ classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of
      -- the Coercible check
     Just (tc, tys) | Just clas <- tyConClass_maybe tc
                    -> ClassPred clas tys
-    Just (tc, tys) | isTupleTyCon tc
-                   -> TuplePred tys
     _ -> IrredPred ev_ty
 
 getClassPredTys :: PredType -> (Class, [Type])
index f755f3f..527bfda 100644 (file)
@@ -78,6 +78,7 @@ import Outputable
 import FastString
 import Util
 import DynFlags
+import StaticFlags( opt_PprStyle_Debug )
 
 -- libraries
 import Data.List( mapAccumL, partition )
@@ -743,8 +744,7 @@ pprTcApp p pp tc tys
         ty_args = drop arity tys    -- Drop the kind args
   , ty_args `lengthIs` arity        -- Result is saturated
   = pprPromotionQuote tc <>
-    (tupleParens tup_sort $
-     sep (punctuate comma (map (pp TopPrec) ty_args)))
+    (tupleParens tup_sort $ pprWithCommas (pp TopPrec) ty_args)
 
   | otherwise
   = sdocWithDynFlags (pprTcApp_help p pp tc tys)
@@ -754,11 +754,12 @@ pprTupleApp :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> TupleSort -> [a] -> S
 pprTupleApp p pp tc sort tys
   | null tys
   , ConstraintTuple <- sort
-  = maybeParen p TopPrec $
-    ppr tc <+> dcolon <+> ppr (tyConKind tc)
+  = if opt_PprStyle_Debug then ptext (sLit "(%%)")
+                          else maybeParen p FunPrec $
+                               ptext (sLit "() :: Constraint")
   | otherwise
   = pprPromotionQuote tc <>
-    tupleParens sort (sep (punctuate comma (map (pp TopPrec) tys)))
+    tupleParens sort (pprWithCommas (pp TopPrec) tys)
 
 pprTcApp_help :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> DynFlags -> SDoc
 -- This one has accss to the DynFlags
index bcd85cb..d5bbd65 100644 (file)
@@ -141,7 +141,7 @@ sumTyCon        = indexBuiltin "sumTyCon" sumTyCons
 prodTyCon :: Int -> Builtins -> TyCon
 prodTyCon n _
   | n >= 2 && n <= mAX_DPH_PROD 
-  = tupleTyCon BoxedTuple n
+  = tupleTyCon Boxed n
   | otherwise
   = pprPanic "prodTyCon" (ppr n)
 
index 6770103..ee7cf9c 100644 (file)
@@ -192,7 +192,7 @@ initBuiltinVars (Builtins { })
     preludeDataCons
       = [mk_tup n (mkFastString $ "tup" ++ show n) | n <- [2..5]]
       where
-        mk_tup n name = (tupleCon BoxedTuple n, name)
+        mk_tup n name = (tupleDataCon Boxed n, name)
 
 
 -- Auxilliary look up functions -----------------------------------------------
index 0a918f8..335b34b 100644 (file)
@@ -22,7 +22,7 @@ import TyCon
 import DataCon
 import MkId
 import TysWiredIn
-import BasicTypes( TupleSort(..) )
+import BasicTypes( Boxity(..) )
 import FastString
 
 
@@ -128,13 +128,13 @@ buildEnv []
       void  <- builtin voidVar
       pvoid <- builtin pvoidVar
       return (ty, vVar (void, pvoid), \_ body -> body)
-buildEnv [v] 
+buildEnv [v]
  = return (vVarType v, vVar v,
            \env body -> vLet (vNonRec v env) body)
 buildEnv vs
  = do (lenv_tc, lenv_tyargs) <- pdataReprTyCon ty
 
-      let venv_con   = tupleCon BoxedTuple (length vs) 
+      let venv_con   = tupleDataCon Boxed (length vs)
           [lenv_con] = tyConDataCons lenv_tc
 
           venv       = mkCoreTup (map Var vvs)
index 1f9ec2d..5a3e48e 100644 (file)
@@ -1,6 +1,7 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,
-             KindSignatures, DataKinds, MultiParamTypeClasses, FunctionalDependencies #-}
+             KindSignatures, DataKinds, ConstraintKinds,
+              MultiParamTypeClasses, FunctionalDependencies #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
   -- ip :: IP x a => a  is strictly speaking ambiguous, but IP is magic
 
@@ -314,3 +315,37 @@ x# `modInt#` y#
       else r#
     where
     !r# = x# `remInt#` y#
+
+
+{- *************************************************************
+*                                                              *
+*               Constraint tuples                              *
+*                                                              *
+************************************************************* -}
+
+class ()
+class (c1, c2)     => (c1, c2)
+class (c1, c2, c3) => (c1, c2, c3)
+class (c1, c2, c3, c4) => (c1, c2, c3, c4)
+class (c1, c2, c3, c4, c5) => (c1, c2, c3, c4, c5)
+class (c1, c2, c3, c4, c5, c6) => (c1, c2, c3, c4, c5, c6)
+class (c1, c2, c3, c4, c5, c6, c7) => (c1, c2, c3, c4, c5, c6, c7)
+class (c1, c2, c3, c4, c5, c6, c7, c8) => (c1, c2, c3, c4, c5, c6, c7, c8)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16)
+
+
index 3c4c8c2..4ebda15 100644 (file)
@@ -23,113 +23,141 @@ default () -- Double and Integer aren't available yet
 -- constructor @()@.
 data () = ()
 
-data (,) a b = (,) a b
-data (,,) a b c = (,,) a b c
-data (,,,) a b c d = (,,,) a b c d
-data (,,,,) a b c d e = (,,,,) a b c d e
-data (,,,,,) a b c d e f = (,,,,,) a b c d e f
-data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
-data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
-data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i
-data (,,,,,,,,,) a b c d e f g h i j = (,,,,,,,,,) a b c d e f g h i j
-data (,,,,,,,,,,) a b c d e f g h i j k = (,,,,,,,,,,) a b c d e f g h i j k
-data (,,,,,,,,,,,) a b c d e f g h i j k l = (,,,,,,,,,,,) a b c d e f g h i j k l
-data (,,,,,,,,,,,,) a b c d e f g h i j k l m = (,,,,,,,,,,,,) a b c d e f g h i j k l m
-data (,,,,,,,,,,,,,) a b c d e f g h i j k l m n = (,,,,,,,,,,,,,) a b c d e f g h i j k l m n
-data (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o = (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o
-data (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p = (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p
-data (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
- = (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
-data (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
- = (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
-data (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
- = (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
-data (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
- = (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
-data (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
- = (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
-data (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
- = (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
-data (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
- = (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
-data (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
- = (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
-data (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y
- = (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y
-data (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z
- = (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
+data (a,b) = (a,b)
+data (a,b,c) = (a,b,c)
+data (a,b,c,d) = (a,b,c,d)
+data (a,b,c,d,e) = (a,b,c,d,e)
+data (a,b,c,d,e,f) = (a,b,c,d,e,f)
+data (a,b,c,d,e,f,g) = (a,b,c,d,e,f,g)
+data (a,b,c,d,e,f,g,h) = (a,b,c,d,e,f,g,h)
+data (a,b,c,d,e,f,g,h,i) = (a,b,c,d,e,f,g,h,i)
+data (a,b,c,d,e,f,g,h,i,j) = (a,b,c,d,e,f,g,h,i,j)
+data (a,b,c,d,e,f,g,h,i,j,k) = (a,b,c,d,e,f,g,h,i,j,k)
+data (a,b,c,d,e,f,g,h,i,j,k,l) = (a,b,c,d,e,f,g,h,i,j,k,l)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m) = (a,b,c,d,e,f,g,h,i,j,k,l,m)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z)
+
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,r1,s1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2)
+data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2)
+  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
+     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2)
 
 {- Manuel says: Including one more declaration gives a segmentation fault.
 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__
index e893974..a25d7ff 100644 (file)
@@ -1,5 +1,5 @@
 {-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples,
-             RoleAnnotations #-}
+             MultiParamTypeClasses, RoleAnnotations #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Types
index dd479b7..1594d19 100644 (file)
@@ -1,18 +1,17 @@
-
-NotRelaxedExamples.hs:9:15:
-    Nested type family application
-      in the type family application: F1 (F1 Char)
-    (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‘F1’
-
-NotRelaxedExamples.hs:10:15:
-    Application is no smaller than the instance head
-      in the type family application: F2 [x]
-    (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‘F2’
-
-NotRelaxedExamples.hs:11:15:
-    Application is no smaller than the instance head
-      in the type family application: F3 [Char]
-    (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‘F3’
+\r
+NotRelaxedExamples.hs:9:15: error:\r
+    Illegal nested type family application ‘F1 (F1 Char)’\r
+    (Use UndecidableInstances to permit this)\r
+    In the type instance declaration for ‘F1’\r
+\r
+NotRelaxedExamples.hs:10:15: error:\r
+    The type family application ‘F2 [x]’\r
+      is no smaller than the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the type instance declaration for ‘F2’\r
+\r
+NotRelaxedExamples.hs:11:15: error:\r
+    The type family application ‘F3 [Char]’\r
+      is no smaller than the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the type instance declaration for ‘F3’\r
index 15cd757..bdc9c5f 100644 (file)
@@ -1,18 +1,17 @@
-
-TyFamUndec.hs:6:15:
-    Variable ‘b’ occurs more often than in the instance head
-      in the type family application: T (b, b)
-    (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‘T’
-
-TyFamUndec.hs:7:15:
-    Application is no smaller than the instance head
-      in the type family application: T (a, Maybe b)
-    (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‘T’
-
-TyFamUndec.hs:8:15:
-    Nested type family application
-      in the type family application: T (a, T b)
-    (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‘T’
+\r
+TyFamUndec.hs:6:15: error:\r
+    Variable ‘b’ occurs more often\r
+      in the type family application ‘T (b, b)’ than in the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the type instance declaration for ‘T’\r
+\r
+TyFamUndec.hs:7:15: error:\r
+    The type family application ‘T (a, Maybe b)’\r
+      is no smaller than the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the type instance declaration for ‘T’\r
+\r
+TyFamUndec.hs:8:15: error:\r
+    Illegal nested type family application ‘T (a, T b)’\r
+    (Use UndecidableInstances to permit this)\r
+    In the type instance declaration for ‘T’\r
index c4c2fff..d0b37aa 100644 (file)
@@ -116,7 +116,7 @@ test('mod85', normal, compile, [''])
 test('mod86', normal, compile, [''])
 test('mod87', normal, compile_fail, [''])
 test('mod88', normal, compile_fail, [''])
-test('mod89', normal, compile_fail, [''])
+test('mod89', normal, compile, [''])
 test('mod90', normal, compile_fail, [''])
 test('mod91', normal, compile_fail, [''])
 test('mod92', normal, compile, [''])
index 2c48d65..1e903a0 100644 (file)
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wall #-}
+
 -- !!! Sublist for non-class/tycon
 module M where
 import Prelude(map(..))
index 0f95653..b355f30 100644 (file)
@@ -1,2 +1,10 @@
-
-mod89.hs:3:16: Module ‘Prelude’ does not export ‘map(..)’
+\r
+mod89.hs:5:1: warning:\r
+    The import item ‘map(..)’ suggests that\r
+    ‘map’ has (in-scope) constructors or class methods,\r
+    but it has none\r
+\r
+mod89.hs:5:1: warning:\r
+    The import of ‘Prelude’ is redundant\r
+      except perhaps to import instances from ‘Prelude’\r
+    To import instances alone, use: import Prelude()\r
index 2f815b1..61c62ea 100644 (file)
@@ -1,14 +1,14 @@
-
-T9858a.hs:28:18: error:
-    No instance for (Typeable
-                       (((() :: Constraint), (() :: Constraint)) => ()))
-      (maybe you haven't applied a function to enough arguments?)
-      arising from a use of ‘cast’
-    In the expression: cast e
-    In the expression: case cast e of { Just e' -> ecast e' }
-    In an equation for ‘supercast’:
-        supercast
-          = case cast e of { Just e' -> ecast e' }
-          where
-              e = Refl
-              e :: E PX PX
+\r
+T9858a.hs:28:18: error:\r
+    No instance for (Typeable\r
+                       ((() :: Constraint, () :: Constraint) => ()))\r
+      (maybe you haven't applied a function to enough arguments?)\r
+      arising from a use of ‘cast’\r
+    In the expression: cast e\r
+    In the expression: case cast e of { Just e' -> ecast e' }\r
+    In an equation for ‘supercast’:\r
+        supercast\r
+          = case cast e of { Just e' -> ecast e' }\r
+          where\r
+              e = Refl\r
+              e :: E PX PX\r
index 96fbc3e..44a0618 100644 (file)
@@ -1,12 +1,12 @@
-
-fd-loop.hs:12:10:
-    Variable ‘b’ occurs more often than in the instance head
-      in the constraint: C a b
-    (Use UndecidableInstances to permit this)
-    In the instance declaration for ‘Eq (T a)’
-
-fd-loop.hs:12:10:
-    Variable ‘b’ occurs more often than in the instance head
-      in the constraint: Eq b
-    (Use UndecidableInstances to permit this)
-    In the instance declaration for ‘Eq (T a)’
+\r
+fd-loop.hs:12:10: error:\r
+    Variable ‘b’ occurs more often\r
+      in the constraint ‘C a b’ than in the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the instance declaration for ‘Eq (T a)’\r
+\r
+fd-loop.hs:12:10: error:\r
+    Variable ‘b’ occurs more often\r
+      in the constraint ‘Eq b’ than in the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the instance declaration for ‘Eq (T a)’\r
index 3a2e5a5..da76658 100644 (file)
@@ -1,6 +1,6 @@
 \r
 tcfail108.hs:7:10: error:\r
-    Variable ‘f’ occurs more often than in the instance head\r
-      in the constraint: Eq (f (Rec f))\r
+    Variable ‘f’ occurs more often\r
+      in the constraint ‘Eq (f (Rec f))’ than in the instance head\r
     (Use UndecidableInstances to permit this)\r
     In the instance declaration for ‘Eq (Rec f)’\r
index 9014b64..903f61b 100644 (file)
@@ -1,6 +1,6 @@
-
-tcfail154.hs:12:10:
-    Variable ‘a’ occurs more often than in the instance head
-      in the constraint: C a a
-    (Use UndecidableInstances to permit this)
-    In the instance declaration for ‘Eq (T a)’
+\r
+tcfail154.hs:12:10: error:\r
+    Variable ‘a’ occurs more often\r
+      in the constraint ‘C a a’ than in the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the instance declaration for ‘Eq (T a)’\r
index acdc7df..113e0cc 100644 (file)
@@ -1,12 +1,12 @@
-
-tcfail157.hs:27:10:
-    Variable ‘b’ occurs more often than in the instance head
-      in the constraint: E m a b
-    (Use UndecidableInstances to permit this)
-    In the instance declaration for ‘Foo m (a -> ())’
-
-tcfail157.hs:27:10:
-    Variable ‘b’ occurs more often than in the instance head
-      in the constraint: Foo m b
-    (Use UndecidableInstances to permit this)
-    In the instance declaration for ‘Foo m (a -> ())’
+\r
+tcfail157.hs:27:10: error:\r
+    Variable ‘b’ occurs more often\r
+      in the constraint ‘E m a b’ than in the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the instance declaration for ‘Foo m (a -> ())’\r
+\r
+tcfail157.hs:27:10: error:\r
+    Variable ‘b’ occurs more often\r
+      in the constraint ‘Foo m b’ than in the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the instance declaration for ‘Foo m (a -> ())’\r
index a6b63bd..a29b758 100644 (file)
@@ -1,7 +1,7 @@
-
-tcfail213.hs:8:1:
-    Illegal constraint ‘F a’ in a superclass/instance context
-      (Use UndecidableInstances to permit this)
-    In the context: F a
-    While checking the super-classes of class ‘C’
-    In the class declaration for ‘C’
+\r
+tcfail213.hs:8:1: error:\r
+    Illegal constraint ‘F a’ in a superclass context\r
+      (Use UndecidableInstances to permit this)\r
+    In the context: F a\r
+    While checking the super-classes of class ‘C’\r
+    In the class declaration for ‘C’\r
index 5520a3e..a2741b8 100644 (file)
@@ -1,7 +1,5 @@
-
-tcfail214.hs:9:10:
-    Illegal constraint ‘F a’ in a superclass/instance context
-      (Use UndecidableInstances to permit this)
-    In the context: F a
-    While checking an instance declaration
-    In the instance declaration for ‘C [a]’
+\r
+tcfail214.hs:9:10: error:\r
+    The constraint ‘F a’ is no smaller than the instance head\r
+    (Use UndecidableInstances to permit this)\r
+    In the instance declaration for ‘C [a]’\r
index 129bae3..560fc31 100644 (file)
@@ -1,5 +1,4 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 module ShouldFail where
 
-data Bool a b c d = False
 data Maybe a b = Nothing
index 6a4e873..432dc4c 100644 (file)
@@ -1,17 +1,9 @@
-[1 of 1] Compiling ShouldFail[sig of Prelude] ( tcfail220.hsig, nothing )
-
-tcfail220.hsig:4:1: error:
-    Type constructor ‘Bool’ has conflicting definitions in the module
-    and its hsig file
-    Main module: data Bool = False | True
-    Hsig file:  type role Bool phantom phantom phantom phantom
-                data Bool a b c d = False
-    The types have different kinds
-
-tcfail220.hsig:5:1: error:
-    Type constructor ‘Maybe’ has conflicting definitions in the module
-    and its hsig file
-    Main module: data Maybe a = Nothing | Just a
-    Hsig file:  type role Maybe phantom phantom
-                data Maybe a b = Nothing
-    The types have different kinds
+[1 of 1] Compiling ShouldFail[sig of Prelude] ( tcfail220.hsig, nothing )\r
+\r
+tcfail220.hsig:4:1: error:\r
+    Type constructor ‘Maybe’ has conflicting definitions in the module\r
+    and its hsig file\r
+    Main module: data Maybe a = Nothing | Just a\r
+    Hsig file:  type role Maybe phantom phantom\r
+                data Maybe a b = Nothing\r
+    The types have different kinds\r
index 803323f..a7bc421 100644 (file)
@@ -813,7 +813,7 @@ ppType (TyApp (TyCon "TVar#") [x,y])     = "mkTVarPrimTy " ++ ppType x
 
 ppType (TyApp (VecTyCon _ pptc) [])      = pptc
 
-ppType (TyUTup ts) = "(mkTupleTy UnboxedTuple " 
+ppType (TyUTup ts) = "(mkTupleTy Unboxed " 
                      ++ listify (map ppType ts) ++ ")"
 
 ppType (TyF s d) = "(mkFunTy (" ++ ppType s ++ ") (" ++ ppType d ++ "))"