Implement fuzzy matching for the Finder

[ghc-hetmet.git] / compiler / coreSyn / CoreUtils.lhs

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 66d34b1..2cf8885 100644 (file)
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -25,7 +25,8 @@ module CoreUtils (
 
        -- * Properties of expressions
        exprType, coreAltType, coreAltsType,
-       exprIsDupable, exprIsTrivial, exprIsCheap, exprIsExpandable,
+       exprIsDupable, exprIsTrivial, 
+        exprIsCheap, exprIsExpandable, exprIsCheap', CheapAppFun,
        exprIsHNF, exprOkForSpeculation, exprIsBig, exprIsConLike,
        rhsIsStatic, isCheapApp, isExpandableApp,
 
@@ -55,9 +56,6 @@ import SrcLoc
 import VarEnv
 import VarSet
 import Name
-#if mingw32_TARGET_OS
-import Packages
-#endif
 import Literal
 import DataCon
 import PrimOp
@@ -516,8 +514,8 @@ exprIsCheap = exprIsCheap' isCheapApp
 exprIsExpandable :: CoreExpr -> Bool
 exprIsExpandable = exprIsCheap' isExpandableApp        -- See Note [CONLIKE pragma] in BasicTypes
 
-
-exprIsCheap' :: (Id -> Int -> Bool) -> CoreExpr -> Bool
+type CheapAppFun = Id -> Int -> Bool
+exprIsCheap' :: CheapAppFun -> CoreExpr -> Bool
 exprIsCheap' _          (Lit _)   = True
 exprIsCheap' _          (Type _)  = True
 exprIsCheap' _          (Var _)   = True
@@ -551,7 +549,7 @@ exprIsCheap' good_app other_expr    -- Applications and variables
     go (Var _) [] = True       -- Just a type application of a variable
                                -- (f t1 t2 t3) counts as WHNF
     go (Var f) args
-       = case idDetails f of
+        = case idDetails f of
                RecSelId {}                  -> go_sel args
                ClassOpId {}                 -> go_sel args
                PrimOpId op                  -> go_primop op args
@@ -585,12 +583,12 @@ exprIsCheap' good_app other_expr  -- Applications and variables
                -- BUT: Take care with (sel d x)!  The (sel d) might be cheap, but
                --      there's no guarantee that (sel d x) will be too.  Hence (n_val_args == 1)
 
-isCheapApp :: Id -> Int -> Bool
+isCheapApp :: CheapAppFun
 isCheapApp fn n_val_args
   = isDataConWorkId fn 
   || n_val_args < idArity fn
 
-isExpandableApp :: Id -> Int -> Bool
+isExpandableApp :: CheapAppFun
 isExpandableApp fn n_val_args
   =  isConLikeId fn
   || n_val_args < idArity fn
@@ -695,7 +693,7 @@ exprOkForSpeculation other_expr
                                -- A bit conservative: we don't really need
                                -- to care about lazy arguments, but this is easy
 
-    spec_ok (DFunId new_type) _ = not new_type 
+    spec_ok (DFunId _ new_type) _ = not new_type
          -- DFuns terminate, unless the dict is implemented with a newtype
         -- in which case they may not
 
@@ -735,8 +733,8 @@ If exprOkForSpeculation doesn't look through case expressions, you get this:
       \ (ww :: GHC.Prim.Int#) ->
         case ww of ds {
           __DEFAULT -> case (case <# ds 5 of _ {
-                          GHC.Bool.False -> lvl1; 
-                          GHC.Bool.True -> lvl})
+                          GHC.Types.False -> lvl1;
+                          GHC.Types.True -> lvl})
                        of _ { __DEFAULT ->
                        T.$wfoo (GHC.Prim.-# ds_XkE 1) };
           0 -> 0
@@ -1396,11 +1394,9 @@ rhsIsStatic _is_dynamic_name rhs = is_static False rhs
   is_static :: Bool    -- True <=> in a constructor argument; must be atomic
          -> CoreExpr -> Bool
   
-  is_static False (Lam b e) = isRuntimeVar b || is_static False e
-  
-  is_static _      (Note (SCC _) _) = False
-  is_static in_arg (Note _ e)       = is_static in_arg e
-  is_static in_arg (Cast e _)       = is_static in_arg e
+  is_static False (Lam b e)   = isRuntimeVar b || is_static False e
+  is_static in_arg (Note n e) = notSccNote n && is_static in_arg e
+  is_static in_arg (Cast e _) = is_static in_arg e
   
   is_static _      (Lit lit)
     = case lit of
@@ -1441,11 +1437,9 @@ rhsIsStatic _is_dynamic_name rhs = is_static False rhs
         --   x = D# (1.0## /## 2.0##)
         -- can't float because /## can fail.
 
-    go (Note (SCC _) _) _          = False
-    go (Note _ f)       n_val_args = go f n_val_args
-    go (Cast e _)       n_val_args = go e n_val_args
-
-    go _                _          = False
+    go (Note n f) n_val_args = notSccNote n && go f n_val_args
+    go (Cast e _) n_val_args = go e n_val_args
+    go _          _          = False
 
     saturated_data_con f n_val_args
        = case isDataConWorkId_maybe f of