Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

4 changed files:

Changes:

  • testsuite/tests/simplCore/should_compile/T7803.hs
    1 
    +{-# OPTIONS_GHC -ddump-simpl #-}
    2 
    +
    3 
    +-- #7803: foo1 should be fully specialised at Double.  In the bug report
    4 
    +-- it ended up calling the overloaded exp5Tail (with a dictionary argument),
    5 
    +-- because the specialiser ran before the overloaded call was floated to
    6 
    +-- the top level.  So the dumped Core for this module must mention no
    7 
    +-- exp5Tail at all.
    8 
    +module T7803 (foo1) where
    9 
    +
    10 
    +import T7803a
    11 
    +
    12 
    +bar :: Floating a => a -> a -> a
    13 
    +bar z = subtract (evaluate integ z) . evaluate integ
    14 
    +  where
    15 
    +    integ = indefinite (Piecewise [Poly4 1])
    16 
    +{-# SPECIALIZE bar :: Double -> Double -> Double #-}
    17 
    +
    18 
    +foo :: Floating a => a -> a -> a
    19 
    +foo x = bar x
    20 
    +{-# SPECIALIZE foo :: Double -> Double -> Double #-}
    21 
    +
    22 
    +foo1 :: Double -> Double -> Double
    23 
    +foo1 x = foo x

  • testsuite/tests/simplCore/should_compile/T7803.stderr
    1 
    +foo1

  • testsuite/tests/simplCore/should_compile/T7803a.hs
    1 
    +{-# LANGUAGE ConstraintKinds #-}
    2 
    +{-# LANGUAGE FlexibleContexts #-}
    3 
    +{-# LANGUAGE FlexibleInstances #-}
    4 
    +{-# LANGUAGE MultiParamTypeClasses #-}
    5 
    +{-# LANGUAGE TypeFamilies #-}
    6 
    +{-# LANGUAGE UndecidableInstances #-}
    7 
    +{-# LANGUAGE UndecidableSuperClasses #-}
    8 
    +
    9 
    +module T7803a
    10 
    +    ( Evaluate (..)
    11 
    +    , HasIntegral (..)
    12 
    +    , Poly4 (..)
    13 
    +    , Domain
    14 
    +    , IntOfLogPoly4 (..)
    15 
    +    , Piecewise (..)
    16 
    +    ) where
    17 
    +
    18 
    +import Data.Kind (Constraint, Type)
    19 
    +
    20 
    +class Evaluate poly where
    21 
    +    evaluate :: (Domain' poly a) => poly a -> a -> a
    22 
    +
    23 
    +class Evaluate (IntegralOf poly) => HasIntegral poly where
    24 
    +    type IntegralOf poly :: Type -> Type
    25 
    +    indefinite :: (Domain' poly a, Domain' (IntegralOf poly) a)
    26 
    +               => poly a -> IntegralOf poly a
    27 
    +
    28 
    +type family Domain (f :: Type -> Type) a :: Constraint
    29 
    +
    30 
    +class Domain f a => Domain' f a
    31 
    +instance Domain f a => Domain' f a
    32 
    +
    33 
    +newtype Poly4 a = Poly4 { poly4_a :: a }
    34 
    +
    35 
    +type instance Domain Poly4 a = Fractional a
    36 
    +
    37 
    +data IntOfLogPoly4 a = IntOfLogPoly4 { ilp4_k :: !a, ilp4_u :: !a }
    38 
    +
    39 
    +type instance Domain IntOfLogPoly4 a = Floating a
    40 
    +
    41 
    +instance Evaluate IntOfLogPoly4 where
    42 
    +    evaluate (IntOfLogPoly4 k _) x = k + x * exp5Tail (- log x)
    43 
    +    {-# INLINE evaluate #-}
    44 
    +
    45 
    +{-# RULES "exp5Tail/Double" exp5Tail = exp5TailDouble #-}
    46 
    +{-# NOINLINE exp5Tail #-}
    47 
    +
    48 
    +exp5Tail :: (Floating a) => a -> a
    49 
    +exp5Tail x = x / 120
    50 
    +
    51 
    +exp5TailDouble :: Double -> Double
    52 
    +exp5TailDouble x = x / 120
    53 
    +
    54 
    +instance HasIntegral Poly4 where
    55 
    +    type IntegralOf Poly4 = IntOfLogPoly4
    56 
    +    indefinite = \ (Poly4 a) -> IntOfLogPoly4 0 a
    57 
    +    {-# INLINE indefinite #-}
    58 
    +
    59 
    +newtype Piecewise poly a = Piecewise { unPiecewise :: [poly a] }
    60 
    +
    61 
    +type instance Domain (Piecewise poly) a = (Domain poly a, Num a)
    62 
    +
    63 
    +instance (Evaluate poly) => Evaluate (Piecewise poly) where
    64 
    +    evaluate = \ (Piecewise pp) x ->
    65 
    +        case pp of
    66 
    +          p : _ -> evaluate p x
    67 
    +          []    -> error "evaluate: empty Piecewise"
    68 
    +    {-# INLINE evaluate #-}
    69 
    +
    70 
    +instance (HasIntegral poly) => HasIntegral (Piecewise poly) where
    71 
    +    type IntegralOf (Piecewise poly) = Piecewise (IntegralOf poly)
    72 
    +    indefinite (Piecewise m) = Piecewise $ map indefinite m
    73 
    +    {-# INLINE indefinite #-}

  • testsuite/tests/simplCore/should_compile/all.T
    ... ... @@ -148,6 +148,13 @@ test('T7785', [ only_ways(['optasm']),
    148 148 
                    grep_errmsg(r'SPEC') ],
    149 149 
           compile, ['-ddump-cse'])
    150 150
    151 
    +# T7803: we expect NO calls to the overloaded 'exp5Tail' in T7803.hs
    152 
    +# In the bug report #7803, the unspecialised call was signalled by 'exp5Tail'
    153 
    +#    in foo1's Core, so we grep for that; also for 'foo1', lest we dump nothing
    154 
    +# One module, T7803.hs, has OPTIONS_GHC -ddump-simpl
    155 
    +test('T7803', [ grep_errmsg(r'exp5Tail|foo1') ],
    156 
    +     multimod_compile, ['T7803', '-O2 -v0 -dsuppress-all -dsuppress-uniques -dno-typeable-binds'])
    157 
    +
    151 158 
     test('T7702',
    152 159 
          [extra_files(['T7702plugin']),
    153 160 
           pre_cmd('$MAKE -s --no-print-directory -C T7702plugin package.T7702 TOP={top}'),

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/234bab081682018da7d04b22eee4b80f70381d07 at 1790717020