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

Change A.Dimension to take an Expression, not an Int.

Browse Source 
This touches an awful lot of code, but cgtest07/17 (arrays and retyping) pass.

This is useful because there are going to be places in the future where we'll
want to represent dimensions that are known at runtime but not at compile time
-- for example, mobile allocations, or dynamically-sized arrays. It simplifies
the code in a number of places.

However, we do now need to be careful that expressions containing variables do
not leak into the State, since they won't be affected by later passes.

Two caveats (marked as FIXMEs in the source):

- Retypes checking in the occam parser is disabled, since the plan is to move
  it out to a pass anyway.
- There's some (now very obvious) duplication, particularly in the backend, of
  bits of code that construct expressions for the total size of an array
  (either in bytes or elements); this should be moved to a couple of helper
  functions that everything can use.
This commit is contained in:
Adam Sampson 2008-03-18 16:45:38 +00:00
parent 0f0072866c
commit b1416bb0cf
16 changed files with 365 additions and 286 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
backends/BackendPasses.hs
View File

@ -99,39 +99,51 @@ declareSizesArray = doGeneric `ext1M` doStructured
A.SubscriptFromFor _ _ for -> (Just for, snd $ findInnerVar v) -- Keep the outer most
A.Subscript {} -> findInnerVar v
findInnerVar v = (Nothing, v)
-- | Generate the @_sizes@ array for a 'Retypes' expression.
retypesSizes :: Meta -> A.Name -> [A.Dimension] -> A.Type -> A.Variable -> PassM A.Specification
retypesSizes m n_sizes ds elemT v
-- Multiply together all known dimensions
= do let knownDimsTotal = foldl (*) 1 [n | A.Dimension n <- ds]
-- Get the number of bytes in each element (must be known at compile-time)
BIJust biElem <- bytesInType elemT
t <- typeOfVariable v
birhs <- bytesInType t
sizeSpecType <- case birhs of
-- Statically known size; we can check right here whether it fits:
BIJust bytes -> case bytes `mod` (knownDimsTotal * biElem) of
0 -> return $ makeStaticSizeSpec m n_sizes
[if d == A.UnknownDimension then A.Dimension (bytes `div` (knownDimsTotal * biElem)) else d | d <- ds]
_ -> dieP m "RETYPES has sizes that do not fit"
_ -> do totalSizeExpr <- case birhs of
BIUnknown -> return $ A.BytesInType m t
-- An array with a dimension are not known at compile-time:
_ -> do let A.Array srcDs elemSrcT = t
BIJust biSrcElem <- bytesInType elemSrcT
let A.Variable _ srcN = v
multipliedDimsV = foldl (A.Dyadic m A.Mul) (makeConstant m biSrcElem)
[A.ExprVariable m $ A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) (A.Variable m $ append_sizes srcN) | i <- [0 .. length srcDs - 1]]
return multipliedDimsV
return $ makeDynamicSizeSpec m n_sizes
[case d of
-- TODO add a run-time check here for invalid retypes
A.UnknownDimension -> A.Dyadic m A.Div totalSizeExpr
(makeConstant m $ knownDimsTotal * biElem)
A.Dimension n -> makeConstant m n
| d <- ds]
defineSizesName m n_sizes sizeSpecType
return $ A.Specification m n_sizes sizeSpecType
retypesSizes m n_sizes ds elemT v@(A.Variable _ nSrc)
= do biDest <- bytesInType (A.Array ds elemT)
tSrc <- typeOfVariable v
biSrc <- bytesInType tSrc
-- Figure out the size of the source.
srcSize <-
case (biSrc, tSrc) of
-- Fixed-size source -- easy.
(BIJust size, _) -> return size
-- Variable-size source -- it must be an array, so multiply
-- together the dimensions.
(_, A.Array ds t) ->
do BIJust elementSize <- bytesInType t
return $ foldl mulExprs elementSize dSizes
where
srcSizes = A.Variable m $ append_sizes nSrc
dSizes = [case d of
-- Fixed dimension.
A.Dimension e -> e
-- Variable dimension -- use the corresponding
-- element of its _sizes array.
A.UnknownDimension ->
A.ExprVariable m $ A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) srcSizes
| (d, i) <- zip ds [0..]]
_ -> dieP m "Cannot compute size of source type"
-- Build the _sizes array for the destination.
sizeSpecType <-
case biDest of
-- Destination size is fixed -- so we must know the dimensions.
BIJust _ ->
return $ makeStaticSizeSpec m n_sizes ds
-- Destination has one free dimension, so we need to compute
-- it.
BIOneFree destSize n ->
let newDim = A.Dimension $ divExprs srcSize destSize
ds' = replaceAt n newDim ds in
return $ makeStaticSizeSpec m n_sizes ds'
defineSizesName m n_sizes sizeSpecType
return $ A.Specification m n_sizes sizeSpecType
abbrevVarSizes :: Meta -> A.Name -> [A.Dimension] -> A.Variable -> PassM A.Specification
abbrevVarSizes m n_sizes ds outerV
@ -150,12 +162,13 @@ declareSizesArray = doGeneric `ext1M` doStructured
-- Calculate the correct subscript into the source _sizes variable to get to the dimensions for the destination:
let sizeDiff = length srcDs - length ds
subSrcSizeVar = A.SubscriptedVariable m (A.SubscriptFromFor m (makeConstant m sizeDiff) (makeConstant m $ length ds)) varSrcSizes
sizeType = A.Array [makeDimension m $ length ds] A.Int
sizeSpecType = case sliceSize of
Just exp -> let subDims = [A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m n) varSrcSizes | n <- [1 .. (length srcDs - 1)]] in
A.IsExpr m A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) $
A.Literal m (A.Array [A.Dimension $ length ds] A.Int) $ A.ArrayLiteral m $
A.IsExpr m A.ValAbbrev sizeType $
A.Literal m sizeType $ A.ArrayLiteral m $
[A.ArrayElemExpr exp] ++ map (A.ArrayElemExpr . A.ExprVariable m) subDims
Nothing -> A.Is m A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) subSrcSizeVar
Nothing -> A.Is m A.ValAbbrev sizeType subSrcSizeVar
defineSizesName m n_sizes sizeSpecType
return $ A.Specification m n_sizes sizeSpecType
@ -201,17 +214,14 @@ declareSizesArray = doGeneric `ext1M` doStructured
doStructured s = doGeneric s
makeStaticSizeSpec :: Meta -> A.Name -> [A.Dimension] -> A.SpecType
makeStaticSizeSpec m n ds = sizeSpecType
makeStaticSizeSpec m n ds = makeDynamicSizeSpec m n es
where
sizeType = A.Array [A.Dimension $ length ds] A.Int
sizeLit = A.Literal m sizeType $ A.ArrayLiteral m $
map (A.ArrayElemExpr . A.Literal m A.Int . A.IntLiteral m . show . \(A.Dimension d) -> d) ds
sizeSpecType = A.IsExpr m A.ValAbbrev sizeType sizeLit
es = [e | A.Dimension e <- ds]
makeDynamicSizeSpec :: Meta -> A.Name -> [A.Expression] -> A.SpecType
makeDynamicSizeSpec m n es = sizeSpecType
where
sizeType = A.Array [A.Dimension $ length es] A.Int
sizeType = A.Array [makeDimension m $ length es] A.Int
sizeLit = A.Literal m sizeType $ A.ArrayLiteral m $ map A.ArrayElemExpr es
sizeSpecType = A.IsExpr m A.ValAbbrev sizeType sizeLit
@ -233,7 +243,7 @@ addSizesFormalParameters = doGeneric `extM` doSpecification
doSpecification :: A.Specification -> PassM A.Specification
doSpecification (A.Specification m n (A.Proc m' sm args body))
= do (args', newargs) <- transformFormals args
= do (args', newargs) <- transformFormals m args
body' <- doGeneric body
let newspec = A.Proc m' sm args' body'
modify (\cs -> cs {csNames = Map.adjust (\nd -> nd { A.ndType = newspec }) (A.nameName n) (csNames cs)})
@ -252,14 +262,15 @@ addSizesFormalParameters = doGeneric `extM` doSpecification
,A.ndAbbrevMode = A.ValAbbrev
,A.ndPlacement = A.Unplaced}
transformFormals :: [A.Formal] -> PassM ([A.Formal], [A.Formal])
transformFormals [] = return ([],[])
transformFormals ((f@(A.Formal am t n)):fs)
transformFormals :: Meta -> [A.Formal] -> PassM ([A.Formal], [A.Formal])
transformFormals _ [] = return ([],[])
transformFormals m ((f@(A.Formal am t n)):fs)
= case t of
A.Array ds _ -> do let newf = A.Formal A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) (append_sizes n)
(rest, moreNew) <- transformFormals fs
A.Array ds _ -> do let sizeType = A.Array [makeDimension m $ length ds] A.Int
let newf = A.Formal A.ValAbbrev sizeType (append_sizes n)
(rest, moreNew) <- transformFormals m fs
return (f : newf : rest, newf : moreNew)
_ -> do (rest, new) <- transformFormals fs
_ -> do (rest, new) <- transformFormals m fs
return (f : rest, new)
-- | A pass for adding _sizes parameters to actuals in PROC calls
@ -276,10 +287,12 @@ addSizesActualParameters = doGeneric `extM` doProcess
transformActual :: A.Actual -> PassM [A.Actual]
transformActual a@(A.ActualVariable am (A.Array ds _) (A.Variable m n))
= do let a_sizes = A.Variable m (append_sizes n)
return [a, A.ActualVariable A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) a_sizes]
let sizeType = A.Array [makeDimension m $ length ds] A.Int
return [a, A.ActualVariable A.ValAbbrev sizeType a_sizes]
transformActual a@(A.ActualExpression (A.Array ds _) (A.ExprVariable _ (A.Variable m n)))
= do let a_sizes = A.Variable m (append_sizes n)
return [a, A.ActualVariable A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) a_sizes]
let sizeType = A.Array [makeDimension m $ length ds] A.Int
return [a, A.ActualVariable A.ValAbbrev sizeType a_sizes]
transformActual a = let t = case a of
A.ActualVariable _ t _ -> t
A.ActualExpression t _ -> t
@ -304,7 +317,7 @@ simplifySlices = doGeneric `extM` doVariable
= do v' <- doGeneric v
A.Array (d:_) _ <- typeOfVariable v'
limit <- case d of
A.Dimension n -> return $ makeConstant m' n
A.Dimension n -> return n
A.UnknownDimension -> return $ A.SizeVariable m' v'
from' <- doGeneric from
return (A.SubscriptedVariable m (A.SubscriptFromFor m' from' (A.Dyadic m A.Subtr limit from')) v')

35
backends/BackendPassesTest.hs
View File

@ -36,6 +36,7 @@ import TagAST
import TestFramework
import TestUtils
import TreeUtils
import Types
import Utils
m :: Meta
@ -168,7 +169,7 @@ instance Arbitrary StaticTypeList where
, (20, do len <- choose (1,5)
ns <- replicateM len $ choose (1,1000)
t <- oneof [return A.Int, return A.Byte]
return $ A.Array (map A.Dimension ns) t)
return $ A.Array (map dimension ns) t)
]
return $ StaticTypeList tl
@ -181,7 +182,7 @@ instance Arbitrary DynTypeList where
, (10, return A.Byte)
, (20, do len <- choose (1,5)
ds <- replicateM len $ oneof
[choose (1,1000) >>* A.Dimension
[choose (1,1000) >>* dimension
,return A.UnknownDimension]
t <- oneof [return A.Int, return A.Byte]
return $ A.Array ds t)
@ -194,7 +195,7 @@ newtype AbbrevTypesIs = AbbrevTypesIs ([A.Dimension], [A.Dimension], [A.Subscrip
instance Arbitrary AbbrevTypesIs where
arbitrary = do lenSrc <- choose (1,10)
lenDest <- choose (1, lenSrc)
srcDims <- replicateM lenSrc $ oneof [return A.UnknownDimension, choose (1,1000) >>* A.Dimension]
srcDims <- replicateM lenSrc $ oneof [return A.UnknownDimension, choose (1,1000) >>* dimension]
destDims <- flip mapM (take lenDest srcDims) $ \d ->
case d of
A.UnknownDimension -> return A.UnknownDimension
@ -229,8 +230,8 @@ qcTestDeclareSizes =
strFooSizes = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") fooSizesSpec)
isChanArrFoo :: Int -> (A.SpecType, A.SpecType, State CompState ())
isChanArrFoo n = (A.IsChannelArray emptyMeta (A.Array [A.Dimension n] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Byte) (replicate n $ variable "c")
,valSize [n], return ())
isChanArrFoo n = (A.IsChannelArray emptyMeta (A.Array [dimension n] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Byte) (replicate n $ variable "c")
,valSize [makeConstant emptyMeta n], return ())
isIsFoo :: ([A.Dimension], [A.Dimension], [A.Subscript]) -> (A.SpecType, A.SpecType, State CompState ())
isIsFoo (srcDims, destDims, subs)
@ -238,7 +239,7 @@ qcTestDeclareSizes =
(foldr (A.SubscriptedVariable emptyMeta) (variable "src") subs)
,specSizes, defSrc)
where
specSizes = A.Is emptyMeta A.ValAbbrev (A.Array [A.Dimension $ length destDims] A.Int) $
specSizes = A.Is emptyMeta A.ValAbbrev (A.Array [dimension $ length destDims] A.Int) $
A.SubscriptedVariable emptyMeta (A.SubscriptFromFor emptyMeta
(intLiteral $ toInteger $ length srcDims - length destDims)
(intLiteral $ toInteger $ length destDims)
@ -271,21 +272,21 @@ qcTestDeclareSizes =
checkSizeItems _ = const (return ())
isExprStaticFoo :: [Int] -> (A.SpecType, A.SpecType, State CompState ())
isExprStaticFoo ns = (A.IsExpr emptyMeta A.ValAbbrev t (A.True emptyMeta), valSize ns, return ())
isExprStaticFoo ns = (A.IsExpr emptyMeta A.ValAbbrev t (A.True emptyMeta), valSize (map (makeConstant emptyMeta) ns), return ())
where
t = A.Array (map A.Dimension ns) A.Byte
t = A.Array (map dimension ns) A.Byte
declFoo :: [Int] -> (A.SpecType, A.SpecType, State CompState ())
declFoo ns = (A.Declaration emptyMeta t, valSize ns, return ())
declFoo ns = (A.Declaration emptyMeta t, valSize (map (makeConstant emptyMeta) ns), return ())
where
t = A.Array (map A.Dimension ns) A.Byte
t = A.Array (map dimension ns) A.Byte
valSize :: [Int] -> A.SpecType
valSize ds = A.IsExpr emptyMeta A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) $ makeSizesLiteral ds
valSize :: [A.Expression] -> A.SpecType
valSize ds = A.IsExpr emptyMeta A.ValAbbrev (A.Array [dimension $ length ds] A.Int) $ makeSizesLiteral ds
makeSizesLiteral :: [Int] -> A.Expression
makeSizesLiteral xs = A.Literal emptyMeta (A.Array [A.Dimension $ length xs] A.Int) $ A.ArrayLiteral emptyMeta $
map (A.ArrayElemExpr . A.Literal emptyMeta A.Int . A.IntLiteral emptyMeta . show) xs
makeSizesLiteral :: [A.Expression] -> A.Expression
makeSizesLiteral xs = A.Literal emptyMeta (A.Array [dimension $ length xs] A.Int) $ A.ArrayLiteral emptyMeta $
map A.ArrayElemExpr xs
checkFooSizes :: TestMonad m r => A.SpecType -> CompState -> m ()
checkFooSizes sp = checkName "foo_sizes" sp A.ValAbbrev
@ -341,7 +342,7 @@ qcTestSizeParameters =
args = [("x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts]
argsWithSizes = concat [
case t of
(A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [A.Dimension $ length ds] A.Int, A.ValAbbrev)]
(A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [dimension $ length ds] A.Int, A.ValAbbrev)]
_ -> [("x" ++ show n, t, A.Abbrev)]
| (n, t) <- zip [(0::Integer)..] ts]
@ -357,7 +358,7 @@ qcTestSizeParameters =
args = [("x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts]
argsWithSizes = concat [
case t of
(A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [A.Dimension $ length ds] A.Int, A.ValAbbrev)]
(A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [dimension $ length ds] A.Int, A.ValAbbrev)]
_ -> [("x" ++ show n, t, A.Abbrev)]
| (n, t) <- zip [(0::Integer)..] ts]

25
backends/GenerateC.hs
View File

@ -254,7 +254,7 @@ cgenOverArray m var func
A.UnknownDimension ->
do call genVariable var
call genSizeSuffix (show v)
A.Dimension n -> tell [show n]
A.Dimension n -> call genExpression n
tell [";"]
call genVariable i
tell ["++){"]
@ -379,8 +379,13 @@ cgenBytesIn m t v
Just s -> tell ["sizeof(", s, ")"]
Nothing -> diePC m $ formatCode "genBytesIn' %" t
-- FIXME: This could be done by generating an expression for the size,
-- which is what declareSizesPass has to do -- they should share a helper
-- function.
genBytesInArrayDim :: (A.Dimension,Int) -> CGen ()
genBytesInArrayDim (A.Dimension n, _) = tell [show n, "*"]
genBytesInArrayDim (A.Dimension n, _)
= do call genExpression n
tell ["*"]
genBytesInArrayDim (A.UnknownDimension, i)
= case v of
Right rv ->
@ -565,9 +570,10 @@ cgenUnfoldedVariable m var
where
unfoldArray :: [A.Dimension] -> A.Variable -> CGen ()
unfoldArray [] v = call genUnfoldedVariable m v
unfoldArray (A.Dimension n:ds) v
= seqComma $ [unfoldArray ds (A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) v)
| i <- [0..(n - 1)]]
unfoldArray (A.Dimension e:ds) v
= do n <- evalIntExpression e
seqComma $ [unfoldArray ds (A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) v)
| i <- [0..(n - 1)]]
unfoldArray _ _ = dieP m "trying to unfold array with unknown dimension"
-- | Generate a decimal literal -- removing leading zeroes to avoid producing
@ -831,7 +837,7 @@ cgenExpression (A.SizeExpr m e)
cgenExpression (A.SizeVariable m v)
= do A.Array (d:_) _ <- typeOfVariable v
case d of
A.Dimension n -> tell [show n]
A.Dimension n -> call genExpression n
A.UnknownDimension -> do call genVariable v
call genSizeSuffix "0"
cgenExpression (A.Conversion m cm t e) = call genConversion m cm t e
@ -1136,8 +1142,9 @@ cgenFlatArraySize :: [A.Dimension] -> CGen ()
cgenFlatArraySize ds
= do tell ["["]
sequence $ intersperse (tell ["*"])
[case d of A.Dimension n -> tell [show n] | d <- ds]
[call genExpression n | A.Dimension n <- ds]
tell ["]"]
-- FIXME: genBytesInArrayDim could share with this
-- | Initialise an item being declared.
cdeclareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ())
@ -1153,7 +1160,9 @@ cdeclareInit m t@(A.Array ds t') var
tell ["_storage,"]
call genVariableUnchecked var
tell [","]
sequence_ $ intersperse (tell ["*"]) [case dim of A.Dimension d -> tell [show d] | dim <- ds]
sequence_ $ intersperse (tell ["*"])
[call genExpression n | A.Dimension n <- ds]
-- FIXME: and again
tell [");"]
_ -> return ()
fdeclareInit <- fget declareInit

6
backends/GenerateCPPCSP.hs
View File

@ -484,7 +484,9 @@ cppdeclareInit m t@(A.Array ds t') var
tell ["_storage,"]
call genVariableUnchecked var
tell [","]
sequence_ $ intersperse (tell ["*"]) [case dim of A.Dimension d -> tell [show d] | dim <- ds]
sequence_ $ intersperse (tell ["*"])
[call genExpression n
| A.Dimension n <- ds]
tell [");"]
_ -> return ()
cppdeclareInit m rt@(A.Record _) var
@ -664,7 +666,7 @@ cppgenType (A.Chan dir attr t)
= do tell ["tockSendableArray<"]
call genType t
tell [","]
tell $ intersperse "*" [case d of A.Dimension n -> show n | d <- ds]
sequence_ $ intersperse (tell ["*"]) [call genExpression n | A.Dimension n <- ds]
tell [">/**/"]
cppTypeInsideChannel t = call genType t
cppgenType (A.Mobile t@(A.Array {})) = call genType t

175
backends/GenerateCTest.hs
View File

@ -225,15 +225,15 @@ testGenType = TestList
,testBothSame "GenType 22" "float*" (tcall genType $ A.Mobile A.Real32)
,testBothSame "GenType 100" "int*" (tcall genType $ A.Array [A.Dimension 5] A.Int)
,testBothSame "GenType 101" "int*" (tcall genType $ A.Array [A.Dimension 5, A.Dimension 2, A.Dimension 9] A.Int)
,testBothSame "GenType 102" "int*" (tcall genType $ A.Array [A.Dimension 5, A.UnknownDimension] A.Int)
,testBothSame "GenType 100" "int*" (tcall genType $ A.Array [dimension 5] A.Int)
,testBothSame "GenType 101" "int*" (tcall genType $ A.Array [dimension 5, dimension 2, dimension 9] A.Int)
,testBothSame "GenType 102" "int*" (tcall genType $ A.Array [dimension 5, A.UnknownDimension] A.Int)
,testBothSame "GenType 103" "foo" (tcall genType $ A.Record (simpleName "foo"))
,testBoth "GenType 200" "Time" "csp::Time" (tcall genType A.Time)
,testBoth "GenType 201" "Time" "csp::Time" (tcall genType A.Timer)
,testBothSame "GenType 250" "int*" (tcall genType $ A.Mobile $ A.Array [A.Dimension 5, A.Dimension 2, A.Dimension 9] A.Int)
,testBothSame "GenType 251" "int*" (tcall genType $ A.Mobile $ A.Array [A.Dimension 5, A.UnknownDimension] A.Int)
,testBothSame "GenType 250" "int*" (tcall genType $ A.Mobile $ A.Array [dimension 5, dimension 2, dimension 9] A.Int)
,testBothSame "GenType 251" "int*" (tcall genType $ A.Mobile $ A.Array [dimension 5, A.UnknownDimension] A.Int)
,testBothSame "GenType 251" "int*" (tcall genType $ A.Mobile $ A.Array [A.UnknownDimension] A.Int)
,testBothSame "GenType 252" "foo*" (tcall genType $ A.Mobile $ A.Record (simpleName "foo"))
,testBoth "GenType 253" "Time*" "csp::Time*" (tcall genType $ A.Mobile A.Time)
@ -256,8 +256,8 @@ testGenType = TestList
,testBothFail "GenType 600" (tcall genType $ A.UserProtocol (simpleName "foo"))
,testBothFail "GenType 650" (tcall genType $ A.Counted A.Int A.Int)
,testBoth "GenType 700" "Channel**" "csp::One2OneChannel<int>**" (tcall genType $ A.Array [A.Dimension 5] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testBoth "GenType 701" "Channel**" "csp::Chanin<int>*" (tcall genType $ A.Array [A.Dimension 5] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
,testBoth "GenType 700" "Channel**" "csp::One2OneChannel<int>**" (tcall genType $ A.Array [dimension 5] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testBoth "GenType 701" "Channel**" "csp::Chanin<int>*" (tcall genType $ A.Array [dimension 5] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
--Test types that can only occur inside channels:
--ANY:
@ -269,9 +269,9 @@ testGenType = TestList
--Channels of arrays are special in C++:
,testBoth "GenType 1100" "Channel" "csp::One2OneChannel<tockSendableArray<int,6>>"
(tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.Array [A.Dimension 6] A.Int)
(tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.Array [dimension 6] A.Int)
,testBoth "GenType 1101" "Channel" "csp::One2OneChannel<tockSendableArray<int,6*7*8>>"
(tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.Array [A.Dimension 6,A.Dimension 7,A.Dimension 8] A.Int)
(tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.Array [dimension 6,dimension 7,dimension 8] A.Int)
-- List types:
@ -345,7 +345,7 @@ testArraySubscript = TestList
]
where
stateTrans :: CSM m => m ()
stateTrans = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7,A.Dimension 8,A.Dimension 8] A.Int)
stateTrans = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [dimension 7,dimension 8,dimension 8] A.Int)
m = "\"" ++ show emptyMeta ++ "\""
lit :: Int -> (Meta, CGen ())
@ -355,13 +355,13 @@ testArraySlice :: Test
testArraySlice = TestList
[
-- Slice from a one-dimensional array:
testSlice 0 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "])") "arr" 4 5 [A.Dimension 12]
testSlice 0 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "])") "arr" 4 5 [dimension 12]
-- Slice from a two-dimensional array:
,testSlice 1 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "*arr_sizes[1]])") "arr" 4 5 [A.Dimension 12,A.Dimension 12]
,testSlice 1 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "*arr_sizes[1]])") "arr" 4 5 [dimension 12,dimension 12]
-- Slice from a three-dimensional array:
,testSlice 2 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "*arr_sizes[1]*arr_sizes[2]])") "arr" 4 5 [A.Dimension 12,A.Dimension 12,A.Dimension 12]
,testSlice 2 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "*arr_sizes[1]*arr_sizes[2]])") "arr" 4 5 [dimension 12,dimension 12,dimension 12]
-- TODO test with unknown dimensions
]
@ -413,13 +413,13 @@ testOverArray = TestList $ map testOverArray'
"for\\(int ([[:alnum:]_]+)=0;\\3<foo" ++ sz 2 ++ ";\\3\\+\\+)\\{" ++
"foo" ++ (f' [("\\1",[1,2]),("\\2",[2]),("\\3",[])]) ++ suff ++ ";\\}\\}\\}$"
state1Static :: CSM m => m ()
state1Static = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7] A.Int)
state1Static = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [dimension 7] A.Int)
state1Dynamic :: CSM m => m ()
state1Dynamic = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.UnknownDimension] A.Int)
state3Static :: CSM m => m ()
state3Static = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7, A.Dimension 8, A.Dimension 9] A.Int)
state3Static = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [dimension 7, dimension 8, dimension 9] A.Int)
state3Dynamic :: CSM m => m ()
state3Dynamic = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.UnknownDimension, A.Dimension 8, A.UnknownDimension] A.Int)
state3Dynamic = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.UnknownDimension, dimension 8, A.UnknownDimension] A.Int)
testReplicator :: Test
testReplicator = TestList
@ -446,49 +446,49 @@ testDeclaration = TestList
--Arrays (of simple):
,testBothSame "genDeclaration 100" "int foo[8];"
(tcall3 genDeclaration (A.Array [A.Dimension 8] A.Int) foo False)
(tcall3 genDeclaration (A.Array [dimension 8] A.Int) foo False)
,testBothSame "genDeclaration 101" "int foo[8*9];"
(tcall3 genDeclaration (A.Array [A.Dimension 8,A.Dimension 9] A.Int) foo False)
(tcall3 genDeclaration (A.Array [dimension 8,dimension 9] A.Int) foo False)
,testBothSame "genDeclaration 102" "int foo[8*9*10];"
(tcall3 genDeclaration (A.Array [A.Dimension 8,A.Dimension 9,A.Dimension 10] A.Int) foo False)
(tcall3 genDeclaration (A.Array [dimension 8,dimension 9,dimension 10] A.Int) foo False)
--Arrays (of simple) inside records:
,testBothSame "genDeclaration 110" "int foo[8];"
(tcall3 genDeclaration (A.Array [A.Dimension 8] A.Int) foo True)
(tcall3 genDeclaration (A.Array [dimension 8] A.Int) foo True)
,testBothSame "genDeclaration 111" "int foo[8*9];"
(tcall3 genDeclaration (A.Array [A.Dimension 8,A.Dimension 9] A.Int) foo True)
(tcall3 genDeclaration (A.Array [dimension 8,dimension 9] A.Int) foo True)
,testBothSame "genDeclaration 112" "int foo[8*9*10];"
(tcall3 genDeclaration (A.Array [A.Dimension 8,A.Dimension 9,A.Dimension 10] A.Int) foo True)
(tcall3 genDeclaration (A.Array [dimension 8,dimension 9,dimension 10] A.Int) foo True)
--Arrays of channels and channel-ends:
,testBoth "genDeclaration 200" "Channel foo_storage[8];Channel* foo[8];"
"csp::One2OneChannel<int> foo_storage[8];csp::One2OneChannel<int>* foo[8];"
(tcall3 genDeclaration (A.Array [A.Dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) foo False)
(tcall3 genDeclaration (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) foo False)
,testBoth "genDeclaration 201" "Channel foo_storage[8*9];Channel* foo[8*9];"
"csp::One2OneChannel<int> foo_storage[8*9];csp::One2OneChannel<int>* foo[8*9];"
(tcall3 genDeclaration (A.Array [A.Dimension 8, A.Dimension 9] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) foo False)
(tcall3 genDeclaration (A.Array [dimension 8, dimension 9] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) foo False)
,testBoth "genDeclaration 202" "Channel* foo[8];"
"csp::Chanin<int> foo[8];"
(tcall3 genDeclaration (A.Array [A.Dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) foo False)
(tcall3 genDeclaration (A.Array [dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) foo False)
,testBoth "genDeclaration 203" "Channel* foo[8*9];"
"csp::Chanout<int> foo[8*9];"
(tcall3 genDeclaration (A.Array [A.Dimension 8, A.Dimension 9] $ A.Chan A.DirOutput (A.ChanAttributes False False) A.Int) foo False)
(tcall3 genDeclaration (A.Array [dimension 8, dimension 9] $ A.Chan A.DirOutput (A.ChanAttributes False False) A.Int) foo False)
--Records of simple:
,testBothSameS "genDeclaration 300" "REC foo;" (tcall3 genDeclaration (A.Record $ simpleName "REC") foo False) (stateR A.Int)
--Records of arrays of int (the sizes are set by declareInit):
,testBothSameS "genDeclaration 400" "REC foo;" (tcall3 genDeclaration (A.Record $ simpleName "REC") foo False) (stateR $ A.Array [A.Dimension 8] A.Int)
,testBothSameS "genDeclaration 400" "REC foo;" (tcall3 genDeclaration (A.Record $ simpleName "REC") foo False) (stateR $ A.Array [dimension 8] A.Int)
--Timers:
,testBoth "genDeclaration 500" "Time foo;" "csp::Time foo;"
(tcall3 genDeclaration A.Timer foo False)
,testBoth "genDeclaration 501" "Time foo[20];" "csp::Time foo[20];"
(tcall3 genDeclaration (A.Array [A.Dimension 20] A.Timer) foo False)
(tcall3 genDeclaration (A.Array [dimension 20] A.Timer) foo False)
]
where
stateR t = defRecord "REC" "bar" t
@ -504,27 +504,27 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList
,testAllSame 2 ("","") $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int
-- Plain arrays:
,testAllSame 3 ("","") $ A.Array [A.Dimension 4] A.Int
,testAllSame 3 ("","") $ A.Array [dimension 4] A.Int
-- Channel arrays:
,testAll 4 ("tock_init_chan_array(foo_storage,foo,4);^ChanInit(wptr,foo[0]);^","") ("tockInitChanArray(foo_storage,foo,4);","") $ A.Array [A.Dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllSame 6 ("","") $ A.Array [A.Dimension 4] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int
,testAll 4 ("tock_init_chan_array(foo_storage,foo,4);^ChanInit(wptr,foo[0]);^","") ("tockInitChanArray(foo_storage,foo,4);","") $ A.Array [dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllSame 6 ("","") $ A.Array [dimension 4] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int
-- Plain records:
,testAllR 100 ("","") ("","") A.Int id
-- Records containing an array:
,testAllR 101 ("","") ("","") (A.Array [A.Dimension 4,A.Dimension 5] A.Int) id
,testAllR 101 ("","") ("","") (A.Array [dimension 4,dimension 5] A.Int) id
-- Arrays of records containing an array:
,testAllRA 200 ("^^","") ("","") (A.Array [A.Dimension 4,A.Dimension 5] A.Int) id
,testAllRA 200 ("^^","") ("","") (A.Array [dimension 4,dimension 5] A.Int) id
-- Mobile versions
,testAllSame 1003 ("","") $ A.Mobile $ A.Array [A.Dimension 4] A.Int
,testAllSame 1004 ("","") $ A.Mobile $ A.Array [A.Dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllSame 1003 ("","") $ A.Mobile $ A.Array [dimension 4] A.Int
,testAllSame 1004 ("","") $ A.Mobile $ A.Array [dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllR 1100 ("","") ("","") A.Int A.Mobile
-- Records containing an array:
,testAllR 1101 ("","") ("","") (A.Array [A.Dimension 4,A.Dimension 5] A.Int) A.Mobile
,testAllR 1101 ("","") ("","") (A.Array [dimension 4,dimension 5] A.Int) A.Mobile
-- Arrays of records containing an array:
,testAllRA 1200 ("","") ("","") (A.Array [A.Dimension 4,A.Dimension 5] A.Int) A.Mobile
,testAllRA 1200 ("","") ("","") (A.Array [dimension 4,dimension 5] A.Int) A.Mobile
]
@ -536,7 +536,7 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList
testAllR n eC eCPP t f = testAll' n eC eCPP (f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Record (simpleName "REC")))
testAllRA :: Int -> (String,String) -> (String,String) -> A.Type -> (A.Type -> A.Type) -> Test
testAllRA n eC eCPP t f = testAll' n eC eCPP (A.Array [A.Dimension 5] $ f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Array [A.Dimension 5] $ A.Record (simpleName "REC")))
testAllRA n eC eCPP t f = testAll' n eC eCPP (A.Array [dimension 5] $ f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Array [dimension 5] $ A.Record (simpleName "REC")))
testAll' :: Int -> (String,String) -> (String,String) -> A.Type -> State CompState () -> Test
testAll' n (iC,fC) (iCPP,fCPP) t state = TestList
@ -562,7 +562,7 @@ testRecord = TestList
--Record types:
testAllSame 400 ("typedef struct{#ATION_True}foo;","") foo False [(bar,A.Int)]
,testAllSame 401 ("typedef struct{#ATION_True#ATION_True} occam_struct_packed foo;","") foo True [(bar,A.Int),(bar,A.Int)]
,testAllSame 402 ("typedef struct{#ATION_True}foo;","") foo False [(bar,A.Array [A.Dimension 6, A.Dimension 7] A.Int)]
,testAllSame 402 ("typedef struct{#ATION_True}foo;","") foo False [(bar,A.Array [dimension 6, dimension 7] A.Int)]
]
where
testAll :: Int -> (String,String) -> (String,String) -> A.Name -> Bool -> [(A.Name, A.Type)] -> Test
@ -584,8 +584,8 @@ testSpec = TestList
--Declaration:
testAllSame 0 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta A.Int
,testAllSame 1 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAllSame 2 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [A.Dimension 3] A.Int)
,testAllSame 3 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [A.Dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAllSame 2 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [dimension 3] A.Int)
,testAllSame 3 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
-- TODO test declarations with initialisers
@ -598,7 +598,7 @@ testSpec = TestList
--IsChannelArray:
,testAllSame 500
("$(" ++ show chanInt ++ ")*foo[]={@,@};","")
$ A.IsChannelArray emptyMeta (A.Array [A.Dimension 2] $ chanInt)
$ A.IsChannelArray emptyMeta (A.Array [dimension 2] $ chanInt)
[A.Variable undefined undefined,A.Variable undefined undefined]
--Is:
@ -648,7 +648,7 @@ testSpec = TestList
(defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at})
-- single (known) dimension:
,testAllSameS 1101 ("uint8_t* foo=(uint8_t*)&y;@","")
(A.Retypes emptyMeta A.Abbrev (A.Array [A.Dimension 4] A.Byte) (variable "y"))
(A.Retypes emptyMeta A.Abbrev (A.Array [dimension 4] A.Byte) (variable "y"))
(defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at})
-- single (unknown) dimension, VAL:
,testAllSameS 1102 ("const uint8_t* foo=(const uint8_t*)&y;@","")
@ -656,7 +656,7 @@ testSpec = TestList
(defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at})
-- single (known) dimension, VAL:
,testAllSameS 1103 ("const uint8_t* foo=(const uint8_t*)&y;@","")
(A.Retypes emptyMeta A.ValAbbrev (A.Array [A.Dimension 4] A.Byte) (variable "y"))
(A.Retypes emptyMeta A.ValAbbrev (A.Array [dimension 4] A.Byte) (variable "y"))
(defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at})
-- TODO test multiple dimensions plain-to-array (mainly for C++)
@ -714,15 +714,15 @@ testRetypeSizes = TestList
-- Array types where both sizes are fixed should act like the plain types:
,test 3 "if(occam_check_retype(#S,#D,#M)!=1){@}"
(A.Array [A.Dimension 2] A.Int) (A.Array [A.Dimension 8] A.Byte)
(A.Array [dimension 2] A.Int) (A.Array [dimension 8] A.Byte)
,test 4 "if(occam_check_retype(#S,#D,#M)!=1){@}"
(A.Array [A.Dimension 2,A.Dimension 3,A.Dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte)
(A.Array [dimension 2,dimension 3,dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte)
-- Array types with a free dimension should not check the return:
,test 100 "occam_check_retype(#S,#D,#M);"
(A.Array [A.UnknownDimension] A.Int) (A.Array [A.Dimension 8] A.Byte)
(A.Array [A.UnknownDimension] A.Int) (A.Array [dimension 8] A.Byte)
,test 101 "occam_check_retype(#S,#D,#M);"
(A.Array [A.Dimension 2,A.UnknownDimension,A.Dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte)
(A.Array [dimension 2,A.UnknownDimension,dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte)
]
where
test :: Int -> String -> A.Type -> A.Type -> Test
@ -759,16 +759,16 @@ testGenVariable = TestList
,testSameA2 55 ("foo","(*foo)") deref (A.Mobile $ A.Record bar)
-- Arrays of the previous types, unsubscripted:
,testSameA 100 ("foo","foo","foo") id (A.Array [A.Dimension 8] A.Int)
,testSameA 110 ("foo","foo","foo") id (A.Array [A.Dimension 8] $ A.Record bar)
,testSameA2 120 ("foo","foo") id (A.Array [A.Dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testSameA2 130 ("foo","foo") id (A.Array [A.Dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
,testSameA 100 ("foo","foo","foo") id (A.Array [dimension 8] A.Int)
,testSameA 110 ("foo","foo","foo") id (A.Array [dimension 8] $ A.Record bar)
,testSameA2 120 ("foo","foo") id (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testSameA2 130 ("foo","foo") id (A.Array [dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
-- Mobile arrays of the previous types:
,testSameA2 140 ("foo","(*foo)") id (A.Mobile $ A.Array [A.Dimension 8] A.Int)
,testSameA2 145 ("foo","(*foo)") deref (A.Mobile $ A.Array [A.Dimension 8] A.Int)
,testSameA2 150 ("foo","(*foo)") id (A.Mobile $ A.Array [A.Dimension 8] $ A.Record bar)
,testSameA2 155 ("foo","(*foo)") deref (A.Mobile $ A.Array [A.Dimension 8] $ A.Record bar)
,testSameA2 140 ("foo","(*foo)") id (A.Mobile $ A.Array [dimension 8] A.Int)
,testSameA2 145 ("foo","(*foo)") deref (A.Mobile $ A.Array [dimension 8] A.Int)
,testSameA2 150 ("foo","(*foo)") id (A.Mobile $ A.Array [dimension 8] $ A.Record bar)
,testSameA2 155 ("foo","(*foo)") deref (A.Mobile $ A.Array [dimension 8] $ A.Record bar)
-- Subscripted record:
,testSameA 200 ("(&foo)->x","foo->x","foo->x") fieldX (A.Record bar)
@ -778,17 +778,17 @@ testGenVariable = TestList
,testSameA 230 ("(&(&foo)->y)->x","(&foo->y)->x","(&foo->y)->x") (fieldX . fieldY) (A.Record $ simpleName "barbar")
-- Fully subscripted array:
,testAC 300 ("foo@C4","foo@U4") (sub 4) (A.Array [A.Dimension 8] A.Int)
,testAC 305 ("foo@C4,5,6","foo@U4,5,6") ((sub 6) . (sub 5) . (sub 4)) (A.Array [A.Dimension 8,A.Dimension 9,A.Dimension 10] A.Int)
,testAC 310 ("(&foo@C4)","(&foo@U4)") (sub 4) (A.Array [A.Dimension 8] $ A.Record bar)
,testAC 300 ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] A.Int)
,testAC 305 ("foo@C4,5,6","foo@U4,5,6") ((sub 6) . (sub 5) . (sub 4)) (A.Array [dimension 8,dimension 9,dimension 10] A.Int)
,testAC 310 ("(&foo@C4)","(&foo@U4)") (sub 4) (A.Array [dimension 8] $ A.Record bar)
-- Original channel arrays are Channel*[], abbreviated channel arrays are Channel*[]:
,testAC2 320 ("foo@C4","foo@U4") ("foo@C4","foo@U4") (sub 4) (A.Array [A.Dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAC 330 ("foo@C4","foo@U4") (sub 4) (A.Array [A.Dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
,testAC2 320 ("foo@C4","foo@U4") ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAC 330 ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
-- Fully subscripted array, and record field reference:
,testAC 400 ("(&foo@C4)->x","(&foo@U4)->x") (fieldX . (sub 4)) (A.Array [A.Dimension 8] $ A.Record bar)
,testAC 400 ("(&foo@C4)->x","(&foo@U4)->x") (fieldX . (sub 4)) (A.Array [dimension 8] $ A.Record bar)
-- As above, but then with an index too:
,testAC 410 ("(&foo@C4)->x@C4","(&foo@U4)->x@U4") ((sub 4) . fieldX . (sub 4)) (A.Array [A.Dimension 8] $ A.Record bar)
,testAC 410 ("(&foo@C4)->x@C4","(&foo@U4)->x@U4") ((sub 4) . fieldX . (sub 4)) (A.Array [dimension 8] $ A.Record bar)
--TODO come back to slices later
@ -796,7 +796,7 @@ testGenVariable = TestList
,testSameA2 500 ("$(&foo)$","$foo$") dir (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
-- Test for mobile channels (in future)
--,testSameA2 510 ("$foo$","$(*foo)$") (dir . deref) (A.Mobile $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAC2 520 ("$foo@C4$","$foo@U4$") ("$foo@C4$","$foo@U4$") (dir . (sub 4)) (A.Array [A.Dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAC2 520 ("$foo@C4$","$foo@U4$") ("$foo@C4$","$foo@U4$") (dir . (sub 4)) (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
]
where
deref = A.DerefVariable emptyMeta
@ -813,7 +813,7 @@ testGenVariable = TestList
]
where
state = do defineName (simpleName "foo") $ A.NameDef emptyMeta "foo" "foo" A.VariableName (A.Declaration emptyMeta t) am A.Unplaced
defRecord "bar" "x" $ A.Array [A.Dimension 7] A.Int
defRecord "bar" "x" $ A.Array [dimension 7] A.Int
defRecord "barbar" "y" $ A.Record bar
over :: Override
over = local $ \ops -> ops {genArraySubscript = (\c _ subs -> at >> (tell [if c /= A.NoCheck then "C" else "U"]) >> (seqComma $ map snd subs))
@ -942,7 +942,7 @@ testInput = TestList
,testInputItem 101 "ChanIn(wptr,#,&x,^(Int8));" "#>>x;" (A.InVariable emptyMeta $ variable "x") A.Int8
,testInputItem 102 ("ChanIn(wptr,#,(&x),^(" ++ show (A.Record foo) ++ "));") "#>>*(&x);" (A.InVariable emptyMeta $ variable "x") (A.Record foo)
-- Reading into a fixed size array:
,testInputItem 103 "ChanIn(wptr,#,x,^(Array [Dimension 8] Int));" "tockRecvArray(#,x);" (A.InVariable emptyMeta $ variable "x") $ A.Array [A.Dimension 8] A.Int
,testInputItem 103 "ChanIn(wptr,#,x,^(Array [Dimension 8] Int));" "tockRecvArray(#,x);" (A.InVariable emptyMeta $ variable "x") $ A.Array [dimension 8] A.Int
-- Reading into subscripted variables:
,testInputItem 110 "ChanInInt(wptr,#,&xs$);" "#>>xs$;" (A.InVariable emptyMeta $ sub0 $ variable "xs") A.Int
@ -969,7 +969,7 @@ testInput = TestList
,testInputItemProt 302 ("ChanIn(wptr,#,(&x),^(" ++ show (A.Record foo) ++ "));") ("tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(" ++ show (A.Record foo) ++ "),(&x)));")
(A.InVariable emptyMeta $ variable "x") (A.Record foo)
,testInputItemProt 303 "ChanIn(wptr,#,x,^(Array [Dimension 8] Int));" "tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(Array [Dimension 8] Int),x));"
(A.InVariable emptyMeta $ variable "x") $ A.Array [A.Dimension 8] A.Int
(A.InVariable emptyMeta $ variable "x") $ A.Array [dimension 8] A.Int
,testInputItemProt 400 "ChanInInt(wptr,#,&x);ChanIn(wptr,#,xs,x*^(Int));"
"tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(Int),&x));tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(x*^(Int),xs));"
(A.InCounted emptyMeta (variable "x") (variable "xs")) (A.Counted A.Int A.Int)
@ -1002,8 +1002,8 @@ testInput = TestList
defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t')
_ -> do defineName (simpleName "x") $ simpleDefDecl "x" t
defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t)
mkArray (A.Array ds t) = A.Array (A.Dimension 6:ds) t
mkArray t = A.Array [A.Dimension 6] t
mkArray (A.Array ds t) = A.Array (dimension 6:ds) t
mkArray t = A.Array [dimension 6] t
-- chan = simpleName "c"
-- chanIn = simpleName "cIn"
@ -1012,7 +1012,12 @@ testInput = TestList
overInputItemCase, over :: Override
overInputItemCase = local $ \ops -> ops {genInputItem = override2 caret}
over = local $ \ops -> ops {genBytesIn = (\_ t _ -> tell ["^(",show t,")"]) , genArraySubscript = override3 dollar}
over = local $ \ops -> ops {genBytesIn = (\_ t _ -> tell ["^(", showSimplerType t, ")"]) , genArraySubscript = override3 dollar}
-- | Show a type, simplifying how Dimensions are show.
showSimplerType :: A.Type -> String
showSimplerType t = subRegex re (show t) "Dimension \\1"
where re = mkRegex "Dimension [^\"]*\"([^\"]*)\"\\)\\)"
testOutput :: Test
testOutput = TestList
@ -1031,17 +1036,17 @@ testOutput = TestList
--A record type on the channel of the right type (because records are always referenced by pointer):
,testOutputItem 203 "ChanOut(wptr,#,(&x),^);" "#<<*(&x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Record foo)
--A fixed size array on the channel of the right type:
,testOutputItem 204 "ChanOut(wptr,#,x,^);" "tockSendArray(#,x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [A.Dimension 6] A.Int)
,testOutputItem 205 "ChanOut(wptr,#,x,^);" "tockSendArray(#,x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [A.Dimension 6, A.Dimension 7, A.Dimension 8] A.Int)
,testOutputItem 204 "ChanOut(wptr,#,x,^);" "tockSendArray(#,x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [dimension 6] A.Int)
,testOutputItem 205 "ChanOut(wptr,#,x,^);" "tockSendArray(#,x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [dimension 6, dimension 7, dimension 8] A.Int)
--A counted array:
,testOutputItem 206 "ChanOutInt(wptr,#,x);ChanOut(wptr,#,xs,x*^);" "#<<tockSendableArrayOfBytes(&x);#<<tockSendableArrayOfBytes(xs);"
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int A.Int)
--A counted array of arrays:
,testOutputItem 207 "ChanOutInt(wptr,#,x);ChanOut(wptr,#,xs,x*^);" "#<<tockSendableArrayOfBytes(&x);#<<tockSendableArrayOfBytes(xs);"
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int (A.Array [A.Dimension 5] A.Int))
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int (A.Array [dimension 5] A.Int))
,testOutputItem 208 "ChanOutInt(wptr,#,x);ChanOut(wptr,#,xs,x*^);" "#<<tockSendableArrayOfBytes(&x);#<<tockSendableArrayOfBytes(xs);"
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int (A.Array [A.Dimension 4,A.Dimension 5] A.Int))
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int (A.Array [dimension 4,dimension 5] A.Int))
-- Test counted arrays that do not have Int as the count type:
,testOutputItem 209 "ChanOut(wptr,#,&x,^);ChanOut(wptr,#,xs,x*^);" "#<<tockSendableArrayOfBytes(&x);#<<tockSendableArrayOfBytes(xs);"
@ -1054,14 +1059,14 @@ testOutput = TestList
,testOutputItemProt 301 "ChanOutInt(wptr,#,x);" "#<<tockSendableArrayOfBytes(&x);" (A.OutExpression emptyMeta $ exprVariable "x") A.Int
,testOutputItemProt 302 "ChanOut(wptr,#,&x,^);" "#<<tockSendableArrayOfBytes(&x);" (A.OutExpression emptyMeta $ exprVariable "x") A.Int64
,testOutputItemProt 303 "ChanOut(wptr,#,(&x),^);" "#<<tockSendableArrayOfBytes((&x));" (A.OutExpression emptyMeta $ exprVariable "x") (A.Record foo)
,testOutputItemProt 304 "ChanOut(wptr,#,x,^);" "#<<tockSendableArrayOfBytes(x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [A.Dimension 6] A.Int)
,testOutputItemProt 305 "ChanOut(wptr,#,x,^);" "#<<tockSendableArrayOfBytes(x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [A.Dimension 6, A.Dimension 7, A.Dimension 8] A.Int)
,testOutputItemProt 304 "ChanOut(wptr,#,x,^);" "#<<tockSendableArrayOfBytes(x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [dimension 6] A.Int)
,testOutputItemProt 305 "ChanOut(wptr,#,x,^);" "#<<tockSendableArrayOfBytes(x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [dimension 6, dimension 7, dimension 8] A.Int)
,testOutputItemProt 306 "ChanOutInt(wptr,#,x);ChanOut(wptr,#,xs,x*^);" "#<<tockSendableArrayOfBytes(&x);#<<tockSendableArrayOfBytes(xs);"
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int A.Int)
,testOutputItemProt 307 "ChanOutInt(wptr,#,x);ChanOut(wptr,#,xs,x*^);" "#<<tockSendableArrayOfBytes(&x);#<<tockSendableArrayOfBytes(xs);"
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int (A.Array [A.Dimension 5] A.Int))
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int (A.Array [dimension 5] A.Int))
,testOutputItemProt 308 "ChanOutInt(wptr,#,x);ChanOut(wptr,#,xs,x*^);" "#<<tockSendableArrayOfBytes(&x);#<<tockSendableArrayOfBytes(xs);"
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int (A.Array [A.Dimension 4,A.Dimension 5] A.Int))
(A.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int (A.Array [dimension 4,dimension 5] A.Int))
--TODO add tests for sending on channels that are part of (normal, and abbreviated) channel arrays.
@ -1087,8 +1092,8 @@ testOutput = TestList
A.Counted t t' -> do defineName (simpleName "x") $ simpleDefDecl "x" t
defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t')
_ -> defineName (simpleName "x") $ simpleDefDecl "x" t
mkArray (A.Array ds t) = A.Array (A.Dimension 6:ds) t
mkArray t = A.Array [A.Dimension 6] t
mkArray (A.Array ds t) = A.Array (dimension 6:ds) t
mkArray t = A.Array [dimension 6] t
chan = simpleName "c"
chanOut = simpleName "cOut"
@ -1109,7 +1114,7 @@ testBytesIn = TestList
,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin<int>)" (tcall3 genBytesIn undefined (A.Chan A.DirInput (A.ChanAttributes False False) A.Int) undefined)
--Array with a single known dimension:
,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [A.Dimension 5] A.Int) (Left False))
,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [dimension 5] A.Int) (Left False))
--single unknown dimension, no variable, no free dimension allowed:
,testBothFail "testBytesIn 101a" (tcall3 genBytesIn undefined (A.Array [A.UnknownDimension] A.Int) (Left False))
--single unknown dimension, no variable, free dimension allowed:
@ -1118,13 +1123,13 @@ testBytesIn = TestList
,testBothSame "testBytesIn 102" "$(@0)*sizeof(int)" (over (tcall3 genBytesIn undefined (A.Array [A.UnknownDimension] A.Int) (Right undefined)))
--Array with all known dimensions:
,testBothSame "testBytesIn 200" "7*6*5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [A.Dimension 5,A.Dimension 6, A.Dimension 7] A.Int) (Left False))
,testBothSame "testBytesIn 200" "7*6*5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [dimension 5,dimension 6, dimension 7] A.Int) (Left False))
--single unknown dimension, no variable, no free dimension allowed:
,testBothFail "testBytesIn 201a" (tcall3 genBytesIn undefined (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Left False))
,testBothFail "testBytesIn 201a" (tcall3 genBytesIn undefined (A.Array [dimension 5,dimension 6,A.UnknownDimension] A.Int) (Left False))
--single unknown dimension, no variable, free dimension allowed:
,testBothSame "testBytesIn 201b" "6*5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Left True))
,testBothSame "testBytesIn 201b" "6*5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [dimension 5,dimension 6,A.UnknownDimension] A.Int) (Left True))
--single unknown dimension, with variable:
,testBothSame "testBytesIn 202" "$(@2)*6*5*sizeof(int)" (over (tcall3 genBytesIn undefined (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Right undefined)))
,testBothSame "testBytesIn 202" "$(@2)*6*5*sizeof(int)" (over (tcall3 genBytesIn undefined (A.Array [dimension 5,dimension 6,A.UnknownDimension] A.Int) (Right undefined)))
]
where

4
checks/ArrayUsageCheck.hs
View File

@ -86,10 +86,10 @@ checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $
arrLength <- case arrType of
A.Array (A.Dimension d:_) _ -> return d
-- Unknown dimension, use the maximum value for a (assumed 32-bit for INT) integer:
A.Array (A.UnknownDimension:_) _ -> return $ fromInteger $ toInteger (maxBound :: Int32)
A.Array (A.UnknownDimension:_) _ -> return $ makeConstant m $ fromInteger $ toInteger (maxBound :: Int32)
-- It's not an array:
_ -> dieP m $ "Cannot usage check array \"" ++ userArrName ++ "\"; found to be of type: " ++ show arrType
case makeEquations (concatMap makeRepBounds $ listReplicators p) indexes (makeConstant emptyMeta arrLength) of
case makeEquations (concatMap makeRepBounds $ listReplicators p) indexes arrLength of
Left err -> dieP m $ "Could not work with array indexes for array \"" ++ userArrName ++ "\": " ++ err
Right [] -> return () -- No problems to work with
Right problems ->

12
common/EvalConstants.hs
View File

@ -140,7 +140,7 @@ evalExpression (A.MostNeg _ A.Int64) = return $ OccInt64 minBound
evalExpression (A.SizeExpr m e)
= do t <- typeOfExpression e >>= underlyingType m
case t of
A.Array (A.Dimension n:_) _ -> return $ OccInt (fromIntegral n)
A.Array (A.Dimension n:_) _ -> evalExpression n
_ ->
do v <- evalExpression e
case v of
@ -149,7 +149,7 @@ evalExpression (A.SizeExpr m e)
evalExpression (A.SizeVariable m v)
= do t <- typeOfVariable v >>= underlyingType m
case t of
A.Array (A.Dimension n:_) _ -> return $ OccInt (fromIntegral n)
A.Array (A.Dimension n:_) _ -> evalExpression n
_ -> throwError (Just m, "size of non-fixed-size variable " ++ show v ++ " used")
evalExpression e@(A.Literal _ _ _) = evalLiteral e
evalExpression (A.ExprVariable _ v) = evalVariable v
@ -159,12 +159,12 @@ evalExpression (A.SubscriptedExpr _ sub e) = evalExpression e >>= evalSubscript
evalExpression (A.BytesInExpr m e)
= do b <- typeOfExpression e >>= underlyingType m >>= bytesInType
case b of
BIJust n -> return $ OccInt (fromIntegral $ n)
BIJust n -> evalExpression n
_ -> throwError (Just m, "BYTESIN non-constant-size expression " ++ show e ++ " used")
evalExpression (A.BytesInType m t)
= do b <- underlyingType m t >>= bytesInType
case b of
BIJust n -> return $ OccInt (fromIntegral $ n)
BIJust n -> evalExpression n
_ -> throwErrorC (Just m, formatCode "BYTESIN non-constant-size type % used" t)
evalExpression e = throwError (Just $ findMeta e, "bad expression")
@ -272,7 +272,7 @@ renderLiteral m (OccInt64 i) = (A.Int64, A.IntLiteral m $ show i)
renderLiteral m (OccArray vs)
= (t, A.ArrayLiteral m aes)
where
t = addDimensions [A.Dimension $ length vs] (head ts)
t = addDimensions [makeDimension m $ length vs] (head ts)
(ts, aes) = unzip $ map (renderLiteralArray m) vs
renderLiteral m (OccRecord n vs)
= (A.Record n, A.RecordLiteral m (map (snd . renderValue m) vs))
@ -293,7 +293,7 @@ renderLiteralArray :: Meta -> OccValue -> (A.Type, A.ArrayElem)
renderLiteralArray m (OccArray vs)
= (t, A.ArrayElemArray aes)
where
t = addDimensions [A.Dimension $ length vs] (head ts)
t = addDimensions [makeDimension m $ length vs] (head ts)
(ts, aes) = unzip $ map (renderLiteralArray m) vs
renderLiteralArray m v
= (t, A.ArrayElemExpr e)

10
common/ShowCode.hs
View File

@ -200,10 +200,12 @@ instance ShowOccam A.Type where
showOccamM (A.Mobile t) = return "MOBILE " +>> showOccamM t
showOccamM (A.Array ds t)
= (return $ concat [case d of
A.Dimension n -> "[" ++ show n ++ "]"
A.UnknownDimension -> "[]"
| d <- ds]) +>> showOccamM t
= (liftM concat $ sequence dims) +>> showOccamM t
where
dims = [case d of
A.Dimension n -> return "[" +>> showOccamM n +>> return "]"
A.UnknownDimension -> return "[]"
| d <- ds]
showOccamM (A.Chan _ _ t) = return "CHAN OF " +>> showOccamM t
showOccamM (A.Counted ct et) = showOccamM ct +>> return "::" +>> showOccamM et
showOccamM (A.Port t) = return "PORT OF " +>> showOccamM t

4
common/TestUtils.hs
View File

@ -111,6 +111,10 @@ testCheck config property =
--}}}
--{{{ building AST fragments and patterns
-- | Helper function to generate an array dimension.
dimension :: Int -> A.Dimension
dimension n = makeDimension emptyMeta n
-- | Creates a 'A.Name' object with the given 'String' as 'A.nameName', and 'A.nameType' as 'A.VariableName'.
simpleName :: String -> A.Name
simpleName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.VariableName }

151
common/Types.hs
View File

@ -24,7 +24,7 @@ module Types
, returnTypesOfFunction
, BytesInResult(..), bytesInType, countReplicator, countStructured, computeStructured
, makeAbbrevAM, makeConstant, addOne
, makeAbbrevAM, makeConstant, makeDimension, addOne, addExprs, mulExprs, divExprs
, addDimensions, removeFixedDimensions, trivialSubscriptType, subscriptType, unsubscriptType
, recordFields, protocolItems
@ -81,27 +81,6 @@ typeOfSpec st
_ -> return Nothing
--{{{ identifying types
-- | Apply a slice to a type.
sliceType :: (CSMR m, Die m) => Meta -> A.Expression -> A.Expression -> A.Type -> m A.Type
sliceType m base count (A.Array (d:ds) t)
= case (isConstant base, isConstant count) of
(True, True) ->
do b <- evalIntExpression base
c <- evalIntExpression count
case d of
A.Dimension size ->
if (size - b) < c
then dieP m $ "invalid slice " ++ show b ++ " -> " ++ show c ++ " of " ++ show size
else return $ A.Array (A.Dimension c : ds) t
A.UnknownDimension ->
return $ A.Array (A.Dimension c : ds) t
(True, False) -> return $ A.Array (A.UnknownDimension : ds) t
(False, True) ->
do c <- evalIntExpression count
return $ A.Array (A.Dimension c : ds) t
(False, False) -> return $ A.Array (A.UnknownDimension : ds) t
sliceType m _ _ _ = dieP m "slice of non-array type"
-- | Get the fields of a record type.
recordFields :: (CSMR m, Die m) => Meta -> A.Type -> m [(A.Name, A.Type)]
recordFields m (A.Record rec)
@ -119,37 +98,36 @@ typeOfRecordField m t field
-- | Apply a plain subscript to a type.
plainSubscriptType :: (CSMR m, Die m) => Meta -> A.Expression -> A.Type -> m A.Type
plainSubscriptType m sub (A.Array (d:ds) t)
= case (isConstant sub, d) of
(True, A.Dimension size) ->
do i <- evalIntExpression sub
if (i < 0) || (i >= size)
then dieP m $ "invalid subscript " ++ show i ++ " of " ++ show size
else return ok
_ -> return ok
where
ok = case ds of
[] -> t
_ -> A.Array ds t
plainSubscriptType m sub (A.Array (_:ds) t)
= return $ case ds of
[] -> t
_ -> A.Array ds t
plainSubscriptType m _ t = diePC m $ formatCode "subscript of non-array type: %" t
-- | Turn an expression into a 'Dimension'.
-- If the expression is constant, it'll produce 'Dimension'; if not, it'll
-- produce 'UnknownDimension'.
dimensionFromExpr :: A.Expression -> A.Dimension
dimensionFromExpr e
= if isConstant e
then A.Dimension $ e
else A.UnknownDimension
-- | Apply a subscript to a type, and return what the type is after it's been
-- subscripted.
subscriptType :: (CSMR m, Die m) => A.Subscript -> A.Type -> m A.Type
subscriptType sub t@(A.UserDataType _)
= resolveUserType (findMeta sub) t >>= subscriptType sub
subscriptType (A.SubscriptFromFor m base count) t
= sliceType m base count t
subscriptType (A.SubscriptFromFor m _ count) (A.Array (_:ds) t)
= return $ A.Array (dimensionFromExpr count : ds) t
subscriptType (A.SubscriptFrom m base) (A.Array (d:ds) t)
= case (isConstant base, d) of
(True, A.Dimension size) ->
do b <- evalIntExpression base
if (size - b) < 0
then dieP m $ "invalid slice " ++ show b ++ " -> end of " ++ show size
else return $ A.Array (A.Dimension (size - b) : ds) t
_ -> return $ A.Array (A.UnknownDimension : ds) t
subscriptType (A.SubscriptFor m count) t
= sliceType m (makeConstant emptyMeta 0) count t
= return $ A.Array (dim : ds) t
where
dim = case d of
A.Dimension size -> dimensionFromExpr $ A.Dyadic m A.Subtr size base
_ -> A.UnknownDimension
subscriptType (A.SubscriptFor m count) (A.Array (_:ds) t)
= return $ A.Array (dimensionFromExpr count : ds) t
subscriptType (A.SubscriptField m tag) t = typeOfRecordField m t tag
subscriptType (A.Subscript m _ sub) t = plainSubscriptType m sub t
subscriptType sub t = diePC (findMeta sub) $ formatCode "Unsubscriptable type: %" t
@ -262,8 +240,7 @@ typeOfExpression e
else typeOfArrayList [A.UnknownDimension] bt
A.ExprConstr m (A.RepConstr _ rep e) ->
do t <- typeOfExpression e
count <- evalIntExpression $ countReplicator rep
typeOfArrayList [A.Dimension count] t
typeOfArrayList [A.Dimension $ countReplicator rep] t
A.AllocMobile _ t _ -> return t
--}}}
@ -367,10 +344,15 @@ makeAbbrevAM :: A.AbbrevMode -> A.AbbrevMode
makeAbbrevAM A.Original = A.Abbrev
makeAbbrevAM am = am
-- | Generate a constant expression from an integer -- for array sizes and the like.
-- | Generate a constant expression from an integer -- for array sizes and the
-- like.
makeConstant :: Meta -> Int -> A.Expression
makeConstant m n = A.Literal m A.Int $ A.IntLiteral m (show n)
-- | Generate a constant dimension from an integer.
makeDimension :: Meta -> Int -> A.Dimension
makeDimension m n = A.Dimension $ makeConstant m n
-- | Checks whether a given conversion can be done implicitly in Rain
-- Parameters are src dest
isImplicitConversionRain :: A.Type -> A.Type -> Bool
@ -526,34 +508,39 @@ isCaseableType t = isIntegerType t
--{{{ sizes of types
-- | The size in bytes of a data type.
data BytesInResult =
BIJust Int -- ^ Just that many bytes.
| BIOneFree Int Int -- ^ An array type; A bytes, times unknown dimension B.
| BIManyFree -- ^ An array type with multiple unknown dimensions.
| BIUnknown -- ^ We can't tell the size at compile time.
BIJust A.Expression -- ^ Just that many bytes.
| BIOneFree A.Expression Int -- ^ An array type; A bytes, times unknown dimension B.
| BIManyFree -- ^ An array type with multiple unknown dimensions.
| BIUnknown -- ^ We can't tell the size at compile time.
deriving (Show, Eq)
-- | Given the C and C++ values (in that order), selects according to the backend
-- If the backend is not recognised, the C sizes are used
sizeByBackend :: CSMR m => Int -> Int -> m Int
sizeByBackend c cxx = do backend <- getCompState >>* csBackend
return $ case backend of
BackendCPPCSP -> cxx
_ -> c
-- | Make a fixed-size 'BytesInResult'.
justSize :: CSMR m => Int -> m BytesInResult
justSize n = return $ BIJust $ makeConstant emptyMeta n
-- | Given the C and C++ values (in that order), selects according to the
-- backend. If the backend is not recognised, the C sizes are used.
justSizeBackends :: CSMR m => Int -> Int -> m BytesInResult
justSizeBackends c cxx
= do backend <- getCompState >>* csBackend
case backend of
BackendCPPCSP -> justSize c
_ -> justSize cxx
-- | Return the size in bytes of a data type.
bytesInType :: (CSMR m, Die m) => A.Type -> m BytesInResult
bytesInType A.Bool = sizeByBackend cBoolSize cxxBoolSize >>* BIJust
bytesInType A.Byte = return $ BIJust 1
bytesInType A.UInt16 = return $ BIJust 2
bytesInType A.UInt32 = return $ BIJust 4
bytesInType A.UInt64 = return $ BIJust 8
bytesInType A.Int8 = return $ BIJust 1
bytesInType A.Int = sizeByBackend cIntSize cxxIntSize >>* BIJust
bytesInType A.Int16 = return $ BIJust 2
bytesInType A.Int32 = return $ BIJust 4
bytesInType A.Int64 = return $ BIJust 8
bytesInType A.Real32 = return $ BIJust 4
bytesInType A.Real64 = return $ BIJust 8
bytesInType A.Bool = justSizeBackends cBoolSize cxxBoolSize
bytesInType A.Byte = justSize 1
bytesInType A.UInt16 = justSize 2
bytesInType A.UInt32 = justSize 4
bytesInType A.UInt64 = justSize 8
bytesInType A.Int8 = justSize 1
bytesInType A.Int = justSizeBackends cIntSize cxxIntSize
bytesInType A.Int16 = justSize 2
bytesInType A.Int32 = justSize 4
bytesInType A.Int64 = justSize 8
bytesInType A.Real32 = justSize 4
bytesInType A.Real64 = justSize 8
bytesInType a@(A.Array _ _) = bytesInArray 0 a
where
bytesInArray :: (CSMR m, Die m) => Int -> A.Type -> m BytesInResult
@ -561,8 +548,8 @@ bytesInType a@(A.Array _ _) = bytesInArray 0 a
bytesInArray num (A.Array (d:ds) t)
= do ts <- bytesInArray (num + 1) (A.Array ds t)
case (d, ts) of
(A.Dimension n, BIJust m) -> return $ BIJust (n * m)
(A.Dimension n, BIOneFree m x) -> return $ BIOneFree (n * m) x
(A.Dimension n, BIJust m) -> return $ BIJust (mulExprs n m)
(A.Dimension n, BIOneFree m x) -> return $ BIOneFree (mulExprs n m) x
(A.UnknownDimension, BIJust m) -> return $ BIOneFree m num
(A.UnknownDimension, BIOneFree _ _) -> return BIManyFree
(_, _) -> return ts
@ -575,12 +562,12 @@ bytesInType (A.Record n)
_ -> return $ BIUnknown
where
bytesInList :: (CSMR m, Die m) => [(A.Name, A.Type)] -> m BytesInResult
bytesInList [] = return $ BIJust 0
bytesInList [] = justSize 0
bytesInList ((_, t):rest)
= do bi <- bytesInType t
br <- bytesInList rest
case (bi, br) of
(BIJust a, BIJust b) -> return $ BIJust (a + b)
(BIJust a, BIJust b) -> return $ BIJust (addExprs a b)
(_, _) -> return BIUnknown
bytesInType _ = return $ BIUnknown
--}}}
@ -610,3 +597,17 @@ addOne :: A.Expression -> A.Expression
addOne e = A.Dyadic m A.Plus (makeConstant m 1) e
where m = findMeta e
-- | Add two expressions.
addExprs :: A.Expression -> A.Expression -> A.Expression
addExprs a b = A.Dyadic m A.Add a b
where m = findMeta a
-- | Multiply two expressions.
mulExprs :: A.Expression -> A.Expression -> A.Expression
mulExprs a b = A.Dyadic m A.Mul a b
where m = findMeta a
-- | Divide two expressions.
divExprs :: A.Expression -> A.Expression -> A.Expression
divExprs a b = A.Dyadic m A.Div a b
where m = findMeta a

5
common/Utils.hs
View File

@ -291,3 +291,8 @@ applyPairM f = seqPair . transformPair f f
makeArraySize :: (IArray a e, Ix i, Enum i) => (i,i) -> e -> a i e -> a i e
makeArraySize size def arr = array size [(i,arrayLookupWithDefault def arr i) | i <- [fst size .. snd size]]
-- | Replace one item in a list by index.
-- This is like '(//)'.
replaceAt :: Int -> a -> [a] -> [a]
replaceAt n rep es = [if i == n then rep else e | (e, i) <- zip es [0..]]

4
data/AST.hs
View File

@ -138,9 +138,9 @@ data Type =
-- | An array dimension.
-- Depending on the context, an array type may have empty dimensions, which is
-- why this isn't just an Int.
-- why this isn't just an Expression.
data Dimension =
Dimension Int
Dimension Expression
| UnknownDimension
deriving (Show, Eq, Typeable, Data)

88
frontends/ParseOccam.hs
View File

@ -353,46 +353,69 @@ intersperseP (f:fs) sep
as <- intersperseP fs sep
return $ a : as
-- | Are two types the same?
sameType :: A.Type -> A.Type -> OccParser Bool
sameType (A.Array (A.Dimension e1 : ds1) t1)
(A.Array (A.Dimension e2 : ds2) t2)
= do n1 <- evalIntExpression e1
n2 <- evalIntExpression e2
same <- sameType (A.Array ds1 t1) (A.Array ds2 t2)
return $ (n1 == n2) && same
sameType (A.Array (A.UnknownDimension : ds1) t1)
(A.Array (A.UnknownDimension : ds2) t2)
= sameType (A.Array ds1 t1) (A.Array ds2 t2)
sameType a b = return $ a == b
-- | Find the type of a table literal given the types of its components.
-- This'll always return an Array; the inner type will either be the type of
-- the elements if they're all the same (in which case it's either an array
-- literal, or a record where all the fields are the same type), or Any if
-- they're not (i.e. if it's a record literal or an empty array).
tableType :: Meta -> [A.Type] -> OccParser A.Type
tableType m l = tableType' m (length l) l
tableType m l = tableType' m (makeConstant m $ length l) l
where
tableType' :: Meta -> A.Expression -> [A.Type] -> OccParser A.Type
tableType' m len [t] = return $ addDimensions [A.Dimension len] t
tableType' m len (t1 : rest@(t2 : _))
= if t1 == t2 then tableType' m len rest
else return $ addDimensions [A.Dimension len] A.Any
tableType' m len [] = return $ addDimensions [A.Dimension 0] A.Any
= do same <- sameType t1 t2
if same
then tableType' m len rest
else return $ addDimensions [A.Dimension len] A.Any
tableType' m len [] = return $ addDimensions [A.Dimension zero] A.Any
zero = makeConstant m 0
-- | Check that the second dimension can be used in a context where the first
-- is expected.
isValidDimension :: A.Dimension -> A.Dimension -> Bool
isValidDimension A.UnknownDimension A.UnknownDimension = True
isValidDimension A.UnknownDimension (A.Dimension _) = True
isValidDimension (A.Dimension n1) (A.Dimension n2) = n1 == n2
isValidDimension _ _ = False
isValidDimension :: A.Dimension -> A.Dimension -> OccParser Bool
isValidDimension A.UnknownDimension A.UnknownDimension = return True
isValidDimension A.UnknownDimension (A.Dimension _) = return True
isValidDimension (A.Dimension e1) (A.Dimension e2)
= do n1 <- evalIntExpression e1
n2 <- evalIntExpression e2
return $ n1 == n2
isValidDimension _ _ = return False
-- | Check that the second second of dimensions can be used in a context where
-- the first is expected.
areValidDimensions :: [A.Dimension] -> [A.Dimension] -> Bool
areValidDimensions [] [] = True
areValidDimensions :: [A.Dimension] -> [A.Dimension] -> OccParser Bool
areValidDimensions [] [] = return True
areValidDimensions (d1:ds1) (d2:ds2)
= if isValidDimension d1 d2
then areValidDimensions ds1 ds2
else False
areValidDimensions _ _ = False
= do valid <- isValidDimension d1 d2
if valid
then areValidDimensions ds1 ds2
else return False
areValidDimensions _ _ = return False
-- | Check that a type we've inferred matches the type we expected.
matchType :: Meta -> A.Type -> A.Type -> OccParser ()
matchType m et rt
= case (et, rt) of
((A.Array ds t), (A.Array ds' t')) ->
if areValidDimensions ds ds'
then matchType m t t'
else bad
do valid <- areValidDimensions ds ds'
if valid
then matchType m t t'
else bad
_ -> if rt == et then return () else bad
where
bad :: OccParser ()
@ -574,8 +597,7 @@ newTagName = unscopedName A.TagName
arrayType :: OccParser A.Type -> OccParser A.Type
arrayType element
= do (s, t) <- tryXVXV sLeft constIntExpr sRight element
sVal <- evalIntExpression s
return $ addDimensions [A.Dimension sVal] t
return $ addDimensions [A.Dimension s] t
-- | Either a sized or unsized array of a production.
specArrayType :: OccParser A.Type -> OccParser A.Type
@ -629,20 +651,22 @@ isValidLiteralType m rawT wantT
(A.Real32, _) -> return $ isRealType underT
(A.Int, _) -> return $ isIntegerType underT
(A.Byte, _) -> return $ isIntegerType underT
(A.Array (A.Dimension nf:_) _, A.Record _) ->
(A.Array (A.Dimension e:_) _, A.Record _) ->
-- We can't be sure without looking at the literal itself,
-- so we need to do that below.
do fs <- recordFields m wantT
nf <- evalIntExpression e
return $ nf == length fs
(A.Array (d1:ds1) t1, A.Array (d2:ds2) t2) ->
-- Check the outermost dimension is OK, then recurse.
-- We can't just look at all the dimensions because this
-- might be an array of a record type, or similar.
if isValidDimension d2 d1
then do rawT' <- trivialSubscriptType m rawT
underT' <- trivialSubscriptType m underT
isValidLiteralType m rawT' underT'
else return False
do valid <- isValidDimension d2 d1
if valid
then do rawT' <- trivialSubscriptType m rawT
underT' <- trivialSubscriptType m underT
isValidLiteralType m rawT' underT'
else return False
_ -> return $ rawT == wantT
-- | Apply dimensions from one type to another as far as possible.
@ -822,7 +846,7 @@ stringLiteral
cs <- stringCont <|> stringLit
let aes = [A.ArrayElemExpr $ A.Literal m' A.Byte c
| c@(A.ByteLiteral m' _) <- cs]
return (A.ArrayLiteral m aes, A.Dimension $ length cs)
return (A.ArrayLiteral m aes, makeDimension m $ length cs)
<?> "string literal"
where
stringCont :: OccParser [A.LiteralRepr]
@ -1412,6 +1436,8 @@ retypesReshapes :: OccParser ()
retypesReshapes
= sRETYPES <|> sRESHAPES
-- FIXME: Retypes checking is currently disabled; it will be moved into a
-- separate pass.
retypesAbbrev :: OccParser A.Specification
retypesAbbrev
= do m <- md
@ -1420,7 +1446,7 @@ retypesAbbrev
sColon
eol
origT <- typeOfVariable v
checkRetypes m origT s
--checkRetypes m origT s
return $ A.Specification m n $ A.Retypes m A.Abbrev s v
<|> do m <- md
(s, n) <- tryVVX channelSpecifier newChannelName retypesReshapes
@ -1428,7 +1454,7 @@ retypesAbbrev
sColon
eol
origT <- typeOfVariable c
checkRetypes m origT s
--checkRetypes m origT s
return $ A.Specification m n $ A.Retypes m A.Abbrev s c
<|> do m <- md
(s, n) <- tryXVVX sVAL dataSpecifier newVariableName retypesReshapes
@ -1436,10 +1462,11 @@ retypesAbbrev
sColon
eol
origT <- typeOfExpression e
checkRetypes m origT s
--checkRetypes m origT s
return $ A.Specification m n $ A.RetypesExpr m A.ValAbbrev s e
<?> "RETYPES/RESHAPES abbreviation"
{-
-- | Check that a RETYPES\/RESHAPES is safe.
checkRetypes :: Meta -> A.Type -> A.Type -> OccParser ()
-- Retyping channels is always "safe".
@ -1456,6 +1483,7 @@ checkRetypes m fromT toT
dieP m "multiple free dimensions in RETYPES/RESHAPES type"
-- Otherwise we have to do a runtime check.
_ -> return ()
-}
dataSpecifier :: OccParser A.Type
dataSpecifier

3
frontends/ParseRain.hs
View File

@ -34,6 +34,7 @@ import qualified LexRain as L
import Metadata
import ParseUtils
import Pass
import Types
@ -174,7 +175,7 @@ stringLiteral
= do (m,str) <- getToken testToken
let processed = replaceEscapes str
let aes = [A.ArrayElemExpr $ A.Literal m A.Byte $ A.ByteLiteral m [c] | c <- processed]
return (A.ArrayLiteral m aes, A.Dimension $ length processed)
return (A.ArrayLiteral m aes, makeDimension m $ length processed)
<?> "string literal"
where
testToken (L.TokStringLiteral str) = Just str

5
transformations/PassTest.hs
View File

@ -33,6 +33,7 @@ import SimplifyExprs
import TagAST
import TestUtils
import TreeUtils
import Types
import Utils
m :: Meta
@ -204,11 +205,11 @@ skipP = A.Only m (A.Skip m)
testTransformConstr0 :: Test
testTransformConstr0 = TestCase $ testPass "transformConstr0" exp (transformConstr orig) (return ())
where
orig = A.Spec m (A.Specification m (simpleName "arr") $ A.IsExpr m A.ValAbbrev (A.Array [A.Dimension 10] A.Int) $ A.ExprConstr m $
orig = A.Spec m (A.Specification m (simpleName "arr") $ A.IsExpr m A.ValAbbrev (A.Array [dimension 10] A.Int) $ A.ExprConstr m $
A.RepConstr m (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) (exprVariable "x")
) skipP
exp = nameAndStopCaringPattern "indexVar" "i" $ mkPattern exp'
exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [A.Dimension 10] A.Int))) $
exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [dimension 10] A.Int))) $
A.ProcThen m
(A.Seq m $ A.Spec m (A.Specification m (simpleName "i") (A.Declaration m A.Int)) $
A.Several m [A.Only m $ A.Assign m [variable "i"] $ A.ExpressionList m [intLiteral 0],

9
transformations/SimplifyExprs.hs
View File

@ -26,6 +26,7 @@ import qualified Data.Map as Map
import qualified AST as A
import CompState
import Errors
import EvalLiterals
import Metadata
import Pass
import qualified Properties as Prop
@ -137,7 +138,13 @@ expandArrayLiterals = doGeneric `extM` doArrayElem
expand (A.UnknownDimension:_) e
= dieP (findMeta e) "array literal containing non-literal array of unknown size"
expand (A.Dimension n:ds) e
= liftM A.ArrayElemArray $ sequence [expand ds (A.SubscriptedExpr m (A.Subscript m A.NoCheck $ makeConstant m i) e) | i <- [0 .. (n - 1)]]
= do -- Because it's an array literal, we must know the size.
size <- evalIntExpression n
elems <- sequence [expand ds (A.SubscriptedExpr m
(A.Subscript m A.NoCheck $
makeConstant m i) e)
| i <- [0 .. size - 1]]
return $ A.ArrayElemArray elems
where m = findMeta e
-- | We pull up the loop (Rep) counts into a temporary expression, whenever the loop