Comments about ru_auto
[ghc.git] / compiler / coreSyn / CoreSyn.hs
index 24ce641..f06097a 100644 (file)
@@ -31,9 +31,12 @@ module CoreSyn (
 
         -- ** Simple 'Expr' access functions and predicates
         bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
-        collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
+        collectBinders, collectTyAndValBinders,
         collectArgs, collectArgsTicks, flattenBinds,
 
+        exprToType, exprToCoercion_maybe,
+        applyTypeToArg,
+
         isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
         isRuntimeArg, isRuntimeVar,
 
@@ -99,7 +102,6 @@ import Module
 import TyCon
 import BasicTypes
 import DynFlags
-import FastString
 import Outputable
 import Util
 import SrcLoc     ( RealSrcSpan, containsSpan )
@@ -388,31 +390,32 @@ See #type_let#
 
 Note [Empty case alternatives]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The alternatives of a case expression should be exhaustive.
-
-A case expression can have empty alternatives if (and only if) the
-scrutinee is bound to raise an exception or diverge. When do we know
-this?  See Note [Bottoming expressions] in CoreUtils.
-
-The possiblity of empty alternatives is one reason we need a type on
-the case expression: if the alternatives are empty we can't get the
-type from the alternatives!
-
-In the case of empty types (see Note [Bottoming expressions]), say
-  data T
-we do NOT want to replace
-   case (x::T) of Bool {}   -->   error Bool "Inaccessible case"
-because x might raise an exception, and *that*'s what we want to see!
-(Trac #6067 is an example.) To preserve semantics we'd have to say
-   x `seq` error Bool "Inaccessible case"
- but the 'seq' is just a case, so we are back to square 1.  Or I suppose
-we could say
-   x |> UnsafeCoerce T Bool
-but that loses all trace of the fact that this originated with an empty
-set of alternatives.
-
-We can use the empty-alternative construct to coerce error values from
-one type to another.  For example
+The alternatives of a case expression should be exhaustive.  But
+this exhaustive list can be empty!
+
+* A case expression can have empty alternatives if (and only if) the
+  scrutinee is bound to raise an exception or diverge. When do we know
+  this?  See Note [Bottoming expressions] in CoreUtils.
+
+* The possiblity of empty alternatives is one reason we need a type on
+  the case expression: if the alternatives are empty we can't get the
+  type from the alternatives!
+
+* In the case of empty types (see Note [Bottoming expressions]), say
+    data T
+  we do NOT want to replace
+    case (x::T) of Bool {}   -->   error Bool "Inaccessible case"
+  because x might raise an exception, and *that*'s what we want to see!
+  (Trac #6067 is an example.) To preserve semantics we'd have to say
+     x `seq` error Bool "Inaccessible case"
+  but the 'seq' is just a case, so we are back to square 1.  Or I suppose
+  we could say
+     x |> UnsafeCoerce T Bool
+  but that loses all trace of the fact that this originated with an empty
+  set of alternatives.
+
+* We can use the empty-alternative construct to coerce error values from
+  one type to another.  For example
 
     f :: Int -> Int
     f n = error "urk"
@@ -420,14 +423,22 @@ one type to another.  For example
     g :: Int -> (# Char, Bool #)
     g x = case f x of { 0 -> ..., n -> ... }
 
-Then if we inline f in g's RHS we get
+  Then if we inline f in g's RHS we get
     case (error Int "urk") of (# Char, Bool #) { ... }
-and we can discard the alternatives since the scrutinee is bottom to give
+  and we can discard the alternatives since the scrutinee is bottom to give
     case (error Int "urk") of (# Char, Bool #) {}
 
-This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),
-if for no other reason that we don't need to instantiate the (~) at an
-unboxed type.
+  This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),
+  if for no other reason that we don't need to instantiate the (~) at an
+  unboxed type.
+
+* We treat a case expression with empty alternatives as trivial iff
+  its scrutinee is (see CoreUtils.exprIsTrivial).  This is actually
+  important; see Note [Empty case is trivial] in CoreUtils
+
+* An empty case is replaced by its scrutinee during the CoreToStg
+  conversion; remember STG is un-typed, so there is no need for
+  the empty case to do the type conversion.
 
 
 ************************************************************************
@@ -853,15 +864,16 @@ data CoreRule
                                         -- See Note [OccInfo in unfoldings and rules]
 
         -- Locality
-        ru_auto :: Bool,        -- ^ @True@  <=> this rule is auto-generated
-                                --   @False@ <=> generated at the users behest
-                                --   Main effect: reporting of orphan-hood
+        ru_auto :: Bool,   -- ^ @True@  <=> this rule is auto-generated
+                           --               (notably by Specialise or SpecConstr)
+                           --   @False@ <=> generated at the users behest
+                           -- See Note [Trimming auto-rules] in TidyPgm
+                           -- for the sole purpose of this field.
 
-        ru_origin :: !Module,    -- ^ 'Module' the rule was defined in, used
+        ru_origin :: !Module,   -- ^ 'Module' the rule was defined in, used
                                 -- to test if we should see an orphan rule.
 
-        ru_orphan :: !IsOrphan,
-                                -- ^ Whether or not the rule is an orphan.
+        ru_orphan :: !IsOrphan, -- ^ Whether or not the rule is an orphan.
 
         ru_local :: Bool        -- ^ @True@ iff the fn at the head of the rule is
                                 -- defined in the same module as the rule
@@ -1315,7 +1327,7 @@ the occurrence info is wrong
 instance Outputable AltCon where
   ppr (DataAlt dc) = ppr dc
   ppr (LitAlt lit) = ppr lit
-  ppr DEFAULT      = ptext (sLit "__DEFAULT")
+  ppr DEFAULT      = text "__DEFAULT"
 
 cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering
 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
@@ -1446,11 +1458,16 @@ mkVarApps :: Expr b -> [Var] -> Expr b
 mkConApp      :: DataCon -> [Arg b] -> Expr b
 
 mkApps    f args = foldl App                       f args
-mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
 mkCoApps  f args = foldl (\ e a -> App e (Coercion a)) f args
 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
 mkConApp con args = mkApps (Var (dataConWorkId con)) args
 
+mkTyApps  f args = foldl (\ e a -> App e (typeOrCoercion a)) f args
+  where
+    typeOrCoercion ty
+      | Just co <- isCoercionTy_maybe ty = Coercion co
+      | otherwise                        = Type ty
+
 mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b
 mkConApp2 con tys arg_ids = Var (dataConWorkId con)
                             `mkApps` map Type tys
@@ -1547,6 +1564,33 @@ varsToCoreExprs vs = map varToCoreExpr vs
 {-
 ************************************************************************
 *                                                                      *
+   Getting a result type
+*                                                                      *
+************************************************************************
+
+These are defined here to avoid a module loop between CoreUtils and CoreFVs
+
+-}
+
+applyTypeToArg :: Type -> CoreExpr -> Type
+-- ^ Determines the type resulting from applying an expression with given type
+-- to a given argument expression
+applyTypeToArg fun_ty arg = piResultTy fun_ty (exprToType arg)
+
+-- | If the expression is a 'Type', converts. Otherwise,
+-- panics. NB: This does /not/ convert 'Coercion' to 'CoercionTy'.
+exprToType :: CoreExpr -> Type
+exprToType (Type ty)     = ty
+exprToType _bad          = pprPanic "exprToType" empty
+
+-- | If the expression is a 'Coercion', converts.
+exprToCoercion_maybe :: CoreExpr -> Maybe Coercion
+exprToCoercion_maybe (Coercion co) = Just co
+exprToCoercion_maybe _             = Nothing
+
+{-
+************************************************************************
+*                                                                      *
 \subsection{Simple access functions}
 *                                                                      *
 ************************************************************************
@@ -1580,13 +1624,11 @@ flattenBinds []                   = []
 -- | We often want to strip off leading lambdas before getting down to
 -- business. This function is your friend.
 collectBinders               :: Expr b -> ([b],         Expr b)
--- | Collect as many type bindings as possible from the front of a nested lambda
-collectTyBinders             :: CoreExpr -> ([TyVar],     CoreExpr)
--- | Collect as many value bindings as possible from the front of a nested lambda
-collectValBinders            :: CoreExpr -> ([Id],        CoreExpr)
--- | Collect type binders from the front of the lambda first,
--- then follow up by collecting as many value bindings as possible
--- from the resulting stripped expression
+-- | Collect type and value binders from nested lambdas, stopping
+-- right before any "forall"s within a non-forall. For example,
+-- forall (a :: *) (b :: Foo ~ Bar) (c :: *). Baz -> forall (d :: *). Blob
+-- will pull out the binders for a, b, c, and Baz, but not for d or anything
+-- within Blob. This is to coordinate with tcSplitSigmaTy.
 collectTyAndValBinders       :: CoreExpr -> ([TyVar], [Id], CoreExpr)
 
 collectBinders expr
@@ -1596,22 +1638,15 @@ collectBinders expr
     go bs e          = (reverse bs, e)
 
 collectTyAndValBinders expr
-  = (tvs, ids, body)
-  where
-    (tvs, body1) = collectTyBinders expr
-    (ids, body)  = collectValBinders body1
-
-collectTyBinders expr
-  = go [] expr
-  where
-    go tvs (Lam b e) | isTyVar b = go (b:tvs) e
-    go tvs e                     = (reverse tvs, e)
-
-collectValBinders expr
-  = go [] expr
-  where
-    go ids (Lam b e) | isId b = go (b:ids) e
-    go ids body               = (reverse ids, body)
+  = go_forall [] [] expr
+  where go_forall tvs ids (Lam b e)
+          | isTyVar b       = go_forall (b:tvs) ids e
+          | isCoVar b       = go_forall tvs (b:ids) e
+        go_forall tvs ids e = go_fun tvs ids e
+
+        go_fun tvs ids (Lam b e)
+          | isId b          = go_fun tvs (b:ids) e
+        go_fun tvs ids e    = (reverse tvs, reverse ids, e)
 
 -- | Takes a nested application expression and returns the the function
 -- being applied and the arguments to which it is applied