Changed the type of genSlice, and put the C++ version into the GenOps dictionary, as well as adding tests for the function

This commit is contained in:
Neil Brown 2007-10-13 13:20:40 +00:00
parent 886659fd09
commit d5d4580aa3
3 changed files with 71 additions and 27 deletions

View File

@ -143,7 +143,7 @@ data GenOps = GenOps {
genSimpleDyadic :: GenOps -> String -> A.Expression -> A.Expression -> CGen (),
genSimpleMonadic :: GenOps -> String -> A.Expression -> CGen (),
genSizeSuffix :: GenOps -> String -> CGen (),
genSlice :: GenOps -> A.Variable -> A.Variable -> A.Expression -> A.Expression -> [A.Dimension] -> (CGen (), A.Name -> CGen ()),
genSlice :: GenOps -> A.Variable -> A.Expression -> A.Expression -> [A.Dimension] -> (CGen (), A.Name -> CGen ()),
genSpec :: GenOps -> A.Specification -> CGen () -> CGen (),
genSpecMode :: GenOps -> A.SpecMode -> CGen (),
-- | Generates a STOP process that uses the given Meta tag and message as its printed message.
@ -1052,23 +1052,23 @@ cgenReplicatorLoop ops (A.For m index base count)
--{{{ abbreviations
-- FIXME: This code is horrible, and I can't easily convince myself that it's correct.
cgenSlice :: GenOps -> A.Variable -> A.Variable -> A.Expression -> A.Expression -> [A.Dimension] -> (CGen (), A.Name -> CGen ())
cgenSlice ops v (A.Variable _ on) start count ds
cgenSlice :: GenOps -> A.Variable -> A.Expression -> A.Expression -> [A.Dimension] -> (CGen (), A.Name -> CGen ())
cgenSlice ops v@(A.SubscriptedVariable _ _ (A.Variable _ on)) start count ds
-- We need to disable the index check here because we might be taking
-- element 0 of a 0-length array -- which is valid.
= (tell ["&"] >> call genVariableUnchecked ops v,
call genArraySize ops False
(do genLeftB
tell ["occam_check_slice ("]
tell ["occam_check_slice("]
call genExpression ops start
tell [", "]
tell [","]
call genExpression ops count
tell [", "]
tell [","]
genName on
tell ["_sizes[0], "]
tell ["_sizes[0],"]
genMeta (findMeta count)
tell [")"]
sequence_ [do tell [", "]
sequence_ [do tell [","]
genName on
tell ["_sizes[", show i, "]"]
| i <- [1..(length ds - 1)]]
@ -1111,12 +1111,12 @@ abbrevVariable ops am (A.Array _ _) v@(A.SubscriptedVariable _ (A.Subscript _ _)
genAASize (A.DirectedVariable _ _ v) arg
= const $ call genMissing ops "Cannot abbreviate a directed variable as an array"
abbrevVariable ops am (A.Array ds _) v@(A.SubscriptedVariable _ (A.SubscriptFromFor _ start count) v')
= call genSlice ops v v' start count ds
abbrevVariable ops am (A.Array ds _) v@(A.SubscriptedVariable _ (A.SubscriptFromFor _ start count) _)
= call genSlice ops v start count ds
abbrevVariable ops am (A.Array ds _) v@(A.SubscriptedVariable m (A.SubscriptFrom _ start) v')
= call genSlice ops v v' start (A.Dyadic m A.Minus (A.SizeExpr m (A.ExprVariable m v')) start) ds
abbrevVariable ops am (A.Array ds _) v@(A.SubscriptedVariable m (A.SubscriptFor _ count) v')
= call genSlice ops v v' (makeConstant m 0) count ds
= call genSlice ops v start (A.Dyadic m A.Minus (A.SizeExpr m (A.ExprVariable m v')) start) ds
abbrevVariable ops am (A.Array ds _) v@(A.SubscriptedVariable m (A.SubscriptFor _ count) _)
= call genSlice ops v (makeConstant m 0) count ds
abbrevVariable ops am (A.Array _ _) v
= (call genVariable ops v, call genArraySize ops True (call genVariable ops v >> tell ["_sizes"]))
abbrevVariable ops am (A.Chan {}) v

View File

@ -114,6 +114,7 @@ cppgenOps = cgenOps {
genPar = cppgenPar,
genProcCall = cppgenProcCall,
genSizeSuffix = cppgenSizeSuffix,
genSlice = cppgenSlice,
genStop = cppgenStop,
genTimerRead = cppgenTimerRead,
genTimerWait = cppgenTimerWait,
@ -1119,12 +1120,12 @@ prefixUnderscore n = n { A.nameName = "_" ++ A.nameName n }
cppabbrevVariable :: GenOps -> A.AbbrevMode -> A.Type -> A.Variable -> CGen ()
cppabbrevVariable ops am (A.Array _ _) v@(A.SubscriptedVariable _ (A.Subscript _ _) _)
= call genVariable ops v
cppabbrevVariable ops am ty@(A.Array ds _) v@(A.SubscriptedVariable _ (A.SubscriptFromFor _ start count) v')
= cppgenSlice ops v v' ty start count ds
cppabbrevVariable ops am ty@(A.Array ds _) v@(A.SubscriptedVariable _ (A.SubscriptFromFor _ start count) _)
= fst (cppgenSlice ops v start count ds)
cppabbrevVariable ops am ty@(A.Array ds _) v@(A.SubscriptedVariable m (A.SubscriptFrom _ start) v')
= cppgenSlice ops v v' ty start (A.Dyadic m A.Minus (A.SizeExpr m (A.ExprVariable m v')) start) ds
cppabbrevVariable ops am ty@(A.Array ds _) v@(A.SubscriptedVariable m (A.SubscriptFor _ count) v')
= cppgenSlice ops v v' ty (makeConstant m 0) count ds
= fst (cppgenSlice ops v start (A.Dyadic m A.Minus (A.SizeExpr m (A.ExprVariable m v')) start) ds)
cppabbrevVariable ops am ty@(A.Array ds _) v@(A.SubscriptedVariable m (A.SubscriptFor _ count) _)
= fst (cppgenSlice ops v (makeConstant m 0) count ds)
cppabbrevVariable ops am (A.Array _ _) v
= call genVariable ops v
cppabbrevVariable ops am (A.Chan {}) v
@ -1137,16 +1138,27 @@ cppabbrevVariable ops am t v
-- | Use C++ array slices:
--TODO put index checking back:
cppgenSlice :: GenOps -> A.Variable -> A.Variable -> A.Type -> A.Expression -> A.Expression -> [A.Dimension] -> CGen ()
cppgenSlice ops _ v ty start count ds
cppgenSlice :: GenOps -> A.Variable -> A.Expression -> A.Expression -> [A.Dimension] -> (CGen (), A.Name -> CGen ())
cppgenSlice ops (A.SubscriptedVariable _ _ v) start count ds
-- We need to disable the index check here because we might be taking
-- element 0 of a 0-length array -- which is valid.
= do call genVariableUnchecked ops v
tell [".sliceFromFor("]
call genExpression ops start
tell [" , "]
= (do call genVariableUnchecked ops v
tell [".sliceFromFor("]
genStart
tell [",occam_check_slice("]
genStart
tell [","]
call genExpression ops count
tell [")"]
tell [","]
call genVariableUnchecked ops v
call genSizeSuffix ops "0"
tell [","]
genMeta (findMeta count)
tell ["))"]
, const (return ())
)
where
genStart = call genExpression ops start
-- | Changed from GenerateC to use multiple subscripting (e.g. [1][2][3]) rather than the combined indexing of the C method (e.g. [1*x*y+2*y+3])
cppgenArraySubscript :: GenOps -> Bool -> A.Variable -> [A.Expression] -> CGen ()

View File

@ -186,6 +186,9 @@ tcall2 f x y = (\o -> f o o x y)
tcall3 :: (GenOps -> GenOps -> a0 -> a1 -> a2 -> b) -> a0 -> a1 -> a2 -> (GenOps -> b)
tcall3 f x y z = (\o -> f o o x y z)
tcall4 :: (GenOps -> GenOps -> a0 -> a1 -> a2 -> a3 -> b) -> a0 -> a1 -> a2 -> a3 -> (GenOps -> b)
tcall4 f a b c d = (\o -> f o o a b c d)
-- | Overrides a specified function in GenOps to return the given value
override1 ::
b -- ^ The value to return for the overridden function
@ -321,6 +324,36 @@ testArraySubscript = TestList
stateTrans = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [A.Dimension 7,A.Dimension 8,A.Dimension 8] A.Int)
m = "\"" ++ show emptyMeta ++ "\""
testArraySlice :: Test
testArraySlice = TestList
[
-- Slice from a one-dimensional array:
testSlice 0 ("&arr[4]","const int foo_sizes[]={" ++ checkSlice "4" "5" "arr_sizes[0]" ++ "};")
("arr.sliceFromFor(4," ++ checkSlice "4" "5" "arr.extent(0)" ++ ")") "arr" 4 5 [A.Dimension 12]
-- Slice from a two-dimensional array:
,testSlice 1 ("&arr[4*arr_sizes[1]]","const int foo_sizes[]={" ++ checkSlice "4" "5" "arr_sizes[0]" ++ ",arr_sizes[1]};")
("arr.sliceFromFor(4," ++ checkSlice "4" "5" "arr.extent(0)" ++ ")") "arr" 4 5 [A.Dimension 12,A.Dimension 12]
-- Slice from a three-dimensional array:
,testSlice 2 ("&arr[4*arr_sizes[1]*arr_sizes[2]]","const int foo_sizes[]={" ++ checkSlice "4" "5" "arr_sizes[0]" ++ ",arr_sizes[1],arr_sizes[2]};")
("arr.sliceFromFor(4," ++ checkSlice "4" "5" "arr.extent(0)" ++ ")") "arr" 4 5 [A.Dimension 12,A.Dimension 12,A.Dimension 12]
]
where
testSlice :: Int -> (String,String) -> String -> String -> Integer -> Integer -> [A.Dimension] -> Test
testSlice index eC eCPP nm start count ds
= testBothS ("genSlice " ++ show index) (smerge eC) (smerge (eCPP,""))
(merge . tcall4 genSlice
(A.SubscriptedVariable undefined (A.SubscriptFromFor undefined (intLiteral start) (intLiteral count)) (variable nm))
(intLiteral start) (intLiteral count) ds)
(defineName (simpleName nm) $ simpleDefDecl nm (A.Array ds A.Int))
merge (arr,sizes) = arr >> tell ["|"] >> sizes (simpleName "foo")
smerge (arr,sizes) = arr ++ "|" ++ sizes
m = "\"" ++ show emptyMeta ++ "\""
checkSlice s e sub = "occam_check_slice(" ++ s ++ "," ++ e ++ "," ++ sub ++ "," ++ m ++ ")"
testOverArray :: Test
testOverArray = TestList $ map testOverArray'
[(cSize,cIndex,"",cgenOps)
@ -951,14 +984,13 @@ testBytesIn = TestList
where
over ops = ops {genVariable = override1 dollar, genSizeSuffix = (\_ n -> tell["(@",n,")"])}
--TODO test array slicing.
---Returns the list of tests:
tests :: Test
tests = TestList
[
testActuals
,testArraySizes
,testArraySlice
,testArraySubscript
,testAssign
,testBytesIn