suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changed the rest of tock to reflect the changes to the Is constructor

Browse Source
This commit is contained in:
Neil Brown 2009-03-24 23:57:24 +00:00
parent 53f7378988
commit 45b22472c3
17 changed files with 73 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
backends/BackendPasses.hs
View File

@ -259,7 +259,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
A.Literal m sizeType $ A.ArrayListLiteral m $ A.Several m $
A.Only m exp : map (A.Only m) subDims
Nothing -> subSrcSizeVar
sizeSpecType = A.IsExpr m A.ValAbbrev sizeType sizeExpr
sizeSpecType = A.Is m A.ValAbbrev sizeType (A.ActualExpression sizeExpr)
defineSizesName m n_sizes sizeSpecType
return $ A.Specification m n_sizes sizeSpecType
@ -281,15 +281,15 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
-- here, and probably isn't handled right
A.Retypes _ _ _ v ->
retypesSizes m' n_sizes ds elemT v
A.Is _ _ _ v ->
A.Is _ _ _ (A.ActualVariable v) ->
abbrevVarSizes m n_sizes ds v
A.IsChannelArray _ _ vs ->
A.Is _ _ _ (A.ActualChannelArray vs) ->
defineStaticSizes [makeDimension m' (length vs)]
A.IsExpr _ _ _ (A.ExprVariable _ v) ->
A.Is _ _ _ (A.ActualExpression (A.ExprVariable _ v)) ->
abbrevVarSizes m n_sizes ds v
-- The dimensions in a literal should all be
-- static:
A.IsExpr _ _ _ (A.Literal _ (A.Array ds' _) _) ->
A.Is _ _ _ (A.ActualExpression (A.Literal _ (A.Array ds' _) _)) ->
defineStaticSizes ds'
_ ->
dieP m $ "Could not handle unknown array spec: "
@ -314,7 +314,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
where
sizeType = A.Array [makeDimension m $ length es] A.Int
sizeLit = A.Literal m sizeType $ A.ArrayListLiteral m $ A.Several m $ map (A.Only m) es
sizeSpecType = A.IsExpr m A.ValAbbrev sizeType sizeLit
sizeSpecType = A.Is m A.ValAbbrev sizeType $ A.ActualExpression sizeLit
declareFieldSizes :: Data a => String -> Meta -> A.Structured a -> (A.Name, A.Type) -> PassM (A.Structured a)
declareFieldSizes prep m inner (n, A.Array ds _)

12
backends/GenerateC.hs
View File

@ -1342,13 +1342,13 @@ cintroduceSpec (A.Specification m n (A.Declaration _ t))
case fdeclareInit m t (A.Variable m n) of
Just p -> p
Nothing -> return ()
cintroduceSpec (A.Specification _ n (A.Is _ am t v))
cintroduceSpec (A.Specification _ n (A.Is _ am t (A.ActualVariable v)))
= do let rhs = call genVariable v am
call genDecl am t n
tell ["="]
rhs
tell [";"]
cintroduceSpec (A.Specification _ n (A.IsExpr _ am t e))
cintroduceSpec (A.Specification _ n (A.Is _ am t (A.ActualExpression e)))
= do let rhs = abbrevExpression am t e
case (am, t, e) of
(A.ValAbbrev, A.Array _ ts, A.Literal _ _ _) ->
@ -1377,7 +1377,7 @@ cintroduceSpec (A.Specification _ n (A.IsExpr _ am t e))
tell [" = "]
rhs
tell [";\n"]
cintroduceSpec (A.Specification _ n (A.IsChannelArray _ (A.Array _ c) cs))
cintroduceSpec (A.Specification _ n (A.Is _ _ (A.Array _ c) (A.ActualChannelArray cs)))
= do genType c
case c of
A.Chan _ _ -> tell ["* "]
@ -1388,7 +1388,7 @@ cintroduceSpec (A.Specification _ n (A.IsChannelArray _ (A.Array _ c) cs))
tell ["[]={"]
seqComma (map (\v -> call genVariable v A.Abbrev) cs)
tell ["};"]
cintroduceSpec (A.Specification _ n (A.IsClaimed _ v))
cintroduceSpec (A.Specification _ n (A.Is _ _ _ (A.ActualClaim v)))
= do t <- astTypeOf n
case t of
A.ChanEnd dir _ _ -> do call genDecl A.Original t n
@ -1504,14 +1504,14 @@ cremoveSpec (A.Specification m n (A.Declaration _ t))
var = A.Variable m n
cremoveSpec (A.Specification _ n (A.Rep _ rep))
= call genReplicatorEnd rep
cremoveSpec (A.Specification m n (A.IsExpr _ am t e))
cremoveSpec (A.Specification m n (A.Is _ am t (A.ActualExpression e)))
= do fdeclareFree <- fget declareFree
case fdeclareFree m t var of
Just p -> p
Nothing -> return ()
where
var = A.Variable m n
cremoveSpec (A.Specification _ n (A.IsClaimed _ v))
cremoveSpec (A.Specification _ n (A.Is _ _ _ (A.ActualClaim v)))
= do t <- astTypeOf n
let dir = case t of
A.ChanEnd dir _ _ -> dir

4
backends/GenerateCPPCSP.hs
View File

@ -601,8 +601,8 @@ cppintroduceSpec (A.Specification _ n (A.Proc _ (sm, _) fs p))
--A helper function for calling the wrapped functions:
genParamList :: [A.Formal] -> CGen()
genParamList fs = seqComma $ map genParam fs
cppintroduceSpec (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {})) dirV@(A.DirectedVariable
m dir v)))
cppintroduceSpec (A.Specification _ n (A.Is _ am t@(A.Array ds c@(A.ChanEnd {}))
(A.ActualVariable dirV@(A.DirectedVariable m dir v))))
= do t' <- if A.UnknownDimension `elem` ds
then do dirVT <- astTypeOf dirV
case dirVT of

6
checks/UsageCheckUtils.hs
View File

@ -240,9 +240,9 @@ getVarSpec (A.Specification _ n st) = get st
dv = A.Variable (A.nameMeta n) n
get :: A.SpecType -> Vars
get (A.Is _ am _ v) = abbrev am v
get (A.IsExpr _ _ _ e) = getVarExp e `unionVars` processVarW dv (Just e)
get (A.IsChannelArray _ _ vs) = vars vs' ((Var dv,Nothing):(zip vs' $ repeat Nothing)) []
get (A.Is _ am _ (A.ActualVariable v)) = abbrev am v
get (A.Is _ _ _ (A.ActualExpression e)) = getVarExp e `unionVars` processVarW dv (Just e)
get (A.Is _ _ _ (A.ActualChannelArray vs)) = vars vs' ((Var dv,Nothing):(zip vs' $ repeat Nothing)) []
where
vs' = map Var vs
get (A.Retypes _ am _ v) = abbrev am v

2
common/EvalConstants.hs
View File

@ -67,7 +67,7 @@ getConstantName :: (CSMR m, Die m) => A.Name -> m (Maybe A.Expression)
getConstantName n
= do st <- specTypeOfName n
case st of
A.IsExpr _ A.ValAbbrev _ e ->
A.Is _ A.ValAbbrev _ (A.ActualExpression e) ->
do (e', isConst, _) <- constantFold e
-- FIXME: This should update the definition if it's constant
-- (to avoid folding multiple times), but that would require

6
common/ShowCode.hs
View File

@ -499,10 +499,6 @@ instance ShowOccam A.Specification where
= showOccamLine $ showOccamM t >> space >> showName n >> colon
showOccamM (A.Specification _ n (A.Is _ am t v))
= showOccamLine $ (maybeVal am) >> showOccamM t >> space >> showName n >> tell [" IS "] >> showOccamM v >> colon
showOccamM (A.Specification _ n (A.IsExpr _ am t e))
= showOccamLine $ (maybeVal am) >> showOccamM t >> space >> showName n >> tell [" IS "] >> showOccamM e >> colon
showOccamM (A.Specification _ n (A.IsChannelArray _ t vs))
= showOccamLine $ showOccamM t >> space >> showName n >> tell [" IS ["] >> showWithCommas vs >> tell ["]:"]
showOccamM (A.Specification _ n (A.DataType _ t))
= showOccamLine $ tell ["DATA TYPE "] >> showName n >> tell [" IS "] >> showOccamM t >> colon
showOccamM (A.Specification _ n (A.RecordType _ attr fields))
@ -687,8 +683,6 @@ instance ShowRain A.Specification where
= showRainLine $ showRainM t >> colon >> showName n >> semi
showRainM (A.Specification _ n (A.Is _ am t v))
= showRainLine $ (maybeValRain am) >> showRainM t >> colon >> showName n >> tell [" = "] >> showRainM v >> semi
showRainM (A.Specification _ n (A.IsExpr _ am t e))
= showRainLine $ (maybeValRain am) >> showRainM t >> colon >> showName n >> tell [" = "] >> showRainM e >> semi
instance ShowRain A.Process where

36
common/Types.hs
View File

@ -80,6 +80,23 @@ instance ASTTypeable A.Formal where
instance ASTTypeable A.Actual where
astTypeOf (A.ActualVariable v) = astTypeOf v
astTypeOf (A.ActualExpression e) = astTypeOf e
astTypeOf (A.ActualClaim v)
= do t <- typeOfVariable v
case t of
A.Chan attr innerT -> return $ A.Chan (attr
{ A.caWritingShared = A.Unshared
, A.caReadingShared = A.Unshared
}) innerT
A.ChanEnd A.DirInput _ innerT
-> return $ A.ChanEnd A.DirInput A.Unshared innerT
A.ChanEnd A.DirOutput _ innerT
-> return $ A.ChanEnd A.DirOutput A.Unshared innerT
A.ChanDataType dir _ innerT -> return $ A.ChanDataType dir A.Unshared innerT
_ -> dieP (findMeta v) "Item in claim not channel"
astTypeOf (A.ActualChannelArray (v:vs))
= do t <- typeOfVariable v
return $ A.Array [A.Dimension $ makeConstant (findMeta v) (length vs+1)] t
-- | Gets the 'A.Type' for a given 'A.Name' by looking at its definition in the 'CompState'. Dies with an error if the name is unknown.
typeOfName :: (CSMR m, Die m) => A.Name -> m A.Type
@ -96,23 +113,6 @@ typeOfSpec' st
= case st of
A.Declaration a t -> return $ Just (t, A.Declaration a)
A.Is a b t c -> return $ Just (t, \t' -> A.Is a b t' c)
A.IsExpr a b t c -> return $ Just (t, \t' -> A.IsExpr a b t' c)
A.IsChannelArray a t b
-> return $ Just (t, \t' -> A.IsChannelArray a t' b)
A.IsClaimed m v
-> do t <- typeOfVariable v
let t' = case t of
A.Chan attr innerT -> Just $ A.Chan (attr
{ A.caWritingShared = A.Unshared
, A.caReadingShared = A.Unshared
}) innerT
A.ChanEnd A.DirInput _ innerT
-> Just $ A.ChanEnd A.DirInput A.Unshared innerT
A.ChanEnd A.DirOutput _ innerT
-> Just $ A.ChanEnd A.DirOutput A.Unshared innerT
A.ChanDataType dir _ innerT -> Just $ A.ChanDataType dir A.Unshared innerT
_ -> Nothing
return $ fmap (\x -> (x, error "typeOfSpec'")) t'
A.Retypes a b t c -> return $ Just (t, \t' -> A.Retypes a b t' c)
A.RetypesExpr a b t c
-> return $ Just (t, \t' -> A.RetypesExpr a b t' c)
@ -372,8 +372,6 @@ abbrevModeOfSpec :: A.SpecType -> A.AbbrevMode
abbrevModeOfSpec s
= case s of
A.Is _ am _ _ -> am
A.IsExpr _ am _ _ -> am
A.IsChannelArray _ _ _ -> A.Abbrev
A.Retypes _ am _ _ -> am
A.RetypesExpr _ am _ _ -> am
_ -> A.Original

4
data/CompState.hs
View File

@ -365,12 +365,12 @@ makeNonceCounter s m
-- | Generate and define a variable abbreviation.
makeNonceIs :: CSM m => String -> Meta -> A.Type -> A.AbbrevMode -> A.Variable -> m A.Specification
makeNonceIs s m t am v
= defineNonce m s (A.Is m am t v) am
= defineNonce m s (A.Is m am t (A.ActualVariable v)) am
-- | Generate and define an expression abbreviation.
makeNonceIsExpr :: CSM m => String -> Meta -> A.Type -> A.Expression -> m A.Specification
makeNonceIsExpr s m t e
= defineNonce m s (A.IsExpr m A.ValAbbrev t e) A.ValAbbrev
= defineNonce m s (A.Is m A.ValAbbrev t (A.ActualExpression e)) A.ValAbbrev
-- | Generate and define a variable.
makeNonceVariable :: CSM m => String -> Meta -> A.Type -> A.AbbrevMode -> m A.Specification

25
frontends/OccamTypes.hs
View File

@ -886,16 +886,16 @@ inferTypes = occamOnlyPass "Infer types"
return (tEnd, A.DirectedVariable m dir v')
_ -> return (t', v') -- no direction, or two
_ -> return (t', v')
return $ A.Is m am' t'' v''
A.IsExpr m am t e -> lift $
return $ A.Is m am' t'' $ A.ActualVariable v''
A.Is m am t (A.ActualExpression e) -> lift $
do am' <- recurse am
t' <- recurse t
e' <- inTypeContext (Just t') $ recurse e
t'' <- case t' of
A.Infer -> astTypeOf e'
_ -> return t'
return $ A.IsExpr m am' t'' e'
A.IsChannelArray m t vs ->
return $ A.Is m am' t'' (A.ActualExpression e')
A.Is m am t (A.ActualChannelArray vs) ->
-- No expressions in this -- but we may need to infer the type
-- of the variable if it's something like "cs IS [c]:".
do t' <- lift $ recurse t
@ -920,7 +920,7 @@ inferTypes = occamOnlyPass "Infer types"
,A.DirectedVariable m dir)
_ -> return (t'', id)
_ -> return (t'', id)
return $ A.IsChannelArray m t''' $ map f vs'
return $ A.Is m am t''' $ A.ActualChannelArray $ map f vs'
A.Function m sm ts fs (Left sel) -> lift $
do sm' <- recurse sm
ts' <- recurse ts
@ -1333,25 +1333,28 @@ checkSpecTypes = checkDepthM doSpecType
doSpecType :: Check A.SpecType
doSpecType (A.Place _ e) = checkExpressionInt e
doSpecType (A.Declaration _ _) = ok
doSpecType (A.Is m am t v)
doSpecType (A.Is m am t (A.ActualVariable v))
= do tv <- astTypeOf v
checkType (findMeta v) t tv
checkRefAM m am
amv <- abbrevModeOfVariable v
checkAbbrev m amv am
doSpecType (A.IsExpr m am t e)
doSpecType (A.Is m am t (A.ActualExpression e))
= do te <- astTypeOf e
checkType (findMeta e) t te
checkValAM m am
checkAbbrev m A.ValAbbrev am
doSpecType (A.IsClaimed m v)
= do t <- astTypeOf v
case t of
doSpecType (A.Is m am t (A.ActualClaim v))
= do tv <- astTypeOf v
checkAbbrev m A.Abbrev am
checkType (findMeta v) t tv
case tv of
A.ChanEnd _ A.Shared _ -> return ()
A.ChanDataType _ A.Shared _ -> return ()
_ -> dieP m "Expected shared channel end in claim"
doSpecType (A.IsChannelArray m rawT cs)
doSpecType (A.Is m am rawT (A.ActualChannelArray cs))
= do t <- resolveUserType m rawT
checkAbbrev m A.Abbrev am
let isChan (A.Chan {}) = True
isChan (A.ChanEnd {}) = True
isChan _ = False

8
frontends/ParseOccam.hs
View File

@ -1050,7 +1050,7 @@ valAbbrev
e <- expression
sColon
eol
return (A.Specification m n $ A.IsExpr m am t e, VariableName)
return (A.Specification m n $ A.Is m am t (A.ActualExpression e), VariableName)
<?> "abbreviation by value"
refAbbrevMode :: OccParser A.AbbrevMode
@ -1070,7 +1070,7 @@ refAbbrev oldVar nt
sColon
eol
t' <- direct t
return (A.Specification m n $ A.Is m am t' v, nt)
return (A.Specification m n $ A.Is m am t' $ A.ActualVariable v, nt)
<?> "abbreviation by reference"
chanArrayAbbrev :: OccParser NameSpec
@ -1085,7 +1085,7 @@ chanArrayAbbrev
sColon
eol
t' <- direct t
return (A.Specification m n $ A.IsChannelArray m t' cs, ChannelName)
return (A.Specification m n $ A.Is m A.Abbrev t' $ A.ActualChannelArray cs, ChannelName)
<?> "channel array abbreviation"
specMode :: OccParser a -> OccParser (A.SpecMode, a)
@ -1415,7 +1415,7 @@ claimSpec
n <- getName v >>= getOrigName
eol
indent
return ([(A.Specification m (A.Name m n) $ A.IsClaimed m v, ChannelName)], outdent)
return ([(A.Specification m (A.Name m n) $ A.Is m A.Abbrev A.Infer $ A.ActualClaim v, ChannelName)], outdent)
where
getName :: A.Variable -> OccParser A.Name
getName (A.Variable _ n) = return n

2
frontends/RainPasses.hs
View File

@ -306,7 +306,7 @@ excludeNonRainFeatures = rainOnlyPass "AST Validity check, Rain #1" [] []
,con3 A.InCounted
,con3 A.OutCounted
,con2 A.Place
,con3 A.IsChannelArray
,con1 A.ActualChannelArray
,con4 A.Retypes
,con4 A.RetypesExpr
,con0 A.PriPar

3
transformations/ImplicitMobility.hs
View File

@ -221,7 +221,8 @@ mobiliseArrays = pass "Make all arrays mobile" [] [] recurse
recurse scope >>* A.Spec m (A.Specification m' n newSpec)
Nothing -> descend s
_ -> do scope' <- recurse {-addAtEndOfScopeDyn m'' (A.ClearMobile m'' $ A.Variable m' n)-} scope
let newSpec = A.IsExpr m'' A.Original (A.Mobile t) $ A.AllocMobile m'' (A.Mobile t) Nothing
let newSpec = A.Is m'' A.Original (A.Mobile t) $
A.ActualExpression $ A.AllocMobile m'' (A.Mobile t) Nothing
modifyName n (\nd -> nd {A.ndSpecType = newSpec})
let name_sizes = n {A.nameName = A.nameName n ++ "_sizes"}
nd = A.NameDef {

8
transformations/SimplifyAbbrevs.hs
View File

@ -77,7 +77,7 @@ removeInitial
-- PROCTHEN
-- foo := bar
-- inner
A.IsExpr m'' A.InitialAbbrev t e ->
A.Is m'' A.InitialAbbrev t (A.ActualExpression e) ->
return $ declareAssign n t e inner
-- INITIAL retyping
@ -230,7 +230,7 @@ abbrevCheckPass
doStructured :: Data a => A.Structured a -> StateT [Map.Map Var Bool] PassM
(A.Structured a)
doStructured s@(A.Spec _ (A.Specification _ n (A.Is _ A.Abbrev _ v)) scope)
doStructured s@(A.Spec _ (A.Specification _ n (A.Is _ A.Abbrev _ (A.ActualVariable v))) scope)
= do nonce <- nameIsNonce n
ex <- isNameExempt n
if nonce || ex
@ -239,7 +239,7 @@ abbrevCheckPass
checkAbbreved v "Abbreviated variable % used inside the scope of the abbreviation"
pop
return s
doStructured s@(A.Spec _ (A.Specification m n (A.Is _ A.ValAbbrev _ v)) scope)
doStructured s@(A.Spec _ (A.Specification m n (A.Is _ A.ValAbbrev _ (A.ActualVariable v))) scope)
= do nonce <- nameIsNonce n
ex <- isNameExempt n
if nonce || ex
@ -249,7 +249,7 @@ abbrevCheckPass
checkNotWritten (A.Variable m n) "VAL-abbreviated variable % written-to inside the scope of the abbreviation"
pop
return s
doStructured s@(A.Spec _ (A.Specification m n (A.IsExpr _ A.ValAbbrev _ e)) scope)
doStructured s@(A.Spec _ (A.Specification m n (A.Is _ A.ValAbbrev _ (A.ActualExpression e))) scope)
= do nonce <- nameIsNonce n
ex <- isNameExempt n
if nonce || ex

4
transformations/SimplifyComms.hs
View File

@ -70,7 +70,9 @@ outExprs = pass "Define temporary variables for outputting expressions"
abbrevExpr :: Meta -> A.Expression -> PassM (A.Name, A.Structured A.Process -> A.Structured A.Process)
abbrevExpr m e = do t <- astTypeOf e
specification@(A.Specification _ nm _) <- defineNonce m "output_var" (A.IsExpr m A.ValAbbrev t e) A.ValAbbrev
specification@(A.Specification _ nm _) <-
defineNonce m "output_var" (A.Is m A.ValAbbrev t $
A.ActualExpression e) A.ValAbbrev
return (nm, A.Spec m specification)
{- The explanation for this pass is taken from my (Neil's) mailing list post "Case protocols" on tock-discuss, dated 10th October 2007:

14
transformations/SimplifyExprs.hs
View File

@ -212,9 +212,9 @@ transformConstr = pass "Transform array constructors into initialisation code"
-- SEQ i = rep
-- name += [expr]
doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
doStructured (A.Spec m (A.Specification m' n (A.IsExpr _ _ _
expr@(A.Literal m'' t (A.ArrayListLiteral _ (A.Spec _ (A.Specification _
repn (A.Rep _ rep)) repExp))))) scope)
doStructured (A.Spec m (A.Specification m' n (A.Is _ _ _
(A.ActualExpression expr@(A.Literal m'' t (A.ArrayListLiteral _ (A.Spec _ (A.Specification _
repn (A.Rep _ rep)) repExp)))))) scope)
= do case t of
A.Array {} ->
do indexVarSpec@(A.Specification _ indexName _) <- makeNonceVariable "array_constr_index" m'' A.Int A.Original
@ -370,13 +370,13 @@ pullUp pullUpArraysInsideRecords = pass "Pull up definitions"
-- | Filter what can be pulled in Specifications.
doSpecification :: A.Specification -> PassM A.Specification
-- Iss might be SubscriptedVars -- which is fine; the backend can deal with that.
doSpecification (A.Specification m n (A.Is m' am t v))
doSpecification (A.Specification m n (A.Is m' am t (A.ActualVariable v)))
= do v' <- descend v -- note descend rather than pullUp
return $ A.Specification m n (A.Is m' am t v')
return $ A.Specification m n (A.Is m' am t $ A.ActualVariable v')
-- IsExprs might be SubscriptedExprs, and if so we have to convert them.
doSpecification (A.Specification m n (A.IsExpr m' am t e))
doSpecification (A.Specification m n (A.Is m' am t (A.ActualExpression e)))
= do e' <- doExpression' e -- note doExpression' rather than recurse
return $ A.Specification m n (A.IsExpr m' am t e')
return $ A.Specification m n (A.Is m' am t $ A.ActualExpression e')
-- Convert RetypesExpr into Retypes of a variable.
doSpecification (A.Specification m n (A.RetypesExpr m' am toT e))
= do e' <- doExpression e

2
transformations/SimplifyProcs.hs
View File

@ -208,7 +208,7 @@ fixLowReplicators = pass "Fix low-count (0, 1) replicators" [] []
0 -> return $ A.Several m []
1 -> doStructured s >>*
A.Spec m (A.Specification m' n
(A.IsExpr m'' A.ValAbbrev A.Int begin))
(A.Is m'' A.ValAbbrev A.Int $ A.ActualExpression begin))
_ -> doStructured s >>* A.Spec m sp
doStructured (A.Spec m sp s) = doStructured s >>* A.Spec m sp

2
transformations/Unnest.hs
View File

@ -159,8 +159,6 @@ removeFreeNames = pass "Convert free names to arguments"
-- Declaration also covers PROC formals.
A.Declaration {} -> True
A.Is {} -> True
A.IsExpr {} -> True
A.IsChannelArray {} -> True
A.Retypes {} -> True
A.RetypesExpr {} -> True
A.Rep {} -> True