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

Rain: changed the innerBlock parser to work with the new rules for declarations in par blocks, and also simplified its output slightly

Browse Source
This commit is contained in:
Neil Brown 2007-09-14 12:22:12 +00:00
parent 59d86a0afc
commit ff9b0d6611
2 changed files with 42 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
frontends/ParseRain.hs
View File

@ -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 ())

24
frontends/ParseRainTest.hs
View File

@ -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]