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

113
backends/BackendPasses.hs
View File

@ -100,38 +100,50 @@ declareSizesArray = doGeneric `ext1M` doStructured
A.Subscript {} -> findInnerVar v A.Subscript {} -> findInnerVar v
findInnerVar v = (Nothing, 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 :: Meta -> A.Name -> [A.Dimension] -> A.Type -> A.Variable -> PassM A.Specification
retypesSizes m n_sizes ds elemT v retypesSizes m n_sizes ds elemT v@(A.Variable _ nSrc)
-- Multiply together all known dimensions = do biDest <- bytesInType (A.Array ds elemT)
= do let knownDimsTotal = foldl (*) 1 [n | A.Dimension n <- ds] tSrc <- typeOfVariable v
-- Get the number of bytes in each element (must be known at compile-time) biSrc <- bytesInType tSrc
BIJust biElem <- bytesInType elemT
t <- typeOfVariable v -- Figure out the size of the source.
birhs <- bytesInType t srcSize <-
sizeSpecType <- case birhs of case (biSrc, tSrc) of
-- Statically known size; we can check right here whether it fits: -- Fixed-size source -- easy.
BIJust bytes -> case bytes `mod` (knownDimsTotal * biElem) of (BIJust size, _) -> return size
0 -> return $ makeStaticSizeSpec m n_sizes -- Variable-size source -- it must be an array, so multiply
[if d == A.UnknownDimension then A.Dimension (bytes `div` (knownDimsTotal * biElem)) else d | d <- ds] -- together the dimensions.
_ -> dieP m "RETYPES has sizes that do not fit" (_, A.Array ds t) ->
_ -> do totalSizeExpr <- case birhs of do BIJust elementSize <- bytesInType t
BIUnknown -> return $ A.BytesInType m t return $ foldl mulExprs elementSize dSizes
-- An array with a dimension are not known at compile-time: where
_ -> do let A.Array srcDs elemSrcT = t srcSizes = A.Variable m $ append_sizes nSrc
BIJust biSrcElem <- bytesInType elemSrcT dSizes = [case d of
let A.Variable _ srcN = v -- Fixed dimension.
multipliedDimsV = foldl (A.Dyadic m A.Mul) (makeConstant m biSrcElem) A.Dimension e -> e
[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]] -- Variable dimension -- use the corresponding
return multipliedDimsV -- element of its _sizes array.
return $ makeDynamicSizeSpec m n_sizes A.UnknownDimension ->
[case d of A.ExprVariable m $ A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) srcSizes
-- TODO add a run-time check here for invalid retypes | (d, i) <- zip ds [0..]]
A.UnknownDimension -> A.Dyadic m A.Div totalSizeExpr _ -> dieP m "Cannot compute size of source type"
(makeConstant m $ knownDimsTotal * biElem)
A.Dimension n -> makeConstant m n -- Build the _sizes array for the destination.
| d <- ds] sizeSpecType <-
defineSizesName m n_sizes sizeSpecType case biDest of
return $ A.Specification m n_sizes sizeSpecType -- 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 :: Meta -> A.Name -> [A.Dimension] -> A.Variable -> PassM A.Specification
abbrevVarSizes m n_sizes ds outerV 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: -- Calculate the correct subscript into the source _sizes variable to get to the dimensions for the destination:
let sizeDiff = length srcDs - length ds let sizeDiff = length srcDs - length ds
subSrcSizeVar = A.SubscriptedVariable m (A.SubscriptFromFor m (makeConstant m sizeDiff) (makeConstant m $ length ds)) varSrcSizes 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 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 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.IsExpr m A.ValAbbrev sizeType $
A.Literal m (A.Array [A.Dimension $ length ds] A.Int) $ A.ArrayLiteral m $ A.Literal m sizeType $ A.ArrayLiteral m $
[A.ArrayElemExpr exp] ++ map (A.ArrayElemExpr . A.ExprVariable m) subDims [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 defineSizesName m n_sizes sizeSpecType
return $ A.Specification m n_sizes sizeSpecType return $ A.Specification m n_sizes sizeSpecType
@ -201,17 +214,14 @@ declareSizesArray = doGeneric `ext1M` doStructured
doStructured s = doGeneric s doStructured s = doGeneric s
makeStaticSizeSpec :: Meta -> A.Name -> [A.Dimension] -> A.SpecType makeStaticSizeSpec :: Meta -> A.Name -> [A.Dimension] -> A.SpecType
makeStaticSizeSpec m n ds = sizeSpecType makeStaticSizeSpec m n ds = makeDynamicSizeSpec m n es
where where
sizeType = A.Array [A.Dimension $ length ds] A.Int es = [e | A.Dimension e <- ds]
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
makeDynamicSizeSpec :: Meta -> A.Name -> [A.Expression] -> A.SpecType makeDynamicSizeSpec :: Meta -> A.Name -> [A.Expression] -> A.SpecType
makeDynamicSizeSpec m n es = sizeSpecType makeDynamicSizeSpec m n es = sizeSpecType
where 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 sizeLit = A.Literal m sizeType $ A.ArrayLiteral m $ map A.ArrayElemExpr es
sizeSpecType = A.IsExpr m A.ValAbbrev sizeType sizeLit 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 -> PassM A.Specification
doSpecification (A.Specification m n (A.Proc m' sm args body)) 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 body' <- doGeneric body
let newspec = A.Proc m' sm args' 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)}) 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.ndAbbrevMode = A.ValAbbrev
,A.ndPlacement = A.Unplaced} ,A.ndPlacement = A.Unplaced}
transformFormals :: [A.Formal] -> PassM ([A.Formal], [A.Formal]) transformFormals :: Meta -> [A.Formal] -> PassM ([A.Formal], [A.Formal])
transformFormals [] = return ([],[]) transformFormals _ [] = return ([],[])
transformFormals ((f@(A.Formal am t n)):fs) transformFormals m ((f@(A.Formal am t n)):fs)
= case t of = case t of
A.Array ds _ -> do let newf = A.Formal A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) (append_sizes n) A.Array ds _ -> do let sizeType = A.Array [makeDimension m $ length ds] A.Int
(rest, moreNew) <- transformFormals fs let newf = A.Formal A.ValAbbrev sizeType (append_sizes n)
(rest, moreNew) <- transformFormals m fs
return (f : newf : rest, newf : moreNew) return (f : newf : rest, newf : moreNew)
_ -> do (rest, new) <- transformFormals fs _ -> do (rest, new) <- transformFormals m fs
return (f : rest, new) return (f : rest, new)
-- | A pass for adding _sizes parameters to actuals in PROC calls -- | 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.Actual -> PassM [A.Actual]
transformActual a@(A.ActualVariable am (A.Array ds _) (A.Variable m n)) transformActual a@(A.ActualVariable am (A.Array ds _) (A.Variable m n))
= do let a_sizes = A.Variable m (append_sizes 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))) transformActual a@(A.ActualExpression (A.Array ds _) (A.ExprVariable _ (A.Variable m n)))
= do let a_sizes = A.Variable m (append_sizes 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 transformActual a = let t = case a of
A.ActualVariable _ t _ -> t A.ActualVariable _ t _ -> t
A.ActualExpression t _ -> t A.ActualExpression t _ -> t
@ -304,7 +317,7 @@ simplifySlices = doGeneric `extM` doVariable
= do v' <- doGeneric v = do v' <- doGeneric v
A.Array (d:_) _ <- typeOfVariable v' A.Array (d:_) _ <- typeOfVariable v'
limit <- case d of limit <- case d of
A.Dimension n -> return $ makeConstant m' n A.Dimension n -> return n
A.UnknownDimension -> return $ A.SizeVariable m' v' A.UnknownDimension -> return $ A.SizeVariable m' v'
from' <- doGeneric from from' <- doGeneric from
return (A.SubscriptedVariable m (A.SubscriptFromFor m' from' (A.Dyadic m A.Subtr limit from')) v') 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 TestFramework
import TestUtils import TestUtils
import TreeUtils import TreeUtils
import Types
import Utils import Utils
m :: Meta m :: Meta
@ -168,7 +169,7 @@ instance Arbitrary StaticTypeList where
, (20, do len <- choose (1,5) , (20, do len <- choose (1,5)
ns <- replicateM len $ choose (1,1000) ns <- replicateM len $ choose (1,1000)
t <- oneof [return A.Int, return A.Byte] 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 return $ StaticTypeList tl
@ -181,7 +182,7 @@ instance Arbitrary DynTypeList where
, (10, return A.Byte) , (10, return A.Byte)
, (20, do len <- choose (1,5) , (20, do len <- choose (1,5)
ds <- replicateM len $ oneof ds <- replicateM len $ oneof
[choose (1,1000) >>* A.Dimension [choose (1,1000) >>* dimension
,return A.UnknownDimension] ,return A.UnknownDimension]
t <- oneof [return A.Int, return A.Byte] t <- oneof [return A.Int, return A.Byte]
return $ A.Array ds t) return $ A.Array ds t)
@ -194,7 +195,7 @@ newtype AbbrevTypesIs = AbbrevTypesIs ([A.Dimension], [A.Dimension], [A.Subscrip
instance Arbitrary AbbrevTypesIs where instance Arbitrary AbbrevTypesIs where
arbitrary = do lenSrc <- choose (1,10) arbitrary = do lenSrc <- choose (1,10)
lenDest <- choose (1, lenSrc) 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 -> destDims <- flip mapM (take lenDest srcDims) $ \d ->
case d of case d of
A.UnknownDimension -> return A.UnknownDimension A.UnknownDimension -> return A.UnknownDimension
@ -229,8 +230,8 @@ qcTestDeclareSizes =
strFooSizes = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") fooSizesSpec) strFooSizes = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") fooSizesSpec)
isChanArrFoo :: Int -> (A.SpecType, A.SpecType, State CompState ()) 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") isChanArrFoo n = (A.IsChannelArray emptyMeta (A.Array [dimension n] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Byte) (replicate n $ variable "c")
,valSize [n], return ()) ,valSize [makeConstant emptyMeta n], return ())
isIsFoo :: ([A.Dimension], [A.Dimension], [A.Subscript]) -> (A.SpecType, A.SpecType, State CompState ()) isIsFoo :: ([A.Dimension], [A.Dimension], [A.Subscript]) -> (A.SpecType, A.SpecType, State CompState ())
isIsFoo (srcDims, destDims, subs) isIsFoo (srcDims, destDims, subs)
@ -238,7 +239,7 @@ qcTestDeclareSizes =
(foldr (A.SubscriptedVariable emptyMeta) (variable "src") subs) (foldr (A.SubscriptedVariable emptyMeta) (variable "src") subs)
,specSizes, defSrc) ,specSizes, defSrc)
where 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 A.SubscriptedVariable emptyMeta (A.SubscriptFromFor emptyMeta
(intLiteral $ toInteger $ length srcDims - length destDims) (intLiteral $ toInteger $ length srcDims - length destDims)
(intLiteral $ toInteger $ length destDims) (intLiteral $ toInteger $ length destDims)
@ -271,21 +272,21 @@ qcTestDeclareSizes =
checkSizeItems _ = const (return ()) checkSizeItems _ = const (return ())
isExprStaticFoo :: [Int] -> (A.SpecType, A.SpecType, State CompState ()) 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 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 :: [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 where
t = A.Array (map A.Dimension ns) A.Byte t = A.Array (map dimension ns) A.Byte
valSize :: [Int] -> A.SpecType valSize :: [A.Expression] -> A.SpecType
valSize ds = A.IsExpr emptyMeta A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) $ makeSizesLiteral ds valSize ds = A.IsExpr emptyMeta A.ValAbbrev (A.Array [dimension $ length ds] A.Int) $ makeSizesLiteral ds
makeSizesLiteral :: [Int] -> A.Expression makeSizesLiteral :: [A.Expression] -> A.Expression
makeSizesLiteral xs = A.Literal emptyMeta (A.Array [A.Dimension $ length xs] A.Int) $ A.ArrayLiteral emptyMeta $ makeSizesLiteral xs = A.Literal emptyMeta (A.Array [dimension $ length xs] A.Int) $ A.ArrayLiteral emptyMeta $
map (A.ArrayElemExpr . A.Literal emptyMeta A.Int . A.IntLiteral emptyMeta . show) xs map A.ArrayElemExpr xs
checkFooSizes :: TestMonad m r => A.SpecType -> CompState -> m () checkFooSizes :: TestMonad m r => A.SpecType -> CompState -> m ()
checkFooSizes sp = checkName "foo_sizes" sp A.ValAbbrev 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] args = [("x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts]
argsWithSizes = concat [ argsWithSizes = concat [
case t of 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)] _ -> [("x" ++ show n, t, A.Abbrev)]
| (n, t) <- zip [(0::Integer)..] ts] | (n, t) <- zip [(0::Integer)..] ts]
@ -357,7 +358,7 @@ qcTestSizeParameters =
args = [("x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts] args = [("x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts]
argsWithSizes = concat [ argsWithSizes = concat [
case t of 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)] _ -> [("x" ++ show n, t, A.Abbrev)]
| (n, t) <- zip [(0::Integer)..] ts] | (n, t) <- zip [(0::Integer)..] ts]

25
backends/GenerateC.hs
View File

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

6
backends/GenerateCPPCSP.hs
View File

@ -484,7 +484,9 @@ cppdeclareInit m t@(A.Array ds t') var
tell ["_storage,"] tell ["_storage,"]
call genVariableUnchecked var call genVariableUnchecked var
tell [","] 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 [");"] tell [");"]
_ -> return () _ -> return ()
cppdeclareInit m rt@(A.Record _) var cppdeclareInit m rt@(A.Record _) var
@ -664,7 +666,7 @@ cppgenType (A.Chan dir attr t)
= do tell ["tockSendableArray<"] = do tell ["tockSendableArray<"]
call genType t call genType t
tell [","] tell [","]
tell $ intersperse "*" [case d of A.Dimension n -> show n | d <- ds] sequence_ $ intersperse (tell ["*"]) [call genExpression n | A.Dimension n <- ds]
tell [">/**/"] tell [">/**/"]
cppTypeInsideChannel t = call genType t cppTypeInsideChannel t = call genType t
cppgenType (A.Mobile t@(A.Array {})) = 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 22" "float*" (tcall genType $ A.Mobile A.Real32)
,testBothSame "GenType 100" "int*" (tcall genType $ A.Array [A.Dimension 5] A.Int) ,testBothSame "GenType 100" "int*" (tcall genType $ A.Array [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 101" "int*" (tcall genType $ A.Array [dimension 5, dimension 2, dimension 9] A.Int)
,testBothSame "GenType 102" "int*" (tcall genType $ A.Array [A.Dimension 5, A.UnknownDimension] 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")) ,testBothSame "GenType 103" "foo" (tcall genType $ A.Record (simpleName "foo"))
,testBoth "GenType 200" "Time" "csp::Time" (tcall genType A.Time) ,testBoth "GenType 200" "Time" "csp::Time" (tcall genType A.Time)
,testBoth "GenType 201" "Time" "csp::Time" (tcall genType A.Timer) ,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 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 [A.Dimension 5, A.UnknownDimension] 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 251" "int*" (tcall genType $ A.Mobile $ A.Array [A.UnknownDimension] A.Int)
,testBothSame "GenType 252" "foo*" (tcall genType $ A.Mobile $ A.Record (simpleName "foo")) ,testBothSame "GenType 252" "foo*" (tcall genType $ A.Mobile $ A.Record (simpleName "foo"))
,testBoth "GenType 253" "Time*" "csp::Time*" (tcall genType $ A.Mobile A.Time) ,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 600" (tcall genType $ A.UserProtocol (simpleName "foo"))
,testBothFail "GenType 650" (tcall genType $ A.Counted A.Int A.Int) ,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 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 [A.Dimension 5] $ A.Chan A.DirInput (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: --Test types that can only occur inside channels:
--ANY: --ANY:
@ -269,9 +269,9 @@ testGenType = TestList
--Channels of arrays are special in C++: --Channels of arrays are special in C++:
,testBoth "GenType 1100" "Channel" "csp::One2OneChannel<tockSendableArray<int,6>>" ,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>>" ,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: -- List types:
@ -345,7 +345,7 @@ testArraySubscript = TestList
] ]
where where
stateTrans :: CSM m => m () 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 ++ "\"" m = "\"" ++ show emptyMeta ++ "\""
lit :: Int -> (Meta, CGen ()) lit :: Int -> (Meta, CGen ())
@ -355,13 +355,13 @@ testArraySlice :: Test
testArraySlice = TestList testArraySlice = TestList
[ [
-- Slice from a one-dimensional array: -- 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: -- 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: -- 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 -- TODO test with unknown dimensions
] ]
@ -413,13 +413,13 @@ testOverArray = TestList $ map testOverArray'
"for\\(int ([[:alnum:]_]+)=0;\\3<foo" ++ sz 2 ++ ";\\3\\+\\+)\\{" ++ "for\\(int ([[:alnum:]_]+)=0;\\3<foo" ++ sz 2 ++ ";\\3\\+\\+)\\{" ++
"foo" ++ (f' [("\\1",[1,2]),("\\2",[2]),("\\3",[])]) ++ suff ++ ";\\}\\}\\}$" "foo" ++ (f' [("\\1",[1,2]),("\\2",[2]),("\\3",[])]) ++ suff ++ ";\\}\\}\\}$"
state1Static :: CSM m => m () 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 :: CSM m => m ()
state1Dynamic = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.UnknownDimension] A.Int) state1Dynamic = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.UnknownDimension] A.Int)
state3Static :: CSM m => m () 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 :: 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 :: Test
testReplicator = TestList testReplicator = TestList
@ -446,49 +446,49 @@ testDeclaration = TestList
--Arrays (of simple): --Arrays (of simple):
,testBothSame "genDeclaration 100" "int foo[8];" ,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];" ,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];" ,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: --Arrays (of simple) inside records:
,testBothSame "genDeclaration 110" "int foo[8];" ,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];" ,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];" ,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: --Arrays of channels and channel-ends:
,testBoth "genDeclaration 200" "Channel foo_storage[8];Channel* foo[8];" ,testBoth "genDeclaration 200" "Channel foo_storage[8];Channel* foo[8];"
"csp::One2OneChannel<int> foo_storage[8];csp::One2OneChannel<int>* 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];" ,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];" "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];" ,testBoth "genDeclaration 202" "Channel* foo[8];"
"csp::Chanin<int> 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];" ,testBoth "genDeclaration 203" "Channel* foo[8*9];"
"csp::Chanout<int> 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: --Records of simple:
,testBothSameS "genDeclaration 300" "REC foo;" (tcall3 genDeclaration (A.Record $ simpleName "REC") foo False) (stateR A.Int) ,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): --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: --Timers:
,testBoth "genDeclaration 500" "Time foo;" "csp::Time foo;" ,testBoth "genDeclaration 500" "Time foo;" "csp::Time foo;"
(tcall3 genDeclaration A.Timer foo False) (tcall3 genDeclaration A.Timer foo False)
,testBoth "genDeclaration 501" "Time foo[20];" "csp::Time foo[20];" ,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 where
stateR t = defRecord "REC" "bar" t 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 ,testAllSame 2 ("","") $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int
-- Plain arrays: -- Plain arrays:
,testAllSame 3 ("","") $ A.Array [A.Dimension 4] A.Int ,testAllSame 3 ("","") $ A.Array [dimension 4] A.Int
-- Channel arrays: -- 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 ,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 [A.Dimension 4] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int ,testAllSame 6 ("","") $ A.Array [dimension 4] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int
-- Plain records: -- Plain records:
,testAllR 100 ("","") ("","") A.Int id ,testAllR 100 ("","") ("","") A.Int id
-- Records containing an array: -- 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: -- 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 -- Mobile versions
,testAllSame 1003 ("","") $ A.Mobile $ A.Array [A.Dimension 4] A.Int ,testAllSame 1003 ("","") $ A.Mobile $ A.Array [dimension 4] A.Int
,testAllSame 1004 ("","") $ A.Mobile $ A.Array [A.Dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) 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 ,testAllR 1100 ("","") ("","") A.Int A.Mobile
-- Records containing an array: -- 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: -- 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"))) 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 :: 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' :: Int -> (String,String) -> (String,String) -> A.Type -> State CompState () -> Test
testAll' n (iC,fC) (iCPP,fCPP) t state = TestList testAll' n (iC,fC) (iCPP,fCPP) t state = TestList
@ -562,7 +562,7 @@ testRecord = TestList
--Record types: --Record types:
testAllSame 400 ("typedef struct{#ATION_True}foo;","") foo False [(bar,A.Int)] 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 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 where
testAll :: Int -> (String,String) -> (String,String) -> A.Name -> Bool -> [(A.Name, A.Type)] -> Test testAll :: Int -> (String,String) -> (String,String) -> A.Name -> Bool -> [(A.Name, A.Type)] -> Test
@ -584,8 +584,8 @@ testSpec = TestList
--Declaration: --Declaration:
testAllSame 0 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta A.Int 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 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 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 [A.Dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) 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 -- TODO test declarations with initialisers
@ -598,7 +598,7 @@ testSpec = TestList
--IsChannelArray: --IsChannelArray:
,testAllSame 500 ,testAllSame 500
("$(" ++ show chanInt ++ ")*foo[]={@,@};","") ("$(" ++ 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] [A.Variable undefined undefined,A.Variable undefined undefined]
--Is: --Is:
@ -648,7 +648,7 @@ testSpec = TestList
(defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at}) (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at})
-- single (known) dimension: -- single (known) dimension:
,testAllSameS 1101 ("uint8_t* foo=(uint8_t*)&y;@","") ,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}) (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at})
-- single (unknown) dimension, VAL: -- single (unknown) dimension, VAL:
,testAllSameS 1102 ("const uint8_t* foo=(const uint8_t*)&y;@","") ,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}) (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at})
-- single (known) dimension, VAL: -- single (known) dimension, VAL:
,testAllSameS 1103 ("const uint8_t* foo=(const uint8_t*)&y;@","") ,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}) (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at})
-- TODO test multiple dimensions plain-to-array (mainly for C++) -- 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: -- Array types where both sizes are fixed should act like the plain types:
,test 3 "if(occam_check_retype(#S,#D,#M)!=1){@}" ,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){@}" ,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: -- Array types with a free dimension should not check the return:
,test 100 "occam_check_retype(#S,#D,#M);" ,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);" ,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 where
test :: Int -> String -> A.Type -> A.Type -> Test test :: Int -> String -> A.Type -> A.Type -> Test
@ -759,16 +759,16 @@ testGenVariable = TestList
,testSameA2 55 ("foo","(*foo)") deref (A.Mobile $ A.Record bar) ,testSameA2 55 ("foo","(*foo)") deref (A.Mobile $ A.Record bar)
-- Arrays of the previous types, unsubscripted: -- Arrays of the previous types, unsubscripted:
,testSameA 100 ("foo","foo","foo") id (A.Array [A.Dimension 8] A.Int) ,testSameA 100 ("foo","foo","foo") id (A.Array [dimension 8] A.Int)
,testSameA 110 ("foo","foo","foo") id (A.Array [A.Dimension 8] $ A.Record bar) ,testSameA 110 ("foo","foo","foo") id (A.Array [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 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 [A.Dimension 8] $ A.Chan A.DirInput (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: -- Mobile arrays of the previous types:
,testSameA2 140 ("foo","(*foo)") id (A.Mobile $ A.Array [A.Dimension 8] A.Int) ,testSameA2 140 ("foo","(*foo)") id (A.Mobile $ A.Array [dimension 8] A.Int)
,testSameA2 145 ("foo","(*foo)") deref (A.Mobile $ A.Array [A.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 [A.Dimension 8] $ A.Record bar) ,testSameA2 150 ("foo","(*foo)") id (A.Mobile $ A.Array [dimension 8] $ A.Record bar)
,testSameA2 155 ("foo","(*foo)") deref (A.Mobile $ A.Array [A.Dimension 8] $ A.Record bar) ,testSameA2 155 ("foo","(*foo)") deref (A.Mobile $ A.Array [dimension 8] $ A.Record bar)
-- Subscripted record: -- Subscripted record:
,testSameA 200 ("(&foo)->x","foo->x","foo->x") fieldX (A.Record bar) ,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") ,testSameA 230 ("(&(&foo)->y)->x","(&foo->y)->x","(&foo->y)->x") (fieldX . fieldY) (A.Record $ simpleName "barbar")
-- Fully subscripted array: -- Fully subscripted array:
,testAC 300 ("foo@C4","foo@U4") (sub 4) (A.Array [A.Dimension 8] A.Int) ,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 [A.Dimension 8,A.Dimension 9,A.Dimension 10] 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 [A.Dimension 8] $ A.Record bar) ,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*[]: -- 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) ,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 [A.Dimension 8] $ A.Chan A.DirInput (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: -- 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: -- 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 --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) ,testSameA2 500 ("$(&foo)$","$foo$") dir (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
-- Test for mobile channels (in future) -- Test for mobile channels (in future)
--,testSameA2 510 ("$foo$","$(*foo)$") (dir . deref) (A.Mobile $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) --,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 where
deref = A.DerefVariable emptyMeta deref = A.DerefVariable emptyMeta
@ -813,7 +813,7 @@ testGenVariable = TestList
] ]
where where
state = do defineName (simpleName "foo") $ A.NameDef emptyMeta "foo" "foo" A.VariableName (A.Declaration emptyMeta t) am A.Unplaced 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 defRecord "barbar" "y" $ A.Record bar
over :: Override over :: Override
over = local $ \ops -> ops {genArraySubscript = (\c _ subs -> at >> (tell [if c /= A.NoCheck then "C" else "U"]) >> (seqComma $ map snd subs)) 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 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) ,testInputItem 102 ("ChanIn(wptr,#,(&x),^(" ++ show (A.Record foo) ++ "));") "#>>*(&x);" (A.InVariable emptyMeta $ variable "x") (A.Record foo)
-- Reading into a fixed size array: -- 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: -- Reading into subscripted variables:
,testInputItem 110 "ChanInInt(wptr,#,&xs$);" "#>>xs$;" (A.InVariable emptyMeta $ sub0 $ variable "xs") A.Int ,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)));") ,testInputItemProt 302 ("ChanIn(wptr,#,(&x),^(" ++ show (A.Record foo) ++ "));") ("tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(" ++ show (A.Record foo) ++ "),(&x)));")
(A.InVariable emptyMeta $ variable "x") (A.Record foo) (A.InVariable emptyMeta $ variable "x") (A.Record foo)
,testInputItemProt 303 "ChanIn(wptr,#,x,^(Array [Dimension 8] Int));" "tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(Array [Dimension 8] Int),x));" ,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));" ,testInputItemProt 400 "ChanInInt(wptr,#,&x);ChanIn(wptr,#,xs,x*^(Int));"
"tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(Int),&x));tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(x*^(Int),xs));" "tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(Int),&x));tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(x*^(Int),xs));"
(A.InCounted emptyMeta (variable "x") (variable "xs")) (A.Counted A.Int A.Int) (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') defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t')
_ -> do defineName (simpleName "x") $ simpleDefDecl "x" t _ -> do defineName (simpleName "x") $ simpleDefDecl "x" t
defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t) defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t)
mkArray (A.Array ds t) = A.Array (A.Dimension 6:ds) t mkArray (A.Array ds t) = A.Array (dimension 6:ds) t
mkArray t = A.Array [A.Dimension 6] t mkArray t = A.Array [dimension 6] t
-- chan = simpleName "c" -- chan = simpleName "c"
-- chanIn = simpleName "cIn" -- chanIn = simpleName "cIn"
@ -1012,7 +1012,12 @@ testInput = TestList
overInputItemCase, over :: Override overInputItemCase, over :: Override
overInputItemCase = local $ \ops -> ops {genInputItem = override2 caret} 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 :: Test
testOutput = TestList 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): --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) ,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: --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 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 [A.Dimension 6, A.Dimension 7, A.Dimension 8] 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: --A counted array:
,testOutputItem 206 "ChanOutInt(wptr,#,x);ChanOut(wptr,#,xs,x*^);" "#<<tockSendableArrayOfBytes(&x);#<<tockSendableArrayOfBytes(xs);" ,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.OutCounted emptyMeta (exprVariable "x") (exprVariable "xs")) (A.Counted A.Int A.Int)
--A counted array of arrays: --A counted array of arrays:
,testOutputItem 207 "ChanOutInt(wptr,#,x);ChanOut(wptr,#,xs,x*^);" "#<<tockSendableArrayOfBytes(&x);#<<tockSendableArrayOfBytes(xs);" ,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);" ,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: -- 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);" ,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 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 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 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 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 [A.Dimension 6, A.Dimension 7, A.Dimension 8] 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);" ,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) (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);" ,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);" ,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. --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 A.Counted t t' -> do defineName (simpleName "x") $ simpleDefDecl "x" t
defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t') defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t')
_ -> defineName (simpleName "x") $ simpleDefDecl "x" t _ -> defineName (simpleName "x") $ simpleDefDecl "x" t
mkArray (A.Array ds t) = A.Array (A.Dimension 6:ds) t mkArray (A.Array ds t) = A.Array (dimension 6:ds) t
mkArray t = A.Array [A.Dimension 6] t mkArray t = A.Array [dimension 6] t
chan = simpleName "c" chan = simpleName "c"
chanOut = simpleName "cOut" 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) ,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: --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: --single unknown dimension, no variable, no free dimension allowed:
,testBothFail "testBytesIn 101a" (tcall3 genBytesIn undefined (A.Array [A.UnknownDimension] A.Int) (Left False)) ,testBothFail "testBytesIn 101a" (tcall3 genBytesIn undefined (A.Array [A.UnknownDimension] A.Int) (Left False))
--single unknown dimension, no variable, free dimension allowed: --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))) ,testBothSame "testBytesIn 102" "$(@0)*sizeof(int)" (over (tcall3 genBytesIn undefined (A.Array [A.UnknownDimension] A.Int) (Right undefined)))
--Array with all known dimensions: --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: --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: --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: --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 where

4
checks/ArrayUsageCheck.hs
View File

@ -86,10 +86,10 @@ checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $
arrLength <- case arrType of arrLength <- case arrType of
A.Array (A.Dimension d:_) _ -> return d A.Array (A.Dimension d:_) _ -> return d
-- Unknown dimension, use the maximum value for a (assumed 32-bit for INT) integer: -- 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: -- It's not an array:
_ -> dieP m $ "Cannot usage check array \"" ++ userArrName ++ "\"; found to be of type: " ++ show arrType _ -> 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 Left err -> dieP m $ "Could not work with array indexes for array \"" ++ userArrName ++ "\": " ++ err
Right [] -> return () -- No problems to work with Right [] -> return () -- No problems to work with
Right problems -> 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) evalExpression (A.SizeExpr m e)
= do t <- typeOfExpression e >>= underlyingType m = do t <- typeOfExpression e >>= underlyingType m
case t of case t of
A.Array (A.Dimension n:_) _ -> return $ OccInt (fromIntegral n) A.Array (A.Dimension n:_) _ -> evalExpression n
_ -> _ ->
do v <- evalExpression e do v <- evalExpression e
case v of case v of
@ -149,7 +149,7 @@ evalExpression (A.SizeExpr m e)
evalExpression (A.SizeVariable m v) evalExpression (A.SizeVariable m v)
= do t <- typeOfVariable v >>= underlyingType m = do t <- typeOfVariable v >>= underlyingType m
case t of 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") _ -> throwError (Just m, "size of non-fixed-size variable " ++ show v ++ " used")
evalExpression e@(A.Literal _ _ _) = evalLiteral e evalExpression e@(A.Literal _ _ _) = evalLiteral e
evalExpression (A.ExprVariable _ v) = evalVariable v evalExpression (A.ExprVariable _ v) = evalVariable v
@ -159,12 +159,12 @@ evalExpression (A.SubscriptedExpr _ sub e) = evalExpression e >>= evalSubscript
evalExpression (A.BytesInExpr m e) evalExpression (A.BytesInExpr m e)
= do b <- typeOfExpression e >>= underlyingType m >>= bytesInType = do b <- typeOfExpression e >>= underlyingType m >>= bytesInType
case b of case b of
BIJust n -> return $ OccInt (fromIntegral $ n) BIJust n -> evalExpression n
_ -> throwError (Just m, "BYTESIN non-constant-size expression " ++ show e ++ " used") _ -> throwError (Just m, "BYTESIN non-constant-size expression " ++ show e ++ " used")
evalExpression (A.BytesInType m t) evalExpression (A.BytesInType m t)
= do b <- underlyingType m t >>= bytesInType = do b <- underlyingType m t >>= bytesInType
case b of case b of
BIJust n -> return $ OccInt (fromIntegral $ n) BIJust n -> evalExpression n
_ -> throwErrorC (Just m, formatCode "BYTESIN non-constant-size type % used" t) _ -> throwErrorC (Just m, formatCode "BYTESIN non-constant-size type % used" t)
evalExpression e = throwError (Just $ findMeta e, "bad expression") 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) renderLiteral m (OccArray vs)
= (t, A.ArrayLiteral m aes) = (t, A.ArrayLiteral m aes)
where where
t = addDimensions [A.Dimension $ length vs] (head ts) t = addDimensions [makeDimension m $ length vs] (head ts)
(ts, aes) = unzip $ map (renderLiteralArray m) vs (ts, aes) = unzip $ map (renderLiteralArray m) vs
renderLiteral m (OccRecord n vs) renderLiteral m (OccRecord n vs)
= (A.Record n, A.RecordLiteral m (map (snd . renderValue m) 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) renderLiteralArray m (OccArray vs)
= (t, A.ArrayElemArray aes) = (t, A.ArrayElemArray aes)
where where
t = addDimensions [A.Dimension $ length vs] (head ts) t = addDimensions [makeDimension m $ length vs] (head ts)
(ts, aes) = unzip $ map (renderLiteralArray m) vs (ts, aes) = unzip $ map (renderLiteralArray m) vs
renderLiteralArray m v renderLiteralArray m v
= (t, A.ArrayElemExpr e) = (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.Mobile t) = return "MOBILE " +>> showOccamM t
showOccamM (A.Array ds t) showOccamM (A.Array ds t)
= (return $ concat [case d of = (liftM concat $ sequence dims) +>> showOccamM t
A.Dimension n -> "[" ++ show n ++ "]" where
A.UnknownDimension -> "[]" dims = [case d of
| d <- ds]) +>> showOccamM t A.Dimension n -> return "[" +>> showOccamM n +>> return "]"
A.UnknownDimension -> return "[]"
| d <- ds]
showOccamM (A.Chan _ _ t) = return "CHAN OF " +>> showOccamM t showOccamM (A.Chan _ _ t) = return "CHAN OF " +>> showOccamM t
showOccamM (A.Counted ct et) = showOccamM ct +>> return "::" +>> showOccamM et showOccamM (A.Counted ct et) = showOccamM ct +>> return "::" +>> showOccamM et
showOccamM (A.Port t) = return "PORT OF " +>> showOccamM t 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 --{{{ 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'. -- | Creates a 'A.Name' object with the given 'String' as 'A.nameName', and 'A.nameType' as 'A.VariableName'.
simpleName :: String -> A.Name simpleName :: String -> A.Name
simpleName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.VariableName } 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 , returnTypesOfFunction
, BytesInResult(..), bytesInType, countReplicator, countStructured, computeStructured , BytesInResult(..), bytesInType, countReplicator, countStructured, computeStructured
, makeAbbrevAM, makeConstant, addOne , makeAbbrevAM, makeConstant, makeDimension, addOne, addExprs, mulExprs, divExprs
, addDimensions, removeFixedDimensions, trivialSubscriptType, subscriptType, unsubscriptType , addDimensions, removeFixedDimensions, trivialSubscriptType, subscriptType, unsubscriptType
, recordFields, protocolItems , recordFields, protocolItems
@ -81,27 +81,6 @@ typeOfSpec st
_ -> return Nothing _ -> return Nothing
--{{{ identifying types --{{{ 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. -- | Get the fields of a record type.
recordFields :: (CSMR m, Die m) => Meta -> A.Type -> m [(A.Name, A.Type)] recordFields :: (CSMR m, Die m) => Meta -> A.Type -> m [(A.Name, A.Type)]
recordFields m (A.Record rec) recordFields m (A.Record rec)
@ -119,37 +98,36 @@ typeOfRecordField m t field
-- | Apply a plain subscript to a type. -- | Apply a plain subscript to a type.
plainSubscriptType :: (CSMR m, Die m) => Meta -> A.Expression -> A.Type -> m A.Type plainSubscriptType :: (CSMR m, Die m) => Meta -> A.Expression -> A.Type -> m A.Type
plainSubscriptType m sub (A.Array (d:ds) t) plainSubscriptType m sub (A.Array (_:ds) t)
= case (isConstant sub, d) of = return $ case ds of
(True, A.Dimension size) -> [] -> t
do i <- evalIntExpression sub _ -> A.Array ds t
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 _ t = diePC m $ formatCode "subscript of non-array type: %" 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 -- | Apply a subscript to a type, and return what the type is after it's been
-- subscripted. -- subscripted.
subscriptType :: (CSMR m, Die m) => A.Subscript -> A.Type -> m A.Type subscriptType :: (CSMR m, Die m) => A.Subscript -> A.Type -> m A.Type
subscriptType sub t@(A.UserDataType _) subscriptType sub t@(A.UserDataType _)
= resolveUserType (findMeta sub) t >>= subscriptType sub = resolveUserType (findMeta sub) t >>= subscriptType sub
subscriptType (A.SubscriptFromFor m base count) t subscriptType (A.SubscriptFromFor m _ count) (A.Array (_:ds) t)
= sliceType m base count t = return $ A.Array (dimensionFromExpr count : ds) t
subscriptType (A.SubscriptFrom m base) (A.Array (d:ds) t) subscriptType (A.SubscriptFrom m base) (A.Array (d:ds) t)
= case (isConstant base, d) of = return $ A.Array (dim : ds) t
(True, A.Dimension size) -> where
do b <- evalIntExpression base dim = case d of
if (size - b) < 0 A.Dimension size -> dimensionFromExpr $ A.Dyadic m A.Subtr size base
then dieP m $ "invalid slice " ++ show b ++ " -> end of " ++ show size _ -> A.UnknownDimension
else return $ A.Array (A.Dimension (size - b) : ds) t subscriptType (A.SubscriptFor m count) (A.Array (_:ds) t)
_ -> return $ A.Array (A.UnknownDimension : ds) t = return $ A.Array (dimensionFromExpr count : ds) t
subscriptType (A.SubscriptFor m count) t
= sliceType m (makeConstant emptyMeta 0) count t
subscriptType (A.SubscriptField m tag) t = typeOfRecordField m t tag subscriptType (A.SubscriptField m tag) t = typeOfRecordField m t tag
subscriptType (A.Subscript m _ sub) t = plainSubscriptType m sub t subscriptType (A.Subscript m _ sub) t = plainSubscriptType m sub t
subscriptType sub t = diePC (findMeta sub) $ formatCode "Unsubscriptable type: %" t subscriptType sub t = diePC (findMeta sub) $ formatCode "Unsubscriptable type: %" t
@ -262,8 +240,7 @@ typeOfExpression e
else typeOfArrayList [A.UnknownDimension] bt else typeOfArrayList [A.UnknownDimension] bt
A.ExprConstr m (A.RepConstr _ rep e) -> A.ExprConstr m (A.RepConstr _ rep e) ->
do t <- typeOfExpression e do t <- typeOfExpression e
count <- evalIntExpression $ countReplicator rep typeOfArrayList [A.Dimension $ countReplicator rep] t
typeOfArrayList [A.Dimension count] t
A.AllocMobile _ t _ -> return t A.AllocMobile _ t _ -> return t
--}}} --}}}
@ -367,10 +344,15 @@ makeAbbrevAM :: A.AbbrevMode -> A.AbbrevMode
makeAbbrevAM A.Original = A.Abbrev makeAbbrevAM A.Original = A.Abbrev
makeAbbrevAM am = am 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 :: Meta -> Int -> A.Expression
makeConstant m n = A.Literal m A.Int $ A.IntLiteral m (show n) 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 -- | Checks whether a given conversion can be done implicitly in Rain
-- Parameters are src dest -- Parameters are src dest
isImplicitConversionRain :: A.Type -> A.Type -> Bool isImplicitConversionRain :: A.Type -> A.Type -> Bool
@ -526,34 +508,39 @@ isCaseableType t = isIntegerType t
--{{{ sizes of types --{{{ sizes of types
-- | The size in bytes of a data type. -- | The size in bytes of a data type.
data BytesInResult = data BytesInResult =
BIJust Int -- ^ Just that many bytes. BIJust A.Expression -- ^ Just that many bytes.
| BIOneFree Int Int -- ^ An array type; A bytes, times unknown dimension B. | BIOneFree A.Expression Int -- ^ An array type; A bytes, times unknown dimension B.
| BIManyFree -- ^ An array type with multiple unknown dimensions. | BIManyFree -- ^ An array type with multiple unknown dimensions.
| BIUnknown -- ^ We can't tell the size at compile time. | BIUnknown -- ^ We can't tell the size at compile time.
deriving (Show, Eq) deriving (Show, Eq)
-- | Given the C and C++ values (in that order), selects according to the backend -- | Make a fixed-size 'BytesInResult'.
-- If the backend is not recognised, the C sizes are used justSize :: CSMR m => Int -> m BytesInResult
sizeByBackend :: CSMR m => Int -> Int -> m Int justSize n = return $ BIJust $ makeConstant emptyMeta n
sizeByBackend c cxx = do backend <- getCompState >>* csBackend
return $ case backend of -- | Given the C and C++ values (in that order), selects according to the
BackendCPPCSP -> cxx -- backend. If the backend is not recognised, the C sizes are used.
_ -> c 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. -- | Return the size in bytes of a data type.
bytesInType :: (CSMR m, Die m) => A.Type -> m BytesInResult bytesInType :: (CSMR m, Die m) => A.Type -> m BytesInResult
bytesInType A.Bool = sizeByBackend cBoolSize cxxBoolSize >>* BIJust bytesInType A.Bool = justSizeBackends cBoolSize cxxBoolSize
bytesInType A.Byte = return $ BIJust 1 bytesInType A.Byte = justSize 1
bytesInType A.UInt16 = return $ BIJust 2 bytesInType A.UInt16 = justSize 2
bytesInType A.UInt32 = return $ BIJust 4 bytesInType A.UInt32 = justSize 4
bytesInType A.UInt64 = return $ BIJust 8 bytesInType A.UInt64 = justSize 8
bytesInType A.Int8 = return $ BIJust 1 bytesInType A.Int8 = justSize 1
bytesInType A.Int = sizeByBackend cIntSize cxxIntSize >>* BIJust bytesInType A.Int = justSizeBackends cIntSize cxxIntSize
bytesInType A.Int16 = return $ BIJust 2 bytesInType A.Int16 = justSize 2
bytesInType A.Int32 = return $ BIJust 4 bytesInType A.Int32 = justSize 4
bytesInType A.Int64 = return $ BIJust 8 bytesInType A.Int64 = justSize 8
bytesInType A.Real32 = return $ BIJust 4 bytesInType A.Real32 = justSize 4
bytesInType A.Real64 = return $ BIJust 8 bytesInType A.Real64 = justSize 8
bytesInType a@(A.Array _ _) = bytesInArray 0 a bytesInType a@(A.Array _ _) = bytesInArray 0 a
where where
bytesInArray :: (CSMR m, Die m) => Int -> A.Type -> m BytesInResult 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) bytesInArray num (A.Array (d:ds) t)
= do ts <- bytesInArray (num + 1) (A.Array ds t) = do ts <- bytesInArray (num + 1) (A.Array ds t)
case (d, ts) of case (d, ts) of
(A.Dimension n, BIJust m) -> return $ BIJust (n * m) (A.Dimension n, BIJust m) -> return $ BIJust (mulExprs n m)
(A.Dimension n, BIOneFree m x) -> return $ BIOneFree (n * m) x (A.Dimension n, BIOneFree m x) -> return $ BIOneFree (mulExprs n m) x
(A.UnknownDimension, BIJust m) -> return $ BIOneFree m num (A.UnknownDimension, BIJust m) -> return $ BIOneFree m num
(A.UnknownDimension, BIOneFree _ _) -> return BIManyFree (A.UnknownDimension, BIOneFree _ _) -> return BIManyFree
(_, _) -> return ts (_, _) -> return ts
@ -575,12 +562,12 @@ bytesInType (A.Record n)
_ -> return $ BIUnknown _ -> return $ BIUnknown
where where
bytesInList :: (CSMR m, Die m) => [(A.Name, A.Type)] -> m BytesInResult bytesInList :: (CSMR m, Die m) => [(A.Name, A.Type)] -> m BytesInResult
bytesInList [] = return $ BIJust 0 bytesInList [] = justSize 0
bytesInList ((_, t):rest) bytesInList ((_, t):rest)
= do bi <- bytesInType t = do bi <- bytesInType t
br <- bytesInList rest br <- bytesInList rest
case (bi, br) of case (bi, br) of
(BIJust a, BIJust b) -> return $ BIJust (a + b) (BIJust a, BIJust b) -> return $ BIJust (addExprs a b)
(_, _) -> return BIUnknown (_, _) -> return BIUnknown
bytesInType _ = 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 addOne e = A.Dyadic m A.Plus (makeConstant m 1) e
where m = findMeta 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 :: (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]] 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. -- | An array dimension.
-- Depending on the context, an array type may have empty dimensions, which is -- 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 = data Dimension =
Dimension Int Dimension Expression
| UnknownDimension | UnknownDimension
deriving (Show, Eq, Typeable, Data) deriving (Show, Eq, Typeable, Data)

88
frontends/ParseOccam.hs
View File

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

3
frontends/ParseRain.hs
View File

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

5
transformations/PassTest.hs
View File

@ -33,6 +33,7 @@ import SimplifyExprs
import TagAST import TagAST
import TestUtils import TestUtils
import TreeUtils import TreeUtils
import Types
import Utils import Utils
m :: Meta m :: Meta
@ -204,11 +205,11 @@ skipP = A.Only m (A.Skip m)
testTransformConstr0 :: Test testTransformConstr0 :: Test
testTransformConstr0 = TestCase $ testPass "transformConstr0" exp (transformConstr orig) (return ()) testTransformConstr0 = TestCase $ testPass "transformConstr0" exp (transformConstr orig) (return ())
where 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") A.RepConstr m (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) (exprVariable "x")
) skipP ) skipP
exp = nameAndStopCaringPattern "indexVar" "i" $ mkPattern exp' 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.ProcThen m
(A.Seq m $ A.Spec m (A.Specification m (simpleName "i") (A.Declaration m A.Int)) $ (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], 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 qualified AST as A
import CompState import CompState
import Errors import Errors
import EvalLiterals
import Metadata import Metadata
import Pass import Pass
import qualified Properties as Prop import qualified Properties as Prop
@ -137,7 +138,13 @@ expandArrayLiterals = doGeneric `extM` doArrayElem
expand (A.UnknownDimension:_) e expand (A.UnknownDimension:_) e
= dieP (findMeta e) "array literal containing non-literal array of unknown size" = dieP (findMeta e) "array literal containing non-literal array of unknown size"
expand (A.Dimension n:ds) e 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 where m = findMeta e
-- | We pull up the loop (Rep) counts into a temporary expression, whenever the loop -- | We pull up the loop (Rep) counts into a temporary expression, whenever the loop