Changeset 2433 for src/Main.hs

Timestamp:

04/28/05 13:59:35 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

3914

Message:

* STMification: All our IORefs are now TVars.

Files:

• src/Main.hs (modified) (9 diffs)

src/Main.hs

@@ -93 +93 @@
 dumpGlob :: String -> IO ()
 dumpGlob = (doParseWith $ \env _ -> do
-    glob <- readIORef $ envGlobal env
+    glob <- liftSTM $ readTVar $ envGlobal env
     print $ userDefined glob) "-"
 
@@ -105 +105 @@
 repLoop = do
     initializeShell
-    env <- tabulaRasa >>= newIORef
-    modifyIORef env $ \e -> e{ envDebug = Nothing }
+    env <- liftSTM . newTVar . (\e -> e{ envDebug = Nothing }) =<< tabulaRasa
     fix $ \loop -> do
         command <- getCommand
@@ -115 +114 @@
             CmdParse prog     -> doParse "<interactive>" prog >> loop
             CmdHelp           -> printInteractiveHelp >> loop
-            CmdReset          -> tabulaRasa >>= writeIORef env >> loop
+            CmdReset          -> tabulaRasa >>= (liftSTM . writeTVar env) >> loop
 
 tabulaRasa :: IO Env
@@ -131 +130 @@
 doCompile :: [Char] -> FilePath -> String -> IO ()
 doCompile backend = doParseWith $ \env _ -> do
-    glob    <- readIORef $ envGlobal env
-    globRef <- newIORef $ userDefined glob
-    str  <- compile backend env{ envGlobal = globRef }
+    globRef <- liftSTM $ do
+        glob <- readTVar $ envGlobal env
+        newTVar $ userDefined glob
+    str     <- compile backend env{ envGlobal = globRef }
     writeFile "dump.ast" str
 
@@ -154 +154 @@
         exp -> putStrLn $ pretty exp
 
-doLoad :: IORef Env -> String -> IO ()
+doLoad :: TVar Env -> String -> IO ()
 doLoad env fn = do
     runImperatively env (evaluate exp)
@@ -161 +161 @@
     exp = App "&require" [] [Val $ VStr fn]
 
-doRunSingle :: IORef Env -> RunOptions -> String -> IO ()
+doRunSingle :: TVar Env -> RunOptions -> String -> IO ()
 doRunSingle menv opts prog = (`catch` handler) $ do
     exp     <- makeProper =<< parse
@@ -168 +168 @@
     result  <- case rv of
         VControl (ControlEnv env') -> do
-            glob    <- readIORef $ envGlobal env'
+            glob    <- liftSTM . readTVar $ envGlobal env'
             ref     <- findSymRef "$*_" glob
             val     <- runEval env' $ readRef ref
-            writeIORef menv env'
+            liftSTM $ writeTVar menv env'
             return val
         _ -> return rv
@@ -177 +177 @@
     where
     parse = do
-        env <- readIORef menv
+        env <- liftSTM $ readTVar menv
         runRule env (return . envBody) ruleProgram "<interactive>" (decodeUTF8 prog)
     theEnv = do
         ref <- if runOptSeparately opts
-                then tabulaRasa >>= newIORef
+                then (liftSTM . newTVar) =<< tabulaRasa
                 else return menv
         debug <- if runOptDebug opts
-                then liftM Just (newIORef Map.empty)
+                then fmap Just (liftSTM $ newTVar Map.empty)
                 else return Nothing
-        modifyIORef ref $ \e -> e{ envDebug = debug }
+        liftSTM $ modifyTVar ref $ \e -> e{ envDebug = debug }
         return ref
     printer env = if runOptShowPretty opts
@@ -206 +206 @@
         putStrLn $ ioeGetErrorString err
 
-runImperatively :: IORef Env -> Eval Val -> IO Val
+runImperatively :: TVar Env -> Eval Val -> IO Val
 runImperatively menv eval = do
-    env <- readIORef menv
+    env <- liftSTM $ readTVar menv
     runEval env $ do
         val <- eval
         newEnv <- ask
-        liftIO $ writeIORef menv newEnv
+        liftSTM $ writeTVar menv newEnv
         return val