[put interactive mode into its own monad
John Meacham <john@repetae.net>**20051208063130] hunk ./FrontEnd/Class.hs 729
-      | any null tss -> fail $ "topDefaults: ambiguity " ++ (render $ pprint ps)
+      | any null tss -> fail $ " ambiguity " ++ (render $ pprint ps)
hunk ./FrontEnd/Class.hs 736
-defaults     = map (\name -> TCon (Tycon name Star))
-                   [tc_Integer, tc_Double]
+defaults
+    | not $ fopts FO.Defaulting = []
+    | otherwise = map (\name -> TCon (Tycon name Star)) [tc_Integer, tc_Double]
hunk ./FrontEnd/TIMain.hs 687
-tiProgram ::  Module -> SigEnv -> KindEnv -> ClassHierarchy -> TypeEnv -> TypeEnv -> Program -> IO TypeEnv
-tiProgram modName sEnv kt h dconsEnv env bgs = runTI dconsEnv h kt sEnv modName $
+tiProgram ::  Opt -> Module -> SigEnv -> KindEnv -> ClassHierarchy -> TypeEnv -> TypeEnv -> Program -> IO TypeEnv
+tiProgram opt modName sEnv kt h dconsEnv env bgs = runTI opt dconsEnv h kt sEnv modName $
hunk ./FrontEnd/TIMain.hs 695
-       Right s' -> do
-        env1' <- flattenType env1
-        return $  apply  s'  env1'
-       --Nothing -> return $  apply  s env1
-       Left s -> fail $ show modName ++ s
+        Right s' -> do
+            env1' <- flattenType env1
+            return $  apply  s'  env1'
+        Left s -> fail $ show modName ++ s
+        --Left _ -> do
+        --    env1' <- flattenType env1
+        --    return  env1'
hunk ./FrontEnd/TIModule.hs 247
+                (modInfoOptions tms)           -- choose options from one of recursive group
hunk ./FrontEnd/TIMonad.hs 104
-runTI :: Map.Map Name Scheme-> ClassHierarchy -> KindEnv -> SigEnv -> Module -> TI a -> IO a
-runTI env' ch' kt' st' mod' (TI tim) = do
+runTI :: Opt -> Map.Map Name Scheme-> ClassHierarchy -> KindEnv -> SigEnv -> Module -> TI a -> IO a
+runTI opt  env' ch' kt' st' mod' (TI tim) = do
hunk ./FrontEnd/TIMonad.hs 115
-        tcOptions = options,
+        tcOptions = opt,
hunk ./Interactive.hs 6
+import Control.Monad.Reader
+import Control.Monad.Trans
hunk ./Interactive.hs 62
-    stateModule :: Module
+    stateModule :: Module,
+    stateOptions :: Opt
hunk ./Interactive.hs 69
-    stateModule = Module "Main"
+    stateModule = Module "Main",
+    stateOptions = options
hunk ./Interactive.hs 73
+
+
+
+newtype In a = MkIn (ReaderT InteractiveState IO a)
+    deriving(MonadIO,Monad,Functor,MonadReader InteractiveState)
+
+runIn :: InteractiveState -> In a -> IO a
+runIn is (MkIn x) = runReaderT x is
+
+instance OptionMonad In where
+    getOptions = asks stateOptions
+
+instance MonadWarn In where
+    addWarning x = liftIO $ addWarning x
+
+
+
hunk ./Interactive.hs 135
-            catch (executeStatement isInitial { stateHo = ho, stateInteract = act } e)$ (\e -> putStrLn $ ioeGetErrorString e)
+            catch (runIn isInitial { stateHo = ho, stateInteract = act } $ executeStatement e) $ (\e -> putStrLn $ ioeGetErrorString e)
hunk ./Interactive.hs 150
-        putStrLn $ HsPretty.render $ HsPretty.ppHsStmt $  stmt
+        liftIO $ putStrLn $ HsPretty.render $ HsPretty.ppHsStmt $  stmt
+
+procErrors :: In a -> In ()
+procErrors act = do
+    b <- liftIO $ printIOErrors
+    if b then return () else act >> return ()
+
hunk ./Interactive.hs 158
-executeStatement :: InteractiveState -> HsStmt -> IO ()
-executeStatement is@IS { stateHo = ho } stmt = do
+executeStatement :: HsStmt -> In ()
+executeStatement stmt = do
+    is@IS { stateHo = ho } <- ask
hunk ./Interactive.hs 163
-    b <- printIOErrors
-    if b then return () else do
+    procErrors $ do
hunk ./Interactive.hs 167
-    b <- printIOErrors
-    if b then return () else do
+    procErrors $ do
hunk ./Interactive.hs 169
-    tcStatement is stmt'''
+    tcStatement stmt'''
hunk ./Interactive.hs 171
-tcStatement _ HsLetStmt {} = putStrLn "let statements not yet supported"
-tcStatement _ HsGenerator {} = putStrLn "generators not yet supported"
-tcStatement is@IS { stateHo = ho } (HsQualifier e) = do
+tcStatement :: HsStmt -> In ()
+tcStatement HsLetStmt {} = liftIO $ putStrLn "let statements not yet supported"
+tcStatement HsGenerator {} = liftIO $ putStrLn "generators not yet supported"
+tcStatement (HsQualifier e) = do
+    is@IS { stateHo = ho } <- ask
hunk ./Interactive.hs 180
-    localVarEnv <- tiProgram
+    opt <- getOptions
+    localVarEnv <- liftIO $ tiProgram
+                opt                            -- options
hunk ./Interactive.hs 186
-                (hoClassHierarchy ho)        -- class hierarchy with instances
+                (hoClassHierarchy ho)          -- class hierarchy with instances
hunk ./Interactive.hs 190
-    b <- printIOErrors
-    if b then return () else do
+    procErrors $ do
hunk ./Interactive.hs 192
-    putStrLn $ show (text "::" <+> pprint vv :: P.Doc)
+    liftIO $ putStrLn $ show (text "::" <+> pprint vv :: P.Doc)