From d044b51335adfa0ed2526a073b65e9d076691da8 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Wed, 21 May 2008 13:38:51 +0000 Subject: [PATCH] Renamed ndType to ndSpecType, as per Trac ticket #59 --- backends/BackendPasses.hs | 6 +++--- backends/BackendPassesTest.hs | 4 ++-- common/TestUtils.hs | 8 ++++---- common/Types.hs | 2 +- data/AST.hs | 2 +- data/CompState.hs | 4 ++-- frontends/OccamPasses.hs | 2 +- frontends/OccamTypes.hs | 2 +- frontends/ParseOccam.hs | 2 +- frontends/ParseRain.hs | 2 +- frontends/RainPasses.hs | 8 ++++---- frontends/RainTypes.hs | 10 +++++----- transformations/SimplifyExprs.hs | 2 +- transformations/Unnest.hs | 2 +- 14 files changed, 28 insertions(+), 28 deletions(-) diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs index e0e5679..946d70e 100644 --- a/backends/BackendPasses.hs +++ b/backends/BackendPasses.hs @@ -91,7 +91,7 @@ declareSizesArray = doGeneric `ext1M` doStructured ,A.ndName = A.nameName n ,A.ndOrigName = A.nameName n ,A.ndNameType = A.VariableName - ,A.ndType = spec + ,A.ndSpecType = spec ,A.ndAbbrevMode = A.ValAbbrev ,A.ndPlacement = A.Unplaced} @@ -249,7 +249,7 @@ addSizesFormalParameters = doGeneric `extM` doSpecification = do (args', newargs) <- transformFormals m args body' <- doGeneric body let newspec = A.Proc m' sm args' body' - modify (\cs -> cs {csNames = Map.adjust (\nd -> nd { A.ndType = newspec }) (A.nameName n) (csNames cs)}) + modify (\cs -> cs {csNames = Map.adjust (\nd -> nd { A.ndSpecType = newspec }) (A.nameName n) (csNames cs)}) mapM_ (recordArg m') newargs return $ A.Specification m n newspec doSpecification st = doGeneric st @@ -261,7 +261,7 @@ addSizesFormalParameters = doGeneric `extM` doSpecification ,A.ndName = A.nameName n ,A.ndOrigName = A.nameName n ,A.ndNameType = A.VariableName - ,A.ndType = A.Declaration m t + ,A.ndSpecType = A.Declaration m t ,A.ndAbbrevMode = A.ValAbbrev ,A.ndPlacement = A.Unplaced} diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index 8df3b5a..80d073e 100644 --- a/backends/BackendPassesTest.hs +++ b/backends/BackendPassesTest.hs @@ -324,7 +324,7 @@ defineTestName n sp am ,A.ndName = n ,A.ndOrigName = n ,A.ndNameType = A.VariableName - ,A.ndType = sp + ,A.ndSpecType = sp ,A.ndAbbrevMode = am ,A.ndPlacement = A.Unplaced } @@ -336,7 +336,7 @@ checkName n spec am cs Nothing -> testFailure ("Could not find " ++ n) >> return undefined testEqual "ndName" n (A.ndName nd) testEqual "ndOrigName" n (A.ndOrigName nd) - testEqual "ndType" spec (A.ndType nd) + testEqual "ndSpecType" spec (A.ndSpecType nd) testEqual "ndAbbrevMode" am (A.ndAbbrevMode nd) diff --git a/common/TestUtils.hs b/common/TestUtils.hs index df27843..d74ebdc 100644 --- a/common/TestUtils.hs +++ b/common/TestUtils.hs @@ -293,7 +293,7 @@ buildExpr (Func f es) = A.FunctionCall emptyMeta ((simpleName f) {A.nameType -- | A simple definition of a variable simpleDef :: String -> A.SpecType -> A.NameDef simpleDef n sp = A.NameDef {A.ndMeta = emptyMeta, A.ndName = n, A.ndOrigName = n, A.ndNameType = A.VariableName, - A.ndType = sp, A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} + A.ndSpecType = sp, A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} -- | A simple definition of a declared variable simpleDefDecl :: String -> A.Type -> A.NameDef @@ -315,7 +315,7 @@ defineThing s nt st am = defineName (simpleName s) $ A.ndName = s, A.ndOrigName = s, A.ndNameType = nt, - A.ndType = st, + A.ndSpecType = st, A.ndAbbrevMode = am, A.ndPlacement = A.Unplaced } @@ -444,10 +444,10 @@ checkTempVarTypes testName vars is = mapM_ (checkTempVarType testName is) vars case Map.lookup nm (csNames state) of Nothing -> assertFailure (testName ++ ": item with key \"" ++ key ++ "\" was not recorded in the state") Just nd -> evalStateT ( - do mtSpec <- typeOfSpec (A.ndType nd) + do mtSpec <- typeOfSpec (A.ndSpecType nd) case mtSpec of Just tSpec -> liftIO $ assertEqual (testName ++ ": type not as expected for key \"" ++ key ++ "\"") t tSpec - Nothing -> liftIO $ assertFailure (testName ++ ": spec does not have identifiable type for key \"" ++ key ++ "\": " ++ show (A.ndType nd)) + Nothing -> liftIO $ assertFailure (testName ++ ": spec does not have identifiable type for key \"" ++ key ++ "\": " ++ show (A.ndSpecType nd)) ) state assertEither :: (Eq a, Show a) => String -> a -> Either String a -> Assertion diff --git a/common/Types.hs b/common/Types.hs index 2eb714f..a5d0eb5 100644 --- a/common/Types.hs +++ b/common/Types.hs @@ -63,7 +63,7 @@ instance ASTTypeable A.Type where -- | Gets the 'A.SpecType' for a given 'A.Name' from the recorded types in the 'CompState'. Dies with an error if the name is unknown. specTypeOfName :: (CSMR m, Die m) => A.Name -> m A.SpecType specTypeOfName n - = liftM A.ndType (lookupNameOrError n $ dieP (A.nameMeta n) $ "Could not find type in specTypeOfName for: " ++ (show $ A.nameName n)) + = liftM A.ndSpecType (lookupNameOrError n $ dieP (A.nameMeta n) $ "Could not find type in specTypeOfName for: " ++ (show $ A.nameName n)) -- | Gets the 'A.AbbrevMode' for a given 'A.Name' from the recorded types in the 'CompState'. Dies with an error if the name is unknown. abbrevModeOfName :: (CSMR m, Die m) => A.Name -> m A.AbbrevMode diff --git a/data/AST.hs b/data/AST.hs index 8210380..fdcb4b1 100644 --- a/data/AST.hs +++ b/data/AST.hs @@ -72,7 +72,7 @@ data NameDef = NameDef { -- | The general type of the name. ndNameType :: NameType, -- | The specification type of the name's definition (see 'SpecType'). - ndType :: SpecType, + ndSpecType :: SpecType, -- | The abbreviation mode of the name's definition (see 'AbbrevMode'). ndAbbrevMode :: AbbrevMode, -- | The placement mode of the name's definition (see 'Placement'). diff --git a/data/CompState.hs b/data/CompState.hs index dcaa775..23e4804 100644 --- a/data/CompState.hs +++ b/data/CompState.hs @@ -306,7 +306,7 @@ defineNonce m s st nt am A.ndName = ns, A.ndOrigName = ns, A.ndNameType = nt, - A.ndType = st, + A.ndSpecType = st, A.ndAbbrevMode = am, A.ndPlacement = A.Unplaced } @@ -359,7 +359,7 @@ findAllProcesses where findAllProcesses' :: (String, A.NameDef) -> Maybe (String, A.Process) findAllProcesses' (n, nd) - = case A.ndType nd of + = case A.ndSpecType nd of A.Proc _ _ _ p -> Just (n, p) _ -> Nothing diff --git a/frontends/OccamPasses.hs b/frontends/OccamPasses.hs index 19cb585..5f1b40e 100644 --- a/frontends/OccamPasses.hs +++ b/frontends/OccamPasses.hs @@ -101,7 +101,7 @@ foldConstants = applyDepthM2 doExpression doSpecification -- so we just update them all.) doSpecification :: A.Specification -> PassM A.Specification doSpecification s@(A.Specification _ n st) - = do modifyName n (\nd -> nd { A.ndType = st }) + = do modifyName n (\nd -> nd { A.ndSpecType = st }) return s -- | Check that things that must be constant are. diff --git a/frontends/OccamTypes.hs b/frontends/OccamTypes.hs index f9637dd..a28f055 100644 --- a/frontends/OccamTypes.hs +++ b/frontends/OccamTypes.hs @@ -739,7 +739,7 @@ inferTypes = applyX $ baseX doSpecification descend s@(A.Specification m n st) = do st' <- doSpecType descend st -- Update the definition of each name after we handle it. - modifyName n (\nd -> nd { A.ndType = st' }) + modifyName n (\nd -> nd { A.ndSpecType = st' }) return $ A.Specification m n st' doSpecType :: ExplicitTrans A.SpecType diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index 3080220..991e282 100644 --- a/frontends/ParseOccam.hs +++ b/frontends/ParseOccam.hs @@ -361,7 +361,7 @@ scopeIn n@(A.Name m nt s) specType am A.ndName = s', A.ndOrigName = s, A.ndNameType = A.nameType n', - A.ndType = specType, + A.ndSpecType = specType, A.ndAbbrevMode = am, A.ndPlacement = A.Unplaced } diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index eb8bd28..05f41fa 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -525,7 +525,7 @@ parseRainProgram filename source do defineName rainTimerName $ A.NameDef {A.ndMeta = emptyMeta, A.ndName = A.nameName rainTimerName, A.ndOrigName = A.nameName rainTimerName, - A.ndNameType = A.TimerName, A.ndType = A.Declaration emptyMeta + A.ndNameType = A.TimerName, A.ndSpecType = A.Declaration emptyMeta (A.Timer A.RainTimer), A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} cs <- get diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index 9625ed7..40dd7a6 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -98,7 +98,7 @@ uniquifyAndResolveVars = everywhereM (mk1M uniquifyAndResolveVars') uniquifyAndResolveVars' (A.Spec m (A.Specification m' n decl@(A.Declaration {})) scope) = do n' <- makeNonce $ A.nameName n defineName (n {A.nameName = n'}) A.NameDef {A.ndMeta = m', A.ndName = n', A.ndOrigName = A.nameName n, - A.ndNameType = A.VariableName, A.ndType = decl, + A.ndNameType = A.VariableName, A.ndSpecType = decl, A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} let scope' = everywhere (mkT $ replaceNameName (A.nameName n) n') scope return $ A.Spec m (A.Specification m' n {A.nameName = n'} decl) scope' @@ -108,7 +108,7 @@ uniquifyAndResolveVars = everywhereM (mk1M uniquifyAndResolveVars') = do (params',procBody') <- doFormals params procBody let newProc = (A.Proc m'' procMode params' procBody') defineName n A.NameDef {A.ndMeta = m', A.ndName = A.nameName n, A.ndOrigName = A.nameName n, - A.ndNameType = A.ProcName, A.ndType = newProc, + A.ndNameType = A.ProcName, A.ndSpecType = newProc, A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} return $ A.Spec m (A.Specification m' n newProc) scope -- Functions: @@ -117,7 +117,7 @@ uniquifyAndResolveVars = everywhereM (mk1M uniquifyAndResolveVars') = do (params', funcBody') <- doFormals params funcBody let newFunc = (A.Function m'' funcMode retTypes params' funcBody') defineName n A.NameDef {A.ndMeta = m', A.ndName = A.nameName n, A.ndOrigName = A.nameName n, - A.ndNameType = A.FunctionName, A.ndType = newFunc, + A.ndNameType = A.FunctionName, A.ndSpecType = newFunc, A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} return $ A.Spec m (A.Specification m' n newFunc) scope @@ -144,7 +144,7 @@ uniquifyAndResolveVars = everywhereM (mk1M uniquifyAndResolveVars') let newName = (n {A.nameName = n'}) let m = A.nameMeta n defineName newName A.NameDef {A.ndMeta = m, A.ndName = n', A.ndOrigName = A.nameName n, - A.ndNameType = A.VariableName, A.ndType = (A.Declaration m t), + A.ndNameType = A.VariableName, A.ndSpecType = (A.Declaration m t), A.ndAbbrevMode = am, A.ndPlacement = A.Unplaced} let scope' = everywhere (mkT $ replaceNameName (A.nameName n) n') scope return (A.Formal am t newName, scope') diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs index acbe4b6..7fbce1c 100644 --- a/frontends/RainTypes.hs +++ b/frontends/RainTypes.hs @@ -113,7 +113,7 @@ performTypeUnification x shift = liftM (Map.fromList . catMaybes) . mapM shift' . Map.toList where shift' :: (String, A.NameDef) -> PassM (Maybe (UnifyIndex, UnifyValue)) - shift' (rawName, d) = do mt <- typeOfSpec (A.ndType d) + shift' (rawName, d) = do mt <- typeOfSpec (A.ndSpecType d) case mt of Nothing -> return Nothing Just t -> do te <- typeToTypeExp (A.ndMeta d) t @@ -144,7 +144,7 @@ recordInfNameTypes = everywhereM (mkM recordInfNameTypes') recordInfNameTypes' input@(A.ForEach m n e) = do let innerT = A.UnknownVarType $ Left n defineName n A.NameDef {A.ndMeta = m, A.ndName = A.nameName n, A.ndOrigName = A.nameName n, - A.ndNameType = A.VariableName, A.ndType = (A.Declaration m innerT), + A.ndNameType = A.VariableName, A.ndSpecType = (A.Declaration m innerT), A.ndAbbrevMode = A.Abbrev, A.ndPlacement = A.Unplaced} return input recordInfNameTypes' r = return r @@ -173,7 +173,7 @@ markParamPass = checkDepthM2 matchParamPassProc matchParamPassFunc matchParamPassProc :: Check A.Process matchParamPassProc (A.ProcCall m n actualParams) = do def <- lookupNameOrError n $ dieP m ("Process name is unknown: \"" ++ (show $ A.nameName n) ++ "\"") - case A.ndType def of + case A.ndSpecType def of A.Proc _ _ expectedParams _ -> if (length expectedParams) == (length actualParams) then mapM_ (uncurry markUnify) (zip expectedParams actualParams) @@ -185,7 +185,7 @@ markParamPass = checkDepthM2 matchParamPassProc matchParamPassFunc matchParamPassFunc :: Check A.Expression matchParamPassFunc (A.FunctionCall m n actualParams) = do def <- lookupNameOrError n $ dieP m ("Function name is unknown: \"" ++ (show $ A.nameName n) ++ "\"") - case A.ndType def of + case A.ndSpecType def of A.Function _ _ _ expectedParams _ -> if (length expectedParams) == (length actualParams) then mapM_ (uncurry markUnify) (zip expectedParams actualParams) @@ -193,7 +193,7 @@ markParamPass = checkDepthM2 matchParamPassProc matchParamPassFunc _ -> dieP m $ "Attempt to make a function call with something" ++ " that is not a function: \"" ++ A.nameName n ++ "\"; is actually: " ++ showConstr (toConstr $ - A.ndType def) + A.ndSpecType def) matchParamPassFunc _ = return () -- | Checks the types in expressions diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs index 6c960ac..3d77a0c 100644 --- a/transformations/SimplifyExprs.hs +++ b/transformations/SimplifyExprs.hs @@ -71,7 +71,7 @@ functionsToProcs = doGeneric `extM` doSpecification A.ndName = A.nameName n, A.ndOrigName = A.nameName n, A.ndNameType = A.ProcName, - A.ndType = st, + A.ndSpecType = st, A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced } diff --git a/transformations/Unnest.hs b/transformations/Unnest.hs index 768386c..7076545 100644 --- a/transformations/Unnest.hs +++ b/transformations/Unnest.hs @@ -150,7 +150,7 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess -- Update the definition of the proc nameDef <- lookupName n - defineName n (nameDef { A.ndType = st'' }) + defineName n (nameDef { A.ndSpecType = st'' }) -- Note that we should add extra arguments to calls of this proc -- when we find them