GitLab

Summary

When compiling a fairly short module (around 120 lines), GHC 9.0.2 uses over 14GB and then gets killed by the OOM killer.

Steps to reproduce

Consider the file below, and compile using 9.0.2 with ghc -O OOM (only depends on base). It will use a lot of memory and eventually be killed. However, uncommenting the wibble lines will avoid this and it will compile quickly with rather little memory. This seems to be fairly sensitive to small changes in the code / ghc versions. This current file only has a problem with ghc 9.0.1 and 9.0.2 but not 8.10.7, 9.2.1 or 9.2.2. However, I have seen the same issue with 8.10.7 on a less minimised example.

OOM.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}


module OOM (bar) where

import GHC.Generics
import GHC.Exts (Constraint)
import Data.Coerce (coerce)
import Data.Kind (Type)

data A = A ()
  deriving Generic

data B = B A

-- This avoids callstack stuff in core dumps
undefined' :: a
undefined' = undefined'

ba :: Optic A_Setter B B A A
ba = castOptic $ lens (\(B a) -> a) (\_ -> B)

aunit :: Optic A_Setter A A () ()
aunit = case foo (Market id Right) of
  Market _ _ -> Optic undefined'
 where
   foo :: Profunctor p => p i () () -> p i A A
   foo = dimap from to . dimap coerce coerce

bar :: Monad m => m [B]
bar = do
      _ <- pure []
      pure $ over (mapped %% ba) inner []
    where
      -- NB: inlining inner hides the bug
      inner = over aunit id

class Profunctor p where
  dimap :: (a -> b) -> (c -> d) -> p i b c -> p i a d

class Mapping p where
  -- Uncommenting this line avoids the OOM
  --wibble :: p i a b -> ()
  roam :: ((a -> b) -> s -> t) -> p i a b -> p i s t

first'  :: Mapping p => p i a b -> p i (a, c) (b, c)
first' = roam (\f (a, x) -> (f a, x))

-----
-- Some minimised code originating from optics-core and indexed-profunctors follows

newtype Optic (k :: OpticKind) s t a b
  = Optic (forall p i. (Profunctor p, Constraints k p) => p i a b -> p i s t)

castOptic :: forall s t a b.  Optic A_Lens  s t a b -> Optic A_Setter s t a b
castOptic (Optic o) = Optic o

infixl 9 %%
(%%) :: forall s t u v a b.  Optic A_Setter s t u v -> Optic A_Setter u v a b -> Optic A_Setter s t a b
Optic o %% Optic o' = Optic (o . o')

over
  :: forall s t a b.  Optic A_Setter s t a b -> (a -> b) -> s -> t
over (Optic o) f = runFunArrow $ o (FunArrow f)

lens :: (s -> a) -> (s -> b -> t) -> Optic A_Lens s t a b
lens get set = Optic $ dimap (\s -> (get s, s)) (\(b, s) -> set s b) . first'

mapped :: Functor f => Optic A_Setter (f a) (f b) a b
mapped = Optic (roam fmap)

type OpticKind = Type

data A_Lens :: OpticKind
data A_Setter :: OpticKind

-- Changing this into a synonym hides the OOM bug
type family Constraints (k :: OpticKind) (p :: Type -> Type -> Type -> Type) :: Constraint where
  Constraints A_Lens   p = Mapping p
  Constraints A_Setter p = Mapping p

data Market a b i s t = Market (b -> t) (s -> Either t a)

instance Profunctor (Market a b) where
  dimap f g (Market bt seta) = Market (g . bt) (either (Left . g) Right . seta . f)

-- NB: changing this to data hides the OOM bug
newtype FunArrow i a b = FunArrow { runFunArrow :: a -> b }

instance Profunctor FunArrow where
  dimap f g (FunArrow k) = FunArrow (g . k . f)

instance Mapping FunArrow where
  --wibble _ = ()
  roam  f (FunArrow k) = FunArrow $ f k

There are some strange interactions with core lint and -v flags: With the wibble lines uncommented, all configurations build fine. With them commented, I find that

• -v3 OOMs
• -v4 completes successfully, and needs only a small amount of memory
• -v3 -dcore-lint OOMs
• -v4 -dcore-lint only requires a small amount of memory and finds a core lint error (after multiple GB are written to stdout/stderr). This is a Trans coercion mis-match: OOM.N:Mapping{tc rh}[0] ...

Also, note that 9.2.1 reports (before completing sucessfully)

exprIsLambda_maybe: Unexpected lambda in case
  \ (eta_B0 :: B) ->
    B ((inner_s2zl
        `cast` (N:FunArrow[0] <Type>_N <Any>_P <A>_N <A>_N
                :: FunArrow Any A A ~R# (A -> A)))
         (case eta_B0 of { B a_a12P -> a_a12P }))

so this is potentially related to #21555 (closed). (9.2.2 does not report this, but does complete successfully.)

Expected behavior

Have roughly the same behaviour whether or not the Mapping class has one or two methods, and in both cases GHC should compile the module successfully whilst using only a small amount of memory.

Environment

GHC 9.0.2, on nixos (x86_64). (Specifically, I am using nixpkgs-unstable f419dc5763c2b3c5580e396dea065b6d8b58ee27)