Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/e8fe3a1209e5ded220ccdfec53f7968297abdfc3 >--------------------------------------------------------------- commit e8fe3a1209e5ded220ccdfec53f7968297abdfc3 Author: Simon Peyton Jones <[email protected]> Date: Wed Jun 22 17:37:59 2011 +0100 Comments and layout >--------------------------------------------------------------- compiler/coreSyn/CoreUtils.lhs | 18 ++++++++---------- compiler/hsSyn/HsBinds.lhs | 6 +++--- compiler/hsSyn/HsExpr.lhs | 1 - 3 files changed, 11 insertions(+), 14 deletions(-) diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 9f0b674..26d6cbf 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -1493,16 +1493,14 @@ rhsIsStatic :: (Name -> Bool) -> CoreExpr -> Bool rhsIsStatic _is_dynamic_name rhs = is_static False rhs where 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 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 - MachLabel _ _ _ -> False - _ -> True + -> CoreExpr -> Bool + + 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 _ (Coercion {}) = True -- Behaves just like a literal + is_static _ (Lit (MachLabel {})) = False + is_static _ (Lit _) = True -- A MachLabel (foreign import "&foo") in an argument -- prevents a constructor application from being static. The -- reason is that it might give rise to unresolvable symbols diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 52ed14b..fcba55a 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -148,8 +148,8 @@ data HsBindLR idL idR abs_ev_vars :: [EvVar], -- Includes equality constraints -- AbsBinds only gets used when idL = idR after renaming, - -- but these need to be idL's for the collect... code in HsUtil to have - -- the right type + -- but these need to be idL's for the collect... code in HsUtil + -- to have the right type abs_exports :: [([TyVar], idL, idL, TcSpecPrags)], -- (tvs, poly_id, mono_id, prags) abs_ev_binds :: TcEvBinds, -- Evidence bindings @@ -378,7 +378,7 @@ data HsWrapper = WpHole -- The identity coercion | WpCompose HsWrapper HsWrapper - -- (wrap1 `WpCompse` wrap2)[e] = wrap1[ wrap2[ e ]] + -- (wrap1 `WpCompose` wrap2)[e] = wrap1[ wrap2[ e ]] -- -- Hence (\a. []) `WpCompose` (\b. []) = (\a b. []) -- But ([] a) `WpCompose` ([] b) = ([] b a) diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index dd33cae..33cc2c5 100644 --- a/compiler/hsSyn/HsExpr.lhs +++ b/compiler/hsSyn/HsExpr.lhs @@ -672,7 +672,6 @@ type HsRecordBinds id = HsRecFields id (LHsExpr id) \end{code} - %************************************************************************ %* * \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
