GitLab

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

Trac metadata

Trac field	Value
Version	7.0.3
Type	Bug
TypeOfFailure	OtherFailure
Priority	highest
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture