diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 56c8cfd..cb05e2f 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -86,10 +86,8 @@ 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 - genBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> CGen (), - -- | Generates the number of bytes in a type that may have one free dimension - genBytesIn' :: GenOps -> A.Type -> Maybe A.Variable -> CGen (Maybe Int), + -- | 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 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 (), @@ -193,7 +191,6 @@ cgenOps = GenOps { genAssert = cgenAssert, genAssign = cgenAssign, genBytesIn = cgenBytesIn, - genBytesIn' = cgenBytesIn', genCase = cgenCase, genCheckedConversion = cgenCheckedConversion, genConversion = cgenConversion, @@ -410,19 +407,32 @@ cgenType ops t Just s -> tell [s] Nothing -> call genMissingC ops $ formatCode "genType %" t +indexOfFreeDimensions :: [A.Dimension] -> [Int] +indexOfFreeDimensions = (mapMaybe indexOfFreeDimensions') . (zip [0..]) + where + indexOfFreeDimensions' :: (Int,A.Dimension) -> Maybe Int + indexOfFreeDimensions' (_, A.Dimension _) = Nothing + 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 -> CGen () -cgenBytesIn ops t v - = do free <- call genBytesIn' ops t v - case free of - Nothing -> return () - Just _ -> die "genBytesIn type with unknown dimension" +cgenBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> Bool -> CGen () +cgenBytesIn ops t v freeDimensionAllowed + = do cgenBytesIn' ops t v + case (t, v) of + (A.Array ds _, Nothing) -> + 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 () + (_,_) -> die "genBytesIn type with more than one free dimension" + _ -> return () -- | Generate the number of bytes in a type that may have one free dimension. cgenBytesIn' :: GenOps -> A.Type -> Maybe A.Variable -> CGen (Maybe Int) cgenBytesIn' ops (A.Array ds t) v = do free <- genBytesInArray ds 0 - call genBytesIn' ops t v + cgenBytesIn' ops t v return free where genBytesInArray [] _ = return Nothing @@ -846,7 +856,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 +cgenExpression ops (A.BytesInType m t) = call genBytesIn ops t Nothing False --cgenExpression ops (A.OffsetOf m t n) cgenExpression ops t = call genMissing ops $ "genExpression " ++ show t @@ -947,7 +957,7 @@ cgenInputItem ops c (A.InCounted m cv av) subT <- trivialSubscriptType t call genVariable ops cv tell ["*"] - call genBytesIn ops subT (Just av) + call genBytesIn ops subT (Just av) False tell [");"] cgenInputItem ops c (A.InVariable m v) = do t <- typeOfVariable v @@ -965,7 +975,7 @@ cgenInputItem ops c (A.InVariable m v) tell [","] rhs tell [","] - call genBytesIn ops t (Just v) + call genBytesIn ops t (Just v) False tell [");"] cgenOutputItem :: GenOps -> A.Variable -> A.OutputItem -> CGen () @@ -982,7 +992,7 @@ cgenOutputItem ops c (A.OutCounted m ce ae) subT <- trivialSubscriptType t call genExpression ops ce tell ["*"] - call genBytesIn ops subT (Just v) + call genBytesIn ops subT (Just v) False tell [");"] cgenOutputItem ops c (A.OutExpression m e) = do t <- typeOfExpression e @@ -999,7 +1009,7 @@ cgenOutputItem ops c (A.OutExpression m e) tell [","] fst $ abbrevVariable ops A.Abbrev t v tell [","] - call genBytesIn ops t (Just v) + call genBytesIn ops t (Just v) False tell [");"] --}}} @@ -1132,9 +1142,9 @@ cgenRetypeSizes _ _ _ (A.Chan {}) _ (A.Chan {}) _ = return () cgenRetypeSizes ops m am destT destN srcT srcV = do size <- makeNonce "retype_size" tell ["int ", size, " = occam_check_retype ("] - call genBytesIn ops srcT (Just srcV) + call genBytesIn ops srcT (Just srcV) False tell [", "] - free <- call genBytesIn' ops destT Nothing + call genBytesIn ops destT Nothing True tell [", "] genMeta m tell [");\n"] @@ -1142,7 +1152,8 @@ cgenRetypeSizes ops m am destT destN srcT srcV case destT of -- An array -- figure out the genMissing dimension, if there is one. A.Array destDS _ -> - do case free of + do let free = listToMaybe (indexOfFreeDimensions destDS) + case free of -- No free dimensions; check the complete array matches in size. Nothing -> do tell ["if (", size, " != 1) {\n"] diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index d6644f3..98b9aa9 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) + call genBytesIn ops t (Just av) False ) (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)) + (True,_)-> recvBytes v (call genBytesIn ops t (Just v) False) (False,A.Array {}) -> do tell ["tockRecvArray("] chan' tell [","] diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index 238cce4..fdb03a9 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 = override2 caret, genArraySubscript = override3 dollar} + over ops = ops {genBytesIn = override3 caret, genArraySubscript = override3 dollar} testOutput :: Test testOutput = TestList @@ -956,29 +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 = override2 caret} + over ops = ops {genBytesIn = override3 caret} testBytesIn :: Test testBytesIn = TestList [ - 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) + 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) --Array with a single known dimension: - ,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall2 genBytesIn (A.Array [A.Dimension 5] A.Int) undefined) - --single unknown dimension, no variable: - ,testBothFail "testBytesIn 101" (tcall2 genBytesIn (A.Array [A.UnknownDimension] A.Int) Nothing) + ,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall3 genBytesIn (A.Array [A.Dimension 5] A.Int) Nothing undefined) + --single unknown dimension, no variable, no free dimension allowed: + ,testBothFail "testBytesIn 101a" (tcall3 genBytesIn (A.Array [A.UnknownDimension] A.Int) Nothing False) + --single unknown dimension, no variable, free dimension allowed: + ,testBothSame "testBytesIn 101b" "sizeof(int)" (tcall3 genBytesIn (A.Array [A.UnknownDimension] A.Int) Nothing True) --single unknown dimension, with variable: - ,testBothSame "testBytesIn 102" "$(@0)*sizeof(int)" ((tcall2 genBytesIn (A.Array [A.UnknownDimension] A.Int) (Just undefined)) . over) + ,testBothSame "testBytesIn 102" "$(@0)*sizeof(int)" ((tcall3 genBytesIn (A.Array [A.UnknownDimension] A.Int) (Just undefined) undefined) . over) --Array with all known dimensions: - ,testBothSame "testBytesIn 200" "7*6*5*sizeof(int)" (tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6, A.Dimension 7] A.Int) undefined) - --single unknown dimension, no variable: - ,testBothFail "testBytesIn 201" (tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) Nothing) + ,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) + --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) + --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) --single unknown dimension, with variable: - ,testBothSame "testBytesIn 202" "$(@2)*6*5*sizeof(int)" ((tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Just undefined)) . over) + ,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) ] where