[project @ 2001-12-10 14:08:14 by simonmar]

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

diff --git a/ghc/compiler/hsSyn/HsPat.lhs b/ghc/compiler/hsSyn/HsPat.lhs
index 62c4600..00df779 100644 (file)
--- a/ghc/compiler/hsSyn/HsPat.lhs
+++ b/ghc/compiler/hsSyn/HsPat.lhs
@@ -9,15 +9,16 @@ module HsPat (
        OutPat(..),
 
        irrefutablePat, irrefutablePats,
-       failureFreePat, isWildPat,
-       patsAreAllCons, isConPat,
+       failureFreePat, isWildPat, 
+       patsAreAllCons, isConPat, 
        patsAreAllLits, isLitPat,
        collectPatBinders, collectPatsBinders,
-       collectSigTysFromPats
+       collectSigTysFromPat, collectSigTysFromPats
     ) where
 
 #include "HsVersions.h"
 
+
 -- friends:
 import HsLit           ( HsLit, HsOverLit )
 import HsExpr          ( HsExpr )
@@ -25,6 +26,7 @@ import HsTypes                ( HsType )
 import BasicTypes      ( Fixity, Boxity, tupleParens )
 
 -- others:
+import Name            ( Name )
 import Var             ( Id, TyVar )
 import DataCon         ( DataCon, dataConTyCon )
 import Name            ( isDataSymOcc, getOccName, NamedThing )
@@ -52,14 +54,11 @@ data InPat name
                    Fixity              -- c.f. OpApp in HsExpr
                    (InPat name)
 
-  | NPatIn         (HsOverLit name)
+  | NPatIn         HsOverLit
 
   | NPlusKPatIn            name                -- n+k pattern
-                   (HsOverLit name)    -- It'll always be an HsIntegral, but
-                                       -- we need those names to support -fuser-numerics
-                   name                -- Name for "-"; this supports -fuser-numerics
-                                       -- We don't do the same for >= because that isn't
-                                       -- affected by -fuser-numerics
+                   HsOverLit           -- It'll always be an HsIntegral
+                   Name                -- Name of '-' (see RnEnv.lookupSyntaxName)
 
   -- We preserve prefix negation and parenthesis for the precedence parser.
 
@@ -88,6 +87,12 @@ data OutPat id
   | AsPat          id          -- as pattern
                    (OutPat id)
 
+  | SigPat         (OutPat id) -- Pattern p
+                   Type        -- Type, t, of the whole pattern
+                   (HsExpr id (OutPat id))
+                               -- Coercion function,
+                               -- of type t -> typeof(p)
+
   | ListPat                    -- Syntactic list
                    Type        -- The type of the elements
                    [OutPat id]
@@ -115,11 +120,11 @@ data OutPat id
                    HsLit
                    Type                -- Type of pattern
 
-  | NPat           -- Used for *overloaded* literal patterns
+  | NPat           -- Used for literal patterns where there's an equality function to call
                    HsLit                       -- The literal is retained so that
                                                -- the desugarer can readily identify
                                                -- equations with identical literal-patterns
-                                               -- Always HsInt, HsRat or HsString.
+                                               -- Always HsInteger, HsRat or HsString.
                    Type                        -- Type of pattern, t
                    (HsExpr id (OutPat id))     -- Of type t -> Bool; detects match
 
@@ -188,6 +193,8 @@ pprOutPat (LazyPat pat)     = hcat [char '~', ppr pat]
 pprOutPat (AsPat name pat)
   = parens (hcat [ppr name, char '@', ppr pat])
 
+pprOutPat (SigPat pat ty _)   = ppr pat <+> dcolon <+> ppr ty
+
 pprOutPat (ConPat name ty [] [] [])
   = ppr name
 
@@ -337,6 +344,9 @@ collect (TypePatIn ty)           bndrs = bndrs
 collectSigTysFromPats :: [InPat name] -> [HsType name]
 collectSigTysFromPats pats = foldr collect_pat [] pats
 
+collectSigTysFromPat :: InPat name -> [HsType name]
+collectSigTysFromPat pat = collect_pat pat []
+
 collect_pat (SigPatIn pat ty)     acc = collect_pat pat (ty:acc)
 collect_pat WildPatIn             acc = acc
 collect_pat (VarPatIn var)         acc = acc