Changed the type of genArraySizesLiteral, added tests for the C++ version and implemented the C++ version
This commit is contained in:
parent
8ea4ad79e8
commit
e7cdaf2e90
|
@ -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 ()]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user