Skip to content

tc126(optasm) is failing with a core lint error

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)
Trac metadata
Trac field Value
Version 7.5
Type Bug
TypeOfFailure OtherFailure
Priority high
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