suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changed the generation of the record structs to use the altered genDeclaration (that can now generate declarations for inside records)

Browse Source
This commit is contained in:
Neil Brown 2007-10-05 20:06:11 +00:00
parent 904d1e8f5f
commit 9d5164d9c1
3 changed files with 18 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
backends/GenerateC.hs
View File

@ -1333,26 +1333,12 @@ cintroduceSpec ops (A.Specification _ n (A.IsChannelArray _ t cs))
call declareArraySizes ops [A.Dimension $ length cs] n
cintroduceSpec _ (A.Specification _ _ (A.DataType _ _)) = return ()
cintroduceSpec ops (A.Specification _ n (A.RecordType _ b fs))
= do tell ["typedef struct {\n"]
sequence_ [case t of
-- Arrays need the corresponding _sizes array.
A.Array ds t' ->
do call genType ops t'
tell [" "]
genName n
call genFlatArraySize ops ds
tell [";\n"]
tell ["int "]
genName n
tell ["_sizes"]
call genArraySizesSize ops ds
tell [";"]
_ -> call genDeclaration ops t n True
| (n, t) <- fs]
tell ["} "]
when b $ tell ["occam_struct_packed "]
= do tell ["typedef struct{"]
sequence_ [call genDeclaration ops t n True | (n, t) <- fs]
tell ["}"]
when b $ tell [" occam_struct_packed "]
genName n
tell [";\n"]
tell [";"]
cintroduceSpec _ (A.Specification _ n (A.Protocol _ _)) = return ()
cintroduceSpec ops (A.Specification _ n (A.ProtocolCase _ ts))
= do tell ["typedef enum {\n"]

6
backends/GenerateCPPCSP.hs
View File

@ -938,10 +938,10 @@ cppintroduceSpec ops (A.Specification _ n (A.RecordType _ b fs))
= do tell ["typedef struct{"]
sequence_ [call genDeclaration ops t n True
| (n, t) <- fs]
tell ["} "]
when b $ tell ["occam_struct_packed "]
tell ["}"]
when b $ tell [" occam_struct_packed "]
genName n
tell [";\n"]
tell [";"]
--We do sequential protocols by introducing a new tuple:
cppintroduceSpec ops (A.Specification _ n (A.Protocol _ typeList))
= do createChainedType "boost::tuple" (genProtocolName n) $ map (call genType ops) typeList

16
backends/GenerateCTest.hs
View File

@ -461,21 +461,25 @@ testSpec :: Test
testSpec = TestList
[
--Declaration:
testAllSame 0 ("#ATION#INIT","#FREE") $ A.Declaration emptyMeta A.Int
,testAllSame 1 ("#ATION#INIT","#FREE") $ A.Declaration emptyMeta $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllSame 2 ("#ATION#INIT","#FREE") $ A.Declaration emptyMeta $ A.Array [A.Dimension 3] A.Int
,testAllSame 3 ("#ATION#INIT","#FREE") $ A.Declaration emptyMeta $ A.Array [A.Dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
testAllSame 0 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta A.Int
,testAllSame 1 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllSame 2 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta $ A.Array [A.Dimension 3] A.Int
,testAllSame 3 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta $ A.Array [A.Dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
--Empty/failure cases:
,testAllSame 100 ("","") $ A.DataType undefined undefined
,testBothFail "testAllSame 200" (tcall introduceSpec $ A.Specification emptyMeta foo $ A.RetypesExpr emptyMeta A.Original A.Int (A.True emptyMeta))
,testBothFail "testAllSame 300" (tcall introduceSpec $ A.Specification emptyMeta foo $ A.Place emptyMeta (A.True emptyMeta))
--Record types:
,testAllSame 400 ("typedef struct{#ATION_True}foo;","") $ A.RecordType emptyMeta False [(bar,A.Int)]
,testAllSame 401 ("typedef struct{#ATION_True#ATION_True} occam_struct_packed foo;","") $ A.RecordType emptyMeta True [(bar,A.Int),(bar,A.Int)]
,testAll 402 ("typedef struct{#ATION_True}foo;","") ("typedef struct{#ATION_True}foo;","")$ A.RecordType emptyMeta False [(bar,A.Array [A.Dimension 6, A.Dimension 7] A.Int)]
--TODO Is
--TODO IsExpr
--TODO IsChannelArray
--TODO Protocol
--TODO RecordType
--TODO ProtocolCase
--TODO Proc
--TODO Retypes
@ -488,7 +492,7 @@ testSpec = TestList
,testBoth ("testSpec " ++ show n) eCR eCPPR ((tcall removeSpec $ A.Specification emptyMeta foo spec) . over)
]
testAllSame n e s = testAll n e e s
over ops = ops {genDeclaration = override3 (tell ["#ATION"]), genDecl = override3 (tell ["#DECL"])
over ops = ops {genDeclaration = override2 (tell . (\x -> ["#ATION_",show x])), genDecl = override3 (tell ["#DECL"])
,declareInit = (override3 (Just $ tell ["#INIT"])), declareFree = override3 (Just $ tell ["#FREE"])
}