Opened 8 years ago

Closed 8 years ago

#5342 closed bug (fixed)

2047 core lint error when profiling

Reported by: igloo Owned by: simonpj
Priority: highest Milestone: 7.2.1
Component: Compiler Version: 7.0.3
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: None/Unknown Test Case: simplCore/should_compile/T5342
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:

Description

Cut-down copy of the 2047 test:

module Q (increaseAreas) where

import Control.Monad
import Data.List

nubSorted :: Eq a => [a] -> [a]
nubSorted = undefined

cellsAround :: (Num a, Num b, Ord a, Ord b) => [(a, b)] -> [(a, b)]
cellsAround = undefined

increaseAreas :: (Num a, Num b, Ord a, Ord b) => [[(a, b)]] -> [[(a, b)]]
increaseAreas areas = nubSorted $ sort $
    do
        area <- areas
        cell2 <- cellsAround area
        return $ sort $ cell2 : area
ghc -fforce-recomp -c -O -prof -auto-all -dcore-lint -dcmm-lint 2047.hs -Wall
*** Core Lint errors : in result of Simplifier ***
<no location info>:
    [RHS of go_sxn :: [[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]]
    Demand type has  1  arguments, rhs has  0 arguments,  go_sxn
    Binder's strictness signature: DmdType S
*** Offending Program ***
$wincreaseAreas_sxi
  :: forall a_adT b_adU.
     (GHC.Classes.Ord a_adT, GHC.Classes.Ord b_adU) =>
     [[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]
[LclId,
 Arity=2,
 Str=DmdType LL,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=2, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=IF_ARGS [0 0] 442 60}]
$wincreaseAreas_sxi =
  \ (@ a_adT)
    (@ b_adU)
    (w_sxf :: GHC.Classes.Ord a_adT)
    (w_sxg :: GHC.Classes.Ord b_adU) ->
    letrec {
      go_sxn [Occ=LoopBreaker]
        :: [[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]
      [LclId,
       Str=DmdType S,
       Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
               ConLike=True, Cheap=False, Expandable=False,
               Guidance=IF_ARGS [] 301 60}]
      go_sxn =
        __scc {increaseAreas main:Q !}
        let {
          lvl_sxq
            :: (a_adT, b_adU) -> (a_adT, b_adU) -> GHC.Ordering.Ordering
          [LclId,
           Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
                   ConLike=True, Cheap=True, Expandable=True,
                   Guidance=IF_ARGS [] 30 60}]
          lvl_sxq =
            GHC.Classes.$fOrd(,)_$ccompare @ a_adT @ b_adU w_sxf w_sxg } in
        \ (ds_avk :: [[(a_adT, b_adU)]]) ->
          case ds_avk of _ {
            [] -> GHC.Types.[] @ [(a_adT, b_adU)];
            : y_avo [Dmd=Just X] ys_avp [Dmd=Just X] ->
              letrec {
                go_XvC [Occ=LoopBreaker] :: [(a_adT, b_adU)] -> [[(a_adT, b_adU)]]
                [LclId,
                 Arity=1,
                 Str=DmdType S,
                 Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=1, Value=True,
                         ConLike=True, Cheap=True, Expandable=True,
                         Guidance=IF_ARGS [30] 90 130}]
                go_XvC =
                  \ (ds_XvE :: [(a_adT, b_adU)]) ->
                    case ds_XvE of _ {
                      [] -> GHC.Types.[] @ [(a_adT, b_adU)];
                      : y_XvK [Dmd=Just L] ys_XvM [Dmd=Just L] ->
                        GHC.Types.:
                          @ [(a_adT, b_adU)]
                          (Data.List.sortBy
                             @ (a_adT, b_adU)
                             lvl_sxq
                             (GHC.Types.: @ (a_adT, b_adU) y_XvK y_avo))
                          (go_XvC ys_XvM)
                    }; } in
              case go_XvC
                     ((__scc {cellsAround main:Q}
                       GHC.Err.undefined @ ([(a_adT, b_adU)] -> [(a_adT, b_adU)]))
                        y_avo)
              of _ {
                [] -> go_sxn ys_avp;
                : x_avv [Dmd=Just L] xs_avw [Dmd=Just L] ->
                  GHC.Types.:
                    @ [(a_adT, b_adU)]
                    x_avv
                    (GHC.Base.++ @ [(a_adT, b_adU)] xs_avw (go_sxn ys_avp))
              }
          }; } in
    __scc {increaseAreas main:Q}
    let {
      $dOrd_svK [Dmd=Just L] :: GHC.Classes.Ord (a_adT, b_adU)
      [LclId,
       Str=DmdType,
       Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
               ConLike=True, Cheap=False, Expandable=True,
               Guidance=IF_ARGS [] 30 0}]
      $dOrd_svK = GHC.Classes.$fOrd(,) @ a_adT @ b_adU w_sxf w_sxg } in
    let {
      lvl_sxr
        :: [(a_adT, b_adU)] -> [(a_adT, b_adU)] -> GHC.Ordering.Ordering
      [LclId,
       Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
               ConLike=True, Cheap=True, Expandable=True,
               Guidance=IF_ARGS [] 20 60}]
      lvl_sxr =
        GHC.Classes.$fOrd[]_$ccompare1 @ (a_adT, b_adU) $dOrd_svK } in
    \ (areas_adY :: [[(a_adT, b_adU)]]) ->
      (__scc {nubSorted main:Q}
       GHC.Err.undefined @ ([[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]))
        (Data.List.sortBy @ [(a_adT, b_adU)] lvl_sxr (go_sxn areas_adY))

Q.increaseAreas [InlPrag=INLINE[0]]
  :: forall a_adT b_adU.
     (GHC.Num.Num a_adT,
      GHC.Num.Num b_adU,
      GHC.Classes.Ord a_adT,
      GHC.Classes.Ord b_adU) =>
     [[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]
[LclIdX,
 Arity=4,
 Str=DmdType AALL,
 Unf=Unf{Src=Worker=$wincreaseAreas_sxi, TopLvl=True, Arity=4,
         Value=True, ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)
         Tmpl= \ (@ a_adT)
                 (@ b_adU)
                 _
                 _
                 (w_sxf [Occ=Once] :: GHC.Classes.Ord a_adT)
                 (w_sxg [Occ=Once] :: GHC.Classes.Ord b_adU) ->
                 $wincreaseAreas_sxi @ a_adT @ b_adU w_sxf w_sxg}]
Q.increaseAreas =
  \ (@ a_adT)
    (@ b_adU)
    _
    _
    (w_sxf :: GHC.Classes.Ord a_adT)
    (w_sxg :: GHC.Classes.Ord b_adU) ->
    $wincreaseAreas_sxi @ a_adT @ b_adU w_sxf w_sxg

*** End of Offense ***


<no location info>: 
Compilation had errors

Change History (3)

comment:1 Changed 8 years ago by simonpj@…

commit 4e72e09348c11b44103ee29990262d44ee86df50

Author: Simon Peyton Jones <simonpj@microsoft.com>
Date:   Wed Jul 27 06:25:45 2011 +0100

    Fix let-floating out of Rec blocks
    
    This fixes Trac #5341 and #5342.  The question is about
    what to do when floating out of the RHS of a Rec-bound
    function, when there's a FloatCase involved.  For FloatLets
    they can join the Rec block, but FloatCases can't.  But
    we don't want to mess with the arity (that was the bug).
    So in this (rather exotic case) we push the FloatCase
    back inside any lambdas.
    
    See Note [Floating out of Rec rhss]. It's a slightly ugly fix, but I
    can't think of anything better, and I don't think it has any practical
    impact.

 compiler/simplCore/FloatOut.lhs |   49 ++++++++++++++++++++++++++++++++++++--
 1 files changed, 46 insertions(+), 3 deletions(-)

comment:2 Changed 8 years ago by simonpj

Status: newmerge
Test Case: simplCore/should_compile/T5342

Fixed, I think. Test added. But I didn't do anything special to say "run this test profiled". Do I need to?

comment:3 Changed 8 years ago by igloo

Resolution: fixed
Status: mergeclosed

Merged as changeset:60030a887f075c4858276f36097cdd2525952f1d.

Normal tests are run as profiled in a full testsuite run.

Note: See TracTickets for help on using tickets.