PostTcType replaced with TypeAnnot

Summary:
This is a first step toward allowing generic traversals of the AST without 'landmines', by removing the `panic`s located throughout `placeHolderType`, `placeHolderKind` & co.

See more on the discussion at https://www.mail-archive.com/ghc-devs@haskell.org/msg05564.html

(This also makes a corresponding update to the `haddock` submodule.)

Test Plan: `sh validate` and new tests pass.

Reviewers: austin, simonpj, goldfire

Reviewed By: austin, simonpj, goldfire

Subscribers: edsko, Fuuzetsu, thomasw, holzensp, goldfire, simonmar, relrod, ezyang, carter

Projects: #ghc

Differential Revision: https://phabricator.haskell.org/D157

9 files changed, 206 insertions, 0 deletions

diff --git a/testsuite/tests/ghc-api/landmines/.gitignore b/testsuite/tests/ghc-api/landmines/.gitignore
new file mode 100644
index 0000000000..1452e78bbd
--- /dev/null
+++ b/testsuite/tests/ghc-api/landmines/.gitignore
@@ -0,0 +1,5 @@
+landmines
+*.hi
+*.o
+*.run.*
+*.normalised
diff --git a/testsuite/tests/ghc-api/landmines/Makefile b/testsuite/tests/ghc-api/landmines/Makefile
new file mode 100644
index 0000000000..3197647a49
--- /dev/null
+++ b/testsuite/tests/ghc-api/landmines/Makefile
@@ -0,0 +1,13 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean:
+	rm -f *.o *.hi
+
+landmines: clean
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc landmines
+	./landmines "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
+
+
+.PHONY: clean
diff --git a/testsuite/tests/ghc-api/landmines/MineFixity.hs b/testsuite/tests/ghc-api/landmines/MineFixity.hs
new file mode 100644
index 0000000000..a735ee6aaf
--- /dev/null
+++ b/testsuite/tests/ghc-api/landmines/MineFixity.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+{-
+
+Exercising avoidance of known landmines.
+
+We need one each of
+
+  PostTc id Kind
+  PostTc id Type
+
+  PostRn id Fixity
+  PostRn id NameSet
+
+
+-}
+module MineFixity where
+
+infixl 3 `foo`
+
+foo = undefined
diff --git a/testsuite/tests/ghc-api/landmines/MineKind.hs b/testsuite/tests/ghc-api/landmines/MineKind.hs
new file mode 100644
index 0000000000..c97a996c66
--- /dev/null
+++ b/testsuite/tests/ghc-api/landmines/MineKind.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+{-
+
+Exercising avoidance of known landmines.
+
+We need one each of
+
+  PostTc id Kind
+  PostTc id Type
+
+  PostRn id Fixity
+  PostRn id NameSet
+
+
+-}
+module MineKind where
+
+data HList :: [*] -> * where
+  HNil  :: HList '[]
+  HCons :: a -> HList t -> HList (a ': t)
+
+data Tuple :: (*,*) -> * where
+  Tuple :: a -> b -> Tuple '(a,b)
diff --git a/testsuite/tests/ghc-api/landmines/MineNames.hs b/testsuite/tests/ghc-api/landmines/MineNames.hs
new file mode 100644
index 0000000000..af5362fc37
--- /dev/null
+++ b/testsuite/tests/ghc-api/landmines/MineNames.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+{-
+
+Exercising avoidance of known landmines.
+
+We need one each of
+
+  PostTc id Kind
+  PostTc id Type
+
+  PostRn id Fixity
+  PostRn id NameSet
+
+
+-}
+module MineNames where
+
+foo :: Int
+foo = 1
diff --git a/testsuite/tests/ghc-api/landmines/MineType.hs b/testsuite/tests/ghc-api/landmines/MineType.hs
new file mode 100644
index 0000000000..142d7c9af7
--- /dev/null
+++ b/testsuite/tests/ghc-api/landmines/MineType.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+{-
+
+Exercising avoidance of known landmines.
+
+We need one each of
+
+  PostTc id Kind
+  PostTc id Type
+
+  PostRn id Fixity
+  PostRn id NameSet
+
+
+-}
+module MineType where
+
+foo = undefined
diff --git a/testsuite/tests/ghc-api/landmines/all.T b/testsuite/tests/ghc-api/landmines/all.T
new file mode 100644
index 0000000000..b03a97f0ae
--- /dev/null
+++ b/testsuite/tests/ghc-api/landmines/all.T
@@ -0,0 +1,2 @@
+test('landmines', normal, run_command, ['$MAKE -s --no-print-directory landmines'])
+
diff --git a/testsuite/tests/ghc-api/landmines/landmines.hs b/testsuite/tests/ghc-api/landmines/landmines.hs
new file mode 100644
index 0000000000..9b058fa8a8
--- /dev/null
+++ b/testsuite/tests/ghc-api/landmines/landmines.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE RankNTypes #-}
+
+-- This program must be called with GHC's libdir as the single command line
+-- argument.
+module Main where
+
+-- import Data.Generics
+import Data.Data
+import System.IO
+import GHC
+import MonadUtils
+import Outputable
+import Bag (filterBag,isEmptyBag)
+import System.Directory (removeFile)
+import System.Environment( getArgs )
+
+main::IO()
+main = do
+        [libdir] <- getArgs
+        testOneFile libdir "MineFixity"
+        testOneFile libdir "MineKind"
+        testOneFile libdir "MineNames"
+        testOneFile libdir "MineType"
+
+
+testOneFile libdir fileName = do
+        (p,r,ts) <- runGhc (Just libdir) $ do
+                        dflags <- getSessionDynFlags
+                        setSessionDynFlags dflags
+                        let mn =mkModuleName fileName
+                        addTarget Target { targetId = TargetModule mn
+                                         , targetAllowObjCode = True
+                                         , targetContents = Nothing }
+                        load LoadAllTargets
+                        modSum <- getModSummary mn
+                        p <- parseModule modSum
+                        t <- typecheckModule p
+                        d <- desugarModule t
+                        l <- loadModule d
+                        let ts=typecheckedSource l
+                            r =renamedSource l
+                        -- liftIO (putStr (showSDocDebug (ppr ts)))
+                        return (pm_parsed_source p,r,ts)
+        let pCount = gq p
+            rCount = gq r
+            tsCount = gq ts
+
+        print (pCount,rCount,tsCount)
+    where
+        gq ast = length $ everything (++)    ([] `mkQ` worker) ast
+
+        worker (s@(RealSrcSpan _)) = [s]
+        worker _ = []
+
+-- ---------------------------------------------------------------------
+
+-- Copied from syb for the test
+
+
+-- | Generic queries of type \"r\",
+--   i.e., take any \"a\" and return an \"r\"
+--
+type GenericQ r = forall a. Data a => a -> r
+
+
+-- | Make a generic query;
+--   start from a type-specific case;
+--   return a constant otherwise
+--
+mkQ :: ( Typeable a
+       , Typeable b
+       )
+    => r
+    -> (b -> r)
+    -> a
+    -> r
+(r `mkQ` br) a = case cast a of
+                        Just b  -> br b
+                        Nothing -> r
+
+
+
+-- | Summarise all nodes in top-down, left-to-right order
+everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
+
+-- Apply f to x to summarise top-level node;
+-- use gmapQ to recurse into immediate subterms;
+-- use ordinary foldl to reduce list of intermediate results
+
+everything k f x = foldl k (f x) (gmapQ (everything k f) x)
diff --git a/testsuite/tests/ghc-api/landmines/landmines.stdout b/testsuite/tests/ghc-api/landmines/landmines.stdout
new file mode 100644
index 0000000000..5d9fd71ea2
--- /dev/null
+++ b/testsuite/tests/ghc-api/landmines/landmines.stdout
@@ -0,0 +1,4 @@
+(9,9,6)
+(46,42,0)
+(11,10,6)
+(7,7,6)