+data OnOff a = On a
+ | Off a
+
+flattenLanguageFlags :: DynFlags -> DynFlags
+flattenLanguageFlags dflags
+ = case languageFlags dflags of
+ Left onoffs ->
+ dflags {
+ languageFlags = Right $ flattenLanguageFlags' onoffs
+ }
+ Right _ ->
+ panic "Flattening already-flattened language flags"
+
+ensureFlattenedLanguageFlags :: DynFlags -> DynFlags
+ensureFlattenedLanguageFlags dflags
+ = case languageFlags dflags of
+ Left onoffs ->
+ dflags {
+ languageFlags = Right $ flattenLanguageFlags' onoffs
+ }
+ Right _ ->
+ dflags
+
+-- OnOffs accumulate in reverse order, so we use foldr in order to
+-- process them in the right order
+flattenLanguageFlags' :: [OnOff LanguageFlag] -> [LanguageFlag]
+flattenLanguageFlags' = foldr f defaultLanguageFlags
+ where f (On f) flags = f : delete f flags
+ f (Off f) flags = delete f flags
+ defaultLanguageFlags = [
+ Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard
+ -- behaviour the default, to see if anyone notices
+ -- SLPJ July 06
+
+ Opt_ImplicitPrelude,
+ Opt_MonomorphismRestriction,
+ Opt_NPlusKPatterns,
+ Opt_DatatypeContexts
+ ]
+
+-- 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 LanguageFlag where
+ dopt = lopt
+ dopt_set = lopt_set
+ dopt_unset = lopt_unset
+