From 7f59eec18959b0c171dafebc8cee090eb0069fa5 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 25 Oct 2007 00:27:12 +0000 Subject: [PATCH] Changed the C and C++ backends (and tests) to handle declarations with initialisers properly --- backends/GenerateC.hs | 24 +++++++++++++----------- backends/GenerateCPPCSP.hs | 16 +++++++++------- backends/GenerateCTest.hs | 26 ++++++++++++++++++-------- common/TestUtil.hs | 4 ++++ 4 files changed, 44 insertions(+), 26 deletions(-) diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 15139cd..0400ecd 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -67,7 +67,7 @@ data GenOps = GenOps { -- | Generates code when a variable goes out of scope (e.g. deallocating memory). declareFree :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()), -- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables). - declareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()), + declareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe A.Expression -> Maybe (CGen ()), -- | Generates an individual parameter to a function\/proc. genActual :: GenOps -> A.Actual -> CGen (), -- | Generates the list of actual parameters to a function\/proc. @@ -1276,12 +1276,12 @@ cgenArraySizesLiteral ops _ (A.Array ds _) | d <- ds] -- | Initialise an item being declared. -cdeclareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()) -cdeclareInit ops _ (A.Chan A.DirUnknown _ _) var +cdeclareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe A.Expression -> Maybe (CGen ()) +cdeclareInit ops _ (A.Chan A.DirUnknown _ _) var _ = Just $ do tell ["ChanInit("] call genVariableUnchecked ops var tell [");"] -cdeclareInit ops m t@(A.Array ds t') var +cdeclareInit ops m t@(A.Array ds t') var _ = Just $ do case t' of A.Chan A.DirUnknown _ _ -> do tell ["tock_init_chan_array("] @@ -1292,9 +1292,9 @@ cdeclareInit ops m t@(A.Array ds t') var sequence_ $ intersperse (tell ["*"]) [case dim of A.Dimension d -> tell [show d] | dim <- ds] tell [");"] _ -> return () - init <- return (\sub -> call declareInit ops m t' (sub var)) + init <- return (\sub -> call declareInit ops m t' (sub var) Nothing) call genOverArray ops m var init -cdeclareInit ops m rt@(A.Record _) var +cdeclareInit ops m rt@(A.Record _) var _ = Just $ do fs <- recordFields m rt sequence_ [initField t (A.SubscriptedVariable m (A.SubscriptField m n) var) | (n, t) <- fs] @@ -1306,9 +1306,11 @@ cdeclareInit ops m rt@(A.Record _) var call genSizeSuffix ops (show i) tell ["=", show n, ";"] | (i, A.Dimension n) <- zip [0..(length ds - 1)] ds] - doMaybe $ call declareInit ops m t v - initField t v = doMaybe $ call declareInit ops m t v -cdeclareInit _ _ _ _ = Nothing + doMaybe $ call declareInit ops m t v Nothing + initField t v = doMaybe $ call declareInit ops m t v Nothing +cdeclareInit ops m _ v (Just e) + = Just $ call genAssign ops m [v] $ A.ExpressionList m [e] +cdeclareInit _ _ _ _ _ = Nothing -- | Free a declared item that's going out of scope. cdeclareFree :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()) @@ -1330,9 +1332,9 @@ CHAN OF INT c IS d: Channel *c = d; const int *ds_sizes = cs_sizes; -} cintroduceSpec :: GenOps -> A.Specification -> CGen () -cintroduceSpec ops (A.Specification m n (A.Declaration _ t _)) +cintroduceSpec ops (A.Specification m n (A.Declaration _ t init)) = do call genDeclaration ops t n False - case call declareInit ops m t (A.Variable m n) of + case call declareInit ops m t (A.Variable m n) init of Just p -> p Nothing -> return () cintroduceSpec ops (A.Specification _ n (A.Is _ am t v)) diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 179e838..54356e2 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -582,9 +582,9 @@ cppgenArraySizesLiteral ops n t@(A.Array ds _) = | d <- ds] -- | Changed because we initialise channels and arrays differently in C++ -cppdeclareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()) -cppdeclareInit ops m t@(A.Array ds t') var - = Just $ do init <- return (\sub -> call declareInit ops m t' (sub var)) +cppdeclareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe A.Expression -> Maybe (CGen ()) +cppdeclareInit ops m t@(A.Array ds t') var _ + = Just $ do init <- return (\sub -> call declareInit ops m t' (sub var) Nothing) call genOverArray ops m var init case t' of A.Chan A.DirUnknown _ _ -> @@ -596,7 +596,7 @@ cppdeclareInit ops m t@(A.Array ds t') var sequence_ $ intersperse (tell ["*"]) [case dim of A.Dimension d -> tell [show d] | dim <- ds] tell [");"] _ -> return () -cppdeclareInit ops m rt@(A.Record _) var +cppdeclareInit ops m rt@(A.Record _) var _ = Just $ do fs <- recordFields m rt sequence_ [initField t (A.SubscriptedVariable m (A.SubscriptField m n) var) | (n, t) <- fs] @@ -610,9 +610,11 @@ cppdeclareInit ops m rt@(A.Record _) var tell ["_actual,tockDims("] infixComma [tell [show n] | (A.Dimension n) <- ds] tell ["));"] - doMaybe $ call declareInit ops m t v - initField t v = doMaybe $ call declareInit ops m t v -cppdeclareInit _ _ _ _ = Nothing + doMaybe $ call declareInit ops m t v Nothing + initField t v = doMaybe $ call declareInit ops m t v Nothing +cppdeclareInit ops m _ v (Just e) + = Just $ call genAssign ops m [v] $ A.ExpressionList m [e] +cppdeclareInit _ _ _ _ _ = Nothing -- | Changed because we don't need any de-initialisation in C++, regardless of whether C does. cppdeclareFree :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()) diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index 61a4439..7e0770e 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -180,6 +180,9 @@ override2 val = (\_ _ _ -> val) override3 :: b -> (GenOps -> a0 -> a1 -> a2 -> b) override3 val = (\_ _ _ _ -> val) +override4 :: b -> (GenOps -> a0 -> a1 -> a2 -> a3 -> b) +override4 val = (\_ _ _ _ _ -> val) + override5 :: b -> (GenOps -> a0 -> a1 -> a2 -> a3 -> a4 -> b) override5 val = (\_ _ _ _ _ _ -> val) @@ -449,6 +452,7 @@ testDeclareInitFree = TestList [ -- Plain type: testAllSame 0 ("","") A.Int + ,testAllSameInit 10 ("foo=3;","") A.Int (intLiteral 3) -- Channel types: ,testAll 1 ("ChanInit((&foo));","") ("","") $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int @@ -484,19 +488,22 @@ testDeclareInitFree = TestList ] where testAll :: Int -> (String,String) -> (String,String) -> A.Type -> Test - testAll n eC eCPP t = testAll' n eC eCPP t (defineName (simpleName "foo") $ simpleDefDecl "foo" t) + testAll n eC eCPP t = testAll' n eC eCPP t (defineName (simpleName "foo") $ simpleDefDecl "foo" t) Nothing + + testAllInit :: Int -> (String,String) -> (String,String) -> A.Type -> Maybe A.Expression -> Test + testAllInit n eC eCPP t init = testAll' n eC eCPP t (defineName (simpleName "foo") $ simpleDefDeclInit "foo" t init) init testAllR :: Int -> (String,String) -> (String,String) -> A.Type -> (A.Type -> A.Type) -> Test - testAllR n eC eCPP t f = testAll' n eC eCPP (f $ A.Record $ simpleName "REC") $ (defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Record (simpleName "REC")) + testAllR n eC eCPP t f = testAll' n eC eCPP (f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Record (simpleName "REC"))) Nothing testAllRA :: Int -> (String,String) -> (String,String) -> A.Type -> (A.Type -> A.Type) -> Test - testAllRA n eC eCPP t f = testAll' n eC eCPP (A.Array [A.Dimension 5] $ f $ A.Record $ simpleName "REC") $ (defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Array [A.Dimension 5] $ A.Record (simpleName "REC")) + testAllRA n eC eCPP t f = testAll' n eC eCPP (A.Array [A.Dimension 5] $ f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Array [A.Dimension 5] $ A.Record (simpleName "REC"))) Nothing - testAll' :: Int -> (String,String) -> (String,String) -> A.Type -> State CompState () -> Test - testAll' n (iC,fC) (iCPP,fCPP) t state = TestList + testAll' :: Int -> (String,String) -> (String,String) -> A.Type -> State CompState () -> Maybe A.Expression -> Test + testAll' n (iC,fC) (iCPP,fCPP) t state init = TestList [ - testBothS ("testDeclareInitFree/a" ++ show n) ("@" ++ iC) ("@" ++ iCPP) ((tcall introduceSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t Nothing)) . over) state - ,testBothS ("testDeclareInitFree/b" ++ show n) iC iCPP ((fromMaybe (return ())) . (tcall3 declareInit emptyMeta t (A.Variable emptyMeta foo)) . over) state + testBothS ("testDeclareInitFree/a" ++ show n) ("@" ++ iC) ("@" ++ iCPP) ((tcall introduceSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t init)) . over) state + ,testBothS ("testDeclareInitFree/b" ++ show n) iC iCPP ((fromMaybe (return ())) . (tcall4 declareInit emptyMeta t (A.Variable emptyMeta foo) init) . over) state ,testBothS ("testDeclareInitFree/c" ++ show n) fC fCPP ((tcall removeSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t Nothing)) . over) state ,testBothS ("testDeclareInitFree/d" ++ show n) fC fCPP ((fromMaybe (return ())) . (tcall3 declareFree emptyMeta t (A.Variable emptyMeta foo)) . over) state ] @@ -509,6 +516,9 @@ testDeclareInitFree = TestList testAllSame :: Int -> (String,String) -> A.Type -> Test testAllSame n e t = testAll n e e t + testAllSameInit :: Int -> (String,String) -> A.Type -> A.Expression -> Test + testAllSameInit n e t init = testAllInit n e e t (Just init) + testSpec :: Test testSpec = TestList [ @@ -631,7 +641,7 @@ testSpec = TestList testAllSame n e s = testAll n e e s testAllSameS n e s st o = testAllS n e e s st o over ops = ops {genDeclaration = override2 (tell . (\x -> ["#ATION_",show x])) - ,declareInit = (override3 (Just $ tell ["#INIT"])), declareFree = override3 (Just $ tell ["#FREE"]) + ,declareInit = (override4 (Just $ tell ["#INIT"])), declareFree = override3 (Just $ tell ["#FREE"]) ,genType = (\_ x -> tell ["$(",show x,")"]) ,genVariable = override1 at } diff --git a/common/TestUtil.hs b/common/TestUtil.hs index 0373ca2..3caca07 100644 --- a/common/TestUtil.hs +++ b/common/TestUtil.hs @@ -380,6 +380,10 @@ simpleDef n sp = A.NameDef {A.ndMeta = m, A.ndName = n, A.ndOrigName = n, A.ndNa simpleDefDecl :: String -> A.Type -> A.NameDef simpleDefDecl n t = simpleDef n (A.Declaration m t Nothing) +-- | A simple definition of a declared variable +simpleDefDeclInit :: String -> A.Type -> Maybe A.Expression -> A.NameDef +simpleDefDeclInit n t init = simpleDef n (A.Declaration m t init) + -- | A pattern that will match simpleDef, with a different abbreviation mode simpleDefPattern :: String -> A.AbbrevMode -> Pattern -> Pattern simpleDefPattern n am sp = tag7 A.NameDef DontCare n n A.VariableName sp am A.Unplaced