X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsPat.lhs;h=aff67627c14859a8dfef1602de44bcfd7b6fa171;hb=1fb1ab5d53a09607e7f6d2450806760688396387;hp=da42d1ce89068a8e76977d673a5ec1d601f8c258;hpb=8de16184643ea3c2f9f30b5eaed18db6ef247760;p=ghc-hetmet.git

diff --git a/ghc/compiler/hsSyn/HsPat.lhs b/ghc/compiler/hsSyn/HsPat.lhs
index da42d1c..aff6762 100644
--- a/ghc/compiler/hsSyn/HsPat.lhs
+++ b/ghc/compiler/hsSyn/HsPat.lhs
@@ -50,6 +50,9 @@ data InPat name
 		    Fixity		-- c.f. OpApp in HsExpr
 		    (InPat name)
 
+  | NPlusKPatIn	    name		--  n+k pattern
+		    HsLit
+
   -- We preserve prefix negation and parenthesis for the precedence parser.
 
   | NegPatIn	    (InPat name)	-- negated pattern
@@ -104,6 +107,15 @@ data OutPat tyvar uvar id
    	    	    (HsExpr tyvar uvar id (OutPat tyvar uvar id))
 						-- of type t -> Bool; detects match
 
+  | NPlusKPat	    id
+		    HsLit			-- Same reason as for LitPat
+						-- (This could be an Integer, but then
+						-- it's harder to partitionEqnsByLit
+						-- in the desugarer.)
+		    (GenType tyvar uvar)    	-- Type of pattern, t
+   	    	    (HsExpr tyvar uvar id (OutPat tyvar uvar id)) 	-- Of type t -> Bool; detects match
+   	    	    (HsExpr tyvar uvar id (OutPat tyvar uvar id)) 	-- Of type t -> t; subtracts k
+
   | DictPat	    -- Used when destructing Dictionaries with an explicit case
 		    [id]			-- superclass dicts
 		    [id]			-- methods
@@ -115,7 +127,7 @@ instance (Outputable name, NamedThing name) => Outputable (InPat name) where
 
 pprInPat :: (Outputable name, NamedThing name) => PprStyle -> InPat name -> Pretty
 
-pprInPat sty (WildPatIn)	= ppStr "_"
+pprInPat sty (WildPatIn)	= ppChar '_'
 pprInPat sty (VarPatIn var)	= ppr sty var
 pprInPat sty (LitPatIn s)	= ppr sty s
 pprInPat sty (LazyPatIn pat)	= ppBeside (ppChar '~') (ppr sty pat)
@@ -151,12 +163,14 @@ pprInPat sty (ListPatIn pats)
   = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
 pprInPat sty (TuplePatIn pats)
   = ppParens (interpp'SP sty pats)
+pprInPat sty (NPlusKPatIn n k)
+  = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
 
 pprInPat sty (RecPatIn con rpats)
   = ppCat [ppr sty con, ppCurlies (ppIntersperse pp'SP (map (pp_rpat sty) rpats))]
   where
     pp_rpat PprForUser (v, _, True) = ppr PprForUser v
-    pp_rpat sty        (v, p, _)    = ppCat [ppr sty v, ppStr "=", ppr sty p]
+    pp_rpat sty        (v, p, _)    = ppCat [ppr sty v, ppChar '=', ppr sty p]
 \end{code}
 
 \begin{code}
@@ -193,10 +207,12 @@ pprOutPat sty (RecPat con ty rpats)
   = ppBesides [ppr sty con, ppCurlies (ppIntersperse pp'SP (map (pp_rpat sty) rpats))]
   where
     pp_rpat PprForUser (v, _, True) = ppr PprForUser v
-    pp_rpat sty (v, p, _)           = ppCat [ppr sty v, ppStr "=", ppr sty p]
+    pp_rpat sty (v, p, _)           = ppCat [ppr sty v, ppChar '=', ppr sty p]
 
 pprOutPat sty (LitPat l ty) 	= ppr sty l	-- ToDo: print more
 pprOutPat sty (NPat   l ty e)	= ppr sty l	-- ToDo: print more
+pprOutPat sty (NPlusKPat n k ty e1 e2)		-- ToDo: print more
+  = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
 
 pprOutPat sty (DictPat dicts methods)
  = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
@@ -279,10 +295,11 @@ isConPat other			= False
 patsAreAllLits :: [OutPat a b c] -> Bool
 patsAreAllLits pat_list = all isLitPat pat_list
 
-isLitPat (AsPat _ pat)	= isLitPat pat
-isLitPat (LitPat _ _)	= True
-isLitPat (NPat   _ _ _)	= True
-isLitPat other		= False
+isLitPat (AsPat _ pat)	       = isLitPat pat
+isLitPat (LitPat _ _)	       = True
+isLitPat (NPat   _ _ _)	       = True
+isLitPat (NPlusKPat _ _ _ _ _) = True
+isLitPat other		       = False
 \end{code}
 
 This function @collectPatBinders@ works with the ``collectBinders''
@@ -296,6 +313,7 @@ collectPatBinders (VarPatIn var)      	 = [var]
 collectPatBinders (LitPatIn _)	      	 = []
 collectPatBinders (LazyPatIn pat)     	 = collectPatBinders pat
 collectPatBinders (AsPatIn a pat)     	 = a : collectPatBinders pat
+collectPatBinders (NPlusKPatIn n _)      = [n]
 collectPatBinders (ConPatIn c pats)   	 = concat (map collectPatBinders pats)
 collectPatBinders (ConOpPatIn p1 c f p2) = collectPatBinders p1 ++ collectPatBinders p2
 collectPatBinders (NegPatIn  pat)     	 = collectPatBinders pat