From c74ae1281024ad134a79ee5bc2c8f0fd721da3f4 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Sat, 13 Oct 2007 16:16:52 +0000 Subject: [PATCH] Changed the type of genBytesIn again, to remove redundancy in its parameters --- backends/GenerateC.hs | 34 ++++++++++++++++++---------------- backends/GenerateCPPCSP.hs | 4 ++-- backends/GenerateCTest.hs | 28 ++++++++++++++-------------- 3 files changed, 34 insertions(+), 32 deletions(-) diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 3a147d9..957d16e 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -86,8 +86,10 @@ data GenOps = GenOps { genAssert :: GenOps -> Meta -> A.Expression -> CGen (), -- | Generates an assignment statement with a single destination and single source. genAssign :: GenOps -> Meta -> [A.Variable] -> A.ExpressionList -> CGen (), - -- | Generates the number of bytes in a fixed size type, fails if a free dimension is present and is not allowed - genBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> Bool -> CGen (), + -- | Generates the number of bytes in a fixed size type, fails if a free dimension is present and is not allowed. + -- The Either parameter is either an array variable (to use the _sizes array of) or a boolean specifying + -- wheter or not one free dimension is allowed (True <=> allowed). + genBytesIn :: GenOps -> A.Type -> Either Bool A.Variable -> CGen (), -- | Generates a case statement over the given expression with the structured as the body. genCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen (), genCheckedConversion :: GenOps -> Meta -> A.Type -> A.Type -> CGen () -> CGen (), @@ -415,12 +417,12 @@ indexOfFreeDimensions = (mapMaybe indexOfFreeDimensions') . (zip [0..]) indexOfFreeDimensions' (n, A.UnknownDimension) = Just n --- | Generate the number of bytes in a type that must have a fixed size. -cgenBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> Bool -> CGen () -cgenBytesIn ops t v freeDimensionAllowed +-- | Generate the number of bytes in a type. +cgenBytesIn :: GenOps -> A.Type -> Either Bool A.Variable -> CGen () +cgenBytesIn ops t v = do case (t, v) of - (A.Array ds _, Nothing) -> - case (length (indexOfFreeDimensions ds),freeDimensionAllowed) of + (A.Array ds _, Left freeDimensionAllowed) -> + case (length (indexOfFreeDimensions ds), freeDimensionAllowed) of (0,_) -> return () (1,False) -> die "genBytesIn type with unknown dimension, when unknown dimensions are not allowed" (1,True) -> return () @@ -452,11 +454,11 @@ cgenBytesIn ops t v freeDimensionAllowed genBytesInArrayDim (A.Dimension n, _) = tell [show n, "*"] genBytesInArrayDim (A.UnknownDimension, i) = case v of - Just rv -> + Right rv -> do call genVariable ops rv call genSizeSuffix ops (show i) tell ["*"] - Nothing -> return () + _ -> return () --}}} @@ -845,7 +847,7 @@ cgenExpression _ (A.False m) = tell ["false"] cgenExpression ops (A.IntrinsicFunctionCall m s es) = call genIntrinsicFunction ops m s es --cgenExpression ops (A.SubscriptedExpr m s e) --cgenExpression ops (A.BytesInExpr m e) -cgenExpression ops (A.BytesInType m t) = call genBytesIn ops t Nothing False +cgenExpression ops (A.BytesInType m t) = call genBytesIn ops t (Left False) --cgenExpression ops (A.OffsetOf m t n) cgenExpression ops t = call genMissing ops $ "genExpression " ++ show t @@ -946,7 +948,7 @@ cgenInputItem ops c (A.InCounted m cv av) subT <- trivialSubscriptType t call genVariable ops cv tell ["*"] - call genBytesIn ops subT (Just av) False + call genBytesIn ops subT (Right av) tell [");"] cgenInputItem ops c (A.InVariable m v) = do t <- typeOfVariable v @@ -964,7 +966,7 @@ cgenInputItem ops c (A.InVariable m v) tell [","] rhs tell [","] - call genBytesIn ops t (Just v) False + call genBytesIn ops t (Right v) tell [");"] cgenOutputItem :: GenOps -> A.Variable -> A.OutputItem -> CGen () @@ -981,7 +983,7 @@ cgenOutputItem ops c (A.OutCounted m ce ae) subT <- trivialSubscriptType t call genExpression ops ce tell ["*"] - call genBytesIn ops subT (Just v) False + call genBytesIn ops subT (Right v) tell [");"] cgenOutputItem ops c (A.OutExpression m e) = do t <- typeOfExpression e @@ -998,7 +1000,7 @@ cgenOutputItem ops c (A.OutExpression m e) tell [","] fst $ abbrevVariable ops A.Abbrev t v tell [","] - call genBytesIn ops t (Just v) False + call genBytesIn ops t (Right v) tell [");"] --}}} @@ -1131,9 +1133,9 @@ cgenRetypeSizes _ _ (A.Chan {}) _ (A.Chan {}) _ = return () cgenRetypeSizes ops m destT destN srcT srcV = do size <- makeNonce "retype_size" tell ["int ", size, " = occam_check_retype ("] - call genBytesIn ops srcT (Just srcV) False + call genBytesIn ops srcT (Right srcV) tell [", "] - call genBytesIn ops destT Nothing True + call genBytesIn ops destT (Left True) tell [", "] genMeta m tell [");\n"] diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 8b0ba3e..8c0cc31 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -419,13 +419,13 @@ cppgenInputItem ops c dest tell ["*"] t <- typeOfVariable av subT <- trivialSubscriptType t - call genBytesIn ops t (Just av) False + call genBytesIn ops t (Right av) ) (A.InVariable m v) -> do ct <- typeOfVariable c t <- typeOfVariable v case (byteArrayChan ct,t) of - (True,_)-> recvBytes v (call genBytesIn ops t (Just v) False) + (True,_)-> recvBytes v (call genBytesIn ops t (Right v)) (False,A.Array {}) -> do tell ["tockRecvArray("] chan' tell [","] diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index 92004b8..149e406 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -872,7 +872,7 @@ testInput = TestList -- defineName chanOut $ simpleDefDecl "cIn" (A.Chan A.DirInput (A.ChanAttributes False False) $ A.UserProtocol foo) overInputItemCase ops = ops {genInputItem = override2 caret, genInputCase = override3 dollar} - over ops = ops {genBytesIn = override3 caret, genArraySubscript = override3 dollar} + over ops = ops {genBytesIn = override2 caret, genArraySubscript = override3 dollar} testOutput :: Test testOutput = TestList @@ -956,33 +956,33 @@ testOutput = TestList defineName chanOut $ simpleDefDecl "cOut" (A.Chan A.DirOutput (A.ChanAttributes False False) $ A.UserProtocol foo) overOutput ops = ops {genOutput = override2 caret} overOutputItem ops = ops {genOutputItem = override2 caret} - over ops = ops {genBytesIn = override3 caret} + over ops = ops {genBytesIn = override2 caret} testBytesIn :: Test testBytesIn = TestList [ - testBothSame "testBytesIn 0" "sizeof(int)" (tcall3 genBytesIn A.Int undefined undefined) - ,testBothSame "testBytesIn 1" "sizeof(foo)" (tcall3 genBytesIn (A.Record foo) undefined undefined) - ,testBoth "testBytesIn 2" "sizeof(Channel)" "sizeof(csp::One2OneChannel)" (tcall3 genBytesIn (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) undefined undefined) - ,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin)" (tcall3 genBytesIn (A.Chan A.DirInput (A.ChanAttributes False False) A.Int) undefined undefined) + testBothSame "testBytesIn 0" "sizeof(int)" (tcall2 genBytesIn A.Int undefined) + ,testBothSame "testBytesIn 1" "sizeof(foo)" (tcall2 genBytesIn (A.Record foo) undefined) + ,testBoth "testBytesIn 2" "sizeof(Channel)" "sizeof(csp::One2OneChannel)" (tcall2 genBytesIn (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) undefined) + ,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin)" (tcall2 genBytesIn (A.Chan A.DirInput (A.ChanAttributes False False) A.Int) undefined) --Array with a single known dimension: - ,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall3 genBytesIn (A.Array [A.Dimension 5] A.Int) Nothing undefined) + ,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall2 genBytesIn (A.Array [A.Dimension 5] A.Int) (Left False)) --single unknown dimension, no variable, no free dimension allowed: - ,testBothFail "testBytesIn 101a" (tcall3 genBytesIn (A.Array [A.UnknownDimension] A.Int) Nothing False) + ,testBothFail "testBytesIn 101a" (tcall2 genBytesIn (A.Array [A.UnknownDimension] A.Int) (Left False)) --single unknown dimension, no variable, free dimension allowed: - ,testBothSame "testBytesIn 101b" "sizeof(int)" (tcall3 genBytesIn (A.Array [A.UnknownDimension] A.Int) Nothing True) + ,testBothSame "testBytesIn 101b" "sizeof(int)" (tcall2 genBytesIn (A.Array [A.UnknownDimension] A.Int) (Left True)) --single unknown dimension, with variable: - ,testBothSame "testBytesIn 102" "$(@0)*sizeof(int)" ((tcall3 genBytesIn (A.Array [A.UnknownDimension] A.Int) (Just undefined) undefined) . over) + ,testBothSame "testBytesIn 102" "$(@0)*sizeof(int)" ((tcall2 genBytesIn (A.Array [A.UnknownDimension] A.Int) (Right undefined)) . over) --Array with all known dimensions: - ,testBothSame "testBytesIn 200" "7*6*5*sizeof(int)" (tcall3 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6, A.Dimension 7] A.Int) Nothing undefined) + ,testBothSame "testBytesIn 200" "7*6*5*sizeof(int)" (tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6, A.Dimension 7] A.Int) (Left False)) --single unknown dimension, no variable, no free dimension allowed: - ,testBothFail "testBytesIn 201a" (tcall3 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) Nothing False) + ,testBothFail "testBytesIn 201a" (tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Left False)) --single unknown dimension, no variable, free dimension allowed: - ,testBothSame "testBytesIn 201b" "6*5*sizeof(int)" (tcall3 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) Nothing True) + ,testBothSame "testBytesIn 201b" "6*5*sizeof(int)" (tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Left True)) --single unknown dimension, with variable: - ,testBothSame "testBytesIn 202" "$(@2)*6*5*sizeof(int)" ((tcall3 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Just undefined) undefined) . over) + ,testBothSame "testBytesIn 202" "$(@2)*6*5*sizeof(int)" ((tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Right undefined)) . over) ] where