blob: 3b14cc1d8ab0936fde0ea8d488996c767011ceb3 (
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
|
{-# LANGUAGE TemplateHaskell, ExplicitForAll, PolyKinds #-}
module Main where
import Language.Haskell.TH (runQ)
import GHC.Types.Basic
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.Types
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
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
((warnings, errors), mres) <-
tcRnType hsc_env SkolemiseFlexi True hs_t
case mres of
Nothing -> do
printBagOfErrors dflags warnings
printBagOfErrors dflags errors
Just (t, _) -> do
putStrLn $ showSDoc dflags (debugPprType t)
|
