Get rid of the nasty ghost names hack.
Rather than prefixing the names, there's now a set of ghost names in CompState. Fixes #66.
This commit is contained in:
parent
13ea7f2c4b
commit
cf79f9c284
|
@ -42,23 +42,22 @@ import Utils
|
||||||
m :: Meta
|
m :: Meta
|
||||||
m = emptyMeta
|
m = emptyMeta
|
||||||
|
|
||||||
|
timerName :: A.Name
|
||||||
|
timerName = simpleName "rain_timer"
|
||||||
|
|
||||||
waitFor :: A.Expression -> A.Process -> A.Alternative
|
waitFor :: A.Expression -> A.Process -> A.Alternative
|
||||||
waitFor e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta $ simpleName
|
waitFor e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta timerName) (A.InputTimerFor emptyMeta e)
|
||||||
(ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix)) (A.InputTimerFor emptyMeta e)
|
|
||||||
body
|
body
|
||||||
|
|
||||||
waitUntil :: A.Expression -> A.Process -> A.Alternative
|
waitUntil :: A.Expression -> A.Process -> A.Alternative
|
||||||
waitUntil e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta $ simpleName
|
waitUntil e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta timerName) (A.InputTimerAfter emptyMeta e)
|
||||||
(ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix)) (A.InputTimerAfter emptyMeta e)
|
|
||||||
body
|
body
|
||||||
|
|
||||||
mWaitUntil :: (Data a, Data b) => a -> b -> Pattern
|
mWaitUntil :: (Data a, Data b) => a -> b -> Pattern
|
||||||
mWaitUntil e body = mAlternative (A.True emptyMeta) (mVariable $ simpleName (ghostVarPrefix ++ "raintimer"
|
mWaitUntil e body = mAlternative (A.True emptyMeta) (mVariable timerName) (mInputTimerAfter e) body
|
||||||
++ ghostVarSuffix)) (mInputTimerAfter e) body
|
|
||||||
|
|
||||||
mGetTime :: Pattern -> Pattern
|
mGetTime :: Pattern -> Pattern
|
||||||
mGetTime v = mInput (mVariable $ simpleName (ghostVarPrefix ++ "raintimer"
|
mGetTime v = mInput (mVariable timerName) (mInputTimerRead $ mInVariable v)
|
||||||
++ ghostVarSuffix)) (mInputTimerRead $ mInVariable v)
|
|
||||||
|
|
||||||
-- | Test WaitUntil guard (should be unchanged)
|
-- | Test WaitUntil guard (should be unchanged)
|
||||||
testTransformWaitFor0 :: Test
|
testTransformWaitFor0 :: Test
|
||||||
|
|
|
@ -35,6 +35,7 @@ import Errors (Die, dieP, ErrorReport, Warn, warnP)
|
||||||
import Metadata
|
import Metadata
|
||||||
import OrdAST ()
|
import OrdAST ()
|
||||||
import UnifyType
|
import UnifyType
|
||||||
|
import Utils
|
||||||
|
|
||||||
-- | Modes that Tock can run in.
|
-- | Modes that Tock can run in.
|
||||||
data CompMode = ModeFlowGraph | ModeParse | ModeCompile | ModePostC | ModeFull
|
data CompMode = ModeFlowGraph | ModeParse | ModeCompile | ModePostC | ModeFull
|
||||||
|
@ -111,6 +112,7 @@ data CompState = CompState {
|
||||||
csMainLocals :: [(String, (A.Name, NameType))],
|
csMainLocals :: [(String, (A.Name, NameType))],
|
||||||
csNames :: Map String A.NameDef,
|
csNames :: Map String A.NameDef,
|
||||||
csUnscopedNames :: Map String String,
|
csUnscopedNames :: Map String String,
|
||||||
|
csGhostNames :: Set A.Name,
|
||||||
csNameCounter :: Int,
|
csNameCounter :: Int,
|
||||||
|
|
||||||
-- Set by passes
|
-- Set by passes
|
||||||
|
@ -145,6 +147,7 @@ emptyState = CompState {
|
||||||
csMainLocals = [],
|
csMainLocals = [],
|
||||||
csNames = Map.empty,
|
csNames = Map.empty,
|
||||||
csUnscopedNames = Map.empty,
|
csUnscopedNames = Map.empty,
|
||||||
|
csGhostNames = Set.empty,
|
||||||
csNameCounter = 0,
|
csNameCounter = 0,
|
||||||
|
|
||||||
csTypeContext = [],
|
csTypeContext = [],
|
||||||
|
@ -202,6 +205,12 @@ defineName :: CSM m => A.Name -> A.NameDef -> m ()
|
||||||
defineName n nd
|
defineName n nd
|
||||||
= modify $ (\ps -> ps { csNames = Map.insert (A.nameName n) nd (csNames ps) })
|
= 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.
|
-- | Modify the definition of a name.
|
||||||
modifyName :: CSM m => A.Name -> (A.NameDef -> A.NameDef) -> m ()
|
modifyName :: CSM m => A.Name -> (A.NameDef -> A.NameDef) -> m ()
|
||||||
modifyName n f
|
modifyName n f
|
||||||
|
@ -246,6 +255,13 @@ findUnscopedName n@(A.Name m s)
|
||||||
}
|
}
|
||||||
defineName n nd
|
defineName n nd
|
||||||
return n
|
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
|
--{{{ pulled items
|
||||||
|
@ -380,14 +396,6 @@ findAllProcesses
|
||||||
A.Proc _ _ _ p -> Just (n, p)
|
A.Proc _ _ _ p -> Just (n, p)
|
||||||
_ -> Nothing
|
_ -> 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
|
-- | A new identifer for the unify types in the tree
|
||||||
getUniqueIdentifer :: CSM m => m Int
|
getUniqueIdentifer :: CSM m => m Int
|
||||||
getUniqueIdentifer = do st <- get
|
getUniqueIdentifer = do st <- get
|
||||||
|
|
|
@ -510,9 +510,20 @@ rainSourceFile
|
||||||
s <- getState
|
s <- getState
|
||||||
return (p, s)
|
return (p, s)
|
||||||
|
|
||||||
|
-- | A ghost variable for Rain's single timer.
|
||||||
|
-- This is used for all timer operations.
|
||||||
rainTimerName :: A.Name
|
rainTimerName :: A.Name
|
||||||
rainTimerName = A.Name {A.nameName = ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix,
|
rainTimerName = A.Name emptyMeta "rain_timer"
|
||||||
A.nameMeta = emptyMeta}
|
|
||||||
|
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)
|
-- | Parse Rain source text (with filename for error messages)
|
||||||
parseRainProgram :: FilePath -> String -> PassM A.AST
|
parseRainProgram :: FilePath -> String -> PassM A.AST
|
||||||
|
@ -521,12 +532,7 @@ parseRainProgram filename source
|
||||||
case lexOut of
|
case lexOut of
|
||||||
Left merr -> dieP merr $ "Parse (lexing) error"
|
Left merr -> dieP merr $ "Parse (lexing) error"
|
||||||
Right toks ->
|
Right toks ->
|
||||||
do defineName rainTimerName $ A.NameDef {A.ndMeta = emptyMeta,
|
do defineGhostName rainTimerName rainTimerNameDef
|
||||||
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}
|
|
||||||
cs <- get
|
cs <- get
|
||||||
case runParser rainSourceFile cs filename toks of
|
case runParser rainSourceFile cs filename toks of
|
||||||
Left err -> dieP (sourcePosToMeta $ errorPos err) $ "Parse error: " ++ show err
|
Left err -> dieP (sourcePosToMeta $ errorPos err) $ "Parse error: " ++ show err
|
||||||
|
|
|
@ -58,9 +58,7 @@ freeNamesIn = doGeneric
|
||||||
ignore s = Map.empty
|
ignore s = Map.empty
|
||||||
|
|
||||||
doName :: A.Name -> NameMap
|
doName :: A.Name -> NameMap
|
||||||
doName n | ghostVarPrefix `isPrefixOf` (A.nameName n)
|
doName n = Map.singleton (A.nameName n) n
|
||||||
&& ghostVarSuffix `isSuffixOf` (A.nameName n) = Map.empty
|
|
||||||
| otherwise = Map.singleton (A.nameName n) n
|
|
||||||
|
|
||||||
doStructured :: Data a => A.Structured a -> NameMap
|
doStructured :: Data a => A.Structured a -> NameMap
|
||||||
doStructured (A.Rep _ rep s) = doRep rep s
|
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.
|
-- | 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
|
-- Things like data types and PROCs aren't, because they'll be the same
|
||||||
-- for all instances of a PROC.
|
-- for all instances of a PROC.
|
||||||
-- Constants aren't, because they'll be pulled up anyway.
|
-- Constants aren't, because they'll be pulled up anyway.
|
||||||
|
@ -158,7 +156,8 @@ removeFreeNames = applyDepthM2 doSpecification doProcess
|
||||||
isFreeName n
|
isFreeName n
|
||||||
= do st <- specTypeOfName n
|
= do st <- specTypeOfName n
|
||||||
isConst <- isConstantName n
|
isConst <- isConstantName n
|
||||||
return $ isFreeST st && not isConst
|
isGhost <- isGhostName n
|
||||||
|
return $ isFreeST st && not (isConst || isGhost)
|
||||||
where
|
where
|
||||||
isFreeST :: A.SpecType -> Bool
|
isFreeST :: A.SpecType -> Bool
|
||||||
isFreeST st
|
isFreeST st
|
||||||
|
|
Loading…
Reference in New Issue
Block a user