internal error: PAP object entered!

changed weight to 5

I can confirm that this code also panics on 8.6.3 (after lots of tweaking to make it compile). Alas, this repo is absolutely massive, and I haven't the slightest clue where to begin minimizing it. Any help you could provide would be massively helpful.

One thing to note is that the insertX function appears to be important here. The program still crashes if you make the following change to test/PersistWrap/WidgetSpec.hs:

diff --git a/persistwrap/test/PersistWrap/WidgetSpec.hs b/persistwrap/test/PersistWrap/WidgetSpec.hs
index 8055d52..2c9435e 100644
--- a/persistwrap/test/PersistWrap/WidgetSpec.hs
+++ b/persistwrap/test/PersistWrap/WidgetSpec.hs
@@ -47,6 +47,7 @@ widgetAssertions = atomicTransaction $ do
       w1 = Blarg (False, True, BS.pack "hello world")
       w2 = Glorp fk3
   fkw1      <- insertX @"widget" w1
+  {-
   fkw2      <- insertX @"widget" w2
   fkw3      <- insertWidget3
   traceM "Hi"
@@ -60,6 +61,8 @@ widgetAssertions = atomicTransaction $ do
     result1 `shouldBe` Just w1
     result2 `shouldBe` Just w2
     result3 `shouldBe` Just widget3
+  -}
+  undefined
 
 widget3 :: Widget fk
 widget3 =

If I comment out the first two uses of insertX in widgetAssertions, however, then the crash no longer occurs.

I don't know about shrinking but I was able to isolate where it's happening.

It's in the call to STM's return method here: https://github.com/dspies-leapyear/persistwrap/blob/885a079923cb3eefb24db344f5e2fddee9fab425/persistwrap/src/PersistWrap/Persistable/Insert/Utils.hs#L130

I've added a Monad2 typeclass and threaded it through the program in order to make it easy to play with the bug and get more info: https://github.com/dspies-leapyear/persistwrap/blob/e8ee02716acdd42ceea8210c9ef333c0f6c9d08d/persistwrap-table/src/PersistWrap/Table/Monad2.hs#L20

When I run

stack test persistwrap:persistwrap-test --ta '-p "Widget.should get back"'

I get

Progress 1/2: persistwrap-0.1.0.0test/Driver.hs
  widget
    Widget
      should get back what you put in: STM returning ValueSnd (V (PV 3))
persistwrap-test: internal error: PAP object entered!
    (GHC version 8.4.4 for x86_64_apple_darwin)
    Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug

So the message outside the return is getting printed but not the one on the inside.

I pushed the failing return call much closer to the top to make it clear that it's not a lazy evaluation thing:

Now it's happening here: https://github.com/dspies-leapyear/persistwrap/blob/c6923216c126e9125e4ce80a33bd4e416b3922c7/persistwrap/src/PersistWrap/Persisted.hs#L44

When I run it I get:

Progress 9/10: persistwrap-0.1.0.0test/Driver.hs
  widget
    Widget
      should get back what you put in: Before: <foreign key: abc>
STM returning <foreign key: abc>
persistwrap-test: internal error: PAP object entered!
    (GHC version 8.4.4 for x86_64_apple_darwin)
    Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug

RyanGlScott, have you tried enabling core lint while building the reproducer?

That test builds without issue when enabling -dcore-lint (on GHC 8.4.4, at least).

The failure occurs when running the test; not when building.

Right, but a Core Lint failure would tell us at compile-time whether and where the compiler misstepped. Sadly it looks like this won't be so simple to find.

dnspies, any help you could provide in minimizing the reproducer would be greatly appreciated.

added runtime crash label

@RyanGlScott can you share your tweaks for GHC 8.6? I'm using stack2cabal to build this using cabal as I don't have stack and am hitting the 8.6 compile errors now.

We're running into a similar problem at my day job (DFINITY) which is hurting our ability to profile and optimise, but our reproduction only occurs after running a network program for 10+ minutes. This one seems maybe easier to minimise.

@infinity0, see https://github.com/RyanGlScott/persistwrap/commit/785deb04bb1efa6434de0d7dfbcdd82fb5dc3547. You can trigger the panic with:

$ cabal new-test --enable-tests persistwrap:persistwrap-test
Build profile: -w ghc-8.6.4 -O1
In order, the following will be built (use -v for more details):
 - persistwrap-0.1.0.0 (test:persistwrap-test) (first run)
Preprocessing test suite 'persistwrap-test' for persistwrap-0.1.0.0..
Building test suite 'persistwrap-test' for persistwrap-0.1.0.0..
Running 1 test suites...
Test suite persistwrap-test: RUNNING...
test/Driver.hs
  widget
    Widget
      should get back what you put in: persistwrap-test: internal error: PAP object entered!
    (GHC version 8.6.4 for x86_64_unknown_linux)
    Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug
Test suite persistwrap-test: FAIL
Test suite logged to:
/home/rgscott/Documents/Hacking/Haskell/persistwrap/dist-newstyle/build/x86_64-linux/ghc-8.6.4/persistwrap-0.1.0.0/t/persistwrap-test/test/persistwrap-0.1.0.0-persistwrap-test.log
0 of 1 test suites (0 of 1 test cases) passed.
cabal: Tests failed for test:persistwrap-test from persistwrap-0.1.0.0.

Thanks! Here's a smaller reproduction, outside of the testing framework but still using some persistwrap functions. You can run it directly with ghc Test.hs && ./Test as long as persistwrap is installed.

I tried to make it even smaller but got into a thicket trying to inline functions like unsafeSetupEmptyTables etc, perhaps @trac-dnspies can help or take over from here.

16066.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_GHC -O -Wunused-imports -dcmm-lint -dstg-lint -dcore-lint #-}

module Main (main) where

import Control.Monad (join)
import Data.Singletons.Prelude (withSomeSing)

import PersistWrap.Itemized (Itemized (runItemized))
import PersistWrap.Persistable (entitySchemas)
import PersistWrap.Persisted (insertX)

import PersistWrap.Structure (StructureOf)

import PersistWrap.Table.BackEnd.STM.Internal (unsafeSetupEmptyTables)
import PersistWrap.Table.Transaction (MonadPersist (atomicTransaction))

main :: IO ()
main = do
  let schema = entitySchemas @"a" @(StructureOf Int)
  let action = withSomeSing schema $ \sschema ->
        unsafeSetupEmptyTables sschema (const (runItemized widgetAssertions))
  join action >>= print

--HIDESBUG:
--widgetAssertions :: Itemized Tbl (STMPersist s IO) (IO ())
widgetAssertions :: (MonadPersist m) => Itemized Tbl m (IO ())
widgetAssertions = atomicTransaction $ do
  _ <- insertX @"a" 1
  _ <- insertX @"a" 1
  --HIDESBUG:
  --pure (pure ())
  error "exit assertion"

type Tbl = '[ '("a", Int)]

edit: put code in collapsible details box

Hah, that's about the same point where I gave up on minimizing this :) That code is deceivingly small in appearance—there's a lot happening underneath the hood!

If someone familiar with this codebase could help minimize this further, that would be greatly appreciated, as I lack the expertise to do so.

Two things that would make this easier (a) some automatic inliner tool, similar to the output of gcc -E (b) being able to find out which instances are being used and where it's being imported from. Any clues on those fronts would also be appreciated.

Progress update, here's a smaller example plus a patch needed to make it work (it exposes some internal constructors).

I am actually not sure how to minimise it more, please have a look and see if you have any ideas. atomicTransaction seems to be a good next step, however if I inline the typeclass constraint away with the actual type (IO) the bug goes away! :(

Pretty much everything else that remains, e.g. runItemized, is trivial wrappers etc, and can't be minimised before we deal with atomicTransaction...

16066.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

{-# OPTIONS_GHC -O -Wunused-imports -dcmm-lint -dstg-lint -dcore-lint #-}

module Main (main) where

import Control.Monad (join)
import Control.Concurrent.STM.TVar (newTVarIO)
import Control.Monad.Reader (runReaderT)
import qualified Data.Map as Map (singleton)

import Consin (Some(Some))
import Consin.SingMap (SingMap(SingMap))
import Data.Singletons.Prelude (SingI(sing), SomeSing(SomeSing), withSingI)

-- for type Sch
import qualified PersistWrap.Table.Schema.Internal as SInternal (Schema(Schema), Column(Column), BaseColumn(Prim))
import PersistWrap.Primitives (PrimName(PrimInt64))

-- for mschema
import PersistWrap.Table.Schema (Sing(SSchema))
import PersistWrap.Table.Reflect (SomeTableNamed(SomeTableNamed))
import qualified PersistWrap.Table.BackEnd.STM.Internal as Internal (Table(Table))

-- for widgetAssertions
import PersistWrap.Itemized (Itemized (runItemized))
import PersistWrap.Persisted (insertX)
import PersistWrap.Table.BackEnd.STM.Internal (STMPersist(unSTMPersist))
import PersistWrap.Table.Transaction (MonadPersist (atomicTransaction))

exec :: IO (IO ())
exec = do
  let sch = sing @Sch
  (k, v) <- case sch of
    SSchema name cols -> do
      v <- Internal.Table @_ @Sch <$> newTVarIO []
      pure (SomeSing name, withSingI name $ Some $ SomeTableNamed cols v)
  let mschema = Map.singleton k v
  let action = unSTMPersist $ runItemized widgetAssertions
  --let schs = SCons sch SNil
  runReaderT (withSingI (error "schs never accessed") action) (SingMap mschema)

main :: IO ()
main = join exec >>= print

--HIDESBUG:
--widgetAssertions :: Itemized Tbl (STMPersist s IO) (IO ())
widgetAssertions :: (MonadPersist m) => Itemized Tbl m (IO ())
widgetAssertions = atomicTransaction $ do
  _ <- insertX @"a" 1
  _ <- insertX @"a" 1
  --HIDESBUG:
  --pure (pure ())
  error "exit never happens"

type Tbl = '[ '("a", Int)]
type Sch = 'SInternal.Schema "a" '[ '("value", 'SInternal.Column 'False ('SInternal.Prim 'PrimInt64))]

diff.patch

diff --git a/consin/src/Consin/SingMap.hs b/consin/src/Consin/SingMap.hs
index 9959558..051729e 100644
--- a/consin/src/Consin/SingMap.hs
+++ b/consin/src/Consin/SingMap.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module Consin.SingMap
-    ( SingMap
+    ( SingMap(..)
     , (\\)
     , (!?)
     , delete
diff --git a/persistwrap-table/src/PersistWrap/Table/BackEnd/STM/Internal.hs b/persistwrap-table/src/PersistWrap/Table/BackEnd/STM/Internal.hs
index 4abf1cd..8dbb6e0 100644
--- a/persistwrap-table/src/PersistWrap/Table/BackEnd/STM/Internal.hs
+++ b/persistwrap-table/src/PersistWrap/Table/BackEnd/STM/Internal.hs
@@ -2,8 +2,9 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module PersistWrap.Table.BackEnd.STM.Internal
-    ( STMPersist
-    , STMTransaction
+    ( STMPersist(..)
+    , STMTransaction(..)
+    , Class.Table(..) -- export Table constructor
     , showAllTables
     , unsafeSetupEmptyTables
, withEmptyTables

Unfortunately the reproducer is still huge. It'd be best if we could find a smaller reproducer (with less dependencies) but perhaps it might also help to build this program with -debug and run with +RTS -DS. If you also make the nurseries small (e.g. +RTS -A10k) you end up doing a lot of sanity checking, which may help with diagnosing the problem.

Here's a minimal reproducer with no dependencies. The bug is something to do with specialisation and is pretty sensitive, see my comments inline.

-- these flags affect the bug
-- note that -O implies the others, but flipping any of them hides the bug
{-# OPTIONS_GHC
  -O
  -fenable-rewrite-rules
  -fspecialise
  -fno-ignore-interface-pragmas
 #-}

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- misc stuff for debugging
{-# OPTIONS_GHC
  -Wunused-imports
  -dcmm-lint
  -dstg-lint
  -dcore-lint
 #-}

module Main (main) where

import Control.Monad (join)
import Control.Monad.Reader (ReaderT(..))
import Control.Concurrent.STM (STM, atomically)

class Monad (Transaction m) => MonadPersist m where
  type Transaction m :: * -> *
  atomicTransaction :: Transaction m y -> m y

-- HIDESBUG: replacing ReaderT with IdentityT, or dropping it
instance MonadPersist (ReaderT () IO) where
  type Transaction (ReaderT () IO) = ReaderT () STM
  --HIDESBUG:
  --atomicTransaction = mapReaderT atomically
  --atomicTransaction = ReaderT . (atomically .) . runReaderT
  atomicTransaction act = ReaderT (atomically . runReaderT act)

main :: IO ()
main = join (runReaderT doPure2 ()) >>= print

--HIDESBUG:
--doPure2 :: ReaderT () IO (IO ()) 
doPure2 :: MonadPersist m => m (IO ())
--HIDESBUG:
--doPure2 = ReaderT $ \() -> atomically $ flip runReaderT () $ do
doPure2 = atomicTransaction $ do
  _ <- pure ()
  _ <- pure ()
  --HIDESBUG:
  --pure (pure ())
  error "exit never happens"

edit: remove collapsible details box for emphasis, since this is the best reproducer we have so far

That's a very helpful reduction, thank you.

I hope someone can dig into this. GHC should never crash!

Trac field	Value
Version	8.4.4
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture

internal error: PAP object entered!

Child items ...

Activity

internal error: PAP object entered!

Relates to

Activity