[project @ 2001-03-01 17:06:53 by simonpj]

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

diff --git a/ghc/compiler/hsSyn/HsPat.lhs b/ghc/compiler/hsSyn/HsPat.lhs
index f28d443..ec92913 100644 (file)
--- a/ghc/compiler/hsSyn/HsPat.lhs
+++ b/ghc/compiler/hsSyn/HsPat.lhs
@@ -18,6 +18,7 @@ module HsPat (
 
 #include "HsVersions.h"
 
+
 -- friends:
 import HsLit           ( HsLit, HsOverLit )
 import HsExpr          ( HsExpr )
@@ -27,7 +28,7 @@ import BasicTypes     ( Fixity, Boxity, tupleParens )
 -- others:
 import Var             ( Id, TyVar )
 import DataCon         ( DataCon, dataConTyCon )
-import Name            ( Name, isDataSymOcc, getOccName, NamedThing )
+import Name            ( isDataSymOcc, getOccName, NamedThing )
 import Maybes          ( maybeToBool )
 import Outputable      
 import TyCon           ( maybeTyConSingleCon )
@@ -52,14 +53,10 @@ 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
 
   -- We preserve prefix negation and parenthesis for the precedence parser.
 
@@ -72,6 +69,15 @@ data InPat name
   | RecPatIn       name                -- record
                    [(name, InPat name, Bool)]  -- True <=> source used punning
 
+-- Generics
+  | TypePatIn       (HsType name)       -- Type pattern for generic definitions
+                                        -- e.g  f{| a+b |} = ...
+                                        -- These show up only in class 
+                                       -- declarations,
+                                        -- and should be a top-level pattern
+
+-- /Generics
+
 data OutPat id
   = WildPat        Type        -- wild card
   | VarPat         id          -- variable (type is in the Id)
@@ -145,7 +151,7 @@ pprInPat (AsPatIn name pat)   = parens (hcat [ppr name, char '@', ppr pat])
 pprInPat (ParPatIn pat)              = parens (pprInPat pat)
 pprInPat (ListPatIn pats)     = brackets (interpp'SP pats)
 pprInPat (TuplePatIn pats bx) = tupleParens bx (interpp'SP pats)
-pprInPat (NPlusKPatIn n k _)  = parens (hcat [ppr n, char '+', ppr k])
+pprInPat (NPlusKPatIn n k)    = parens (hcat [ppr n, char '+', ppr k])
 pprInPat (NPatIn l)          = ppr l
 
 pprInPat (ConPatIn c pats)
@@ -163,6 +169,8 @@ pprInPat (RecPatIn con rpats)
   where
     pp_rpat (v, _, True) = ppr v
     pp_rpat (v, p, _)    = hsep [ppr v, char '=', ppr p]
+
+pprInPat (TypePatIn ty) = ptext SLIT("{|") <> ppr ty <> ptext SLIT("|}")
 \end{code}
 
 \begin{code}
@@ -309,7 +317,7 @@ collect (LitPatIn _)                 bndrs = bndrs
 collect (SigPatIn pat _)        bndrs = collect pat bndrs
 collect (LazyPatIn pat)         bndrs = collect pat bndrs
 collect (AsPatIn a pat)         bndrs = a : collect pat bndrs
-collect (NPlusKPatIn n _ _)      bndrs = n : bndrs
+collect (NPlusKPatIn n _)        bndrs = n : bndrs
 collect (NPatIn _)              bndrs = bndrs
 collect (ConPatIn c pats)       bndrs = foldr collect bndrs pats
 collect (ConOpPatIn p1 c f p2)   bndrs = collect p1 (collect p2 bndrs)
@@ -317,9 +325,11 @@ collect (ParPatIn  pat)             bndrs = collect pat bndrs
 collect (ListPatIn pats)        bndrs = foldr collect bndrs pats
 collect (TuplePatIn pats _)     bndrs = foldr collect bndrs pats
 collect (RecPatIn c fields)     bndrs = foldr (\ (f,pat,_) bndrs -> collect pat bndrs) bndrs fields
+-- Generics
+collect (TypePatIn ty)           bndrs = bndrs
+-- assume the type variables do not need to be bound
 \end{code}
 
-
 \begin{code}
 collectSigTysFromPats :: [InPat name] -> [HsType name]
 collectSigTysFromPats pats = foldr collect_pat [] pats
@@ -331,11 +341,14 @@ collect_pat (LitPatIn _)     acc = acc
 collect_pat (LazyPatIn pat)        acc = collect_pat pat acc
 collect_pat (AsPatIn a pat)        acc = collect_pat pat acc
 collect_pat (NPatIn _)            acc = acc
-collect_pat (NPlusKPatIn n _ _)    acc = acc
+collect_pat (NPlusKPatIn n _)      acc = acc
 collect_pat (ConPatIn c pats)      acc = foldr collect_pat acc pats
 collect_pat (ConOpPatIn p1 c f p2) acc = collect_pat p1 (collect_pat p2 acc)
 collect_pat (ParPatIn  pat)        acc = collect_pat pat acc
 collect_pat (ListPatIn pats)       acc = foldr collect_pat acc pats
 collect_pat (TuplePatIn pats _)    acc = foldr collect_pat acc pats
 collect_pat (RecPatIn c fields)    acc = foldr (\ (f,pat,_) acc -> collect_pat pat acc) acc fields
+-- Generics
+collect_pat (TypePatIn ty)         acc = ty:acc
 \end{code}
+