Fix CodingStyle#Warnings URLs

[ghc-hetmet.git] / compiler / hsSyn / HsUtils.lhs

diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 9bd3448..3b9271a 100644 (file)
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -13,6 +13,13 @@ which deal with the intantiated versions are located elsewhere:
    Id                  typecheck/TcHsSyn       
 
 \begin{code}
    Id                  typecheck/TcHsSyn       
 
 \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 HsUtils where
 
 #include "HsVersions.h"
 module HsUtils where
 
 #include "HsVersions.h"

@@ -22,7 +29,6 @@ import HsExpr
 import HsPat
 import HsTypes 
 import HsLit
 import HsPat
 import HsTypes 
 import HsLit

-import HsDecls

 
 import RdrName
 import Var
 
 import RdrName
 import Var

@@ -101,7 +107,7 @@ mkHsDictLet binds expr
                            val_binds = ValBindsOut [(Recursive, binds)] []
 
 mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
                            val_binds = ValBindsOut [(Recursive, binds)] []
 
 mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id

--- Used for constructing dictinoary terms etc, so no locations 
+-- Used for constructing dictionary terms etc, so no locations 

 mkHsConApp data_con tys args 
   = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args
   where
 mkHsConApp data_con tys args 
   = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args
   where

@@ -320,22 +326,24 @@ collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-collectLStmtsBinders :: [LStmt id] -> [Located id]
+collectLStmtsBinders :: OutputableBndr id => [LStmt id] -> [Located id]

 collectLStmtsBinders = concatMap collectLStmtBinders
 
 collectLStmtsBinders = concatMap collectLStmtBinders
 

-collectStmtsBinders :: [Stmt id] -> [Located id]
+collectStmtsBinders :: OutputableBndr id => [Stmt id] -> [Located id]

 collectStmtsBinders = concatMap collectStmtBinders
 
 collectStmtsBinders = concatMap collectStmtBinders
 

-collectLStmtBinders :: LStmt id -> [Located id]
+collectLStmtBinders :: OutputableBndr id => LStmt id -> [Located id]

 collectLStmtBinders = collectStmtBinders . unLoc
 
 collectLStmtBinders = collectStmtBinders . unLoc
 

-collectStmtBinders :: Stmt id -> [Located id]
+collectStmtBinders :: OutputableBndr id => Stmt id -> [Located id]

   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
 collectStmtBinders (BindStmt pat _ _ _) = collectLocatedPatBinders pat
 collectStmtBinders (LetStmt binds)      = collectLocalBinders binds
   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
 collectStmtBinders (BindStmt pat _ _ _) = collectLocatedPatBinders pat
 collectStmtBinders (LetStmt binds)      = collectLocalBinders binds

-collectStmtBinders (ExprStmt _ _ _)    = []
-collectStmtBinders (RecStmt ss _ _ _ _)        = collectLStmtsBinders ss
-collectStmtBinders other               = panic "collectStmtBinders"
+collectStmtBinders (ExprStmt _ _ _)     = []
+collectStmtBinders (ParStmt xs)         = collectLStmtsBinders
+                                        $ concatMap fst xs
+collectStmtBinders (RecStmt ss _ _ _ _) = collectLStmtsBinders ss
+collectStmtBinders s                    = pprPanic "collectStmtBinders" (ppr s)

 \end{code}
 
 
 \end{code}
 
 

@@ -382,8 +390,8 @@ collectl (L l pat) bndrs
     go (PArrPat pats _)          = foldr collectl bndrs pats
     go (TuplePat pats _ _)       = foldr collectl bndrs pats
                                  
     go (PArrPat pats _)          = foldr collectl bndrs pats
     go (TuplePat pats _ _)       = foldr collectl bndrs pats
                                  

-    go (ConPatIn c ps)           = foldr collectl bndrs (hsConArgs ps)
-    go (ConPatOut {pat_args=ps})  = foldr collectl bndrs (hsConArgs ps)
+    go (ConPatIn c ps)           = foldr collectl bndrs (hsConPatArgs ps)
+    go (ConPatOut {pat_args=ps})  = foldr collectl bndrs (hsConPatArgs ps)

        -- See Note [Dictionary binders in ConPatOut]
     go (LitPat _)                = bndrs
     go (NPat _ _ _ _)            = bndrs
        -- See Note [Dictionary binders in ConPatOut]
     go (LitPat _)                = bndrs
     go (NPat _ _ _ _)            = bndrs

@@ -392,8 +400,6 @@ collectl (L l pat) bndrs
     go (SigPatIn pat _)                  = collectl pat bndrs
     go (SigPatOut pat _)         = collectl pat bndrs
     go (TypePat ty)               = bndrs
     go (SigPatIn pat _)                  = collectl pat bndrs
     go (SigPatOut pat _)         = collectl pat bndrs
     go (TypePat ty)               = bndrs

-    go (DictPat ids1 ids2)        = map noLoc ids1 ++ map noLoc ids2
-                                   ++ bndrs

     go (CoPat _ pat ty)           = collectl (noLoc pat) bndrs
 \end{code}
 
     go (CoPat _ pat ty)           = collectl (noLoc pat) bndrs
 \end{code}
 

@@ -407,6 +413,22 @@ collectPatBinders.  In a lazy pattern, for example f ~(C x y) = ...,
 we want to generate bindings for x,y but not for dictionaries bound by
 C.  (The type checker ensures they would not be used.)
 
 we want to generate bindings for x,y but not for dictionaries bound by
 C.  (The type checker ensures they would not be used.)
 

+Desugaring of arrow case expressions needs these bindings (see DsArrows
+and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
+own pat-binder-collector:
+
+Here's the problem.  Consider
+
+data T a where
+   C :: Num a => a -> Int -> T a
+
+f ~(C (n+1) m) = (n,m)
+
+Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
+and *also* uses that dictionary to match the (n+1) pattern.  Yet, the
+variables bound by the lazy pattern are n,m, *not* the dictionary d.
+So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
+

 \begin{code}
 collectSigTysFromPats :: [InPat name] -> [LHsType name]
 collectSigTysFromPats pats = foldr collect_lpat [] pats
 \begin{code}
 collectSigTysFromPats :: [InPat name] -> [LHsType name]
 collectSigTysFromPats pats = foldr collect_lpat [] pats

@@ -426,6 +448,6 @@ collect_pat (ParPat  pat)           acc = collect_lpat pat acc
 collect_pat (ListPat pats _)           acc = foldr collect_lpat acc pats
 collect_pat (PArrPat pats _)           acc = foldr collect_lpat acc pats
 collect_pat (TuplePat pats _ _) acc = foldr collect_lpat acc pats
 collect_pat (ListPat pats _)           acc = foldr collect_lpat acc pats
 collect_pat (PArrPat pats _)           acc = foldr collect_lpat acc pats
 collect_pat (TuplePat pats _ _) acc = foldr collect_lpat acc pats

-collect_pat (ConPatIn c ps)     acc = foldr collect_lpat acc (hsConArgs ps)
+collect_pat (ConPatIn c ps)     acc = foldr collect_lpat acc (hsConPatArgs ps)

 collect_pat other              acc = acc       -- Literals, vars, wildcard
 \end{code}
 collect_pat other              acc = acc       -- Literals, vars, wildcard
 \end{code}