ghc/compiler/abstractSyn/HsPat.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
   3 %
   4 \section[PatSyntax]{Abstract Haskell syntax---patterns}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module HsPat where
  10
  11 import AbsPrel          ( mkTupleTy, mkListTy
  12                           IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
  13                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
  14 #ifdef DPH
  15                           , mkProcessorTy
  16 #endif
  17                         )
  18 import AbsUniType
  19 import HsLit            ( Literal )
  20 import HsExpr           ( Expr, TypecheckedExpr(..) )
  21 import Id
  22 import IdInfo
  23 import Maybes           ( maybeToBool, Maybe(..) )
  24 import Name             ( Name )
  25 import ProtoName        ( ProtoName(..) ) -- .. for pragmas only
  26 import Outputable
  27 import Pretty
  28 import Unique           ( Unique )
  29 import Util
  30 \end{code}
  31
  32 Patterns come in distinct before- and after-typechecking flavo(u)rs.
  33 \begin{code}
  34 data InPat name
  35   = WildPatIn                           --X wild card
  36   | VarPatIn        name                --X variable
  37   | LitPatIn        Literal             --  literal
  38   | LazyPatIn       (InPat name)        --X lazy pattern
  39   | AsPatIn         name                --X as pattern
  40                     (InPat name)
  41   | ConPatIn        name                --X constructed type
  42                     [(InPat name)]
  43   | ConOpPatIn      (InPat name)
  44                     name
  45                     (InPat name)
  46   | ListPatIn       [InPat name]                --X syntactic list
  47                                         -- must have >= 1 elements
  48   | TuplePatIn      [InPat name]                --X tuple
  49                                         -- UnitPat is TuplePat []
  50   | NPlusKPatIn     name                --  n+k pattern
  51                     Literal
  52 #ifdef DPH
  53   | ProcessorPatIn  [(InPat name)]
  54                      (InPat name)       -- (|pat1,...,patK;pat|)
  55 #endif {- Data Parallel Haskell -}
  56
  57 type ProtoNamePat = InPat ProtoName
  58 type RenamedPat = InPat Name
  59
  60 data TypecheckedPat
  61   = WildPat         UniType             -- wild card
  62
  63   | VarPat          Id                  -- variable (type is in the Id)
  64
  65   | LazyPat         TypecheckedPat      -- lazy pattern
  66
  67   | AsPat           Id          -- as pattern
  68                     TypecheckedPat
  69
  70   | ConPat          Id          -- constructed type;
  71                     UniType             -- the type of the pattern
  72                     [TypecheckedPat]
  73
  74   | ConOpPat        TypecheckedPat      -- just a special case...
  75                     Id
  76                     TypecheckedPat
  77                     UniType
  78   | ListPat                             -- syntactic list
  79                     UniType             -- the type of the elements
  80                     [TypecheckedPat]
  81
  82   | TuplePat        [TypecheckedPat]    -- tuple
  83                                         -- UnitPat is TuplePat []
  84
  85   | LitPat          -- Used for *non-overloaded* literal patterns:
  86                     -- Int#, Char#, Int, Char, String, etc.
  87                     Literal
  88                     UniType             -- type of pattern
  89
  90   | NPat            -- Used for *overloaded* literal patterns
  91                     Literal             -- the literal is retained so that
  92                                         -- the desugarer can readily identify
  93                                         -- equations with identical literal-patterns
  94                     UniType             -- type of pattern, t
  95                     TypecheckedExpr     -- Of type t -> Bool; detects match
  96
  97   | NPlusKPat       Id
  98                     Literal             -- Same reason as for LitPat
  99                                         -- (This could be an Integer, but then
 100                                         -- it's harder to partitionEqnsByLit
 101                                         -- in the desugarer.)
 102                     UniType             -- Type of pattern, t
 103                     TypecheckedExpr     -- "fromInteger literal"; of type t
 104                     TypecheckedExpr     -- Of type t-> t -> Bool; detects match
 105                     TypecheckedExpr     -- Of type t -> t -> t; subtracts k
 106 #ifdef DPH
 107   | ProcessorPat
 108                     [TypecheckedPat]    -- Typechecked Pattern
 109                     [TypecheckedExpr]   -- Of type t-> Integer; conversion
 110                     TypecheckedPat      -- Data at that processor
 111 #endif {- Data Parallel Haskell -}
 112 \end{code}
 113
 114 Note: If @typeOfPat@ doesn't bear a strong resemblance to @typeOfCoreExpr@,
 115 then something is wrong.
 116 \begin{code}
 117 typeOfPat :: TypecheckedPat -> UniType
 118 typeOfPat (WildPat ty)          = ty
 119 typeOfPat (VarPat var)          = getIdUniType var
 120 typeOfPat (LazyPat pat)         = typeOfPat pat
 121 typeOfPat (AsPat var pat)       = getIdUniType var
 122 typeOfPat (ConPat _ ty _)       = ty
 123 typeOfPat (ConOpPat _ _ _ ty)   = ty
 124 typeOfPat (ListPat ty _)        = mkListTy ty
 125 typeOfPat (TuplePat pats)       = mkTupleTy (length pats) (map typeOfPat pats)
 126 typeOfPat (LitPat lit ty)       = ty
 127 typeOfPat (NPat   lit ty _)     = ty
 128 typeOfPat (NPlusKPat n k ty _ _ _) = ty
 129 #ifdef DPH
 130 -- Should be more efficient to find type of pid than pats
 131 typeOfPat (ProcessorPat pats _ pat)
 132    = mkProcessorTy (map typeOfPat pats) (typeOfPat pat)
 133 #endif {- Data Parallel Haskell -}
 134 \end{code}
 135
 136 \begin{code}
 137 instance (NamedThing name) => NamedThing (InPat name) where
 138     hasType pat         = False
 139 #ifdef DEBUG
 140     getExportFlag       = panic "NamedThing.InPat.getExportFlag"
 141     isLocallyDefined    = panic "NamedThing.InPat.isLocallyDefined"
 142     getOrigName         = panic "NamedThing.InPat.getOrigName"
 143     getOccurrenceName   = panic "NamedThing.InPat.getOccurrenceName"
 144     getInformingModules = panic "NamedThing.InPat.getOccurrenceName"
 145     getSrcLoc           = panic "NamedThing.InPat.getSrcLoc"
 146     getTheUnique        = panic "NamedThing.InPat.getTheUnique"
 147     getType pat         = panic "NamedThing.InPat.getType"
 148     fromPreludeCore     = panic "NamedThing.InPat.fromPreludeCore"
 149 #endif
 150
 151 instance NamedThing TypecheckedPat where
 152     hasType pat         = True
 153     getType             = typeOfPat
 154 #ifdef DEBUG
 155     getExportFlag       = panic "NamedThing.TypecheckedPat.getExportFlag"
 156     isLocallyDefined    = panic "NamedThing.TypecheckedPat.isLocallyDefined"
 157     getOrigName         = panic "NamedThing.TypecheckedPat.getOrigName"
 158     getOccurrenceName   = panic "NamedThing.TypecheckedPat.getOccurrenceName"
 159     getInformingModules = panic "NamedThing.TypecheckedPat.getOccurrenceName"
 160     getSrcLoc           = panic "NamedThing.TypecheckedPat.getSrcLoc"
 161     getTheUnique        = panic "NamedThing.TypecheckedPat.getTheUnique"
 162     fromPreludeCore     = panic "NamedThing.TypecheckedPat.fromPreludeCore"
 163 #endif
 164 \end{code}
 165
 166 \begin{code}
 167 instance (Outputable name) => Outputable (InPat name) where
 168     ppr = pprInPat
 169
 170 pprInPat :: (Outputable name) => PprStyle -> InPat name -> Pretty
 171 pprInPat sty (WildPatIn)        = ppStr "_"
 172 pprInPat sty (VarPatIn var)     = ppr sty var
 173 pprInPat sty (LitPatIn s)       = ppr sty s
 174 pprInPat sty (LazyPatIn pat)    = ppBeside (ppChar '~') (ppr sty pat)
 175 pprInPat sty (AsPatIn name pat)
 176     = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
 177
 178 pprInPat sty (ConPatIn c pats)
 179  = if null pats then
 180       ppr sty c
 181    else
 182       ppBesides [ppLparen, ppr sty c, ppSP, interppSP sty pats, ppRparen]
 183
 184
 185 pprInPat sty (ConOpPatIn pat1 op pat2)
 186  = ppBesides [ppLparen, ppr sty pat1, ppSP, ppr sty op, ppSP, ppr sty pat2, ppRparen]
 187
 188 -- ToDo: use pprOp to print op (but this involves fiddling various
 189 -- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP)
 190
 191 pprInPat sty (ListPatIn pats)
 192   = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
 193 pprInPat sty (TuplePatIn pats)
 194   = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
 195 pprInPat sty (NPlusKPatIn n k)
 196   = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
 197 #ifdef DPH
 198 pprInPat sty (ProcessorPatIn pats pat)
 199       = ppBesides [ppStr "(|", interpp'SP sty pats,ppSemi ,
 200                    ppr sty pat , ppStr "|)"]
 201 #endif {- Data Parallel Haskell -}
 202 \end{code}
 203
 204 Problems with @Outputable@ instance for @TypecheckedPat@ when no
 205 original names.
 206 \begin{code}
 207 instance Outputable TypecheckedPat where
 208     ppr = pprTypecheckedPat
 209 \end{code}
 210
 211 \begin{code}
 212 pprTypecheckedPat sty (WildPat ty)      = ppChar '_'
 213 pprTypecheckedPat sty (VarPat var)      = ppr sty var
 214 pprTypecheckedPat sty (LazyPat pat)     = ppBesides [ppChar '~', ppr sty pat]
 215 pprTypecheckedPat sty (AsPat name pat)
 216   = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
 217
 218 pprTypecheckedPat sty (ConPat name ty [])
 219   = ppBeside (ppr sty name)
 220         (ifPprShowAll sty (pprConPatTy sty ty))
 221
 222 pprTypecheckedPat sty (ConPat name ty pats)
 223   = ppBesides [ppLparen, ppr sty name, ppSP,
 224          interppSP sty pats, ppRparen,
 225          ifPprShowAll sty (pprConPatTy sty ty) ]
 226
 227 pprTypecheckedPat sty (ConOpPat pat1 op pat2 ty)
 228   = ppBesides [ppLparen, ppr sty pat1, ppSP, pprOp sty op, ppSP, ppr sty pat2, ppRparen]
 229
 230 pprTypecheckedPat sty (ListPat ty pats)
 231   = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
 232 pprTypecheckedPat sty (TuplePat pats)
 233   = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
 234
 235 pprTypecheckedPat sty (LitPat l ty)     = ppr sty l     -- ToDo: print more
 236 pprTypecheckedPat sty (NPat   l ty e)   = ppr sty l     -- ToDo: print more
 237
 238 pprTypecheckedPat sty (NPlusKPat n k ty e1 e2 e3)
 239   = case sty of
 240       PprForUser -> basic_ppr
 241       _          -> ppHang basic_ppr 4 exprs_ppr
 242   where
 243     basic_ppr = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
 244     exprs_ppr = ppSep [ ppBeside (ppStr "{- ") (ppr sty ty),
 245                         ppr sty e1, ppr sty e2,
 246                         ppBeside (ppr sty e3) (ppStr " -}")]
 247 #ifdef DPH
 248 pprTypecheckedPat sty (ProcessorPat pats convs pat)
 249    = case sty of
 250       PprForUser -> basic_ppr
 251       _          -> ppHang basic_ppr 4 exprs_ppr
 252   where
 253     basic_ppr = ppBesides [ppStr "(|", interpp'SP sty pats,ppSemi ,
 254                            ppr sty pat , ppStr "|)"]
 255     exprs_ppr = ppBesides [ppStr "{- " ,
 256                            ppr sty convs,
 257                            ppStr " -}"]
 258 #endif {- Data Parallel Haskell -}
 259
 260 pprConPatTy :: PprStyle -> UniType -> Pretty
 261 pprConPatTy sty ty
 262  = ppBesides [ppLparen, ppr sty ty, ppRparen]
 263 \end{code}
 264
 265 %************************************************************************
 266 %*                                                                      *
 267 %* predicates for checking things about pattern-lists in EquationInfo   *
 268 %*                                                                      *
 269 %************************************************************************
 270 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
 271
 272 Unlike in the Wadler chapter, where patterns are either ``variables''
 273 or ``constructors,'' here we distinguish between:
 274 \begin{description}
 275 \item[unfailable:]
 276 Patterns that cannot fail to match: variables, wildcards, and lazy
 277 patterns.
 278
 279 These are the irrefutable patterns; the two other categories
 280 are refutable patterns.
 281
 282 \item[constructor:]
 283 A non-literal constructor pattern (see next category).
 284
 285 \item[literal (including n+k patterns):]
 286 At least the numeric ones may be overloaded.
 287 \end{description}
 288
 289 A pattern is in {\em exactly one} of the above three categories; `as'
 290 patterns are treated specially, of course.
 291
 292 \begin{code}
 293 unfailablePats :: [TypecheckedPat] -> Bool
 294 unfailablePats pat_list = all unfailablePat pat_list
 295
 296 unfailablePat (AsPat    _ pat)  = unfailablePat pat
 297 unfailablePat (WildPat  _)      = True
 298 unfailablePat (VarPat   _)      = True
 299 unfailablePat (LazyPat  _)      = True
 300 unfailablePat other             = False
 301
 302 patsAreAllCons :: [TypecheckedPat] -> Bool
 303 patsAreAllCons pat_list = all isConPat pat_list
 304
 305 isConPat (AsPat _ pat)          = isConPat pat
 306 isConPat (ConPat _ _ _)         = True
 307 isConPat (ConOpPat _ _ _ _)     = True
 308 isConPat (ListPat _ _)          = True
 309 isConPat (TuplePat _)           = True
 310 #ifdef DPH
 311 isConPat (ProcessorPat _ _ _)   = True
 312
 313 #endif {- Data Parallel Haskell -}
 314 isConPat other                  = False
 315
 316 patsAreAllLits :: [TypecheckedPat] -> Bool
 317 patsAreAllLits pat_list = all isLitPat pat_list
 318
 319 isLitPat (AsPat _ pat)          = isLitPat pat
 320 isLitPat (LitPat _ _)           = True
 321 isLitPat (NPat   _ _ _)         = True
 322 isLitPat (NPlusKPat _ _ _ _ _ _)= True
 323 isLitPat other                  = False
 324
 325 #ifdef DPH
 326 patsAreAllProcessor :: [TypecheckedPat] -> Bool
 327 patsAreAllProcessor pat_list = all isProcessorPat pat_list
 328    where
 329       isProcessorPat (ProcessorPat _ _ _) = True
 330       isProcessorPat _                    = False
 331 #endif
 332 \end{code}
 333
 334 \begin{code}
 335 -- A pattern is irrefutable if a match on it cannot fail
 336 -- (at any depth)
 337 irrefutablePat :: TypecheckedPat -> Bool
 338
 339 irrefutablePat (WildPat _)                = True
 340 irrefutablePat (VarPat _)                 = True
 341 irrefutablePat (LazyPat _)                = True
 342 irrefutablePat (AsPat _ pat)              = irrefutablePat pat
 343 irrefutablePat (ConPat con tys pats)      = all irrefutablePat pats && only_con con
 344 irrefutablePat (ConOpPat pat1 con pat2 _) = irrefutablePat pat1 && irrefutablePat pat1 && only_con con
 345 irrefutablePat (ListPat _ _)              = False
 346 irrefutablePat (TuplePat pats)            = all irrefutablePat pats
 347 irrefutablePat other_pat                  = False       -- Literals, NPlusK, NPat
 348
 349 only_con con = maybeToBool (maybeSingleConstructorTyCon tycon)
 350                where
 351                  (_,_,_, tycon) = getDataConSig con
 352 \end{code}