Merge remote-tracking branch 'origin/master' into wip/orf-rebootwip/orf-reboot

Conflicts:
	compiler/rename/RnNames.hs
	compiler/typecheck/TcRnMonad.hs
	utils/haddock

5 files changed, 145 insertions, 82 deletions

diff --git a/compiler/prelude/ForeignCall.hs b/compiler/prelude/ForeignCall.hs
index bec849f728..a08f64b621 100644
--- a/compiler/prelude/ForeignCall.hs
+++ b/compiler/prelude/ForeignCall.hs
@@ -114,7 +114,7 @@ data CCallTarget
                                   -- See note [Pragma source text] in BasicTypes
         CLabelString                    -- C-land name of label.
 
-        (Maybe PackageKey)              -- What package the function is in.
+        (Maybe UnitId)              -- What package the function is in.
                                         -- If Nothing, then it's taken to be in the current package.
                                         -- Note: This information is only used for PrimCalls on Windows.
                                         --       See CLabel.labelDynamic and CoreToStg.coreToStgApp
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index be6396cf21..3808c4ecb8 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -370,7 +370,9 @@ genericTyConNames = [
     compTyConName, rTyConName, pTyConName, dTyConName,
     cTyConName, sTyConName, rec0TyConName, par0TyConName,
     d1TyConName, c1TyConName, s1TyConName, noSelTyConName,
-    repTyConName, rep1TyConName
+    repTyConName, rep1TyConName, uRecTyConName,
+    uAddrTyConName, uCharTyConName, uDoubleTyConName,
+    uFloatTyConName, uIntTyConName, uWordTyConName
   ]
 
 {-
@@ -458,8 +460,9 @@ gHC_PARR' = mkBaseModule (fsLit "GHC.PArr")
 gHC_SRCLOC :: Module
 gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc")
 
-gHC_STACK :: Module
+gHC_STACK, gHC_STACK_TYPES :: Module
 gHC_STACK = mkBaseModule (fsLit "GHC.Stack")
+gHC_STACK_TYPES = mkBaseModule (fsLit "GHC.Stack.Types")
 
 gHC_STATICPTR :: Module
 gHC_STATICPTR = mkBaseModule (fsLit "GHC.StaticPtr")
@@ -473,7 +476,7 @@ rOOT_MAIN       = mkMainModule (fsLit ":Main") -- Root module for initialisation
 
 mkInteractiveModule :: Int -> Module
 -- (mkInteractiveMoudule 9) makes module 'interactive:M9'
-mkInteractiveModule n = mkModule interactivePackageKey (mkModuleName ("Ghci" ++ show n))
+mkInteractiveModule n = mkModule interactiveUnitId (mkModuleName ("Ghci" ++ show n))
 
 pRELUDE_NAME, mAIN_NAME :: ModuleName
 pRELUDE_NAME   = mkModuleNameFS (fsLit "Prelude")
@@ -484,28 +487,28 @@ dATA_ARRAY_PARALLEL_NAME      = mkModuleNameFS (fsLit "Data.Array.Parallel")
 dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim")
 
 mkPrimModule :: FastString -> Module
-mkPrimModule m = mkModule primPackageKey (mkModuleNameFS m)
+mkPrimModule m = mkModule primUnitId (mkModuleNameFS m)
 
 mkIntegerModule :: FastString -> Module
-mkIntegerModule m = mkModule integerPackageKey (mkModuleNameFS m)
+mkIntegerModule m = mkModule integerUnitId (mkModuleNameFS m)
 
 mkBaseModule :: FastString -> Module
-mkBaseModule m = mkModule basePackageKey (mkModuleNameFS m)
+mkBaseModule m = mkModule baseUnitId (mkModuleNameFS m)
 
 mkBaseModule_ :: ModuleName -> Module
-mkBaseModule_ m = mkModule basePackageKey m
+mkBaseModule_ m = mkModule baseUnitId m
 
 mkThisGhcModule :: FastString -> Module
-mkThisGhcModule m = mkModule thisGhcPackageKey (mkModuleNameFS m)
+mkThisGhcModule m = mkModule thisGhcUnitId (mkModuleNameFS m)
 
 mkThisGhcModule_ :: ModuleName -> Module
-mkThisGhcModule_ m = mkModule thisGhcPackageKey m
+mkThisGhcModule_ m = mkModule thisGhcUnitId m
 
 mkMainModule :: FastString -> Module
-mkMainModule m = mkModule mainPackageKey (mkModuleNameFS m)
+mkMainModule m = mkModule mainUnitId (mkModuleNameFS m)
 
 mkMainModule_ :: ModuleName -> Module
-mkMainModule_ m = mkModule mainPackageKey m
+mkMainModule_ m = mkModule mainUnitId m
 
 {-
 ************************************************************************
@@ -686,7 +689,11 @@ u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,
   conName_RDR, conFixity_RDR, conIsRecord_RDR,
   noArityDataCon_RDR, arityDataCon_RDR, selName_RDR,
   prefixDataCon_RDR, infixDataCon_RDR, leftAssocDataCon_RDR,
-  rightAssocDataCon_RDR, notAssocDataCon_RDR :: RdrName
+  rightAssocDataCon_RDR, notAssocDataCon_RDR,
+  uAddrDataCon_RDR, uCharDataCon_RDR, uDoubleDataCon_RDR,
+  uFloatDataCon_RDR, uIntDataCon_RDR, uWordDataCon_RDR,
+  uAddrHash_RDR, uCharHash_RDR, uDoubleHash_RDR,
+  uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: RdrName
 
 u1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "U1")
 par1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "Par1")
@@ -727,6 +734,19 @@ leftAssocDataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "LeftAssociative")
 rightAssocDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "RightAssociative")
 notAssocDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "NotAssociative")
 
+uAddrDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "UAddr")
+uCharDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "UChar")
+uDoubleDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UDouble")
+uFloatDataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "UFloat")
+uIntDataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "UInt")
+uWordDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "UWord")
+
+uAddrHash_RDR   = varQual_RDR gHC_GENERICS (fsLit "uAddr#")
+uCharHash_RDR   = varQual_RDR gHC_GENERICS (fsLit "uChar#")
+uDoubleHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uDouble#")
+uFloatHash_RDR  = varQual_RDR gHC_GENERICS (fsLit "uFloat#")
+uIntHash_RDR    = varQual_RDR gHC_GENERICS (fsLit "uInt#")
+uWordHash_RDR   = varQual_RDR gHC_GENERICS (fsLit "uWord#")
 
 fmap_RDR, pure_RDR, ap_RDR, foldable_foldr_RDR, foldMap_RDR,
     traverse_RDR, mempty_RDR, mappend_RDR :: RdrName
@@ -788,7 +808,9 @@ v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
   compTyConName, rTyConName, pTyConName, dTyConName,
   cTyConName, sTyConName, rec0TyConName, par0TyConName,
   d1TyConName, c1TyConName, s1TyConName, noSelTyConName,
-  repTyConName, rep1TyConName :: Name
+  repTyConName, rep1TyConName, uRecTyConName,
+  uAddrTyConName, uCharTyConName, uDoubleTyConName,
+  uFloatTyConName, uIntTyConName, uWordTyConName :: Name
 
 v1TyConName  = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey
 u1TyConName  = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey
@@ -817,6 +839,14 @@ noSelTyConName = tcQual gHC_GENERICS (fsLit "NoSelector") noSelTyConKey
 repTyConName  = tcQual gHC_GENERICS (fsLit "Rep")  repTyConKey
 rep1TyConName = tcQual gHC_GENERICS (fsLit "Rep1") rep1TyConKey
 
+uRecTyConName      = tcQual gHC_GENERICS (fsLit "URec") uRecTyConKey
+uAddrTyConName     = tcQual gHC_GENERICS (fsLit "UAddr") uAddrTyConKey
+uCharTyConName     = tcQual gHC_GENERICS (fsLit "UChar") uCharTyConKey
+uDoubleTyConName   = tcQual gHC_GENERICS (fsLit "UDouble") uDoubleTyConKey
+uFloatTyConName    = tcQual gHC_GENERICS (fsLit "UFloat") uFloatTyConKey
+uIntTyConName      = tcQual gHC_GENERICS (fsLit "UInt") uIntTyConKey
+uWordTyConName     = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey
+
 -- Base strings Strings
 unpackCStringName, unpackCStringFoldrName,
     unpackCStringUtf8Name, eqStringName, stringTyConName :: Name
@@ -1178,11 +1208,11 @@ knownSymbolClassName  = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolCl
 -- Source Locations
 callStackDataConName, callStackTyConName, srcLocDataConName :: Name
 callStackDataConName
-  = dcQual gHC_TYPES  (fsLit "CallStack") callStackDataConKey
+  = dcQual gHC_STACK_TYPES  (fsLit "CallStack") callStackDataConKey
 callStackTyConName
-  = tcQual  gHC_TYPES (fsLit "CallStack") callStackTyConKey
+  = tcQual gHC_STACK_TYPES  (fsLit "CallStack") callStackTyConKey
 srcLocDataConName
-  = dcQual gHC_TYPES (fsLit "SrcLoc")   srcLocDataConKey
+  = dcQual gHC_STACK_TYPES  (fsLit "SrcLoc")    srcLocDataConKey
 
 -- plugins
 pLUGINS :: Module
@@ -1468,7 +1498,9 @@ v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey,
   compTyConKey, rTyConKey, pTyConKey, dTyConKey,
   cTyConKey, sTyConKey, rec0TyConKey, par0TyConKey,
   d1TyConKey, c1TyConKey, s1TyConKey, noSelTyConKey,
-  repTyConKey, rep1TyConKey :: Unique
+  repTyConKey, rep1TyConKey, uRecTyConKey,
+  uAddrTyConKey, uCharTyConKey, uDoubleTyConKey,
+  uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique
 
 v1TyConKey    = mkPreludeTyConUnique 135
 u1TyConKey    = mkPreludeTyConUnique 136
@@ -1497,21 +1529,29 @@ noSelTyConKey = mkPreludeTyConUnique 154
 repTyConKey  = mkPreludeTyConUnique 155
 rep1TyConKey = mkPreludeTyConUnique 156
 
+uRecTyConKey    = mkPreludeTyConUnique 157
+uAddrTyConKey   = mkPreludeTyConUnique 158
+uCharTyConKey   = mkPreludeTyConUnique 159
+uDoubleTyConKey = mkPreludeTyConUnique 160
+uFloatTyConKey  = mkPreludeTyConUnique 161
+uIntTyConKey    = mkPreludeTyConUnique 162
+uWordTyConKey   = mkPreludeTyConUnique 163
+
 -- Type-level naturals
 typeNatKindConNameKey, typeSymbolKindConNameKey,
   typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatExpTyFamNameKey,
   typeNatLeqTyFamNameKey, typeNatSubTyFamNameKey
   , typeSymbolCmpTyFamNameKey, typeNatCmpTyFamNameKey
   :: Unique
-typeNatKindConNameKey     = mkPreludeTyConUnique 160
-typeSymbolKindConNameKey  = mkPreludeTyConUnique 161
-typeNatAddTyFamNameKey    = mkPreludeTyConUnique 162
-typeNatMulTyFamNameKey    = mkPreludeTyConUnique 163
-typeNatExpTyFamNameKey    = mkPreludeTyConUnique 164
-typeNatLeqTyFamNameKey    = mkPreludeTyConUnique 165
-typeNatSubTyFamNameKey    = mkPreludeTyConUnique 166
-typeSymbolCmpTyFamNameKey = mkPreludeTyConUnique 167
-typeNatCmpTyFamNameKey    = mkPreludeTyConUnique 168
+typeNatKindConNameKey     = mkPreludeTyConUnique 164
+typeSymbolKindConNameKey  = mkPreludeTyConUnique 165
+typeNatAddTyFamNameKey    = mkPreludeTyConUnique 166
+typeNatMulTyFamNameKey    = mkPreludeTyConUnique 167
+typeNatExpTyFamNameKey    = mkPreludeTyConUnique 168
+typeNatLeqTyFamNameKey    = mkPreludeTyConUnique 169
+typeNatSubTyFamNameKey    = mkPreludeTyConUnique 170
+typeSymbolCmpTyFamNameKey = mkPreludeTyConUnique 171
+typeNatCmpTyFamNameKey    = mkPreludeTyConUnique 172
 
 ntTyConKey:: Unique
 ntTyConKey = mkPreludeTyConUnique 174
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index d44c224479..f87dce4798 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -241,19 +241,19 @@ primOpRules nm CharGeOp   = mkRelOpRule nm (>=) [ boundsCmp Ge ]
 primOpRules nm CharLeOp   = mkRelOpRule nm (<=) [ boundsCmp Le ]
 primOpRules nm CharLtOp   = mkRelOpRule nm (<)  [ boundsCmp Lt ]
 
-primOpRules nm FloatGtOp  = mkFloatingRelOpRule nm (>)  []
-primOpRules nm FloatGeOp  = mkFloatingRelOpRule nm (>=) []
-primOpRules nm FloatLeOp  = mkFloatingRelOpRule nm (<=) []
-primOpRules nm FloatLtOp  = mkFloatingRelOpRule nm (<)  []
-primOpRules nm FloatEqOp  = mkFloatingRelOpRule nm (==) [ litEq True ]
-primOpRules nm FloatNeOp  = mkFloatingRelOpRule nm (/=) [ litEq False ]
-
-primOpRules nm DoubleGtOp = mkFloatingRelOpRule nm (>)  []
-primOpRules nm DoubleGeOp = mkFloatingRelOpRule nm (>=) []
-primOpRules nm DoubleLeOp = mkFloatingRelOpRule nm (<=) []
-primOpRules nm DoubleLtOp = mkFloatingRelOpRule nm (<)  []
-primOpRules nm DoubleEqOp = mkFloatingRelOpRule nm (==) [ litEq True ]
-primOpRules nm DoubleNeOp = mkFloatingRelOpRule nm (/=) [ litEq False ]
+primOpRules nm FloatGtOp  = mkFloatingRelOpRule nm (>)
+primOpRules nm FloatGeOp  = mkFloatingRelOpRule nm (>=)
+primOpRules nm FloatLeOp  = mkFloatingRelOpRule nm (<=)
+primOpRules nm FloatLtOp  = mkFloatingRelOpRule nm (<)
+primOpRules nm FloatEqOp  = mkFloatingRelOpRule nm (==)
+primOpRules nm FloatNeOp  = mkFloatingRelOpRule nm (/=)
+
+primOpRules nm DoubleGtOp = mkFloatingRelOpRule nm (>)
+primOpRules nm DoubleGeOp = mkFloatingRelOpRule nm (>=)
+primOpRules nm DoubleLeOp = mkFloatingRelOpRule nm (<=)
+primOpRules nm DoubleLtOp = mkFloatingRelOpRule nm (<)
+primOpRules nm DoubleEqOp = mkFloatingRelOpRule nm (==)
+primOpRules nm DoubleNeOp = mkFloatingRelOpRule nm (/=)
 
 primOpRules nm WordGtOp   = mkRelOpRule nm (>)  [ boundsCmp Gt ]
 primOpRules nm WordGeOp   = mkRelOpRule nm (>=) [ boundsCmp Ge ]
@@ -284,29 +284,49 @@ mkPrimOpRule nm arity rules = Just $ mkBasicRule nm arity (msum rules)
 mkRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)
             -> [RuleM CoreExpr] -> Maybe CoreRule
 mkRelOpRule nm cmp extra
-  = mkPrimOpRule nm 2 $ rules ++ extra
+  = mkPrimOpRule nm 2 $
+    binaryCmpLit cmp : equal_rule : extra
   where
-    rules = [ binaryCmpLit cmp
-            , do equalArgs
-              -- x `cmp` x does not depend on x, so
-              -- compute it for the arbitrary value 'True'
-              -- and use that result
-                 dflags <- getDynFlags
-                 return (if cmp True True
-                         then trueValInt  dflags
-                         else falseValInt dflags) ]
-
--- Note [Rules for floating-point comparisons]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- We need different rules for floating-point values because for floats
--- it is not true that x = x. The special case when this does not occur
--- are NaNs.
+        -- x `cmp` x does not depend on x, so
+        -- compute it for the arbitrary value 'True'
+        -- and use that result
+    equal_rule = do { equalArgs
+                    ; dflags <- getDynFlags
+                    ; return (if cmp True True
+                              then trueValInt  dflags
+                              else falseValInt dflags) }
+
+{- Note [Rules for floating-point comparisons]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We need different rules for floating-point values because for floats
+it is not true that x = x (for NaNs); so we do not want the equal_rule
+rule that mkRelOpRule uses.
+
+Note also that, in the case of equality/inequality, we do /not/
+want to switch to a case-expression.  For example, we do not want
+to convert
+   case (eqFloat# x 3.8#) of
+     True -> this
+     False -> that
+to
+  case x of
+    3.8#::Float# -> this
+    _            -> that
+See Trac #9238.  Reason: comparing floating-point values for equality
+delicate, and we don't want to implement that delicacy in the code for
+case expressions.  So we make it an invariant of Core that a case
+expression never scrutinises a Float# or Double#.
+
+This transformation is what the litEq rule does;
+see Note [The litEq rule: converting equality to case].
+So we /refrain/ from using litEq for mkFloatingRelOpRule.
+-}
 
 mkFloatingRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)
-                    -> [RuleM CoreExpr] -> Maybe CoreRule
-mkFloatingRelOpRule nm cmp extra -- See Note [Rules for floating-point comparisons]
-  = mkPrimOpRule nm 2 $ binaryCmpLit cmp : extra
+                    -> Maybe CoreRule
+-- See Note [Rules for floating-point comparisons]
+mkFloatingRelOpRule nm cmp
+  = mkPrimOpRule nm 2 [binaryCmpLit cmp]
 
 -- common constants
 zeroi, onei, zerow, onew :: DynFlags -> Literal
@@ -428,24 +448,27 @@ doubleOp2 op dflags (MachDouble f1) (MachDouble f2)
 doubleOp2 _ _ _ _ = Nothing
 
 --------------------------
--- This stuff turns
---      n ==# 3#
--- into
---      case n of
---        3# -> True
---        m  -> False
---
--- This is a Good Thing, because it allows case-of case things
--- to happen, and case-default absorption to happen.  For
--- example:
---
---      if (n ==# 3#) || (n ==# 4#) then e1 else e2
--- will transform to
---      case n of
---        3# -> e1
---        4# -> e1
---        m  -> e2
--- (modulo the usual precautions to avoid duplicating e1)
+{- Note [The litEq rule: converting equality to case]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+This stuff turns
+     n ==# 3#
+into
+     case n of
+       3# -> True
+       m  -> False
+
+This is a Good Thing, because it allows case-of case things
+to happen, and case-default absorption to happen.  For
+example:
+
+     if (n ==# 3#) || (n ==# 4#) then e1 else e2
+will transform to
+     case n of
+       3# -> e1
+       4# -> e1
+       m  -> e2
+(modulo the usual precautions to avoid duplicating e1)
+-}
 
 litEq :: Bool  -- True <=> equality, False <=> inequality
       -> RuleM CoreExpr
diff --git a/compiler/prelude/PrimOp.hs b/compiler/prelude/PrimOp.hs
index 6b012ee5ea..202fd815d5 100644
--- a/compiler/prelude/PrimOp.hs
+++ b/compiler/prelude/PrimOp.hs
@@ -39,7 +39,7 @@ import ForeignCall      ( CLabelString )
 import Unique           ( Unique, mkPrimOpIdUnique )
 import Outputable
 import FastString
-import Module           ( PackageKey )
+import Module           ( UnitId )
 
 {-
 ************************************************************************
@@ -617,7 +617,7 @@ pprPrimOp other_op = pprOccName (primOpOcc other_op)
 ************************************************************************
 -}
 
-data PrimCall = PrimCall CLabelString PackageKey
+data PrimCall = PrimCall CLabelString UnitId
 
 instance Outputable PrimCall where
   ppr (PrimCall lbl pkgId)
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
index d3deb49ba2..9c39564147 100644
--- a/compiler/prelude/THNames.hs
+++ b/compiler/prelude/THNames.hs
@@ -7,7 +7,7 @@
 module THNames where
 
 import PrelNames( mk_known_key_name )
-import Module( Module, mkModuleNameFS, mkModule, thPackageKey )
+import Module( Module, mkModuleNameFS, mkModule, thUnitId )
 import Name( Name )
 import OccName( tcName, clsName, dataName, varName )
 import RdrName( RdrName, nameRdrName )
@@ -145,7 +145,7 @@ thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
 qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
 
 mkTHModule :: FastString -> Module
-mkTHModule m = mkModule thPackageKey (mkModuleNameFS m)
+mkTHModule m = mkModule thUnitId (mkModuleNameFS m)
 
 libFun, libTc, thFun, thTc, thCls, thCon, qqFun :: FastString -> Unique -> Name
 libFun = mk_known_key_name OccName.varName  thLib