Use Maps for things that should be maps

fco2/Parse.hs

@@ -5,6 +5,7 @@ import Control.Monad (liftM, when)
 import Control.Monad.Error (runErrorT)
 import Control.Monad.State (MonadState, StateT, execStateT, liftIO, modify, get, put)
 import Data.List
+import qualified Data.Map as Map
 import Data.Maybe
 import qualified IO
 import Numeric (readHex)
@@ -2000,7 +2001,7 @@ loadSource file = load file file
     load :: String -> String -> PassM ()
     load file realName
         =  do ps <- get
-              case lookup file (psSourceFiles ps) of
+              case Map.lookup file (psSourceFiles ps) of
                 Just _ -> return ()
                 Nothing ->
                   do progress $ "Loading source file " ++ realName
@@ -2008,7 +2009,7 @@ loadSource file = load file file
                      source <- removeIndentation realName (rawSource ++ "\n" ++ mainMarker ++ "\n")
                      debug $ "Preprocessed source:"
                      debug $ numberLines source
-                     modify $ (\ps -> ps { psSourceFiles = (file, source) : psSourceFiles ps })
+                     modify $ (\ps -> ps { psSourceFiles = Map.insert file source (psSourceFiles ps) })
                      let deps = map mangleModName $ preFindIncludes source
                      sequence_ [load dep (joinPath realName dep) | dep <- deps]
 --}}}
@@ -2023,7 +2024,7 @@ testParse prod text
 -- | Parse a file with the given production.
 parseFile :: Monad m => String -> OccParser t -> ParseState -> m t
 parseFile file prod ps
-    =  do let source = case lookup file (psSourceFiles ps) of
+    =  do let source = case Map.lookup file (psSourceFiles ps) of
                          Just s -> s
                          Nothing -> dieIO $ "Failed to preload file: " ++ show file
           let ps' = ps { psLoadedFiles = file : psLoadedFiles ps }

fco2/ParseState.hs

@@ -2,6 +2,8 @@
 module ParseState where
 
 import Data.Generics
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Control.Monad.State
 
 import qualified AST as A
@@ -16,14 +18,14 @@ data ParseState = ParseState {
     psOutputFile :: String,
 
     -- Set by preprocessor
-    psSourceFiles :: [(String, String)],
+    psSourceFiles :: Map String String,
     psIndentLinesIn :: [String],
     psIndentLinesOut :: [String],
 
     -- Set by Parse
     psLocalNames :: [(String, A.Name)],
     psMainLocals :: [(String, A.Name)],
-    psNames :: [(String, A.NameDef)],
+    psNames :: Map String A.NameDef,
     psNameCounter :: Int,
     psTypeContext :: [Maybe A.Type],
     psLoadedFiles :: [String],
@@ -31,9 +33,9 @@ data ParseState = ParseState {
 
     -- Set by passes
     psNonceCounter :: Int,
-    psFunctionReturns :: [(String, [A.Type])],
+    psFunctionReturns :: Map String [A.Type],
     psPulledItems :: [[A.Structured -> A.Structured]],
-    psAdditionalArgs :: [(String, [A.Actual])]
+    psAdditionalArgs :: Map String [A.Actual]
   }
   deriving (Show, Data, Typeable)
 
@@ -46,22 +48,22 @@ emptyState = ParseState {
     psParseOnly = False,
     psOutputFile = "-",
 
-    psSourceFiles = [],
+    psSourceFiles = Map.empty,
     psIndentLinesIn = [],
     psIndentLinesOut = [],
 
     psLocalNames = [],
     psMainLocals = [],
-    psNames = [],
+    psNames = Map.empty,
     psNameCounter = 0,
     psTypeContext = [],
     psLoadedFiles = [],
     psWarnings = [],
 
     psNonceCounter = 0,
-    psFunctionReturns = [],
+    psFunctionReturns = Map.empty,
     psPulledItems = [],
-    psAdditionalArgs = []
+    psAdditionalArgs = Map.empty
   }
 
 -- | Class of monads which keep a ParseState.
@@ -72,13 +74,14 @@ instance MonadState ParseState m => PSM m
 --{{{  name definitions
 -- | Add the definition of a name.
 defineName :: PSM m => A.Name -> A.NameDef -> m ()
-defineName n nd = modify $ (\ps -> ps { psNames = (A.nameName n, nd) : psNames ps })
+defineName n nd
+    = modify $ (\ps -> ps { psNames = Map.insert (A.nameName n) nd (psNames ps) })
 
 -- | Find the definition of a name.
 lookupName :: (PSM m, Die m) => A.Name -> m A.NameDef
 lookupName n
     =  do ps <- get
-          case lookup (A.nameName n) (psNames ps) of
+          case Map.lookup (A.nameName n) (psNames ps) of
             Just nd -> return nd
             Nothing -> die $ "cannot find name " ++ A.nameName n
 --}}}

fco2/SimplifyExprs.hs

@@ -3,6 +3,7 @@ module SimplifyExprs (simplifyExprs) where
 
 import Control.Monad.State
 import Data.Generics
+import qualified Data.Map as Map
 import Data.Maybe
 
 import qualified AST as A
@@ -35,7 +36,7 @@ functionsToProcs = doGeneric `extM` doSpecification
              specs <- sequence [makeNonceVariable "return_formal" mf t A.VariableName A.Abbrev | t <- rts]
              let names = [n | A.Specification mf n _ <- specs]
              -- Note the return types so we can fix calls later.
-             modify $ (\ps -> ps { psFunctionReturns = (A.nameName n, rts) : psFunctionReturns ps })
+             modify $ (\ps -> ps { psFunctionReturns = Map.insert (A.nameName n) rts (psFunctionReturns ps) })
              -- Turn the value process into an assignment process.
              let p = A.Seq mf $ vpToSeq vp [A.Variable mf n | n <- names]
              let st = A.Proc mf sm (fs ++ [A.Formal A.Abbrev t n | (t, n) <- zip rts names]) p
@@ -192,7 +193,7 @@ pullUp = doGeneric `extM` doStructured `extM` doProcess `extM` doSpecification `
              ets <- sequence [typeOfExpression e | e <- es']
 
              ps <- get
-             let rts = fromJust $ lookup (A.nameName n) (psFunctionReturns ps)
+             rts <- Map.lookup (A.nameName n) (psFunctionReturns ps)
              specs <- sequence [makeNonceVariable "return_actual" m t A.VariableName A.Original | t <- rts]
              sequence_ [addPulled $ A.Spec m spec | spec <- specs]
 

fco2/TODO

@@ -19,8 +19,6 @@ nothing to do with parsing.
 
 Types needs cleaning up and Haddocking.
 
-Many of the "lookup" lists should actually be Maps.
-
 ## Driver
 
 Add an option for whether to compile out overflow/bounds checks.

fco2/Types.hs

@@ -6,6 +6,7 @@ module Types where
 import Control.Monad
 import Control.Monad.State
 import Data.Generics
+import qualified Data.Map as Map
 import Data.Maybe
 
 import qualified AST as A
@@ -170,7 +171,7 @@ returnTypesOfFunction n
             _ ->
               do ps <- get
                  checkJust "not defined as a function" $
-                   lookup (A.nameName n) (psFunctionReturns ps)
+                   Map.lookup (A.nameName n) (psFunctionReturns ps)
 
 returnTypesOfIntrinsic :: (PSM m, Die m) => String -> m [A.Type]
 returnTypesOfIntrinsic s

fco2/Unnest.hs

@@ -127,7 +127,7 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
                           | (am, n, t) <- zip3 ams freeNames types]
              debug $ "removeFreeNames: " ++ show n ++ " has new args " ++ show newAs
              when (newAs /= []) $
-               modify $ (\ps -> ps { psAdditionalArgs = (A.nameName n, newAs) : psAdditionalArgs ps })
+               modify $ (\ps -> ps { psAdditionalArgs = Map.insert (A.nameName n) newAs (psAdditionalArgs ps) })
 
              return spec'
         _ -> doGeneric spec
@@ -136,7 +136,7 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
     doProcess :: A.Process -> PassM A.Process
     doProcess p@(A.ProcCall m n as)
         =  do st <- get
-              case lookup (A.nameName n) (psAdditionalArgs st) of
+              case Map.lookup (A.nameName n) (psAdditionalArgs st) of
                 Just add -> doGeneric $ A.ProcCall m n (as ++ add)
                 Nothing -> doGeneric p
     doProcess p = doGeneric p