Simon Peyton Jones pushed to branch wip/T26425 at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • compiler/GHC/Core/Make.hs
    ... ... @@ -151,37 +151,28 @@ mkCoreConWrapApps con args = mkCoreApps (Var (dataConWrapId con)) args
    151 151
    152 152 
     -- | Construct an expression which represents the application of a number of
    153 153 
     -- expressions to another. The leftmost expression in the list is applied first
    154 
    -mkCoreApps :: CoreExpr -- ^ function
    154 
    +-- See Note [Assertion checking in mkCoreApp]
    155 
    +mkCoreApps :: CoreExpr   -- ^ function
    155 156 
                -> [CoreExpr] -- ^ arguments
    156 157 
                -> CoreExpr
    157 
    -mkCoreApps fun args
    158 
    -  = fst $
    159 
    -    foldl' (mkCoreAppTyped doc_string) (fun, fun_ty) args
    160 
    -  where
    161 
    -    doc_string = ppr fun_ty $$ ppr fun $$ ppr args
    162 
    -    fun_ty = exprType fun
    158 
    +mkCoreApps fun args = foldl' mkCoreApp fun args
    163 159
    164 160 
     -- | Construct an expression which represents the application of one expression
    165 161 
     -- to the other
    166 
    -mkCoreApp :: SDoc
    167 
    -          -> CoreExpr -- ^ function
    162 
    +-- See Note [Assertion checking in mkCoreApp]
    163 
    +mkCoreApp :: CoreExpr -- ^ function
    168 164 
               -> CoreExpr -- ^ argument
    169 165 
               -> CoreExpr
    170 
    -mkCoreApp s fun arg
    171 
    -  = fst $ mkCoreAppTyped s (fun, exprType fun) arg
    172 
    -
    173 
    --- | Construct an expression which represents the application of one expression
    174 
    --- paired with its type to an argument. The result is paired with its type. This
    175 
    --- function is not exported and used in the definition of 'mkCoreApp' and
    176 
    --- 'mkCoreApps'.
    177 
    -mkCoreAppTyped :: SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)
    178 
    -mkCoreAppTyped _ (fun, fun_ty) (Type ty)
    179 
    -  = (App fun (Type ty), piResultTy fun_ty ty)
    180 
    -mkCoreAppTyped _ (fun, fun_ty) (Coercion co)
    181 
    -  = (App fun (Coercion co), funResultTy fun_ty)
    182 
    -mkCoreAppTyped d (fun, fun_ty) arg
    183 
    -  = assertPpr (isFunTy fun_ty) (ppr fun $$ ppr arg $$ d)
    184 
    -    (App fun arg, funResultTy fun_ty)
    166 
    +mkCoreApp fun arg = App fun arg
    167 
    +
    168 
    +{- Note [Assertion checking in mkCoreApp]
    169 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    170 
    +At one time we had an assertion to check that the function and argument type match up,
    171 
    +but that turned out to take 90% of all compile time (!) when compiling test
    172 
    +`unboxedsums/UbxSumUnpackedSize.hs`. The reason was an unboxed sum constructor with
    173 
    +hundreds of foralls.   It's most straightforward just to remove the assert, and
    174 
    +rely on Lint to discover any mis-constructed terms.
    175 
    +-}
    185 176
    186 177 
     {- *********************************************************************
    187 178 
     *                                                                      *

  • compiler/GHC/HsToCore/Binds.hs
    ... ... @@ -1620,7 +1620,7 @@ ds_hs_wrapper hs_wrap
    1620 1620 
                                   do { x <- newSysLocalDs (mkScaled (subMultCoRKind w_co) t)
    1621 1621 
                                      ; go c1 $ \w1 ->
    1622 1622 
                                        go c2 $ \w2 ->
    1623 
    -                                   let app f a = mkCoreApp (text "dsHsWrapper") f a
    1623 
    +                                   let app f a = mkCoreApp f a
    1624 1624 
                                            arg     = w1 (Var x)
    1625 1625 
                                        in k (\e -> (Lam x (w2 (app e arg)))) }
    1626 1626

  • compiler/GHC/HsToCore/Expr.hs
    ... ... @@ -877,8 +877,7 @@ dsHsConLike (PatSynCon ps)
    877 877 
       | Just (builder_name, _, add_void) <- patSynBuilder ps
    878 878 
       = do { builder_id <- dsLookupGlobalId builder_name
    879 879 
            ; return (if add_void
    880 
    -                 then mkCoreApp (text "dsConLike" <+> ppr ps)
    881 
    -                                (Var builder_id) unboxedUnitExpr
    880 
    +                 then mkCoreApp (Var builder_id) unboxedUnitExpr
    882 881 
                      else Var builder_id) }
    883 882 
       | otherwise
    884 883 
       = pprPanic "dsConLike" (ppr ps)

  • compiler/GHC/HsToCore/Match.hs
    ... ... @@ -301,7 +301,7 @@ matchView (var :| vars) ty eqns@(eqn1 :| _)
    301 301 
              -- compile the view expressions
    302 302 
             ; viewExpr' <- dsExpr viewExpr
    303 303 
             ; return (mkViewMatchResult var'
    304 
    -                    (mkCoreApp (text "matchView") viewExpr' (Var var))
    304 
    +                    (mkCoreApp viewExpr' (Var var))
    305 305 
                         match_result) }
    306 306
    307 307 
     -- decompose the first pattern and leave the rest alone

  • testsuite/tests/unboxedsums/UbxSumUnpackedSize.hs
    ... ... @@ -133,6 +133,124 @@ data U_E1 = U_E1 {-# UNPACK #-} !E1
    133 133 
                      {-# UNPACK #-} !Int8
    134 134 
         deriving (Show)
    135 135
    136 
    +{- In `data U_E`, the {-# UNPACK #-} !E1 gives rise to a pretty clumsy expression
    137 
    +   for the wrapper for U_E1. Here is what it looks like when ther are only 16
    138 
    +   data constructors in E1, and we have just
    139 
    +       data U_E1 = U_E1 {-# UNPACK #-} !E1
    140 
    +   Blimey!
    141 
    +
    142 
    +Main.$WU_E1
    143 
    +  = \ (conrep_t1N4 [Occ=Once1!] :: Main.E1) ->
    144 
    +      case case conrep_t1N4 of {
    145 
    +             Main.E1_1 ->
    146 
    +               GHC.Internal.Types.(# _| | | | | | | | | | | | | | | #)
    147 
    +                 @GHC.Internal.Types.ZeroBitRep
    148 
    +                 @GHC.Internal.Types.ZeroBitRep
    149 
    +                 @GHC.Internal.Types.ZeroBitRep
    150 
    +                 @GHC.Internal.Types.ZeroBitRep
    151 
    +                 @GHC.Internal.Types.ZeroBitRep
    152 
    +                 @GHC.Internal.Types.ZeroBitRep
    153 
    +                 @GHC.Internal.Types.ZeroBitRep
    154 
    +                 @GHC.Internal.Types.ZeroBitRep
    155 
    +                 @GHC.Internal.Types.ZeroBitRep
    156 
    +                 @GHC.Internal.Types.ZeroBitRep
    157 
    +                 @GHC.Internal.Types.ZeroBitRep
    158 
    +                 @GHC.Internal.Types.ZeroBitRep
    159 
    +                 @GHC.Internal.Types.ZeroBitRep
    160 
    +                 @GHC.Internal.Types.ZeroBitRep
    161 
    +                 @GHC.Internal.Types.ZeroBitRep
    162 
    +                 @GHC.Internal.Types.ZeroBitRep
    163 
    +                 @(# #)
    164 
    +                 @(# #)
    165 
    +                 @(# #)
    166 
    +                 @(# #)
    167 
    +                 @(# #)
    168 
    +                 @(# #)
    169 
    +                 @(# #)
    170 
    +                 @(# #)
    171 
    +                 @(# #)
    172 
    +                 @(# #)
    173 
    +                 @(# #)
    174 
    +                 @(# #)
    175 
    +                 @(# #)
    176 
    +                 @(# #)
    177 
    +                 @(# #)
    178 
    +                 @(# #)
    179 
    +                 GHC.Internal.Types.(##);
    180 
    +             Main.E1_2 ->
    181 
    +               GHC.Internal.Types.(# |_| | | | | | | | | | | | | | #)
    182 
    +                 @GHC.Internal.Types.ZeroBitRep
    183 
    +                 @GHC.Internal.Types.ZeroBitRep
    184 
    +                 @GHC.Internal.Types.ZeroBitRep
    185 
    +                 @GHC.Internal.Types.ZeroBitRep
    186 
    +                 @GHC.Internal.Types.ZeroBitRep
    187 
    +                 @GHC.Internal.Types.ZeroBitRep
    188 
    +                 @GHC.Internal.Types.ZeroBitRep
    189 
    +                 @GHC.Internal.Types.ZeroBitRep
    190 
    +                 @GHC.Internal.Types.ZeroBitRep
    191 
    +                 @GHC.Internal.Types.ZeroBitRep
    192 
    +                 @GHC.Internal.Types.ZeroBitRep
    193 
    +                 @GHC.Internal.Types.ZeroBitRep
    194 
    +                 @GHC.Internal.Types.ZeroBitRep
    195 
    +                 @GHC.Internal.Types.ZeroBitRep
    196 
    +                 @GHC.Internal.Types.ZeroBitRep
    197 
    +                 @GHC.Internal.Types.ZeroBitRep
    198 
    +                 @(# #)
    199 
    +                 @(# #)
    200 
    +                 @(# #)
    201 
    +                 @(# #)
    202 
    +                 @(# #)
    203 
    +                 @(# #)
    204 
    +                 @(# #)
    205 
    +                 @(# #)
    206 
    +                 @(# #)
    207 
    +                 @(# #)
    208 
    +                 @(# #)
    209 
    +                 @(# #)
    210 
    +                 @(# #)
    211 
    +                 @(# #)
    212 
    +                 @(# #)
    213 
    +                 @(# #)
    214 
    +                 GHC.Internal.Types.(##);
    215 
    +             Main.E1_3 ->
    216 
    +               GHC.Internal.Types.(# | |_| | | | | | | | | | | | | #)
    217 
    +                 @GHC.Internal.Types.ZeroBitRep
    218 
    +                 @GHC.Internal.Types.ZeroBitRep
    219 
    +                 @GHC.Internal.Types.ZeroBitRep
    220 
    +                 @GHC.Internal.Types.ZeroBitRep
    221 
    +                 @GHC.Internal.Types.ZeroBitRep
    222 
    +                 @GHC.Internal.Types.ZeroBitRep
    223 
    +                 @GHC.Internal.Types.ZeroBitRep
    224 
    +                 @GHC.Internal.Types.ZeroBitRep
    225 
    +                 @GHC.Internal.Types.ZeroBitRep
    226 
    +                 @GHC.Internal.Types.ZeroBitRep
    227 
    +                 @GHC.Internal.Types.ZeroBitRep
    228 
    +                 @GHC.Internal.Types.ZeroBitRep
    229 
    +                 @GHC.Internal.Types.ZeroBitRep
    230 
    +                 @GHC.Internal.Types.ZeroBitRep
    231 
    +                 @GHC.Internal.Types.ZeroBitRep
    232 
    +                 @GHC.Internal.Types.ZeroBitRep
    233 
    +                 @(# #)
    234 
    +                 @(# #)
    235 
    +                 @(# #)
    236 
    +                 @(# #)
    237 
    +                 @(# #)
    238 
    +                 @(# #)
    239 
    +                 @(# #)
    240 
    +                 @(# #)
    241 
    +                 @(# #)
    242 
    +                 @(# #)
    243 
    +                 @(# #)
    244 
    +                 @(# #)
    245 
    +                 @(# #)
    246 
    +                 @(# #)
    247 
    +                 @(# #)
    248 
    +                 @(# #)
    249 
    +                 GHC.Internal.Types.(##);
    250 
    +
    251 
    +       ... etc ....
    252 
    +-}
    253 
    +
    136 254 
     data U_E2 = U_E2 {-# UNPACK #-} !E2
    137 255 
                      {-# UNPACK #-} !Int8
    138 256 
                      {-# UNPACK #-} !Int8

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help