Fix CodingStyle#Warnings URLs

[ghc-hetmet.git] / compiler / codeGen / CgExpr.lhs

diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index 43f6990..bc91bef 100644 (file)
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.lhs
@@ -4,6 +4,13 @@
 %
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module CgExpr ( cgExpr ) where
 
 #include "HsVersions.h"
@@ -146,8 +153,7 @@ cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
                    else assignNonPtrTemp amode
                                        -- We're going to use it twice,
                                        -- so save in a temp if non-trivial
-       ; this_pkg <- getThisPackage
-       ; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
+       ; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
        ; performReturn emitReturnInstr }
    where
          -- If you're reading this code in the attempt to figure
@@ -183,10 +189,9 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
        = do tag_reg <- if isFollowableArg (typeCgRep res_ty)
                         then newPtrTemp wordRep
                         else newNonPtrTemp wordRep
-            this_pkg <- getThisPackage
             cgPrimOp [tag_reg] primop args emptyVarSet
             stmtC (CmmAssign nodeReg
-                    (tagToClosure this_pkg tycon
+                    (tagToClosure tycon
                      (CmmReg (CmmLocal tag_reg))))
             performReturn emitReturnInstr
   where
@@ -203,7 +208,7 @@ module, @CgCase@.
 \begin{code}
 
 cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
-  = cgCase expr live_vars save_vars bndr srt alt_type alts
+  = setSRT srt $ cgCase expr live_vars save_vars bndr alt_type alts
 \end{code}
 
 
@@ -292,8 +297,7 @@ cgRhs name (StgRhsCon maybe_cc con args)
        ; returnFC (name, idinfo) }
 
 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = do this_pkg <- getThisPackage
-       mkRhsClosure this_pkg name cc bi srt fvs upd_flag args body
+  = setSRT srt $ mkRhsClosure name cc bi fvs upd_flag args body
 \end{code}
 
 mkRhsClosure looks for two special forms of the right-hand side:
@@ -316,12 +320,12 @@ form:
 
 
 \begin{code}
-mkRhsClosure   this_pkg bndr cc bi srt
+mkRhsClosure   bndr cc bi
                [the_fv]                -- Just one free var
                upd_flag                -- Updatable thunk
                []                      -- A thunk
                body@(StgCase (StgApp scrutinee [{-no args-}])
-                     _ _ _ _   -- ignore uniq, etc.
+                     _ _ _ srt   -- ignore uniq, etc.
                      (AlgAlt tycon)
                      [(DataAlt con, params, use_mask,
                            (StgApp selectee [{-no args-}]))])
@@ -334,11 +338,11 @@ mkRhsClosure      this_pkg bndr cc bi srt
     -- other constructors in the datatype.  It's still ok to make a selector
     -- thunk in this case, because we *know* which constructor the scrutinee
     -- will evaluate to.
-    cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
+    setSRT srt $ cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
   where
     lf_info              = mkSelectorLFInfo bndr offset_into_int
                                 (isUpdatable upd_flag)
-    (_, params_w_offsets) = layOutDynConstr this_pkg con (addIdReps params)
+    (_, params_w_offsets) = layOutDynConstr con (addIdReps params)
                        -- Just want the layout
     maybe_offset         = assocMaybe params_w_offsets selectee
     Just the_offset      = maybe_offset
@@ -362,7 +366,7 @@ We only generate an Ap thunk if all the free variables are pointers,
 for semi-obvious reasons.
 
 \begin{code}
-mkRhsClosure   this_pkg bndr cc bi srt
+mkRhsClosure    bndr cc bi
                fvs
                upd_flag
                []                      -- No args; a thunk
@@ -387,8 +391,8 @@ mkRhsClosure        this_pkg bndr cc bi srt
 The default case
 ~~~~~~~~~~~~~~~~
 \begin{code}
-mkRhsClosure this_pkg bndr cc bi srt fvs upd_flag args body
-  = cgRhsClosure bndr cc bi srt fvs upd_flag args body
+mkRhsClosure bndr cc bi fvs upd_flag args body
+  = cgRhsClosure bndr cc bi fvs upd_flag args body
 \end{code}
 
 
@@ -434,7 +438,7 @@ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
     -- case upd_flag of
     --     Updatable -> panic "cgLetNoEscapeRhs"       -- Nothing to update!
     --     other     -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
-    cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
+    setSRT srt $ cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info
        maybe_cc_slot rec args body
 
 -- For a constructor RHS we want to generate a single chunk of code which
@@ -442,7 +446,7 @@ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
                 (StgRhsCon cc con args)
-  = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT
+  = setSRT NoSRT $ cgLetNoEscapeClosure binder cc noBinderInfo{-safe-}
                         full_live_in_rhss rhs_eob_info maybe_cc_slot rec
        []      --No args; the binder is data structure, not a function
        (StgConApp con args)