From cbbafffbd209653bb84d8fce90bfa15528c80606 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Mon, 24 Mar 2008 13:50:14 +0000 Subject: [PATCH] Changed Rain to use the new timer type rather than things like the GetTime statement --- backends/GenerateCPPCSP.hs | 14 +++++++++++--- data/AST.hs | 3 +++ data/CompState.hs | 8 ++++++++ frontends/ParseRain.hs | 31 +++++++++++++++++++++++-------- frontends/RainPasses.hs | 3 --- transformations/Unnest.hs | 5 ++++- 6 files changed, 49 insertions(+), 15 deletions(-) diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 80957c6..c282d78 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -202,14 +202,22 @@ genCPPCSPChannelOutput var --Since this is too large to be contained in an int once it has been multiplied, --the remainder is taken to trim the timer back down to something that will be useful in an int cppgenTimerRead :: A.Variable -> A.Variable -> CGen () -cppgenTimerRead c v - = do tell ["csp::CurrentTime (&"] +cppgenTimerRead c v = do + tt <- typeOfVariable c + case tt of + A.Timer A.RainTimer -> + do tell ["csp::CurrentTime (&"] + call genVariable v + tell [");"] + A.Timer A.OccamTimer -> + do tell ["csp::CurrentTime (&"] call genVariable c tell [");\n"] call genVariable v tell [" = (int)(unsigned)remainder(1000000.0 * csp::GetSeconds("] call genVariable c - tell ["),4294967296.0);\n"] + tell ["),4294967296.0);"] + _ -> call genMissing $ "Unsupported timer type: " ++ show tt cppgenGetTime :: A.Variable -> CGen () cppgenGetTime v diff --git a/data/AST.hs b/data/AST.hs index b7217fc..c6c4037 100644 --- a/data/AST.hs +++ b/data/AST.hs @@ -460,6 +460,9 @@ data InputMode = | InputTimerRead Meta InputItem -- | Wait for a particular time to go past on a timer. | InputTimerAfter Meta Expression + -- | Wait for a specified amount of time on a timer. + -- Equivalent to a timer-read followed by a timer-after + | InputTimerFor Meta Expression deriving (Show, Eq, Typeable, Data) -- | Abbreviation mode. diff --git a/data/CompState.hs b/data/CompState.hs index d14babd..e00e870 100644 --- a/data/CompState.hs +++ b/data/CompState.hs @@ -320,3 +320,11 @@ findAllProcesses = case A.ndType nd of 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 = "_##" \ No newline at end of file diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index ed7ee84..0e87595 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -390,9 +390,10 @@ alt = do {m <- sPri ; sAlt ; m' <- sLeftC ; cases <- many altCase ; optElseCase case input of A.Input m lv im -> do { body <- block ; return $ A.Only m $ A.Alternative m lv im body } _ -> dieP (findMeta input) $ "communication type not supported in an alt: \"" ++ show input ++ "\"" - <|> do (m, wm, e) <- waitStatement True + <|> do (m, wm) <- waitStatement True body <- block - return $ A.Only m $ A.AlternativeWait m wm e body + return $ A.Only m $ A.Alternative m (A.Variable m rainTimerName) + wm body elseCase :: RainParser (A.Structured A.Alternative) elseCase = do m <- sElse body <- block @@ -412,11 +413,13 @@ runProcess = do m <- sRun convertItem (A.ExprVariable _ v) = A.ActualVariable A.Original A.Any v convertItem e = A.ActualExpression A.Any e -waitStatement :: Bool -> RainParser (Meta, A.WaitMode, A.Expression) +waitStatement :: Bool -> RainParser (Meta, A.InputMode) waitStatement isAlt = do { m <- sWait ; - do { sFor ; e <- expression ; possSemiColon ; return (m, A.WaitFor, e)} - <|> do { sUntil ; e <- expression ; possSemiColon ; return (m, A.WaitUntil, e)} + do { sFor ; e <- expression ; possSemiColon ; + return (m, A.InputTimerFor m e)} + <|> do { sUntil ; e <- expression ; possSemiColon ; + return (m, A.InputTimerAfter m e)} "reserved word \"for\" or \"until\" should follow reserved word \"wait\"" } where @@ -433,8 +436,10 @@ statement <|> block <|> each <|> runProcess - <|> do {m <- reserved "now" ; dest <- lvalue ; sSemiColon ; return $ A.GetTime m dest} - <|> do {(m,wm,exp) <- waitStatement False ; return $ A.Wait m wm exp} + <|> do {m <- reserved "now" ; dest <- lvalue ; sSemiColon ; return $ A.Input + m (A.Variable m rainTimerName) $ A.InputTimerRead m $ A.InVariable m dest} + <|> do {(m,wm) <- waitStatement False; return $ A.Input m (A.Variable m + rainTimerName) wm} <|> try (comm False) <|> alt <|> try (do { lv <- lvalue ; op <- assignOp ; exp <- expression ; sSemiColon ; @@ -486,6 +491,10 @@ rainSourceFile s <- getState return (p, s) +rainTimerName :: A.Name +rainTimerName = A.Name {A.nameName = ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix, + A.nameMeta = emptyMeta, A.nameType = A.TimerName} + -- | Load and parse a Rain source file. parseRainProgram :: String -> PassM A.AST parseRainProgram filename @@ -494,7 +503,13 @@ parseRainProgram filename case lexOut of Left merr -> dieP merr $ "Parse (lexing) error" Right toks -> - do cs <- get + 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.Timer A.RainTimer), + A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} + cs <- get case runParser rainSourceFile cs filename toks of Left err -> dieP (sourcePosToMeta $ errorPos err) $ "Parse error: " ++ show err Right (p, cs') -> diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index 5c70f6d..7c84766 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -298,7 +298,6 @@ excludeNonRainFeatures = excludeConstr [ con0 A.Real32 ,con0 A.Real64 ,con2 A.Counted - ,con1 A.Timer ,con1 A.Port ,con2 A.BytesInExpr ,con2 A.BytesInType @@ -306,8 +305,6 @@ excludeNonRainFeatures = excludeConstr ,con0 A.After ,con3 A.InCounted ,con3 A.OutCounted - ,con2 A.InputTimerRead - ,con2 A.InputTimerAfter ,con2 A.Place ,con3 A.IsChannelArray ,con4 A.Retypes diff --git a/transformations/Unnest.hs b/transformations/Unnest.hs index a696970..57d75f4 100644 --- a/transformations/Unnest.hs +++ b/transformations/Unnest.hs @@ -21,6 +21,7 @@ module Unnest (unnest) where import Control.Monad.State import Data.Generics +import Data.List import qualified Data.Map as Map import Data.Maybe @@ -55,7 +56,9 @@ freeNamesIn = doGeneric ignore s = Map.empty doName :: A.Name -> NameMap - doName n = Map.singleton (A.nameName n) n + doName n | ghostVarPrefix `isPrefixOf` (A.nameName n) + && ghostVarSuffix `isSuffixOf` (A.nameName n) = Map.empty + | otherwise = Map.singleton (A.nameName n) n doStructured :: Data a => A.Structured a -> NameMap doStructured (A.Rep _ rep s) = doRep rep s