Fix #12073: Add MonadFix Q instance

3 files changed, 36 insertions, 0 deletions

diff --git a/testsuite/tests/th/T12073.hs b/testsuite/tests/th/T12073.hs
new file mode 100644
index 0000000000..2af76a6730
--- /dev/null
+++ b/testsuite/tests/th/T12073.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+
+import Control.Monad.Fix
+import Language.Haskell.TH
+import Control.Monad.State
+
+-- Direct variant
+$([d|
+  f1, f2 :: Integer -> [Integer]
+  f1 = \z -> z : f2 (succ z)
+  f2 = \z -> z : f1 (z * z)
+  |])
+
+-- Using mfix.
+-- This is a contrived example, but it fits into a single splice
+$(fmap (\(x,x',y,y') ->
+    [ ValD (VarP x') (NormalB x) []
+    , ValD (VarP y') (NormalB y) []
+    ]) $
+  mfix $ \ ~(_,x',_,y') -> do
+    x <- [| \z -> z : $(return $ VarE y') (succ z) |]
+    y <- [| \z -> z : $(return $ VarE x') (z * z)  |]
+    x'' <- newName "g1"
+    y'' <- newName "g2"
+    return (x, x'', y, y'')
+ )
+
+
+main :: IO ()
+main = do
+    print $ take 11 $ f1 0
+    print $ take 11 $ g1 0
diff --git a/testsuite/tests/th/T12073.stdout b/testsuite/tests/th/T12073.stdout
new file mode 100644
index 0000000000..15c42f3745
--- /dev/null
+++ b/testsuite/tests/th/T12073.stdout
@@ -0,0 +1,2 @@
+[0,1,1,2,4,5,25,26,676,677,458329]
+[0,1,1,2,4,5,25,26,676,677,458329]
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 83844ad396..46fbcf7073 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -364,6 +364,7 @@ test('T11629', normal, compile, ['-v0'])
 test('T8761', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T12045TH1', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T12045TH2', normal, compile, ['-v0'])
+test('T12073', normal, compile_and_run, [''])
 test('T12130', [], multimod_compile,
      ['T12130', '-v0 ' + config.ghc_th_way_flags])
 test('T12387', normal, compile_fail, ['-v0'])