Rewrite rules not applied exhaustively when simplifying from plugin

Consider this program:

{-# OPTIONS_GHC -O -fplugin TestPlugin #-}
module Test where

foo :: Int -> Int
foo = id
{-# INLINE [0] foo #-}

{-# RULES
"foo1" [1] foo 1 = foo 2
"foo2" [1] foo 2 = foo 3
 #-}

fun :: Int -> Int -> Int
fun = (+)
{-# NOINLINE fun #-}

test = foo 1 `fun` foo 2

I would expect that one run of the simplifier in phase 1 will turn this into

test = foo 3 `fun` foo 3

I am using this plugin to test this:

module TestPlugin where

import System.Exit
import Control.Monad

import GhcPlugins
import Simplify
import CoreStats
import SimplMonad
import FamInstEnv
import SimplEnv

-- Plugin boiler plate

plugin :: Plugin
plugin = defaultPlugin { installCoreToDos = install }

install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ (simpl:xs) = return $ simpl : pass : xs
  where pass = CoreDoPluginPass "Test" testPass

-- The plugin

testPass :: ModGuts -> CoreM ModGuts
testPass guts = do
    let [expr] = [ e | NonRec v e <- mg_binds guts
                     , occNameString (occName v) == "test" ]
    simplified_expression <- simplify guts expr

    putMsg $
        text "Test" $$
        nest 4 (hang (text "Before" <> colon) 4 (ppr expr)) $$
        nest 4 (hang (text "After" <> colon) 4 (ppr simplified_expression))

    liftIO $ exitFailure

-- A simplifier

simplify :: ModGuts -> CoreExpr -> CoreM CoreExpr
simplify guts expr = do
    dflags <- getDynFlags

    let dflags' = dflags { ufVeryAggressive = True }
    us <- liftIO $ mkSplitUniqSupply 's'
    let sz = exprSize expr

    rule_base <- getRuleBase
    vis_orphs <- getVisibleOrphanMods
    let rule_base2 = extendRuleBaseList rule_base (mg_rules guts)
    let rule_env = RuleEnv rule_base2 vis_orphs

    (expr', _) <- liftIO $ initSmpl dflags' rule_env emptyFamInstEnvs us sz $
        simplExpr (simplEnv 1) >=> simplExpr (simplEnv 1) $
        expr
    return expr'

simplEnv :: Int -> SimplEnv
simplEnv p = mkSimplEnv $ SimplMode { sm_names = ["Test"]
                                    , sm_phase = Phase p
                                    , sm_rules = True
                                    , sm_inline = True
                                    , sm_eta_expand = True
                                    , sm_case_case = True }

But I get:

$ ghc-head -package ghc Test.hs
[1 of 2] Compiling TestPlugin       ( TestPlugin.hs, TestPlugin.o )
[2 of 2] Compiling Test             ( Test.hs, Test.o )
Test
    Before: fun (foo (GHC.Types.I# 1#)) (foo (GHC.Types.I# 2#))
    After: fun (foo (GHC.Types.I# 2#)) (foo (GHC.Types.I# 3#))

If I however compile this without the plugin, and look at what’s happening with -dverbose-core2core, I observe this:

…
test :: Int
test = fun (foo (GHC.Types.I# 1#)) (foo (GHC.Types.I# 2#))
…
==================== Simplifier ====================
  Max iterations = 4
  SimplMode {Phase = 1 [main],
             inline,
             rules,
             eta-expand,
             case-of-case}
…
test :: Int
test = fun (foo (GHC.Types.I# 3#)) (foo (GHC.Types.I# 3#))
…

So what am I doing wrong in my plugin? Any help is appreciated.

Trac metadata

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