blob: 2837cac62d6a827ae695c89d4aedf3f70b6c8fc7 (
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
|
{-# OPTIONS_GHC -Wno-missing-fields #-}
import GHC hiding (parseModule)
import GHC.Data.StringBuffer
import GHC.Driver.Config.Parser
import GHC.Parser
import GHC.Parser.Lexer
import GHC.Platform
import GHC.Plugins
import GHC.Settings
import GHC.Settings.Config
fakeSettings :: Settings
fakeSettings =
Settings
{ sGhcNameVersion =
GhcNameVersion
{ ghcNameVersion_programName =
"ghc",
ghcNameVersion_projectVersion =
cProjectVersion
},
sFileSettings =
FileSettings {},
sToolSettings = ToolSettings {},
sTargetPlatform =
genericPlatform,
sPlatformMisc = PlatformMisc {}
}
fakeDynFlags :: DynFlags
fakeDynFlags = defaultDynFlags fakeSettings
parse :: DynFlags -> String -> IO (Located (HsModule GhcPs))
parse dflags src = do
let buf = stringToStringBuffer src
let loc = mkRealSrcLoc (mkFastString "Main.hs") 1 1
case unP parseModule (initParserState (initParserOpts dflags) buf loc) of
PFailed _ -> fail "parseModule failed"
POk _ rdr_module -> pure rdr_module
main :: IO ()
main = do
m <- parse fakeDynFlags "main = putStrLn \"hello world\""
putStrLn $ showSDoc fakeDynFlags $ ppr m
|
