X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FCheck.lhs;h=3996678b4e32308c18621eaee8fc29744c771fc9;hp=4713d202bb07e4e05c5234cd23b91d772eb6d02f;hb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;hpb=6202305819577fce2b11ab509ed94422775df30e

diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs
index 4713d20..3996678 100644
--- a/compiler/deSugar/Check.lhs
+++ b/compiler/deSugar/Check.lhs
@@ -216,7 +216,9 @@ check' qs
    | literals     = split_by_literals qs
    | constructors = split_by_constructor qs
    | only_vars    = first_column_only_vars qs
-   | otherwise    = pprPanic "Check.check': Not implemented :-(" (ppr first_pats)
+-- FIXME: hack to get view patterns through for now
+   | otherwise    = ([([],[])],emptyUniqSet)
+-- pprPanic "Check.check': Not implemented :-(" (ppr first_pats)
   where
      -- Note: RecPats will have been simplified to ConPats
      --       at this stage.
@@ -430,9 +432,9 @@ get_lit :: Pat id -> Maybe HsLit
 -- It doesn't matter which one, because they will only be compared
 -- with other HsLits gotten in the same way
 get_lit (LitPat lit)			 = Just lit
-get_lit (NPat (HsIntegral i   _) mb _ _) = Just (HsIntPrim   (mb_neg mb i))
-get_lit (NPat (HsFractional f _) mb _ _) = Just (HsFloatPrim (mb_neg mb f))
-get_lit (NPat (HsIsString s   _)  _ _ _) = Just (HsStringPrim s)
+get_lit (NPat (HsIntegral i   _ _) mb _) = Just (HsIntPrim   (mb_neg mb i))
+get_lit (NPat (HsFractional f _ _) mb _) = Just (HsFloatPrim (mb_neg mb f))
+get_lit (NPat (HsIsString s   _ _)  _ _) = Just (HsStringPrim s)
 get_lit other_pat			 = Nothing
 
 mb_neg :: Num a => Maybe b -> a -> a
@@ -484,7 +486,7 @@ is_con _              = False
 
 is_lit :: Pat Id -> Bool
 is_lit (LitPat _)      = True
-is_lit (NPat _ _ _ _)  = True
+is_lit (NPat _ _ _)  = True
 is_lit _               = False
 
 is_var :: Pat Id -> Bool
@@ -610,6 +612,7 @@ has_nplusk_pat :: Pat Id -> Bool
 has_nplusk_pat (NPlusKPat _ _ _ _) 	     = True
 has_nplusk_pat (ParPat p)  	   	     = has_nplusk_lpat p
 has_nplusk_pat (AsPat _ p) 	   	     = has_nplusk_lpat p
+has_nplusk_pat (ViewPat _ p _)           = has_nplusk_lpat p
 has_nplusk_pat (SigPatOut p _ )    	     = has_nplusk_lpat p
 has_nplusk_pat (ListPat ps _)  	   	     = any has_nplusk_lpat ps
 has_nplusk_pat (TuplePat ps _ _)   	     = any has_nplusk_lpat ps
@@ -631,6 +634,9 @@ simplify_pat (LazyPat p)      = WildPat (hsLPatType p)	-- For overlap and exhaus
 							-- purposes, a ~pat is like a wildcard
 simplify_pat (BangPat p)      = unLoc (simplify_lpat p)
 simplify_pat (AsPat id p)     = unLoc (simplify_lpat p)
+
+simplify_pat (ViewPat expr p ty)     = ViewPat expr (simplify_lpat p) ty
+
 simplify_pat (SigPatOut p _)  = unLoc (simplify_lpat p)	-- I'm not sure this is right
 
 simplify_pat pat@(ConPatOut { pat_con = L loc id, pat_args = ps })
@@ -665,7 +671,7 @@ simplify_pat pat@(LitPat (HsString s)) =
     mk_char_lit c = mkPrefixConPat charDataCon [nlLitPat (HsCharPrim c)] charTy
 
 simplify_pat (LitPat lit)		 = tidyLitPat lit 
-simplify_pat (NPat lit mb_neg eq lit_ty) = tidyNPat lit mb_neg eq lit_ty
+simplify_pat (NPat lit mb_neg eq) = tidyNPat lit mb_neg eq
 
 simplify_pat (NPlusKPat id hslit hsexpr1 hsexpr2)
    = WildPat (idType (unLoc id))