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

Removed genBytesIn' from the GenOps, in favour of adding a parameter to genBytesIn, and changed the tests and code accordingly

Browse Source
This commit is contained in:
Neil Brown 2007-10-13 14:51:29 +00:00
parent d5d4580aa3
commit ffd09847fe
3 changed files with 51 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
backends/GenerateC.hs
View File

@ -86,10 +86,8 @@ data GenOps = GenOps {
genAssert :: GenOps -> Meta -> A.Expression -> CGen (), genAssert :: GenOps -> Meta -> A.Expression -> CGen (),
-- | Generates an assignment statement with a single destination and single source. -- | Generates an assignment statement with a single destination and single source.
genAssign :: GenOps -> Meta -> [A.Variable] -> A.ExpressionList -> CGen (), genAssign :: GenOps -> Meta -> [A.Variable] -> A.ExpressionList -> CGen (),
-- | Generates the number of bytes in a fixed size type -- | 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 -> CGen (), genBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> Bool -> 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 a case statement over the given expression with the structured as the body. -- | Generates a case statement over the given expression with the structured as the body.
genCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen (), genCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen (),
genCheckedConversion :: GenOps -> Meta -> A.Type -> A.Type -> CGen () -> CGen (), genCheckedConversion :: GenOps -> Meta -> A.Type -> A.Type -> CGen () -> CGen (),
@ -193,7 +191,6 @@ cgenOps = GenOps {
genAssert = cgenAssert, genAssert = cgenAssert,
genAssign = cgenAssign, genAssign = cgenAssign,
genBytesIn = cgenBytesIn, genBytesIn = cgenBytesIn,
genBytesIn' = cgenBytesIn',
genCase = cgenCase, genCase = cgenCase,
genCheckedConversion = cgenCheckedConversion, genCheckedConversion = cgenCheckedConversion,
genConversion = cgenConversion, genConversion = cgenConversion,
@ -410,19 +407,32 @@ cgenType ops t
Just s -> tell [s] Just s -> tell [s]
Nothing -> call genMissingC ops $ formatCode "genType %" t 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. -- | Generate the number of bytes in a type that must have a fixed size.
cgenBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> CGen () cgenBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> Bool -> CGen ()
cgenBytesIn ops t v cgenBytesIn ops t v freeDimensionAllowed
= do free <- call genBytesIn' ops t v = do cgenBytesIn' ops t v
case free of case (t, v) of
Nothing -> return () (A.Array ds _, Nothing) ->
Just _ -> die "genBytesIn type with unknown dimension" 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. -- | 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' :: GenOps -> A.Type -> Maybe A.Variable -> CGen (Maybe Int)
cgenBytesIn' ops (A.Array ds t) v cgenBytesIn' ops (A.Array ds t) v
= do free <- genBytesInArray ds 0 = do free <- genBytesInArray ds 0
call genBytesIn' ops t v cgenBytesIn' ops t v
return free return free
where where
genBytesInArray [] _ = return Nothing 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.IntrinsicFunctionCall m s es) = call genIntrinsicFunction ops m s es
--cgenExpression ops (A.SubscriptedExpr m s e) --cgenExpression ops (A.SubscriptedExpr m s e)
--cgenExpression ops (A.BytesInExpr m 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 (A.OffsetOf m t n)
cgenExpression ops t = call genMissing ops $ "genExpression " ++ show t cgenExpression ops t = call genMissing ops $ "genExpression " ++ show t
@ -947,7 +957,7 @@ cgenInputItem ops c (A.InCounted m cv av)
subT <- trivialSubscriptType t subT <- trivialSubscriptType t
call genVariable ops cv call genVariable ops cv
tell ["*"] tell ["*"]
call genBytesIn ops subT (Just av) call genBytesIn ops subT (Just av) False
tell [");"] tell [");"]
cgenInputItem ops c (A.InVariable m v) cgenInputItem ops c (A.InVariable m v)
= do t <- typeOfVariable v = do t <- typeOfVariable v
@ -965,7 +975,7 @@ cgenInputItem ops c (A.InVariable m v)
tell [","] tell [","]
rhs rhs
tell [","] tell [","]
call genBytesIn ops t (Just v) call genBytesIn ops t (Just v) False
tell [");"] tell [");"]
cgenOutputItem :: GenOps -> A.Variable -> A.OutputItem -> CGen () cgenOutputItem :: GenOps -> A.Variable -> A.OutputItem -> CGen ()
@ -982,7 +992,7 @@ cgenOutputItem ops c (A.OutCounted m ce ae)
subT <- trivialSubscriptType t subT <- trivialSubscriptType t
call genExpression ops ce call genExpression ops ce
tell ["*"] tell ["*"]
call genBytesIn ops subT (Just v) call genBytesIn ops subT (Just v) False
tell [");"] tell [");"]
cgenOutputItem ops c (A.OutExpression m e) cgenOutputItem ops c (A.OutExpression m e)
= do t <- typeOfExpression e = do t <- typeOfExpression e
@ -999,7 +1009,7 @@ cgenOutputItem ops c (A.OutExpression m e)
tell [","] tell [","]
fst $ abbrevVariable ops A.Abbrev t v fst $ abbrevVariable ops A.Abbrev t v
tell [","] tell [","]
call genBytesIn ops t (Just v) call genBytesIn ops t (Just v) False
tell [");"] tell [");"]
--}}} --}}}
@ -1132,9 +1142,9 @@ cgenRetypeSizes _ _ _ (A.Chan {}) _ (A.Chan {}) _ = return ()
cgenRetypeSizes ops m am destT destN srcT srcV cgenRetypeSizes ops m am destT destN srcT srcV
= do size <- makeNonce "retype_size" = do size <- makeNonce "retype_size"
tell ["int ", size, " = occam_check_retype ("] tell ["int ", size, " = occam_check_retype ("]
call genBytesIn ops srcT (Just srcV) call genBytesIn ops srcT (Just srcV) False
tell [", "] tell [", "]
free <- call genBytesIn' ops destT Nothing call genBytesIn ops destT Nothing True
tell [", "] tell [", "]
genMeta m genMeta m
tell [");\n"] tell [");\n"]
@ -1142,7 +1152,8 @@ cgenRetypeSizes ops m am destT destN srcT srcV
case destT of case destT of
-- An array -- figure out the genMissing dimension, if there is one. -- An array -- figure out the genMissing dimension, if there is one.
A.Array destDS _ -> 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. -- No free dimensions; check the complete array matches in size.
Nothing -> Nothing ->
do tell ["if (", size, " != 1) {\n"] do tell ["if (", size, " != 1) {\n"]

4
backends/GenerateCPPCSP.hs
View File

@ -419,13 +419,13 @@ cppgenInputItem ops c dest
tell ["*"] tell ["*"]
t <- typeOfVariable av t <- typeOfVariable av
subT <- trivialSubscriptType t subT <- trivialSubscriptType t
call genBytesIn ops t (Just av) call genBytesIn ops t (Just av) False
) )
(A.InVariable m v) -> (A.InVariable m v) ->
do ct <- typeOfVariable c do ct <- typeOfVariable c
t <- typeOfVariable v t <- typeOfVariable v
case (byteArrayChan ct,t) of 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("] (False,A.Array {}) -> do tell ["tockRecvArray("]
chan' chan'
tell [","] tell [","]

32
backends/GenerateCTest.hs
View File

@ -872,7 +872,7 @@ testInput = TestList
-- defineName chanOut $ simpleDefDecl "cIn" (A.Chan A.DirInput (A.ChanAttributes False False) $ A.UserProtocol foo) -- defineName chanOut $ simpleDefDecl "cIn" (A.Chan A.DirInput (A.ChanAttributes False False) $ A.UserProtocol foo)
overInputItemCase ops = ops {genInputItem = override2 caret, genInputCase = override3 dollar} 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 :: Test
testOutput = TestList testOutput = TestList
@ -956,29 +956,33 @@ testOutput = TestList
defineName chanOut $ simpleDefDecl "cOut" (A.Chan A.DirOutput (A.ChanAttributes False False) $ A.UserProtocol foo) defineName chanOut $ simpleDefDecl "cOut" (A.Chan A.DirOutput (A.ChanAttributes False False) $ A.UserProtocol foo)
overOutput ops = ops {genOutput = override2 caret} overOutput ops = ops {genOutput = override2 caret}
overOutputItem ops = ops {genOutputItem = override2 caret} overOutputItem ops = ops {genOutputItem = override2 caret}
over ops = ops {genBytesIn = override2 caret} over ops = ops {genBytesIn = override3 caret}
testBytesIn :: Test testBytesIn :: Test
testBytesIn = TestList testBytesIn = TestList
[ [
testBothSame "testBytesIn 0" "sizeof(int)" (tcall2 genBytesIn A.Int undefined) testBothSame "testBytesIn 0" "sizeof(int)" (tcall3 genBytesIn A.Int undefined undefined)
,testBothSame "testBytesIn 1" "sizeof(foo)" (tcall2 genBytesIn (A.Record foo) undefined) ,testBothSame "testBytesIn 1" "sizeof(foo)" (tcall3 genBytesIn (A.Record foo) undefined undefined)
,testBoth "testBytesIn 2" "sizeof(Channel)" "sizeof(csp::One2OneChannel<int>)" (tcall2 genBytesIn (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) undefined) ,testBoth "testBytesIn 2" "sizeof(Channel)" "sizeof(csp::One2OneChannel<int>)" (tcall3 genBytesIn (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) undefined undefined)
,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin<int>)" (tcall2 genBytesIn (A.Chan A.DirInput (A.ChanAttributes False False) A.Int) undefined) ,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin<int>)" (tcall3 genBytesIn (A.Chan A.DirInput (A.ChanAttributes False False) A.Int) undefined undefined)
--Array with a single known dimension: --Array with a single known dimension:
,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall2 genBytesIn (A.Array [A.Dimension 5] A.Int) undefined) ,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall3 genBytesIn (A.Array [A.Dimension 5] A.Int) Nothing undefined)
--single unknown dimension, no variable: --single unknown dimension, no variable, no free dimension allowed:
,testBothFail "testBytesIn 101" (tcall2 genBytesIn (A.Array [A.UnknownDimension] A.Int) Nothing) ,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: --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: --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) ,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: --single unknown dimension, no variable, no free dimension allowed:
,testBothFail "testBytesIn 201" (tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) Nothing) ,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: --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 where