Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-7.4

http://hackage.haskell.org/trac/ghc/changeset/4a2127ceca0981147eb9c5dde49b076683168978

>---------------------------------------------------------------

commit 4a2127ceca0981147eb9c5dde49b076683168978
Author: David Terei <[email protected]>
Date:   Tue Dec 20 15:15:21 2011 -0800

    Move function from where clause to top level

>---------------------------------------------------------------

 compiler/main/HscMain.hs |   69 ++++++++++++++++++++++------------------------
 1 files changed, 33 insertions(+), 36 deletions(-)

diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index d56df00..b2a7932 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -911,20 +911,18 @@ hscCheckSafeImports tcg_env = do
             text "Rule \"" <> ftext n <> text "\" ignored" $+$
             text "User defined rules are disabled under Safe Haskell"
 
--- | Validate that safe imported modules are actually safe.
--- For modules in the HomePackage (the package the module we
--- are compiling in resides) this just involves checking its
--- trust type is 'Safe' or 'Trustworthy'. For modules that
--- reside in another package we also must check that the
--- external pacakge is trusted. See the Note [Safe Haskell
--- Trust Check] above for more information.
+-- | Validate that safe imported modules are actually safe.  For modules in the
+-- HomePackage (the package the module we are compiling in resides) this just
+-- involves checking its trust type is 'Safe' or 'Trustworthy'. For modules
+-- that reside in another package we also must check that the external pacakge
+-- is trusted. See the Note [Safe Haskell Trust Check] above for more
+-- information.
 --
--- The code for this is quite tricky as the whole algorithm
--- is done in a few distinct phases in different parts of the
--- code base. See RnNames.rnImportDecl for where package trust
--- dependencies for a module are collected and unioned.
--- Specifically see the Note [RnNames . Tracking Trust Transitively]
--- and the Note [RnNames . Trust Own Package].
+-- The code for this is quite tricky as the whole algorithm is done in a few
+-- distinct phases in different parts of the code base. See
+-- RnNames.rnImportDecl for where package trust dependencies for a module are
+-- collected and unioned.  Specifically see the Note [RnNames . Tracking Trust
+-- Transitively] and the Note [RnNames . Trust Own Package].
 checkSafeImports :: DynFlags -> TcGblEnv -> Hsc TcGblEnv
 checkSafeImports dflags tcg_env
     = do
@@ -941,7 +939,7 @@ checkSafeImports dflags tcg_env
         clearWarnings
         logWarnings oldErrs
 
-        -- See the Note [ Safe Haskell Inference]
+        -- See the Note [Safe Haskell Inference]
         case (not $ isEmptyBag errs) of
 
             -- We have errors!
@@ -953,7 +951,7 @@ checkSafeImports dflags tcg_env
 
             -- All good matey!
             False -> do
-                when (packageTrustOn dflags) $ checkPkgTrust pkg_reqs
+                when (packageTrustOn dflags) $ checkPkgTrust dflags pkg_reqs
                 -- add in trusted package requirements for this module
                 let new_trust = emptyImportAvails { imp_trust_pkgs = catMaybes 
pkgs }
                 return tcg_env { tcg_imports = imp_info `plusImportAvails` 
new_trust }
@@ -986,22 +984,6 @@ checkSafeImports dflags tcg_env
     checkSafe (_, _, False) = return Nothing
     checkSafe (m, l, True ) = hscCheckSafe' dflags m l
 
-    -- Here we check the transitive package trust requirements are OK still.
-    checkPkgTrust :: [PackageId] -> Hsc ()
-    checkPkgTrust pkgs =
-        case errors of
-            [] -> return ()
-            _  -> (liftIO . throwIO . mkSrcErr . listToBag) errors
-        where
-            errors = catMaybes $ map go pkgs
-            go pkg
-                | trusted $ getPackageDetails (pkgState dflags) pkg
-                = Nothing
-                | otherwise
-                = Just $ mkPlainErrMsg noSrcSpan
-                       $ text "The package (" <> ppr pkg <> text ") is 
required"
-                      <> text " to be trusted but it isn't!"
-
 -- | Check that a module is safe to import.
 --
 -- We return a package id if the safe import is OK and a Nothing otherwise
@@ -1055,11 +1037,10 @@ hscCheckSafe' dflags m l = do
                         <+> text "can't be safely imported!"
                         <+> text "The module itself isn't safe."
 
-    -- | Check the package a module resides in is trusted.
-    -- Safe compiled modules are trusted without requiring
-    -- that their package is trusted. For trustworthy modules,
-    -- modules in the home package are trusted but otherwise
-    -- we check the package trust flag.
+    -- | Check the package a module resides in is trusted. Safe compiled
+    -- modules are trusted without requiring that their package is trusted. For
+    -- trustworthy modules, modules in the home package are trusted but
+    -- otherwise we check the package trust flag.
     packageTrusted :: SafeHaskellMode -> Bool -> Module -> Bool
     packageTrusted _ _ _
         | not (packageTrustOn dflags)     = True
@@ -1084,6 +1065,22 @@ hscCheckSafe' dflags m l = do
         | thisPackage dflags == modulePackageId m = True
         | otherwise                               = False
 
+-- | Check the list of packages are trusted.
+checkPkgTrust :: DynFlags -> [PackageId] -> Hsc ()
+checkPkgTrust dflags pkgs =
+    case errors of
+        [] -> return ()
+        _  -> (liftIO . throwIO . mkSrcErr . listToBag) errors
+    where
+        errors = catMaybes $ map go pkgs
+        go pkg
+            | trusted $ getPackageDetails (pkgState dflags) pkg
+            = Nothing
+            | otherwise
+            = Just $ mkPlainErrMsg noSrcSpan
+                   $ text "The package (" <> ppr pkg <> text ") is required"
+                  <> text " to be trusted but it isn't!"
+
 -- | Set module to unsafe and wipe trust information.
 --
 -- Make sure to call this method to set a module to infered unsafe,



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to