Skip to content

Commit

Permalink
enable implied extensions
Browse files Browse the repository at this point in the history
  • Loading branch information
shayne-fletcher committed Dec 15, 2024
1 parent 3145e86 commit 2598890
Showing 1 changed file with 19 additions and 2 deletions.
21 changes: 19 additions & 2 deletions src/GHC/All.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ import Control.Monad.Trans.Except
import Control.Monad.IO.Class
import Util
import Data.Char
import Data.List
import Data.List.NonEmpty qualified as NE
import Data.List.Extra
import Timing
Expand All @@ -39,6 +40,8 @@ import Data.Generics.Uniplate.DataOnly

import Language.Haskell.GhclibParserEx.GHC.Parser
import Language.Haskell.GhclibParserEx.Fixity
import Language.Haskell.GhclibParserEx.GHC.Driver.Session

import GHC.Util

-- | What C pre processor should be used.
Expand Down Expand Up @@ -131,7 +134,7 @@ ghcFixitiesFromParseFlags = map toFixity . fixities

parseModeToFlags :: ParseFlags -> DynFlags
parseModeToFlags parseMode =
flip lang_set (baseLanguage parseMode) $ foldl' xopt_unset (foldl' xopt_set baseDynFlags enable) disable
flip lang_set (baseLanguage parseMode) $ foldl xopt_unset (foldl' xopt_set baseDynFlags enable) disable
where
(enable, disable) = ghcExtensionsFromParseFlags parseMode

Expand Down Expand Up @@ -163,6 +166,16 @@ createModuleExWithFixities :: [(String, Fixity)] -> Located (HsModule GhcPs) ->
createModuleExWithFixities fixities ast =
ModuleEx (applyFixities (fixitiesFromModule ast ++ fixities) ast)

impliedEnables :: Extension -> [Extension]
impliedEnables ext = case Data.List.lookup ext extensionImplications of
Just exts -> ext : fst exts
Nothing -> [ext]

impliedDisables :: Extension -> [Extension]
impliedDisables ext = case Data.List.lookup ext extensionImplications of
Just exts -> ext : snd exts
Nothing -> []

-- | Parse a Haskell module. Applies the C pre processor, and uses
-- best-guess fixity resolution if there are ambiguities. The
-- filename @-@ is treated as @stdin@. Requires some flags (often
Expand All @@ -179,7 +192,11 @@ parseModuleEx flags file str = timedIO "Parse" file $ runExceptT $ do
Nothing | file == "-" -> liftIO getContentsUTF8
| otherwise -> liftIO $ readFileUTF8' file
str <- pure $ dropPrefix "\65279" str -- Remove the BOM if it exists, see #130.
let enableDisableExts = ghcExtensionsFromParseFlags flags
let (enable, disable) = ghcExtensionsFromParseFlags flags
-- Enable/disable extensions and the extensions they imply.
impliedEnabled = concatMap impliedEnables enable
impliedDisabled = concatMap impliedDisables disable
enableDisableExts = (impliedEnabled, impliedDisabled)
-- Read pragmas for the first time.
dynFlags <- withExceptT (parsePragmasErr str) $ ExceptT (parsePragmasIntoDynFlags baseDynFlags enableDisableExts file str)
dynFlags <- pure $ lang_set dynFlags $ baseLanguage flags
Expand Down

0 comments on commit 2598890

Please sign in to comment.