From 88019fb54bca4ca6cd12e4683d721aa6068b876c Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Tue, 26 Nov 2019 21:35:44 +0100
Subject: Use IntMap's in VM; doesn't actually give much speed though

---
 VM.hs | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/VM.hs b/VM.hs
index 7812afd..3d78519 100644
--- a/VM.hs
+++ b/VM.hs
@@ -4,7 +4,7 @@ import Control.Monad
 import Data.Char
 import Data.List
 import qualified Data.Map.Strict as Map
-import Data.Map.Strict ((!))
+import qualified Data.IntMap.Strict as IMap
 import System.IO
 import qualified System.IO.Error as IO
 -- import Debug.Trace
@@ -19,13 +19,13 @@ data Info =
          (Map.Map Name GlobFuncDef)  -- global functions
          [Value]  -- data table
 
-type TempMap = Map.Map Int RunValue
+type TempMap = IMap.IntMap RunValue
 
 data State = State
     { sTempMap :: TempMap
     , sArgs :: [RunValue] {- current arguments -}
     , sCloVals :: [RunValue] {- current closure -}
-    , sHandles :: Map.Map Int Handle
+    , sHandles :: IMap.IntMap Handle
     , sUniq :: Int
     }
 
@@ -46,7 +46,7 @@ vmRun :: IRProgram -> IO ()
 vmRun (IRProgram bbs gfds datas) =
     let bbmap = Map.fromList [(bidOf bb, bb) | bb <- bbs]
         info = Info bbmap gfds datas
-        state = State Map.empty [] [] (Map.fromList [(-1, stdin), (-2, stdout), (-3, stderr)]) 0
+        state = State IMap.empty [] [] (IMap.fromList [(-1, stdin), (-2, stdout), (-3, stderr)]) 0
     in IO.catchIOError (void $ vmRunBB info state (head bbs)) vmErrorHandler
 
 vmErrorHandler :: IOError -> IO ()
@@ -79,8 +79,8 @@ vmRunInstr info@(Info _ _ datas) state@(State { sTempMap = tmap, sArgs = args, s
 
 vmRunTerm :: Info -> State -> Terminator -> IO (RunValue, State)
 vmRunTerm info@(Info bbmap _ _) state@(State { sTempMap = tmap }) term = case term of
-    IBr ref b1 b2 -> vmRunBB info state . (bbmap !) $ if truthy (findRef tmap ref) then b1 else b2
-    IJmp b -> vmRunBB info state (bbmap ! b)
+    IBr ref b1 b2 -> vmRunBB info state . (bbmap Map.!) $ if truthy (findRef tmap ref) then b1 else b2
+    IJmp b -> vmRunBB info state (bbmap Map.! b)
     IRet ref -> return (findRef tmap ref, state)
     ITailC cl as -> callClosure info state cl as
     IExit -> IO.ioError (IO.userError kErrorExit)
@@ -88,14 +88,14 @@ vmRunTerm info@(Info bbmap _ _) state@(State { sTempMap = tmap }) term = case te
 
 findRef :: TempMap -> Ref -> RunValue
 findRef _ (RConst n) = RVNum n
-findRef tmap (RTemp i) = case Map.lookup i tmap of
+findRef tmap (RTemp i) = case IMap.lookup i tmap of
                              Nothing -> error "Use of declared but uninitialised variable"
                              Just v -> v
 findRef _ (RSClo name) = RVClosure name []
 findRef _ RNone = error "VM: None ref used"
 
 assignRef :: State -> Ref -> RunValue -> State
-assignRef state (RTemp i) rv = state { sTempMap = Map.insert i rv (sTempMap state) }
+assignRef state (RTemp i) rv = state { sTempMap = IMap.insert i rv (sTempMap state) }
 assignRef _ ref _ = error $ "VM: Unexpected ref " ++ show ref ++ " assigned"
 
 callClosure :: Info -> State -> Ref -> [Ref] -> IO (RunValue, State)
@@ -144,21 +144,21 @@ vmRunBuiltin state "sys-open-file" [RVNum modenum, RVString path] = do
     let mode = [ReadMode, WriteMode] !! modenum
         fid = sUniq state
     handle <- openFile (DS.unpack path) mode
-    return (RVNum fid, state { sHandles = Map.insert fid handle (sHandles state), sUniq = fid + 1 })
+    return (RVNum fid, state { sHandles = IMap.insert fid handle (sHandles state), sUniq = fid + 1 })
 vmRunBuiltin state "sys-close-file" [RVNum fid] = do
-    hClose (sHandles state ! fid)
-    return (RVList [], state { sHandles = Map.delete fid (sHandles state) })
+    hClose (sHandles state IMap.! fid)
+    return (RVList [], state { sHandles = IMap.delete fid (sHandles state) })
 vmRunBuiltin state "sys-get-char" [RVNum fid] = do
-    let h = sHandles state ! fid
+    let h = sHandles state IMap.! fid
     eof <- hIsEOF h
     if eof
         then return (RVList [], state)
         else hGetChar h >>= \ch -> return (RVString (DS.singleton ch), state)
 vmRunBuiltin state "sys-put-string" [RVNum fid, RVString str] = do
-    DS.hPutStr (sHandles state ! fid) str
+    DS.hPutStr (sHandles state IMap.! fid) str
     return (RVList [], state)
 vmRunBuiltin state "sys-flush" [RVNum fid] = do
-    hFlush (sHandles state ! fid)
+    hFlush (sHandles state IMap.! fid)
     return (RVList [], state)
 vmRunBuiltin state "sys-stdin" [] = return (RVNum (-1), state)
 vmRunBuiltin state "sys-stdout" [] = return (RVNum (-2), state)
-- 
cgit v1.2.3-54-g00ecf