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

Implement channel direction decorators.

Browse Source 
This is mostly straightforward: modify the parser to allow direction
decorators in the right places, and extend the type checker to match.
There's some slight awkwardness in that some of the Types functions
have to perform the same checks as the type checker (e.g. directing a
non-channel), so I've tidied up their error messages a bit.

At the backend, I've just added a little pass to strip out all the
DirectedVariables, since the other backend passes don't handle them
gracefully. From the occam/C point of view this is fine, but I'm not
sure if it's going to cause problems for C++.
This commit is contained in:
Adam Sampson 2008-06-09 21:35:20 +00:00
parent 04f72a62db
commit 62a0873d3d
11 changed files with 443 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
LANGUAGE
View File

@ -23,3 +23,6 @@ PLACE IN WORKSPACE and PLACE IN VECSPACE, both currently ignored.
INITIAL and RESULT abbreviations.
Array constructors.
Direction decorators.

17
backends/BackendPasses.hs
View File

@ -36,7 +36,8 @@ import Utils
squashArrays :: [Pass]
squashArrays =
[ simplifySlices
[ removeDirections
, simplifySlices
, declareSizesArray
, addSizesFormalParameters
, addSizesActualParameters
@ -45,6 +46,20 @@ squashArrays =
prereq :: [Property]
prereq = Prop.agg_namesDone ++ Prop.agg_typesDone ++ Prop.agg_functionsGone ++ [Prop.subscriptsPulledUp, Prop.arrayLiteralsExpanded]
-- | Remove all variable directions.
-- They're unimportant in occam code once the directions have been checked,
-- and this somewhat simplifies the work of the later passes.
removeDirections :: Pass
removeDirections
= occamOnlyPass "Remove variable directions"
prereq
[Prop.directionsRemoved]
(applyDepthM (return . doVariable))
where
doVariable :: A.Variable -> A.Variable
doVariable (A.DirectedVariable _ _ v) = v
doVariable v = v
transformWaitFor :: Pass
transformWaitFor = cOnlyPass "Transform wait for guards into wait until guards"
[]

3
backends/GenerateC.hs
View File

@ -821,7 +821,8 @@ cgenVariable' checkValid v
collectSubs v = do t <- astTypeOf v
return ([], v, t)
-- | Return whether a type is one that is declared as a structure, but
-- abbreviated as a pointer.
indirectedType :: A.Type -> Bool
indirectedType (A.Record {}) = True
indirectedType (A.Chan A.DirUnknown _ _) = True

23
common/Types.hs
View File

@ -28,6 +28,7 @@ module Types
, makeAbbrevAM, makeConstant, makeDimension, addOne, subOne, addExprs, subExprs,
mulExprs, divExprs
, addDimensions, applyDimension, removeFixedDimensions, trivialSubscriptType, subscriptType, unsubscriptType
, applyDirection
, recordFields, protocolItems
, leastGeneralSharedTypeRain
@ -200,13 +201,15 @@ typeOfVariable (A.SubscriptedVariable m s v)
typeOfVariable (A.DerefVariable m v)
= do t <- typeOfVariable v
case t of
(A.Mobile innerT) -> return innerT
_ -> dieP m $ "Tried to dereference a non-mobile variable: " ++ show v
A.Mobile innerT -> return innerT
_ -> dieP m $ "Dereference applied to non-mobile variable"
typeOfVariable (A.DirectedVariable m dir v)
= do t <- typeOfVariable v
case t of
(A.Chan A.DirUnknown attr innerT) -> return (A.Chan dir attr innerT)
_ -> dieP m $ "Used specifier on something that was not a directionless channel: " ++ show v
case t of
A.Chan _ attr innerT -> return $ A.Chan dir attr innerT
A.Array ds (A.Chan _ attr innerT)
-> return $ A.Array ds (A.Chan dir attr innerT)
_ -> dieP m $ "Direction specified on non-channel variable"
-- | Get the abbreviation mode of a variable.
abbrevModeOfVariable :: (CSMR m, Die m) => A.Variable -> m A.AbbrevMode
@ -379,6 +382,16 @@ makeConstant m n = A.Literal m A.Int $ A.IntLiteral m (show n)
makeDimension :: Meta -> Int -> A.Dimension
makeDimension m n = A.Dimension $ makeConstant m n
-- | Apply a direction to a type.
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 idir ca t)
| (idir == A.DirUnknown || idir == dir) = return $ A.Chan dir ca t
| otherwise = dieP m "Direction specified does not match existing direction"
applyDirection m _ t
= dieP m "Direction specified on non-channel type"
-- | Checks whether a given conversion can be done implicitly in Rain
-- Parameters are src dest
isImplicitConversionRain :: A.Type -> A.Type -> Bool

24
frontends/OccamTypes.hs
View File

@ -77,16 +77,26 @@ areValidDimensions (d1:ds1) (d2:ds2)
else return False
areValidDimensions _ _ = return False
-- | Check that the second direction can be used in a context where the first
-- is expected.
isValidDirection :: A.Direction -> A.Direction -> Bool
isValidDirection _ A.DirUnknown = True
isValidDirection ed rd = ed == rd
-- | Check that a type we've inferred matches the type we expected.
checkType :: Meta -> A.Type -> A.Type -> PassM ()
checkType m et rt
= case (et, rt) of
(A.Infer, _) -> ok
((A.Array ds t), (A.Array ds' t')) ->
(A.Array ds t, A.Array ds' t') ->
do valid <- areValidDimensions ds ds'
if valid
then checkType m t t'
else bad
(A.Chan dir ca t, A.Chan dir' ca' t') ->
if isValidDirection dir dir' && (ca == ca')
then checkType m t t'
else bad
_ ->
do same <- sameType rt et
when (not same) $ bad
@ -1026,11 +1036,17 @@ checkVariables = checkDepthM doVariable
doVariable (A.SubscriptedVariable m s v)
= do t <- astTypeOf v
checkSubscript m s t
doVariable (A.DirectedVariable m _ v)
doVariable (A.DirectedVariable m dir v)
= do t <- astTypeOf v >>= resolveUserType m
case t of
A.Chan _ _ _ -> ok
_ -> dieP m $ "Direction applied to non-channel variable"
A.Chan oldDir _ _ -> checkDir oldDir
A.Array _ (A.Chan oldDir _ _) -> checkDir oldDir
_ -> dieP m $ "Direction specified on non-channel variable"
where
checkDir oldDir
= if isValidDirection dir oldDir
then ok
else dieP m "Direction specified does not match existing direction"
doVariable (A.DerefVariable m v)
= do t <- astTypeOf v >>= resolveUserType m
case t of

5
frontends/OccamTypesTest.hs
View File

@ -623,6 +623,9 @@ ioTests = liftM (TestLabel "OccamTypesTest" . TestList) $ sequence $
[ testOccamTypes
]
++ map (automaticTest FrontendOccam)
[ "testcases/automatic/initial-result-1.occ.test"
[ "testcases/automatic/direction-decorators-1.occ.test"
, "testcases/automatic/direction-decorators-2.occ.test"
, "testcases/automatic/direction-decorators-3.occ.test"
, "testcases/automatic/initial-result-1.occ.test"
, "testcases/automatic/initial-result-2.occ.test"
]

64
frontends/ParseOccam.hs
View File

@ -721,7 +721,7 @@ sizeExpr
do { t <- dataType; return $ A.SizeType m t }
<|> do v <- operand
return $ A.SizeExpr m v
<|> do v <- (channel <|> timer <|> port)
<|> do v <- (directedChannel <|> timer <|> port)
return $ A.SizeVariable m v
<?> "SIZE expression"
@ -846,6 +846,36 @@ channel'
<|> maybeSliced channel A.SubscriptedVariable
<?> "channel'"
direction :: OccParser A.Direction
direction
= (sQuest >> return A.DirInput)
<|> (sBang >> return A.DirOutput)
<|> return A.DirUnknown
<?> "direction decorator"
-- | Parse a production with an optional direction specifier,
-- returning a function to apply the direction specifier to a type and the
-- result of the inner production.
maybeDirected :: OccParser t -> OccParser (A.Type -> OccParser A.Type, t)
maybeDirected inner
= do v <- inner
m <- md
dir <- direction
return (case dir of
A.DirUnknown -> return
_ -> applyDirection m dir,
v)
-- | Parse a channel followed by an optional direction specifier.
directedChannel :: OccParser A.Variable
directedChannel
= do c <- channel
m <- md
dir <- direction
case dir of
A.DirUnknown -> return c
_ -> return $ A.DirectedVariable m dir c
timer :: OccParser A.Variable
timer
= maybeSubscripted "timer" timer' A.SubscriptedVariable
@ -956,7 +986,7 @@ abbreviation :: OccParser NameSpec
abbreviation
= valAbbrev
<|> refAbbrev variable VariableName
<|> refAbbrev channel ChannelName
<|> refAbbrev directedChannel ChannelName
<|> chanArrayAbbrev
<|> refAbbrev timer TimerName
<|> refAbbrev port PortName
@ -992,22 +1022,31 @@ refAbbrevMode
refAbbrev :: OccParser A.Variable -> NameType -> OccParser NameSpec
refAbbrev oldVar nt
= do m <- md
(am, t, n, v) <-
tryVVVXV refAbbrevMode (maybeInfer specifier) (newName nt) sIS oldVar
(am, t, (direct, n), v) <-
tryVVVXV refAbbrevMode
(maybeInfer specifier)
(maybeDirected $ newName nt)
sIS
oldVar
sColon
eol
return (A.Specification m n $ A.Is m am t v, nt)
t' <- direct t
return (A.Specification m n $ A.Is m am t' v, nt)
<?> "abbreviation by reference"
chanArrayAbbrev :: OccParser NameSpec
chanArrayAbbrev
= do m <- md
(t, n, cs) <-
tryVVXV (maybeInfer channelSpecifier) newChannelName (sIS >> sLeft) (sepBy1 channel sComma)
(t, (direct, n), cs) <-
tryVVXV (maybeInfer channelSpecifier)
(maybeDirected newChannelName)
(sIS >> sLeft)
(sepBy1 directedChannel sComma)
sRight
sColon
eol
return (A.Specification m n $ A.IsChannelArray m t cs, ChannelName)
t' <- direct t
return (A.Specification m n $ A.IsChannelArray m t' cs, ChannelName)
<?> "channel array abbreviation"
specMode :: OccParser () -> OccParser A.SpecMode
@ -1062,7 +1101,7 @@ retypesAbbrev
return (A.Specification m n $ A.Retypes m am s v, VariableName)
<|> do m <- md
(s, n) <- tryVVX channelSpecifier newChannelName retypesReshapes
c <- channel
c <- directedChannel
sColon
eol
return (A.Specification m n $ A.Retypes m A.Abbrev s c, ChannelName)
@ -1128,9 +1167,10 @@ formalItem spec nt
where
names :: A.AbbrevMode -> A.Type -> OccParser [NameFormal]
names am t
= do n <- newName nt
= do (direct, n) <- maybeDirected $ newName nt
fs <- tail am t
return $ (A.Formal am t n, nt) : fs
t' <- direct t
return $ (A.Formal am t' n, nt) : fs
tail :: A.AbbrevMode -> A.Type -> OccParser [NameFormal]
tail am t
@ -1571,7 +1611,7 @@ actual (A.Formal am t n)
A.ValAbbrev -> expression >>* A.ActualExpression
_ ->
case stripArrayType t of
A.Chan {} -> var channel
A.Chan {} -> var directedChannel
A.Timer {} -> var timer
A.Port _ -> var port
_ -> var variable

9
pass/Properties.hs
View File

@ -34,6 +34,7 @@ module Properties
, declarationsUnique
, declarationTypesRecorded
, declaredNamesResolved
, directionsRemoved
, eachRangeTransformed
, eachTransformed
, expressionTypesChecked
@ -414,3 +415,11 @@ resultRemoved
= Property "resultRemoved" $
checkNull "resultRemoved" . listify (== A.ResultAbbrev)
directionsRemoved :: Property
directionsRemoved
= Property "directionsRemoved" $
checkNull "directionsRemoved" . listify findVariable
where
findVariable :: A.Variable -> Bool
findVariable (A.DirectedVariable {}) = True
findVariable _ = False

173
testcases/automatic/direction-decorators-1.occ.test Normal file
View File

@ -0,0 +1,173 @@
-- This file tests direction decorators for abbreviations.
PROC main ()
CHAN INT c, d:
[10]CHAN INT cs:
SEQ
%%
SKIP
:
%PASS Nothing to do
%PASS Normal kinds of abbreviations
-- Actually, these probably shouldn't be allowed, since they're
-- abbreviating a whole channel.
CHAN INT abbrev IS c:
inferred.abbrev IS c:
[]CHAN INT chan.array IS [c, d]:
[]CHAN INT chans IS cs:
%FAIL Abbreviate channel array to channel
CHAN INT chan IS cs:
%PASS Abbreviate output end (no dir)
CHAN INT out! IS c:
%PASS Abbreviate output end
CHAN INT out! IS c!:
%FAIL Abbreviate output end (bad dir)
CHAN INT out! IS c?:
%PASS Abbreviate input end (no dir)
CHAN INT in? IS c:
%PASS Abbreviate input end
CHAN INT in? IS c?:
%FAIL Abbreviate input end (bad dir)
CHAN INT in? IS c!:
%PASS Abbreviate output end from array (no dir)
CHAN INT out! IS cs[0]:
%PASS Abbreviate output end from array
CHAN INT out! IS cs[0]!:
%FAIL Abbreviate output end from array (bad dir)
CHAN INT out! IS cs[0]?:
%PASS Abbreviate input end from array (no dir)
CHAN INT in? IS cs[0]:
%PASS Abbreviate input end from array
CHAN INT in? IS cs[0]?:
%FAIL Abbreviate input end from array (bad dir)
CHAN INT in? IS cs[0]!:
%PASS Abbreviate input ends of array (no dir)
[]CHAN INT ins? IS cs:
%PASS Abbreviate input ends of array
[]CHAN INT ins? IS cs?:
%FAIL Abbreviate input ends of array (bad dir)
[]CHAN INT ins? IS cs!:
%PASS Abbreviate output ends of array (no dir)
[]CHAN INT outs! IS cs:
%PASS Abbreviate output ends of array
[]CHAN INT outs! IS cs!:
%FAIL Abbreviate output ends of array (bad dir)
[]CHAN INT outs! IS cs?:
%PASS Abbreviate output end of abbreviation (no dir)
CHAN INT out! IS c!:
CHAN INT out.2! IS out:
%PASS Abbreviate output end of abbreviation
CHAN INT out! IS c!:
CHAN INT out.2! IS out!:
%FAIL Abbreviate output end of abbreviation (bad dir)
CHAN INT out! IS c!:
CHAN INT out.2! IS out?:
%FAIL Abbreviate output end of abbreviation (to input, mismatched)
CHAN INT out! IS c!:
CHAN INT in? IS out!:
%FAIL Abbreviate output end of abbreviation (to input, matched)
CHAN INT out! IS c!:
CHAN INT in? IS out?:
%PASS Abbreviate input end of abbreviation (no dir)
CHAN INT in? IS c?:
CHAN INT in.2? IS in:
%PASS Abbreviate input end of abbreviation
CHAN INT in? IS c?:
CHAN INT in.2? IS in?:
%FAIL Abbreviate input end of abbreviation (bad dir)
CHAN INT in? IS c?:
CHAN INT in.2? IS in!:
%FAIL Abbreviate input end of abbreviation (to output, mismatched)
CHAN INT in? IS c?:
CHAN INT out! IS in?:
%FAIL Abbreviate input end of abbreviation (to output, matched)
CHAN INT in? IS c?:
CHAN INT out! IS in!:
%PASS Abbreviate input ends of abbreviation (no dir)
[]CHAN INT ins? IS cs:
[]CHAN INT ins.2? IS ins:
%PASS Abbreviate input ends of abbreviation
[]CHAN INT ins? IS cs:
[]CHAN INT ins.2? IS ins?:
%FAIL Abbreviate input ends of abbreviation (bad dir)
[]CHAN INT ins? IS cs:
[]CHAN INT ins.2? IS ins!:
%FAIL Abbreviate input ends of abbreviation (to outputs, mismatched)
[]CHAN INT ins? IS cs:
[]CHAN INT outs! IS ins?:
%FAIL Abbreviate input ends of abbreviation (to outputs, matched)
[]CHAN INT ins? IS cs:
[]CHAN INT outs! IS ins!:
%FAIL Abbreviate channels to end
CHAN INT out! IS cs:
%FAIL Abbreviate channel to ends
[]CHAN INT outs! IS c:
%PASS Abbreviate output ends array (no dirs)
[]CHAN INT outs! IS [c, d]:
%PASS Abbreviate output ends array
[]CHAN INT outs! IS [c!, d!]:
%FAIL Abbreviate output ends array (both bad)
[]CHAN INT outs! IS [c?, d?]:
%FAIL Abbreviate output ends array (inconsistent 1)
[]CHAN INT outs! IS [c?, d!]:
%FAIL Abbreviate output ends array (inconsistent 2)
[]CHAN INT outs! IS [c!, d?]:
%PASS Abbreviate input ends array
[]CHAN INT ins? IS [c?, d?]:
%FAIL Can't use directions on inferred-type abbreviations
out! IS c:
%FAIL Can't use directions on things that aren't channels
INT x:
INT y! IS x:
%FAIL Can't use multiple directions
CHAN INT out!!!! IS c:
%

85
testcases/automatic/direction-decorators-2.occ.test Normal file
View File

@ -0,0 +1,85 @@
-- This file tests direction decorators for actuals.
PROC main ()
CHAN INT c:
[10]CHAN INT cs:
INT n:
CHAN INT out! IS c!:
CHAN INT in? IS c?:
PROC unknown (CHAN INT c)
SKIP
:
PROC known.out (CHAN INT c!)
c ! 42
:
PROC known.in (CHAN INT c?)
c ? n
:
PROC known.outs ([]CHAN INT cs!)
cs[0] ! 42
:
PROC known.ins ([]CHAN INT cs?)
cs[0] ? n
:
SEQ
%%
SKIP
:
%PASS Nothing to do
%PASS Unknown for unknown
unknown (c)
%FAIL Unknown for output
unknown (out!)
%FAIL Unknown for input
unknown (in?)
%PASS Output for unknown
known.out (c)
%PASS Output for directed unknown
known.out (c!)
%FAIL Output for directed unknown (wrong dir)
known.out (c?)
%PASS Output for output
known.out (out!)
%FAIL Output for output (wrong dir)
known.out (out?)
%FAIL Output for input
known.out (in?)
%FAIL Output for input (wrong dir)
known.out (in!)
%PASS Input for unknown
known.in (c)
%PASS Input for directed unknown
known.in (c?)
%FAIL Input for directed unknown (wrong dir)
known.in (c!)
%FAIL Input for output
known.in (out!)
%FAIL Input for output (wrong dir)
known.in (out?)
%PASS Input for input
known.in (in?)
%FAIL Input for input (wrong dir)
known.in (in!)
%

61
testcases/automatic/direction-decorators-3.occ.test Normal file
View File

@ -0,0 +1,61 @@
-- This file tests direction decorators for formals.
PROC main ()
INT n:
SEQ
%%
SKIP
:
%PASS Nothing to do
%PASS Abbreviate unknown as input
PROC p (CHAN INT c)
CHAN INT in? IS c?:
SKIP
:
%PASS Abbreviate input as input
PROC p (CHAN INT c?)
CHAN INT in? IS c?:
SKIP
:
%FAIL Abbreviate input as output
PROC p (CHAN INT c?)
CHAN INT out! IS c?:
SKIP
:
%PASS Use unknown as input
PROC p (CHAN INT c)
c ? n
:
%PASS Use input as input
PROC p (CHAN INT c?)
c ? n
:
%FAIL Use input as output
PROC p (CHAN INT c?)
c ! 42
:
%PASS Use unknown array as input
PROC p ([]CHAN INT cs)
cs[0] ? n
:
%PASS Use input array as input
PROC p ([]CHAN INT cs?)
cs[0] ? n
:
%FAIL Use input array as output
PROC p ([]CHAN INT cs?)
cs[0] ! 42
:
%