Changed the C and C++ backends (and tests) to handle declarations with initialisers properly
This commit is contained in:
Neil Brown
parent
6b95827cab
commit
7f59eec189
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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 ())
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user