Skip to content

GitLab

  • Menu
Projects Groups Snippets
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,870
    • Issues 4,870
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 453
    • Merge requests 453
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #5342
Closed
Open
Created Jul 24, 2011 by Ian Lynagh <igloo@earth.li>@trac-igloo

2047 core lint error when profiling

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
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking