nmattia/snack
1
1
Fork 0
mirror of https://github.com/nmattia/snack.git synced 2024-11-24 12:16:17 +03:00
Code Issues Projects Releases Wiki Activity

Fix CPP parsing with global extensions

Browse Source
This commit is contained in:
Nicolas Mattia 2018-10-21 18:51:35 +02:00
parent 3f94647bd4
commit 6bfd266494
3 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
snack-lib/Imports.hs
View File

@ -29,10 +29,9 @@ import System.IO (stderr)
main :: IO ()
main = do
fp <- getArgs >>= \case
[fp] -> pure fp
[] -> fail "Please provide exactly one argument (got none)"
xs -> fail $ "Please provide exactly one argument, got: \n" <> unlines xs
(fp:exts) <- getArgs >>= \case
args@(_:_) -> pure args
[] -> fail "Please provide at least one argument (got none)"
-- Read the output of @--print-libdir@ for 'runGhc'
(_,Just ho1, _, hdl) <- Process.createProcess
@ -44,18 +43,25 @@ main = do
res <- GHC.runGhc (Just libdir)
$ do
-- Without this line GHC parsing fails with the following error
-- message:
-- We allow passing some extra extensions to be parsed by GHC.
-- Otherwise modules that have e.g. @RankNTypes@ enabled will fail to
-- parse. Note: if anybody gets rid of this: even without this it /is/
-- necessary to run getSessionFlags/setSessionFlags at least once,
-- otherwise GHC parsing fails with the following error message:
-- <command line>: unknown package: rts
_ <- GHC.setSessionDynFlags =<< GHC.getSessionDynFlags
dflags0 <- GHC.getSessionDynFlags
(dflags1, _leftovers, _warns) <-
DynFlags.parseDynamicFlagsCmdLine dflags0 (map (SrcLoc.mkGeneralLocated "on the commandline") exts)
_ <- GHC.setSessionDynFlags dflags1
hsc_env <- GHC.getSession
-- XXX: We need to preprocess the file so that all extensions are
-- loaded
(dflags, fp2) <- liftIO $
(dflags2, fp2) <- liftIO $
DriverPipeline.preprocess hsc_env (fp, Nothing)
_ <- GHC.setSessionDynFlags dflags
_ <- GHC.setSessionDynFlags dflags2
-- Read the file that we want to parse
str <- liftIO $ filterBOM <$> readFile fp2
@ -72,7 +78,7 @@ main = do
, show spn
]
throwIO $ HscTypes.mkSrcErr $
Bag.unitBag $ ErrUtils.mkPlainErrMsg dflags spn e
Bag.unitBag $ ErrUtils.mkPlainErrMsg dflags2 spn e
-- Extract the imports from the parsed module
let imports' =

2
snack-lib/module-spec.nix
View File

@ -47,7 +47,7 @@ rec {
modImportsNames = modName:
lib.lists.filter
(modName': ! builtins.isNull (baseByModuleName modName'))
(listModuleImports baseByModuleName modName);
(listModuleImports baseByModuleName extsByModuleName modName);
in
# TODO: DFS instead of Fold
{ f = modName:

12
snack-lib/modules.nix
View File

@ -31,9 +31,9 @@ rec {
"${singleOut base (moduleToFile mod)}/${moduleToFile mod}";
# Generate a list of haskell module names needed by the haskell file
listModuleImports = baseByModuleName: modName:
listModuleImports = baseByModuleName: extsByModuleName: modName:
builtins.fromJSON
(builtins.readFile (listAllModuleImportsJSON (baseByModuleName modName) modName))
(builtins.readFile (listAllModuleImportsJSON baseByModuleName extsByModuleName modName))
;
# Whether the file is a Haskell module or not. It uses very simple
@ -51,8 +51,12 @@ rec {
# Lists all module dependencies, not limited to modules existing in this
# project
listAllModuleImportsJSON = base: modName:
listAllModuleImportsJSON = baseByModuleName: extsByModuleName: modName:
let
base = baseByModuleName modName;
modExts =
lib.strings.escapeShellArgs
(map (x: "-X${x}") (extsByModuleName modName));
ghc = haskellPackages.ghcWithPackages (ps: [ ps.ghc ]);
importParser = runCommand "import-parser"
{ buildInputs = [ ghc ];
@ -65,6 +69,6 @@ rec {
}
''
${importParser} ${singleOutModulePath base modName} > $out
${importParser} ${singleOutModulePath base modName} ${modExts} > $out
'';
}