Changed the type of genArraySizesLiteral, added tests for the C++ version and implemented the C++ version

This commit is contained in:
Neil Brown 2007-10-06 12:31:14 +00:00
parent 8ea4ad79e8
commit e7cdaf2e90
3 changed files with 27 additions and 11 deletions

View File

@ -77,8 +77,8 @@ data GenOps = GenOps {
genArrayLiteralElems :: GenOps -> [A.ArrayElem] -> CGen (), genArrayLiteralElems :: GenOps -> [A.ArrayElem] -> CGen (),
-- | Declares a constant array for the sizes (dimensions) of a C array. -- | Declares a constant array for the sizes (dimensions) of a C array.
genArraySize :: GenOps -> Bool -> CGen () -> A.Name -> CGen (), genArraySize :: GenOps -> Bool -> CGen () -> A.Name -> CGen (),
-- | Writes out the dimensions of an array, separated by commas. Fails if there is an 'A.UnknownDimension' present. -- | Writes out the dimensions of an array, that can be used to initialise the sizes of an array. Fails if there is an 'A.UnknownDimension' present.
genArraySizesLiteral :: GenOps -> [A.Dimension] -> CGen (), genArraySizesLiteral :: GenOps -> A.Name -> A.Type -> CGen (),
-- | Writes out the size of the _sizes array, in square brackets. -- | Writes out the size of the _sizes array, in square brackets.
genArraySizesSize :: GenOps -> [A.Dimension] -> CGen (), genArraySizesSize :: GenOps -> [A.Dimension] -> CGen (),
-- | Writes out the actual data storage array name. -- | Writes out the actual data storage array name.
@ -581,7 +581,7 @@ cgenUnfoldedExpression ops (A.Literal _ t lr)
case t of case t of
A.Array ds _ -> A.Array ds _ ->
do genComma do genComma
call genArraySizesLiteral ops ds call genArraySizesLiteral ops undefined t --TODO work this out for C++
_ -> return () _ -> return ()
cgenUnfoldedExpression ops (A.ExprVariable m var) = call genUnfoldedVariable ops m var cgenUnfoldedExpression ops (A.ExprVariable m var) = call genUnfoldedVariable ops m var
cgenUnfoldedExpression ops e = call genExpression ops e cgenUnfoldedExpression ops e = call genExpression ops e
@ -596,7 +596,7 @@ cgenUnfoldedVariable ops m var
unfoldArray ds var unfoldArray ds var
genRightB genRightB
genComma genComma
call genArraySizesLiteral ops ds call genArraySizesLiteral ops undefined t --TODO work this out for C++
A.Record _ -> A.Record _ ->
do genLeftB do genLeftB
fs <- recordFields m t fs <- recordFields m t
@ -1225,13 +1225,13 @@ cgenArraySizesSize ops ds
-- | Declare an _sizes array for a variable. -- | Declare an _sizes array for a variable.
cdeclareArraySizes :: GenOps -> A.Type -> A.Name -> CGen () cdeclareArraySizes :: GenOps -> A.Type -> A.Name -> CGen ()
cdeclareArraySizes ops (A.Array ds _) name cdeclareArraySizes ops t name
= call genArraySize ops False (call genArraySizesLiteral ops ds) name = call genArraySize ops False (call genArraySizesLiteral ops name t) name
-- | Generate a C literal to initialise an _sizes array with, where all the -- | Generate a C literal to initialise an _sizes array with, where all the
-- dimensions are fixed. -- dimensions are fixed.
cgenArraySizesLiteral :: GenOps -> [A.Dimension] -> CGen () cgenArraySizesLiteral :: GenOps -> A.Name -> A.Type -> CGen ()
cgenArraySizesLiteral ops ds cgenArraySizesLiteral ops _ (A.Array ds _)
= genLeftB >> seqComma dims >> genRightB = genLeftB >> seqComma dims >> genRightB
where where
dims :: [CGen ()] dims :: [CGen ()]

View File

@ -98,6 +98,7 @@ cppgenOps = cgenOps {
genActual = cppgenActual, genActual = cppgenActual,
genActuals = cppgenActuals, genActuals = cppgenActuals,
genAlt = cppgenAlt, genAlt = cppgenAlt,
genArraySizesLiteral = cppgenArraySizesLiteral,
genArrayStoreName = cppgenArrayStoreName, genArrayStoreName = cppgenArrayStoreName,
genArraySubscript = cppgenArraySubscript, genArraySubscript = cppgenArraySubscript,
genDeclType = cppgenDeclType, genDeclType = cppgenDeclType,
@ -684,6 +685,21 @@ cppdeclareArraySizes ops arrType@(A.Array ds _) n = do
genDims ds genDims ds
tell ["));"] tell ["));"]
cppgenArraySizesLiteral :: GenOps -> A.Name -> A.Type -> CGen ()
cppgenArraySizesLiteral ops n t@(A.Array ds _) =
do call genType ops t
tell ["("]
genName n
tell ["_actual,tockDims("]
seqComma dims
tell ["))"]
where
dims :: [CGen ()]
dims = [case d of
A.Dimension n -> tell [show n]
_ -> die "unknown dimension in array type"
| d <- ds]
-- | Changed because we don't need any initialisation in C++ -- | Changed because we don't need any initialisation in C++
cppdeclareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()) cppdeclareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ())
cppdeclareInit ops m t@(A.Array ds t') var cppdeclareInit ops m t@(A.Array ds t') var

View File

@ -253,9 +253,9 @@ testStop =
testArraySizes :: Test testArraySizes :: Test
testArraySizes = TestList testArraySizes = TestList
[ [
testBothSame "genArraySizesLiteral 0" "{3}" (tcall genArraySizesLiteral [A.Dimension 3]) testBoth "genArraySizesLiteral 0" "{3}" "tockArrayView<int,1>(foo_actual,tockDims(3))" (tcall2 genArraySizesLiteral foo $ A.Array [A.Dimension 3] A.Int)
,testBothSame "genArraySizesLiteral 1" "{3,6,8}" (tcall genArraySizesLiteral [A.Dimension 3, A.Dimension 6, A.Dimension 8]) ,testBoth "genArraySizesLiteral 1" "{3,6,8}" "tockArrayView<int,3>(foo_actual,tockDims(3,6,8))" (tcall2 genArraySizesLiteral foo $ A.Array [A.Dimension 3, A.Dimension 6, A.Dimension 8] A.Int)
,testBothFail "genArraySizesLiteral 2" (tcall genArraySizesLiteral [A.Dimension 6, A.UnknownDimension]) ,testBothFail "genArraySizesLiteral 2" (tcall2 genArraySizesLiteral foo $ A.Array [A.Dimension 6, A.UnknownDimension] A.Int)
,testBothSame "genArraySizesSize 0" "[1]" (tcall genArraySizesSize [A.Dimension 7]) ,testBothSame "genArraySizesSize 0" "[1]" (tcall genArraySizesSize [A.Dimension 7])
,testBothSame "genArraySize 0" "const int*foo_sizes=@;" (tcall3 genArraySize True at foo) ,testBothSame "genArraySize 0" "const int*foo_sizes=@;" (tcall3 genArraySize True at foo)
,testBothSame "genArraySize 1" "const int foo_sizes[]=@;" (tcall3 genArraySize False at foo) ,testBothSame "genArraySize 1" "const int foo_sizes[]=@;" (tcall3 genArraySize False at foo)