Revert multiple commits
authorAustin Seipp <austin@well-typed.com>
Thu, 14 May 2015 15:55:03 +0000 (10:55 -0500)
committerAustin Seipp <austin@well-typed.com>
Thu, 14 May 2015 15:55:03 +0000 (10:55 -0500)
This reverts multiple commits from Simon:

  - 04a484eafc9eb9f8774b4bdd41a5dc6c9f640daf Test Trac #10359
  - a9ccd37add8315e061c02e5bf26c08f05fad9ac9 Test Trac #10403
  - c0aae6f699cbd222d826d0b8d78d6cb3f682079e Test Trac #10248
  - eb6ca851f553262efe0824b8dcbe64952de4963d Make the "matchable-given" check happen first
  - ca173aa30467a0b1023682d573fcd94244d85c50 Add a case to checkValidTyCon
  - 51cbad15f86fca1d1b0e777199eb1079a1b64d74 Update haddock submodule
  - 6e1174da5b8e0b296f5bfc8b39904300d04eb5b7 Separate transCloVarSet from fixVarSet
  - a8493e03b89f3b3bfcdb6005795de050501f5c29 Fix imports in HscMain (stage2)
  - a154944bf07b2e13175519bafebd5a03926bf105 Two wibbles to fix the build
  - 5910a1bc8142b4e56a19abea104263d7bb5c5d3f Change in capitalisation of error msg
  - 130e93aab220bdf14d08028771f83df210da340b Refactor tuple constraints
  - 8da785d59f5989b9a9df06386d5bd13f65435bc0 Delete commented-out line

These break the build by causing Haddock to fail mysteriously when
trying to examine GHC.Prim it seems.

96 files changed:
compiler/basicTypes/BasicTypes.hs
compiler/basicTypes/DataCon.hs
compiler/basicTypes/RdrName.hs
compiler/basicTypes/Unique.hs
compiler/basicTypes/VarSet.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/main/StaticFlags.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 [deleted file]
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/ghci/scripts/T10248.script [deleted file]
testsuite/tests/ghci/scripts/T10248.stderr [deleted file]
testsuite/tests/ghci/scripts/all.T
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/partial-sigs/should_compile/T10403.hs [deleted file]
testsuite/tests/partial-sigs/should_compile/T10403.stderr [deleted file]
testsuite/tests/partial-sigs/should_compile/all.T
testsuite/tests/perf/should_run/T10359.hs [deleted file]
testsuite/tests/perf/should_run/T10359.stdout [deleted file]
testsuite/tests/perf/should_run/all.T
testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32
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
utils/haddock

index 682317b..cf1bf58 100644 (file)
@@ -46,7 +46,7 @@ module BasicTypes(
 
         Boxity(..), isBoxed,
 
-        TupleSort(..), tupleSortBoxity, boxityTupleSort,
+        TupleSort(..), tupleSortBoxity, boxityNormalTupleSort,
         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,20 +573,19 @@ data TupleSort
   deriving( Eq, Data, Typeable )
 
 tupleSortBoxity :: TupleSort -> Boxity
-tupleSortBoxity BoxedTuple      = Boxed
-tupleSortBoxity UnboxedTuple    = Unboxed
+tupleSortBoxity BoxedTuple     = Boxed
+tupleSortBoxity UnboxedTuple   = Unboxed
 tupleSortBoxity ConstraintTuple = Boxed
 
-boxityTupleSort :: Boxity -> TupleSort
-boxityTupleSort Boxed   = BoxedTuple
-boxityTupleSort Unboxed = UnboxedTuple
+boxityNormalTupleSort :: Boxity -> TupleSort
+boxityNormalTupleSort Boxed   = BoxedTuple
+boxityNormalTupleSort Unboxed = UnboxedTuple
 
 tupleParens :: TupleSort -> SDoc -> SDoc
 tupleParens BoxedTuple      p = parens p
-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
+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 "#)")
 
 {-
 ************************************************************************
index 79c1472..46d79d8 100644 (file)
@@ -1015,6 +1015,7 @@ 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 4ebeeca..094347a 100644 (file)
@@ -32,7 +32,7 @@ module RdrName (
         nameRdrName, getRdrName,
 
         -- ** Destruction
-        rdrNameOcc, rdrNameSpace, demoteRdrName,
+        rdrNameOcc, rdrNameSpace, setRdrNameSpace, demoteRdrName,
         isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
         isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
 
@@ -153,6 +153,32 @@ 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 70600d8..ecff80f 100644 (file)
@@ -43,7 +43,6 @@ module Unique (
         mkAlphaTyVarUnique,
         mkPrimOpIdUnique,
         mkTupleTyConUnique, mkTupleDataConUnique,
-        mkCTupleTyConUnique,
         mkPreludeMiscIdUnique, mkPreludeDataConUnique,
         mkPreludeTyConUnique, mkPreludeClassUnique,
         mkPArrDataConUnique,
@@ -284,25 +283,25 @@ Allocation of unique supply characters:
 mkAlphaTyVarUnique     :: Int -> Unique
 mkPreludeClassUnique   :: Int -> Unique
 mkPreludeTyConUnique   :: Int -> Unique
-mkTupleTyConUnique     :: Boxity -> Arity -> Unique
-mkCTupleTyConUnique    :: Arity -> Unique
-mkPreludeDataConUnique :: Arity -> Unique
-mkTupleDataConUnique   :: Boxity -> Arity -> Unique
+mkTupleTyConUnique     :: TupleSort -> Int -> Unique
+mkPreludeDataConUnique :: Int -> Unique
+mkTupleDataConUnique   :: TupleSort -> Int -> 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 Boxed   a = mkUnique '4' (3*a)
-mkTupleTyConUnique Unboxed a = mkUnique '5' (3*a)
-mkCTupleTyConUnique        a = mkUnique 'k' (3*a)
+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)
 
 -- Data constructor keys occupy *two* slots.  The first is used for the
 -- data constructor itself and its wrapper function (the function that
@@ -310,9 +309,10 @@ mkCTupleTyConUnique        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 Boxed   a = mkUnique '7' (2*a)        -- ditto (*may* be used in C labels)
-mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a)
+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)
 
 mkPrimOpIdUnique op         = mkUnique '9' op
 mkPreludeMiscIdUnique  i    = mkUnique '0' i
index 7adc898..7b21487 100644 (file)
@@ -16,8 +16,8 @@ module VarSet (
         unionVarSet, unionVarSets, mapUnionVarSet,
         intersectVarSet, intersectsVarSet, disjointVarSet,
         isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
-        minusVarSet, foldVarSet, filterVarSet,
-        transCloVarSet, fixVarSet,
+        minusVarSet, foldVarSet, filterVarSet, 
+        transCloVarSet,
         lookupVarSet, mapVarSet, sizeVarSet, seqVarSet,
         elemVarSetByKey, partitionVarSet
     ) where
@@ -110,28 +110,13 @@ intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
 disjointVarSet   s1 s2 = isEmptyVarSet (s1 `intersectVarSet` s2)
 subVarSet        s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
 
-fixVarSet :: (VarSet -> VarSet)   -- Map the current set to a new set
-          -> VarSet -> VarSet
--- (fixVarSet f s) repeatedly applies f to the set s, 
--- until it reaches a fixed point.
-fixVarSet fn vars
-  | new_vars `subVarSet` vars = vars
-  | otherwise                 = fixVarSet fn new_vars
-  where
-    new_vars = fn vars
-
 transCloVarSet :: (VarSet -> VarSet)
                   -- Map some variables in the set to
                   -- extra variables that should be in it
                -> VarSet -> VarSet
--- (transCloVarSet f s) repeatedly applies f to new candidates, adding any
--- new variables to s that it finds thereby, until it reaches a fixed point.
---
--- The function fn could be (Var -> VarSet), but we use (VarSet -> VarSet)
--- for efficiency, so that the test can be batched up.
--- It's essential that fn will work fine if given new candidates
--- one at at time; ie  fn {v1,v2} = fn v1 `union` fn v2
--- Use fixVarSet if the function needs to see the whole set all at once
+-- (transCloVarSet f s) repeatedly applies f to the set s, adding any
+-- new variables to s that it finds thereby, until it reaches a fixed
+-- point.  The actual algorithm is a bit more efficient.
 transCloVarSet fn seeds
   = go seeds seeds
   where
@@ -139,7 +124,7 @@ transCloVarSet fn seeds
        -> VarSet  -- Work-list; un-processed subset of accumulating result
        -> VarSet
     -- Specification: go acc vs = acc `union` transClo fn vs
-
+   
     go acc candidates
        | isEmptyVarSet new_vs = acc
        | otherwise            = go (acc `unionVarSet` new_vs) new_vs
index 13285a5..ec0bb5e 100644 (file)
@@ -1570,7 +1570,7 @@ lookupIdInScope id
 
 
 oneTupleDataConId :: Id -- Should not happen
-oneTupleDataConId = dataConWorkId (tupleDataCon Boxed 1)
+oneTupleDataConId = dataConWorkId (tupleCon BoxedTuple 1)
 
 checkBndrIdInScope :: Var -> Var -> LintM ()
 checkBndrIdInScope binder id
index 3b76aef..6905641 100644 (file)
@@ -379,7 +379,7 @@ mkCoreVarTupTy ids = mkBoxedTupleTy (map idType ids)
 mkCoreTup :: [CoreExpr] -> CoreExpr
 mkCoreTup []  = Var unitDataConId
 mkCoreTup [c] = c
-mkCoreTup cs  = mkConApp (tupleDataCon Boxed (length cs))
+mkCoreTup cs  = mkConApp (tupleCon BoxedTuple (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 (tupleDataCon Boxed (length vars)), vars, Var the_var)]
+         [(DataAlt (tupleCon BoxedTuple (length vars)), vars, Var the_var)]
 
 -- | A generalization of 'mkTupleSelector', allowing the body
 -- of the case to be an arbitrary expression.
@@ -537,8 +537,7 @@ 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 (tupleDataCon Boxed (length vars)), vars, body)]
+  = Case scrut scrut_var (exprType body) [(DataAlt (tupleCon BoxedTuple (length vars)), vars, body)]
 
 {-
 ************************************************************************
index ecea850..24abf18 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 = pprWithCommas pprCoreExpr val_args
+        pp_tup_args = sep (punctuate comma (map 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 (pprWithCommas ppr_bndr args)
+  = tupleParens sort (hsep (punctuate comma (map ppr_bndr args)))
   where
     ppr_bndr = pprBndr CaseBind
     tc = dataConTyCon dc
index af72f74..3d855d4 100644 (file)
@@ -722,7 +722,7 @@ tidy_pat (PArrPat ps ty)
                            [ty]
 
 tidy_pat (TuplePat ps boxity tys)
-  = unLoc $ mkPrefixConPat (tupleDataCon boxity arity)
+  = unLoc $ mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity)
                            (map tidy_lpat ps) tys
   where
     arity = length ps
index 44795b9..55cd7d2 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 (tupleDataCon Boxed 2), [var1, var2], body)]
+         [(DataAlt (tupleCon BoxedTuple 2), [var1, var2], body)]
 
 mkCorePairTy :: Type -> Type -> Type
 mkCorePairTy t1 t2 = mkBoxedTupleTy [t1, t2]
index f67ffac..8e56fb5 100644 (file)
@@ -40,18 +40,19 @@ import Digraph
 
 import PrelNames
 import TysPrim ( mkProxyPrimTy )
-import TyCon
+import TyCon      ( isTupleTyCon, tyConDataCons_maybe
+                  , tyConName, isPromotedTyCon, isPromotedDataCon, tyConKind )
 import TcEvidence
 import TcType
 import Type
 import Kind (returnsConstraintKind)
 import Coercion hiding (substCo)
-import TysWiredIn ( eqBoxDataCon, coercibleDataCon, mkListTy
+import TysWiredIn ( eqBoxDataCon, coercibleDataCon, tupleCon, mkListTy
                   , mkBoxedTupleTy, stringTy )
 import Id
 import MkId(proxyHashId)
 import Class
-import DataCon  ( dataConTyCon )
+import DataCon  ( dataConTyCon, dataConWorkId )
 import Name
 import MkId     ( seqId )
 import IdInfo   ( IdDetails(..) )
@@ -69,6 +70,7 @@ import BasicTypes hiding ( TopLevel )
 import DynFlags
 import FastString
 import ErrUtils( MsgDoc )
+import ListSetOps( getNth )
 import Util
 import Control.Monad( when )
 import MonadUtils
@@ -851,6 +853,23 @@ 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 90121a0..5c5fde0 100644 (file)
@@ -226,7 +226,7 @@ boxResult result_ty
                      _ -> []
 
               return_result state anss
-                = mkCoreConApps (tupleDataCon Unboxed (2 + length extra_result_tys))
+                = mkCoreConApps (tupleCon UnboxedTuple (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 Unboxed arity)
+        ccall_res_ty = mkTyConApp (tupleTyCon UnboxedTuple arity)
                                   (realWorldStatePrimTy : ls)
-        the_alt      = ( DataAlt (tupleDataCon Unboxed arity)
+        the_alt      = ( DataAlt (tupleCon UnboxedTuple arity)
                        , (state_id : args_ids)
                        , the_rhs
                        )
index 37c927d..78a6d11 100644 (file)
@@ -23,6 +23,7 @@ import DsMonad
 import Name
 import NameEnv
 import FamInstEnv( topNormaliseType )
+
 import DsMeta
 import HsSyn
 
@@ -292,7 +293,7 @@ dsExpr (ExplicitTuple tup_args boxity)
                 -- The reverse is because foldM goes left-to-right
 
        ; return $ mkCoreLams lam_vars $
-                  mkCoreConApps (tupleDataCon boxity (length tup_args))
+                  mkCoreConApps (tupleCon (boxityNormalTupleSort boxity) (length tup_args))
                                 (map (Type . exprType) args ++ args) }
 
 dsExpr (HsSCC _ cc expr@(L loc _)) = do
@@ -427,7 +428,7 @@ dsExpr (HsStatic expr@(L loc _)) = do
                             , srcLocCol  $ realSrcSpanStart r
                             )
            _             -> (0, 0)
-        srcLoc = mkCoreConApps (tupleDataCon Boxed 2)
+        srcLoc = mkCoreConApps (tupleCon BoxedTuple 2)
                      [ Type intTy              , Type intTy
                      , mkIntExprInt dflags line, mkIntExprInt dflags col
                      ]
index 34ef0e8..9eb37a9 100644 (file)
 -- a Royal Pain (triggers other recompilation).
 -----------------------------------------------------------------------------
 
-module DsMeta( dsBracket ) where
+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
 
 #include "HsVersions.h"
 
@@ -33,12 +41,11 @@ 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 )
+import qualified OccName( isDataOcc, isVarOcc, isTcOcc, varName, tcName, dataName )
 
 import Module
 import Id
 import Name hiding( isVarOcc, isTcOcc, varName, tcName )
-import THNames
 import NameEnv
 import TcType
 import TyCon
@@ -2088,3 +2095,830 @@ 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 5840578..c8e30f1 100644 (file)
@@ -43,7 +43,7 @@ import Maybes
 import Util
 import Name
 import Outputable
-import BasicTypes ( isGenerated )
+import BasicTypes ( boxityNormalTupleSort, 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 (tupleDataCon boxity arity) pats tys
+    tuple_ConPat = mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity) pats tys
 
 -- LitPats: we *might* be able to replace these w/ a simpler form
 tidy1 _ (LitPat lit)
index 4934d18..09c252b 100644 (file)
@@ -164,6 +164,7 @@ Library
         IdInfo
         Lexeme
         Literal
+        DsMeta
         Llvm
         Llvm.AbsSyn
         Llvm.MetaData
@@ -421,8 +422,6 @@ Library
         TcSplice
         Class
         Coercion
-        DsMeta
-        THNames
         FamInstEnv
         FunDeps
         InstEnv
index b95d053..56efbb8 100644 (file)
@@ -48,7 +48,7 @@ import Name
 import VarEnv
 import Util
 import VarSet
-import BasicTypes       ( Boxity(..) )
+import BasicTypes       ( TupleSort(UnboxedTuple) )
 import TysPrim
 import PrelNames
 import TysWiredIn
@@ -832,9 +832,8 @@ 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 (tupleDataCon Unboxed (length terms)))
-                (error "unboxedTupleTerm: no HValue for unboxed tuple") terms
+    unboxedTupleTerm ty terms = Term ty (Right (tupleCon UnboxedTuple (length terms)))
+                                        (error "unboxedTupleTerm: no HValue for unboxed tuple") terms
 
 
 -- Fast, breadth-first Type reconstruction
index 20cb234..031a340 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 Boxed n))) tys'
+             -> mk_apps (HsTyVar (getRdrName (tupleTyCon BoxedTuple 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 Unboxed n))) tys'
+             -> mk_apps (HsTyVar (getRdrName (tupleTyCon UnboxedTuple n))) tys'
            ArrowT
              | [x',y'] <- tys' -> returnL (HsFunTy x' y')
              | otherwise       -> mk_apps (HsTyVar (getRdrName funTyCon)) tys'
index e9171a4..efefd17 100644 (file)
@@ -636,7 +636,8 @@ ppr_expr (SectionR op expr)
     pp_infixly v = sep [pprInfixOcc v, pp_expr]
 
 ppr_expr (ExplicitTuple exprs boxity)
-  = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))
+  = tupleParens (boxityNormalTupleSort 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 5d74edf..6cde908 100644 (file)
@@ -302,24 +302,17 @@ 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 (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 (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 (ListPat pats _ _)     = brackets (interpp'SP pats)
-pprPat (PArrPat pats _)       = paBrackets (interpp'SP pats)
-pprPat (TuplePat pats bx _)   = tupleParens (boxityTupleSort bx) (pprWithCommas ppr pats)
+pprPat (PArrPat pats _)     = paBrackets (interpp'SP pats)
+pprPat (TuplePat pats bx _) = tupleParens (boxityNormalTupleSort bx) (interpp'SP 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 })
@@ -332,6 +325,14 @@ 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 caa8301..ebd3bd4 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 (pprWithCommas ppr tys)
+ppr_mono_ty _    (HsTupleTy con tys) = tupleParens std_con (interpp'SP tys)
   where std_con = case con of
                     HsUnboxedTuple -> UnboxedTuple
                     _              -> BoxedTuple
index 9d3ef75..e99ad4d 100644 (file)
@@ -24,7 +24,7 @@ import TcRnMonad
 import TyCon
 import ConLike
 import DataCon    (dataConName, dataConWorkId, dataConTyCon)
-import PrelInfo   ( knownKeyNames )
+import PrelInfo   (wiredInThings, basicKnownKeyNames)
 import Id         (idName, isDataConWorkId_maybe)
 import TysWiredIn
 import IfaceEnv
@@ -303,11 +303,14 @@ 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
@@ -346,7 +349,7 @@ putTupleName_ bh tc tup_sort thing_tag
     sort_tag = case tup_sort of
                  BoxedTuple      -> 0
                  UnboxedTuple    -> 1
-                 ConstraintTuple -> pprPanic "putTupleName:ConstraintTuple" (ppr tc)
+                 ConstraintTuple -> 2
 
 -- See Note [Symbol table representation of names]
 getSymtabName :: NameCacheUpdater
@@ -367,10 +370,11 @@ getSymtabName _ncu _dict symtab bh = do
                         2 -> idName (dataConWorkId dc)
                         _ -> pprPanic "getSymtabName:unknown tuple thing" (ppr i)
           where
-            dc = tupleDataCon sort arity
+            dc = tupleCon sort arity
             sort = case (i .&. 0x30000000) `shiftR` 28 of
-                     0 -> Boxed
-                     1 -> Unboxed
+                     0 -> BoxedTuple
+                     1 -> UnboxedTuple
+                     2 -> ConstraintTuple
                      _ -> pprPanic "getSymtabName:unknown tuple sort" (ppr i)
             thing_tag = (i .&. 0x0CFFFFFF) `shiftR` 26
             arity = fromIntegral (i .&. 0x03FFFFFF)
index b6db5dc..6e14700 100644 (file)
@@ -21,7 +21,6 @@ module BuildTyCl (
 
 import IfaceEnv
 import FamInstEnv( FamInstEnvs )
-import TysWiredIn( isCTupleTyConName )
 import DataCon
 import PatSyn
 import Var
@@ -283,9 +282,6 @@ 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 c5aa1a5..0838cb8 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 (pprWithCommas ppr as)
+pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 
 pprIfaceExpr add_par i@(IfaceLam _ _)
   = add_par (sep [char '\\' <+> sep (map pprIfaceLamBndr bndrs) <+> arrow,
@@ -1136,10 +1136,11 @@ 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 (IfaceTupleTy _ _ ts) = freeNamesIfTcArgs ts
+freeNamesIfType (IfaceTyConApp tc ts) =
+   freeNamesIfTc tc &&& 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 6dfff6e..dc3c5c5 100644 (file)
@@ -10,8 +10,7 @@ This module defines interface types and binders
 module IfaceType (
         IfExtName, IfLclName,
 
-        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
-        IfaceTyCon(..), IfaceTyConInfo(..),
+        IfaceType(..), IfacePredType, IfaceKind, IfaceTyCon(..), IfaceCoercion(..),
         IfaceTyLit(..), IfaceTcArgs(..),
         IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr, IfaceTvBndr, IfaceIdBndr,
 
@@ -45,12 +44,12 @@ module IfaceType (
 #include "HsVersions.h"
 
 import Coercion
-import DataCon ( isTupleDataCon )
+import DataCon ( dataConTyCon )
 import TcType
 import DynFlags
 import TypeRep
 import Unique( hasKey )
-import Util ( filterOut, zipWithEqual )
+import Util ( filterOut, lengthIs, zipWithEqual )
 import TyCon hiding ( pprPromotionQuote )
 import CoAxiom
 import Id
@@ -100,19 +99,13 @@ 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
-
-  | 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
+                                          -- Includes newtypes, synonyms, tuples
+  | IfaceLitTy IfaceTyLit
 
 type IfacePredType = IfaceType
 type IfaceContext = [IfacePredType]
@@ -135,14 +128,10 @@ data IfaceTcArgs
 -- coercion constructors, the lot.
 -- We have to tag them in order to pretty print them
 -- properly.
-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 IfaceTyCon
+  = IfaceTc              { ifaceTyConName :: IfExtName }
+  | IfacePromotedDataCon { ifaceTyConName :: IfExtName }
+  | IfacePromotedTyCon   { ifaceTyConName :: IfExtName }
 
 data IfaceCoercion
   = IfaceReflCo      Role IfaceType
@@ -218,9 +207,8 @@ ifTyVarsOfType ty
       IfaceForAllTy (var,t) ty
         -> delOneFromUniqSet (ifTyVarsOfType ty) var `unionUniqSets`
            ifTyVarsOfType t
-      IfaceTyConApp _ args  -> ifTyVarsOfArgs args
-      IfaceTupleTy _ _ args -> ifTyVarsOfArgs args
-      IfaceLitTy    _       -> emptyUniqSet
+      IfaceTyConApp _ args -> ifTyVarsOfArgs args
+      IfaceLitTy    _      -> emptyUniqSet
 
 ifTyVarsOfArgs :: IfaceTcArgs -> UniqSet IfLclName
 ifTyVarsOfArgs args = argv emptyUniqSet args
@@ -250,7 +238,6 @@ 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
@@ -317,6 +304,18 @@ we want
 
 ************************************************************************
 *                                                                      *
+                Functions over IFaceTyCon
+*                                                                      *
+************************************************************************
+-}
+
+--isPromotedIfaceTyCon :: IfaceTyCon -> Bool
+--isPromotedIfaceTyCon (IfacePromotedTyCon _) = True
+--isPromotedIfaceTyCon _ = False
+
+{-
+************************************************************************
+*                                                                      *
                 Pretty-printing
 *                                                                      *
 ************************************************************************
@@ -396,7 +395,6 @@ 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)
@@ -523,6 +521,10 @@ 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)
 
@@ -538,10 +540,22 @@ ppr_iface_tc_app pp ctxt_prec tc tys
   where
     tc_name = ifaceTyConName tc
 
-pprTuple :: TupleSort -> IfaceTyConInfo -> IfaceTcArgs -> SDoc
-pprTuple sort info args
-  = pprPromotionQuoteI info <>
-    tupleParens sort (pprWithCommas pprIfaceType (tcArgsIfaceTypes args))
+    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
+
 
 ppr_tylit :: IfaceTyLit -> SDoc
 ppr_tylit (IfaceNumTyLit n) = integer n
@@ -621,34 +635,27 @@ instance Outputable IfaceTyCon where
   ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
 
 pprPromotionQuote :: IfaceTyCon -> SDoc
-pprPromotionQuote tc = pprPromotionQuoteI (ifaceTyConInfo tc)
-
-pprPromotionQuoteI  :: IfaceTyConInfo -> SDoc
-pprPromotionQuoteI NoIfaceTyConInfo     = empty
-pprPromotionQuoteI IfacePromotedDataCon = char '\''
-pprPromotionQuoteI IfacePromotedTyCon   = ifPprDebug (char '\'')
+pprPromotionQuote (IfacePromotedDataCon _ ) = char '\''
+pprPromotionQuote (IfacePromotedTyCon _)    = ifPprDebug (char '\'')
+pprPromotionQuote _                         = empty
 
 instance Outputable IfaceCoercion where
   ppr = pprIfaceCoercion
 
 instance Binary IfaceTyCon where
-   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
+   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
 
    get bh =
-     do i <- getByte bh
-        case i of
-          0 -> return NoIfaceTyConInfo
-          1 -> return IfacePromotedDataCon
-          _ -> return IfacePromotedTyCon
+     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)
 
 instance Outputable IfaceTyLit where
   ppr = ppr_tylit
@@ -722,10 +729,9 @@ 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 7; put_ bh n }
+      = do { putByte bh 30; put_ bh n }
 
     get bh = do
             h <- getByte bh
@@ -746,8 +752,6 @@ 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)
 
@@ -900,32 +904,12 @@ 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)  -- 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
+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)
 
 toIfaceTyVar :: TyVar -> FastString
 toIfaceTyVar = occNameFS . getOccName
@@ -936,17 +920,13 @@ toIfaceCoVar = occNameFS . getOccName
 ----------------
 toIfaceTyCon :: TyCon -> IfaceTyCon
 toIfaceTyCon tc
-  = IfaceTyCon tc_name info
-  where
-    tc_name = tyConName tc
-    info | isPromotedDataCon tc = IfacePromotedDataCon
-         | isPromotedTyCon tc   = IfacePromotedTyCon
-         | otherwise            = NoIfaceTyConInfo
+  | isPromotedDataCon tc = IfacePromotedDataCon tc_name
+  | isPromotedTyCon tc   = IfacePromotedTyCon tc_name
+  | otherwise            = IfaceTc tc_name
+    where tc_name = tyConName tc
 
 toIfaceTyCon_name :: Name -> IfaceTyCon
-toIfaceTyCon_name n = IfaceTyCon n NoIfaceTyConInfo
-  -- Used for the "rough-match" tycon stuff,
-  -- where pretty-printing is not an issue
+toIfaceTyCon_name = IfaceTc
 
 toIfaceTyLit :: TyLit -> IfaceTyLit
 toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x
index 2553643..1beae57 100644 (file)
@@ -49,7 +49,7 @@ import DataCon
 import PrelNames
 import TysWiredIn
 import TysPrim          ( superKindTyConName )
-import BasicTypes       ( strongLoopBreaker, Arity, TupleSort(..), Boxity(..) )
+import BasicTypes       ( strongLoopBreaker )
 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.roughTopNames does
+        -- This function *must* mirror exactly what Rules.topFreeName 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,7 +652,6 @@ 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
@@ -806,7 +805,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
                      -- name is not a tycon => internal inconsistency
                    Just _              -> notATyConErr
                      -- tycon is external
-                   Nothing             -> tcIfaceTyConByName name
+                   Nothing             -> tcIfaceTyCon (IfaceTc name)
                }
 
         notATyConErr = pprPanic "TcIface.tcIfaceVectInfo: not a tycon" (ppr name)
@@ -825,7 +824,6 @@ 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') }
@@ -844,34 +842,6 @@ 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
@@ -972,15 +942,15 @@ tcIfaceExpr (IfaceFCall cc ty) = do
     dflags <- getDynFlags
     return (Var (mkFCallId dflags u cc ty'))
 
-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) }
+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)
   where
     arity = length args
+    con_id = dataConWorkId (tupleCon boxity arity)
+
 
 tcIfaceExpr (IfaceLam (bndr, os) body)
   = bindIfaceBndr bndr $ \bndr' ->
@@ -1089,7 +1059,7 @@ tcIfaceLit :: Literal -> IfL Literal
 -- so tcIfaceLit just fills in the type.
 -- See Note [Integer literals] in Literal
 tcIfaceLit (LitInteger i _)
-  = do t <- tcIfaceTyConByName integerTyConName
+  = do t <- tcIfaceTyCon (IfaceTc integerTyConName)
        return (mkLitInteger i (mkTyConTy t))
 tcIfaceLit lit = return lit
 
@@ -1267,7 +1237,6 @@ 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]
@@ -1310,25 +1279,20 @@ 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 (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)
+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)
+    }
 
 tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
index 22bd4e6..0f23fc2 100644 (file)
@@ -17,9 +17,6 @@ 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 5ae104b..0acbdff 100644 (file)
@@ -90,7 +90,9 @@ import BasicTypes       ( HValue )
 import ByteCodeGen      ( byteCodeGen, coreExprToBCOs )
 import Linker
 import CoreTidy         ( tidyExpr )
-import Type             ( Type, Kind )
+import Type             ( Type )
+import PrelNames
+import {- Kind parts of -} Type         ( Kind )
 import CoreLint         ( lintInteractiveExpr )
 import VarEnv           ( emptyTidyEnv )
 import Panic
@@ -99,6 +101,7 @@ import ConLike
 import GHC.Exts
 #endif
 
+import DsMeta           ( templateHaskellNames )
 import Module
 import Packages
 import RdrName
@@ -189,6 +192,12 @@ 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 e2876a4..914a145 100644 (file)
@@ -43,6 +43,7 @@ import CmdLineParser
 import FastString
 import SrcLoc
 import Util
+-- import Maybes                ( firstJusts )
 import Panic
 
 import Control.Monad
index 7ffa6b6..eb2aa0c 100644 (file)
@@ -80,7 +80,7 @@ import TcEvidence       ( emptyTcEvBinds )
 -- compiler/prelude
 import ForeignCall
 import TysPrim          ( liftedTypeKindTyConName, eqPrimTyCon )
-import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
+import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
                           unboxedUnitTyCon, unboxedUnitDataCon,
                           listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
 
@@ -728,9 +728,10 @@ qcname_ext :: { Located RdrName }       -- Variable or data constructor
         |  'type' qcname            {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
                                             [mj AnnType $1,mj AnnVal $2] }
 
-qcname  :: { Located RdrName }  -- Variable or type constructor
+-- Cannot pull into qcname_ext, as qcname is also used in expression.
+qcname  :: { Located RdrName }  -- Variable or data constructor
         :  qvar                         { $1 }
-        |  oqtycon                      { $1 }
+        |  qcon                         { $1 }
 
 -----------------------------------------------------------------------------
 -- Import Declarations
@@ -2276,9 +2277,8 @@ aexp1   :: { LHsExpr RdrName }
         | aexp2                { $1 }
 
 aexp2   :: { LHsExpr RdrName }
-        : qvar                          { sL1 $1 (HsVar   $! unLoc $1) }
-        | qcon                          { sL1 $1 (HsVar   $! unLoc $1) }
-        | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
+        : ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
+        | qcname                        { sL1 $1 (HsVar   $! 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 $> $ tupleDataCon Boxed (snd $2 + 1))
+        | '(' commas ')'        {% ams (sLL $1 $> $ tupleCon BoxedTuple (snd $2 + 1))
                                        (mop $1:mcp $3:(mcommas (fst $2))) }
         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
-        | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleCon UnboxedTuple (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 Boxed
+        | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon BoxedTuple
                                                         (snd $2 + 1)))
                                        (mop $1:mcp $3:(mcommas (fst $2))) }
-        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon UnboxedTuple
                                                         (snd $2 + 1)))
                                        (mo $1:mc $3:(mcommas (fst $2))) }
         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
index 39589fe..f0dc1ea 100644 (file)
@@ -21,7 +21,6 @@ module RdrHsSyn (
         mkPatSynMatchGroup,
         mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
         mkTyClD, mkInstD,
-        setRdrNameSpace,
 
         cvBindGroup,
         cvBindsAndSigs,
@@ -66,24 +65,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
-import Name
-import BasicTypes
+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 TcEvidence       ( idHsWrapper )
 import Lexer
-import Type             ( TyThing(..) )
-import TysWiredIn       ( cTupleTyConName, tupleTyCon, tupleDataCon,
-                          nilDataConName, nilDataConKey,
-                          listTyConName, listTyConKey )
+import TysWiredIn       ( unitTyCon, unitDataCon )
 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
@@ -138,7 +137,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 True tycl_hdr
+       ; (cls, tparams,ann) <- checkTyClHdr 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
@@ -272,7 +271,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 False tycl_hdr
+  = do { (tc, tparams,ann) <- checkTyClHdr 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
@@ -307,7 +306,7 @@ mkTySynonym :: SrcSpan
             -> LHsType RdrName  -- RHS
             -> P (LTyClDecl RdrName)
 mkTySynonym loc lhs rhs
-  = do { (tc, tparams,ann) <- checkTyClHdr False lhs
+  = do { (tc, tparams,ann) <- checkTyClHdr 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) <>
@@ -320,7 +319,7 @@ mkTyFamInstEqn :: LHsType RdrName
                -> LHsType RdrName
                -> P (TyFamInstEqn RdrName,[AddAnn])
 mkTyFamInstEqn lhs rhs
-  = do { (tc, tparams,ann) <- checkTyClHdr False lhs
+  = do { (tc, tparams,ann) <- checkTyClHdr lhs
        ; let err xhs = hang (text "In type family instance equation of" <+>
                              quotes (ppr tc) <> colon)
                        2 (ppr xhs)
@@ -340,7 +339,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 False tycl_hdr
+  = do { (tc, tparams,ann) <- checkTyClHdr 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 (
@@ -360,7 +359,7 @@ mkFamDecl :: SrcSpan
           -> Maybe (LHsKind RdrName) -- Optional kind signature
           -> P (LTyClDecl RdrName)
 mkFamDecl loc info lhs ksig
-  = do { (tc, tparams,ann) <- checkTyClHdr False lhs
+  = do { (tc, tparams,ann) <- checkTyClHdr 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
@@ -546,9 +545,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 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)
+   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)
 
    mk_rest [L l (HsRecTy flds)] = RecCon (L l flds)
    mk_rest ts                   = PrefixCon ts
@@ -663,91 +662,6 @@ 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
@@ -824,9 +738,7 @@ checkRecordSyntax lr@(L loc r)
                       (text "Illegal record syntax (use TraditionalRecordSyntax):" <+>
                        ppr r)
 
-checkTyClHdr :: Bool               -- True  <=> class header
-                                   -- False <=> type header
-             -> LHsType RdrName
+checkTyClHdr :: 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
@@ -834,28 +746,22 @@ checkTyClHdr :: Bool               -- True  <=> class header
 -- Decomposes   T ty1 .. tyn   into    (T, [ty1, ..., tyn])
 --              Int :*: Bool   into    (:*:, [Int, Bool])
 -- returning the pieces
-checkTyClHdr is_cls ty
+checkTyClHdr 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 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)
+    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)
 
 checkContext :: LHsType RdrName -> P (LHsContext RdrName)
 checkContext (L l orig_t)
@@ -1575,12 +1481,14 @@ mkModuleImpExp n@(L l name) subs =
   case subs of
     ImpExpAbs
       | isVarNameSpace (rdrNameSpace name) -> IEVar       n
-      | otherwise                          -> IEThingAbs  (L l name)
-    ImpExpAll                              -> IEThingAll  (L l name)
-    ImpExpList xs                          -> IEThingWith (L l name) xs
+      | otherwise                          -> IEThingAbs  (L l nameT)
+    ImpExpAll                              -> IEThingAll  (L l nameT)
+    ImpExpList xs                          -> IEThingWith (L l nameT) xs
+
+  where
+    nameT = setRdrNameSpace name tcClsName
 
-mkTypeImpExp :: Located RdrName   -- TcCls or Var name space
-             -> P (Located RdrName)
+mkTypeImpExp :: Located RdrName -> P (Located RdrName)
 mkTypeImpExp name =
   do allowed <- extension explicitNamespacesEnabled
      if allowed
index 4d1cd9a..2303a8e 100644 (file)
@@ -10,7 +10,7 @@ module PrelInfo (
         primOpRules, builtinRules,
 
         ghcPrimExports,
-        wiredInThings, knownKeyNames,
+        wiredInThings, basicKnownKeyNames,
         primOpId,
 
         -- Random other things
@@ -30,7 +30,6 @@ import PrimOp
 import DataCon
 import Id
 import MkId
-import Name( Name, getName )
 import TysPrim
 import TysWiredIn
 import HscTypes
@@ -39,31 +38,12 @@ 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
-
-{- *********************************************************************
+{-
+************************************************************************
 *                                                                      *
-                Wired in things
+\subsection[builtinNameInfo]{Lookup built-in names}
 *                                                                      *
 ************************************************************************
 
index ded9583..113dfdc 100644 (file)
@@ -121,6 +121,7 @@ import Module
 import OccName
 import RdrName
 import Unique
+import BasicTypes
 import Name
 import SrcLoc
 import FastString
@@ -519,6 +520,19 @@ 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
 *                                                                      *
 ************************************************************************
@@ -1558,6 +1572,9 @@ typeRepTyConKey = mkPreludeTyConUnique 183
 
 #include "primop-vector-uniques.hs-incl"
 
+unitTyConKey :: Unique
+unitTyConKey = mkTupleTyConUnique BoxedTuple 0
+
 {-
 ************************************************************************
 *                                                                      *
index 1ab8543..5c6b700 100644 (file)
@@ -907,7 +907,7 @@ seqRule :: RuleM CoreExpr
 seqRule = do
   [ty_a, Type ty_s, a, s] <- getArgs
   guard $ exprIsHNF a
-  return $ mkConApp (tupleDataCon Unboxed 2)
+  return $ mkConApp (tupleCon UnboxedTuple 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 (tupleDataCon Unboxed 2)
+  = Just $ mkConApp (tupleCon UnboxedTuple 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 (tupleDataCon Unboxed 2)
+            Just $ mkConApp (tupleCon UnboxedTuple 2)
                             [Type integerTy,
                              Type intHashTy,
                              Lit (LitInteger y integerTy),
index dbeade2..de6d49b 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(..), Boxity(..) )
+import BasicTypes       ( Arity, Fixity(..), FixityDirection(..), TupleSort(..) )
 import ForeignCall      ( CLabelString )
 import Unique           ( Unique, mkPrimOpIdUnique )
 import Outputable
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
deleted file mode 100644 (file)
index 5ccfaeb..0000000
+++ /dev/null
@@ -1,836 +0,0 @@
--- %************************************************************************
--- %*                                                                   *
---              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 34c1838..6c2ffb7 100644 (file)
@@ -43,22 +43,21 @@ module TysWiredIn (
         wordTyCon, wordDataCon, wordTyConName, wordTy,
 
         -- * List
-        listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
-        nilDataCon, nilDataConName, nilDataConKey,
-        consDataCon_RDR, consDataCon, consDataConName,
-
+        listTyCon, nilDataCon, nilDataConName, consDataCon, consDataConName,
+        listTyCon_RDR, consDataCon_RDR, listTyConName,
         mkListTy, mkPromotedListTy,
 
         -- * Tuples
         mkTupleTy, mkBoxedTupleTy,
-        tupleTyCon, tupleDataCon, tupleTyConName,
+        tupleTyCon, tupleCon,
         promotedTupleTyCon, promotedTupleDataCon,
-        unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
-        pairTyCon,
+        unitTyCon, unitDataCon, unitDataConId, pairTyCon,
         unboxedUnitTyCon, unboxedUnitDataCon,
         unboxedSingletonTyCon, unboxedSingletonDataCon,
         unboxedPairTyCon, unboxedPairDataCon,
-        cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
+
+        -- * Unit
+        unitTy,
 
         -- * Kinds
         typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,
@@ -85,7 +84,7 @@ import PrelNames
 import TysPrim
 
 -- others:
-import Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
+import Constants        ( mAX_TUPLE_SIZE )
 import Module           ( Module )
 import Type             ( mkTyConApp )
 import DataCon
@@ -96,14 +95,11 @@ import Class            ( Class, mkClass )
 import TypeRep
 import RdrName
 import Name
-import NameSet          ( NameSet, mkNameSet, elemNameSet )
-import BasicTypes       ( Arity, RecFlag(..), Boxity(..),
-                           TupleSort(..) )
+import BasicTypes       ( TupleSort(..), tupleSortBoxity,
+                          Arity, RecFlag(..), Boxity(..) )
 import ForeignCall
-import Unique           ( incrUnique,
-                          mkTupleTyConUnique, mkTupleDataConUnique,
-                          mkCTupleTyConUnique, mkPArrDataConUnique )
-import SrcLoc           ( noSrcSpan )
+import Unique           ( incrUnique, mkTupleTyConUnique,
+                          mkTupleDataConUnique, mkPArrDataConUnique )
 import Data.Array
 import FastString
 import Outputable
@@ -323,39 +319,14 @@ 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, 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
+  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.
 
 * When looking up an OccName in the original-name cache
   (IfaceEnv.lookupOrigNameCache), we spot the tuple OccName to make sure
@@ -369,164 +340,140 @@ isBuiltInOcc_maybe :: OccName -> Maybe Name
 -- map to wired-in Names with BuiltInSyntax
 isBuiltInOcc_maybe occ
   = case occNameString occ of
-        "[]"             -> choose_ns listTyConName nilDataConName
+        "[]"             -> choose_ns listTyCon nilDataCon
         ":"              -> Just consDataConName
         "[::]"           -> Just parrTyConName
-        "()"             -> tup_name Boxed      0
-        "(##)"           -> tup_name Unboxed    0
-        '(':',':rest     -> parse_tuple Boxed   2 rest
-        '(':'#':',':rest -> parse_tuple Unboxed 2 rest
+        "(##)"           -> choose_ns unboxedUnitTyCon unboxedUnitDataCon
+        "()"             -> choose_ns unitTyCon        unitDataCon
+        '(':'#':',':rest -> parse_tuple UnboxedTuple 2 rest
+        '(':',':rest     -> parse_tuple BoxedTuple   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  = tup_name sort n
+      | tail_matches sort rest  = choose_ns (tupleTyCon sort n)
+                                            (tupleCon   sort n)
       | otherwise               = Nothing
 
-    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))
+    tail_matches BoxedTuple   ")"  = True
+    tail_matches UnboxedTuple "#)" = True
+    tail_matches _            _    = False
 
     choose_ns tc dc
-      | isTcClsNameSpace ns   = Just tc
-      | isDataConNameSpace ns = Just dc
-      | otherwise             = pprPanic "tup_name" (ppr occ)
+      | isTcClsNameSpace ns   = Just (getName tc)
+      | isDataConNameSpace ns = Just (getName dc)
+      | otherwise             = Just (getName (dataConWorkId dc))
 
-mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
+mkTupleOcc :: NameSpace -> TupleSort -> 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
-                Unboxed    -> '(' : '#' : commas ++ "#)"
-                Boxed      -> '(' : commas ++ ")"
-
-    commas = take (ar-1) (repeat ',')
+                UnboxedTuple    -> '(' : '#' : commas ++ "#)"
+                BoxedTuple      -> '(' : commas ++ ")"
+                ConstraintTuple -> '(' : commas ++ ")"
 
-mkCTupleOcc :: NameSpace -> Arity -> OccName
-mkCTupleOcc ns ar = mkOccName ns str
-  where
-    str    = "(%" ++ commas ++ "%)"
     commas = take (ar-1) (repeat ',')
 
-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
+    -- 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
 tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)  -- Build one specially
-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)
+tupleTyCon BoxedTuple      i = fst (boxedTupleArr   ! i)
+tupleTyCon UnboxedTuple    i = fst (unboxedTupleArr ! i)
+tupleTyCon ConstraintTuple i = fst (factTupleArr    ! i)
 
-promotedTupleTyCon :: Boxity -> Arity -> TyCon
-promotedTupleTyCon boxity i = promoteTyCon (tupleTyCon boxity i)
+promotedTupleTyCon :: TupleSort -> Arity -> TyCon
+promotedTupleTyCon sort i = promoteTyCon (tupleTyCon sort i)
 
-promotedTupleDataCon :: Boxity -> Arity -> TyCon
-promotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i)
+promotedTupleDataCon :: TupleSort -> Arity -> TyCon
+promotedTupleDataCon sort i = promoteDataCon (tupleCon sort 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)
+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)
 
-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]]
+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]]
 
-mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
-mk_tuple boxity arity = (tycon, tuple_con)
+mk_tuple :: TupleSort -> Int -> (TyCon,DataCon)
+mk_tuple sort arity = (tycon, tuple_con)
   where
-        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
+        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
                                 (ATyCon tycon) BuiltInSyntax
         tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
+        res_kind = case sort of
+          BoxedTuple      -> liftedTypeKind
+          UnboxedTuple    -> unliftedTypeKind
+          ConstraintTuple -> constraintKind
 
-        res_kind = case boxity of
-                     Boxed   -> liftedTypeKind
-                     Unboxed -> unliftedTypeKind
-
-        tyvars = take arity $ case boxity of
-                   Boxed   -> alphaTyVars
-                   Unboxed -> openAlphaTyVars
+        tyvars = take arity $ case sort of
+          BoxedTuple      -> alphaTyVars
+          UnboxedTuple    -> openAlphaTyVars
+          ConstraintTuple -> tyVarList constraintKind
 
         tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
         tyvar_tys = mkTyVarTys tyvars
-        dc_name   = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
+        dc_name   = mkWiredInName modu (mkTupleOcc dataName sort arity) dc_uniq
                                   (AConLike (RealDataCon tuple_con)) BuiltInSyntax
-        tc_uniq   = mkTupleTyConUnique   boxity arity
-        dc_uniq   = mkTupleDataConUnique boxity arity
+        tc_uniq   = mkTupleTyConUnique   sort arity
+        dc_uniq   = mkTupleDataConUnique sort arity
 
 unitTyCon :: TyCon
-unitTyCon = tupleTyCon Boxed 0
-
-unitTyConKey :: Unique
-unitTyConKey = getUnique unitTyCon
-
+unitTyCon     = tupleTyCon BoxedTuple 0
 unitDataCon :: DataCon
 unitDataCon   = head (tyConDataCons unitTyCon)
-
 unitDataConId :: Id
 unitDataConId = dataConWorkId unitDataCon
 
 pairTyCon :: TyCon
-pairTyCon = tupleTyCon Boxed 2
+pairTyCon = tupleTyCon BoxedTuple 2
 
 unboxedUnitTyCon :: TyCon
-unboxedUnitTyCon = tupleTyCon Unboxed 0
-
+unboxedUnitTyCon   = tupleTyCon UnboxedTuple 0
 unboxedUnitDataCon :: DataCon
-unboxedUnitDataCon = tupleDataCon   Unboxed 0
+unboxedUnitDataCon = tupleCon   UnboxedTuple 0
 
 unboxedSingletonTyCon :: TyCon
-unboxedSingletonTyCon = tupleTyCon Unboxed 1
-
+unboxedSingletonTyCon   = tupleTyCon UnboxedTuple 1
 unboxedSingletonDataCon :: DataCon
-unboxedSingletonDataCon = tupleDataCon Unboxed 1
+unboxedSingletonDataCon = tupleCon   UnboxedTuple 1
 
 unboxedPairTyCon :: TyCon
-unboxedPairTyCon = tupleTyCon Unboxed 2
-
+unboxedPairTyCon   = tupleTyCon UnboxedTuple 2
 unboxedPairDataCon :: DataCon
-unboxedPairDataCon = tupleDataCon Unboxed 2
+unboxedPairDataCon = tupleCon   UnboxedTuple 2
 
 {-
 ************************************************************************
@@ -807,17 +754,17 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 \end{itemize}
 -}
 
-mkTupleTy :: Boxity -> [Type] -> Type
+mkTupleTy :: TupleSort -> [Type] -> Type
 -- Special case for *boxed* 1-tuples, which are represented by the type itself
-mkTupleTy Boxed  [ty] = ty
-mkTupleTy boxity tys  = mkTyConApp (tupleTyCon boxity (length tys)) tys
+mkTupleTy sort [ty] | Boxed <- tupleSortBoxity sort = ty
+mkTupleTy sort tys = mkTyConApp (tupleTyCon sort (length tys)) tys
 
 -- | Build the type of a small tuple that holds the specified type of thing
 mkBoxedTupleTy :: [Type] -> Type
-mkBoxedTupleTy tys = mkTupleTy Boxed tys
+mkBoxedTupleTy tys = mkTupleTy BoxedTuple tys
 
 unitTy :: Type
-unitTy = mkTupleTy Boxed []
+unitTy = mkTupleTy BoxedTuple []
 
 {-
 ************************************************************************
index 28da6cb..0794412 100644 (file)
@@ -53,7 +53,6 @@ import RdrName
 import HscTypes
 import TcEnv            ( tcLookupDataCon, tcLookupField, isBrackStage )
 import TcRnMonad
-import RdrHsSyn         ( setRdrNameSpace )
 import Id               ( isRecordSelector )
 import Name
 import NameSet
index 00381b3..036d652 100644 (file)
@@ -32,7 +32,6 @@ import NameSet
 import Avail
 import HscTypes
 import RdrName
-import RdrHsSyn        ( setRdrNameSpace )
 import Outputable
 import Maybes
 import SrcLoc
@@ -653,14 +652,10 @@ 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.
 -}
@@ -768,30 +763,19 @@ 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, 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]))]
+            (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               = []
             case mb_parent of
-              Nothing     -> return ([(renamed_ie, avail)], warns)
-                             -- non-associated ty/cls
-              Just parent -> return ((renamed_ie, AvailTC parent [name]) : sub_avails, warns)
-                             -- associated type
+              -- 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)
 
         IEThingAbs (L l tc)
             | want_hiding   -- hiding ( C )
index 737dcc9..5d12720 100644 (file)
@@ -37,15 +37,15 @@ import {-# SOURCE #-} RnExpr   ( rnLExpr )
 
 import PrelNames        ( isUnboundName )
 import TcEnv            ( checkWellStaged )
-import THNames          ( liftName )
+import DsMeta           ( liftName )
 
 #ifdef GHCI
 import ErrUtils         ( dumpIfSet_dyn_printer )
+import DsMeta           ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
 import TcEnv            ( tcMetaTy )
 import Hooks
 import Var              ( Id )
-import THNames          ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
-                        , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
+import DsMeta           ( quoteExpName, quotePatName, quoteDecName, quoteTypeName )
 import Util
 
 import {-# SOURCE #-} TcExpr   ( tcMonoExpr )
index f3d592f..0fc6ccf 100644 (file)
@@ -59,7 +59,7 @@ import BasicTypes
 type UnariseEnv = VarEnv [Id]
 
 ubxTupleId0 :: Id
-ubxTupleId0 = dataConWorkId (tupleDataCon Unboxed 0)
+ubxTupleId0 = dataConWorkId (tupleCon UnboxedTuple 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 (tupleDataCon Unboxed (length tys))
+    StgConApp (tupleCon UnboxedTuple (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 (tupleDataCon Unboxed (length args')) args'
+  | isUnboxedTupleCon dc = StgConApp (tupleCon UnboxedTuple (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 (tupleDataCon Unboxed n), ys, uses, unariseExpr us2' rho' e)])
+  = (UbxTupAlt n, [(DataAlt (tupleCon UnboxedTuple 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 (tupleDataCon Unboxed n), ys', uses', unariseExpr us2' rho'' e)])
+  = (UbxTupAlt n, [(DataAlt (tupleCon UnboxedTuple n), ys', uses', unariseExpr us2' rho'' e)])
   where
     (us2', rho', ys', uses') = unariseUsedIdBinders us rho ys uses
     rho'' = extendVarEnv rho' bndr ys'
index 61633f9..de1bf08 100644 (file)
@@ -1725,7 +1725,8 @@ mkCallUDs' env f args
 
     type_determines_value pred    -- See Note [Type determines value]
         = case classifyPredType pred of
-            ClassPred cls _ -> not (isIPClass cls)  -- Superclasses can't be IPs
+            ClassPred cls _ -> not (isIPClass cls)
+            TuplePred ps    -> all type_determines_value ps
             EqPred {}       -> True
             IrredPred {}    -> True   -- Things like (D []) where D is a
                                       -- Constraint-ranged family; Trac #7785
index 304a3cb..8c96afa 100644 (file)
@@ -24,11 +24,11 @@ import Demand
 import MkCore           ( mkRuntimeErrorApp, aBSENT_ERROR_ID )
 import MkId             ( voidArgId, voidPrimId )
 import TysPrim          ( voidPrimTy )
-import TysWiredIn       ( tupleDataCon )
+import TysWiredIn       ( tupleCon )
 import Type
 import Coercion hiding  ( substTy, substTyVarBndr )
 import FamInstEnv
-import BasicTypes       ( Boxity(..), OneShotInfo(..), worstOneShot )
+import BasicTypes       ( TupleSort(..), 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  = tupleDataCon Unboxed (length arg_tys)
+             ubx_tup_con  = tupleCon UnboxedTuple (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 830873c..53ecb48 100644 (file)
@@ -23,7 +23,6 @@ import Name
 import Var
 import Class
 import Type
-import TcType( immSuperClasses )
 import Unify
 import InstEnv
 import VarSet
@@ -446,29 +445,32 @@ 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   = fixVarSet extend fixed_tvs
+  | otherwise   = loop fixed_tvs
   where
-    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
+    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
 
     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])]
-            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
-            _ -> []
+            TuplePred ts       -> concatMap determined ts
+            _                  -> []
 
 {-
 ************************************************************************
index 1383bdd..78a53fb 100644 (file)
@@ -173,11 +173,42 @@ 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
 *                                                                      *
 ************************************************************************
@@ -353,6 +384,7 @@ 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 a4c4703..88c88bd 100644 (file)
@@ -320,6 +320,8 @@ 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 6e02694..6dd01f9 100644 (file)
@@ -14,7 +14,7 @@ module TcEvidence (
   EvBindMap(..), emptyEvBindMap, extendEvBinds,
                  lookupEvBind, evBindMapBinds, foldEvBindMap,
   EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,
-  EvTerm(..), mkEvCast, evVarsOfTerm, mkEvScSelectors,
+  EvTerm(..), mkEvCast, evVarsOfTerm, mkEvTupleSelectors, mkEvScSelectors,
   EvLit(..), evTermCoercion,
   EvCallStack(..),
   EvTypeable(..),
@@ -712,6 +712,10 @@ 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
@@ -971,6 +975,11 @@ 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..]
@@ -997,8 +1006,10 @@ 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
@@ -1078,6 +1089,8 @@ 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 a962258..155cdb4 100644 (file)
@@ -16,7 +16,7 @@ module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC,
 #include "HsVersions.h"
 
 import {-# SOURCE #-}   TcSplice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket )
-import THNames( liftStringName, liftName )
+import DsMeta( 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 boxity (length tup_args)
+  = do { let tup_tc = tupleTyCon (boxityNormalTupleSort 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 boxity arity
+             tup_tc = tupleTyCon (boxityNormalTupleSort 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 THNames.liftStringName
+                     do { sid <- tcLookupId DsMeta.liftStringName
                                      -- See Note [Lifting strings]
                         ; return (HsVar sid) }
                   else
                      setConstraintVar lie_var   $
                           -- Put the 'lift' constraint into the right LIE
                      newMethodFromName (OccurrenceOf (idName id))
-                                       THNames.liftName id_ty
+                                       DsMeta.liftName id_ty
 
                    -- Update the pending splices
         ; ps <- readMutVar ps_var
index d30c1ca..d18e6ed 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     :: TyCon -> [a] -> a   -- Tuple type
+        , ft_tup     :: TupleSort -> [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,7 +1644,8 @@ 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
-       | isTupleTyCon con = (caseTuple con xrs, True)
+       | Just sort <- tyConTuple_maybe con
+                          = (caseTuple sort 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)
@@ -1715,11 +1716,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)))
-                  -> 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] }
+                  -> 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]
 
 {-
 ************************************************************************
index 02d993f..80dd175 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 bx tys
+hsPatType (TuplePat _ bx tys)         = mkTupleTy (boxityNormalTupleSort bx) tys
 hsPatType (ConPatOut { pat_con = L _ con, pat_arg_tys = tys })
                                       = conLikeResTy con tys
 hsPatType (SigPatOut _ ty)            = ty
@@ -1247,6 +1247,7 @@ 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) =
@@ -1270,6 +1271,8 @@ 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 785dce7..fbd21b2 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   Boxed n
-             ty_con     = promotedTupleDataCon Boxed n
+             kind_con   = promotedTupleTyCon   BoxedTuple n
+             ty_con     = promotedTupleDataCon BoxedTuple n
              (taus, ks) = unzip tks
              tup_k      = mkTyConApp kind_con ks
        ; checkExpectedKind hs_ty tup_k exp_kind
@@ -568,15 +568,10 @@ 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
-       ; 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)
+       ; checkWiredInTyCon tycon
        ; return (mkTyConApp tycon tau_tys) }
   where
-    arity = length tau_tys
+    tycon = tupleTyCon tup_sort (length tau_tys)
     res_kind = case tup_sort of
                  UnboxedTuple    -> unliftedTypeKind
                  BoxedTuple      -> liftedTypeKind
@@ -1563,7 +1558,7 @@ tc_hs_kind (HsTupleTy _ kis) =
      checkWiredInTyCon tycon
      return $ mkTyConApp tycon kappas
   where
-     tycon = promotedTupleTyCon Boxed (length kis)
+     tycon = promotedTupleTyCon BoxedTuple (length kis)
 
 -- Argument not kind-shaped
 tc_hs_kind k = pprPanic "tc_hs_kind" (ppr k)
index de5df6a..ed4fd91 100644 (file)
@@ -1015,6 +1015,7 @@ 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
@@ -1022,8 +1023,7 @@ 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
-      | not (isCTupleClass cls)
-      , sizeTypes tys >= head_size  -- Here is where we test for
+      | sizeTypes tys >= head_size  -- Here is where we test for
       = []                          -- a smaller dictionary
       | otherwise
       = concatMap super_classes (mkEvScSelectors ev_tm cls tys)
index 18a798f..95715fe 100644 (file)
@@ -27,7 +27,6 @@ import PrelNames ( knownNatClassName, knownSymbolClassName, ipClassNameKey,
 import Id( idType )
 import Class
 import TyCon
-import DataCon( dataConWrapId )
 import FunDeps
 import FamInst
 import Inst( tyVarsOfCt )
@@ -1531,12 +1530,13 @@ emitFunDepDeriveds fd_eqns
 
 topReactionsStage :: WorkItem -> TcS (StopOrContinue Ct)
 topReactionsStage wi
- = do { tir <- doTopReact wi
+ = do { inerts <- getTcSInerts
+      ; tir <- doTopReact inerts wi
       ; case tir of
           ContinueWith wi -> return (ContinueWith wi)
           Stop ev s       -> return (Stop ev (ptext (sLit "Top react:") <+> s)) }
 
-doTopReact :: WorkItem -> TcS (StopOrContinue Ct)
+doTopReact :: InertSet -> WorkItem -> TcS (StopOrContinue Ct)
 -- The work item does not react with the inert set, so try interaction with top-level
 -- instances. Note:
 --
@@ -1544,11 +1544,10 @@ doTopReact :: WorkItem -> TcS (StopOrContinue Ct)
 --       Instead superclasses are added in the worklist as part of the
 --       canonicalization process. See Note [Adding superclasses].
 
-doTopReact work_item
+doTopReact inerts work_item
   = do { traceTcS "doTopReact" (ppr work_item)
        ; case work_item of
-           CDictCan {}  -> do { inerts <- getTcSInerts
-                              ; doTopReactDict inerts work_item }
+           CDictCan {}  -> doTopReactDict inerts work_item
            CFunEqCan {} -> doTopReactFunEq work_item
            _  -> -- Any other work item does not react with any top-level equations
                  return (ContinueWith work_item)  }
@@ -1570,9 +1569,8 @@ doTopReactDict inerts work_item@(CDictCan { cc_ev = fl, cc_class = cls
                   -- of generating some improvements
                   -- C.f. Example 3 of Note [The improvement story]
                   -- It's easy because no evidence is involved
-   = do { dflags <- getDynFlags
-        ; lkup_inst_res <- matchClassInst dflags inerts cls xis dict_loc
-        ; case lkup_inst_res of
+   = do { lkup_inst_res <- matchClassInst inerts cls xis dict_loc
+         ; case lkup_inst_res of
                GenInst preds _ s -> do { mapM_ (emitNewDerived dict_loc) preds
                                        ; unless s $
                                            insertSafeOverlapFailureTcS work_item
@@ -1583,9 +1581,8 @@ doTopReactDict inerts work_item@(CDictCan { cc_ev = fl, cc_class = cls
                                        ; continueWith work_item } }
 
   | otherwise  -- Wanted, but not cached
-   = do { dflags <- getDynFlags
-        ; lkup_inst_res <- matchClassInst dflags inerts cls xis dict_loc
-        ; case lkup_inst_res of
+   = do { lkup_inst_res <- matchClassInst inerts cls xis dict_loc
+         ; case lkup_inst_res of
                GenInst theta mk_ev s -> do { addSolvedDict fl cls xis
                                            ; unless s $
                                                insertSafeOverlapFailureTcS work_item
@@ -1987,41 +1984,9 @@ instance Outputable LookupInstResult where
     where ss = text $ if s then "[safe]" else "[unsafe]"
 
 
-matchClassInst :: DynFlags -> InertSet -> Class -> [Type] -> CtLoc -> TcS LookupInstResult
-
--- First check whether there is an in-scope Given that could
--- match this constraint.  In that case, do not use top-level
--- instances.  See Note [Instance and Given overlap]
-matchClassInst dflags inerts clas tys _
-  | not (xopt Opt_IncoherentInstances dflags)
-  , not (isEmptyBag matchable_givens)
-  = do { traceTcS "Delaying instance application" $
-              vcat [ text "Work item=" <+> pprType (mkClassPred clas tys)
-                   , text "Relevant given dictionaries="
-                           <+> ppr matchable_givens ]
-       ; return NoInstance }
-  where
-     matchable_givens :: Cts
-     matchable_givens = filterBag matchable_given $
-                        findDictsByClass (inert_dicts $ inert_cans inerts) clas
-
-     matchable_given ct
-       | CDictCan { cc_class = clas_g, cc_tyargs = sys, cc_ev = fl } <- ct
-       , isGiven fl
-       , Just {} <- tcUnifyTys bind_meta_tv tys sys
-       = ASSERT( clas_g == clas ) True
-     matchable_given _ = False
-
-     bind_meta_tv :: TcTyVar -> BindFlag
-     -- Any meta tyvar may be unified later, so we treat it as
-     -- bindable when unifying with givens. That ensures that we
-     -- conservatively assume that a meta tyvar might get unified with
-     -- something that matches the 'given', until demonstrated
-     -- otherwise.
-     bind_meta_tv tv | isMetaTyVar tv = BindMe
-                     | otherwise      = Skolem
+matchClassInst :: InertSet -> Class -> [Type] -> CtLoc -> TcS LookupInstResult
 
-matchClassInst _ clas [ ty ] _
+matchClassInst _ clas [ ty ] _
   | className clas == knownNatClassName
   , Just n <- isNumLitTy ty = makeDict (EvNum n)
 
@@ -2057,22 +2022,17 @@ 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)
-        tuple_ev = EvDFunApp (dataConWrapId data_con) ts
-  = return (GenInst ts tuple_ev True)
-            -- The dfun is the data constructor!
+matchClassInst _ clas [k,t] _
+  | className clas == typeableClassName = matchTypeableClass clas k t
 
-matchClassInst _ _ clas [k,t] _
-  | className clas == typeableClassName
-  = matchTypeableClass clas k t
-
-matchClassInst dflags _ clas tys loc
-   = do { traceTcS "matchClassInst" $ vcat [ text "pred =" <+> ppr pred ]
+matchClassInst inerts clas tys loc
+   = do { dflags <- getDynFlags
+        ; traceTcS "matchClassInst" $ vcat [ text "pred =" <+> ppr pred
+                                           , text "inerts=" <+> ppr inerts ]
         ; instEnvs <- getInstEnvs
-        ; let safeOverlapCheck = safeHaskell dflags `elem` [Sf_Safe, Sf_Trustworthy]
-              (matches, unify, unsafeOverlaps) = lookupInstEnv True instEnvs clas tys
+        ; safeOverlapCheck <- ((`elem` [Sf_Safe, Sf_Trustworthy]) . safeHaskell)
+                            `fmap` getDynFlags
+        ; let (matches, unify, unsafeOverlaps) = lookupInstEnv True instEnvs clas tys
               safeHaskFail = safeOverlapCheck && not (null unsafeOverlaps)
         ; case (matches, unify, safeHaskFail) of
 
@@ -2084,6 +2044,16 @@ matchClassInst dflags _ clas tys loc
 
             -- A single match (& no safe haskell failure)
             ([(ispec, inst_tys)], [], False)
+                | not (xopt Opt_IncoherentInstances dflags)
+                , not (isEmptyBag unifiable_givens)
+                -> -- See Note [Instance and Given overlap]
+                   do { traceTcS "Delaying instance application" $
+                          vcat [ text "Work item=" <+> pprType (mkClassPred clas tys)
+                               , text "Relevant given dictionaries="
+                                     <+> ppr unifiable_givens ]
+                      ; return NoInstance  }
+
+                | otherwise
                 -> do   { let dfun_id = instanceDFunId ispec
                         ; traceTcS "matchClass success" $
                           vcat [text "dict" <+> ppr pred,
@@ -2109,6 +2079,26 @@ matchClassInst dflags _ clas tys loc
             ; (tys, theta) <- instDFunType dfun_id mb_inst_tys
             ; return $ GenInst theta (EvDFunApp dfun_id tys) so }
 
+     unifiable_givens :: Cts
+     unifiable_givens = filterBag matchable $
+                        findDictsByClass (inert_dicts $ inert_cans inerts) clas
+
+     matchable (CDictCan { cc_class = clas_g, cc_tyargs = sys, cc_ev = fl })
+       | isGiven fl
+       , Just {} <- tcUnifyTys bind_meta_tv tys sys
+       = ASSERT( clas_g == clas ) True
+       | otherwise = False -- No overlap with a solved, already been taken care of
+                           -- by the overlap check with the instance environment.
+     matchable ct = pprPanic "Expecting dictionary!" (ppr ct)
+
+     bind_meta_tv :: TcTyVar -> BindFlag
+     -- Any meta tyvar may be unified later, so we treat it as
+     -- bindable when unifying with givens. That ensures that we
+     -- conservatively assume that a meta tyvar might get unified with
+     -- something that matches the 'given', until demonstrated
+     -- otherwise.
+     bind_meta_tv tv | isMetaTyVar tv = BindMe
+                     | otherwise      = Skolem
 
 {- Note [Instance and Given overlap]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2144,18 +2134,12 @@ Trac #4981 and #5002.
 
 Other notes:
 
-* The check is done *first*, so that it also covers classes
-  with built-in instance solving, such as
-     - constraint tuples
-     - natural numbers
-     - Typeable
-
-* The given-overlap problem is arguably not easy to appear in practice
-  due to our aggressive prioritization of equality solving over other
+* This is arguably not easy to appear in practice due to our
+  aggressive prioritization of equality solving over other
   constraints, but it is possible. I've added a test case in
   typecheck/should-compile/GivenOverlapping.hs
 
-* Another "live" example is Trac #10195; another is #10177.
+* Another "live" example is Trac #10195
 
 * We ignore the overlap problem if -XIncoherentInstances is in force:
   see Trac #6002 for a worked-out example where this makes a
index a5d5555..0eaae8f 100644 (file)
@@ -143,6 +143,7 @@ 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 df2ad18..93c4728 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 boxity (length pats)
+  = do  { let tc = tupleTyCon (boxityNormalTupleSort boxity) (length pats)
         ; (coi, arg_tys) <- matchExpectedPatTy (matchExpectedTyConApp tc) pat_ty
         ; (pats', res) <- tc_lpats penv pats arg_tys thing_inside
 
index 820e969..ea454d5 100644 (file)
@@ -1016,10 +1016,6 @@ 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 ee0740f..e970579 100644 (file)
@@ -614,6 +614,7 @@ 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 a7363d8..4ecbd50 100644 (file)
@@ -38,7 +38,7 @@ import Outputable
 import TcExpr
 import SrcLoc
 import FastString
-import THNames
+import DsMeta
 import TcUnify
 import TcEnv
 
index 1b324f6..6ac8720 100644 (file)
@@ -581,24 +581,13 @@ 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 $
-    do { traceTc "tcTyAndCl-x" (ppr decl)
-       ; tcTyClDecl1 NoParentTyCon rec_info decl }
+    traceTc "tcTyAndCl-x" (ppr decl) >>
+    tcTyClDecl1 NoParentTyCon rec_info decl
 
   -- "type family" declarations
 tcTyClDecl1 :: TyConParent -> RecTyInfo -> TyClDecl Name -> TcM [TyThing]
@@ -799,7 +788,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)
@@ -1451,9 +1440,6 @@ checkValidTyCl thing
 
 checkValidTyCon :: TyCon -> TcM ()
 checkValidTyCon tc
-  | isPrimTyCon tc   -- Happens when Haddock'ing GHC.Prim
-  = return ()
-
   | Just cl <- tyConClass_maybe tc
   = checkValidClass cl
 
index 9ce1449..4d4f682 100644 (file)
@@ -1377,6 +1377,7 @@ 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]
@@ -1386,9 +1387,10 @@ 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]
@@ -1404,6 +1406,7 @@ 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 16059e6..3225b28 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,6 +45,7 @@ import Util
 import ListSetOps
 import SrcLoc
 import Outputable
+import Unique           ( hasKey )
 import BasicTypes       ( IntWithInf, infinity )
 import FastString
 
@@ -395,11 +396,7 @@ 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 SigmaCtxt theta
-                -- Allow     type T = ?x::Int => Int -> Int
-                -- but not   type T = ?x::Int
-
+        ; check_valid_theta ctxt theta
         ; check_type ctxt rank tau }      -- Allow foralls to right of arrow
   where
     (tvs, theta, tau) = tcSplitSigmaTy ty
@@ -620,16 +617,15 @@ 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)
-        | 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
+      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
       _ -> check_irred_pred under_syn dflags ctxt pred
 
 check_eq_pred :: DynFlags -> PredType -> [TcType] -> TcM ()
@@ -660,22 +656,16 @@ 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)
-        failIfTc (not under_syn && not (xopt Opt_ConstraintKinds dflags)
-                                && hasTyVarHead pred)
-                 (predIrredErr pred)
+        checkTc (under_syn || xopt Opt_ConstraintKinds dflags || not (hasTyVarHead pred))
+                (predIrredErr pred)
 
          -- Make sure it is OK to have an irred pred in this context
          -- See Note [Irreducible predicates in superclasses]
-       ; failIfTc (is_superclass ctxt
-                   && not (xopt Opt_UndecidableInstances dflags)
-                   && has_tyfun_head pred)
-                  (predSuperClassErr pred) }
+       ; checkTc (xopt Opt_UndecidableInstances dflags || not (dodgy_superclass ctxt))
+                 (predIrredBadCtxtErr pred) }
   where
-    is_superclass ctxt = case ctxt of { ClassSCCtxt _ -> True; _ -> False }
-    has_tyfun_head ty
-      = case tcSplitTyConApp_maybe ty of
-          Just (tc, _) -> isTypeFamilyTyCon tc
-          Nothing      -> False
+    dodgy_superclass ctxt
+       = case ctxt of { ClassSCCtxt _ -> True; InstDeclCtxt -> True; _ -> False }
 
 {- Note [ConstraintKinds in predicates]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -689,7 +679,7 @@ e.g.   module A where
 
 Note [Irreducible predicates in superclasses]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Allowing type-family calls in class superclasses is somewhat dangerous
+Allowing irreducible predicates in class superclasses is somewhat dangerous
 because we can write:
 
  type family Fooish x :: * -> Constraint
@@ -698,7 +688,10 @@ 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.  -}
+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. -}
 
 -------------------------
 check_class_pred :: DynFlags -> UserTypeCtxt -> PredType -> Class -> [TcType] -> TcM ()
@@ -729,25 +722,10 @@ 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 (TySynCtxt {})    = False
-okIPCtxt (RuleSigCtxt {})  = False
-okIPCtxt DefaultDeclCtxt   = False
+okIPCtxt _                 = True
 
 badIPPred :: PredType -> SDoc
 badIPPred pred = ptext (sLit "Illegal implicit parameter") <+> quotes (ppr pred)
@@ -778,9 +756,10 @@ checkThetaCtxt ctxt theta
   = vcat [ptext (sLit "In the context:") <+> pprTheta theta,
           ptext (sLit "While checking") <+> pprUserTypeCtxt ctxt ]
 
-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")) ]
+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"))
 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")) ]
@@ -788,10 +767,9 @@ predTupleErr pred  = hang (ptext (sLit "Illegal tuple constraint:") <+> pprType
                         2 (parens constraintKindsMsg)
 predIrredErr pred  = hang (ptext (sLit "Illegal constraint:") <+> pprType pred)
                         2 (parens constraintKindsMsg)
-predSuperClassErr pred
-  = hang (ptext (sLit "Illegal constraint") <+> quotes (pprType pred)
-          <+> ptext (sLit "in a superclass context"))
-       2 (parens undecidableMsg)
+predIrredBadCtxtErr pred = hang (ptext (sLit "Illegal constraint") <+> quotes (pprType pred)
+                                 <+> ptext (sLit "in a superclass/instance context"))
+                               2 (parens undecidableMsg)
 
 constraintSynErr :: Type -> SDoc
 constraintSynErr kind = hang (ptext (sLit "Illegal constraint synonym of kind:") <+> quotes (ppr kind))
@@ -908,9 +886,10 @@ not converge.  See Trac #5287.
 validDerivPred :: TyVarSet -> PredType -> Bool
 validDerivPred tv_set pred
   = case classifyPredType pred of
-       ClassPred _ tys -> check_tys tys
-       EqPred {}       -> False  -- reject equality constraints
-       _               -> True   -- Non-class predicates are ok
+       ClassPred _ tys       -> check_tys tys
+       TuplePred ps          -> all (validDerivPred tv_set) ps
+       EqPred {}             -> False  -- reject equality constraints
+       _                     -> True   -- Non-class predicates are ok
   where
     check_tys tys = hasNoDups fvs
                     && sizeTypes tys == fromIntegral (length fvs)
@@ -984,9 +963,6 @@ 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
@@ -1000,45 +976,36 @@ checkInstTermination tys theta
 
    check :: PredType -> TcM ()
    check pred
-     = 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 ()
+     = 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 ()
      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}))
 
-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")
+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") ]
 
-undecidableMsg, constraintKindsMsg :: SDoc
+smallerMsg, undecidableMsg, constraintKindsMsg :: SDoc
+smallerMsg         = ptext (sLit "Constraint is no smaller than the instance head")
 undecidableMsg     = ptext (sLit "Use UndecidableInstances to permit this")
 constraintKindsMsg = ptext (sLit "Use ConstraintKinds to permit this")
 
@@ -1225,12 +1192,16 @@ checkFamInstRhs lhsTys famInsts
    size = sizeTypes lhsTys
    fvs  = fvTypes lhsTys
    check (tc, tys)
-      | not (all isTyFamFree tys) = Just (nestedMsg what)
-      | not (null bad_tvs)        = Just (noMoreMsg bad_tvs what)
-      | size <= sizeTypes tys     = Just (smallerMsg what)
-      | otherwise                 = Nothing
+      | 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
       where
-        what    = ptext (sLit "type family application") <+> quotes (pprType (TyConApp tc tys))
+        famInst = TyConApp tc tys
         bad_tvs = filterOut isKindVar (fvTypes tys \\ fvs)
              -- Rightly or wrongly, we only check for
              -- excessive occurrences of *type* variables.
@@ -1276,10 +1247,11 @@ tyFamInstIllegalErr ty
          colon) 2 $
       ppr ty
 
-nestedMsg :: SDoc -> SDoc
-nestedMsg what
-  = sep [ ptext (sLit "Illegal nested") <+> what
-        , parens undecidableMsg ]
+famInstUndecErr :: Type -> SDoc -> SDoc
+famInstUndecErr ty msg
+  = sep [msg,
+         nest 2 (ptext (sLit "in the type family application:") <+>
+                 pprType ty)]
 
 famPatErr :: TyCon -> [TyVar] -> [Type] -> SDoc
 famPatErr fam_tc tvs pats
@@ -1288,6 +1260,10 @@ 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")
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1355,14 +1331,14 @@ sizeTypes xs = sum (map sizeType tys)
 -- "local instances" in expressions).
 -- See Trac #4200.
 sizePred :: PredType -> TypeSize
-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
+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
 
 {-
 ************************************************************************
index 827c076..1861343 100644 (file)
@@ -61,8 +61,7 @@ module TyCon(
         tyConTyVars,
         tyConCType, tyConCType_maybe,
         tyConDataCons, tyConDataCons_maybe,
-        tyConSingleDataCon_maybe, tyConSingleDataCon,
-        tyConSingleAlgDataCon_maybe,
+        tyConSingleDataCon_maybe, tyConSingleAlgDataCon_maybe,
         tyConFamilySize,
         tyConStupidTheta,
         tyConArity,
@@ -1039,7 +1038,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 promoted
+               Nothing    -- Class TyCons are not pormoted
 
 mkTupleTyCon :: Name
              -> Kind    -- ^ Kind of the resulting 'TyCon'
@@ -1048,9 +1047,8 @@ 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 parent
+mkTupleTyCon name kind arity tyvars con sort prom_tc
   = AlgTyCon {
         tyConName        = name,
         tyConUnique      = nameUnique name,
@@ -1061,7 +1059,7 @@ mkTupleTyCon name kind arity tyvars con sort prom_tc parent
         tyConCType       = Nothing,
         algTcStupidTheta = [],
         algTcRhs         = TupleTyCon { data_con = con, tup_sort = sort },
-        algTcParent      = parent,
+        algTcParent      = NoParentTyCon,
         algTcRec         = NonRecursive,
         algTcGadtSyntax  = False,
         tcPromoted       = prom_tc
@@ -1472,23 +1470,17 @@ 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 = 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
+isImplicitTyCon (AlgTyCon { algTcRhs = TupleTyCon {} })             = True
+isImplicitTyCon (AlgTyCon { algTcParent = AssocFamilyTyCon {} })    = True
+isImplicitTyCon (AlgTyCon {})                                       = False
+isImplicitTyCon (FamilyTyCon { famTcParent = AssocFamilyTyCon {} }) = True
+isImplicitTyCon (FamilyTyCon {})                                    = False
+isImplicitTyCon (SynonymTyCon {})                                   = False
 
 tyConCType_maybe :: TyCon -> Maybe CType
 tyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc
@@ -1556,12 +1548,6 @@ 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 41b6b2d..f29791c 100644 (file)
@@ -50,7 +50,6 @@ module Type (
         mkClassPred,
         isClassPred, isEqPred,
         isIPPred, isIPPred_maybe, isIPTyCon, isIPClass,
-        isCTupleClass,
 
         -- Deconstructing predicate types
         PredTree(..), EqRel(..), eqRelRole, classifyPredType,
@@ -914,9 +913,6 @@ 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
@@ -1024,6 +1020,7 @@ eqRelRole ReprEq = Representational
 
 data PredTree = ClassPred Class [Type]
               | EqPred EqRel Type Type
+              | TuplePred [PredType]
               | IrredPred PredType
 
 classifyPredType :: PredType -> PredTree
@@ -1038,6 +1035,8 @@ 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 527bfda..f755f3f 100644 (file)
@@ -78,7 +78,6 @@ import Outputable
 import FastString
 import Util
 import DynFlags
-import StaticFlags( opt_PprStyle_Debug )
 
 -- libraries
 import Data.List( mapAccumL, partition )
@@ -744,7 +743,8 @@ 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 $ pprWithCommas (pp TopPrec) ty_args)
+    (tupleParens tup_sort $
+     sep (punctuate comma (map (pp TopPrec) ty_args)))
 
   | otherwise
   = sdocWithDynFlags (pprTcApp_help p pp tc tys)
@@ -754,12 +754,11 @@ pprTupleApp :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> TupleSort -> [a] -> S
 pprTupleApp p pp tc sort tys
   | null tys
   , ConstraintTuple <- sort
-  = if opt_PprStyle_Debug then ptext (sLit "(%%)")
-                          else maybeParen p FunPrec $
-                               ptext (sLit "() :: Constraint")
+  = maybeParen p TopPrec $
+    ppr tc <+> dcolon <+> ppr (tyConKind tc)
   | otherwise
   = pprPromotionQuote tc <>
-    tupleParens sort (pprWithCommas (pp TopPrec) tys)
+    tupleParens sort (sep (punctuate comma (map (pp TopPrec) tys)))
 
 pprTcApp_help :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> DynFlags -> SDoc
 -- This one has accss to the DynFlags
index d5bbd65..bcd85cb 100644 (file)
@@ -141,7 +141,7 @@ sumTyCon        = indexBuiltin "sumTyCon" sumTyCons
 prodTyCon :: Int -> Builtins -> TyCon
 prodTyCon n _
   | n >= 2 && n <= mAX_DPH_PROD 
-  = tupleTyCon Boxed n
+  = tupleTyCon BoxedTuple n
   | otherwise
   = pprPanic "prodTyCon" (ppr n)
 
index ee7cf9c..6770103 100644 (file)
@@ -192,7 +192,7 @@ initBuiltinVars (Builtins { })
     preludeDataCons
       = [mk_tup n (mkFastString $ "tup" ++ show n) | n <- [2..5]]
       where
-        mk_tup n name = (tupleDataCon Boxed n, name)
+        mk_tup n name = (tupleCon BoxedTuple n, name)
 
 
 -- Auxilliary look up functions -----------------------------------------------
index 335b34b..0a918f8 100644 (file)
@@ -22,7 +22,7 @@ import TyCon
 import DataCon
 import MkId
 import TysWiredIn
-import BasicTypes( Boxity(..) )
+import BasicTypes( TupleSort(..) )
 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   = tupleDataCon Boxed (length vs)
+      let venv_con   = tupleCon BoxedTuple (length vs) 
           [lenv_con] = tyConDataCons lenv_tc
 
           venv       = mkCoreTup (map Var vvs)
index 73ae69e..1f9ec2d 100644 (file)
@@ -1,17 +1,11 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,
-             KindSignatures, DataKinds, ConstraintKinds,
-              MultiParamTypeClasses, FunctionalDependencies #-}
+             KindSignatures, DataKinds, MultiParamTypeClasses, FunctionalDependencies #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
   -- ip :: IP x a => a  is strictly speaking ambiguous, but IP is magic
 
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
--- -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh.
-
-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
--- -fno-warn-unused-top-binds is there (I hope) to stop Haddock complaining
--- about the constraint tuples being defined but not used
-
+-- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh.
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
@@ -320,37 +314,3 @@ 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 4ebda15..3c4c8c2 100644 (file)
@@ -23,141 +23,113 @@ 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,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)
+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__
 
 {- 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 a25d7ff..e893974 100644 (file)
@@ -1,5 +1,5 @@
 {-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples,
-             MultiParamTypeClasses, RoleAnnotations #-}
+             RoleAnnotations #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Types
diff --git a/testsuite/tests/ghci/scripts/T10248.script b/testsuite/tests/ghci/scripts/T10248.script
deleted file mode 100644 (file)
index 6614044..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-:set -fdefer-type-errors
-Just <$> _
diff --git a/testsuite/tests/ghci/scripts/T10248.stderr b/testsuite/tests/ghci/scripts/T10248.stderr
deleted file mode 100644 (file)
index 1245b99..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-
-<interactive>:3:10: warning:
-    Found hole ‘_’ with type: IO ()
-    In the second argument of ‘(<$>)’, namely ‘_’
-    In the first argument of ‘ghciStepIO ::
-                                IO a_alT -> IO a_alT’, namely
-      ‘Just <$> _’
-    In a stmt of an interactive GHCi command:
-      it <- ghciStepIO :: IO a_alT -> IO a_alT (Just <$> _)
-*** Exception: <interactive>:3:10: error:
-    Found hole ‘_’ with type: IO ()
-    In the second argument of ‘(<$>)’, namely ‘_’
-    In the first argument of ‘ghciStepIO ::
-                                IO a_alT -> IO a_alT’, namely
-      ‘Just <$> _’
-    In a stmt of an interactive GHCi command:
-      it <- ghciStepIO :: IO a_alT -> IO a_alT (Just <$> _)
-(deferred type error)
index 85ba5af..1582344 100755 (executable)
@@ -216,4 +216,3 @@ test('T10408A', normal, run_command,
     ['$MAKE -s --no-print-directory T10408A'])
 test('T10408B', normal, run_command,
     ['$MAKE -s --no-print-directory T10408B'])
-test('T10248', normal, ghci_script, ['T10248.script'])
index 1594d19..dd479b7 100644 (file)
@@ -1,17 +1,18 @@
-\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
+
+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’
index bdc9c5f..15cd757 100644 (file)
@@ -1,17 +1,18 @@
-\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
+
+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’
index d0b37aa..c4c2fff 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, [''])
+test('mod89', normal, compile_fail, [''])
 test('mod90', normal, compile_fail, [''])
 test('mod91', normal, compile_fail, [''])
 test('mod92', normal, compile, [''])
index 1e903a0..2c48d65 100644 (file)
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wall #-}
-
 -- !!! Sublist for non-class/tycon
 module M where
 import Prelude(map(..))
index b355f30..0f95653 100644 (file)
@@ -1,10 +1,2 @@
-\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
+
+mod89.hs:3:16: Module ‘Prelude’ does not export ‘map(..)’
diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.hs b/testsuite/tests/partial-sigs/should_compile/T10403.hs
deleted file mode 100644 (file)
index a33646d..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE PartialTypeSignatures #-}
-module T10403 where
-
-data I a = I a
-instance Functor I where
-    fmap f (I a) = I (f a)
-
-newtype B t a = B a
-instance Functor (B t) where
-    fmap f (B a) = B (f a)
-
-newtype H f = H (f ())
-
-app :: H (B t)
-app = h (H . I) (B ())
-
-h :: _ => _
---h :: Functor m => (a -> b) -> m a -> H m
-h f b = (H . fmap (const ())) (fmap f b)
diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.stderr b/testsuite/tests/partial-sigs/should_compile/T10403.stderr
deleted file mode 100644 (file)
index 6b0660d..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-
-T10403.hs:17:6: warning:
-    Found hole ‘_’ with inferred constraints: Functor f
-    In the type signature for ‘h’: _ => _
-
-T10403.hs:17:11: warning:
-    Found hole ‘_’ with type: (a -> b) -> f a -> H f
-    Where: ‘f’ is a rigid type variable bound by
-               the inferred type of h :: Functor f => (a -> b) -> f a -> H f
-               at T10403.hs:19:1
-           ‘b’ is a rigid type variable bound by
-               the inferred type of h :: Functor f => (a -> b) -> f a -> H f
-               at T10403.hs:19:1
-           ‘a’ is a rigid type variable bound by
-               the inferred type of h :: Functor f => (a -> b) -> f a -> H f
-               at T10403.hs:19:1
-    In the type signature for ‘h’: _ => _
index 91294a5..e83e070 100644 (file)
@@ -46,4 +46,3 @@ test('SomethingShowable', normal, compile, ['-ddump-types -fno-warn-partial-type
 test('Uncurry', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
 test('UncurryNamed', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
 test('WarningWildcardInstantiations', normal, compile, ['-ddump-types'])
-test('T10403', normal, compile, [''])
diff --git a/testsuite/tests/perf/should_run/T10359.hs b/testsuite/tests/perf/should_run/T10359.hs
deleted file mode 100644 (file)
index fa10560..0000000
+++ /dev/null
@@ -1,125 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ConstraintKinds #-}
-
-module Main( main, boo ) where
-
-import Prelude hiding (repeat)
-
-boo xs f = (\x -> f x, xs)
-
-repeat :: Int -> (a -> a) -> a -> a
-repeat 1 f x = f x
-repeat n f x = n `seq` x `seq` repeat (n-1) f $ f x
-
----- Buggy version
-------------------
-
-type Numerical a = (Fractional a, Real a)
-
-data Box a = Box
-    { func :: forall dum. (Numerical dum) => dum -> a -> a
-    , obj :: !a }
-
-do_step :: (Numerical num) => num -> Box a -> Box a
-do_step number Box{..} = Box{ obj = func number obj, .. }
-
-start :: Box Double
-start = Box { func = \x y -> realToFrac x + y
-            , obj = 0 }
-
-test :: Int -> IO ()
-test steps = putStrLn $ show $ obj $ repeat steps (do_step 1) start
-
----- Driver
------------
-
-main :: IO ()
-main = test 2000 -- compare test2 10000000 or test3 10000000, but test4 20000
-
-
-{-
----- No tuple constraint synonym is better
-------------------------------------------
-
-data Box2 a = Box2
-    { func2 :: forall num. (Fractional num, Real num) => num -> a -> a
-    , obj2 :: !a }
-
-do_step2 :: (Fractional num, Real num) => num -> Box2 a -> Box2 a
-do_step2 number Box2{..} = Box2{ obj2 = func2 number obj2, ..}
-
-start2 :: Box2 Double
-start2 = Box2 { func2 = \x y -> realToFrac x + y
-              , obj2 = 0 }
-
-test2 :: Int -> IO ()
-test2 steps = putStrLn $ show $ obj2 $ repeat steps (do_step2 1) start2
-
----- Not copying the function field works too
----------------------------------------------
-
-do_step3 :: (Numerical num) => num -> Box a -> Box a
-do_step3 number b@Box{..} = b{ obj = func number obj }
-
-test3 :: Int -> IO ()
-test3 steps = putStrLn $ show $ obj $ repeat steps (do_step3 1) start
-
----- But record wildcards are not at fault
-------------------------------------------
-
-do_step4 :: (Numerical num) => num -> Box a -> Box a
-do_step4 number Box{func = f, obj = x} = Box{ obj = f number x, func = f }
-
-test4 :: Int -> IO ()
-test4 steps = putStrLn $ show $ obj $ repeat steps (do_step4 1) start
--}
-
-
-{-
-First of all, very nice example. Thank you for making it so small and easy to work with.
-
-I can see what's happening. The key part is what happens here:
-{{{
-do_step4 :: (Numerical num) => num -> Box a -> Box a
-do_step4 number Box{ func = f, obj = x}
-              = Box{ func = f, obj = f number x }
-}}}
-After elaboration (ie making dictionaries explicit) we get this:
-{{{
-do_step4 dn1 number (Box {func = f, obj = x })
-  = Box { func = \dn2 -> f ( case dn2 of (f,r) -> f
-                           , case dn2 of (f,r) -> r)
-        , obj = f dn1 number x }
-}}}
-That's odd!  We expected this:
-{{{
-do_step4 dn1 number (Box {func = f, obj = x })
-  = Box { func = f
-        , obj = f dn1 number x }
-}}}
-And indeed, the allocation of all those `\dn2` closures is what is causing the problem.
-So we are missing this optimisation:
-{{{
-   (case dn2 of (f,r) -> f, case dn2 of (f,r) -> r)
-===>
-   dn2
-}}}
-If we did this, then the lambda would look like `\dn2 -> f dn2` which could eta-reduce to `f`.
-But there are at least three problems:
- * The tuple transformation above is hard to spot
- * The tuple transformation is not quite semantically right; if `dn2` was bottom, the LHS and RHS are different
- * The eta-reduction isn't quite semantically right: if `f` ws bottom, the LHS and RHS are different.
-
-You might argue that the latter two can be ignored because dictionary arguments are special;
-indeed we often toy with making them strict.
-
-But perhaps a better way to avoid the tuple-transformation issue would be not to construct that strange expression in the first place. Where is it coming from?  It comes from the call to `f` (admittedly applied to no arguments) in `Box { ..., func = f }`.  GHC needs a dictionary for `(Numerical dum)` (I changed the name of the type variable in `func`'s type in the definition of `Box`).  Since it's just a pair GHC says "fine, I'll build a pair, out of `Fractional dum` and `Real dum`.  How does it get those dictionaries?  By selecting the components of the `Franctional dum` passed to `f`.
-
-If GHC said instead "I need `Numerical dum` and behold I have one in hand, it'd be much better. It doesn't because tuple constraints are treated specially.  But if we adopted the idea in #10362, we would (automatically) get to re-use the `Numerical dum` constraint.  That would leave us with eta reduction, which is easier.
-
-As to what will get you rolling, a good solution is `test3`, which saves instantiating and re-generalising `f`. The key thing is to update all the fields ''except'' the polymorphic `func` field. I'm surprised you say that it doesn't work.  Can you give a (presumably more complicated) example to demonstrate? Maybe there's a separate bug!
-
--}
-
-
diff --git a/testsuite/tests/perf/should_run/T10359.stdout b/testsuite/tests/perf/should_run/T10359.stdout
deleted file mode 100644 (file)
index f6f4e07..0000000
+++ /dev/null
@@ -1 +0,0 @@
-2000.0
index c95dfa0..f680104 100644 (file)
@@ -1,16 +1,8 @@
 # Tests that newArray/newArray_ is being optimised correctly
 
-test('T10359',
-     [stats_num_field('bytes allocated',
-          [(wordsize(64), 499512, 5),
-           (wordsize(32), 250000, 5)]),
-      only_ways(['normal'])
-      ],
-     compile_and_run,
-     ['-O'])
-
 # fortunately the values here are mostly independent of the wordsize,
 # because the test allocates an unboxed array of doubles.
+
 test('T3586',
      [stats_num_field('peak_megabytes_allocated', (17, 1)),
                                  # expected value: 17 (amd64/Linux)
index 61c62ea..2f815b1 100644 (file)
@@ -1,14 +1,14 @@
-\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
+
+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
index 44a0618..96fbc3e 100644 (file)
@@ -1,12 +1,12 @@
-\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
+
+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)’
index da76658..3a2e5a5 100644 (file)
@@ -1,6 +1,6 @@
 \r
 tcfail108.hs:7:10: error:\r
-    Variable ‘f’ occurs more often\r
-      in the constraint ‘Eq (f (Rec f))’ than in the instance head\r
+    Variable ‘f’ occurs more often than in the instance head\r
+      in the constraint: Eq (f (Rec f))\r
     (Use UndecidableInstances to permit this)\r
     In the instance declaration for ‘Eq (Rec f)’\r
index 903f61b..9014b64 100644 (file)
@@ -1,6 +1,6 @@
-\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
+
+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)’
index 113e0cc..acdc7df 100644 (file)
@@ -1,12 +1,12 @@
-\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
+
+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 -> ())’
index a29b758..a6b63bd 100644 (file)
@@ -1,7 +1,7 @@
-\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
+
+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’
index a2741b8..5520a3e 100644 (file)
@@ -1,5 +1,7 @@
-\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
+
+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]’
index 560fc31..129bae3 100644 (file)
@@ -1,4 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 module ShouldFail where
 
+data Bool a b c d = False
 data Maybe a b = Nothing
index 432dc4c..6a4e873 100644 (file)
@@ -1,9 +1,17 @@
-[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
+[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
index a7bc421..803323f 100644 (file)
@@ -813,7 +813,7 @@ ppType (TyApp (TyCon "TVar#") [x,y])     = "mkTVarPrimTy " ++ ppType x
 
 ppType (TyApp (VecTyCon _ pptc) [])      = pptc
 
-ppType (TyUTup ts) = "(mkTupleTy Unboxed " 
+ppType (TyUTup ts) = "(mkTupleTy UnboxedTuple " 
                      ++ listify (map ppType ts) ++ ")"
 
 ppType (TyF s d) = "(mkFunTy (" ++ ppType s ++ ") (" ++ ppType d ++ "))"
index 5a57a24..2380f07 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 5a57a24c44e06e964c4ea2276c842c722c4e93d9
+Subproject commit 2380f07c430c525b205ce2eae6dab23c8388d899