diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index 5a76c65..ecc8bf7 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -246,24 +246,40 @@ expression <|> do {(m,op) <- monadicArithOp ; rhs <- subExpr' ; return $ A.Monadic m op rhs} <|> do {sLeftR ; e <- expression ; sRightR ; return e} -innerBlock :: RainParser A.Structured -innerBlock = do {m <- sLeftC ; lines <- linesToEnd ; return $ A.Several m lines} +data InnerBlockLineState = Decls | NoMoreDecls | Mixed deriving (Eq) + + +innerBlock :: Bool -> RainParser A.Structured +innerBlock declsMustBeFirst = do m <- sLeftC + lines <- linesToEnd (if declsMustBeFirst then Decls else Mixed) + case lines of + Left single -> return single + Right lines -> return $ A.Several m lines where wrapProc :: A.Process -> A.Structured wrapProc x = A.OnlyP (findMeta x) x - linesToEnd :: RainParser [A.Structured] - linesToEnd = do {(m,decl) <- declaration ; rest <- linesToEnd ; return [decl $ A.Several m rest]} - <|> do {st <- statement ; rest <- linesToEnd ; return $ (wrapProc st) : rest} + + makeList :: Either A.Structured [A.Structured] -> [A.Structured] + makeList (Left s) = [s] + makeList (Right ss) = ss + + --Returns either a single line (which means the immediate next line is a declaration) or a list of remaining lines + linesToEnd :: InnerBlockLineState -> RainParser (Either A.Structured [A.Structured]) + linesToEnd state + = (if state /= NoMoreDecls then do {(m,decl) <- declaration ; rest <- linesToEnd state ; return $ Left $ decl $ A.Several m (makeList rest)} else pzero) + <|> do {st <- statement ; rest <- linesToEnd nextState ; return $ Right $ (wrapProc st) : (makeList rest)} --Although return is technically a statement, we parse it here because it can only occur inside a block, --and we don't want to wrap it in an A.OnlyP: - <|> do {m <- sReturn ; exp <- expression ; sSemiColon ; rest <- linesToEnd ; - return $ (A.OnlyEL m $ A.ExpressionList (findMeta exp) [exp]) : rest} - <|> do {sRightC ; return []} + <|> do {m <- sReturn ; exp <- expression ; sSemiColon ; rest <- linesToEnd nextState ; + return $ Right $ (A.OnlyEL m $ A.ExpressionList (findMeta exp) [exp]) : (makeList rest)} + <|> do {sRightC ; return $ Right []} "statement, declaration, or end of block" + where + nextState = if state == Mixed then Mixed else NoMoreDecls block :: RainParser A.Process -block = do { optionalSeq ; b <- innerBlock ; return $ A.Seq (findMeta b) b} - <|> do { m <- sPar ; b <- innerBlock ; return $ A.Par m A.PlainPar b} +block = do { optionalSeq ; b <- innerBlock False ; return $ A.Seq (findMeta b) b} + <|> do { m <- sPar ; b <- innerBlock True ; return $ A.Par m A.PlainPar b} optionalSeq :: RainParser () optionalSeq = option () (sSeq >> return ()) diff --git a/frontends/ParseRainTest.hs b/frontends/ParseRainTest.hs index 3b7e75d..50a40cc 100644 --- a/frontends/ParseRainTest.hs +++ b/frontends/ParseRainTest.hs @@ -338,29 +338,37 @@ testPar = ,pass ("par { {} {} }",RP.statement, assertEqual "Par Skip Test" $ A.Par m A.PlainPar $ A.Several m [A.OnlyP m emptyBlock, A.OnlyP m emptyBlock] ) + + --Rain only allows declarations at the beginning of a par block: + + ,pass ("par {int:x; {} }",RP.statement, + assertEqual "Par Decl Test 0" $ A.Par m A.PlainPar $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) $ A.Several m + [A.OnlyP m $ A.Seq m $ A.Several m []] ) + + ,fail ("par { {} int: x; }",RP.statement) ] -- | Test innerBlock, particularly with declarations mixed with statements: testBlock :: [ParseTest A.Structured] testBlock = [ - pass("{ a = b; }",RP.innerBlock,assertPatternMatch "testBlock 0" (tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b"]) ) - ,pass("{ a = b; b = c; }",RP.innerBlock,assertPatternMatch "testBlock 1" (tag2 A.Several DontCare + pass("{ a = b; }",RP.innerBlock False,assertPatternMatch "testBlock 0" (tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b"]) ) + ,pass("{ a = b; b = c; }",RP.innerBlock False,assertPatternMatch "testBlock 1" (tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b",tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c"]) ) - ,pass("{ uint8: x; a = b; }",RP.innerBlock,assertPatternMatch "testBlock 2" $ tag2 A.Several DontCare [tag3 A.Spec DontCare + ,pass("{ uint8: x; a = b; }",RP.innerBlock False,assertPatternMatch "testBlock 2" $ tag3 A.Spec DontCare (tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte) $ tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b"] - ]) - ,pass("{ uint8: x; a = b; b = c; }",RP.innerBlock,assertPatternMatch "testBlock 3" $ tag2 A.Several DontCare [tag3 A.Spec DontCare + ) + ,pass("{ uint8: x; a = b; b = c; }",RP.innerBlock False,assertPatternMatch "testBlock 3" $ tag3 A.Spec DontCare (tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte) $ tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b",tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c"] - ]) - ,pass("{ b = c; uint8: x; a = b; }",RP.innerBlock,assertPatternMatch "testBlock 4" $ tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c", + ) + ,pass("{ b = c; uint8: x; a = b; }",RP.innerBlock False,assertPatternMatch "testBlock 4" $ tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c", tag3 A.Spec DontCare (tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte) $ tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b"] ]) - ,fail("{b}",RP.innerBlock) + ,fail("{b}",RP.innerBlock False) ] testEach :: [ParseTest A.Process]