3 files changed, 62 insertions, 0 deletions
diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile
index 448331fc38..58f3609cc9 100644
--- a/testsuite/tests/codeGen/should_compile/Makefile
+++ b/testsuite/tests/codeGen/should_compile/Makefile
@@ -31,6 +31,9 @@ debug:
 	./debug
 	rm debug
 
+T13233_orig:
+	'$(TEST_HC)' $(TEST_HC_OPTS) T13233_orig -fforce-recomp -prof -fprof-auto-exported -v0
+
 T14999:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -O2 -g -c T14999.cmm -o T14999.o
 	gdb --batch -ex 'file T14999.o' -ex 'disassemble stg_catch_frame_info' --nx | tr -s '[[:blank:]\n]'
diff --git a/testsuite/tests/codeGen/should_compile/T13233_orig.hs b/testsuite/tests/codeGen/should_compile/T13233_orig.hs
new file mode 100644
index 0000000000..e9447ec2c0
--- /dev/null
+++ b/testsuite/tests/codeGen/should_compile/T13233_orig.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module T13233_orig where
+
+import Control.Monad ( ap, liftM )
+
+newtype FCode a = FCode (CgInfoDownwards -> CgState -> (# a, CgState #))
+
+data CgInfoDownwards
+  = MkCgInfoDown { cgd_dflags :: DynFlags }
+
+data CgState = MkCgState
+
+returnFC :: a -> FCode a
+returnFC val = FCode (\_info_down state -> (# val, state #))
+
+thenC :: FCode () -> FCode a -> FCode a
+thenC (FCode m) (FCode k) =
+  FCode $ \ info_down state ->
+    case m info_down state of
+      (# _, new_state #) -> k info_down new_state
+
+thenFC :: FCode a -> (a -> FCode c) -> FCode c
+thenFC (FCode m) k =
+  FCode $ \ info_down state ->
+    case m info_down state of
+      (# m_result, new_state #) ->
+        case k m_result of
+          FCode kcode -> kcode info_down new_state
+
+infixr 9 `thenC`
+infixr 9 `thenFC`
+{-# INLINE thenC #-}
+{-# INLINE thenFC #-}
+{-# INLINE returnFC #-}
+
+instance Functor FCode where
+  fmap f (FCode g) =
+    FCode $ \ i s -> case g i s of (# a, s' #) -> (# f a, s' #)
+
+instance Applicative FCode where
+  pure = returnFC
+  (<*>) = ap
+
+instance Monad FCode where
+  (>>=) = thenFC
+
+instance HasDynFlags FCode where
+  getDynFlags = liftM cgd_dflags getInfoDown
+
+getInfoDown :: FCode CgInfoDownwards
+getInfoDown = FCode $ \ info_down state -> (# info_down, state #)
+
+class HasDynFlags m where
+  getDynFlags :: m DynFlags
+
+data DynFlags = DynFlags
diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T
index 0e89b1d82c..3c76163582 100644
--- a/testsuite/tests/codeGen/should_compile/all.T
+++ b/testsuite/tests/codeGen/should_compile/all.T
@@ -33,6 +33,7 @@ test('T10518', [cmm_src], compile, ['-no-hs-main'])
 test('T10667', normal, compile, ['-g'])
 test('T12115', normal, compile, [''])
 test('T12355', normal, compile, [''])
+test('T13233_orig', [unless(have_profiling(), skip)], makefile_test, [])
 test('T14999',
      [when(unregisterised(), skip),
       unless(opsys('linux') and arch('x86_64') and have_gdb() and