diff options
author | Zubin Duggal <zubin.duggal@gmail.com> | 2021-05-18 17:59:50 +0530 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-05-25 05:51:26 -0400 |
commit | 6ce8e68753da41a444021e84405c153eb3d70a67 (patch) | |
tree | aa9c6b2f9ef80597f0a439f1eabd3bc32fad7e08 | |
parent | f243acf4d7322a15e9eb6e432c490a4d6db741df (diff) | |
download | haskell-6ce8e68753da41a444021e84405c153eb3d70a67.tar.gz |
Make tcIfaceCompleteMatch lazier.
Insufficient lazyness causes a loop while typechecking
COMPLETE pragmas from interfaces (#19744).
-rw-r--r-- | compiler/GHC/IfaceToCore.hs | 15 | ||||
-rw-r--r-- | testsuite/tests/driver/T19744/Client.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/driver/T19744/Makefile | 8 | ||||
-rw-r--r-- | testsuite/tests/driver/T19744/Mod.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/driver/T19744/T19744.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/driver/T19744/all.T | 2 |
6 files changed, 40 insertions, 2 deletions
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs index 66a143b0b4..bf40b2947c 100644 --- a/compiler/GHC/IfaceToCore.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -1291,13 +1291,24 @@ tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch] tcIfaceCompleteMatches = mapM tcIfaceCompleteMatch tcIfaceCompleteMatch :: IfaceCompleteMatch -> IfL CompleteMatch -tcIfaceCompleteMatch (IfaceCompleteMatch ms mtc) = do - conlikes <- mkUniqDSet <$> mapM (forkM doc . tcIfaceConLike) ms +tcIfaceCompleteMatch (IfaceCompleteMatch ms mtc) = forkM doc $ do -- See Note [Positioning of forkM] + conlikes <- mkUniqDSet <$> mapM tcIfaceConLike ms mtc' <- traverse tcIfaceTyCon mtc return (CompleteMatch conlikes mtc') where doc = text "COMPLETE sig" <+> ppr ms +{- Note [Positioning of forkM] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We need to be lazy when type checking the interface, since these functions are +called when the interface itself is being loaded, which means it is not in the +PIT yet. If we are not lazy enough, in certain cases we might recursively try to +load the same interface in an infinite loop. + +For this reason, the forkM should be around as much of the computation as +possible. +-} + {- ************************************************************************ * * diff --git a/testsuite/tests/driver/T19744/Client.hs b/testsuite/tests/driver/T19744/Client.hs new file mode 100644 index 0000000000..4c291f6221 --- /dev/null +++ b/testsuite/tests/driver/T19744/Client.hs @@ -0,0 +1,7 @@ +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module Client where + +import Mod + +f :: T -> T +f D = D diff --git a/testsuite/tests/driver/T19744/Makefile b/testsuite/tests/driver/T19744/Makefile new file mode 100644 index 0000000000..58917564e3 --- /dev/null +++ b/testsuite/tests/driver/T19744/Makefile @@ -0,0 +1,8 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T19744: + '$(TEST_HC)' Mod.hs + '$(TEST_HC)' Client.hs + diff --git a/testsuite/tests/driver/T19744/Mod.hs b/testsuite/tests/driver/T19744/Mod.hs new file mode 100644 index 0000000000..f40a9c6fb4 --- /dev/null +++ b/testsuite/tests/driver/T19744/Mod.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE PatternSynonyms #-} +module Mod where + +data T = C + +pattern D = C + +{-# COMPLETE D :: T #-} diff --git a/testsuite/tests/driver/T19744/T19744.stdout b/testsuite/tests/driver/T19744/T19744.stdout new file mode 100644 index 0000000000..80cc624f31 --- /dev/null +++ b/testsuite/tests/driver/T19744/T19744.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling Mod ( Mod.hs, Mod.o ) +[2 of 2] Compiling Client ( Client.hs, Client.o ) diff --git a/testsuite/tests/driver/T19744/all.T b/testsuite/tests/driver/T19744/all.T new file mode 100644 index 0000000000..ccc410dfc2 --- /dev/null +++ b/testsuite/tests/driver/T19744/all.T @@ -0,0 +1,2 @@ +srcs = ['Mod.hs', 'Client.hs'] +test('T19744', [run_timeout_multiplier(0.1),extra_files(srcs)], makefile_test, []) |