Removed genBytesIn' from the GenOps, in favour of adding a parameter to genBytesIn, and changed the tests and code accordingly
This commit is contained in:
parent
d5d4580aa3
commit
ffd09847fe
|
@ -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"]
|
||||
|
|
|
@ -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 [","]
|
||||
|
|
|
@ -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<int>)" (tcall2 genBytesIn (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) undefined)
|
||||
,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin<int>)" (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<int>)" (tcall3 genBytesIn (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) undefined 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:
|
||||
,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
|
||||
|
|
Loading…
Reference in New Issue
Block a user