Skip to content
Snippets Groups Projects

Simplifier does not preserve dependency ordering of the program

    • Open Issue created by Ömer Sinan Ağacan @osa1

    I noticed this some time ago, but I thought this is expected, because there's a comment in CoreLint that mentions this:

    lintCoreBindings dflags pass local_in_scope binds
  = initL dflags flags in_scope_set $
    addLoc TopLevelBindings         $
    lintLetBndrs TopLevel binders   $
        -- Put all the top-level binders in scope at the start
        -- This is because transformation rules can bring something
        -- into use 'unexpectedly'
    ...

    However talking to SPJ today he mentioned that in Core we should actually preserve dependency ordering, hence this ticket.

    I'll update with a reproducer.

    Trac metadata
    Trac field Value
    Version 8.6.3
    Type Bug
    TypeOfFailure OtherFailure
    Priority normal
    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

    Child items 0

    • No child items are currently assigned. Use child items to break down this issue into smaller parts.

    Activity

    • Ömer Sinan Ağacan changed weight to 5

      changed weight to 5

    • Ömer Sinan Ağacan added Tbug Trac import labels

      added Tbug Trac import labels

    • Ömer Sinan Ağacan mentioned in merge request !1278 (closed)

      mentioned in merge request !1278 (closed)

    • Ömer Sinan Ağacan mentioned in merge request !1304 (merged)

      mentioned in merge request !1304 (merged)

    • Ömer Sinan Ağacan
      Ömer Sinan Ağacan @osa1 ·
      Author Maintainer

      A simple reproducer is the test determ006:

      module Lib where

foo :: Int -> Int
foo n =
  go (Just n) (Just (6::Int))
  where
  go Nothing (Just x) = go (Just 10) (Just x)
  go (Just n) (Just x)
    | n <= 0    = 0
    | otherwise = go (Just (n-1)) (Just x)

      Compile using !1278 (closed):

      $ ghc-stage1 Lib.hs -dcore-lint -O2 -fforce-recomp
[1 of 1] Compiling Lib              ( Lib.hs, Lib.o )
*** Core Lint errors : in result of SpecConstr ***
<no location info>: warning:
    In the expression: Just @ Int lvl_s2vQ
    Out of scope: lvl_s2vQ :: Int
                  [LclId, Str=m]
*** Offending Program ***
$trModule_s2uK :: Addr#
[LclId]
$trModule_s2uK = "main"#

$trModule_s2uL :: TrName
[LclId, Str=m1]
$trModule_s2uL = TrNameS $trModule_s2uK

$trModule_s2uM :: Addr#
[LclId]
$trModule_s2uM = "Lib"#

$trModule_s2uN :: TrName
[LclId, Str=m1]
$trModule_s2uN = TrNameS $trModule_s2uM

$trModule :: Module
[LclIdX, Str=m]
$trModule = Module $trModule_s2uL $trModule_s2uN

lvl_s2vM :: Int
[LclId, Str=m]
lvl_s2vM = I# 10#

lvl_s2vN :: Maybe Int
[LclId, Str=m2]
lvl_s2vN = Just @ Int lvl_s2vM

lvl_s2x2 :: Addr#
[LclId]
lvl_s2x2 = "Lib.hs:(7,3)-(10,42)|function go"#

lvl_s2x3 :: Int
[LclId, Str=b]
lvl_s2x3 = patError @ 'LiftedRep @ Int lvl_s2x2

Rec {
$s$wgo_s2xC :: Int# -> Int#
[LclId, Arity=1, Str=<L,U>]
$s$wgo_s2xC
  = \ (sc_s2xx :: Int#) ->
      case <=# sc_s2xx 0# of {
        __DEFAULT ->
          $wgo_s2wF (Just @ Int (I# (-# sc_s2xx 1#))) (Just @ Int lvl_s2vQ);
        1# -> 0#
      }

$s$wgo_s2xD :: Int -> Int# -> Int#
[LclId, Arity=2, Str=<L,U><L,U>]
$s$wgo_s2xD
  = \ (sc_s2xz :: Int) (sc_s2xy :: Int#) ->
      case <=# sc_s2xy 0# of {
        __DEFAULT ->
          $wgo_s2wF (Just @ Int (I# (-# sc_s2xy 1#))) (Just @ Int sc_s2xz);
        1# -> 0#
      }

$s$wgo_s2xw :: Int -> Int#
[LclId, Arity=1, Str=<L,U>]
$s$wgo_s2xw
  = \ (sc_s2xt :: Int) ->
      case sc_s2xt of { I# x_a2vd ->
      case <=# x_a2vd 0# of {
        __DEFAULT ->
          $wgo_s2wF (Just @ Int (I# (-# x_a2vd 1#))) (Just @ Int lvl_s2vQ);
        1# -> 0#
      }
      }

$wgo_s2wF [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker]
  :: Maybe Int -> Maybe Int -> Int#
[LclId,
 Arity=2,
 Str=<S,1*U><S,1*U>,
 RULES: "SC:$wgo1" [2]
            forall (sc_s2xx :: Int#).
              $wgo_s2wF (Just @ Int (I# sc_s2xx)) (Just @ Int lvl_s2vQ)
              = $s$wgo_s2xC sc_s2xx
        "SC:$wgo2" [2]
            forall (sc_s2xz :: Int) (sc_s2xy :: Int#).
              $wgo_s2wF (Just @ Int (I# sc_s2xy)) (Just @ Int sc_s2xz)
              = $s$wgo_s2xD sc_s2xz sc_s2xy
        "SC:$wgo0" [2]
            forall (sc_s2xt :: Int).
              $wgo_s2wF (Just @ Int sc_s2xt) (Just @ Int lvl_s2vQ)
              = $s$wgo_s2xw sc_s2xt]
$wgo_s2wF
  = \ (w_s2wA :: Maybe Int) (w_s2wB :: Maybe Int) ->
      case w_s2wA of {
        Nothing ->
          case w_s2wB of wild_X8 [Dmd=<L,A>] {
            Nothing -> case lvl_s2x3 of wild_00 { };
            Just x_aYO -> $wgo_s2wF lvl_s2vN wild_X8
          };
        Just n_aYP [Dmd=<S,U(U)>] ->
          case w_s2wB of wild_X9 [Dmd=<L,A>] {
            Nothing -> case lvl_s2x3 of wild_00 { };
            Just x_aYQ ->
              case n_aYP of { I# x_a2vd ->
              case <=# x_a2vd 0# of {
                __DEFAULT -> $wgo_s2wF (Just @ Int (I# (-# x_a2vd 1#))) wild_X9;
                1# -> 0#
              }
              }
          }
      }
end Rec }

go_s2vI [InlPrag=NOUSERINLINE[2]] :: Maybe Int -> Maybe Int -> Int
[LclId,
 Arity=2,
 Str=<S,U><S,U>m,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
         Tmpl= \ (w_s2wA [Occ=Once] :: Maybe Int)
                 (w_s2wB [Occ=Once] :: Maybe Int) ->
                 case $wgo_s2wF w_s2wA w_s2wB of ww_s2wE [Occ=Once] { __DEFAULT ->
                 I# ww_s2wE
                 }}]
go_s2vI
  = \ (w_s2wA :: Maybe Int) (w_s2wB :: Maybe Int) ->
      case $wgo_s2wF w_s2wA w_s2wB of ww_s2wE { __DEFAULT -> I# ww_s2wE }

lvl_s2vQ :: Int
[LclId, Str=m]
lvl_s2vQ = I# 6#

lvl_s2vR :: Maybe Int
[LclId, Str=m2]
lvl_s2vR = Just @ Int lvl_s2vQ

foo :: Int -> Int
[LclIdX,
 Arity=1,
 Str=<L,U>m,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
         Tmpl= \ (n_aXV [Occ=Once] :: Int) ->
                 go_s2vI (Just @ Int n_aXV) lvl_s2vR}]
foo
  = \ (n_aXV :: Int) ->
      case $wgo_s2wF (Just @ Int n_aXV) lvl_s2vR of ww_s2wE
      { __DEFAULT ->
      I# ww_s2wE
      }

*** End of Offense ***


<no location info>: error: 
Compilation had errors

      lvl_s2vQ is defined after being used.

    • Ömer Sinan Ağacan
      Ömer Sinan Ağacan @osa1 ·
      Author Maintainer

      The bindings that use lvl_s2vQ

                $s$wgo_s2xC
            = \ sc_s2xx ->
                case <=# sc_s2xx 0# of {
                  __DEFAULT -> $wgo_s2wF (Just (I# (-# sc_s2xx 1#))) (Just lvl_s2vQ);
                  1# -> 0#
                }
          
          $s$wgo_s2xD
            = \ sc_s2xz sc_s2xy ->
                case <=# sc_s2xy 0# of {
                  __DEFAULT -> $wgo_s2wF (Just (I# (-# sc_s2xy 1#))) (Just sc_s2xz);
                  1# -> 0#
                }
          
          $s$wgo_s2xw
            = \ sc_s2xt ->
                case sc_s2xt of { I# x_a2vd ->
                case <=# x_a2vd 0# of {
                  __DEFAULT -> $wgo_s2wF (Just (I# (-# x_a2vd 1#))) (Just lvl_s2vQ);
                  1# -> 0#
                }
                }

      are never used.

    • Ömer Sinan Ağacan
      Ömer Sinan Ağacan @osa1 ·
      Author Maintainer

      Another example is the recently added test T16066:

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

module Main (main) where

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

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

instance MonadPersist (ReaderT () IO) where
  type Transaction (ReaderT () IO) = ReaderT () STM
  atomicTransaction act = ReaderT (atomically . runReaderT act)

main :: IO ()
main = join (runReaderT doPure2 ()) >>= \x -> seq x (return ())

doPure2 :: MonadPersist m => m (IO ())
doPure2 = atomicTransaction $ do
  () <- pure ()
  () <- pure ()
  error "exit never happens"

      Build with -dcore-lint -O. Lint error caught in result of Simplifier.

    • Simon Peyton Jones mentioned in issue #16884

      mentioned in issue #16884

    • Simon Peyton Jones
      Simon Peyton Jones @simonpj ·
      Developer

      However talking to SPJ today he mentioned that in Core we should actually preserve dependency ordering, hence this ticket.

      Not so. In fact this is defintely (albeit annoyingly) false, becuause of RULES: see Note [Glomming] in OccurAnal. This won't come up in the testsuite (I guess) because (as the Note says) "NOTICE that this cannot happen for rules whose head is a locally-defined function", and I bet all regression tests have rules only for locally defined functions.

      What I intended to say is that the output of the occurrence analyser is in dependency order. If you need dependency order, run the occurrence analyser.

      Nevertheless, it very much the exception, so flagging up cases where it is false is very interesting. Your determ006 one is a bug in SpecConstr`, andI have opened #16884 to track it.

      I do not know what is happening in T16066 -- can you show the error (ie what is out of scope) and exactly which pass it follows?

      Edited by Ömer Sinan Ağacan
    • Ben Gamari added Pnormal label

      added Pnormal label

    Please register or sign in to reply