Add separate functions for querying DynFlag and ExtensionFlag options

[ghc-hetmet.git] / compiler / deSugar / Match.lhs

diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index d676911..2c9aa0b 100644 (file)
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -35,7 +35,6 @@ import Id
 import DataCon
 import MatchCon
 import MatchLit
-import PrelInfo
 import Type
 import TysWiredIn
 import ListSetOps
@@ -43,9 +42,10 @@ import SrcLoc
 import Maybes
 import Util
 import Name
-import FiniteMap
 import Outputable
 import FastString
+
+import qualified Data.Map as Map
 \end{code}
 
 This function is a wrapper of @match@, it must be called from all the parts where 
@@ -293,7 +293,7 @@ match vars@(v:_) ty eqns
        ; let grouped = groupEquations tidy_eqns
 
          -- print the view patterns that are commoned up to help debug
-       ; ifOptM Opt_D_dump_view_pattern_commoning (debug grouped)
+       ; ifDOptM Opt_D_dump_view_pattern_commoning (debug grouped)
 
        ; match_results <- mapM match_group grouped
        ; return (adjustMatchResult (foldr1 (.) aux_binds) $
@@ -346,7 +346,7 @@ matchCoercion (var:vars) ty (eqns@(eqn1:_))
   = do { let CoPat co pat _ = firstPat eqn1
        ; var' <- newUniqueId var (hsPatType pat)
        ; match_result <- match (var':vars) ty (map decomposeFirst_Coercion eqns)
-       ; co' <- dsCoercion co
+       ; co' <- dsHsWrapper co
         ; let rhs' = co' (Var var)
        ; return (mkCoLetMatchResult (NonRec var' rhs') match_result) }
 
@@ -464,8 +464,8 @@ tidy1 v (VarPat var)
   = return (wrapBind var v, WildPat (idType var)) 
 
 tidy1 v (VarPatOut var binds)
-  = do { prs <- dsLHsBinds binds
-       ; return (wrapBind var v . mkCoreLet (Rec prs),
+  = do { ds_ev_binds <- dsTcEvBinds binds
+       ; return (wrapBind var v . wrapDsEvBinds ds_ev_binds,
                  WildPat (idType var)) }
 
        -- case v of { x@p -> mr[] }
@@ -802,14 +802,14 @@ subGroup :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]]
 -- Each sub-list in the result has the same PatGroup
 -- See Note [Take care with pattern order]
 subGroup group 
-    = map reverse $ eltsFM $ foldl accumulate emptyFM group
+    = map reverse $ Map.elems $ foldl accumulate Map.empty group
   where
     accumulate pg_map (pg, eqn)
-      = case lookupFM pg_map pg of
-          Just eqns -> addToFM pg_map pg (eqn:eqns)
-          Nothing   -> addToFM pg_map pg [eqn]
+      = case Map.lookup pg pg_map of
+          Just eqns -> Map.insert pg (eqn:eqns) pg_map
+          Nothing   -> Map.insert pg [eqn]      pg_map
 
-    -- pg_map :: FiniteMap a [EquationInfo]
+    -- pg_map :: Map a [EquationInfo]
     -- Equations seen so far in reverse order of appearance
 \end{code}
 
@@ -875,7 +875,7 @@ viewLExprEq (e1,_) (e2,_) =
         wrap WpHole WpHole = True
         wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2'
         wrap (WpCast c)  (WpCast c')  = tcEqType c c'
-        wrap (WpApp d)   (WpApp d')   = d == d'
+        wrap (WpEvApp _) (WpEvApp _) = panic "ToDo: Match.viewLExprEq"
         wrap (WpTyApp t) (WpTyApp t') = tcEqType t t'
         -- Enhancement: could implement equality for more wrappers
         --   if it seems useful (lams and lets)