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

Helper function for "sequence_ $ intersperse genComma"

Browse Source
This commit is contained in:
Adam Sampson 2007-05-16 19:39:04 +00:00
parent d5766c5fe5
commit b6537890e0
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
fco2/GenerateC.hs
View File

@ -60,6 +60,9 @@ missing s = tell ["\n#error Unimplemented: ", s, "\n"]
genComma :: CGen () genComma :: CGen ()
genComma = tell [", "] genComma = tell [", "]
seqComma :: [CGen ()] -> CGen ()
seqComma ps = sequence_ $ intersperse genComma ps
genLeftB :: CGen () genLeftB :: CGen ()
genLeftB = tell ["{ "] genLeftB = tell ["{ "]
@ -323,7 +326,7 @@ genLiteralRepr (A.ArrayLiteral m aes)
genRightB genRightB
genLiteralRepr (A.RecordLiteral _ es) genLiteralRepr (A.RecordLiteral _ es)
= do genLeftB = do genLeftB
sequence_ $ intersperse genComma $ map genUnfoldedExpression es seqComma $ map genUnfoldedExpression es
genRightB genRightB
-- | Generate an expression inside a record literal. -- | Generate an expression inside a record literal.
@ -363,8 +366,8 @@ genUnfoldedVariable m var
A.Record _ -> A.Record _ ->
do genLeftB do genLeftB
fs <- recordFields m t fs <- recordFields m t
sequence_ $ intersperse genComma [genUnfoldedVariable m (A.SubscriptedVariable m (A.SubscriptField m n) var) seqComma [genUnfoldedVariable m (A.SubscriptedVariable m (A.SubscriptField m n) var)
| (n, t) <- fs] | (n, t) <- fs]
genRightB genRightB
-- We can defeat the usage check here because we know it's safe; *we're* -- We can defeat the usage check here because we know it's safe; *we're*
-- generating the subscripts. -- generating the subscripts.
@ -374,8 +377,8 @@ genUnfoldedVariable m var
unfoldArray :: [A.Dimension] -> A.Variable -> CGen () unfoldArray :: [A.Dimension] -> A.Variable -> CGen ()
unfoldArray [] v = genUnfoldedVariable m v unfoldArray [] v = genUnfoldedVariable m v
unfoldArray (A.Dimension n:ds) v unfoldArray (A.Dimension n:ds) v
= sequence_ $ intersperse genComma $ [unfoldArray ds (A.SubscriptedVariable m (A.Subscript m $ makeConstant m i) v) = seqComma $ [unfoldArray ds (A.SubscriptedVariable m (A.Subscript m $ makeConstant m i) v)
| i <- [0..(n - 1)]] | i <- [0..(n - 1)]]
unfoldArray _ _ = dieP m "trying to unfold array with unknown dimension" unfoldArray _ _ = dieP m "trying to unfold array with unknown dimension"
-- | Generate a decimal literal -- removing leading zeroes to avoid producing -- | Generate a decimal literal -- removing leading zeroes to avoid producing
@ -388,7 +391,7 @@ genDecimal s = tell [s]
genArrayLiteralElems :: [A.ArrayElem] -> CGen () genArrayLiteralElems :: [A.ArrayElem] -> CGen ()
genArrayLiteralElems aes genArrayLiteralElems aes
= sequence_ $ intersperse genComma $ map genElem aes = seqComma $ map genElem aes
where where
genElem :: A.ArrayElem -> CGen () genElem :: A.ArrayElem -> CGen ()
genElem (A.ArrayElemArray aes) = genArrayLiteralElems aes genElem (A.ArrayElemArray aes) = genArrayLiteralElems aes
@ -891,7 +894,7 @@ genRetypeSizes m am destT destN srcT srcV
die "genRetypeSizes expecting free dimension" die "genRetypeSizes expecting free dimension"
A.Dimension n -> tell [show n] A.Dimension n -> tell [show n]
| d <- destDS] | d <- destDS]
genArraySize False (sequence_ $ intersperse genComma dims) destN genArraySize False (seqComma dims) destN
-- Not array; just check the size is 1. -- Not array; just check the size is 1.
_ -> _ ->
@ -969,7 +972,7 @@ declareArraySizes ds name
-- dimensions are fixed. -- dimensions are fixed.
genArraySizesLiteral :: [A.Dimension] -> CGen () genArraySizesLiteral :: [A.Dimension] -> CGen ()
genArraySizesLiteral ds genArraySizesLiteral ds
= sequence_ $ intersperse genComma dims = seqComma dims
where where
dims :: [CGen ()] dims :: [CGen ()]
dims = [case d of dims = [case d of
@ -1083,7 +1086,7 @@ introduceSpec (A.Specification _ n (A.IsChannelArray _ t cs))
= do tell ["Channel *"] = do tell ["Channel *"]
genName n genName n
tell ["[] = {"] tell ["[] = {"]
sequence_ $ intersperse genComma (map genVariable cs) seqComma (map genVariable cs)
tell ["};\n"] tell ["};\n"]
declareArraySizes [A.Dimension $ length cs] n declareArraySizes [A.Dimension $ length cs] n
introduceSpec (A.Specification _ _ (A.DataType _ _)) = return () introduceSpec (A.Specification _ _ (A.DataType _ _)) = return ()
@ -1111,8 +1114,7 @@ introduceSpec (A.Specification _ n (A.RecordType _ b fs))
introduceSpec (A.Specification _ n (A.Protocol _ _)) = return () introduceSpec (A.Specification _ n (A.Protocol _ _)) = return ()
introduceSpec (A.Specification _ n (A.ProtocolCase _ ts)) introduceSpec (A.Specification _ n (A.ProtocolCase _ ts))
= do tell ["typedef enum {\n"] = do tell ["typedef enum {\n"]
sequence_ $ intersperse genComma [genName tag >> tell ["_"] >> genName n seqComma [genName tag >> tell ["_"] >> genName n | (tag, _) <- ts]
| (tag, _) <- ts]
-- You aren't allowed to have an empty enum. -- You aren't allowed to have an empty enum.
when (ts == []) $ when (ts == []) $
tell ["empty_protocol_"] >> genName n tell ["empty_protocol_"] >> genName n