[add option monad that distributes options to all the code
John Meacham <john@repetae.net>**20051208055313] hunk ./FlagOpts.flags 11
+defaulting perform defaulting of ambiguous types
hunk ./FlagOpts.flags 20
-@default inline-pragmas rules wrapper float-in strictness
+@default inline-pragmas rules wrapper float-in strictness defaulting
hunk ./FrontEnd/Class.hs 78
+import Options
+import qualified FlagOpts as FO
hunk ./FrontEnd/Class.hs 614
-splitReduce :: Monad m => ClassHierarchy -> [Tyvar] -> [Tyvar] -> [Pred] -> m ([Pred], [Pred], [(Tyvar,Type)])
+splitReduce :: OptionMonad m => ClassHierarchy -> [Tyvar] -> [Tyvar] -> [Pred] -> m ([Pred], [Pred], [(Tyvar,Type)])
hunk ./FrontEnd/Class.hs 625
-reduce :: Monad m => ClassHierarchy -> [Tyvar] -> [Tyvar] -> [Pred] -> m ([Pred], [Pred])
+reduce :: OptionMonad m => ClassHierarchy -> [Tyvar] -> [Tyvar] -> [Pred] -> m ([Pred], [Pred])
hunk ./FrontEnd/Class.hs 714
-useDefaults     :: Monad m => ClassHierarchy -> [Tyvar] -> [Pred] -> m [Pred]
-useDefaults h vs ps
-  | any null tss = fail $ "useDefaults.ambiguity: " ++ (render $ pprint ps) ++  show ps
-  | otherwise = fail $ "Zambiguity: " ++ (render $ pprint ps) ++  show (ps,ps',ams)
-  | otherwise    = return $ ps \\ ps'
-    where ams = ambig h vs ps
-          tss = [ ts | (v,qs,ts) <- ams ]
-          ps' = [ p | (v,qs,ts) <- ams, p<-qs ]
+useDefaults     :: OptionMonad m => ClassHierarchy -> [Tyvar] -> [Pred] -> m [Pred]
+useDefaults h vs ps = flagOpt FO.Defaulting >>= \b -> case b of
+ --   False -> return ps
+    _
+      | any null tss -> fail $ "useDefaults.ambiguity: " ++ (render $ pprint ps) ++  show ps
+      | otherwise -> fail $ "Zambiguity: " ++ (render $ pprint ps) ++  show (ps,ps',ams)
+--      | otherwise    = return $ ps \\ ps'
+        where ams = ambig h vs ps
+              tss = [ ts | (v,qs,ts) <- ams ]
+              ps' = [ p | (v,qs,ts) <- ams, p<-qs ]
hunk ./FrontEnd/Class.hs 725
-topDefaults     :: Monad m => ClassHierarchy -> [Pred] -> m Subst
-topDefaults h ps
-  | any null tss = fail $ "topDefaults: ambiguity " ++ (render $ pprint ps)
-  | otherwise    = return $ listToFM (zip vs (map head tss))
-    where ams = ambig h [] ps
-          tss = [ ts | (v,qs,ts) <- ams ]
-          vs  = [ v  | (v,qs,ts) <- ams ]
+topDefaults     :: OptionMonad m => ClassHierarchy -> [Pred] -> m Subst
+topDefaults h ps  =  flagOpt FO.Defaulting >>= \b -> case b of
+--    False -> return mempty
+    _
+      | any null tss -> fail $ "topDefaults: ambiguity " ++ (render $ pprint ps)
+      | otherwise    -> return $ listToFM (zip vs (map head tss))
+        where ams = ambig h [] ps
+              tss = [ ts | (v,qs,ts) <- ams ]
+              vs  = [ v  | (v,qs,ts) <- ams ]
hunk ./FrontEnd/TIMain.hs 35
+import FrontEnd.SrcLoc
hunk ./FrontEnd/TIMain.hs 39
-import FrontEnd.SrcLoc
hunk ./FrontEnd/TIMain.hs 42
+import Options
hunk ./FrontEnd/TIMain.hs 693
-     case topDefaults h rs of
+     opt <- getOptions
+     case withOptionsT opt $ topDefaults h rs of
hunk ./FrontEnd/TIMonad.hs 58
+import Options
hunk ./FrontEnd/TIMonad.hs 72
-      tcSigs              :: SigEnv
+      tcSigs              :: SigEnv,
+      tcOptions           :: Opt
hunk ./FrontEnd/TIMonad.hs 101
+instance OptionMonad TI where
+    getOptions = asks tcOptions
hunk ./FrontEnd/TIMonad.hs 115
+        tcOptions = options,
hunk ./Options.hs 2
-module Options(processOptions, Opt(..), options, putVerbose, putVerboseLn, verbose, verbose2, dump, wdump, fopts, flint, fileOptions, versionString) where
+module Options(
+    processOptions,
+    Opt(..),
+    options,
+    putVerbose,
+    putVerboseLn,
+    verbose,
+    verbose2,
+    dump,
+    wdump,
+    fopts,
+    flint,
+    fileOptions,
+    versionString,
+    withOptions,
+    withOptionsT,
+    OptM(),
+    OptT(),
+    OptionMonad(..),
+    flagOpt
+    ) where
hunk ./Options.hs 24
+import Control.Monad.Identity
+import Control.Monad.Reader
+import Control.Monad.Trans
hunk ./Options.hs 240
+
+class Monad m => OptionMonad m where
+    getOptions :: m Opt
+    getOptions = return options
+
+instance OptionMonad Identity
+
+newtype OptT m a = OptT (ReaderT Opt m a)
+    deriving(MonadIO,Monad,Functor,MonadTrans)
+
+type OptM = OptT Identity
+
+instance Monad m => OptionMonad (OptT m) where
+    getOptions = OptT ask
+
+
+
+withOptions :: Opt -> OptM a -> a
+withOptions opt (OptT x) = runIdentity (runReaderT x opt)
+
+withOptionsT :: Opt -> OptT m a -> m a
+withOptionsT opt (OptT x) = runReaderT x opt
+
+
+flagOpt :: OptionMonad m => FlagOpts.Flag -> m Bool
+flagOpt flag = do
+    opt <- getOptions
+    return (flag `S.member` optFOptsSet opt)
+
+