Changed the type of genBytesIn again, to remove redundancy in its parameters
This commit is contained in:
parent
a98ff8cad0
commit
c74ae12810
|
@ -86,8 +86,10 @@ 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, fails if a free dimension is present and is not allowed
|
-- | 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 (),
|
-- 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.
|
-- | 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 (),
|
||||||
|
@ -415,11 +417,11 @@ indexOfFreeDimensions = (mapMaybe indexOfFreeDimensions') . (zip [0..])
|
||||||
indexOfFreeDimensions' (n, A.UnknownDimension) = Just n
|
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.
|
||||||
cgenBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> Bool -> CGen ()
|
cgenBytesIn :: GenOps -> A.Type -> Either Bool A.Variable -> CGen ()
|
||||||
cgenBytesIn ops t v freeDimensionAllowed
|
cgenBytesIn ops t v
|
||||||
= do case (t, v) of
|
= do case (t, v) of
|
||||||
(A.Array ds _, Nothing) ->
|
(A.Array ds _, Left freeDimensionAllowed) ->
|
||||||
case (length (indexOfFreeDimensions ds), freeDimensionAllowed) of
|
case (length (indexOfFreeDimensions ds), freeDimensionAllowed) of
|
||||||
(0,_) -> return ()
|
(0,_) -> return ()
|
||||||
(1,False) -> die "genBytesIn type with unknown dimension, when unknown dimensions are not allowed"
|
(1,False) -> die "genBytesIn type with unknown dimension, when unknown dimensions are not allowed"
|
||||||
|
@ -452,11 +454,11 @@ cgenBytesIn ops t v freeDimensionAllowed
|
||||||
genBytesInArrayDim (A.Dimension n, _) = tell [show n, "*"]
|
genBytesInArrayDim (A.Dimension n, _) = tell [show n, "*"]
|
||||||
genBytesInArrayDim (A.UnknownDimension, i)
|
genBytesInArrayDim (A.UnknownDimension, i)
|
||||||
= case v of
|
= case v of
|
||||||
Just rv ->
|
Right rv ->
|
||||||
do call genVariable ops rv
|
do call genVariable ops rv
|
||||||
call genSizeSuffix ops (show i)
|
call genSizeSuffix ops (show i)
|
||||||
tell ["*"]
|
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.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 False
|
cgenExpression ops (A.BytesInType m t) = call genBytesIn ops t (Left 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
|
||||||
|
|
||||||
|
@ -946,7 +948,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) False
|
call genBytesIn ops subT (Right av)
|
||||||
tell [");"]
|
tell [");"]
|
||||||
cgenInputItem ops c (A.InVariable m v)
|
cgenInputItem ops c (A.InVariable m v)
|
||||||
= do t <- typeOfVariable v
|
= do t <- typeOfVariable v
|
||||||
|
@ -964,7 +966,7 @@ cgenInputItem ops c (A.InVariable m v)
|
||||||
tell [","]
|
tell [","]
|
||||||
rhs
|
rhs
|
||||||
tell [","]
|
tell [","]
|
||||||
call genBytesIn ops t (Just v) False
|
call genBytesIn ops t (Right v)
|
||||||
tell [");"]
|
tell [");"]
|
||||||
|
|
||||||
cgenOutputItem :: GenOps -> A.Variable -> A.OutputItem -> CGen ()
|
cgenOutputItem :: GenOps -> A.Variable -> A.OutputItem -> CGen ()
|
||||||
|
@ -981,7 +983,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) False
|
call genBytesIn ops subT (Right v)
|
||||||
tell [");"]
|
tell [");"]
|
||||||
cgenOutputItem ops c (A.OutExpression m e)
|
cgenOutputItem ops c (A.OutExpression m e)
|
||||||
= do t <- typeOfExpression e
|
= do t <- typeOfExpression e
|
||||||
|
@ -998,7 +1000,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) False
|
call genBytesIn ops t (Right v)
|
||||||
tell [");"]
|
tell [");"]
|
||||||
--}}}
|
--}}}
|
||||||
|
|
||||||
|
@ -1131,9 +1133,9 @@ cgenRetypeSizes _ _ (A.Chan {}) _ (A.Chan {}) _ = return ()
|
||||||
cgenRetypeSizes ops m destT destN srcT srcV
|
cgenRetypeSizes ops m 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) False
|
call genBytesIn ops srcT (Right srcV)
|
||||||
tell [", "]
|
tell [", "]
|
||||||
call genBytesIn ops destT Nothing True
|
call genBytesIn ops destT (Left True)
|
||||||
tell [", "]
|
tell [", "]
|
||||||
genMeta m
|
genMeta m
|
||||||
tell [");\n"]
|
tell [");\n"]
|
||||||
|
|
|
@ -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) False
|
call genBytesIn ops t (Right av)
|
||||||
)
|
)
|
||||||
(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) False)
|
(True,_)-> recvBytes v (call genBytesIn ops t (Right v))
|
||||||
(False,A.Array {}) -> do tell ["tockRecvArray("]
|
(False,A.Array {}) -> do tell ["tockRecvArray("]
|
||||||
chan'
|
chan'
|
||||||
tell [","]
|
tell [","]
|
||||||
|
|
|
@ -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 = override3 caret, genArraySubscript = override3 dollar}
|
over ops = ops {genBytesIn = override2 caret, genArraySubscript = override3 dollar}
|
||||||
|
|
||||||
testOutput :: Test
|
testOutput :: Test
|
||||||
testOutput = TestList
|
testOutput = TestList
|
||||||
|
@ -956,33 +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 = override3 caret}
|
over ops = ops {genBytesIn = override2 caret}
|
||||||
|
|
||||||
testBytesIn :: Test
|
testBytesIn :: Test
|
||||||
testBytesIn = TestList
|
testBytesIn = TestList
|
||||||
[
|
[
|
||||||
testBothSame "testBytesIn 0" "sizeof(int)" (tcall3 genBytesIn A.Int undefined undefined)
|
testBothSame "testBytesIn 0" "sizeof(int)" (tcall2 genBytesIn A.Int undefined)
|
||||||
,testBothSame "testBytesIn 1" "sizeof(foo)" (tcall3 genBytesIn (A.Record foo) undefined undefined)
|
,testBothSame "testBytesIn 1" "sizeof(foo)" (tcall2 genBytesIn (A.Record foo) 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 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>)" (tcall3 genBytesIn (A.Chan A.DirInput (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)
|
||||||
|
|
||||||
--Array with a single known dimension:
|
--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:
|
--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:
|
--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:
|
--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:
|
--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:
|
--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:
|
--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:
|
--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
|
where
|
||||||
|
|
Loading…
Reference in New Issue
Block a user