Opened 3 years ago

Closed 3 years ago

#6096 closed bug (fixed)

tc126(optasm) is failing with a core lint error

Reported by: igloo Owned by:
Priority: high Milestone: 7.6.1
Component: Compiler Version: 7.5
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: GHC rejects valid program Test Case: tc126
Blocked By: Blocking:
Related Tickets: Differential Revisions:

Description

tc126(optasm) is failing with a core lint error.

The code:

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
             FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
-- UndecidableInstances now needed because the Coverage Condition fails

-- !!! Functional dependency test. Hugs [Apr 2001] fails to typecheck this
-- Rather bizarre example submitted by Jonathon Bell

module ShouldCompile where

-- module Foo where

class Bug f a r | f a -> r where
   bug::f->a->r

instance                Bug (Int->r) Int      r
instance (Bug f a r) => Bug f        (c a)    (c r) 

f:: Bug(Int->Int) a r => a->r
f = bug (id::Int->Int)

g1 = f (f [0::Int])
-- Inner f gives result type 
--      f [0::Int] :: Bug (Int->Int) [Int] r => r
-- Which matches the second instance declaration, giving r = [r']
--      f [0::Int] :: Bug (Int->Int) Int r' => r'
-- Wwich matches the first instance decl giving r' = Int
--      f [0::Int] :: Int
-- The outer f now has constraint
--      Bug (Int->Int) Int r
-- which makes r=Int
-- So g1::Int

g2 = f (f (f [0::Int]))
-- The outer f repeats the exercise, so g2::Int
-- This is the definition that Hugs rejects

The failure:

=====> tc126(optasm) 120 of 326 [0, 0, 0]
cd . && '/home/ian/ghc/git/ghc/inplace/bin/ghc-stage2' -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-package-conf -rtsopts  -fno-ghci-history -c tc126.hs -O -fasm  -fno-warn-incomplete-patterns >tc126.comp.stderr 2>&1
Compile failed (status 256) errors were:

tc126.hs:15:25: Warning:
    No explicit method or default declaration for `bug'
    In the instance declaration for `Bug (Int -> r) Int r'

tc126.hs:16:10: Warning:
    No explicit method or default declaration for `bug'
    In the instance declaration for `Bug f (c a) (c r)'
*** Core Lint errors : in result of Common sub-expression ***
{-# LINE 33 "tc126.hs #-}: Warning:
    [RHS of ShouldCompile.g2 :: [GHC.Types.Int]]
    The type of this binder doesn't match the type of its RHS: ShouldCompile.g2
    Binder's type: [GHC.Types.Int]
    Rhs type: [GHC.Types.Int] -> [GHC.Types.Int]
*** Offending Program ***
lvl_sbL
  :: forall f_aal (c_aam :: * -> *) a_aan r_aao.
     f_aal -> c_aam a_aan -> c_aam r_aao
[LclId, Str=DmdType b]
lvl_sbL =
  \ (@ f_aal) (@ (c_aam :: * -> *)) (@ a_aan) (@ r_aao) ->
    Control.Exception.Base.noMethodBindingError
      @ (f_aal -> c_aam a_aan -> c_aam r_aao)
      "tc126.hs:16:10-51|ShouldCompile.bug"

$cbug_abl
  :: forall f_aal (c_aam :: * -> *) a_aan r_aao.
     ShouldCompile.Bug f_aal a_aan r_aao =>
     f_aal -> c_aam a_aan -> c_aam r_aao
[LclId,
 Arity=1,
 Str=DmdType Ab,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
         ConLike=True, WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)
         Tmpl= \ (@ f_aal) (@ (c_aam :: * -> *)) (@ a_aan) (@ r_aao) _ ->
                 lvl_sbL @ f_aal @ c_aam @ a_aan @ r_aao}]
$cbug_abl =
  \ (@ f_aal) (@ (c_aam :: * -> *)) (@ a_aan) (@ r_aao) _ ->
    lvl_sbL @ f_aal @ c_aam @ a_aan @ r_aao

ShouldCompile.$fBugfcc [InlPrag=INLINE (sat-args=0)]
  :: forall f_aal (c_aam :: * -> *) a_aan r_aao.
     ShouldCompile.Bug f_aal a_aan r_aao =>
     ShouldCompile.Bug f_aal (c_aam a_aan) (c_aam r_aao)
[LclIdX[DFunId(nt)],
 Arity=1,
 Str=DmdType Ab,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
         ConLike=True, WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True)
         Tmpl= $cbug_abl
               `cast` (forall f_aal (c_aam :: * -> *) a_aan r_aao.
                       <ShouldCompile.Bug f_aal a_aan r_aao>
                       -> Sym
                            <(ShouldCompile.NTCo:Bug <f_aal> <c_aam a_aan> <c_aam r_aao>)>
                       :: (forall f_aal (c_aam :: * -> *) a_aan r_aao.
                           ShouldCompile.Bug f_aal a_aan r_aao =>
                           f_aal -> c_aam a_aan -> c_aam r_aao)
                            ~#
                          (forall f_aal (c_aam :: * -> *) a_aan r_aao.
                           ShouldCompile.Bug f_aal a_aan r_aao =>
                           ShouldCompile.Bug f_aal (c_aam a_aan) (c_aam r_aao)))}]
ShouldCompile.$fBugfcc =
  (\ (@ f_aal)
     (@ (c_aam :: * -> *))
     (@ a_aan)
     (@ r_aao)
     (eta_B1 :: ShouldCompile.Bug f_aal a_aan r_aao) ->
     $cbug_abl @ f_aal @ c_aam @ a_aan @ r_aao eta_B1)
  `cast` (forall f_aal (c_aam :: * -> *) a_aan r_aao.
          <ShouldCompile.Bug f_aal a_aan r_aao>
          -> Sym
               <(ShouldCompile.NTCo:Bug <f_aal> <c_aam a_aan> <c_aam r_aao>)>
          :: (forall f_aal (c_aam :: * -> *) a_aan r_aao.
              ShouldCompile.Bug f_aal a_aan r_aao =>
              f_aal -> c_aam a_aan -> c_aam r_aao)
               ~#
             (forall f_aal (c_aam :: * -> *) a_aan r_aao.
              ShouldCompile.Bug f_aal a_aan r_aao =>
              ShouldCompile.Bug f_aal (c_aam a_aan) (c_aam r_aao)))

$cbug_abh
  :: forall r_aap. (GHC.Types.Int -> r_aap) -> GHC.Types.Int -> r_aap
[LclId, Str=DmdType b]
$cbug_abh =
  \ (@ r_aap) ->
    Control.Exception.Base.noMethodBindingError
      @ ((GHC.Types.Int -> r_aap) -> GHC.Types.Int -> r_aap)
      "tc126.hs:15:25-47|ShouldCompile.bug"

ShouldCompile.$fBug(->)Intr [InlPrag=INLINE (sat-args=0)]
  :: forall r_aap.
     ShouldCompile.Bug (GHC.Types.Int -> r_aap) GHC.Types.Int r_aap
[LclIdX[DFunId(nt)],
 Str=DmdType b,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=False,
         ConLike=False, WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True)
         Tmpl= $cbug_abh
               `cast` (forall r_aap.
                       Sym
                         <(ShouldCompile.NTCo:Bug
                             <GHC.Types.Int -> r_aap> <GHC.Types.Int> <r_aap>)>
                       :: (forall r_aap.
                           (GHC.Types.Int -> r_aap) -> GHC.Types.Int -> r_aap)
                            ~#
                          (forall r_aap.
                           ShouldCompile.Bug (GHC.Types.Int -> r_aap) GHC.Types.Int r_aap))}]
ShouldCompile.$fBug(->)Intr =
  $cbug_abh
  `cast` (forall r_aap.
          Sym
            <(ShouldCompile.NTCo:Bug
                <GHC.Types.Int -> r_aap> <GHC.Types.Int> <r_aap>)>
          :: (forall r_aap.
              (GHC.Types.Int -> r_aap) -> GHC.Types.Int -> r_aap)
               ~#
             (forall r_aap.
              ShouldCompile.Bug (GHC.Types.Int -> r_aap) GHC.Types.Int r_aap))

$sf_sbw :: [GHC.Types.Int] -> [GHC.Types.Int]
[LclId, Str=DmdType b]
$sf_sbw = case lvl_sbL of wild_00 { }

ShouldCompile.f
  :: forall a_aaf r_aag.
     ShouldCompile.Bug (GHC.Types.Int -> GHC.Types.Int) a_aaf r_aag =>
     a_aaf -> r_aag
[LclIdX,
 Arity=1,
 Str=DmdType C(S),
 RULES: "SPEC ShouldCompile.f [[GHC.Types.Int], [GHC.Types.Int]]" [ALWAYS]
            forall ($dBug_XbY
                      :: ShouldCompile.Bug
                           (GHC.Types.Int -> GHC.Types.Int) [GHC.Types.Int] [GHC.Types.Int]).
              ShouldCompile.f @ [GHC.Types.Int] @ [GHC.Types.Int] $dBug_XbY
              = $sf_sbw]
ShouldCompile.f =
  \ (@ a_a)
    (@ r_b)
    ($dBug_aaQ
       :: ShouldCompile.Bug (GHC.Types.Int -> GHC.Types.Int) a_a r_b) ->
    ($dBug_aaQ
     `cast` (<ShouldCompile.NTCo:Bug
                <GHC.Types.Int -> GHC.Types.Int> <a_a> <r_b>>
             :: ShouldCompile.Bug (GHC.Types.Int -> GHC.Types.Int) a_a r_b
                  ~#
                ((GHC.Types.Int -> GHC.Types.Int) -> a_a -> r_b)))
      (GHC.Base.id @ GHC.Types.Int)

ShouldCompile.g2 :: [GHC.Types.Int]
[LclIdX, Str=DmdType b]
ShouldCompile.g2 = $sf_sbw

ShouldCompile.g1 :: [GHC.Types.Int]
[LclIdX, Str=DmdType b]
ShouldCompile.g1 = $sf_sbw

*** End of Offense ***


<no location info>: 
Compilation had errors



*** unexpected failure for tc126(optasm)

Change History (2)

comment:1 Changed 3 years ago by simonpj@…

commit ebcad7641a1e37e2e4abd7f513feb10c4ee458bc

Author: Simon Peyton Jones <[email protected]>
Date:   Wed May 16 10:50:36 2012 +0100

    When comparing Case expressions, take account of empty alternatives
    
    After the recent change that allows empty case alternatives, we
    were accidentally saying that these two were equal:
       Case x _ Int  []
       Case x _ Bool []
    Usually if the alternatives are equal so is the result type -- but
    not if the alternatives are empty!
    
    There are two places to fix:
      CoreUtils.eqExpr
      TrieMap with CoreExpr key
    
    Fixes #6096, #6097

 compiler/coreSyn/CoreUtils.lhs |    9 +++--
 compiler/coreSyn/TrieMap.lhs   |   60 ++++++++++++++++++++++++++-------------
 2 files changed, 45 insertions(+), 24 deletions(-)

comment:2 Changed 3 years ago by simonpj

  • Resolution set to fixed
  • Status changed from new to closed
Note: See TracTickets for help on using tickets.