diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 8f6f038..0b495f3 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -145,7 +145,6 @@ cgenOps = GenOps { genTypeSymbol = cgenTypeSymbol, genUnfoldedExpression = cgenUnfoldedExpression, genUnfoldedVariable = cgenUnfoldedVariable, - genVariable = \v am -> cgenVariableWithAM True v am id, genVariable' = cgenVariableWithAM True, genVariableUnchecked = \v am -> cgenVariableWithAM False v am id, genWhile = cgenWhile, @@ -709,7 +708,9 @@ cgenVariableWithAM checkValid v am fct Pointer ct <- details iv let check = if checkValid then subCheck else A.NoCheck -- Arrays should be pointers to the inner element: - return (do cgenVariableWithAM checkValid iv A.Original id + return (do tell ["("] + cgenVariableWithAM checkValid iv A.Original id + tell [")"] call genArraySubscript check iv (map (\e -> (findMeta e, call genExpression e)) es) , ct) A.SubscriptField _ fieldName @@ -808,7 +809,7 @@ cgetCType m origT am -- Scalar types: (_, Just pl, False, A.Original) -> return $ Plain pl - (_, Just pl, False, A.Abbrev) -> return $ Pointer $ Plain pl + (_, Just pl, False, A.Abbrev) -> return $ Const $ Pointer $ Plain pl (_, Just pl, False, A.ValAbbrev) -> return $ Const $ Plain pl -- Mobile scalar types: diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs index 6c55628..d9b446d 100644 --- a/backends/GenerateCBased.hs +++ b/backends/GenerateCBased.hs @@ -177,8 +177,6 @@ data GenOps = GenOps { genTypeSymbol :: String -> A.Type -> CGen (), genUnfoldedExpression :: A.Expression -> CGen (), genUnfoldedVariable :: Meta -> A.Variable -> CGen (), - -- | Generates a variable, with indexing checks if needed - genVariable :: A.Variable -> A.AbbrevMode -> CGen (), -- Like genVariable, but modifies the desired CType genVariable' :: A.Variable -> A.AbbrevMode -> (CType -> CType) -> CGen (), -- | Generates a variable, with no indexing checks anywhere @@ -190,6 +188,10 @@ data GenOps = GenOps { removeSpec :: A.Specification -> CGen () } +-- | Generates a variable, with indexing checks if needed +genVariable :: GenOps -> A.Variable -> A.AbbrevMode -> CGen () +genVariable ops v am = genVariable' ops v am id + -- | Call an operation in GenOps. class CGenCall a where call :: (GenOps -> a) -> a @@ -247,7 +249,7 @@ data CType instance Show CType where show (Plain s) = s show (Pointer t) = show t ++ "*" - show (Const t) = show t ++ " const " + show (Const t) = show t ++ " const" show (Template wr cts) = wr ++ "<" ++ concat (intersperse "," $ map show cts) ++ ">/**/" -- show (Subscript t) = "(" ++ show t ++ "[n])" @@ -278,9 +280,9 @@ dressUp m (gen, Const t) t' dressUp m (gen, t) (Const t') = dressUp m (gen, t) t' dressUp m (gen, t@(Plain {})) (Pointer t') - = dressUp m (tell ["(&("] >> gen >> tell ["))"], t) t' + = dressUp m (tell ["&"] >> gen, t) t' dressUp m (gen, Pointer t) t'@(Plain {}) - = dressUp m (tell ["(*("] >> gen >> tell ["))"], t) t' + = dressUp m (tell ["*"] >> gen, t) t' dressUp m (gen, t) t' = dieP m $ "Types cannot be brought together: " ++ show t ++ " and " ++ show t' diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index db23419..c3fe27b 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -193,8 +193,9 @@ genCPPCSPChannelInput var case t of (A.ChanEnd A.DirInput _ _) -> call genVariable var A.Original -- TODO remove the following line, eventually - (A.Chan _ _) -> do call genVariable var A.Original - tell [".reader()"] + (A.Chan _ _) -> do tell ["("] + call genVariable var A.Original + tell [").reader()"] _ -> call genMissing $ "genCPPCSPChannelInput used on something which does not support input: " ++ show var -- | Generates code from a channel 'A.Variable' that will be of type Chanout\<\> @@ -204,8 +205,9 @@ genCPPCSPChannelOutput var case t of (A.ChanEnd A.DirOutput _ _) -> call genVariable var A.Original -- TODO remove the following line, eventually - (A.Chan _ _) -> do call genVariable var A.Original - tell [".writer()"] + (A.Chan _ _) -> do tell ["("] + call genVariable var A.Original + tell [").writer()"] _ -> call genMissing $ "genCPPCSPChannelOutput used on something which does not support output: " ++ show var cppgenPoison :: Meta -> A.Variable -> CGen () diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index 06d2c3f..d37a4d3 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -256,9 +256,9 @@ testGenType = TestList ,testBoth "GenType 253" "Time*" "csp::Time*" (gt $ A.Mobile A.Time) ,testBoth "GenType 300" "Channel" "csp::One2OneChannel" (gt $ A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int32) - ,testBoth "GenType 301" "Channel" "csp::One2AnyChannel" (gt $ A.Chan (A.ChanAttributes A.Unshared A.Shared) A.Int32) - ,testBoth "GenType 302" "Channel" "csp::Any2OneChannel" (gt $ A.Chan (A.ChanAttributes A.Shared A.Unshared) A.Int32) - ,testBoth "GenType 303" "Channel" "csp::Any2AnyChannel" (gt $ A.Chan (A.ChanAttributes A.Shared A.Shared) A.Int32) + ,testBoth "GenType 301" "mt_cb_t*" "csp::One2AnyChannel" (gt $ A.Chan (A.ChanAttributes A.Unshared A.Shared) A.Int32) + ,testBoth "GenType 302" "mt_cb_t*" "csp::Any2OneChannel" (gt $ A.Chan (A.ChanAttributes A.Shared A.Unshared) A.Int32) + ,testBoth "GenType 303" "mt_cb_t*" "csp::Any2AnyChannel" (gt $ A.Chan (A.ChanAttributes A.Shared A.Shared) A.Int32) ,testBoth "GenType 310" "Channel" "csp::One2OneChannel" (gt $ A.Chan (A.ChanAttributes A.Unshared A.Unshared) (A.Mobile A.Int32)) @@ -323,7 +323,7 @@ testActuals :: Test testActuals = TestList [ -- C adds a prefix comma (to follow Process* me) but C++ does not: - testBoth "genActuals 0" ",@,@" "@,@" $ overActual (tcall genActuals [undefined, undefined] [undefined, undefined]) + testBoth "genActuals 0" "@,@" "@,@" $ overActual (tcall genActuals [undefined, undefined] [undefined, undefined]) ,testBothSame "genActuals 1" "" $ (tcall genActuals [] []) --For expressions, genExpression should be called: @@ -351,32 +351,32 @@ testActuals = TestList overActual :: Override overActual = local (\ops -> ops {genActual = override2 at}) over :: Override - over = local (\ops -> ops {genVariable = override2 at, genExpression = override1 dollar}) + over = local (\ops -> ops {genVariable' = override3 at, genExpression = override1 dollar}) -- TODO test the other two array checking methods testArraySubscript :: Test testArraySubscript = TestList [ - testBothSameS "genArraySubscript 0" "[5*foo_sizes[1]*foo_sizes[2]]" + testBothSameS "genArraySubscript 0" "[5*8*9]" (tcall3 genArraySubscript A.NoCheck (A.Variable emptyMeta foo) [lit 5]) stateTrans - ,testBothSameS "genArraySubscript 1" "[5*foo_sizes[1]*foo_sizes[2]+6*foo_sizes[2]]" + ,testBothSameS "genArraySubscript 1" "[5*8*9+6*9]" (tcall3 genArraySubscript A.NoCheck (A.Variable emptyMeta foo) [lit 5, lit 6]) stateTrans - ,testBothSameS "genArraySubscript 2" "[5*foo_sizes[1]*foo_sizes[2]+6*foo_sizes[2]+7]" + ,testBothSameS "genArraySubscript 2" "[5*8*9+6*9+7]" (tcall3 genArraySubscript A.NoCheck (A.Variable emptyMeta foo) [lit 5, lit 6, lit 7]) stateTrans - ,testBothSameS "genArraySubscript 3" ("[occam_check_index(5,foo_sizes[0]," ++ m ++ ")*foo_sizes[1]*foo_sizes[2]]") + ,testBothSameS "genArraySubscript 3" ("[occam_check_index(5,7," ++ m ++ ")*8*9]") (tcall3 genArraySubscript A.CheckBoth (A.Variable emptyMeta foo) [lit 5]) stateTrans ,testBothSameS "genArraySubscript 4" - ("[occam_check_index(5,foo_sizes[0]," ++ m ++ ")*foo_sizes[1]*foo_sizes[2]+occam_check_index(6,foo_sizes[1]," ++ m ++ ")*foo_sizes[2]]") + ("[occam_check_index(5,7," ++ m ++ ")*8*9+occam_check_index(6,8," ++ m ++ ")*9]") (tcall3 genArraySubscript A.CheckBoth (A.Variable emptyMeta foo) [lit 5, lit 6]) stateTrans ,testBothSameS "genArraySubscript 5" - ("[occam_check_index(5,foo_sizes[0]," ++ m ++ ")*foo_sizes[1]*foo_sizes[2]+occam_check_index(6,foo_sizes[1]," ++ m ++ ")*foo_sizes[2]+occam_check_index(7,foo_sizes[2]," ++ m ++ ")]") + ("[occam_check_index(5,7," ++ m ++ ")*8*9+occam_check_index(6,8," ++ m ++ ")*9+occam_check_index(7,9," ++ m ++ ")]") (tcall3 genArraySubscript A.CheckBoth (A.Variable emptyMeta foo) [lit 5, lit 6, lit 7]) stateTrans ] where stateTrans :: CSM m => m () - stateTrans = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [dimension 7,dimension 8,dimension 8] A.Int) + stateTrans = defineName (simpleName "foo") $ simpleDefDecl "foo" (A.Array [dimension 7,dimension 8,dimension 9] A.Int) m = "\"" ++ show emptyMeta ++ "\"" lit :: Int -> (Meta, CGen ()) @@ -470,11 +470,11 @@ testDeclaration = TestList ,testBoth "genDeclaration 1" "Channel foo;" "csp::One2OneChannel foo;" (tcall3 genDeclaration (A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int32) foo False) ,testBoth "genDeclaration 2" "Channel foo;" "csp::Any2OneChannel foo;" (tcall3 genDeclaration (A.Chan (A.ChanAttributes A.Shared A.Unshared) A.Int32) foo False) ,testBoth "genDeclaration 3" "Channel foo;" "csp::One2AnyChannel foo;" (tcall3 genDeclaration (A.Chan (A.ChanAttributes A.Unshared A.Shared) A.Int32) foo False) - ,testBoth "genDeclaration 4" "Channel foo;" "csp::Any2AnyChannel foo;" (tcall3 genDeclaration (A.Chan (A.ChanAttributes A.Shared A.Shared) A.Int32) foo False) + ,testBoth "genDeclaration 4" "mt_cb_t* foo;" "csp::Any2AnyChannel foo;" (tcall3 genDeclaration (A.Chan (A.ChanAttributes A.Shared A.Shared) A.Int32) foo False) ,testBoth "genDeclaration 5" "Channel* foo;" "csp::AltChanin foo;" (tcall3 genDeclaration (A.ChanEnd A.DirInput A.Unshared A.Int32) foo False) - ,testBoth "genDeclaration 6" "Channel* foo;" "csp::AltChanin foo;" (tcall3 genDeclaration (A.ChanEnd A.DirInput A.Shared A.Int32) foo False) + ,testBoth "genDeclaration 6" "mt_cb_t* foo;" "csp::AltChanin foo;" (tcall3 genDeclaration (A.ChanEnd A.DirInput A.Shared A.Int32) foo False) ,testBoth "genDeclaration 7" "Channel* foo;" "csp::Chanout foo;" (tcall3 genDeclaration (A.ChanEnd A.DirOutput A.Unshared A.Int32) foo False) - ,testBoth "genDeclaration 8" "Channel* foo;" "csp::Chanout foo;" (tcall3 genDeclaration (A.ChanEnd A.DirOutput A.Shared A.Int32) foo False) + ,testBoth "genDeclaration 8" "mt_cb_t* foo;" "csp::Chanout foo;" (tcall3 genDeclaration (A.ChanEnd A.DirOutput A.Shared A.Int32) foo False) --Arrays (of simple): ,testBothSame "genDeclaration 100" "int32_t foo[8];" @@ -532,14 +532,14 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList testAllSame 0 ("","") A.Int -- Channel types: - ,testAll 1 ("ChanInit(wptr,(&foo));","") ("","") $ A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int + ,testAll 1 ("ChanInit(wptr,&foo);","") ("","") $ A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int ,testAllSame 2 ("","") $ A.ChanEnd A.DirInput A.Unshared A.Int -- Plain arrays: ,testAllSame 3 ("","") $ A.Array [dimension 4] A.Int -- Channel arrays: - ,testAll 4 ("tock_init_chan_array(foo_storage,foo,4);^ChanInit(wptr,foo[0]);^","") ("tockInitChanArray(foo_storage,foo,4);","") $ A.Array [dimension 4] $ A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int + ,testAll 4 ("tock_init_chan_array(foo_storage,foo,4);^ChanInit(wptr,(foo)[0]);^","") ("tockInitChanArray(foo_storage,foo,4);","") $ A.Array [dimension 4] $ A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int ,testAllSame 6 ("","") $ A.Array [dimension 4] $ A.ChanEnd A.DirInput A.Unshared A.Int -- Plain records: @@ -611,7 +611,7 @@ testRecord = TestList over ops = ops {genDeclaration = override2 (tell . (\x -> ["#ATION_",show x])) ,declareInit = (override3 (Just $ tell ["#INIT"])), declareFree = override3 (Just $ tell ["#FREE"]) ,getCType = (\_ x _ -> return $ Plain $ "$(" ++ show x ++ ")") - ,genVariable = override2 at + ,genVariable' = override3 at } testSpec :: Test @@ -640,18 +640,18 @@ testSpec = TestList --Is: -- Plain types require you to take an address to get the pointer: - ,testAllSameForTypes 600 (\t -> ("$(" ++ show t ++ ")*const foo=&bar;","")) + ,testAllSameForTypes 600 (\t -> ("$(" ++ show t ++ ")* const foo=&bar;","")) (\t -> A.Is emptyMeta A.Abbrev t $ A.ActualVariable (variable "bar")) [A.Int,A.Time] - ,testAllSameForTypes 610 (\t -> ("$(" ++ show t ++ ")*const foo=(&bar);","")) + ,testAllSameForTypes 610 (\t -> ("$(" ++ show t ++ ")* const foo=(&bar);","")) (\t -> A.Is emptyMeta A.Abbrev t $ A.ActualVariable (variable "bar")) [chanInt,A.Record foo] --Abbreviations of channel-ends in C++ should just copy the channel-end, rather than trying to take the address of the temporary returned by writer()/reader() --C abbreviations will be of type Channel*, so they can just copy the channel address. ,testAllForTypes 620 (\t -> ("$(" ++ show t ++ ") foo=bar;","")) (\t -> ("$(" ++ show t ++ ") foo=bar;","")) (\t -> A.Is emptyMeta A.Abbrev t $ A.ActualVariable (variable "bar")) [chanIntIn,chanIntOut] - ,testAllSameForTypes 700 (\t -> ("const $(" ++ show t ++ ") foo=bar;","")) + ,testAllSameForTypes 700 (\t -> ("$(" ++ show t ++ ") const foo=bar;","")) (\t -> A.Is emptyMeta A.ValAbbrev t $ A.ActualVariable (variable "bar")) [A.Int,A.Time] - ,testAllSameForTypes 710 (\t -> ("const $(" ++ show t ++ ")*const foo=(&bar);","")) + ,testAllSameForTypes 710 (\t -> ("$(" ++ show t ++ ") const* const foo=(&bar);","")) (\t -> A.Is emptyMeta A.ValAbbrev t $ A.ActualVariable (variable "bar")) [A.Record foo] -- I don't think ValAbbrev of channels/channel-ends makes much sense (occam doesn't support it, certainly) so they are not tested here. @@ -664,20 +664,20 @@ testSpec = TestList --Retypes: -- Normal abbreviation: - ,testAllSameS 900 ("int32_t*const foo=(int32_t*const)&y;@","") (A.Retypes emptyMeta A.Abbrev A.Int32 (variable "y")) + ,testAllSameS 900 ("int32_t* const foo=(int32_t* const)&y;@","") (A.Retypes emptyMeta A.Abbrev A.Int32 (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" A.Real32)) (\ops -> ops {genRetypeSizes = override5 at}) -- Val abbreviation: - ,testAllSameS 901 ("const int32_t foo=*(const int32_t*)&y;@","") (A.Retypes emptyMeta A.ValAbbrev A.Int32 (variable "y")) + ,testAllSameS 901 ("int32_t const foo=*(int32_t const*)&y;@","") (A.Retypes emptyMeta A.ValAbbrev A.Int32 (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" A.Real32)) (\ops -> ops {genRetypeSizes = override5 at}) --Abbreviations of records as records: - ,testAllSameS 910 ("bar*const foo=(bar*const)(&y);@","") (A.Retypes emptyMeta A.Abbrev (A.Record bar) (variable "y")) + ,testAllSameS 910 ("bar* const foo=(bar* const)(&y);@","") (A.Retypes emptyMeta A.Abbrev (A.Record bar) (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" (A.Record bar2))) (\ops -> ops {genRetypeSizes = override5 at}) -- Val abbreviation of records as records: - ,testAllSameS 911 ("const bar*const foo=(const bar*const)(&y);@","") (A.Retypes emptyMeta A.ValAbbrev (A.Record bar) (variable "y")) + ,testAllSameS 911 ("const bar* const foo=(const bar* const)(&y);@","") (A.Retypes emptyMeta A.ValAbbrev (A.Record bar) (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" (A.Record bar2))) (\ops -> ops {genRetypeSizes = override5 at}) -- Channel retyping doesn't require size checking: - ,testAllS 1000 ("Channel*const foo=(Channel*const)(&y);","") ("csp::One2OneChannel*const foo=(csp::One2OneChannel*const)(&y);","") + ,testAllS 1000 ("Channel* const foo=(Channel* const)(&y);","") ("csp::One2OneChannel* const foo=(csp::One2OneChannel* const)(&y);","") (A.Retypes emptyMeta A.Abbrev (A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Any) (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" (A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Any))) id @@ -691,20 +691,20 @@ testSpec = TestList (A.Retypes emptyMeta A.Abbrev (A.Array [dimension 4] A.Byte) (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at}) -- single (unknown) dimension, VAL: - ,testAllSameS 1102 ("const uint8_t* foo=(const uint8_t*)&y;@","") + ,testAllSameS 1102 ("uint8_t const* foo=(uint8_t const*)&y;@","") (A.Retypes emptyMeta A.ValAbbrev (A.Array [A.UnknownDimension] A.Byte) (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at}) -- single (known) dimension, VAL: - ,testAllSameS 1103 ("const uint8_t* foo=(const uint8_t*)&y;@","") + ,testAllSameS 1103 ("uint8_t const* foo=(uint8_t const*)&y;@","") (A.Retypes emptyMeta A.ValAbbrev (A.Array [dimension 4] A.Byte) (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" A.Int32)) (\ops -> ops {genRetypeSizes = override5 at}) -- TODO test multiple dimensions plain-to-array (mainly for C++) -- Array-to-plain retyping: - ,testAllSameS 1200 ("int32_t*const foo=(int32_t*const)y;@","") + ,testAllSameS 1200 ("int32_t* const foo=(int32_t* const)y;@","") (A.Retypes emptyMeta A.Abbrev A.Int32 (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" (A.Array [A.UnknownDimension] A.Byte))) (\ops -> ops {genRetypeSizes = override5 at}) - ,testAllSameS 1201 ("const int32_t foo=*(const int32_t*)y;@","") + ,testAllSameS 1201 ("int32_t const foo=*(int32_t const*)y;@","") (A.Retypes emptyMeta A.ValAbbrev A.Int32 (variable "y")) (defineName (simpleName "y") (simpleDefDecl "y" (A.Array [A.UnknownDimension] A.Byte))) (\ops -> ops {genRetypeSizes = override5 at}) @@ -737,9 +737,9 @@ testSpec = TestList 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"]) - ,getCType = (\_ x _ -> return $ Plain $ "$(" ++ show x ++ ")") + ,getScalarType = (\x -> Just $ "$(" ++ show x ++ ")") } - over ops = (over' ops) { genVariable = override2 at } + over ops = (over' ops) { genVariable' = override3 at } testRetypeSizes :: Test testRetypeSizes = TestList [ @@ -790,16 +790,16 @@ testGenVariable :: Test testGenVariable = TestList [ -- Various types, unsubscripted: - testSameA 0 ("foo","(*foo)","foo") id A.Int - ,testSameA 10 ("(&foo)","foo","foo") id (A.Record bar) - ,testSameA2 20 ("(&foo)","foo") id (A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int) + testSameA 0 ("foo","*foo","foo") id A.Int + ,testSameA 10 ("foo","*foo","*foo") id (A.Record bar) + ,testSameA2 20 ("foo","*foo") id (A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int) ,testSameA2 30 ("foo","foo") id (A.ChanEnd A.DirInput A.Unshared A.Int) -- Mobile versions of the above: - ,testSameA2 40 ("foo","(*foo)") id (A.Mobile A.Int) - ,testSameA2 45 ("(*foo)","(**foo)") deref (A.Mobile A.Int) - ,testSameA2 50 ("foo","(*foo)") id (A.Mobile $ A.Record bar) - ,testSameA2 55 ("foo","(*foo)") deref (A.Mobile $ A.Record bar) + ,testSameA2 40 ("foo","*foo") id (A.Mobile A.Int) + ,testSameA2 45 ("*foo","**foo") deref (A.Mobile A.Int) + ,testSameA2 50 ("foo","*foo") id (A.Mobile $ A.Record bar) + ,testSameA2 55 ("*foo","**foo") deref (A.Mobile $ A.Record bar) -- Arrays of the previous types, unsubscripted: ,testSameA 100 ("foo","foo","foo") id (A.Array [dimension 8] A.Int) @@ -808,30 +808,30 @@ testGenVariable = TestList ,testSameA2 130 ("foo","foo") id (A.Array [dimension 8] $ A.ChanEnd A.DirInput A.Unshared A.Int) -- Mobile arrays of the previous types: - ,testSameA2 140 ("foo","(*foo)") id (A.Mobile $ A.Array [dimension 8] A.Int) - ,testSameA2 145 ("foo","(*foo)") deref (A.Mobile $ A.Array [dimension 8] A.Int) - ,testSameA2 150 ("foo","(*foo)") id (A.Mobile $ A.Array [dimension 8] $ A.Record bar) - ,testSameA2 155 ("foo","(*foo)") deref (A.Mobile $ A.Array [dimension 8] $ A.Record bar) + ,testSameA2 140 ("foo","*foo") id (A.Mobile $ A.Array [dimension 8] A.Int) + ,testSameA2 145 ("((int32_t*)((foo)->data))","((int32_t*)((*foo)->data))") deref (A.Mobile $ A.Array [dimension 8] A.Int) + ,testSameA2 150 ("foo","*foo") id (A.Mobile $ A.Array [dimension 8] $ A.Record bar) + ,testSameA2 155 ("((bar*)((foo)->data))","((bar*)((*foo)->data))") deref (A.Mobile $ A.Array [dimension 8] $ A.Record bar) -- Subscripted record: - ,testSameA 200 ("(&foo)->x","foo->x","foo->x") fieldX (A.Record bar) - ,testSameA2 210 ("foo->x","(*foo)->x") (fieldX . deref) (A.Mobile $ A.Record bar) + ,testSameA 200 ("(foo).x","(*foo).x","(*foo).x") fieldX (A.Record bar) + ,testSameA2 210 ("(*foo).x","(**foo).x") (fieldX . deref) (A.Mobile $ A.Record bar) - ,testSameA 220 ("(&(&foo)->y)","(&foo->y)","(&foo->y)") fieldY (A.Record $ simpleName "barbar") - ,testSameA 230 ("(&(&foo)->y)->x","(&foo->y)->x","(&foo->y)->x") (fieldX . fieldY) (A.Record $ simpleName "barbar") + ,testSameA 220 ("(foo).y","(*foo).y","(*foo).y") fieldY (A.Record $ simpleName "barbar") + ,testSameA 230 ("((foo).y).x","((*foo).y).x","((*foo).y).x") (fieldX . fieldY) (A.Record $ simpleName "barbar") -- Fully subscripted array: - ,testAC 300 ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] A.Int) - ,testAC 305 ("foo@C4,5,6","foo@U4,5,6") ((sub 6) . (sub 5) . (sub 4)) (A.Array [dimension 8,dimension 9,dimension 10] A.Int) - ,testAC 310 ("(&foo@C4)","(&foo@U4)") (sub 4) (A.Array [dimension 8] $ A.Record bar) + ,testAC 300 ("(foo)@C4","(foo)@U4") (sub 4) (A.Array [dimension 8] A.Int) + ,testAC 305 ("(foo)@C4,5,6","(foo)@U4,5,6") ((sub 6) . (sub 5) . (sub 4)) (A.Array [dimension 8,dimension 9,dimension 10] A.Int) + ,testAC 310 ("(foo)@C4","(foo)@U4") (sub 4) (A.Array [dimension 8] $ A.Record bar) -- Original channel arrays are Channel*[], abbreviated channel arrays are Channel*[]: - ,testAC2 320 ("foo@C4","foo@U4") ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int) - ,testAC 330 ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.ChanEnd A.DirInput A.Unshared A.Int) + ,testAC2 320 ("(foo)@C4","(foo)@U4") ("(foo)@C4","(foo)@U4") (sub 4) (A.Array [dimension 8] $ A.Chan (A.ChanAttributes A.Unshared A.Unshared) A.Int) + ,testAC 330 ("(foo)@C4","(foo)@U4") (sub 4) (A.Array [dimension 8] $ A.ChanEnd A.DirInput A.Unshared A.Int) -- Fully subscripted array, and record field reference: - ,testAC 400 ("(&foo@C4)->x","(&foo@U4)->x") (fieldX . (sub 4)) (A.Array [dimension 8] $ A.Record bar) + ,testAC 400 ("((foo)@C4).x","((foo)@U4).x") (fieldX . (sub 4)) (A.Array [dimension 8] $ A.Record bar) -- As above, but then with an index too: - ,testAC 410 ("(&foo@C4)->x@C4","(&foo@U4)->x@U4") ((sub 4) . fieldX . (sub 4)) (A.Array [dimension 8] $ A.Record bar) + ,testAC 410 ("((foo)@C4).x@C4","((foo)@U4).x)@U4") ((sub 4) . fieldX . (sub 4)) (A.Array [dimension 8] $ A.Record bar) --TODO come back to slices later @@ -910,7 +910,7 @@ testAssign = TestList e = A.True emptyMeta state t = defineName (simpleName "foo") $ simpleDefDecl "foo" t over :: Override - over = local $ \ops -> ops {genVariable = override2 at, genExpression = override1 dollar} + over = local $ \ops -> ops {genVariable' = override3 at, genExpression = override1 dollar} testCase :: Test testCase = TestList @@ -1038,7 +1038,7 @@ testInput = TestList testInputItem' :: Int -> String -> String -> A.InputItem -> A.Type -> A.Type -> Test testInputItem' n eC eCPP ii t ct = TestList [ - testBothS ("testInput " ++ show n) (hashIs "(&c)" eC) (hashIs "(&c)->reader()" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii)) + testBothS ("testInput " ++ show n) (hashIs "&c" eC) (hashIs "(c).reader()" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii)) (state $ A.Chan (A.ChanAttributes A.Unshared A.Unshared)) ,testBothS ("testInput [in] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii)) (state $ A.ChanEnd A.DirInput A.Unshared) @@ -1126,7 +1126,7 @@ testOutput = TestList ,testOutputItemProt 302 "ChanOut(wptr,#,&x,^);" "tockSendArrayOfBytes(#,tockSendableArrayOfBytes(&x));" (A.OutExpression emptyMeta $ exprVariable "x") A.Int64 - ,testOutputItemProt 303 "ChanOut(wptr,#,(&x),^);" + ,testOutputItemProt 303 "ChanOut(wptr,#,&x,^);" "tockSendArrayOfBytes(#,tockSendableArrayOfBytes((&x)));" (A.OutExpression emptyMeta $ exprVariable "x") (A.Record foo) ,testOutputItemProt 304 "ChanOut(wptr,#,x,^);" @@ -1158,7 +1158,7 @@ testOutput = TestList testOutputItem' :: Int -> String -> String -> A.OutputItem -> A.Type -> A.Type -> Test testOutputItem' n eC eCPP oi t ct = TestList [ - testBothS ("testOutput " ++ show n) (hashIs "(&c)" eC) (hashIs "(&c)->writer()" eCPP) + testBothS ("testOutput " ++ show n) (hashIs "&c" eC) (hashIs "(c).writer()" eCPP) (over (tcall3 genOutputItem A.Int64 (A.Variable emptyMeta $ simpleName "c") oi)) (state $ A.Chan (A.ChanAttributes A.Unshared A.Unshared)) ,testBothS ("testOutput [out] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) @@ -1216,7 +1216,7 @@ testBytesIn = TestList ] where over :: Override - over = local $ \ops -> ops {genVariable = override2 dollar} + over = local $ \ops -> ops {genVariable' = override3 dollar} testMobile :: Test testMobile = TestList @@ -1233,7 +1233,7 @@ testMobile = TestList over ops = ops { genBytesIn = showBytesInParams , getCType = (\_ t _ -> return $ Plain $ show t) , genExpression = override1 dollar - , genVariable = override2 at + , genVariable' = override3 at } ---Returns the list of tests: diff --git a/frontends/OccamTypesTest.hs b/frontends/OccamTypesTest.hs index b6c6320..dad2d44 100644 --- a/frontends/OccamTypesTest.hs +++ b/frontends/OccamTypesTest.hs @@ -520,13 +520,13 @@ testOccamTypes = TestList where testOK :: (Show a, Data a) => Int -> a -> Test testOK n orig - = TestCase $ testPass ("testOccamTypes" ++ show n) + = TestCase $ testPass ("testOccamTypes " ++ show n) orig OccamTypes.checkTypes orig startState testFail :: (Show a, Data a) => Int -> a -> Test testFail n orig - = TestCase $ testPassShouldFail ("testOccamTypes" ++ show n) + = TestCase $ testPassShouldFail ("testOccamTypes " ++ show n) OccamTypes.checkTypes orig startState diff --git a/transformations/PassTest.hs b/transformations/PassTest.hs index 9c3e34e..0cb3968 100644 --- a/transformations/PassTest.hs +++ b/transformations/PassTest.hs @@ -639,8 +639,9 @@ testPullRepCounts = TestList ) pullRepCounts ] where + -- Not for PAR any more, that gets pulled up further forAllThree :: (forall a. Data a => ([Occ (A.Structured a)] -> Occ A.Process) -> Test) -> Test - forAllThree f = TestList [f oSEQ, f oPAR, f oALT] + forAllThree f = TestList [f oSEQ, f oALT] testUnchanged :: Data a => Int -> (A.Structured a -> A.Process) -> Test testUnchanged n f = TestCase $ testPass