Fix CodingStyle#Warnings URLs

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

diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index bd1fc21..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"

@@ -100,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

@@ -383,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

@@ -393,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}
 

@@ -408,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

@@ -427,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}