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

Changed the ChanEnd constructor to only keep information about its shared-ness, not about the whole channel

Browse Source
This commit is contained in:
Neil Brown 2009-03-23 18:40:28 +00:00
parent e8fec8585b
commit 41805aaacf
8 changed files with 28 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
common/ShowCode.hs
View File

@ -255,11 +255,9 @@ instance ShowOccam A.Type where
= tell [shared, "CHAN", direction, " "] >> showOccamM t
where
shared
= case (A.caWritingShared ca, A.caReadingShared ca) of
(A.Unshared, A.Unshared) -> ""
(A.Shared, A.Unshared) -> "SHARED! "
(A.Unshared, A.Shared) -> "SHARED? "
(A.Shared, A.Shared) -> "SHARED "
= case ca of
A.Unshared -> ""
A.Shared -> "SHARED "
direction
= case dir of
A.DirInput -> "?"
@ -303,8 +301,8 @@ instance ShowRain A.Type where
ao b = if b == A.Shared then "any" else "one"
showRainM (A.ChanEnd dir attr t)
= case dir of
A.DirInput -> tell [if A.caReadingShared attr == A.Shared then "shared" else "", " ?"] >> showRainM t
A.DirOutput -> tell [if A.caWritingShared attr == A.Shared then "shared" else "", " !"] >> showRainM t
A.DirInput -> tell [if attr == A.Shared then "shared" else "", " ?"] >> showRainM t
A.DirOutput -> tell [if attr == A.Shared then "shared" else "", " !"] >> showRainM t
where
ao :: Bool -> String
ao b = if b then "any" else "one"

13
common/Types.hs
View File

@ -29,7 +29,7 @@ module Types
mulExprs, divExprs
, addDimensions, applyDimension, removeFixedDimensions, trivialSubscriptType, subscriptType, unsubscriptType
, applyDirection
, recordFields, recordAttr, protocolItems
, recordFields, recordAttr, protocolItems, dirAttr
, leastGeneralSharedTypeRain
@ -133,6 +133,9 @@ recordAttr m (A.Record rec)
_ -> dieP m "not record type"
recordAttr m _ = dieP m "not record type"
dirAttr :: A.Direction -> A.ChanAttributes -> A.ShareMode
dirAttr A.DirInput = A.caReadingShared
dirAttr A.DirOutput = A.caWritingShared
-- | Get the type of a record field.
typeOfRecordField :: (CSMR m, Die m) => Meta -> A.Type -> A.Name -> m A.Type
@ -228,14 +231,14 @@ typeOfVariable (A.DirectedVariable m dir v)
if dir == dir'
then return t
else dieP m $ "Attempted to reverse direction of a channel-end"
A.Chan attr innerT -> return $ A.ChanEnd dir attr innerT
A.Chan attr innerT -> return $ A.ChanEnd dir (dirAttr dir attr) innerT
A.Array ds (A.Chan attr innerT)
-> return $ A.Array ds (A.ChanEnd dir attr innerT)
-> return $ A.Array ds (A.ChanEnd dir (dirAttr dir attr) innerT)
A.Array _ (A.ChanEnd dir' _ _) ->
if dir == dir'
then return t
else dieP m $ "Attempted to reverse direction of a channel-end"
A.Infer -> return $ A.ChanEnd dir (A.ChanAttributes A.Unshared A.Unshared) A.Infer
A.Infer -> return $ A.ChanEnd dir A.Unshared A.Infer
_ -> diePC m $ formatCode "Direction specified on non-channel variable of type: %" t
-- | Get the abbreviation mode of a variable.
@ -415,7 +418,7 @@ applyDirection :: Die m => Meta -> A.Direction -> A.Type -> m A.Type
applyDirection m dir (A.Array ds t)
= applyDirection m dir t >>* A.Array ds
applyDirection m dir (A.Chan ca t)
= return $ A.ChanEnd dir ca t
= return $ A.ChanEnd dir (dirAttr dir ca) t
applyDirection m _ t
= dieP m "Direction specified on non-channel type"

2
data/AST.hs
View File

@ -133,7 +133,7 @@ data Type =
-- | A channel of the specified type.
| Chan ChanAttributes Type
-- | A channel end of the specified type.
| ChanEnd Direction ChanAttributes Type
| ChanEnd Direction ShareMode Type
-- | A counted input or output.
-- The first type is that of the count; the second is that of the array.
-- (For example, @INT::[]BYTE@ would be @A.Counted A.Int (A.Array ...)@).

17
frontends/OccamTypes.hs
View File

@ -428,14 +428,13 @@ checkChannel wantDir c
= do -- Check it's a channel.
t <- astTypeOf c >>= resolveUserType m
case t of
A.ChanEnd dir (A.ChanAttributes ws rs) innerT ->
A.ChanEnd dir sh innerT ->
do -- Check the direction is appropriate
when (wantDir /= dir) $ dieP m $ "Channel directions do not match"
-- Check it's not shared in the direction we're using.
case (ws, rs, wantDir) of
(A.Unshared, _, A.DirOutput) -> ok
(_, A.Unshared, A.DirInput) -> ok
_ -> dieP m $ "Shared channel must be claimed before use"
case sh of
A.Unshared -> ok
A.Shared -> dieP m $ "Shared channel must be claimed before use"
return innerT
_ -> diePC m $ formatCode ("Expected channel " ++ exp ++ "; found %") t
@ -851,7 +850,7 @@ inferTypes = occamOnlyPass "Infer types"
do dirs <- ask >>= (lift . findDir n)
case nub dirs of
[dir] ->
do let tEnd = A.ChanEnd dir attr innerT
do let tEnd = A.ChanEnd dir (dirAttr dir attr) innerT
return (tEnd, A.DirectedVariable m dir v')
_ -> return (vt, v') -- no direction, or two
(A.Infer, _) -> return (vt, v')
@ -870,7 +869,7 @@ inferTypes = occamOnlyPass "Infer types"
do dirs <- ask >>= (lift . findDir n)
case nub dirs of
[dir] ->
do let tEnd = A.ChanEnd dir attr innerT
do let tEnd = A.ChanEnd dir (dirAttr dir attr) innerT
return (tEnd, A.DirectedVariable m dir v')
_ -> return (t', v') -- no direction, or two
_ -> return (t', v')
@ -904,7 +903,7 @@ inferTypes = occamOnlyPass "Infer types"
A.Array ds (A.Chan attr innerT) -> do
dirs <- ask >>= (lift . findDir n)
case nub dirs of
[dir] -> return (A.Array ds $ A.ChanEnd dir attr innerT
[dir] -> return (A.Array ds $ A.ChanEnd dir (dirAttr dir attr) innerT
,A.DirectedVariable m dir)
_ -> return (t'', id)
_ -> return (t'', id)
@ -931,7 +930,7 @@ inferTypes = occamOnlyPass "Infer types"
do dirs <- findDir n body
case nub dirs of
[dir] ->
do let t' = A.ChanEnd dir attr innerT
do let t' = A.ChanEnd dir (dirAttr dir attr) innerT
f' = A.Formal am t' n
modifyName n (\nd -> nd {A.ndSpecType =
A.Declaration m t'})

2
frontends/ParseOccam.hs
View File

@ -1182,7 +1182,7 @@ definition
dir <- direction
sColon
eol
return (n, A.ChanEnd dir (A.ChanAttributes A.Unshared A.Unshared) t)
return (n, A.ChanEnd dir A.Unshared t)
retypesAbbrev :: OccParser NameSpec
retypesAbbrev

4
frontends/ParseRain.hs
View File

@ -168,8 +168,8 @@ dataType
<|> do {reserved "sint64" ; return A.Int64}
<|> do {reserved "time" ; return A.Time}
<|> do {sChannel ; inner <- dataType ; return $ A.Chan (A.ChanAttributes {A.caWritingShared = A.Unshared, A.caReadingShared = A.Unshared}) inner}
<|> do {sIn ; inner <- dataType ; return $ A.ChanEnd A.DirInput (A.ChanAttributes {A.caWritingShared = A.Unshared, A.caReadingShared = A.Unshared}) inner}
<|> do {sOut ; inner <- dataType ; return $ A.ChanEnd A.DirOutput (A.ChanAttributes {A.caWritingShared = A.Unshared, A.caReadingShared = A.Unshared}) inner}
<|> do {sIn ; inner <- dataType ; return $ A.ChanEnd A.DirInput A.Unshared inner}
<|> do {sOut ; inner <- dataType ; return $ A.ChanEnd A.DirOutput A.Unshared inner}
<|> do {sLeftQ ; inner <- dataType ; sRightQ ; return $ A.List inner}
<|> do {(m,n) <- identifier ; return $ A.UserDataType A.Name {A.nameMeta = m, A.nameName = n}}
<?> "data type"

6
frontends/RainTypes.hs
View File

@ -282,8 +282,7 @@ markCommTypes = checkDepthM2 checkInputOutput checkAltInput
where
checkInput :: A.Variable -> A.Variable -> Meta -> a -> RainTypeM ()
checkInput chanVar destVar m p
= astTypeOf destVar >>= markUnify chanVar . A.ChanEnd A.DirInput (A.ChanAttributes
A.Unshared A.Unshared)
= astTypeOf destVar >>= markUnify chanVar . A.ChanEnd A.DirInput A.Unshared
checkWait :: RainTypeCheck A.InputMode
checkWait (A.InputTimerFor m exp) = markUnify A.Time exp
@ -298,8 +297,7 @@ markCommTypes = checkDepthM2 checkInputOutput checkAltInput
checkInputOutput (A.Input _ _ im@(A.InputTimerAfter {})) = checkWait im
checkInputOutput (A.Input _ _ im@(A.InputTimerRead {})) = checkWait im
checkInputOutput p@(A.Output m chanVar [A.OutExpression m' srcExp])
= astTypeOf srcExp >>= markUnify chanVar . A.ChanEnd A.DirOutput (A.ChanAttributes
A.Unshared A.Unshared)
= astTypeOf srcExp >>= markUnify chanVar . A.ChanEnd A.DirOutput A.Unshared
checkInputOutput _ = return ()
checkAltInput :: RainTypeCheck A.Alternative

2
transformations/SimplifyExprs.hs
View File

@ -460,7 +460,7 @@ pullUp pullUpArraysInsideRecords = pass "Pull up definitions"
n) v) innerV (replicate i $ makeConstant m 0)
| (d, i) <- zip ds [0..]]
spec@(A.Specification _ n _) <- makeNonceIs "dir_array" m
(A.Array ds' $ A.ChanEnd dir attr innerT) A.Abbrev v
(A.Array ds' $ A.ChanEnd dir (dirAttr dir attr) innerT) A.Abbrev v
addPulled $ (m, Left spec)
return $ A.Variable m n
_ -> descend v