diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index 153ad71..26c3972 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -835,6 +835,9 @@ introduceSpec (A.Specification _ n (A.ProtocolCase _ ts)) = do tell ["typedef enum {\n"] sequence_ $ intersperse genComma [genName tag >> tell ["_"] >> genName n | (tag, _) <- ts] + -- You aren't allowed to have an empty enum. + when (ts == []) $ + tell ["empty_protocol_"] >> genName n tell ["\n"] tell ["} "] genName n diff --git a/fco2/Parse.hs b/fco2/Parse.hs index e14646f..36b23c9 100644 --- a/fco2/Parse.hs +++ b/fco2/Parse.hs @@ -379,6 +379,18 @@ maybeSliced inner subscripter typer fromOrFor = (sFROM >> return "FROM") <|> (sFOR >> return "FOR") --}}} +-- | Parse an optional indented list, where if it's not there we should issue a +-- warning. (This is for things that are legal in the occam spec, but are +-- almost certainly programmer errors.) +maybeIndentedList :: Meta -> String -> OccParser t -> OccParser [t] +maybeIndentedList m msg inner + = do try indent + vs <- many1 inner + outdent + return vs + <|> do addWarning m msg + return [] + handleSpecs :: OccParser [A.Specification] -> OccParser a -> (Meta -> A.Specification -> a -> a) -> OccParser a handleSpecs specs inner specMarker = do m <- md @@ -1152,7 +1164,7 @@ definition sPROTOCOL n <- newProtocolName do { sIS; p <- sequentialProtocol; sColon; eol; return $ A.Specification m n $ A.Protocol m p } - <|> do { eol; indent; sCASE; eol; indent; ps <- many1 taggedProtocol; outdent; outdent; sColon; eol; return $ A.Specification m n $ A.ProtocolCase m ps } + <|> do { eol; indent; sCASE; eol; ps <- maybeIndentedList m "empty CASE protocol" taggedProtocol; outdent; sColon; eol; return $ A.Specification m n $ A.ProtocolCase m ps } <|> do m <- md -- FIXME INLINE is ignored. sPROC <|> (tryXX sINLINE sPROC) @@ -1393,9 +1405,7 @@ caseInput = do m <- md c <- tryVX channel (do {sQuest; sCASE; eol}) nts <- caseInputItems c - indent - vs <- many1 (variant nts) - outdent + vs <- maybeIndentedList m "empty ? CASE" (variant nts) return $ A.Input m c (A.InputCase m (A.Several m vs)) "case input" @@ -1463,7 +1473,7 @@ seqProcess :: OccParser A.Process seqProcess = do m <- md sSEQ - do { eol; indent; ps <- many1 process; outdent; return $ A.Seq m ps } + do { eol; ps <- maybeIndentedList m "empty SEQ" process; return $ A.Seq m ps } <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; p <- process; scopeOutRep r'; outdent; return $ A.SeqRep m r' p } "SEQ process" --}}} @@ -1479,7 +1489,7 @@ conditional :: OccParser A.Structured conditional = do m <- md sIF - do { eol; indent; cs <- many1 ifChoice; outdent; return $ A.Several m cs } + do { eol; cs <- maybeIndentedList m "empty IF" ifChoice; return $ A.Several m cs } <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; c <- ifChoice; scopeOutRep r'; outdent; return $ A.Rep m r' c } "conditional" @@ -1510,9 +1520,7 @@ caseProcess t <- typeOfExpression sel when (not $ isIntegerType t) $ fail "case selector has non-CASEable type" eol - indent - os <- many1 (caseOption t) - outdent + os <- maybeIndentedList m "empty CASE" (caseOption t) return $ A.Case m sel (A.Several m os) "CASE process" @@ -1553,7 +1561,7 @@ parallel :: OccParser A.Process parallel = do m <- md isPri <- parKeyword - do { eol; indent; ps <- many1 process; outdent; return $ A.Par m isPri ps } + do { eol; ps <- maybeIndentedList m "empty PAR" process; return $ A.Par m isPri ps } <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; p <- process; scopeOutRep r'; outdent; return $ A.ParRep m isPri r' p } <|> placedpar "PAR process" @@ -1568,7 +1576,7 @@ placedpar :: OccParser A.Process placedpar = do m <- md tryXX sPLACED sPAR - do { eol; indent; ps <- many1 placedpar; outdent; return $ A.Par m A.PlacedPar ps } + do { eol; ps <- maybeIndentedList m "empty PLACED PAR" placedpar; return $ A.Par m A.PlacedPar ps } <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; p <- placedpar; scopeOutRep r'; outdent; return $ A.ParRep m A.PlacedPar r' p } <|> do m <- md sPROCESSOR @@ -1592,7 +1600,7 @@ alternation :: OccParser (Bool, A.Structured) alternation = do m <- md isPri <- altKeyword - do { eol; indent; as <- many1 alternative; outdent; return (isPri, A.Several m as) } + do { eol; as <- maybeIndentedList m "empty ALT" alternative; return (isPri, A.Several m as) } <|> do { r <- replicator; eol; indent; r' <- scopeInRep r; a <- alternative; scopeOutRep r'; outdent; return (isPri, A.Rep m r' a) } "alternation" @@ -1615,17 +1623,13 @@ alternative (b, c) <- tryVXVXX booleanExpr sAmp channel sQuest sCASE nts <- caseInputItems c eol - indent - vs <- many1 (variant nts) - outdent + vs <- maybeIndentedList m "empty ? CASE" (variant nts) return $ A.OnlyA m (A.AlternativeCond m b c (A.InputCase m $ A.Several m vs) (A.Skip m)) <|> do m <- md c <- tryVXX channel sQuest sCASE nts <- caseInputItems c eol - indent - vs <- many1 (variant nts) - outdent + vs <- maybeIndentedList m "empty ? CASE" (variant nts) return $ A.OnlyA m (A.Alternative m c (A.InputCase m $ A.Several m vs) (A.Skip m)) <|> guardedAlternative <|> handleSpecs specification alternative A.Spec diff --git a/fco2/Pass.hs b/fco2/Pass.hs index e23b5aa..e2bf479 100644 --- a/fco2/Pass.hs +++ b/fco2/Pass.hs @@ -46,7 +46,7 @@ warn = verboseMessage 0 showWarnings :: (PSM m, MonadIO m) => m () showWarnings = do ps <- get - sequence_ $ map warn (psWarnings ps) + sequence_ $ map warn (reverse $ psWarnings ps) put $ ps { psWarnings = [] } -- | Print a progress message. diff --git a/fco2/testcases/empties.occ b/fco2/testcases/empties.occ new file mode 100644 index 0000000..024292b --- /dev/null +++ b/fco2/testcases/empties.occ @@ -0,0 +1,19 @@ +PROTOCOL FOO + CASE +: +PROC P () + CHAN OF FOO c: + INT n: + SEQ + SEQ + PAR + IF + c ? CASE + n := 0 + CASE n + PLACED PAR + ALT + ALT + TRUE & c ? CASE + c ? CASE +: