+        |      vocurly    top close    { (fst $2, snd $2, EpVirtualBraces (glR $1)) }

+        |  missing_module_keyword top close     { ([], snd $2, EpVirtualBraces (EpaDelta noSrcSpan (SameLine 0) [])) }

+                                           in L l ((noEpTok, anns, noEpTok), decls, EpVirtualBraces (glR $1)) }

+  EpLayout(..), getEpaLocationCol,

+      !EpaLocation -- ^ Layout column (indentation level, begins at 1)

+                   -- We keep this as an 'EpaLocation' so exact printing

+                   -- can use it too.

+-- | Used in 'GHC.Parser.Haddock' to get layout column. It assumes

+-- | there is a RealSrcSpan in it, falling back to zero otherwise

+getEpaLocationCol :: EpaLocation -> Int

+getEpaLocationCol loc

+  = case loc of

+      EpaSpan (RealSrcSpan l _) -> srcSpanStartCol l

+      _ -> leftmostColumn -- should never happen in Parser output

+

+      EpVirtualBraces n' ->

+        let n = getEpaLocationCol n'

+            loc_range = mempty { loc_range_col = ColumnFrom (n+1) }

+      EpVirtualBraces n -> getEpaLocationCol n /= srcSpanStartCol (psRealSpan l_comment)

+    (EpaSpan { T22919.hs:2:1 }))

+    (EpaSpan { Test20239.hs:5:1 }))

+    (EpaSpan { ZeroWidthSemi.hs:6:1 }))

+    (EpaSpan { T17544.hs:5:1 }))

+        (EpaSpan { T17544.hs:6:3 })))

+        (EpaSpan { T17544.hs:10:3 })))

+        (EpaSpan { T17544.hs:14:3 })))

+        (EpaSpan { T17544.hs:18:3 })))

+    (EpaSpan { T17544_kw.hs:13:1 }))

+        (EpaSpan { T17544_kw.hs:22:5 })))

+    (EpaSpan { T24221.hs:3:1 }))

+    (EpaDelta { <no location info> } (SameLine 0) []))

+    (EpaSpan { DumpParsedAst.hs:5:1 }))

+    (EpaSpan { DumpParsedAstComments.hs:9:1 }))

+    (EpaSpan { DumpSemis.hs:4:1 }))

+        (EpaSpan { DumpSemis.hs:29:3 })))

+    (EpaSpan { KindSigs.hs:8:1 }))

+    (EpaSpan { T15323.hs:5:1 }))

+    (EpaSpan { T20452.hs:5:1 }))

+    (EpaSpan { T20718.hs:8:1 }))

+    (EpaSpan { T20718b.hs:8:1 }))

+    (EpaSpan { T20846.hs:3:1 }))

+    (EpaSpan { T23315.hsig:3:1 }))

+    (EpaSpan { AnnotationNoListTuplePuns.hs:5:1 }))

+    (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:1 }))

+    (EpaSpan { T18791.hs:4:1 }))

+    (EpaSpan { Test20297.hs:5:1 }))

+    (EpaSpan { Test20297.ppr.hs:3:1 }))

+    (EpaSpan { Test24533.hs:4:1 }))

+    (EpaSpan { Test24533.ppr.hs:3:1 }))

+{-# OPTIONS_GHC -ddump-simpl #-}

+

+-- #7803: foo1 should be fully specialised at Double.  In the bug report

+-- it ended up calling the overloaded exp5Tail (with a dictionary argument),

+-- because the specialiser ran before the overloaded call was floated to

+-- the top level.  So the dumped Core for this module must mention no

+-- exp5Tail at all.

+module T7803 (foo1) where

+

+import T7803a

+

+bar :: Floating a => a -> a -> a

+bar z = subtract (evaluate integ z) . evaluate integ

+  where

+    integ = indefinite (Piecewise [Poly4 1])

+{-# SPECIALIZE bar :: Double -> Double -> Double #-}

+

+foo :: Floating a => a -> a -> a

+foo x = bar x

+{-# SPECIALIZE foo :: Double -> Double -> Double #-}

+

+foo1 :: Double -> Double -> Double

+foo1 x = foo x

+foo1

+{-# LANGUAGE ConstraintKinds #-}

+{-# LANGUAGE FlexibleContexts #-}

+{-# LANGUAGE FlexibleInstances #-}

+{-# LANGUAGE MultiParamTypeClasses #-}

+{-# LANGUAGE TypeFamilies #-}

+{-# LANGUAGE UndecidableInstances #-}

+{-# LANGUAGE UndecidableSuperClasses #-}

+

+module T7803a

+    ( Evaluate (..)

+    , HasIntegral (..)

+    , Poly4 (..)

+    , Domain

+    , IntOfLogPoly4 (..)

+    , Piecewise (..)

+    ) where

+

+import Data.Kind (Constraint, Type)

+

+class Evaluate poly where

+    evaluate :: (Domain' poly a) => poly a -> a -> a

+

+class Evaluate (IntegralOf poly) => HasIntegral poly where

+    type IntegralOf poly :: Type -> Type

+    indefinite :: (Domain' poly a, Domain' (IntegralOf poly) a)

+               => poly a -> IntegralOf poly a

+

+type family Domain (f :: Type -> Type) a :: Constraint

+

+class Domain f a => Domain' f a

+instance Domain f a => Domain' f a

+

+newtype Poly4 a = Poly4 { poly4_a :: a }

+

+type instance Domain Poly4 a = Fractional a

+

+data IntOfLogPoly4 a = IntOfLogPoly4 { ilp4_k :: !a, ilp4_u :: !a }

+

+type instance Domain IntOfLogPoly4 a = Floating a

+

+instance Evaluate IntOfLogPoly4 where

+    evaluate (IntOfLogPoly4 k _) x = k + x * exp5Tail (- log x)

+    {-# INLINE evaluate #-}

+

+{-# RULES "exp5Tail/Double" exp5Tail = exp5TailDouble #-}

+{-# NOINLINE exp5Tail #-}

+

+exp5Tail :: (Floating a) => a -> a

+exp5Tail x = x / 120

+

+exp5TailDouble :: Double -> Double

+exp5TailDouble x = x / 120

+

+instance HasIntegral Poly4 where

+    type IntegralOf Poly4 = IntOfLogPoly4

+    indefinite = \ (Poly4 a) -> IntOfLogPoly4 0 a

+    {-# INLINE indefinite #-}

+

+newtype Piecewise poly a = Piecewise { unPiecewise :: [poly a] }

+

+type instance Domain (Piecewise poly) a = (Domain poly a, Num a)

+

+instance (Evaluate poly) => Evaluate (Piecewise poly) where

+    evaluate = \ (Piecewise pp) x ->

+        case pp of

+          p : _ -> evaluate p x

+          []    -> error "evaluate: empty Piecewise"

+    {-# INLINE evaluate #-}

+

+instance (HasIntegral poly) => HasIntegral (Piecewise poly) where

+    type IntegralOf (Piecewise poly) = Piecewise (IntegralOf poly)

+    indefinite (Piecewise m) = Piecewise $ map indefinite m

+    {-# INLINE indefinite #-}

+# T7803: we expect NO calls to the overloaded 'exp5Tail' in T7803.hs

+# In the bug report #7803, the unspecialised call was signalled by 'exp5Tail'

+#    in foo1's Core, so we grep for that; also for 'foo1', lest we dump nothing

+# One module, T7803.hs, has OPTIONS_GHC -ddump-simpl

+test('T7803', [ grep_errmsg(r'exp5Tail|foo1') ],

+     multimod_compile, ['T7803', '-O2 -v0 -dsuppress-all -dsuppress-uniques -dno-typeable-binds'])

+