diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index b8e4cb6..56c8cfd 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -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 diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 47859ee..d6644f3 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -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 () diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index 5ee344c..238cce4 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -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