Formatting fixes to TcForeign.lhs

1 files changed, 76 insertions, 77 deletions

diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 73fd449d32..8f53d6e7b8 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -12,11 +12,11 @@ is restricted to what the outside world understands (read C), and this
 module checks to see if a foreign declaration has got a legal type.
 
 \begin{code}
-module TcForeign 
-	( 
-	  tcForeignImports
+module TcForeign
+        (
+          tcForeignImports
         , tcForeignExports
-	) where
+        ) where
 
 #include "HsVersions.h"
 
@@ -43,18 +43,18 @@ import FastString
 -- Defines a binding
 isForeignImport :: LForeignDecl name -> Bool
 isForeignImport (L _ (ForeignImport _ _ _)) = True
-isForeignImport _			      = False
+isForeignImport _                           = False
 
 -- Exports a binding
 isForeignExport :: LForeignDecl name -> Bool
 isForeignExport (L _ (ForeignExport _ _ _)) = True
-isForeignExport _	  	              = False
+isForeignExport _                           = False
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Imports}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -64,22 +64,22 @@ tcForeignImports decls
 
 tcFImport :: ForeignDecl Name -> TcM (Id, ForeignDecl Id)
 tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl)
- = addErrCtxt (foreignDeclCtxt fo)  $ 
-   do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
-      ; let 
-          -- Drop the foralls before inspecting the
-          -- structure of the foreign type.
-	    (_, t_ty)	      = tcSplitForAllTys sig_ty
-	    (arg_tys, res_ty) = tcSplitFunTys t_ty
-	    id  	      = mkLocalId nm sig_ty
- 		-- Use a LocalId to obey the invariant that locally-defined 
-		-- things are LocalIds.  However, it does not need zonking,
-		-- (so TcHsSyn.zonkForeignExports ignores it).
-   
-      ; imp_decl' <- tcCheckFIType sig_ty arg_tys res_ty imp_decl
-         -- Can't use sig_ty here because sig_ty :: Type and 
-	 -- we need HsType Id hence the undefined
-      ; return (id, ForeignImport (L loc id) undefined imp_decl') }
+  = addErrCtxt (foreignDeclCtxt fo)  $
+    do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
+       ; let
+           -- Drop the foralls before inspecting the
+           -- structure of the foreign type.
+             (_, t_ty)         = tcSplitForAllTys sig_ty
+             (arg_tys, res_ty) = tcSplitFunTys t_ty
+             id                = mkLocalId nm sig_ty
+                 -- Use a LocalId to obey the invariant that locally-defined
+                 -- things are LocalIds.  However, it does not need zonking,
+                 -- (so TcHsSyn.zonkForeignExports ignores it).
+
+       ; imp_decl' <- tcCheckFIType sig_ty arg_tys res_ty imp_decl
+          -- Can't use sig_ty here because sig_ty :: Type and
+          -- we need HsType Id hence the undefined
+       ; return (id, ForeignImport (L loc id) undefined imp_decl') }
 tcFImport d = pprPanic "tcFImport" (ppr d)
 \end{code}
 
@@ -93,15 +93,15 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ (CLabel _))
     do { checkCg checkCOrAsmOrLlvmOrInterp
        ; checkSafety safety
        ; check (isFFILabelTy res_ty) (illegalForeignTyErr empty sig_ty)
-       ; return idecl }	     -- NB check res_ty not sig_ty!
-       	 	      	     --    In case sig_ty is (forall a. ForeignPtr a)
+       ; return idecl }      -- NB check res_ty not sig_ty!
+                             --    In case sig_ty is (forall a. ForeignPtr a)
 
 tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ 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.
+        -- 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.
     checkCg checkCOrAsmOrLlvmOrInterp
     checkCConv cconv
     checkSafety safety
@@ -174,14 +174,14 @@ checkMissingAmpersand dflags arg_tys res_ty
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Exports}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
-tcForeignExports :: [LForeignDecl Name] 
-    		 -> TcM (LHsBinds TcId, [LForeignDecl TcId])
+tcForeignExports :: [LForeignDecl Name]
+                 -> TcM (LHsBinds TcId, [LForeignDecl TcId])
 tcForeignExports decls
   = foldlM combine (emptyLHsBinds, []) (filter isForeignExport decls)
   where
@@ -190,25 +190,25 @@ tcForeignExports decls
        return (b `consBag` binds, f:fs)
 
 tcFExport :: ForeignDecl Name -> TcM (LHsBind Id, ForeignDecl Id)
-tcFExport fo@(ForeignExport (L loc nm) hs_ty spec) =
-   addErrCtxt (foreignDeclCtxt fo)      $ do
+tcFExport fo@(ForeignExport (L loc nm) hs_ty spec)
+  = addErrCtxt (foreignDeclCtxt fo) $ do
 
-   sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
-   rhs <- tcPolyExpr (nlHsVar nm) sig_ty
+    sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
+    rhs <- tcPolyExpr (nlHsVar nm) sig_ty
 
-   tcCheckFEType sig_ty spec
+    tcCheckFEType sig_ty spec
 
-	  -- we're exporting a function, but at a type possibly more
-	  -- constrained than its declared/inferred type. Hence the need
-	  -- to create a local binding which will call the exported function
-	  -- at a particular type (and, maybe, overloading).
+           -- we're exporting a function, but at a type possibly more
+           -- constrained than its declared/inferred type. Hence the need
+           -- to create a local binding which will call the exported function
+           -- at a particular type (and, maybe, overloading).
 
 
-   -- We need to give a name to the new top-level binding that
-   -- is *stable* (i.e. the compiler won't change it later),
-   -- because this name will be referred to by the C code stub.
-   id  <- mkStableIdFromName nm sig_ty loc mkForeignExportOcc
-   return (mkVarBind id rhs, ForeignExport (L loc id) undefined spec)
+    -- We need to give a name to the new top-level binding that
+    -- is *stable* (i.e. the compiler won't change it later),
+    -- because this name will be referred to by the C code stub.
+    id  <- mkStableIdFromName nm sig_ty loc mkForeignExportOcc
+    return (mkVarBind id rhs, ForeignExport (L loc id) undefined spec)
 tcFExport d = pprPanic "tcFExport" (ppr d)
 \end{code}
 
@@ -232,9 +232,9 @@ tcCheckFEType sig_ty (CExport (CExportStatic str cconv)) = do
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Miscellaneous}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -246,7 +246,7 @@ checkForeignArgs pred tys
     go ty = check (pred ty) (illegalForeignTyErr argument ty)
 
 ------------ Checking result types for foreign calls ----------------------
--- Check that the type has the form 
+-- Check that the type has the form
 --    (IO t) or (t) , and that t satisfies the given predicate.
 --
 checkForeignRes :: Bool -> (Type -> Bool) -> Type -> TcM ()
@@ -256,14 +256,14 @@ nonIOok  = True
 mustBeIO = False
 
 checkForeignRes non_io_result_ok pred_res_ty ty
-	-- (IO t) is ok, and so is any newtype wrapping thereof
+        -- (IO t) is ok, and so is any newtype wrapping thereof
   | Just (_, res_ty, _) <- tcSplitIOType_maybe ty,
     pred_res_ty res_ty
   = return ()
- 
+
   | otherwise
-  = check (non_io_result_ok && pred_res_ty ty) 
-	  (illegalForeignTyErr result ty)
+  = check (non_io_result_ok && pred_res_ty ty)
+          (illegalForeignTyErr result ty)
 \end{code}
 
 \begin{code}
@@ -272,7 +272,7 @@ checkCOrAsmOrLlvm HscC    = Nothing
 checkCOrAsmOrLlvm HscAsm  = Nothing
 checkCOrAsmOrLlvm HscLlvm = Nothing
 checkCOrAsmOrLlvm _
-   = Just (text "requires via-C, llvm (-fllvm) or native code generation (-fvia-C)")
+  = Just (text "requires via-C, llvm (-fllvm) or native code generation (-fvia-C)")
 
 checkCOrAsmOrLlvmOrInterp :: HscTarget -> Maybe SDoc
 checkCOrAsmOrLlvmOrInterp HscC           = Nothing
@@ -280,7 +280,7 @@ checkCOrAsmOrLlvmOrInterp HscAsm         = Nothing
 checkCOrAsmOrLlvmOrInterp HscLlvm        = Nothing
 checkCOrAsmOrLlvmOrInterp HscInterpreted = Nothing
 checkCOrAsmOrLlvmOrInterp _
-   = Just (text "requires interpreted, C, Llvm or native code generation")
+  = Just (text "requires interpreted, C, Llvm or native code generation")
 
 checkCOrAsmOrLlvmOrDotNetOrInterp :: HscTarget -> Maybe SDoc
 checkCOrAsmOrLlvmOrDotNetOrInterp HscC           = Nothing
@@ -288,33 +288,33 @@ checkCOrAsmOrLlvmOrDotNetOrInterp HscAsm         = Nothing
 checkCOrAsmOrLlvmOrDotNetOrInterp HscLlvm        = Nothing
 checkCOrAsmOrLlvmOrDotNetOrInterp HscInterpreted = Nothing
 checkCOrAsmOrLlvmOrDotNetOrInterp _
-   = Just (text "requires interpreted, C, Llvm or native code generation")
+  = Just (text "requires interpreted, C, Llvm or native code generation")
 
 checkCg :: (HscTarget -> Maybe SDoc) -> TcM ()
 checkCg check = do
-   dflags <- getDOpts
-   let target = hscTarget dflags
-   case target of
-     HscNothing -> return ()
-     _ ->
-       case check target of
-	 Nothing  -> return ()
-	 Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
+    dflags <- getDOpts
+    let target = hscTarget dflags
+    case target of
+      HscNothing -> return ()
+      _ ->
+        case check target of
+          Nothing  -> return ()
+          Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
 \end{code}
-			   
+
 Calling conventions
 
 \begin{code}
 checkCConv :: CCallConv -> TcM ()
-checkCConv CCallConv  = return ()
+checkCConv CCallConv    = return ()
 #if i386_TARGET_ARCH
-checkCConv StdCallConv = return ()
+checkCConv StdCallConv  = return ()
 #else
 -- This is a warning, not an error. see #3336
-checkCConv StdCallConv = addWarnTc (text "the 'stdcall' calling convention is unsupported on this platform,"$$ text "treating as ccall")
+checkCConv StdCallConv  = addWarnTc (text "the 'stdcall' calling convention is unsupported on this platform," $$ text "treating as ccall")
 #endif
 checkCConv PrimCallConv = addErrTc (text "The `prim' calling convention can only be used with `foreign import'")
-checkCConv CmmCallConv = panic "checkCConv CmmCallConv"
+checkCConv CmmCallConv  = panic "checkCConv CmmCallConv"
 \end{code}
 
 Deprecated "threadsafe" calls
@@ -329,12 +329,12 @@ Warnings
 
 \begin{code}
 check :: Bool -> Message -> TcM ()
-check True _	   = return ()
+check True _       = return ()
 check _    the_err = addErrTc the_err
 
 illegalForeignTyErr :: SDoc -> Type -> SDoc
 illegalForeignTyErr arg_or_res ty
-  = hang (hsep [ptext (sLit "Unacceptable"), arg_or_res, 
+  = hang (hsep [ptext (sLit "Unacceptable"), arg_or_res,
                 ptext (sLit "type in foreign declaration:")])
        2 (hsep [ppr ty])
 
@@ -344,12 +344,11 @@ argument = text "argument"
 result   = text "result"
 
 badCName :: CLabelString -> Message
-badCName target 
-   = sep [quotes (ppr target) <+> ptext (sLit "is not a valid C identifier")]
+badCName target
+  = sep [quotes (ppr target) <+> ptext (sLit "is not a valid C identifier")]
 
 foreignDeclCtxt :: ForeignDecl Name -> SDoc
 foreignDeclCtxt fo
   = hang (ptext (sLit "When checking declaration:"))
        2 (ppr fo)
 \end{code}
-