blob: e0b6a57764afc98d93303f767390b6f470e1d556 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
{-# LANGUAGE TemplateHaskell, ExplicitForAll, PolyKinds #-}
module Main where
import Language.Haskell.TH (runQ)
import GHC.Types.Basic
import GHC.Types.Error
import GHC.ThToHs
import GHC.Driver.Session
import GHC.Core.TyCo.Ppr
import GHC.Utils.Outputable
import GHC.Tc.Module
import GHC.Tc.Utils.Zonk
import GHC.Utils.Error
import GHC.Driver.Ppr
import GHC.Driver.Env
import GHC.Driver.Errors
import GHC
import qualified GHC.LanguageExtensions as LangExt
import Data.Either (fromRight)
import Control.Monad.IO.Class (liftIO)
import System.Environment (getArgs)
main :: IO ()
main = do
[libdir] <- getArgs
runGhc (Just libdir) $ do
initial_dflags <- getSessionDynFlags
setSessionDynFlags $ initial_dflags
`dopt_set` Opt_D_ppr_debug
`gopt_set` Opt_SuppressUniques
`gopt_set` Opt_SuppressModulePrefixes
`gopt_set` Opt_SuppressVarKinds
`xopt_set` LangExt.KindSignatures
`xopt_set` LangExt.PolyKinds
`xopt_set` LangExt.RankNTypes
hsc_env <- getSession
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
liftIO $ do
th_t <- runQ [t| forall k {j}.
forall (a :: k) (b :: j) ->
() |]
let hs_t = fromRight (error "convertToHsType") $
convertToHsType Generated noSrcSpan th_t
(messages, mres) <-
tcRnType hsc_env SkolemiseFlexi True hs_t
let (warnings, errors) = partitionMessages messages
case mres of
Nothing -> do
printBagOfErrors logger dflags warnings
printBagOfErrors logger dflags errors
Just (t, _) -> do
putStrLn $ showSDoc dflags (debugPprType t)
|
