From b1416bb0cf56449e0d0cc9464fcbda9ee1aa1a08 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Tue, 18 Mar 2008 16:45:38 +0000 Subject: [PATCH] Change A.Dimension to take an Expression, not an Int. 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. --- backends/BackendPasses.hs | 115 +++++++++++--------- backends/BackendPassesTest.hs | 35 ++++--- backends/GenerateC.hs | 25 +++-- backends/GenerateCPPCSP.hs | 6 +- backends/GenerateCTest.hs | 175 ++++++++++++++++--------------- checks/ArrayUsageCheck.hs | 4 +- common/EvalConstants.hs | 12 +-- common/ShowCode.hs | 10 +- common/TestUtils.hs | 4 + common/Types.hs | 151 +++++++++++++------------- common/Utils.hs | 5 + data/AST.hs | 4 +- frontends/ParseOccam.hs | 88 ++++++++++------ frontends/ParseRain.hs | 3 +- transformations/PassTest.hs | 5 +- transformations/SimplifyExprs.hs | 9 +- 16 files changed, 365 insertions(+), 286 deletions(-) diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs index b66ce11..a2115af 100644 --- a/backends/BackendPasses.hs +++ b/backends/BackendPasses.hs @@ -99,39 +99,51 @@ declareSizesArray = doGeneric `ext1M` doStructured A.SubscriptFromFor _ _ for -> (Just for, snd $ findInnerVar v) -- Keep the outer most A.Subscript {} -> findInnerVar v findInnerVar v = (Nothing, v) - + + -- | Generate the @_sizes@ array for a 'Retypes' expression. retypesSizes :: Meta -> A.Name -> [A.Dimension] -> A.Type -> A.Variable -> PassM A.Specification - retypesSizes m n_sizes ds elemT v - -- Multiply together all known dimensions - = do let knownDimsTotal = foldl (*) 1 [n | A.Dimension n <- ds] - -- Get the number of bytes in each element (must be known at compile-time) - BIJust biElem <- bytesInType elemT - t <- typeOfVariable v - birhs <- bytesInType t - sizeSpecType <- case birhs of - -- Statically known size; we can check right here whether it fits: - BIJust bytes -> case bytes `mod` (knownDimsTotal * biElem) of - 0 -> return $ makeStaticSizeSpec m n_sizes - [if d == A.UnknownDimension then A.Dimension (bytes `div` (knownDimsTotal * biElem)) else d | d <- ds] - _ -> dieP m "RETYPES has sizes that do not fit" - _ -> do totalSizeExpr <- case birhs of - BIUnknown -> return $ A.BytesInType m t - -- An array with a dimension are not known at compile-time: - _ -> do let A.Array srcDs elemSrcT = t - BIJust biSrcElem <- bytesInType elemSrcT - let A.Variable _ srcN = v - multipliedDimsV = foldl (A.Dyadic m A.Mul) (makeConstant m biSrcElem) - [A.ExprVariable m $ A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) (A.Variable m $ append_sizes srcN) | i <- [0 .. length srcDs - 1]] - return multipliedDimsV - return $ makeDynamicSizeSpec m n_sizes - [case d of - -- TODO add a run-time check here for invalid retypes - A.UnknownDimension -> A.Dyadic m A.Div totalSizeExpr - (makeConstant m $ knownDimsTotal * biElem) - A.Dimension n -> makeConstant m n - | d <- ds] - defineSizesName m n_sizes sizeSpecType - return $ A.Specification m n_sizes sizeSpecType + retypesSizes m n_sizes ds elemT v@(A.Variable _ nSrc) + = do biDest <- bytesInType (A.Array ds elemT) + tSrc <- typeOfVariable v + biSrc <- bytesInType tSrc + + -- Figure out the size of the source. + srcSize <- + case (biSrc, tSrc) of + -- Fixed-size source -- easy. + (BIJust size, _) -> return size + -- Variable-size source -- it must be an array, so multiply + -- together the dimensions. + (_, A.Array ds t) -> + do BIJust elementSize <- bytesInType t + return $ foldl mulExprs elementSize dSizes + where + srcSizes = A.Variable m $ append_sizes nSrc + dSizes = [case d of + -- Fixed dimension. + A.Dimension e -> e + -- Variable dimension -- use the corresponding + -- element of its _sizes array. + A.UnknownDimension -> + A.ExprVariable m $ A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) srcSizes + | (d, i) <- zip ds [0..]] + _ -> dieP m "Cannot compute size of source type" + + -- Build the _sizes array for the destination. + sizeSpecType <- + case biDest of + -- Destination size is fixed -- so we must know the dimensions. + BIJust _ -> + return $ makeStaticSizeSpec m n_sizes ds + -- Destination has one free dimension, so we need to compute + -- it. + BIOneFree destSize n -> + let newDim = A.Dimension $ divExprs srcSize destSize + ds' = replaceAt n newDim ds in + return $ makeStaticSizeSpec m n_sizes ds' + + defineSizesName m n_sizes sizeSpecType + return $ A.Specification m n_sizes sizeSpecType abbrevVarSizes :: Meta -> A.Name -> [A.Dimension] -> A.Variable -> PassM A.Specification abbrevVarSizes m n_sizes ds outerV @@ -150,12 +162,13 @@ declareSizesArray = doGeneric `ext1M` doStructured -- Calculate the correct subscript into the source _sizes variable to get to the dimensions for the destination: let sizeDiff = length srcDs - length ds subSrcSizeVar = A.SubscriptedVariable m (A.SubscriptFromFor m (makeConstant m sizeDiff) (makeConstant m $ length ds)) varSrcSizes + sizeType = A.Array [makeDimension m $ length ds] A.Int sizeSpecType = case sliceSize of Just exp -> let subDims = [A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m n) varSrcSizes | n <- [1 .. (length srcDs - 1)]] in - A.IsExpr m A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) $ - A.Literal m (A.Array [A.Dimension $ length ds] A.Int) $ A.ArrayLiteral m $ + A.IsExpr m A.ValAbbrev sizeType $ + A.Literal m sizeType $ A.ArrayLiteral m $ [A.ArrayElemExpr exp] ++ map (A.ArrayElemExpr . A.ExprVariable m) subDims - Nothing -> A.Is m A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) subSrcSizeVar + Nothing -> A.Is m A.ValAbbrev sizeType subSrcSizeVar defineSizesName m n_sizes sizeSpecType return $ A.Specification m n_sizes sizeSpecType @@ -201,17 +214,14 @@ declareSizesArray = doGeneric `ext1M` doStructured doStructured s = doGeneric s makeStaticSizeSpec :: Meta -> A.Name -> [A.Dimension] -> A.SpecType - makeStaticSizeSpec m n ds = sizeSpecType + makeStaticSizeSpec m n ds = makeDynamicSizeSpec m n es where - sizeType = A.Array [A.Dimension $ length ds] A.Int - sizeLit = A.Literal m sizeType $ A.ArrayLiteral m $ - map (A.ArrayElemExpr . A.Literal m A.Int . A.IntLiteral m . show . \(A.Dimension d) -> d) ds - sizeSpecType = A.IsExpr m A.ValAbbrev sizeType sizeLit + es = [e | A.Dimension e <- ds] makeDynamicSizeSpec :: Meta -> A.Name -> [A.Expression] -> A.SpecType makeDynamicSizeSpec m n es = sizeSpecType where - sizeType = A.Array [A.Dimension $ length es] A.Int + sizeType = A.Array [makeDimension m $ length es] A.Int sizeLit = A.Literal m sizeType $ A.ArrayLiteral m $ map A.ArrayElemExpr es sizeSpecType = A.IsExpr m A.ValAbbrev sizeType sizeLit @@ -233,7 +243,7 @@ addSizesFormalParameters = doGeneric `extM` doSpecification doSpecification :: A.Specification -> PassM A.Specification doSpecification (A.Specification m n (A.Proc m' sm args body)) - = do (args', newargs) <- transformFormals args + = do (args', newargs) <- transformFormals m args body' <- doGeneric body let newspec = A.Proc m' sm args' body' modify (\cs -> cs {csNames = Map.adjust (\nd -> nd { A.ndType = newspec }) (A.nameName n) (csNames cs)}) @@ -252,14 +262,15 @@ addSizesFormalParameters = doGeneric `extM` doSpecification ,A.ndAbbrevMode = A.ValAbbrev ,A.ndPlacement = A.Unplaced} - transformFormals :: [A.Formal] -> PassM ([A.Formal], [A.Formal]) - transformFormals [] = return ([],[]) - transformFormals ((f@(A.Formal am t n)):fs) + transformFormals :: Meta -> [A.Formal] -> PassM ([A.Formal], [A.Formal]) + transformFormals _ [] = return ([],[]) + transformFormals m ((f@(A.Formal am t n)):fs) = case t of - A.Array ds _ -> do let newf = A.Formal A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) (append_sizes n) - (rest, moreNew) <- transformFormals fs + A.Array ds _ -> do let sizeType = A.Array [makeDimension m $ length ds] A.Int + let newf = A.Formal A.ValAbbrev sizeType (append_sizes n) + (rest, moreNew) <- transformFormals m fs return (f : newf : rest, newf : moreNew) - _ -> do (rest, new) <- transformFormals fs + _ -> do (rest, new) <- transformFormals m fs return (f : rest, new) -- | A pass for adding _sizes parameters to actuals in PROC calls @@ -276,10 +287,12 @@ addSizesActualParameters = doGeneric `extM` doProcess transformActual :: A.Actual -> PassM [A.Actual] transformActual a@(A.ActualVariable am (A.Array ds _) (A.Variable m n)) = do let a_sizes = A.Variable m (append_sizes n) - return [a, A.ActualVariable A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) a_sizes] + let sizeType = A.Array [makeDimension m $ length ds] A.Int + return [a, A.ActualVariable A.ValAbbrev sizeType a_sizes] transformActual a@(A.ActualExpression (A.Array ds _) (A.ExprVariable _ (A.Variable m n))) = do let a_sizes = A.Variable m (append_sizes n) - return [a, A.ActualVariable A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) a_sizes] + let sizeType = A.Array [makeDimension m $ length ds] A.Int + return [a, A.ActualVariable A.ValAbbrev sizeType a_sizes] transformActual a = let t = case a of A.ActualVariable _ t _ -> t A.ActualExpression t _ -> t @@ -304,7 +317,7 @@ simplifySlices = doGeneric `extM` doVariable = do v' <- doGeneric v A.Array (d:_) _ <- typeOfVariable v' limit <- case d of - A.Dimension n -> return $ makeConstant m' n + A.Dimension n -> return n A.UnknownDimension -> return $ A.SizeVariable m' v' from' <- doGeneric from return (A.SubscriptedVariable m (A.SubscriptFromFor m' from' (A.Dyadic m A.Subtr limit from')) v') diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index 358af04..bf31bd4 100644 --- a/backends/BackendPassesTest.hs +++ b/backends/BackendPassesTest.hs @@ -36,6 +36,7 @@ import TagAST import TestFramework import TestUtils import TreeUtils +import Types import Utils m :: Meta @@ -168,7 +169,7 @@ instance Arbitrary StaticTypeList where , (20, do len <- choose (1,5) ns <- replicateM len $ choose (1,1000) t <- oneof [return A.Int, return A.Byte] - return $ A.Array (map A.Dimension ns) t) + return $ A.Array (map dimension ns) t) ] return $ StaticTypeList tl @@ -181,7 +182,7 @@ instance Arbitrary DynTypeList where , (10, return A.Byte) , (20, do len <- choose (1,5) ds <- replicateM len $ oneof - [choose (1,1000) >>* A.Dimension + [choose (1,1000) >>* dimension ,return A.UnknownDimension] t <- oneof [return A.Int, return A.Byte] return $ A.Array ds t) @@ -194,7 +195,7 @@ newtype AbbrevTypesIs = AbbrevTypesIs ([A.Dimension], [A.Dimension], [A.Subscrip instance Arbitrary AbbrevTypesIs where arbitrary = do lenSrc <- choose (1,10) lenDest <- choose (1, lenSrc) - srcDims <- replicateM lenSrc $ oneof [return A.UnknownDimension, choose (1,1000) >>* A.Dimension] + srcDims <- replicateM lenSrc $ oneof [return A.UnknownDimension, choose (1,1000) >>* dimension] destDims <- flip mapM (take lenDest srcDims) $ \d -> case d of A.UnknownDimension -> return A.UnknownDimension @@ -229,8 +230,8 @@ qcTestDeclareSizes = strFooSizes = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") fooSizesSpec) isChanArrFoo :: Int -> (A.SpecType, A.SpecType, State CompState ()) - isChanArrFoo n = (A.IsChannelArray emptyMeta (A.Array [A.Dimension n] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Byte) (replicate n $ variable "c") - ,valSize [n], return ()) + isChanArrFoo n = (A.IsChannelArray emptyMeta (A.Array [dimension n] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Byte) (replicate n $ variable "c") + ,valSize [makeConstant emptyMeta n], return ()) isIsFoo :: ([A.Dimension], [A.Dimension], [A.Subscript]) -> (A.SpecType, A.SpecType, State CompState ()) isIsFoo (srcDims, destDims, subs) @@ -238,7 +239,7 @@ qcTestDeclareSizes = (foldr (A.SubscriptedVariable emptyMeta) (variable "src") subs) ,specSizes, defSrc) where - specSizes = A.Is emptyMeta A.ValAbbrev (A.Array [A.Dimension $ length destDims] A.Int) $ + specSizes = A.Is emptyMeta A.ValAbbrev (A.Array [dimension $ length destDims] A.Int) $ A.SubscriptedVariable emptyMeta (A.SubscriptFromFor emptyMeta (intLiteral $ toInteger $ length srcDims - length destDims) (intLiteral $ toInteger $ length destDims) @@ -271,21 +272,21 @@ qcTestDeclareSizes = checkSizeItems _ = const (return ()) isExprStaticFoo :: [Int] -> (A.SpecType, A.SpecType, State CompState ()) - isExprStaticFoo ns = (A.IsExpr emptyMeta A.ValAbbrev t (A.True emptyMeta), valSize ns, return ()) + isExprStaticFoo ns = (A.IsExpr emptyMeta A.ValAbbrev t (A.True emptyMeta), valSize (map (makeConstant emptyMeta) ns), return ()) where - t = A.Array (map A.Dimension ns) A.Byte + t = A.Array (map dimension ns) A.Byte declFoo :: [Int] -> (A.SpecType, A.SpecType, State CompState ()) - declFoo ns = (A.Declaration emptyMeta t, valSize ns, return ()) + declFoo ns = (A.Declaration emptyMeta t, valSize (map (makeConstant emptyMeta) ns), return ()) where - t = A.Array (map A.Dimension ns) A.Byte + t = A.Array (map dimension ns) A.Byte - valSize :: [Int] -> A.SpecType - valSize ds = A.IsExpr emptyMeta A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) $ makeSizesLiteral ds + valSize :: [A.Expression] -> A.SpecType + valSize ds = A.IsExpr emptyMeta A.ValAbbrev (A.Array [dimension $ length ds] A.Int) $ makeSizesLiteral ds - makeSizesLiteral :: [Int] -> A.Expression - makeSizesLiteral xs = A.Literal emptyMeta (A.Array [A.Dimension $ length xs] A.Int) $ A.ArrayLiteral emptyMeta $ - map (A.ArrayElemExpr . A.Literal emptyMeta A.Int . A.IntLiteral emptyMeta . show) xs + makeSizesLiteral :: [A.Expression] -> A.Expression + makeSizesLiteral xs = A.Literal emptyMeta (A.Array [dimension $ length xs] A.Int) $ A.ArrayLiteral emptyMeta $ + map A.ArrayElemExpr xs checkFooSizes :: TestMonad m r => A.SpecType -> CompState -> m () checkFooSizes sp = checkName "foo_sizes" sp A.ValAbbrev @@ -341,7 +342,7 @@ qcTestSizeParameters = args = [("x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts] argsWithSizes = concat [ case t of - (A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [A.Dimension $ length ds] A.Int, A.ValAbbrev)] + (A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [dimension $ length ds] A.Int, A.ValAbbrev)] _ -> [("x" ++ show n, t, A.Abbrev)] | (n, t) <- zip [(0::Integer)..] ts] @@ -357,7 +358,7 @@ qcTestSizeParameters = args = [("x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts] argsWithSizes = concat [ case t of - (A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [A.Dimension $ length ds] A.Int, A.ValAbbrev)] + (A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [dimension $ length ds] A.Int, A.ValAbbrev)] _ -> [("x" ++ show n, t, A.Abbrev)] | (n, t) <- zip [(0::Integer)..] ts] diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 52ad76e..199e694 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -254,7 +254,7 @@ cgenOverArray m var func A.UnknownDimension -> do call genVariable var call genSizeSuffix (show v) - A.Dimension n -> tell [show n] + A.Dimension n -> call genExpression n tell [";"] call genVariable i tell ["++){"] @@ -379,8 +379,13 @@ cgenBytesIn m t v Just s -> tell ["sizeof(", s, ")"] Nothing -> diePC m $ formatCode "genBytesIn' %" t + -- FIXME: This could be done by generating an expression for the size, + -- which is what declareSizesPass has to do -- they should share a helper + -- function. genBytesInArrayDim :: (A.Dimension,Int) -> CGen () - genBytesInArrayDim (A.Dimension n, _) = tell [show n, "*"] + genBytesInArrayDim (A.Dimension n, _) + = do call genExpression n + tell ["*"] genBytesInArrayDim (A.UnknownDimension, i) = case v of Right rv -> @@ -565,9 +570,10 @@ cgenUnfoldedVariable m var where unfoldArray :: [A.Dimension] -> A.Variable -> CGen () unfoldArray [] v = call genUnfoldedVariable m v - unfoldArray (A.Dimension n:ds) v - = seqComma $ [unfoldArray ds (A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) v) - | i <- [0..(n - 1)]] + unfoldArray (A.Dimension e:ds) v + = do n <- evalIntExpression e + seqComma $ [unfoldArray ds (A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) v) + | i <- [0..(n - 1)]] unfoldArray _ _ = dieP m "trying to unfold array with unknown dimension" -- | Generate a decimal literal -- removing leading zeroes to avoid producing @@ -831,7 +837,7 @@ cgenExpression (A.SizeExpr m e) cgenExpression (A.SizeVariable m v) = do A.Array (d:_) _ <- typeOfVariable v case d of - A.Dimension n -> tell [show n] + A.Dimension n -> call genExpression n A.UnknownDimension -> do call genVariable v call genSizeSuffix "0" cgenExpression (A.Conversion m cm t e) = call genConversion m cm t e @@ -1136,8 +1142,9 @@ cgenFlatArraySize :: [A.Dimension] -> CGen () cgenFlatArraySize ds = do tell ["["] sequence $ intersperse (tell ["*"]) - [case d of A.Dimension n -> tell [show n] | d <- ds] + [call genExpression n | A.Dimension n <- ds] tell ["]"] +-- FIXME: genBytesInArrayDim could share with this -- | Initialise an item being declared. cdeclareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()) @@ -1153,7 +1160,9 @@ cdeclareInit m t@(A.Array ds t') var tell ["_storage,"] call genVariableUnchecked var tell [","] - sequence_ $ intersperse (tell ["*"]) [case dim of A.Dimension d -> tell [show d] | dim <- ds] + sequence_ $ intersperse (tell ["*"]) + [call genExpression n | A.Dimension n <- ds] + -- FIXME: and again tell [");"] _ -> return () fdeclareInit <- fget declareInit diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 43ee885..d9a2161 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -484,7 +484,9 @@ cppdeclareInit m t@(A.Array ds t') var tell ["_storage,"] call genVariableUnchecked var tell [","] - sequence_ $ intersperse (tell ["*"]) [case dim of A.Dimension d -> tell [show d] | dim <- ds] + sequence_ $ intersperse (tell ["*"]) + [call genExpression n + | A.Dimension n <- ds] tell [");"] _ -> return () cppdeclareInit m rt@(A.Record _) var @@ -664,7 +666,7 @@ cppgenType (A.Chan dir attr t) = do tell ["tockSendableArray<"] call genType t tell [","] - tell $ intersperse "*" [case d of A.Dimension n -> show n | d <- ds] + sequence_ $ intersperse (tell ["*"]) [call genExpression n | A.Dimension n <- ds] tell [">/**/"] cppTypeInsideChannel t = call genType t cppgenType (A.Mobile t@(A.Array {})) = call genType t diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index ed81fc2..f973c47 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -225,15 +225,15 @@ testGenType = TestList ,testBothSame "GenType 22" "float*" (tcall genType $ A.Mobile A.Real32) - ,testBothSame "GenType 100" "int*" (tcall genType $ A.Array [A.Dimension 5] A.Int) - ,testBothSame "GenType 101" "int*" (tcall genType $ A.Array [A.Dimension 5, A.Dimension 2, A.Dimension 9] A.Int) - ,testBothSame "GenType 102" "int*" (tcall genType $ A.Array [A.Dimension 5, A.UnknownDimension] A.Int) + ,testBothSame "GenType 100" "int*" (tcall genType $ A.Array [dimension 5] A.Int) + ,testBothSame "GenType 101" "int*" (tcall genType $ A.Array [dimension 5, dimension 2, dimension 9] A.Int) + ,testBothSame "GenType 102" "int*" (tcall genType $ A.Array [dimension 5, A.UnknownDimension] A.Int) ,testBothSame "GenType 103" "foo" (tcall genType $ A.Record (simpleName "foo")) ,testBoth "GenType 200" "Time" "csp::Time" (tcall genType A.Time) ,testBoth "GenType 201" "Time" "csp::Time" (tcall genType A.Timer) - ,testBothSame "GenType 250" "int*" (tcall genType $ A.Mobile $ A.Array [A.Dimension 5, A.Dimension 2, A.Dimension 9] A.Int) - ,testBothSame "GenType 251" "int*" (tcall genType $ A.Mobile $ A.Array [A.Dimension 5, A.UnknownDimension] A.Int) + ,testBothSame "GenType 250" "int*" (tcall genType $ A.Mobile $ A.Array [dimension 5, dimension 2, dimension 9] A.Int) + ,testBothSame "GenType 251" "int*" (tcall genType $ A.Mobile $ A.Array [dimension 5, A.UnknownDimension] A.Int) ,testBothSame "GenType 251" "int*" (tcall genType $ A.Mobile $ A.Array [A.UnknownDimension] A.Int) ,testBothSame "GenType 252" "foo*" (tcall genType $ A.Mobile $ A.Record (simpleName "foo")) ,testBoth "GenType 253" "Time*" "csp::Time*" (tcall genType $ A.Mobile A.Time) @@ -256,8 +256,8 @@ testGenType = TestList ,testBothFail "GenType 600" (tcall genType $ A.UserProtocol (simpleName "foo")) ,testBothFail "GenType 650" (tcall genType $ A.Counted A.Int A.Int) - ,testBoth "GenType 700" "Channel**" "csp::One2OneChannel**" (tcall genType $ A.Array [A.Dimension 5] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) - ,testBoth "GenType 701" "Channel**" "csp::Chanin*" (tcall genType $ A.Array [A.Dimension 5] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) + ,testBoth "GenType 700" "Channel**" "csp::One2OneChannel**" (tcall genType $ A.Array [dimension 5] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) + ,testBoth "GenType 701" "Channel**" "csp::Chanin*" (tcall genType $ A.Array [dimension 5] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) --Test types that can only occur inside channels: --ANY: @@ -269,9 +269,9 @@ testGenType = TestList --Channels of arrays are special in C++: ,testBoth "GenType 1100" "Channel" "csp::One2OneChannel>" - (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>" - (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.Array [A.Dimension 6,A.Dimension 7,A.Dimension 8] A.Int) + (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.Array [dimension 6,dimension 7,dimension 8] A.Int) -- List types: @@ -345,7 +345,7 @@ testArraySubscript = TestList ] where stateTrans :: CSM m => m () - stateTrans = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7,A.Dimension 8,A.Dimension 8] A.Int) + stateTrans = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [dimension 7,dimension 8,dimension 8] A.Int) m = "\"" ++ show emptyMeta ++ "\"" lit :: Int -> (Meta, CGen ()) @@ -355,13 +355,13 @@ testArraySlice :: Test testArraySlice = TestList [ -- Slice from a one-dimensional array: - testSlice 0 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "])") "arr" 4 5 [A.Dimension 12] + testSlice 0 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "])") "arr" 4 5 [dimension 12] -- Slice from a two-dimensional array: - ,testSlice 1 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "*arr_sizes[1]])") "arr" 4 5 [A.Dimension 12,A.Dimension 12] + ,testSlice 1 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "*arr_sizes[1]])") "arr" 4 5 [dimension 12,dimension 12] -- Slice from a three-dimensional array: - ,testSlice 2 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "*arr_sizes[1]*arr_sizes[2]])") "arr" 4 5 [A.Dimension 12,A.Dimension 12,A.Dimension 12] + ,testSlice 2 ("(&arr[" ++ checkSlice "4" "5" "12" ++ "*arr_sizes[1]*arr_sizes[2]])") "arr" 4 5 [dimension 12,dimension 12,dimension 12] -- TODO test with unknown dimensions ] @@ -413,13 +413,13 @@ testOverArray = TestList $ map testOverArray' "for\\(int ([[:alnum:]_]+)=0;\\3 m () - state1Static = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7] A.Int) + state1Static = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [dimension 7] A.Int) state1Dynamic :: CSM m => m () state1Dynamic = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.UnknownDimension] A.Int) state3Static :: CSM m => m () - state3Static = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7, A.Dimension 8, A.Dimension 9] A.Int) + state3Static = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [dimension 7, dimension 8, dimension 9] A.Int) state3Dynamic :: CSM m => m () - state3Dynamic = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.UnknownDimension, A.Dimension 8, A.UnknownDimension] A.Int) + state3Dynamic = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.UnknownDimension, dimension 8, A.UnknownDimension] A.Int) testReplicator :: Test testReplicator = TestList @@ -446,49 +446,49 @@ testDeclaration = TestList --Arrays (of simple): ,testBothSame "genDeclaration 100" "int foo[8];" - (tcall3 genDeclaration (A.Array [A.Dimension 8] A.Int) foo False) + (tcall3 genDeclaration (A.Array [dimension 8] A.Int) foo False) ,testBothSame "genDeclaration 101" "int foo[8*9];" - (tcall3 genDeclaration (A.Array [A.Dimension 8,A.Dimension 9] A.Int) foo False) + (tcall3 genDeclaration (A.Array [dimension 8,dimension 9] A.Int) foo False) ,testBothSame "genDeclaration 102" "int foo[8*9*10];" - (tcall3 genDeclaration (A.Array [A.Dimension 8,A.Dimension 9,A.Dimension 10] A.Int) foo False) + (tcall3 genDeclaration (A.Array [dimension 8,dimension 9,dimension 10] A.Int) foo False) --Arrays (of simple) inside records: ,testBothSame "genDeclaration 110" "int foo[8];" - (tcall3 genDeclaration (A.Array [A.Dimension 8] A.Int) foo True) + (tcall3 genDeclaration (A.Array [dimension 8] A.Int) foo True) ,testBothSame "genDeclaration 111" "int foo[8*9];" - (tcall3 genDeclaration (A.Array [A.Dimension 8,A.Dimension 9] A.Int) foo True) + (tcall3 genDeclaration (A.Array [dimension 8,dimension 9] A.Int) foo True) ,testBothSame "genDeclaration 112" "int foo[8*9*10];" - (tcall3 genDeclaration (A.Array [A.Dimension 8,A.Dimension 9,A.Dimension 10] A.Int) foo True) + (tcall3 genDeclaration (A.Array [dimension 8,dimension 9,dimension 10] A.Int) foo True) --Arrays of channels and channel-ends: ,testBoth "genDeclaration 200" "Channel foo_storage[8];Channel* foo[8];" "csp::One2OneChannel foo_storage[8];csp::One2OneChannel* foo[8];" - (tcall3 genDeclaration (A.Array [A.Dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) foo False) + (tcall3 genDeclaration (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) foo False) ,testBoth "genDeclaration 201" "Channel foo_storage[8*9];Channel* foo[8*9];" "csp::One2OneChannel foo_storage[8*9];csp::One2OneChannel* foo[8*9];" - (tcall3 genDeclaration (A.Array [A.Dimension 8, A.Dimension 9] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) foo False) + (tcall3 genDeclaration (A.Array [dimension 8, dimension 9] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) foo False) ,testBoth "genDeclaration 202" "Channel* foo[8];" "csp::Chanin foo[8];" - (tcall3 genDeclaration (A.Array [A.Dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) foo False) + (tcall3 genDeclaration (A.Array [dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) foo False) ,testBoth "genDeclaration 203" "Channel* foo[8*9];" "csp::Chanout foo[8*9];" - (tcall3 genDeclaration (A.Array [A.Dimension 8, A.Dimension 9] $ A.Chan A.DirOutput (A.ChanAttributes False False) A.Int) foo False) + (tcall3 genDeclaration (A.Array [dimension 8, dimension 9] $ A.Chan A.DirOutput (A.ChanAttributes False False) A.Int) foo False) --Records of simple: ,testBothSameS "genDeclaration 300" "REC foo;" (tcall3 genDeclaration (A.Record $ simpleName "REC") foo False) (stateR A.Int) --Records of arrays of int (the sizes are set by declareInit): - ,testBothSameS "genDeclaration 400" "REC foo;" (tcall3 genDeclaration (A.Record $ simpleName "REC") foo False) (stateR $ A.Array [A.Dimension 8] A.Int) + ,testBothSameS "genDeclaration 400" "REC foo;" (tcall3 genDeclaration (A.Record $ simpleName "REC") foo False) (stateR $ A.Array [dimension 8] A.Int) --Timers: ,testBoth "genDeclaration 500" "Time foo;" "csp::Time foo;" (tcall3 genDeclaration A.Timer foo False) ,testBoth "genDeclaration 501" "Time foo[20];" "csp::Time foo[20];" - (tcall3 genDeclaration (A.Array [A.Dimension 20] A.Timer) foo False) + (tcall3 genDeclaration (A.Array [dimension 20] A.Timer) foo False) ] where stateR t = defRecord "REC" "bar" t @@ -504,27 +504,27 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList ,testAllSame 2 ("","") $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int -- Plain arrays: - ,testAllSame 3 ("","") $ A.Array [A.Dimension 4] A.Int + ,testAllSame 3 ("","") $ A.Array [dimension 4] A.Int -- Channel arrays: - ,testAll 4 ("tock_init_chan_array(foo_storage,foo,4);^ChanInit(wptr,foo[0]);^","") ("tockInitChanArray(foo_storage,foo,4);","") $ A.Array [A.Dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int - ,testAllSame 6 ("","") $ A.Array [A.Dimension 4] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int + ,testAll 4 ("tock_init_chan_array(foo_storage,foo,4);^ChanInit(wptr,foo[0]);^","") ("tockInitChanArray(foo_storage,foo,4);","") $ A.Array [dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int + ,testAllSame 6 ("","") $ A.Array [dimension 4] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int -- Plain records: ,testAllR 100 ("","") ("","") A.Int id -- Records containing an array: - ,testAllR 101 ("","") ("","") (A.Array [A.Dimension 4,A.Dimension 5] A.Int) id + ,testAllR 101 ("","") ("","") (A.Array [dimension 4,dimension 5] A.Int) id -- Arrays of records containing an array: - ,testAllRA 200 ("^^","") ("","") (A.Array [A.Dimension 4,A.Dimension 5] A.Int) id + ,testAllRA 200 ("^^","") ("","") (A.Array [dimension 4,dimension 5] A.Int) id -- Mobile versions - ,testAllSame 1003 ("","") $ A.Mobile $ A.Array [A.Dimension 4] A.Int - ,testAllSame 1004 ("","") $ A.Mobile $ A.Array [A.Dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int + ,testAllSame 1003 ("","") $ A.Mobile $ A.Array [dimension 4] A.Int + ,testAllSame 1004 ("","") $ A.Mobile $ A.Array [dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int ,testAllR 1100 ("","") ("","") A.Int A.Mobile -- Records containing an array: - ,testAllR 1101 ("","") ("","") (A.Array [A.Dimension 4,A.Dimension 5] A.Int) A.Mobile + ,testAllR 1101 ("","") ("","") (A.Array [dimension 4,dimension 5] A.Int) A.Mobile -- Arrays of records containing an array: - ,testAllRA 1200 ("","") ("","") (A.Array [A.Dimension 4,A.Dimension 5] A.Int) A.Mobile + ,testAllRA 1200 ("","") ("","") (A.Array [dimension 4,dimension 5] A.Int) A.Mobile ] @@ -536,7 +536,7 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList testAllR n eC eCPP t f = testAll' n eC eCPP (f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Record (simpleName "REC"))) testAllRA :: Int -> (String,String) -> (String,String) -> A.Type -> (A.Type -> A.Type) -> Test - testAllRA n eC eCPP t f = testAll' n eC eCPP (A.Array [A.Dimension 5] $ f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Array [A.Dimension 5] $ A.Record (simpleName "REC"))) + testAllRA n eC eCPP t f = testAll' n eC eCPP (A.Array [dimension 5] $ f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Array [dimension 5] $ A.Record (simpleName "REC"))) testAll' :: Int -> (String,String) -> (String,String) -> A.Type -> State CompState () -> Test testAll' n (iC,fC) (iCPP,fCPP) t state = TestList @@ -562,7 +562,7 @@ testRecord = TestList --Record types: testAllSame 400 ("typedef struct{#ATION_True}foo;","") foo False [(bar,A.Int)] ,testAllSame 401 ("typedef struct{#ATION_True#ATION_True} occam_struct_packed foo;","") foo True [(bar,A.Int),(bar,A.Int)] - ,testAllSame 402 ("typedef struct{#ATION_True}foo;","") foo False [(bar,A.Array [A.Dimension 6, A.Dimension 7] A.Int)] + ,testAllSame 402 ("typedef struct{#ATION_True}foo;","") foo False [(bar,A.Array [dimension 6, dimension 7] A.Int)] ] where testAll :: Int -> (String,String) -> (String,String) -> A.Name -> Bool -> [(A.Name, A.Type)] -> Test @@ -584,8 +584,8 @@ testSpec = TestList --Declaration: testAllSame 0 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta A.Int ,testAllSame 1 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) - ,testAllSame 2 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [A.Dimension 3] A.Int) - ,testAllSame 3 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [A.Dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) + ,testAllSame 2 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [dimension 3] A.Int) + ,testAllSame 3 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) -- TODO test declarations with initialisers @@ -598,7 +598,7 @@ testSpec = TestList --IsChannelArray: ,testAllSame 500 ("$(" ++ show chanInt ++ ")*foo[]={@,@};","") - $ A.IsChannelArray emptyMeta (A.Array [A.Dimension 2] $ chanInt) + $ A.IsChannelArray emptyMeta (A.Array [dimension 2] $ chanInt) [A.Variable undefined undefined,A.Variable undefined undefined] --Is: @@ -648,7 +648,7 @@ testSpec = TestList (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at}) -- single (known) dimension: ,testAllSameS 1101 ("uint8_t* foo=(uint8_t*)&y;@","") - (A.Retypes emptyMeta A.Abbrev (A.Array [A.Dimension 4] A.Byte) (variable "y")) + (A.Retypes emptyMeta A.Abbrev (A.Array [dimension 4] A.Byte) (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at}) -- single (unknown) dimension, VAL: ,testAllSameS 1102 ("const uint8_t* foo=(const uint8_t*)&y;@","") @@ -656,7 +656,7 @@ testSpec = TestList (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at}) -- single (known) dimension, VAL: ,testAllSameS 1103 ("const uint8_t* foo=(const uint8_t*)&y;@","") - (A.Retypes emptyMeta A.ValAbbrev (A.Array [A.Dimension 4] A.Byte) (variable "y")) + (A.Retypes emptyMeta A.ValAbbrev (A.Array [dimension 4] A.Byte) (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at}) -- TODO test multiple dimensions plain-to-array (mainly for C++) @@ -714,15 +714,15 @@ testRetypeSizes = TestList -- Array types where both sizes are fixed should act like the plain types: ,test 3 "if(occam_check_retype(#S,#D,#M)!=1){@}" - (A.Array [A.Dimension 2] A.Int) (A.Array [A.Dimension 8] A.Byte) + (A.Array [dimension 2] A.Int) (A.Array [dimension 8] A.Byte) ,test 4 "if(occam_check_retype(#S,#D,#M)!=1){@}" - (A.Array [A.Dimension 2,A.Dimension 3,A.Dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte) + (A.Array [dimension 2,dimension 3,dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte) -- Array types with a free dimension should not check the return: ,test 100 "occam_check_retype(#S,#D,#M);" - (A.Array [A.UnknownDimension] A.Int) (A.Array [A.Dimension 8] A.Byte) + (A.Array [A.UnknownDimension] A.Int) (A.Array [dimension 8] A.Byte) ,test 101 "occam_check_retype(#S,#D,#M);" - (A.Array [A.Dimension 2,A.UnknownDimension,A.Dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte) + (A.Array [dimension 2,A.UnknownDimension,dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte) ] where test :: Int -> String -> A.Type -> A.Type -> Test @@ -759,16 +759,16 @@ testGenVariable = TestList ,testSameA2 55 ("foo","(*foo)") deref (A.Mobile $ A.Record bar) -- Arrays of the previous types, unsubscripted: - ,testSameA 100 ("foo","foo","foo") id (A.Array [A.Dimension 8] A.Int) - ,testSameA 110 ("foo","foo","foo") id (A.Array [A.Dimension 8] $ A.Record bar) - ,testSameA2 120 ("foo","foo") id (A.Array [A.Dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) - ,testSameA2 130 ("foo","foo") id (A.Array [A.Dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) + ,testSameA 100 ("foo","foo","foo") id (A.Array [dimension 8] A.Int) + ,testSameA 110 ("foo","foo","foo") id (A.Array [dimension 8] $ A.Record bar) + ,testSameA2 120 ("foo","foo") id (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) + ,testSameA2 130 ("foo","foo") id (A.Array [dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) -- Mobile arrays of the previous types: - ,testSameA2 140 ("foo","(*foo)") id (A.Mobile $ A.Array [A.Dimension 8] A.Int) - ,testSameA2 145 ("foo","(*foo)") deref (A.Mobile $ A.Array [A.Dimension 8] A.Int) - ,testSameA2 150 ("foo","(*foo)") id (A.Mobile $ A.Array [A.Dimension 8] $ A.Record bar) - ,testSameA2 155 ("foo","(*foo)") deref (A.Mobile $ A.Array [A.Dimension 8] $ A.Record bar) + ,testSameA2 140 ("foo","(*foo)") id (A.Mobile $ A.Array [dimension 8] A.Int) + ,testSameA2 145 ("foo","(*foo)") deref (A.Mobile $ A.Array [dimension 8] A.Int) + ,testSameA2 150 ("foo","(*foo)") id (A.Mobile $ A.Array [dimension 8] $ A.Record bar) + ,testSameA2 155 ("foo","(*foo)") deref (A.Mobile $ A.Array [dimension 8] $ A.Record bar) -- Subscripted record: ,testSameA 200 ("(&foo)->x","foo->x","foo->x") fieldX (A.Record bar) @@ -778,17 +778,17 @@ testGenVariable = TestList ,testSameA 230 ("(&(&foo)->y)->x","(&foo->y)->x","(&foo->y)->x") (fieldX . fieldY) (A.Record $ simpleName "barbar") -- Fully subscripted array: - ,testAC 300 ("foo@C4","foo@U4") (sub 4) (A.Array [A.Dimension 8] A.Int) - ,testAC 305 ("foo@C4,5,6","foo@U4,5,6") ((sub 6) . (sub 5) . (sub 4)) (A.Array [A.Dimension 8,A.Dimension 9,A.Dimension 10] A.Int) - ,testAC 310 ("(&foo@C4)","(&foo@U4)") (sub 4) (A.Array [A.Dimension 8] $ A.Record bar) + ,testAC 300 ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] A.Int) + ,testAC 305 ("foo@C4,5,6","foo@U4,5,6") ((sub 6) . (sub 5) . (sub 4)) (A.Array [dimension 8,dimension 9,dimension 10] A.Int) + ,testAC 310 ("(&foo@C4)","(&foo@U4)") (sub 4) (A.Array [dimension 8] $ A.Record bar) -- Original channel arrays are Channel*[], abbreviated channel arrays are Channel*[]: - ,testAC2 320 ("foo@C4","foo@U4") ("foo@C4","foo@U4") (sub 4) (A.Array [A.Dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) - ,testAC 330 ("foo@C4","foo@U4") (sub 4) (A.Array [A.Dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) + ,testAC2 320 ("foo@C4","foo@U4") ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) + ,testAC 330 ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int) -- Fully subscripted array, and record field reference: - ,testAC 400 ("(&foo@C4)->x","(&foo@U4)->x") (fieldX . (sub 4)) (A.Array [A.Dimension 8] $ A.Record bar) + ,testAC 400 ("(&foo@C4)->x","(&foo@U4)->x") (fieldX . (sub 4)) (A.Array [dimension 8] $ A.Record bar) -- As above, but then with an index too: - ,testAC 410 ("(&foo@C4)->x@C4","(&foo@U4)->x@U4") ((sub 4) . fieldX . (sub 4)) (A.Array [A.Dimension 8] $ A.Record bar) + ,testAC 410 ("(&foo@C4)->x@C4","(&foo@U4)->x@U4") ((sub 4) . fieldX . (sub 4)) (A.Array [dimension 8] $ A.Record bar) --TODO come back to slices later @@ -796,7 +796,7 @@ testGenVariable = TestList ,testSameA2 500 ("$(&foo)$","$foo$") dir (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) -- Test for mobile channels (in future) --,testSameA2 510 ("$foo$","$(*foo)$") (dir . deref) (A.Mobile $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) - ,testAC2 520 ("$foo@C4$","$foo@U4$") ("$foo@C4$","$foo@U4$") (dir . (sub 4)) (A.Array [A.Dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) + ,testAC2 520 ("$foo@C4$","$foo@U4$") ("$foo@C4$","$foo@U4$") (dir . (sub 4)) (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) ] where deref = A.DerefVariable emptyMeta @@ -813,7 +813,7 @@ testGenVariable = TestList ] where state = do defineName (simpleName "foo") $ A.NameDef emptyMeta "foo" "foo" A.VariableName (A.Declaration emptyMeta t) am A.Unplaced - defRecord "bar" "x" $ A.Array [A.Dimension 7] A.Int + defRecord "bar" "x" $ A.Array [dimension 7] A.Int defRecord "barbar" "y" $ A.Record bar over :: Override over = local $ \ops -> ops {genArraySubscript = (\c _ subs -> at >> (tell [if c /= A.NoCheck then "C" else "U"]) >> (seqComma $ map snd subs)) @@ -942,7 +942,7 @@ testInput = TestList ,testInputItem 101 "ChanIn(wptr,#,&x,^(Int8));" "#>>x;" (A.InVariable emptyMeta $ variable "x") A.Int8 ,testInputItem 102 ("ChanIn(wptr,#,(&x),^(" ++ show (A.Record foo) ++ "));") "#>>*(&x);" (A.InVariable emptyMeta $ variable "x") (A.Record foo) -- Reading into a fixed size array: - ,testInputItem 103 "ChanIn(wptr,#,x,^(Array [Dimension 8] Int));" "tockRecvArray(#,x);" (A.InVariable emptyMeta $ variable "x") $ A.Array [A.Dimension 8] A.Int + ,testInputItem 103 "ChanIn(wptr,#,x,^(Array [Dimension 8] Int));" "tockRecvArray(#,x);" (A.InVariable emptyMeta $ variable "x") $ A.Array [dimension 8] A.Int -- Reading into subscripted variables: ,testInputItem 110 "ChanInInt(wptr,#,&xs$);" "#>>xs$;" (A.InVariable emptyMeta $ sub0 $ variable "xs") A.Int @@ -969,7 +969,7 @@ testInput = TestList ,testInputItemProt 302 ("ChanIn(wptr,#,(&x),^(" ++ show (A.Record foo) ++ "));") ("tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(" ++ show (A.Record foo) ++ "),(&x)));") (A.InVariable emptyMeta $ variable "x") (A.Record foo) ,testInputItemProt 303 "ChanIn(wptr,#,x,^(Array [Dimension 8] Int));" "tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(Array [Dimension 8] Int),x));" - (A.InVariable emptyMeta $ variable "x") $ A.Array [A.Dimension 8] A.Int + (A.InVariable emptyMeta $ variable "x") $ A.Array [dimension 8] A.Int ,testInputItemProt 400 "ChanInInt(wptr,#,&x);ChanIn(wptr,#,xs,x*^(Int));" "tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(Int),&x));tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(x*^(Int),xs));" (A.InCounted emptyMeta (variable "x") (variable "xs")) (A.Counted A.Int A.Int) @@ -1002,8 +1002,8 @@ testInput = TestList defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t') _ -> do defineName (simpleName "x") $ simpleDefDecl "x" t defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t) - mkArray (A.Array ds t) = A.Array (A.Dimension 6:ds) t - mkArray t = A.Array [A.Dimension 6] t + mkArray (A.Array ds t) = A.Array (dimension 6:ds) t + mkArray t = A.Array [dimension 6] t -- chan = simpleName "c" -- chanIn = simpleName "cIn" @@ -1012,7 +1012,12 @@ testInput = TestList overInputItemCase, over :: Override overInputItemCase = local $ \ops -> ops {genInputItem = override2 caret} - over = local $ \ops -> ops {genBytesIn = (\_ t _ -> tell ["^(",show t,")"]) , genArraySubscript = override3 dollar} + over = local $ \ops -> ops {genBytesIn = (\_ t _ -> tell ["^(", showSimplerType t, ")"]) , genArraySubscript = override3 dollar} + + -- | Show a type, simplifying how Dimensions are show. + showSimplerType :: A.Type -> String + showSimplerType t = subRegex re (show t) "Dimension \\1" + where re = mkRegex "Dimension [^\"]*\"([^\"]*)\"\\)\\)" testOutput :: Test testOutput = TestList @@ -1031,17 +1036,17 @@ testOutput = TestList --A record type on the channel of the right type (because records are always referenced by pointer): ,testOutputItem 203 "ChanOut(wptr,#,(&x),^);" "#<<*(&x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Record foo) --A fixed size array on the channel of the right type: - ,testOutputItem 204 "ChanOut(wptr,#,x,^);" "tockSendArray(#,x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [A.Dimension 6] A.Int) - ,testOutputItem 205 "ChanOut(wptr,#,x,^);" "tockSendArray(#,x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [A.Dimension 6, A.Dimension 7, A.Dimension 8] A.Int) + ,testOutputItem 204 "ChanOut(wptr,#,x,^);" "tockSendArray(#,x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [dimension 6] A.Int) + ,testOutputItem 205 "ChanOut(wptr,#,x,^);" "tockSendArray(#,x);" (A.OutExpression emptyMeta $ exprVariable "x") (A.Array [dimension 6, dimension 7, dimension 8] A.Int) --A counted array: ,testOutputItem 206 "ChanOutInt(wptr,#,x);ChanOut(wptr,#,xs,x*^);" "#< do defineName (simpleName "x") $ simpleDefDecl "x" t defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t') _ -> defineName (simpleName "x") $ simpleDefDecl "x" t - mkArray (A.Array ds t) = A.Array (A.Dimension 6:ds) t - mkArray t = A.Array [A.Dimension 6] t + mkArray (A.Array ds t) = A.Array (dimension 6:ds) t + mkArray t = A.Array [dimension 6] t chan = simpleName "c" chanOut = simpleName "cOut" @@ -1109,7 +1114,7 @@ testBytesIn = TestList ,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin)" (tcall3 genBytesIn undefined (A.Chan A.DirInput (A.ChanAttributes False False) A.Int) undefined) --Array with a single known dimension: - ,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [A.Dimension 5] A.Int) (Left False)) + ,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [dimension 5] A.Int) (Left False)) --single unknown dimension, no variable, no free dimension allowed: ,testBothFail "testBytesIn 101a" (tcall3 genBytesIn undefined (A.Array [A.UnknownDimension] A.Int) (Left False)) --single unknown dimension, no variable, free dimension allowed: @@ -1118,13 +1123,13 @@ testBytesIn = TestList ,testBothSame "testBytesIn 102" "$(@0)*sizeof(int)" (over (tcall3 genBytesIn undefined (A.Array [A.UnknownDimension] A.Int) (Right undefined))) --Array with all known dimensions: - ,testBothSame "testBytesIn 200" "7*6*5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [A.Dimension 5,A.Dimension 6, A.Dimension 7] A.Int) (Left False)) + ,testBothSame "testBytesIn 200" "7*6*5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [dimension 5,dimension 6, dimension 7] A.Int) (Left False)) --single unknown dimension, no variable, no free dimension allowed: - ,testBothFail "testBytesIn 201a" (tcall3 genBytesIn undefined (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Left False)) + ,testBothFail "testBytesIn 201a" (tcall3 genBytesIn undefined (A.Array [dimension 5,dimension 6,A.UnknownDimension] A.Int) (Left False)) --single unknown dimension, no variable, free dimension allowed: - ,testBothSame "testBytesIn 201b" "6*5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Left True)) + ,testBothSame "testBytesIn 201b" "6*5*sizeof(int)" (tcall3 genBytesIn undefined (A.Array [dimension 5,dimension 6,A.UnknownDimension] A.Int) (Left True)) --single unknown dimension, with variable: - ,testBothSame "testBytesIn 202" "$(@2)*6*5*sizeof(int)" (over (tcall3 genBytesIn undefined (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Right undefined))) + ,testBothSame "testBytesIn 202" "$(@2)*6*5*sizeof(int)" (over (tcall3 genBytesIn undefined (A.Array [dimension 5,dimension 6,A.UnknownDimension] A.Int) (Right undefined))) ] where diff --git a/checks/ArrayUsageCheck.hs b/checks/ArrayUsageCheck.hs index 5cf00b9..d7f8b33 100644 --- a/checks/ArrayUsageCheck.hs +++ b/checks/ArrayUsageCheck.hs @@ -86,10 +86,10 @@ checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $ arrLength <- case arrType of A.Array (A.Dimension d:_) _ -> return d -- Unknown dimension, use the maximum value for a (assumed 32-bit for INT) integer: - A.Array (A.UnknownDimension:_) _ -> return $ fromInteger $ toInteger (maxBound :: Int32) + A.Array (A.UnknownDimension:_) _ -> return $ makeConstant m $ fromInteger $ toInteger (maxBound :: Int32) -- It's not an array: _ -> dieP m $ "Cannot usage check array \"" ++ userArrName ++ "\"; found to be of type: " ++ show arrType - case makeEquations (concatMap makeRepBounds $ listReplicators p) indexes (makeConstant emptyMeta arrLength) of + case makeEquations (concatMap makeRepBounds $ listReplicators p) indexes arrLength of Left err -> dieP m $ "Could not work with array indexes for array \"" ++ userArrName ++ "\": " ++ err Right [] -> return () -- No problems to work with Right problems -> diff --git a/common/EvalConstants.hs b/common/EvalConstants.hs index 0a5a3eb..ae12bdd 100644 --- a/common/EvalConstants.hs +++ b/common/EvalConstants.hs @@ -140,7 +140,7 @@ evalExpression (A.MostNeg _ A.Int64) = return $ OccInt64 minBound evalExpression (A.SizeExpr m e) = do t <- typeOfExpression e >>= underlyingType m case t of - A.Array (A.Dimension n:_) _ -> return $ OccInt (fromIntegral n) + A.Array (A.Dimension n:_) _ -> evalExpression n _ -> do v <- evalExpression e case v of @@ -149,7 +149,7 @@ evalExpression (A.SizeExpr m e) evalExpression (A.SizeVariable m v) = do t <- typeOfVariable v >>= underlyingType m case t of - A.Array (A.Dimension n:_) _ -> return $ OccInt (fromIntegral n) + A.Array (A.Dimension n:_) _ -> evalExpression n _ -> throwError (Just m, "size of non-fixed-size variable " ++ show v ++ " used") evalExpression e@(A.Literal _ _ _) = evalLiteral e evalExpression (A.ExprVariable _ v) = evalVariable v @@ -159,12 +159,12 @@ evalExpression (A.SubscriptedExpr _ sub e) = evalExpression e >>= evalSubscript evalExpression (A.BytesInExpr m e) = do b <- typeOfExpression e >>= underlyingType m >>= bytesInType case b of - BIJust n -> return $ OccInt (fromIntegral $ n) + BIJust n -> evalExpression n _ -> throwError (Just m, "BYTESIN non-constant-size expression " ++ show e ++ " used") evalExpression (A.BytesInType m t) = do b <- underlyingType m t >>= bytesInType case b of - BIJust n -> return $ OccInt (fromIntegral $ n) + BIJust n -> evalExpression n _ -> throwErrorC (Just m, formatCode "BYTESIN non-constant-size type % used" t) evalExpression e = throwError (Just $ findMeta e, "bad expression") @@ -272,7 +272,7 @@ renderLiteral m (OccInt64 i) = (A.Int64, A.IntLiteral m $ show i) renderLiteral m (OccArray vs) = (t, A.ArrayLiteral m aes) where - t = addDimensions [A.Dimension $ length vs] (head ts) + t = addDimensions [makeDimension m $ length vs] (head ts) (ts, aes) = unzip $ map (renderLiteralArray m) vs renderLiteral m (OccRecord n vs) = (A.Record n, A.RecordLiteral m (map (snd . renderValue m) vs)) @@ -293,7 +293,7 @@ renderLiteralArray :: Meta -> OccValue -> (A.Type, A.ArrayElem) renderLiteralArray m (OccArray vs) = (t, A.ArrayElemArray aes) where - t = addDimensions [A.Dimension $ length vs] (head ts) + t = addDimensions [makeDimension m $ length vs] (head ts) (ts, aes) = unzip $ map (renderLiteralArray m) vs renderLiteralArray m v = (t, A.ArrayElemExpr e) diff --git a/common/ShowCode.hs b/common/ShowCode.hs index 11ce267..e904536 100644 --- a/common/ShowCode.hs +++ b/common/ShowCode.hs @@ -200,10 +200,12 @@ instance ShowOccam A.Type where showOccamM (A.Mobile t) = return "MOBILE " +>> showOccamM t showOccamM (A.Array ds t) - = (return $ concat [case d of - A.Dimension n -> "[" ++ show n ++ "]" - A.UnknownDimension -> "[]" - | d <- ds]) +>> showOccamM t + = (liftM concat $ sequence dims) +>> showOccamM t + where + dims = [case d of + A.Dimension n -> return "[" +>> showOccamM n +>> return "]" + A.UnknownDimension -> return "[]" + | d <- ds] showOccamM (A.Chan _ _ t) = return "CHAN OF " +>> showOccamM t showOccamM (A.Counted ct et) = showOccamM ct +>> return "::" +>> showOccamM et showOccamM (A.Port t) = return "PORT OF " +>> showOccamM t diff --git a/common/TestUtils.hs b/common/TestUtils.hs index 3d5e0bf..db65c26 100644 --- a/common/TestUtils.hs +++ b/common/TestUtils.hs @@ -111,6 +111,10 @@ testCheck config property = --}}} --{{{ building AST fragments and patterns +-- | Helper function to generate an array dimension. +dimension :: Int -> A.Dimension +dimension n = makeDimension emptyMeta n + -- | Creates a 'A.Name' object with the given 'String' as 'A.nameName', and 'A.nameType' as 'A.VariableName'. simpleName :: String -> A.Name simpleName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.VariableName } diff --git a/common/Types.hs b/common/Types.hs index 385ba49..94470a6 100644 --- a/common/Types.hs +++ b/common/Types.hs @@ -24,7 +24,7 @@ module Types , returnTypesOfFunction , BytesInResult(..), bytesInType, countReplicator, countStructured, computeStructured - , makeAbbrevAM, makeConstant, addOne + , makeAbbrevAM, makeConstant, makeDimension, addOne, addExprs, mulExprs, divExprs , addDimensions, removeFixedDimensions, trivialSubscriptType, subscriptType, unsubscriptType , recordFields, protocolItems @@ -81,27 +81,6 @@ typeOfSpec st _ -> return Nothing --{{{ identifying types --- | Apply a slice to a type. -sliceType :: (CSMR m, Die m) => Meta -> A.Expression -> A.Expression -> A.Type -> m A.Type -sliceType m base count (A.Array (d:ds) t) - = case (isConstant base, isConstant count) of - (True, True) -> - do b <- evalIntExpression base - c <- evalIntExpression count - case d of - A.Dimension size -> - if (size - b) < c - then dieP m $ "invalid slice " ++ show b ++ " -> " ++ show c ++ " of " ++ show size - else return $ A.Array (A.Dimension c : ds) t - A.UnknownDimension -> - return $ A.Array (A.Dimension c : ds) t - (True, False) -> return $ A.Array (A.UnknownDimension : ds) t - (False, True) -> - do c <- evalIntExpression count - return $ A.Array (A.Dimension c : ds) t - (False, False) -> return $ A.Array (A.UnknownDimension : ds) t -sliceType m _ _ _ = dieP m "slice of non-array type" - -- | Get the fields of a record type. recordFields :: (CSMR m, Die m) => Meta -> A.Type -> m [(A.Name, A.Type)] recordFields m (A.Record rec) @@ -119,37 +98,36 @@ typeOfRecordField m t field -- | Apply a plain subscript to a type. plainSubscriptType :: (CSMR m, Die m) => Meta -> A.Expression -> A.Type -> m A.Type -plainSubscriptType m sub (A.Array (d:ds) t) - = case (isConstant sub, d) of - (True, A.Dimension size) -> - do i <- evalIntExpression sub - if (i < 0) || (i >= size) - then dieP m $ "invalid subscript " ++ show i ++ " of " ++ show size - else return ok - _ -> return ok - where - ok = case ds of - [] -> t - _ -> A.Array ds t +plainSubscriptType m sub (A.Array (_:ds) t) + = return $ case ds of + [] -> t + _ -> A.Array ds t plainSubscriptType m _ t = diePC m $ formatCode "subscript of non-array type: %" t +-- | Turn an expression into a 'Dimension'. +-- If the expression is constant, it'll produce 'Dimension'; if not, it'll +-- produce 'UnknownDimension'. +dimensionFromExpr :: A.Expression -> A.Dimension +dimensionFromExpr e + = if isConstant e + then A.Dimension $ e + else A.UnknownDimension + -- | Apply a subscript to a type, and return what the type is after it's been -- subscripted. subscriptType :: (CSMR m, Die m) => A.Subscript -> A.Type -> m A.Type subscriptType sub t@(A.UserDataType _) = resolveUserType (findMeta sub) t >>= subscriptType sub -subscriptType (A.SubscriptFromFor m base count) t - = sliceType m base count t +subscriptType (A.SubscriptFromFor m _ count) (A.Array (_:ds) t) + = return $ A.Array (dimensionFromExpr count : ds) t subscriptType (A.SubscriptFrom m base) (A.Array (d:ds) t) - = case (isConstant base, d) of - (True, A.Dimension size) -> - do b <- evalIntExpression base - if (size - b) < 0 - then dieP m $ "invalid slice " ++ show b ++ " -> end of " ++ show size - else return $ A.Array (A.Dimension (size - b) : ds) t - _ -> return $ A.Array (A.UnknownDimension : ds) t -subscriptType (A.SubscriptFor m count) t - = sliceType m (makeConstant emptyMeta 0) count t + = return $ A.Array (dim : ds) t + where + dim = case d of + A.Dimension size -> dimensionFromExpr $ A.Dyadic m A.Subtr size base + _ -> A.UnknownDimension +subscriptType (A.SubscriptFor m count) (A.Array (_:ds) t) + = return $ A.Array (dimensionFromExpr count : ds) t subscriptType (A.SubscriptField m tag) t = typeOfRecordField m t tag subscriptType (A.Subscript m _ sub) t = plainSubscriptType m sub t subscriptType sub t = diePC (findMeta sub) $ formatCode "Unsubscriptable type: %" t @@ -262,8 +240,7 @@ typeOfExpression e else typeOfArrayList [A.UnknownDimension] bt A.ExprConstr m (A.RepConstr _ rep e) -> do t <- typeOfExpression e - count <- evalIntExpression $ countReplicator rep - typeOfArrayList [A.Dimension count] t + typeOfArrayList [A.Dimension $ countReplicator rep] t A.AllocMobile _ t _ -> return t --}}} @@ -367,10 +344,15 @@ makeAbbrevAM :: A.AbbrevMode -> A.AbbrevMode makeAbbrevAM A.Original = A.Abbrev makeAbbrevAM am = am --- | Generate a constant expression from an integer -- for array sizes and the like. +-- | Generate a constant expression from an integer -- for array sizes and the +-- like. makeConstant :: Meta -> Int -> A.Expression makeConstant m n = A.Literal m A.Int $ A.IntLiteral m (show n) +-- | Generate a constant dimension from an integer. +makeDimension :: Meta -> Int -> A.Dimension +makeDimension m n = A.Dimension $ makeConstant m n + -- | Checks whether a given conversion can be done implicitly in Rain -- Parameters are src dest isImplicitConversionRain :: A.Type -> A.Type -> Bool @@ -526,34 +508,39 @@ isCaseableType t = isIntegerType t --{{{ sizes of types -- | The size in bytes of a data type. data BytesInResult = - BIJust Int -- ^ Just that many bytes. - | BIOneFree Int Int -- ^ An array type; A bytes, times unknown dimension B. - | BIManyFree -- ^ An array type with multiple unknown dimensions. - | BIUnknown -- ^ We can't tell the size at compile time. + BIJust A.Expression -- ^ Just that many bytes. + | BIOneFree A.Expression Int -- ^ An array type; A bytes, times unknown dimension B. + | BIManyFree -- ^ An array type with multiple unknown dimensions. + | BIUnknown -- ^ We can't tell the size at compile time. deriving (Show, Eq) --- | Given the C and C++ values (in that order), selects according to the backend --- If the backend is not recognised, the C sizes are used -sizeByBackend :: CSMR m => Int -> Int -> m Int -sizeByBackend c cxx = do backend <- getCompState >>* csBackend - return $ case backend of - BackendCPPCSP -> cxx - _ -> c +-- | Make a fixed-size 'BytesInResult'. +justSize :: CSMR m => Int -> m BytesInResult +justSize n = return $ BIJust $ makeConstant emptyMeta n + +-- | Given the C and C++ values (in that order), selects according to the +-- backend. If the backend is not recognised, the C sizes are used. +justSizeBackends :: CSMR m => Int -> Int -> m BytesInResult +justSizeBackends c cxx + = do backend <- getCompState >>* csBackend + case backend of + BackendCPPCSP -> justSize c + _ -> justSize cxx -- | Return the size in bytes of a data type. bytesInType :: (CSMR m, Die m) => A.Type -> m BytesInResult -bytesInType A.Bool = sizeByBackend cBoolSize cxxBoolSize >>* BIJust -bytesInType A.Byte = return $ BIJust 1 -bytesInType A.UInt16 = return $ BIJust 2 -bytesInType A.UInt32 = return $ BIJust 4 -bytesInType A.UInt64 = return $ BIJust 8 -bytesInType A.Int8 = return $ BIJust 1 -bytesInType A.Int = sizeByBackend cIntSize cxxIntSize >>* BIJust -bytesInType A.Int16 = return $ BIJust 2 -bytesInType A.Int32 = return $ BIJust 4 -bytesInType A.Int64 = return $ BIJust 8 -bytesInType A.Real32 = return $ BIJust 4 -bytesInType A.Real64 = return $ BIJust 8 +bytesInType A.Bool = justSizeBackends cBoolSize cxxBoolSize +bytesInType A.Byte = justSize 1 +bytesInType A.UInt16 = justSize 2 +bytesInType A.UInt32 = justSize 4 +bytesInType A.UInt64 = justSize 8 +bytesInType A.Int8 = justSize 1 +bytesInType A.Int = justSizeBackends cIntSize cxxIntSize +bytesInType A.Int16 = justSize 2 +bytesInType A.Int32 = justSize 4 +bytesInType A.Int64 = justSize 8 +bytesInType A.Real32 = justSize 4 +bytesInType A.Real64 = justSize 8 bytesInType a@(A.Array _ _) = bytesInArray 0 a where bytesInArray :: (CSMR m, Die m) => Int -> A.Type -> m BytesInResult @@ -561,8 +548,8 @@ bytesInType a@(A.Array _ _) = bytesInArray 0 a bytesInArray num (A.Array (d:ds) t) = do ts <- bytesInArray (num + 1) (A.Array ds t) case (d, ts) of - (A.Dimension n, BIJust m) -> return $ BIJust (n * m) - (A.Dimension n, BIOneFree m x) -> return $ BIOneFree (n * m) x + (A.Dimension n, BIJust m) -> return $ BIJust (mulExprs n m) + (A.Dimension n, BIOneFree m x) -> return $ BIOneFree (mulExprs n m) x (A.UnknownDimension, BIJust m) -> return $ BIOneFree m num (A.UnknownDimension, BIOneFree _ _) -> return BIManyFree (_, _) -> return ts @@ -575,12 +562,12 @@ bytesInType (A.Record n) _ -> return $ BIUnknown where bytesInList :: (CSMR m, Die m) => [(A.Name, A.Type)] -> m BytesInResult - bytesInList [] = return $ BIJust 0 + bytesInList [] = justSize 0 bytesInList ((_, t):rest) = do bi <- bytesInType t br <- bytesInList rest case (bi, br) of - (BIJust a, BIJust b) -> return $ BIJust (a + b) + (BIJust a, BIJust b) -> return $ BIJust (addExprs a b) (_, _) -> return BIUnknown bytesInType _ = return $ BIUnknown --}}} @@ -610,3 +597,17 @@ addOne :: A.Expression -> A.Expression addOne e = A.Dyadic m A.Plus (makeConstant m 1) e where m = findMeta e +-- | Add two expressions. +addExprs :: A.Expression -> A.Expression -> A.Expression +addExprs a b = A.Dyadic m A.Add a b + where m = findMeta a + +-- | Multiply two expressions. +mulExprs :: A.Expression -> A.Expression -> A.Expression +mulExprs a b = A.Dyadic m A.Mul a b + where m = findMeta a + +-- | Divide two expressions. +divExprs :: A.Expression -> A.Expression -> A.Expression +divExprs a b = A.Dyadic m A.Div a b + where m = findMeta a diff --git a/common/Utils.hs b/common/Utils.hs index 84bfba0..1fb2d4c 100644 --- a/common/Utils.hs +++ b/common/Utils.hs @@ -291,3 +291,8 @@ applyPairM f = seqPair . transformPair f f makeArraySize :: (IArray a e, Ix i, Enum i) => (i,i) -> e -> a i e -> a i e makeArraySize size def arr = array size [(i,arrayLookupWithDefault def arr i) | i <- [fst size .. snd size]] + +-- | Replace one item in a list by index. +-- This is like '(//)'. +replaceAt :: Int -> a -> [a] -> [a] +replaceAt n rep es = [if i == n then rep else e | (e, i) <- zip es [0..]] diff --git a/data/AST.hs b/data/AST.hs index f528609..872a392 100644 --- a/data/AST.hs +++ b/data/AST.hs @@ -138,9 +138,9 @@ data Type = -- | An array dimension. -- Depending on the context, an array type may have empty dimensions, which is --- why this isn't just an Int. +-- why this isn't just an Expression. data Dimension = - Dimension Int + Dimension Expression | UnknownDimension deriving (Show, Eq, Typeable, Data) diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index 5b30a08..582f9c3 100644 --- a/frontends/ParseOccam.hs +++ b/frontends/ParseOccam.hs @@ -353,46 +353,69 @@ intersperseP (f:fs) sep as <- intersperseP fs sep return $ a : as +-- | Are two types the same? +sameType :: A.Type -> A.Type -> OccParser Bool +sameType (A.Array (A.Dimension e1 : ds1) t1) + (A.Array (A.Dimension e2 : ds2) t2) + = do n1 <- evalIntExpression e1 + n2 <- evalIntExpression e2 + same <- sameType (A.Array ds1 t1) (A.Array ds2 t2) + return $ (n1 == n2) && same +sameType (A.Array (A.UnknownDimension : ds1) t1) + (A.Array (A.UnknownDimension : ds2) t2) + = sameType (A.Array ds1 t1) (A.Array ds2 t2) +sameType a b = return $ a == b + -- | Find the type of a table literal given the types of its components. -- This'll always return an Array; the inner type will either be the type of -- the elements if they're all the same (in which case it's either an array -- literal, or a record where all the fields are the same type), or Any if -- they're not (i.e. if it's a record literal or an empty array). tableType :: Meta -> [A.Type] -> OccParser A.Type -tableType m l = tableType' m (length l) l +tableType m l = tableType' m (makeConstant m $ length l) l where + tableType' :: Meta -> A.Expression -> [A.Type] -> OccParser A.Type tableType' m len [t] = return $ addDimensions [A.Dimension len] t tableType' m len (t1 : rest@(t2 : _)) - = if t1 == t2 then tableType' m len rest - else return $ addDimensions [A.Dimension len] A.Any - tableType' m len [] = return $ addDimensions [A.Dimension 0] A.Any + = do same <- sameType t1 t2 + if same + then tableType' m len rest + else return $ addDimensions [A.Dimension len] A.Any + tableType' m len [] = return $ addDimensions [A.Dimension zero] A.Any + + zero = makeConstant m 0 -- | Check that the second dimension can be used in a context where the first -- is expected. -isValidDimension :: A.Dimension -> A.Dimension -> Bool -isValidDimension A.UnknownDimension A.UnknownDimension = True -isValidDimension A.UnknownDimension (A.Dimension _) = True -isValidDimension (A.Dimension n1) (A.Dimension n2) = n1 == n2 -isValidDimension _ _ = False +isValidDimension :: A.Dimension -> A.Dimension -> OccParser Bool +isValidDimension A.UnknownDimension A.UnknownDimension = return True +isValidDimension A.UnknownDimension (A.Dimension _) = return True +isValidDimension (A.Dimension e1) (A.Dimension e2) + = do n1 <- evalIntExpression e1 + n2 <- evalIntExpression e2 + return $ n1 == n2 +isValidDimension _ _ = return False -- | Check that the second second of dimensions can be used in a context where -- the first is expected. -areValidDimensions :: [A.Dimension] -> [A.Dimension] -> Bool -areValidDimensions [] [] = True +areValidDimensions :: [A.Dimension] -> [A.Dimension] -> OccParser Bool +areValidDimensions [] [] = return True areValidDimensions (d1:ds1) (d2:ds2) - = if isValidDimension d1 d2 - then areValidDimensions ds1 ds2 - else False -areValidDimensions _ _ = False + = do valid <- isValidDimension d1 d2 + if valid + then areValidDimensions ds1 ds2 + else return False +areValidDimensions _ _ = return False -- | Check that a type we've inferred matches the type we expected. matchType :: Meta -> A.Type -> A.Type -> OccParser () matchType m et rt = case (et, rt) of ((A.Array ds t), (A.Array ds' t')) -> - if areValidDimensions ds ds' - then matchType m t t' - else bad + do valid <- areValidDimensions ds ds' + if valid + then matchType m t t' + else bad _ -> if rt == et then return () else bad where bad :: OccParser () @@ -574,8 +597,7 @@ newTagName = unscopedName A.TagName arrayType :: OccParser A.Type -> OccParser A.Type arrayType element = do (s, t) <- tryXVXV sLeft constIntExpr sRight element - sVal <- evalIntExpression s - return $ addDimensions [A.Dimension sVal] t + return $ addDimensions [A.Dimension s] t -- | Either a sized or unsized array of a production. specArrayType :: OccParser A.Type -> OccParser A.Type @@ -629,20 +651,22 @@ isValidLiteralType m rawT wantT (A.Real32, _) -> return $ isRealType underT (A.Int, _) -> return $ isIntegerType underT (A.Byte, _) -> return $ isIntegerType underT - (A.Array (A.Dimension nf:_) _, A.Record _) -> + (A.Array (A.Dimension e:_) _, A.Record _) -> -- We can't be sure without looking at the literal itself, -- so we need to do that below. do fs <- recordFields m wantT + nf <- evalIntExpression e return $ nf == length fs (A.Array (d1:ds1) t1, A.Array (d2:ds2) t2) -> -- Check the outermost dimension is OK, then recurse. -- We can't just look at all the dimensions because this -- might be an array of a record type, or similar. - if isValidDimension d2 d1 - then do rawT' <- trivialSubscriptType m rawT - underT' <- trivialSubscriptType m underT - isValidLiteralType m rawT' underT' - else return False + do valid <- isValidDimension d2 d1 + if valid + then do rawT' <- trivialSubscriptType m rawT + underT' <- trivialSubscriptType m underT + isValidLiteralType m rawT' underT' + else return False _ -> return $ rawT == wantT -- | Apply dimensions from one type to another as far as possible. @@ -822,7 +846,7 @@ stringLiteral cs <- stringCont <|> stringLit let aes = [A.ArrayElemExpr $ A.Literal m' A.Byte c | c@(A.ByteLiteral m' _) <- cs] - return (A.ArrayLiteral m aes, A.Dimension $ length cs) + return (A.ArrayLiteral m aes, makeDimension m $ length cs) "string literal" where stringCont :: OccParser [A.LiteralRepr] @@ -1412,6 +1436,8 @@ retypesReshapes :: OccParser () retypesReshapes = sRETYPES <|> sRESHAPES +-- FIXME: Retypes checking is currently disabled; it will be moved into a +-- separate pass. retypesAbbrev :: OccParser A.Specification retypesAbbrev = do m <- md @@ -1420,7 +1446,7 @@ retypesAbbrev sColon eol origT <- typeOfVariable v - checkRetypes m origT s + --checkRetypes m origT s return $ A.Specification m n $ A.Retypes m A.Abbrev s v <|> do m <- md (s, n) <- tryVVX channelSpecifier newChannelName retypesReshapes @@ -1428,7 +1454,7 @@ retypesAbbrev sColon eol origT <- typeOfVariable c - checkRetypes m origT s + --checkRetypes m origT s return $ A.Specification m n $ A.Retypes m A.Abbrev s c <|> do m <- md (s, n) <- tryXVVX sVAL dataSpecifier newVariableName retypesReshapes @@ -1436,10 +1462,11 @@ retypesAbbrev sColon eol origT <- typeOfExpression e - checkRetypes m origT s + --checkRetypes m origT s return $ A.Specification m n $ A.RetypesExpr m A.ValAbbrev s e "RETYPES/RESHAPES abbreviation" +{- -- | Check that a RETYPES\/RESHAPES is safe. checkRetypes :: Meta -> A.Type -> A.Type -> OccParser () -- Retyping channels is always "safe". @@ -1456,6 +1483,7 @@ checkRetypes m fromT toT dieP m "multiple free dimensions in RETYPES/RESHAPES type" -- Otherwise we have to do a runtime check. _ -> return () +-} dataSpecifier :: OccParser A.Type dataSpecifier diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index 608829e..1789474 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -34,6 +34,7 @@ import qualified LexRain as L import Metadata import ParseUtils import Pass +import Types @@ -174,7 +175,7 @@ stringLiteral = do (m,str) <- getToken testToken let processed = replaceEscapes str let aes = [A.ArrayElemExpr $ A.Literal m A.Byte $ A.ByteLiteral m [c] | c <- processed] - return (A.ArrayLiteral m aes, A.Dimension $ length processed) + return (A.ArrayLiteral m aes, makeDimension m $ length processed) "string literal" where testToken (L.TokStringLiteral str) = Just str diff --git a/transformations/PassTest.hs b/transformations/PassTest.hs index 470f595..6c5f668 100644 --- a/transformations/PassTest.hs +++ b/transformations/PassTest.hs @@ -33,6 +33,7 @@ import SimplifyExprs import TagAST import TestUtils import TreeUtils +import Types import Utils m :: Meta @@ -204,11 +205,11 @@ skipP = A.Only m (A.Skip m) testTransformConstr0 :: Test testTransformConstr0 = TestCase $ testPass "transformConstr0" exp (transformConstr orig) (return ()) where - orig = A.Spec m (A.Specification m (simpleName "arr") $ A.IsExpr m A.ValAbbrev (A.Array [A.Dimension 10] A.Int) $ A.ExprConstr m $ + orig = A.Spec m (A.Specification m (simpleName "arr") $ A.IsExpr m A.ValAbbrev (A.Array [dimension 10] A.Int) $ A.ExprConstr m $ A.RepConstr m (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) (exprVariable "x") ) skipP exp = nameAndStopCaringPattern "indexVar" "i" $ mkPattern exp' - exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [A.Dimension 10] A.Int))) $ + exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [dimension 10] A.Int))) $ A.ProcThen m (A.Seq m $ A.Spec m (A.Specification m (simpleName "i") (A.Declaration m A.Int)) $ A.Several m [A.Only m $ A.Assign m [variable "i"] $ A.ExpressionList m [intLiteral 0], diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs index ff90e13..eb34b30 100644 --- a/transformations/SimplifyExprs.hs +++ b/transformations/SimplifyExprs.hs @@ -26,6 +26,7 @@ import qualified Data.Map as Map import qualified AST as A import CompState import Errors +import EvalLiterals import Metadata import Pass import qualified Properties as Prop @@ -137,7 +138,13 @@ expandArrayLiterals = doGeneric `extM` doArrayElem expand (A.UnknownDimension:_) e = dieP (findMeta e) "array literal containing non-literal array of unknown size" expand (A.Dimension n:ds) e - = liftM A.ArrayElemArray $ sequence [expand ds (A.SubscriptedExpr m (A.Subscript m A.NoCheck $ makeConstant m i) e) | i <- [0 .. (n - 1)]] + = do -- Because it's an array literal, we must know the size. + size <- evalIntExpression n + elems <- sequence [expand ds (A.SubscriptedExpr m + (A.Subscript m A.NoCheck $ + makeConstant m i) e) + | i <- [0 .. size - 1]] + return $ A.ArrayElemArray elems where m = findMeta e -- | We pull up the loop (Rep) counts into a temporary expression, whenever the loop