Comments, and rename FactTuple to ConstraintTuple

9 files changed, 48 insertions, 28 deletions

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index e892316bf8..62aaddd723 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -387,21 +387,22 @@ pprSafeOverlap False = empty
 data TupleSort
   = BoxedTuple
   | UnboxedTuple
-  | FactTuple
+  | ConstraintTuple
   deriving( Eq, Data, Typeable )
 
 tupleSortBoxity :: TupleSort -> Boxity
-tupleSortBoxity BoxedTuple   = Boxed
-tupleSortBoxity UnboxedTuple = Unboxed
-tupleSortBoxity FactTuple    = Boxed
+tupleSortBoxity BoxedTuple     = Boxed
+tupleSortBoxity UnboxedTuple   = Unboxed
+tupleSortBoxity ConstraintTuple = Boxed
 
 boxityNormalTupleSort :: Boxity -> TupleSort
 boxityNormalTupleSort Boxed   = BoxedTuple
 boxityNormalTupleSort Unboxed = UnboxedTuple
 
 tupleParens :: TupleSort -> SDoc -> SDoc
-tupleParens BoxedTuple   p = parens p
-tupleParens FactTuple    p = parens p -- The user can't write fact tuples directly, we overload the (,,) syntax
+tupleParens BoxedTuple      p = parens p
+tupleParens ConstraintTuple p = parens p -- The user can't write fact tuples 
+                                         -- directly, we overload the (,,) syntax
 tupleParens UnboxedTuple p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
 \end{code}
 
diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index 3b1b41f5e5..7c9c3351e3 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -756,9 +756,9 @@ mkTupleOcc ns sort ar = OccName ns (mkFastString str)
  	-- no need to cache these, the caching is done in the caller
 	-- (TysWiredIn.mk_tuple)
     str = case sort of
-		UnboxedTuple -> '(' : '#' : commas ++ "#)"
-		BoxedTuple   -> '(' : commas ++ ")"
-                FactTuple    -> '(' : commas ++ ")"
+		UnboxedTuple    -> '(' : '#' : commas ++ "#)"
+		BoxedTuple      -> '(' : commas ++ ")"
+                ConstraintTuple -> '(' : commas ++ ")"
                   -- Cute hack: reuse the standard tuple OccNames (and hence code)
                   -- for fact tuples, but give them different Uniques so they are not equal.
                   --
diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs
index 87c22aa63b..39e61027f1 100644
--- a/compiler/basicTypes/Unique.lhs
+++ b/compiler/basicTypes/Unique.lhs
@@ -325,7 +325,7 @@ mkPreludeClassUnique i          = mkUnique '2' i
 mkPreludeTyConUnique i		= mkUnique '3' (3*i)
 mkTupleTyConUnique BoxedTuple   a	= mkUnique '4' (3*a)
 mkTupleTyConUnique UnboxedTuple a	= mkUnique '5' (3*a)
-mkTupleTyConUnique FactTuple    a	= mkUnique 'k' (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
@@ -335,8 +335,8 @@ mkTupleTyConUnique FactTuple    a	= mkUnique 'k' (3*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 FactTuple    a = mkUnique 'h' (2*a)
+mkTupleDataConUnique UnboxedTuple    a = mkUnique '8' (2*a)
+mkTupleDataConUnique ConstraintTuple a = mkUnique 'h' (2*a)
 
 mkPrimOpIdUnique op         = mkUnique '9' op
 mkPreludeMiscIdUnique  i    = mkUnique '0' i
diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs
index be1d7ae93c..8f743cde0d 100644
--- a/compiler/coreSyn/CoreSubst.lhs
+++ b/compiler/coreSyn/CoreSubst.lhs
@@ -775,10 +775,11 @@ Note [Optimise coercion boxes agressively]
 The simple expression optimiser has special cases for Eq# boxes as follows:
  1. If the result of optimising the RHS of a non-recursive binding is an
     Eq# box, that box is substituted rather than turned into a let, just as
-    if it were trivial.
+    if it were trivial.   let x = Eq# e in b  ==>  b[e/x]
 
  2. If the result of optimising a case scrutinee is a Eq# box and the case
     deconstructs it in a trivial way, we evaluate the case then and there.
+        case (Eq# e) of { Eq# y -> b }   ==>  b[e/y]
 
 We do this for two reasons:
 
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index 6901ab4bf8..2b2b3229d7 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -269,7 +269,7 @@ dsEvTerm (EvTupleSel v n)
     xs = map mkWildValBinder tys_before ++ v' : map mkWildValBinder tys_after
     (tys_before, ty_want:tys_after) = splitAt n tys
 dsEvTerm (EvTupleMk vs) = Var (dataConWorkId dc) `mkTyApps` tys `mkVarApps` vs
-  where dc = tupleCon FactTuple (length vs)
+  where dc = tupleCon ConstraintTuple (length vs)
         tys = map varType vs
 dsEvTerm (EvSuperClass d n)
   = Var sc_sel_id `mkTyApps` tys `App` Var d
@@ -572,7 +572,7 @@ specUnfolding _ _ _
 
 \begin{code}
 decomposeRuleLhs :: [Var] -> CoreExpr -> Either SDoc ([Var], Id, [CoreExpr])
--- Take apart the LHS of a RULE.  It's suuposed to look like
+-- Take apart the LHS of a RULE.  It's supposed to look like
 --     /\a. f a Int dOrdInt
 -- or  /\a.\d:Ord a. let { dl::Ord [a] = dOrdList a d } in f [a] dl
 -- That is, the RULE binders are lambda-bound
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 3df9f1a338..5c0391638e 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -652,15 +652,15 @@ instance Binary HsBang where
 	      _ -> do return HsUnpackFailed
 
 instance Binary TupleSort where
-    put_ bh BoxedTuple   = putByte bh 0
-    put_ bh UnboxedTuple = putByte bh 1
-    put_ bh FactTuple    = putByte bh 2
+    put_ bh BoxedTuple      = putByte bh 0
+    put_ bh UnboxedTuple    = putByte bh 1
+    put_ bh ConstraintTuple = putByte bh 2
     get bh = do
       h <- getByte bh
       case h of
         0 -> do return BoxedTuple
         1 -> do return UnboxedTuple
-        _ -> do return FactTuple
+        _ -> do return ConstraintTuple
 
 instance Binary RecFlag where
     put_ bh Recursive = do
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 812a0ff70b..467eb3f18e 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -405,7 +405,7 @@ mkMainModule_ m = mkModule mainPackageId m
 \begin{code}
 mkTupleModule :: TupleSort -> Arity -> Module
 mkTupleModule BoxedTuple   _ = gHC_TUPLE
-mkTupleModule FactTuple    _ = gHC_TUPLE
+mkTupleModule ConstraintTuple    _ = gHC_TUPLE
 mkTupleModule UnboxedTuple _ = gHC_PRIM
 \end{code}
 
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 7b12fecb79..bad62a599b 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -274,23 +274,41 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon
 %*									*
 %************************************************************************
 
+Note [How tuples work]
+~~~~~~~~~~~~~~~~~~~~~~
+* There are three families of tuple TyCons and corresponding
+  DataCons, (boxed, unboxed, and constraint tuples), expressed by the
+  type BasicTypes.TupleSort.
+
+* DataCons (and workers etc) for BoxedTuple and ConstraintTuple have
+    - distinct Uniques
+    - the same OccName
+  Using the same OccName means (hack!) that a single copy of the
+  runtime library code (info tables etc) works for both.
+
+* When looking up an OccName in the original-name cache
+  (IfaceEnv.lookupOrigNameCache), we spot the tuple OccName to make sure
+  we get the right wired-in name.  This guy can't tell the difference
+  betweeen BoxedTuple and ConstraintTuple (same OccName!), so tuples
+  are not serialised into interface files using OccNames at all. 
+
 \begin{code}
 tupleTyCon :: TupleSort -> Arity -> TyCon
 tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)	-- Build one specially
 tupleTyCon BoxedTuple   i = fst (boxedTupleArr   ! i)
 tupleTyCon UnboxedTuple i = fst (unboxedTupleArr ! i)
-tupleTyCon FactTuple    i = fst (factTupleArr    ! i)
+tupleTyCon ConstraintTuple    i = fst (factTupleArr    ! 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 FactTuple    i = snd (factTupleArr    ! i)
+tupleCon ConstraintTuple    i = snd (factTupleArr    ! i)
 
 boxedTupleArr, unboxedTupleArr, factTupleArr :: Array Int (TyCon,DataCon)
 boxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple BoxedTuple i | i <- [0..mAX_TUPLE_SIZE]]
 unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple UnboxedTuple i | i <- [0..mAX_TUPLE_SIZE]]
-factTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple FactTuple i | i <- [0..mAX_TUPLE_SIZE]]
+factTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple ConstraintTuple i | i <- [0..mAX_TUPLE_SIZE]]
 
 mk_tuple :: TupleSort -> Int -> (TyCon,DataCon)
 mk_tuple sort arity = (tycon, tuple_con)
@@ -301,14 +319,14 @@ mk_tuple sort arity = (tycon, tuple_con)
 				(ATyCon tycon) BuiltInSyntax
     	tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
 	res_kind = case sort of
-	  BoxedTuple   -> liftedTypeKind
-	  UnboxedTuple -> ubxTupleKind
-	  FactTuple    -> constraintKind
+	  BoxedTuple   	  -> liftedTypeKind
+	  UnboxedTuple 	  -> ubxTupleKind
+	  ConstraintTuple -> constraintKind
 
 	tyvars = take arity $ case sort of
 	  BoxedTuple   -> alphaTyVars
 	  UnboxedTuple -> openAlphaTyVars
-	  FactTuple    -> tyVarList constraintKind
+	  ConstraintTuple    -> tyVarList constraintKind
 
 	tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
 	tyvar_tys = mkTyVarTys tyvars
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index f243b3ee18..2ece416609 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -575,7 +575,7 @@ ds_type (HsTupleTy hs_con tys) = do
         HsBoxyTuple kind -> do
           kind' <- zonkTcKindToKind kind
           case () of
-            _ | kind' `eqKind` constraintKind -> return FactTuple
+            _ | kind' `eqKind` constraintKind -> return ConstraintTuple
             _ | kind' `eqKind` liftedTypeKind -> return BoxedTuple
             _ | otherwise
               -> failWithTc (ptext (sLit "Unexpected tuple component kind:") <+> ppr kind')