+data OnOff a = On a
+ | Off a
+
+flattenExtensionFlags :: DynFlags -> DynFlags
+flattenExtensionFlags dflags
+ = case extensionFlags dflags of
+ Left onoffs ->
+ dflags {
+ extensionFlags = Right $ flattenExtensionFlags' (language dflags) onoffs
+ }
+ Right _ ->
+ panic "Flattening already-flattened extension flags"
+
+ensureFlattenedExtensionFlags :: DynFlags -> DynFlags
+ensureFlattenedExtensionFlags dflags
+ = case extensionFlags dflags of
+ Left onoffs ->
+ dflags {
+ extensionFlags = Right $ flattenExtensionFlags' (language dflags) onoffs
+ }
+ Right _ ->
+ dflags
+
+-- OnOffs accumulate in reverse order, so we use foldr in order to
+-- process them in the right order
+flattenExtensionFlags' :: Maybe Language -> [OnOff ExtensionFlag]
+ -> [ExtensionFlag]
+flattenExtensionFlags' ml = foldr f defaultExtensionFlags
+ where f (On f) flags = f : delete f flags
+ f (Off f) flags = delete f flags
+ defaultExtensionFlags = languageExtensions ml
+
+languageExtensions :: Maybe Language -> [ExtensionFlag]
+languageExtensions Nothing
+ = Opt_MonoPatBinds -- Experimentally, I'm making this non-standard
+ -- behaviour the default, to see if anyone notices
+ -- SLPJ July 06
+ : languageExtensions (Just Haskell2010)
+languageExtensions (Just Haskell98)
+ = [Opt_ImplicitPrelude,
+ Opt_MonomorphismRestriction,
+ Opt_NPlusKPatterns,
+ Opt_DatatypeContexts]
+languageExtensions (Just Haskell2010)
+ = [Opt_ImplicitPrelude,
+ Opt_MonomorphismRestriction,
+ Opt_DatatypeContexts,
+ Opt_EmptyDataDecls,
+ Opt_ForeignFunctionInterface,
+ Opt_PatternGuards,
+ Opt_RelaxedPolyRec]
+
+-- The DOpt class is a temporary workaround, to avoid having to do
+-- a mass-renaming dopt->lopt at the moment
+class DOpt a where
+ dopt :: a -> DynFlags -> Bool
+ dopt_set :: DynFlags -> a -> DynFlags
+ dopt_unset :: DynFlags -> a -> DynFlags
+
+instance DOpt DynFlag where
+ dopt = dopt'
+ dopt_set = dopt_set'
+ dopt_unset = dopt_unset'
+
+instance DOpt ExtensionFlag where
+ dopt = lopt
+ dopt_set = lopt_set
+ dopt_unset = lopt_unset
+