diff --git a/fco2/Parse.hs b/fco2/Parse.hs index aefa0d8..98a3b73 100644 --- a/fco2/Parse.hs +++ b/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 } diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index c1bd0b4..6d455ae 100644 --- a/fco2/ParseState.hs +++ b/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 --}}} diff --git a/fco2/SimplifyExprs.hs b/fco2/SimplifyExprs.hs index 066e074..6f79ba8 100644 --- a/fco2/SimplifyExprs.hs +++ b/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] diff --git a/fco2/TODO b/fco2/TODO index c2d07b5..3b015a4 100644 --- a/fco2/TODO +++ b/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. diff --git a/fco2/Types.hs b/fco2/Types.hs index 3027a35..9b807eb 100644 --- a/fco2/Types.hs +++ b/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 diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs index 3466c18..51d13b1 100644 --- a/fco2/Unnest.hs +++ b/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