Changed the type of genBytesIn again, to remove redundancy in its parameters

This commit is contained in:
Neil Brown 2007-10-13 16:16:52 +00:00
parent a98ff8cad0
commit c74ae12810
3 changed files with 34 additions and 32 deletions

View File

@ -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,12 +417,12 @@ 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"
(1,True) -> return () (1,True) -> return ()
@ -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"]

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) 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 [","]

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 = 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