diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index fb8de90..4b7f47e 100644 --- a/backends/BackendPassesTest.hs +++ b/backends/BackendPassesTest.hs @@ -42,23 +42,22 @@ import Utils m :: Meta m = emptyMeta +timerName :: A.Name +timerName = simpleName "rain_timer" + waitFor :: A.Expression -> A.Process -> A.Alternative -waitFor e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta $ simpleName - (ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix)) (A.InputTimerFor emptyMeta e) +waitFor e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta timerName) (A.InputTimerFor emptyMeta e) body waitUntil :: A.Expression -> A.Process -> A.Alternative -waitUntil e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta $ simpleName - (ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix)) (A.InputTimerAfter emptyMeta e) +waitUntil e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta timerName) (A.InputTimerAfter emptyMeta e) body mWaitUntil :: (Data a, Data b) => a -> b -> Pattern -mWaitUntil e body = mAlternative (A.True emptyMeta) (mVariable $ simpleName (ghostVarPrefix ++ "raintimer" - ++ ghostVarSuffix)) (mInputTimerAfter e) body +mWaitUntil e body = mAlternative (A.True emptyMeta) (mVariable timerName) (mInputTimerAfter e) body mGetTime :: Pattern -> Pattern -mGetTime v = mInput (mVariable $ simpleName (ghostVarPrefix ++ "raintimer" - ++ ghostVarSuffix)) (mInputTimerRead $ mInVariable v) +mGetTime v = mInput (mVariable timerName) (mInputTimerRead $ mInVariable v) -- | Test WaitUntil guard (should be unchanged) testTransformWaitFor0 :: Test diff --git a/data/CompState.hs b/data/CompState.hs index 7e550d7..6dac17a 100644 --- a/data/CompState.hs +++ b/data/CompState.hs @@ -35,6 +35,7 @@ import Errors (Die, dieP, ErrorReport, Warn, warnP) import Metadata import OrdAST () import UnifyType +import Utils -- | Modes that Tock can run in. data CompMode = ModeFlowGraph | ModeParse | ModeCompile | ModePostC | ModeFull @@ -111,6 +112,7 @@ data CompState = CompState { csMainLocals :: [(String, (A.Name, NameType))], csNames :: Map String A.NameDef, csUnscopedNames :: Map String String, + csGhostNames :: Set A.Name, csNameCounter :: Int, -- Set by passes @@ -145,6 +147,7 @@ emptyState = CompState { csMainLocals = [], csNames = Map.empty, csUnscopedNames = Map.empty, + csGhostNames = Set.empty, csNameCounter = 0, csTypeContext = [], @@ -202,6 +205,12 @@ defineName :: CSM m => A.Name -> A.NameDef -> m () defineName n nd = modify $ (\ps -> ps { csNames = Map.insert (A.nameName n) nd (csNames ps) }) +-- | Add the definition of a ghost name. +defineGhostName :: CSM m => A.Name -> A.NameDef -> m () +defineGhostName n nd + = do defineName n nd + modify (\cs -> cs { csGhostNames = Set.insert n (csGhostNames cs) }) + -- | Modify the definition of a name. modifyName :: CSM m => A.Name -> (A.NameDef -> A.NameDef) -> m () modifyName n f @@ -246,6 +255,13 @@ findUnscopedName n@(A.Name m s) } defineName n nd return n + +-- | Determine whether a name is a ghost name. +isGhostName :: CSMR m => A.Name -> m Bool +isGhostName n + = do ghostNames <- getCompState >>* csGhostNames + return $ n `Set.member` ghostNames + --}}} --{{{ pulled items @@ -380,14 +396,6 @@ findAllProcesses A.Proc _ _ _ p -> Just (n, p) _ -> Nothing --- | A prefix put on all ghost variables, such as Rain's timers -ghostVarPrefix :: String -ghostVarPrefix = "##" - --- | A suffix put on all ghost variables, such as Rain's timers -ghostVarSuffix :: String -ghostVarSuffix = "_##" - -- | A new identifer for the unify types in the tree getUniqueIdentifer :: CSM m => m Int getUniqueIdentifer = do st <- get diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index aa82368..d4b9def 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -510,23 +510,29 @@ rainSourceFile s <- getState return (p, s) +-- | A ghost variable for Rain's single timer. +-- This is used for all timer operations. rainTimerName :: A.Name -rainTimerName = A.Name {A.nameName = ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix, - A.nameMeta = emptyMeta} +rainTimerName = A.Name emptyMeta "rain_timer" + +rainTimerNameDef :: A.NameDef +rainTimerNameDef + = A.NameDef { A.ndMeta = emptyMeta + , A.ndName = A.nameName rainTimerName + , A.ndOrigName = A.nameName rainTimerName + , A.ndSpecType = A.Declaration emptyMeta (A.Timer A.RainTimer) + , A.ndAbbrevMode = A.Original + , A.ndPlacement = A.Unplaced + } -- | Parse Rain source text (with filename for error messages) parseRainProgram :: FilePath -> String -> PassM A.AST parseRainProgram filename source - = do lexOut <- liftIO $ L.runLexer filename source + = do lexOut <- liftIO $ L.runLexer filename source case lexOut of Left merr -> dieP merr $ "Parse (lexing) error" Right toks -> - do defineName rainTimerName $ A.NameDef {A.ndMeta = emptyMeta, - A.ndName = A.nameName rainTimerName, - A.ndOrigName = A.nameName rainTimerName, - A.ndSpecType = A.Declaration emptyMeta - (A.Timer A.RainTimer), - A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} + do defineGhostName rainTimerName rainTimerNameDef cs <- get case runParser rainSourceFile cs filename toks of Left err -> dieP (sourcePosToMeta $ errorPos err) $ "Parse error: " ++ show err diff --git a/transformations/Unnest.hs b/transformations/Unnest.hs index 43a67ce..038f347 100644 --- a/transformations/Unnest.hs +++ b/transformations/Unnest.hs @@ -58,9 +58,7 @@ freeNamesIn = doGeneric ignore s = Map.empty doName :: A.Name -> NameMap - doName n | ghostVarPrefix `isPrefixOf` (A.nameName n) - && ghostVarSuffix `isSuffixOf` (A.nameName n) = Map.empty - | otherwise = Map.singleton (A.nameName n) n + doName n = Map.singleton (A.nameName n) n doStructured :: Data a => A.Structured a -> NameMap doStructured (A.Rep _ rep s) = doRep rep s @@ -150,7 +148,7 @@ removeFreeNames = applyDepthM2 doSpecification doProcess -- | Return whether a 'Name' could be considered a free name. -- - -- Unscoped names aren't. + -- Unscoped and ghost names aren't. -- Things like data types and PROCs aren't, because they'll be the same -- for all instances of a PROC. -- Constants aren't, because they'll be pulled up anyway. @@ -158,7 +156,8 @@ removeFreeNames = applyDepthM2 doSpecification doProcess isFreeName n = do st <- specTypeOfName n isConst <- isConstantName n - return $ isFreeST st && not isConst + isGhost <- isGhostName n + return $ isFreeST st && not (isConst || isGhost) where isFreeST :: A.SpecType -> Bool isFreeST st