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

View File

@ -98,6 +98,7 @@ cppgenOps = cgenOps {
genActual = cppgenActual,
genActuals = cppgenActuals,
genAlt = cppgenAlt,
genArraySizesLiteral = cppgenArraySizesLiteral,
genArrayStoreName = cppgenArrayStoreName,
genArraySubscript = cppgenArraySubscript,
genDeclType = cppgenDeclType,
@ -684,6 +685,21 @@ cppdeclareArraySizes ops arrType@(A.Array ds _) n = do
genDims ds
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++
cppdeclareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ())
cppdeclareInit ops m t@(A.Array ds t') var

View File

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