Merge branch 'master' of http://darcs.haskell.org/ghc

14 files changed, 438 insertions, 232 deletions

diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 41db7eaf46..090c34ffc0 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -20,12 +20,6 @@ Category: Development
 Build-Type: Simple
 Cabal-Version: >= 1.2.3
 
-Flag base4
-    Description: Choose the even newer, even smaller, split-up base package.
-
-Flag base3
-    Description: Choose the new smaller, split-up base package.
-
 Flag dynlibs
     Description: Dynamic library support
     Default: False
@@ -54,26 +48,20 @@ Flag stage3
 Library
     Exposed: False
 
-    if flag(base4)
-        Build-Depends: base       >= 4   && < 5
-    if flag(base3)
-        Build-Depends: base       >= 3   && < 4
-    if !flag(base3) && !flag(base4)
-        Build-Depends: base       < 3
+    Build-Depends: base       >= 4   && < 5,
+                   directory  >= 1   && < 1.2,
+                   process    >= 1   && < 1.2,
+                   bytestring >= 0.9 && < 0.11,
+                   time                 < 1.5,
+                   containers >= 0.1 && < 0.6,
+                   array      >= 0.1 && < 0.5,
+                   filepath   >= 1   && < 1.4,
+                   Cabal,
+                   hpc
 
     if flag(stage1) && impl(ghc < 7.5)
         Build-Depends: old-time   >= 1   && < 1.2
 
-    if flag(base3) || flag(base4)
-        Build-Depends: directory  >= 1   && < 1.2,
-                       process    >= 1   && < 1.2,
-                       bytestring >= 0.9 && < 0.11,
-                       time                 < 1.5,
-                       containers >= 0.1 && < 0.6,
-                       array      >= 0.1 && < 0.5
-
-    Build-Depends: filepath >= 1 && < 1.4
-    Build-Depends: Cabal, hpc
     if os(windows)
         Build-Depends: Win32
     else
@@ -89,10 +77,6 @@ Library
     Build-Depends: bin-package-db
     Build-Depends: hoopl
 
-    -- GHC 6.4.2 needs to be able to find WCsubst.c, which needs to be
-    -- able to find WCsubst.h
-    Include-Dirs: ../libraries/base/cbits, ../libraries/base/include
-
     Extensions: CPP, MagicHash, UnboxedTuples, PatternGuards,
                 ForeignFunctionInterface, EmptyDataDecls,
                 TypeSynonymInstances, MultiParamTypeClasses,
diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index 90deaa7edf..7a15120567 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -183,7 +183,7 @@ cvtDec (NewtypeD ctxt tc tvs constr derivs)
   = do	{ (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
 	; con' <- cvtConstr constr
 	; derivs' <- cvtDerivs derivs
-        ; let defn = TyData { td_ND = DataType, td_cType = Nothing
+        ; let defn = TyData { td_ND = NewType, td_cType = Nothing
                             , td_ctxt = ctxt'
                             , td_kindSig = Nothing
                             , td_cons = [con'], td_derivs = derivs' } 
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 1d6ad4a472..aa5a432762 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -2,51 +2,44 @@
 % (c) The University of Glasgow, 2006
 %
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 -- | Package manipulation
 module Packages (
-	module PackageConfig,
-
-	-- * The PackageConfigMap
-	PackageConfigMap, emptyPackageConfigMap, lookupPackage,
-	extendPackageConfigMap,	dumpPackages,
-
-	-- * Reading the package config, and processing cmdline args
-	PackageState(..),
-	initPackages,
-	getPackageDetails,
-	lookupModuleInAllPackages, lookupModuleWithSuggestions,
-
-	-- * Inspecting the set of packages in scope
-	getPackageIncludePath,
-	getPackageLibraryPath,
-	getPackageLinkOpts,
-	getPackageExtraCcOpts,
-	getPackageFrameworkPath,
-	getPackageFrameworks,
-	getPreloadPackagesAnd,
+        module PackageConfig,
+
+        -- * The PackageConfigMap
+        PackageConfigMap, emptyPackageConfigMap, lookupPackage,
+        extendPackageConfigMap, dumpPackages,
+
+        -- * Reading the package config, and processing cmdline args
+        PackageState(..),
+        initPackages,
+        getPackageDetails,
+        lookupModuleInAllPackages, lookupModuleWithSuggestions,
+
+        -- * Inspecting the set of packages in scope
+        getPackageIncludePath,
+        getPackageLibraryPath,
+        getPackageLinkOpts,
+        getPackageExtraCcOpts,
+        getPackageFrameworkPath,
+        getPackageFrameworks,
+        getPreloadPackagesAnd,
 
         collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
         packageHsLibs,
 
-	-- * Utils
-	isDllName
+        -- * Utils
+        isDllName
     )
 where
 
 #include "HsVersions.h"
 
-import PackageConfig	
+import PackageConfig
 import DynFlags
 import StaticFlags
-import Config		( cProjectVersion )
-import Name		( Name, nameModule_maybe )
+import Config           ( cProjectVersion )
+import Name             ( Name, nameModule_maybe )
 import UniqFM
 import Module
 import Util
@@ -81,12 +74,12 @@ import qualified Data.Set as Set
 --
 -- The package state is computed by 'initPackages', and kept in DynFlags.
 --
---   * @-package <pkg>@ causes @<pkg>@ to become exposed, and all other packages 
---	with the same name to become hidden.
--- 
+--   * @-package <pkg>@ causes @<pkg>@ to become exposed, and all other packages
+--      with the same name to become hidden.
+--
 --   * @-hide-package <pkg>@ causes @<pkg>@ to become hidden.
--- 
---   * Let @exposedPackages@ be the set of packages thus exposed.  
+--
+--   * Let @exposedPackages@ be the set of packages thus exposed.
 --     Let @depExposedPackages@ be the transitive closure from @exposedPackages@ of
 --     their dependencies.
 --
@@ -107,28 +100,28 @@ import qualified Data.Set as Set
 
 -- Notes on DLLs
 -- ~~~~~~~~~~~~~
--- When compiling module A, which imports module B, we need to 
--- know whether B will be in the same DLL as A.  
--- 	If it's in the same DLL, we refer to B_f_closure
--- 	If it isn't, we refer to _imp__B_f_closure
+-- When compiling module A, which imports module B, we need to
+-- know whether B will be in the same DLL as A.
+--      If it's in the same DLL, we refer to B_f_closure
+--      If it isn't, we refer to _imp__B_f_closure
 -- When compiling A, we record in B's Module value whether it's
 -- in a different DLL, by setting the DLL flag.
 
 data PackageState = PackageState {
-  pkgIdMap		:: PackageConfigMap, -- PackageId   -> PackageConfig
-	-- The exposed flags are adjusted according to -package and
-	-- -hide-package flags, and -ignore-package removes packages.
+  pkgIdMap              :: PackageConfigMap, -- PackageId   -> PackageConfig
+        -- The exposed flags are adjusted according to -package and
+        -- -hide-package flags, and -ignore-package removes packages.
 
   preloadPackages      :: [PackageId],
-	-- The packages we're going to link in eagerly.  This list
-	-- should be in reverse dependency order; that is, a package
-	-- is always mentioned before the packages it depends on.
+        -- The packages we're going to link in eagerly.  This list
+        -- should be in reverse dependency order; that is, a package
+        -- is always mentioned before the packages it depends on.
 
-  moduleToPkgConfAll 	:: UniqFM [(PackageConfig,Bool)], -- ModuleEnv mapping
-	-- Derived from pkgIdMap.	
-	-- Maps Module to (pkgconf,exposed), where pkgconf is the
-	-- PackageConfig for the package containing the module, and
-	-- exposed is True if the package exposes that module.
+  moduleToPkgConfAll    :: UniqFM [(PackageConfig,Bool)], -- ModuleEnv mapping
+        -- Derived from pkgIdMap.
+        -- Maps Module to (pkgconf,exposed), where pkgconf is the
+        -- PackageConfig for the package containing the module, and
+        -- exposed is True if the package exposes that module.
 
   installedPackageIdMap :: InstalledPackageIdMap
   }
@@ -149,7 +142,7 @@ lookupPackage = lookupUFM
 
 extendPackageConfigMap
    :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
-extendPackageConfigMap pkg_map new_pkgs 
+extendPackageConfigMap pkg_map new_pkgs
   = foldl add pkg_map new_pkgs
   where add pkg_map p = addToUFM pkg_map (packageConfigId p) p
 
@@ -175,14 +168,14 @@ getPackageDetails ps pid = expectJust "getPackageDetails" (lookupPackage (pkgIdM
 -- 'pkgState' in 'DynFlags' and return a list of packages to
 -- link in.
 initPackages :: DynFlags -> IO (DynFlags, [PackageId])
-initPackages dflags = do 
+initPackages dflags = do
   pkg_db <- case pkgDatabase dflags of
                 Nothing -> readPackageConfigs dflags
                 Just db -> return $ setBatchPackageFlags dflags db
-  (pkg_state, preload, this_pkg)       
+  (pkg_state, preload, this_pkg)
         <- mkPackageState dflags pkg_db [] (thisPackage dflags)
   return (dflags{ pkgDatabase = Just pkg_db,
-		  pkgState = pkg_state,
+                  pkgState = pkg_state,
                   thisPackage = this_pkg },
           preload)
 
@@ -195,13 +188,13 @@ readPackageConfigs dflags = do
    system_pkgconfs <- getSystemPackageConfigs dflags
 
    let pkgconfs = case e_pkg_path of
-		    Left _   -> system_pkgconfs
-		    Right path
-		     | last cs == "" -> init cs ++ system_pkgconfs
-		     | otherwise     -> cs
-		     where cs = parseSearchPath path
-		     -- if the path ends in a separator (eg. "/foo/bar:")
-		     -- the we tack on the system paths.
+                    Left _   -> system_pkgconfs
+                    Right path
+                     | last cs == "" -> init cs ++ system_pkgconfs
+                     | otherwise     -> cs
+                     where cs = parseSearchPath path
+                     -- if the path ends in a separator (eg. "/foo/bar:")
+                     -- the we tack on the system paths.
 
    pkgs <- mapM (readPackageConfig dflags)
                 (pkgconfs ++ reverse (extraPkgConfs dflags))
@@ -214,16 +207,16 @@ readPackageConfigs dflags = do
 
 getSystemPackageConfigs :: DynFlags -> IO [FilePath]
 getSystemPackageConfigs dflags = do
-	-- System one always comes first
+   -- System one always comes first
    let system_pkgconf = systemPackageConfig dflags
 
-	-- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
-	-- unless the -no-user-package-conf flag was given.
+   -- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
+   -- unless the -no-user-package-conf flag was given.
    user_pkgconf <- do
       if not (dopt Opt_ReadUserPackageConf dflags) then return [] else do
       appdir <- getAppUserDataDirectory "ghc"
-      let 
-     	 dir = appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
+      let
+         dir = appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
          pkgconf = dir </> "package.conf.d"
       --
       exist <- doesDirectoryExist pkgconf
@@ -236,17 +229,17 @@ readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
 readPackageConfig dflags conf_file = do
   isdir <- doesDirectoryExist conf_file
 
-  proto_pkg_configs <- 
+  proto_pkg_configs <-
     if isdir
        then do let filename = conf_file </> "package.cache"
                debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename)
                conf <- readBinPackageDB filename
                return (map installedPackageInfoToPackageConfig conf)
 
-       else do 
+       else do
             isfile <- doesFileExist conf_file
             when (not isfile) $
-              ghcError $ InstallationError $ 
+              ghcError $ InstallationError $
                 "can't find a package database at " ++ conf_file
             debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
             str <- readFile conf_file
@@ -293,7 +286,7 @@ mungePackagePaths top_dir pkgroot pkg =
       haddockInterfaces = munge_paths (haddockInterfaces pkg),
       haddockHTMLs = munge_urls (haddockHTMLs pkg)
     }
-  where 
+  where
     munge_paths = map munge_path
     munge_urls  = map munge_url
 
@@ -340,23 +333,23 @@ applyPackageFlag unusable pkgs flag =
        case selectPackages (matchingStr str) pkgs unusable of
          Left ps         -> packageFlagErr flag ps
          Right (p:ps,qs) -> return (p':ps')
-    	  where p' = p {exposed=True}
-    	        ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
+          where p' = p {exposed=True}
+                ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
          _ -> panic "applyPackageFlag"
 
     ExposePackageId str ->
        case selectPackages (matchingId str) pkgs unusable of
          Left ps         -> packageFlagErr flag ps
          Right (p:ps,qs) -> return (p':ps')
-    	  where p' = p {exposed=True}
-    	        ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
+          where p' = p {exposed=True}
+                ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
          _ -> panic "applyPackageFlag"
 
     HidePackage str ->
        case selectPackages (matchingStr str) pkgs unusable of
          Left ps       -> packageFlagErr flag ps
          Right (ps,qs) -> return (map hide ps ++ qs)
-    	  where hide p = p {exposed=False}
+          where hide p = p {exposed=False}
 
     -- we trust all matching packages. Maybe should only trust first one?
     -- and leave others the same or set them untrusted
@@ -364,21 +357,21 @@ applyPackageFlag unusable pkgs flag =
        case selectPackages (matchingStr str) pkgs unusable of
          Left ps       -> packageFlagErr flag ps
          Right (ps,qs) -> return (map trust ps ++ qs)
-    	  where trust p = p {trusted=True}
+          where trust p = p {trusted=True}
 
     DistrustPackage str ->
        case selectPackages (matchingStr str) pkgs unusable of
          Left ps       -> packageFlagErr flag ps
          Right (ps,qs) -> return (map distrust ps ++ qs)
-    	  where distrust p = p {trusted=False}
+          where distrust p = p {trusted=False}
 
     _ -> panic "applyPackageFlag"
 
    where
-	-- When a package is requested to be exposed, we hide all other
-	-- packages with the same name.
-	hideAll name ps = map maybe_hide ps
-	  where maybe_hide p
+        -- When a package is requested to be exposed, we hide all other
+        -- packages with the same name.
+        hideAll name ps = map maybe_hide ps
+          where maybe_hide p
                    | pkgName (sourcePackageId p) == name = p {exposed=False}
                    | otherwise                           = p
 
@@ -401,8 +394,8 @@ selectPackages matches pkgs unusable
 -- version, or just the name if it is unambiguous.
 matchingStr :: String -> PackageConfig -> Bool
 matchingStr str p
-	=  str == display (sourcePackageId p)
-	|| str == display (pkgName (sourcePackageId p))
+        =  str == display (sourcePackageId p)
+        || str == display (pkgName (sourcePackageId p))
 
 matchingId :: String -> PackageConfig -> Bool
 matchingId str p =  InstalledPackageId str == installedPackageId p
@@ -424,9 +417,9 @@ packageFlagErr (ExposePackage pkg) [] | is_dph_package pkg
   where dph_err = text "the " <> text pkg <> text " package is not installed."
                   $$ text "To install it: \"cabal install dph\"."
         is_dph_package pkg = "dph" `isPrefixOf` pkg
-  
+
 packageFlagErr flag reasons = ghcError (CmdLineError (showSDoc $ err))
-  where err = text "cannot satisfy " <> ppr_flag <> 
+  where err = text "cannot satisfy " <> ppr_flag <>
                 (if null reasons then empty else text ": ") $$
               nest 4 (ppr_reasons $$
                       text "(use -v for more information)")
@@ -452,20 +445,20 @@ packageFlagErr flag reasons = ghcError (CmdLineError (showSDoc $ err))
 hideOldPackages :: DynFlags -> [PackageConfig] -> IO [PackageConfig]
 hideOldPackages dflags pkgs = mapM maybe_hide pkgs
   where maybe_hide p
-	   | not (exposed p) = return p
-	   | (p' : _) <- later_versions = do
-		debugTraceMsg dflags 2 $
-		   (ptext (sLit "hiding package") <+> pprSPkg p <+>
-		    ptext (sLit "to avoid conflict with later version") <+>
-		    pprSPkg p')
-		return (p {exposed=False})
-	   | otherwise = return p
-	  where myname = pkgName (sourcePackageId p)
-		myversion = pkgVersion (sourcePackageId p)
-		later_versions = [ p | p <- pkgs, exposed p,
-				    let pkg = sourcePackageId p,
-				    pkgName pkg == myname,
-				    pkgVersion pkg > myversion ]
+           | not (exposed p) = return p
+           | (p' : _) <- later_versions = do
+                debugTraceMsg dflags 2 $
+                   (ptext (sLit "hiding package") <+> pprSPkg p <+>
+                    ptext (sLit "to avoid conflict with later version") <+>
+                    pprSPkg p')
+                return (p {exposed=False})
+           | otherwise = return p
+          where myname = pkgName (sourcePackageId p)
+                myversion = pkgVersion (sourcePackageId p)
+                later_versions = [ p | p <- pkgs, exposed p,
+                                       let pkg = sourcePackageId p,
+                                       pkgName pkg == myname,
+                                       pkgVersion pkg > myversion ]
 
 -- -----------------------------------------------------------------------------
 -- Wired-in packages
@@ -494,43 +487,43 @@ findWiredInPackages dflags pkgs = do
         matches :: PackageConfig -> String -> Bool
         pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid
 
-	-- find which package corresponds to each wired-in package
-	-- delete any other packages with the same name
-	-- update the package and any dependencies to point to the new
-	-- one.
+        -- find which package corresponds to each wired-in package
+        -- delete any other packages with the same name
+        -- update the package and any dependencies to point to the new
+        -- one.
         --
         -- When choosing which package to map to a wired-in package
         -- name, we prefer exposed packages, and pick the latest
         -- version.  To override the default choice, -hide-package
         -- could be used to hide newer versions.
         --
-	findWiredInPackage :: [PackageConfig] -> String
-			   -> IO (Maybe InstalledPackageId)
-	findWiredInPackage pkgs wired_pkg =
+        findWiredInPackage :: [PackageConfig] -> String
+                           -> IO (Maybe InstalledPackageId)
+        findWiredInPackage pkgs wired_pkg =
            let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] in
-	   case all_ps of
-		[]   -> notfound
-		many -> pick (head (sortByVersion many))
+           case all_ps of
+                []   -> notfound
+                many -> pick (head (sortByVersion many))
           where
                 notfound = do
-			  debugTraceMsg dflags 2 $
-			    ptext (sLit "wired-in package ")
-				 <> text wired_pkg
-				 <> ptext (sLit " not found.")
-			  return Nothing
-		pick :: InstalledPackageInfo_ ModuleName
+                          debugTraceMsg dflags 2 $
+                            ptext (sLit "wired-in package ")
+                                 <> text wired_pkg
+                                 <> ptext (sLit " not found.")
+                          return Nothing
+                pick :: InstalledPackageInfo_ ModuleName
                      -> IO (Maybe InstalledPackageId)
                 pick pkg = do
                         debugTraceMsg dflags 2 $
-			    ptext (sLit "wired-in package ")
-				 <> text wired_pkg
-				 <> ptext (sLit " mapped to ")
-				 <> pprIPkg pkg
-			return (Just (installedPackageId pkg))
+                            ptext (sLit "wired-in package ")
+                                 <> text wired_pkg
+                                 <> ptext (sLit " mapped to ")
+                                 <> pprIPkg pkg
+                        return (Just (installedPackageId pkg))
 
 
   mb_wired_in_ids <- mapM (findWiredInPackage pkgs) wired_in_pkgids
-  let 
+  let
         wired_in_ids = catMaybes mb_wired_in_ids
 
         -- this is old: we used to assume that if there were
@@ -541,13 +534,13 @@ findWiredInPackages dflags pkgs = do
         -- wrappers that depend on this one.  e.g. base-4.0 is the
         -- latest, base-3.0 is a compat wrapper depending on base-4.0.
         {-
- 	deleteOtherWiredInPackages pkgs = filterOut bad pkgs
- 	  where bad p = any (p `matches`) wired_in_pkgids
+        deleteOtherWiredInPackages pkgs = filterOut bad pkgs
+          where bad p = any (p `matches`) wired_in_pkgids
                       && package p `notElem` map fst wired_in_ids
         -}
 
-	updateWiredInDependencies pkgs = map upd_pkg pkgs
-	  where upd_pkg p
+        updateWiredInDependencies pkgs = map upd_pkg pkgs
+          where upd_pkg p
                   | installedPackageId p `elem` wired_in_ids
                   = p { sourcePackageId = (sourcePackageId p){ pkgVersion = Version [] [] } }
                   | otherwise
@@ -650,9 +643,9 @@ ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
      case partition (matchingStr str) pkgs of
          (ps, _) -> [ (installedPackageId p, IgnoredWithFlag)
                     | p <- ps ]
-    	-- missing package is not an error for -ignore-package,
-    	-- because a common usage is to -ignore-package P as
-    	-- a preventative measure just in case P exists.
+        -- missing package is not an error for -ignore-package,
+        -- because a common usage is to -ignore-package P as
+        -- a preventative measure just in case P exists.
   doit _ = panic "ignorePackages"
 
 -- -----------------------------------------------------------------------------
@@ -665,7 +658,7 @@ depClosure index ipids = closure Map.empty ipids
    closure set [] = Map.keys set
    closure set (ipid : ipids)
      | ipid `Map.member` set = closure set ipids
-     | Just p <- Map.lookup ipid index = closure (Map.insert ipid p set) 
+     | Just p <- Map.lookup ipid index = closure (Map.insert ipid p set)
                                                  (depends p ++ ipids)
      | otherwise = closure set ipids
 
@@ -688,7 +681,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do
 {-
    Plan.
 
-   1. P = transitive closure of packages selected by -package-id 
+   1. P = transitive closure of packages selected by -package-id
 
    2. Apply shadowing.  When there are multiple packages with the same
       sourcePackageId,
@@ -746,7 +739,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do
 
       ipid_selected = depClosure ipid_map [ InstalledPackageId i
                                           | ExposePackageId i <- flags ]
-      
+
       (ignore_flags, other_flags) = partition is_ignore flags
       is_ignore IgnorePackage{} = True
       is_ignore _ = False
@@ -808,7 +801,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do
       -- set up preloaded package when we are just building it
       preload3 = nub $ filter (/= this_package)
                      $ (basicLinkedPackages ++ preload2)
- 
+
   -- Close the preload packages with their dependencies
   dep_preload <- closeDeps pkg_db ipid_map (zip preload3 (repeat Nothing))
   let new_dep_preload = filter (`notElem` preload0) dep_preload
@@ -820,7 +813,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do
                            }
 
   return (pstate, new_dep_preload, this_package)
-  
+
 
 -- -----------------------------------------------------------------------------
 -- Make the mapping from module to package info
@@ -831,15 +824,15 @@ mkModuleMap
 mkModuleMap pkg_db = foldr extend_modmap emptyUFM pkgids
   where
         pkgids = map packageConfigId (eltsUFM pkg_db)
-        
-	extend_modmap pkgid modmap =
-		addListToUFM_C (++) modmap 
-		   ([(m, [(pkg, True)])  | m <- exposed_mods] ++
-		    [(m, [(pkg, False)]) | m <- hidden_mods])
-	  where
-		pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid)
-	        exposed_mods = exposedModules pkg
-	        hidden_mods  = hiddenModules pkg
+
+        extend_modmap pkgid modmap =
+                addListToUFM_C (++) modmap
+                   ([(m, [(pkg, True)])  | m <- exposed_mods] ++
+                    [(m, [(pkg, False)]) | m <- hidden_mods])
+          where
+                pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid)
+                exposed_mods = exposedModules pkg
+                hidden_mods  = hiddenModules pkg
 
 pprSPkg :: PackageConfig -> SDoc
 pprSPkg p = text (display (sourcePackageId p))
@@ -863,7 +856,7 @@ getPackageIncludePath :: DynFlags -> [PackageId] -> IO [String]
 getPackageIncludePath dflags pkgs =
   collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
 
-collectIncludeDirs :: [PackageConfig] -> [FilePath] 
+collectIncludeDirs :: [PackageConfig] -> [FilePath]
 collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))
 
 -- | Find all the library paths in these and the preload packages
@@ -876,14 +869,14 @@ collectLibraryPaths ps = nub (filter notNull (concatMap libraryDirs ps))
 
 -- | Find all the link options in these and the preload packages
 getPackageLinkOpts :: DynFlags -> [PackageId] -> IO [String]
-getPackageLinkOpts dflags pkgs = 
+getPackageLinkOpts dflags pkgs =
   collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs
 
 collectLinkOpts :: DynFlags -> [PackageConfig] -> [String]
 collectLinkOpts dflags ps = concat (map all_opts ps)
   where
-      	libs p     = packageHsLibs dflags p ++ extraLibraries p
-	all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
+        libs p     = packageHsLibs dflags p ++ extraLibraries p
+        all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
 
 packageHsLibs :: DynFlags -> PackageConfig -> [String]
 packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
@@ -895,7 +888,7 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
         -- we leave out the _dyn, because it is superfluous
 
         -- debug RTS includes support for -eventlog
-        ways2 | WayDebug `elem` map wayName ways1 
+        ways2 | WayDebug `elem` map wayName ways1
               = filter ((/= WayEventLog) . wayName) ways1
               | otherwise
               = ways1
@@ -903,14 +896,14 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
         tag     = mkBuildTag (filter (not . wayRTSOnly) ways2)
         rts_tag = mkBuildTag ways2
 
-	mkDynName | opt_Static = id
-		  | otherwise = (++ ("-ghc" ++ cProjectVersion))
+        mkDynName | opt_Static = id
+                  | otherwise = (++ ("-ghc" ++ cProjectVersion))
 
         addSuffix rts@"HSrts"    = rts       ++ (expandTag rts_tag)
         addSuffix other_lib      = other_lib ++ (expandTag tag)
 
         expandTag t | null t = ""
-		    | otherwise = '_':t
+                    | otherwise = '_':t
 
 -- | Find all the C-compiler options in these and the preload packages
 getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
@@ -933,7 +926,7 @@ getPackageFrameworks dflags pkgs = do
 -- -----------------------------------------------------------------------------
 -- Package Utils
 
--- | Takes a 'Module', and if the module is in a package returns 
+-- | Takes a 'Module', and if the module is in a package returns
 -- @(pkgconf, exposed)@ where pkgconf is the PackageConfig for that package,
 -- and exposed is @True@ if the package exposes the module.
 lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(PackageConfig,Bool)]
@@ -968,7 +961,7 @@ lookupModuleWithSuggestions dflags m
 -- 'PackageConfig's
 getPreloadPackagesAnd :: DynFlags -> [PackageId] -> IO [PackageConfig]
 getPreloadPackagesAnd dflags pkgids =
-  let 
+  let
       state   = pkgState dflags
       pkg_map = pkgIdMap state
       ipid_map = installedPackageIdMap state
@@ -988,8 +981,8 @@ closeDeps pkg_map ipid_map ps = throwErr (closeDepsErr pkg_map ipid_map ps)
 
 throwErr :: MaybeErr MsgDoc a -> IO a
 throwErr m = case m of
-		Failed e    -> ghcError (CmdLineError (showSDoc e))
-		Succeeded r -> return r
+                Failed e    -> ghcError (CmdLineError (showSDoc e))
+                Succeeded r -> return r
 
 closeDepsErr :: PackageConfigMap
              -> Map InstalledPackageId PackageId
@@ -998,21 +991,21 @@ closeDepsErr :: PackageConfigMap
 closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps
 
 -- internal helper
-add_package :: PackageConfigMap 
+add_package :: PackageConfigMap
             -> Map InstalledPackageId PackageId
             -> [PackageId]
             -> (PackageId,Maybe PackageId)
             -> MaybeErr MsgDoc [PackageId]
 add_package pkg_db ipid_map ps (p, mb_parent)
-  | p `elem` ps = return ps	-- Check if we've already added this package
+  | p `elem` ps = return ps     -- Check if we've already added this package
   | otherwise =
       case lookupPackage pkg_db p of
-        Nothing -> Failed (missingPackageMsg (packageIdString p) <> 
+        Nothing -> Failed (missingPackageMsg (packageIdString p) <>
                            missingDependencyMsg mb_parent)
         Just pkg -> do
-    	   -- Add the package's dependents also
-    	   ps' <- foldM add_package_ipid ps (depends pkg)
-    	   return (p : ps')
+           -- Add the package's dependents also
+           ps' <- foldM add_package_ipid ps (depends pkg)
+           return (p : ps')
           where
             add_package_ipid ps ipid@(InstalledPackageId str)
               | Just pid <- Map.lookup ipid ipid_map
@@ -1049,9 +1042,9 @@ isDllName this_pkg name
 -- | Show package info on console, if verbosity is >= 3
 dumpPackages :: DynFlags -> IO ()
 dumpPackages dflags
-  = do  let pkg_map = pkgIdMap (pkgState dflags)
-	putMsg dflags $
-              vcat (map (text . showInstalledPackageInfo
-                              . packageConfigToInstalledPackageInfo)
-                        (eltsUFM pkg_map))
+  = do let pkg_map = pkgIdMap (pkgState dflags)
+       putMsg dflags $
+             vcat (map (text . showInstalledPackageInfo
+                             . packageConfigToInstalledPackageInfo)
+                       (eltsUFM pkg_map))
 \end{code}
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 94b2019e9e..378a25c8e1 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -321,6 +321,10 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
 
   "[" @varid "|"  / { ifExtension qqEnabled }
                      { lex_quasiquote_tok }
+
+  -- qualified quasi-quote (#5555)
+  "[" @qual @varid "|"  / { ifExtension qqEnabled }
+                          { lex_qquasiquote_tok }
 }
 
 <0> {
@@ -562,7 +566,14 @@ data Token
   | ITidEscape   FastString     --  $x
   | ITparenEscape               --  $(
   | ITtyQuote                   --  ''
-  | ITquasiQuote (FastString,FastString,RealSrcSpan) --  [:...|...|]
+  | ITquasiQuote (FastString,FastString,RealSrcSpan)
+    -- ITquasiQuote(quoter, quote, loc)
+    -- represents a quasi-quote of the form
+    -- [quoter| quote |]
+  | ITqQuasiQuote (FastString,FastString,FastString,RealSrcSpan)
+    -- ITqQuasiQuote(Qual, quoter, quote, loc)
+    -- represents a qualified quasi-quote of the form
+    -- [Qual.quoter| quote |]
 
   -- Arrow notation extension
   | ITproc
@@ -1423,6 +1434,18 @@ getCharOrFail i =  do
 -- -----------------------------------------------------------------------------
 -- QuasiQuote
 
+lex_qquasiquote_tok :: Action
+lex_qquasiquote_tok span buf len = do
+  let (qual, quoter) = splitQualName (stepOn buf) (len - 2) False
+  quoteStart <- getSrcLoc
+  quote <- lex_quasiquote quoteStart ""
+  end <- getSrcLoc
+  return (L (mkRealSrcSpan (realSrcSpanStart span) end)
+           (ITqQuasiQuote (qual,
+                           quoter,
+                           mkFastString (reverse quote),
+                           mkRealSrcSpan quoteStart end)))
+
 lex_quasiquote_tok :: Action
 lex_quasiquote_tok span buf len = do
   let quoter = tail (lexemeToString buf (len - 1))
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 6424dea79f..9774c245e7 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -350,6 +350,7 @@ TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
 '$('            { L _ ITparenEscape   }     -- $( exp )
 TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
 TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
+TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
 
 %monad { P } { >>= } { return }
 %lexer { lexer } { L _ ITeof }
@@ -1360,6 +1361,10 @@ quasiquote :: { Located (HsQuasiQuote RdrName) }
                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
                                 ; quoterId = mkUnqual varName quoter }
                             in L1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
+        | TH_QQUASIQUOTE  { let { loc = getLoc $1
+                                ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
+                                ; quoterId = mkQual varName (qual, quoter) }
+                            in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
 
 exp   :: { LHsExpr RdrName }
         : infixexp '::' sigtype         { LL $ ExprWithTySig $1 $3 }
diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 8056c0eceb..56525b97fa 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -79,6 +79,14 @@ occurAnalysePgm this_mod active_rule imp_rules vects binds
                             (rulesFreeVars imp_rules `unionVarSet` vectsFreeVars vects)
     -- The RULES and VECTORISE declarations keep things alive!
 
+    -- Note [Preventing loops due to imported functions rules]
+    imp_rules_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv
+                            [ mapVarEnv (const maps_to) (exprFreeIds arg `delVarSetList` ru_bndrs imp_rule)
+                            | imp_rule <- imp_rules
+                            , let maps_to = exprFreeIds (ru_rhs imp_rule)
+                                             `delVarSetList` ru_bndrs imp_rule
+                            , arg <- ru_args imp_rule ]
+
     go :: OccEnv -> [CoreBind] -> (UsageDetails, [CoreBind])
     go _ []
         = (initial_uds, [])
@@ -86,7 +94,7 @@ occurAnalysePgm this_mod active_rule imp_rules vects binds
         = (final_usage, bind' ++ binds')
         where
            (bs_usage, binds')   = go env binds
-           (final_usage, bind') = occAnalBind env env bind bs_usage
+           (final_usage, bind') = occAnalBind env env imp_rules_edges bind bs_usage
 
 occurAnalyseExpr :: CoreExpr -> CoreExpr
         -- Do occurrence analysis, and discard occurence info returned
@@ -110,12 +118,13 @@ Bindings
 \begin{code}
 occAnalBind :: OccEnv 		-- The incoming OccEnv
 	    -> OccEnv		-- Same, but trimmed by (binderOf bind)
+            -> IdEnv IdSet      -- Mapping from FVs of imported RULE LHSs to RHS FVs
             -> CoreBind
             -> UsageDetails             -- Usage details of scope
             -> (UsageDetails,           -- Of the whole let(rec)
                 [CoreBind])
 
-occAnalBind env _ (NonRec binder rhs) body_usage
+occAnalBind env _ imp_rules_edges (NonRec binder rhs) body_usage
   | isTyVar binder	-- A type let; we don't gather usage info
   = (body_usage, [NonRec binder rhs])
 
@@ -123,15 +132,17 @@ occAnalBind env _ (NonRec binder rhs) body_usage
   = (body_usage, [])
 
   | otherwise                   -- It's mentioned in the body
-  = (body_usage' +++ rhs_usage3, [NonRec tagged_binder rhs'])
+  = (body_usage' +++ rhs_usage4, [NonRec tagged_binder rhs'])
   where
     (body_usage', tagged_binder) = tagBinder body_usage binder
     (rhs_usage1, rhs')           = occAnalRhs env (Just tagged_binder) rhs
     rhs_usage2 = addIdOccs rhs_usage1 (idUnfoldingVars binder)
     rhs_usage3 = addIdOccs rhs_usage2 (idRuleVars binder)
        -- See Note [Rules are extra RHSs] and Note [Rule dependency info]
+    rhs_usage4 = maybe rhs_usage3 (addIdOccs rhs_usage3) $ lookupVarEnv imp_rules_edges binder
+       -- See Note [Preventing loops due to imported functions rules]
 
-occAnalBind _ env (Rec pairs) body_usage
+occAnalBind _ env imp_rules_edges (Rec pairs) body_usage
   = foldr occAnalRec (body_usage, []) sccs
 	-- For a recursive group, we 
 	--	* occ-analyse all the RHSs
@@ -144,7 +155,7 @@ occAnalBind _ env (Rec pairs) body_usage
     sccs = {-# SCC "occAnalBind.scc" #-} stronglyConnCompFromEdgedVerticesR nodes
 
     nodes :: [Node Details]
-    nodes = {-# SCC "occAnalBind.assoc" #-} map (makeNode env bndr_set) pairs
+    nodes = {-# SCC "occAnalBind.assoc" #-} map (makeNode env imp_rules_edges bndr_set) pairs
 \end{code}
 
 Note [Dead code]
@@ -404,6 +415,86 @@ It's up the programmer not to write silly rules like
      RULE f x = f x
 and the example above is just a more complicated version. 
 
+Note [Preventing loops due to imported functions rules]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider:
+  import GHC.Base (foldr)
+  
+  {-# RULES "filterList" forall p. foldr (filterFB (:) p) [] = filter p #-}
+  filter p xs = build (\c n -> foldr (filterFB c p) n xs)
+  filterFB c p = ...
+
+  f = filter p xs
+
+Note that filter is not a loop-breaker, so what happens is:
+  f =          filter p xs
+    = {inline} build (\c n -> foldr (filterFB c p) n xs)
+    = {inline} foldr (filterFB (:) p) [] xs
+    = {RULE}   filter p xs
+
+We are in an infinite loop.
+
+A more elaborate example (that I actually saw in practice when I went to
+mark GHC.List.filter as INLINABLE) is as follows. Say I have this module:
+  {-# LANGUAGE Rank2Types #-}
+  module GHCList where
+  
+  import Prelude hiding (filter)
+  import GHC.Base (build)
+  
+  {-# INLINABLE filter #-}
+  filter :: (a -> Bool) -> [a] -> [a]
+  filter p [] = []
+  filter p (x:xs) = if p x then x : filter p xs else filter p xs
+  
+  {-# NOINLINE [0] filterFB #-}
+  filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b
+  filterFB c p x r | p x       = x `c` r
+                   | otherwise = r
+  
+  {-# RULES
+  "filter"     [~1] forall p xs.  filter p xs = build (\c n -> foldr
+  (filterFB c p) n xs)
+  "filterList" [1]  forall p.     foldr (filterFB (:) p) [] = filter p
+   #-}
+
+Then (because RULES are applied inside INLINABLE unfoldings, but inlinings
+are not), the unfolding given to "filter" in the interface file will be:
+  filter p []     = []
+  filter p (x:xs) = if p x then x : build (\c n -> foldr (filterFB c p) n xs)
+                           else     build (\c n -> foldr (filterFB c p) n xs
+
+Note that because this unfolding does not mention "filter", filter is not
+marked as a strong loop breaker. Therefore at a use site in another module:
+  filter p xs
+    = {inline}
+      case xs of []     -> []
+                 (x:xs) -> if p x then x : build (\c n -> foldr (filterFB c p) n xs)
+                                  else     build (\c n -> foldr (filterFB c p) n xs)
+
+  build (\c n -> foldr (filterFB c p) n xs)
+    = {inline} foldr (filterFB (:) p) [] xs
+    = {RULE}   filter p xs
+
+And we are in an infinite loop again, except that this time the loop is producing an
+infinitely large *term* (an unrolling of filter) and so the simplifier finally
+dies with "ticks exhausted"
+
+Because of this problem, we make a small change in the occurrence analyser
+designed to mark functions like "filter" as strong loop breakers on the basis that:
+  1. The RHS of filter mentions the local function "filterFB"
+  2. We have a rule which mentions "filterFB" on the LHS and "filter" on the RHS
+
+So for each RULE for an *imported* function we are going to add dependency edges between
+the FVS of the rule LHS and the FVS of the rule RHS. We don't do anything special for
+RULES on local functions because the standard occurrence analysis stuff is pretty good
+at getting loop-breakerness correct there.
+
+It is important to note that even with this extra hack we aren't always going to get
+things right. For example, it might be that the rule LHS mentions an imported Id,
+and another module has a RULE that can rewrite that imported Id to one of our local
+Ids.
+
 Note [Specialising imported functions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 BUT for *automatically-generated* rules, the programmer can't be
@@ -566,8 +657,8 @@ instance Outputable Details where
                   , ptext (sLit "rule =") <+> ppr (nd_active_rule_fvs nd)
 	     ])
 
-makeNode :: OccEnv -> VarSet -> (Var, CoreExpr) -> Node Details
-makeNode env bndr_set (bndr, rhs)
+makeNode :: OccEnv -> IdEnv IdSet -> VarSet -> (Var, CoreExpr) -> Node Details
+makeNode env imp_rules_edges bndr_set (bndr, rhs)
   = (details, varUnique bndr, keysUFM node_fvs)
   where
     details = ND { nd_bndr = bndr
@@ -591,7 +682,9 @@ makeNode env bndr_set (bndr, rhs)
     is_active = occ_rule_act env :: Activation -> Bool
     rules = filterOut isBuiltinRule (idCoreRules bndr)
     rules_w_fvs :: [(Activation, VarSet)]    -- Find the RHS fvs
-    rules_w_fvs = [ (ru_act rule, fvs)
+    rules_w_fvs = maybe id (\ids -> ((AlwaysActive, ids):)) (lookupVarEnv imp_rules_edges bndr)
+                   -- See Note [Preventing loops due to imported functions rules]
+                  [ (ru_act rule, fvs)
                   | rule <- rules
                   , let fvs = exprFreeVars (ru_rhs rule)
 		    	      `delVarSetList` ru_bndrs rule
@@ -1191,7 +1284,7 @@ occAnal env (Case scrut bndr ty alts)
 
 occAnal env (Let bind body)
   = case occAnal env_body body                    of { (body_usage, body') ->
-    case occAnalBind env env_body bind body_usage of { (final_usage, new_binds) ->
+    case occAnalBind env env_body emptyVarEnv bind body_usage of { (final_usage, new_binds) ->
        (final_usage, mkLets new_binds body') }}
   where
     env_body = trimOccEnv env (bindersOf bind)
diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 7bda323f5b..ae8ac26918 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -210,17 +210,15 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ (CLabel _))
 
 tcCheckFIType sig_ty arg_tys res_ty (CImport cconv safety mh CWrapper) = do
         -- Foreign wrapper (former f.e.d.)
-        -- The type must be of the form ft -> IO (FunPtr ft), where ft is a
-        -- valid foreign type.  For legacy reasons ft -> IO (Ptr ft) as well
-        -- as ft -> IO Addr is accepted, too.  The use of the latter two forms
-        -- is DEPRECATED, though.
+        -- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid
+        -- foreign type.  For legacy reasons ft -> IO (Ptr ft) is accepted, too.
+        -- The use of the latter form is DEPRECATED, though.
     checkCg checkCOrAsmOrLlvmOrInterp
     cconv' <- checkCConv cconv
     case arg_tys of
         [arg1_ty] -> do checkForeignArgs isFFIExternalTy arg1_tys
                         checkForeignRes nonIOok  checkSafe isFFIExportResultTy res1_ty
-                        checkForeignRes mustBeIO checkSafe isFFIDynResultTy    res_ty
-                                 -- ToDo: Why are res1_ty and res_ty not equal?
+                        checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty
                   where
                      (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
         _ -> addErrTc (illegalForeignTyErr empty sig_ty)
@@ -230,12 +228,13 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
   | isDynamicTarget target = do -- Foreign import dynamic
       checkCg checkCOrAsmOrLlvmOrInterp
       cconv' <- checkCConv cconv
-      case arg_tys of           -- The first arg must be Ptr, FunPtr, or Addr
+      case arg_tys of           -- The first arg must be Ptr or FunPtr
         []                -> do
           check False (illegalForeignTyErr empty sig_ty)
         (arg1_ty:arg_tys) -> do
           dflags <- getDynFlags
-          check (isFFIDynArgumentTy arg1_ty)
+          let curried_res_ty = foldr FunTy res_ty arg_tys
+          check (isFFIDynTy curried_res_ty arg1_ty)
                 (illegalForeignTyErr argument arg1_ty)
           checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
           checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index a345da507f..e535f24d59 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -831,7 +831,7 @@ runMeta show_code run_and_convert expr
         ; either_hval <- tryM $ liftIO $
                          HscMain.hscCompileCoreExpr hsc_env src_span ds_expr
         ; case either_hval of {
-            Left exn   -> failWithTc (mk_msg "compile and link" exn) ;
+            Left exn   -> fail_with_exn "compile and link" exn ;
             Right hval -> do
 
         {       -- Coerce it to Q t, and run it
@@ -859,12 +859,16 @@ runMeta show_code run_and_convert expr
             Right v -> return v
             Left se -> case fromException se of
                          Just IOEnvFailure -> failM -- Error already in Tc monad
-                         _ -> failWithTc (mk_msg "run" se)      -- Exception
+                         _ -> fail_with_exn "run" se -- Exception
         }}}
   where
-    mk_msg s exn = vcat [text "Exception when trying to" <+> text s <+> text "compile-time code:",
-                         nest 2 (text (Panic.showException exn)),
-                         if show_code then nest 2 (text "Code:" <+> ppr expr) else empty]
+    -- see Note [Concealed TH exceptions]
+    fail_with_exn phase exn = do
+        exn_msg <- liftIO $ Panic.safeShowException exn
+        let msg = vcat [text "Exception when trying to" <+> text phase <+> text "compile-time code:",
+                        nest 2 (text exn_msg),
+                        if show_code then nest 2 (text "Code:" <+> ppr expr) else empty]
+        failWithTc msg
 \end{code}
 
 Note [Exceptions in TH]
@@ -896,6 +900,21 @@ like that.  Here's how it's processed:
         - other errors, we add an error to the bag
     and then fail
 
+Note [Concealed TH exceptions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When displaying the error message contained in an exception originated from TH
+code, we need to make sure that the error message itself does not contain an
+exception.  For example, when executing the following splice:
+
+    $( error ("foo " ++ error "bar") )
+
+the message for the outer exception is a thunk which will throw the inner
+exception when evaluated.
+
+For this reason, we display the message of a TH exception using the
+'safeShowException' function, which recursively catches any exception thrown
+when showing an error message.
+
 
 To call runQ in the Tc monad, we need to make TcM an instance of Quasi:
 
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index e9af2015ba..fc08bad1d1 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -102,8 +102,7 @@ module TcType (
   isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
   isFFIExportResultTy, -- :: Type -> Bool
   isFFIExternalTy,     -- :: Type -> Bool
-  isFFIDynArgumentTy,  -- :: Type -> Bool
-  isFFIDynResultTy,    -- :: Type -> Bool
+  isFFIDynTy,          -- :: Type -> Type -> Bool
   isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
   isFFIPrimResultTy,   -- :: DynFlags -> Type -> Bool
   isFFILabelTy,        -- :: Type -> Bool
@@ -1338,19 +1337,24 @@ isFFIImportResultTy dflags ty
 isFFIExportResultTy :: Type -> Bool
 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
 
-isFFIDynArgumentTy :: Type -> Bool
--- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
--- or a newtype of either.
-isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
-
-isFFIDynResultTy :: Type -> Bool
--- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
--- or a newtype of either.
-isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
+isFFIDynTy :: Type -> Type -> Bool
+-- The type in a foreign import dynamic must be Ptr, FunPtr, or a newtype of
+-- either, and the wrapped function type must be equal to the given type.
+-- We assume that all types have been run through normalizeFfiType, so we don't
+-- need to worry about expanding newtypes here.
+isFFIDynTy expected ty
+    -- Note [Foreign import dynamic]
+    -- In the example below, expected would be 'CInt -> IO ()', while ty would
+    -- be 'FunPtr (CDouble -> IO ())'.
+    | Just (tc, [ty']) <- splitTyConApp_maybe ty
+    , tyConUnique tc `elem` [ptrTyConKey, funPtrTyConKey]
+    , eqType ty' expected
+    = True
+    | otherwise
+    = False
 
 isFFILabelTy :: Type -> Bool
--- The type of a foreign label must be Ptr, FunPtr, Addr,
--- or a newtype of either.
+-- The type of a foreign label must be Ptr, FunPtr, or a newtype of either.
 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
 
 isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
@@ -1401,6 +1405,21 @@ checkRepTyConKey keys
   = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
 \end{code}
 
+Note [Foreign import dynamic]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A dynamic stub must be of the form 'FunPtr ft -> ft' where ft is any foreign
+type.  Similarly, a wrapper stub must be of the form 'ft -> IO (FunPtr ft)'.
+
+We use isFFIDynTy to check whether a signature is well-formed. For example,
+given a (illegal) declaration like:
+
+foreign import ccall "dynamic"
+  foo :: FunPtr (CDouble -> IO ()) -> CInt -> IO ()
+
+isFFIDynTy will compare the 'FunPtr' type 'CDouble -> IO ()' with the curried
+result type 'CInt -> IO ()', and return False, as they are not equal.
+
+
 ----------------------------------------------
 These chaps do the work; they are not exported
 ----------------------------------------------
diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs
index 68a61fd860..50a0fcf39a 100644
--- a/compiler/types/Unify.lhs
+++ b/compiler/types/Unify.lhs
@@ -199,6 +199,8 @@ match menv subst (AppTy ty1a ty1b) ty2
   = do { subst' <- match menv subst ty1a ty2a
        ; match menv subst' ty1b ty2b }
 
+match _ subst (LitTy x) (LitTy y) | x == y  = return subst
+
 match _ _ _ _
   = Nothing
 
@@ -339,6 +341,8 @@ typesCantMatch prs = any (\(s,t) -> cant_match s t) prs
 	| Just (f1, a1) <- repSplitAppTy_maybe ty1
 	= cant_match f1 f2 || cant_match a1 a2
 
+    cant_match (LitTy x) (LitTy y) = x /= y
+
     cant_match _ _ = False      -- Safe!
 
 -- Things we could add;
@@ -453,6 +457,8 @@ unify subst ty1 (AppTy ty2a ty2b)
   = do	{ subst' <- unify subst ty1a ty2a
         ; unify subst' ty1b ty2b }
 
+unify subst (LitTy x) (LitTy y) | x == y = return subst
+
 unify _ ty1 ty2 = failWith (misMatch ty1 ty2)
 	-- ForAlls??
 
diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index cc3603baeb..0fb206ca77 100644
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -22,7 +22,7 @@ module Panic (
 
      panic, sorry, panicFastInt, assertPanic, trace,
      
-     Exception.Exception(..), showException, try, tryMost, throwTo,
+     Exception.Exception(..), showException, safeShowException, try, tryMost, throwTo,
 
      installSignalHandlers, interruptTargetThread
 ) where
@@ -113,6 +113,18 @@ short_usage = "Usage: For basic information, try the `--help' option."
 showException :: Exception e => e -> String
 showException = show
 
+-- | Show an exception which can possibly throw other exceptions.
+-- Used when displaying exception thrown within TH code.
+safeShowException :: Exception e => e -> IO String
+safeShowException e = do
+    -- ensure the whole error message is evaluated inside try
+    r <- try (return $! forceList (showException e))
+    case r of
+        Right msg -> return msg
+        Left e' -> safeShowException (e' :: SomeException)
+    where
+        forceList [] = []
+        forceList xs@(x : xt) = x `seq` forceList xt `seq` xs
 
 -- | Append a description of the given exception to this string.
 showGhcException :: GhcException -> String -> String
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 73f9414ecc..169dd9d440 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -981,6 +981,12 @@
             <entry><option>-XNoTypeOperators</option></entry>
           </row>
           <row>
+            <entry><option>-XExplicitNamespaces</option></entry>
+            <entry>Enable using the keyword <literal>type</literal> to specify the namespace of entries in imports and exports.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoExplicitNamespaces</option></entry>
+          </row>
+          <row>
             <entry><option>-XDoRec</option></entry>
             <entry>Enable <link linkend="recursive-do-notation">recursive do notation</link>.</entry>
             <entry>dynamic</entry>
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index 53dff29cf1..14d0630145 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -5371,6 +5371,52 @@ Note that this requires <option>-XTypeOperators</option>.
 </para>
 </sect3>
 
+<sect3 id="promoted-literals">
+<title>Promoted Literals</title>
+<para>
+Numeric and string literals are prmoted to the type level, giving convenient
+access to a large number of predefined type-level constants.  Numeric literals
+are of kind <literal>Nat</literal>, while string literals are of kind
+<literal>Symbol</literal>.  These kinds are defined in the module
+<literal>GHC.TypeLits</literal>.
+</para>
+
+<para>
+Here is an exampe of using type-level numeric literals to provide a safe
+interface to a low-level function:
+<programlisting>
+import GHC.TypeLits
+import Data.Word
+import Foreign
+
+newtype ArrPtr (n :: Nat) a = ArrPtr (Ptr a)
+
+clearPage :: ArrPtr 4096 Word8 -> IO ()
+clearPage (ArrPtr p) = ...
+</programlisting>
+</para>
+
+<para>
+Here is an example of using type-level string literals to simulate
+simple record operations:
+<programlisting>
+data Label (l :: Symbol) = Get
+
+class Has a l b | a l -> b where
+  from :: a -> Label l -> b
+
+data Point = Point Int Int deriving Show
+
+instance Has Point "x" Int where from (Point x _) _ = x
+instance Has Point "y" Int where from (Point _ y) _ = y
+
+example = from (Point 1 2) (Get :: Label "x")
+</programlisting>
+</para>
+</sect3>
+
+
+
 </sect2>
 
 <sect2 id="kind-polymorphism-limitations">
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 045c6a6af4..4525942296 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1688,7 +1688,8 @@ checkAdd ii = do
 
     IIDecl d -> do
        let modname = unLoc (ideclName d)
-       m <- lookupModuleName modname
+           pkgqual = ideclPkgQual d
+       m <- GHC.lookupModule modname pkgqual
        when safe $ do
            t <- GHC.isModuleTrusted m
            when (not t) $