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

Changed the existing Rain code (and tests) to use the new List type rather than the Array type

Browse Source
This commit is contained in:
Neil Brown 2007-10-25 10:13:17 +00:00
parent a6cbdfeb94
commit 25f2efb94c
6 changed files with 25 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
common/TestUtil.hs
View File

@ -169,8 +169,8 @@ makeAssignPattern :: Pattern -> Pattern -> Pattern
makeAssignPattern v e = tag3 A.Assign DontCare [v] $ tag2 A.ExpressionList DontCare [e]
-- | Creates a literal string expression from the given 'String'.
makeLiteralString :: String -> A.Expression
makeLiteralString str = A.Literal emptyMeta (A.Array [A.Dimension (length str)] A.Byte) (A.ArrayLiteral emptyMeta (map makeLiteralChar str))
makeLiteralStringRain :: String -> A.Expression
makeLiteralStringRain str = A.Literal emptyMeta (A.List A.Byte) (A.ArrayLiteral emptyMeta (map makeLiteralChar str))
where
makeLiteralChar :: Char -> A.ArrayElem
makeLiteralChar c = A.ArrayElemExpr $ A.Literal emptyMeta A.Byte (A.ByteLiteral emptyMeta [c] {-(show (fromEnum c))-})
@ -178,8 +178,8 @@ makeLiteralString str = A.Literal emptyMeta (A.Array [A.Dimension (length str)]
-- | Creates a 'Pattern' to match an 'A.Expression' instance.
-- @'assertPatternMatch' ('makeLiteralStringPattern' x) ('makeLiteralString' x)@ will always succeed.
-- All meta tags are ignored
makeLiteralStringPattern :: String -> Pattern
makeLiteralStringPattern = (stopCaringPattern emptyMeta) . mkPattern . makeLiteralString
makeLiteralStringRainPattern :: String -> Pattern
makeLiteralStringRainPattern = (stopCaringPattern emptyMeta) . mkPattern . makeLiteralStringRain
-- | Creates a 'Pattern' to match an 'A.Expression' instance.
-- All meta tags are ignored

2
frontends/ParseRain.hs
View File

@ -200,7 +200,7 @@ integerLiteral :: RainParser A.Expression
integerLiteral = do {i <- integer ; return $ A.Literal (findMeta i) A.Int i}
literal :: RainParser A.Expression
literal = do {(lr, dim) <- stringLiteral ; return $ A.Literal (findMeta lr) (A.Array [dim] A.Byte) lr }
literal = do {(lr, dim) <- stringLiteral ; return $ A.Literal (findMeta lr) (A.List A.Byte) lr }
<|> do {c <- literalCharacter ; return $ A.Literal (findMeta c) A.Byte c}
<|> integerLiteral
<|> do {m <- reserved "true" ; return $ A.True m}

12
frontends/ParseRainTest.hs
View File

@ -195,10 +195,10 @@ testLiteral =
,fail ("FALSE",RP.literal)
--Strings:
,pass ("\"\"", RP.literal, assertPatternMatch "testLiteral 201" $ makeLiteralStringPattern "")
,pass ("\"abc\"", RP.literal, assertPatternMatch "testLiteral 202" $ makeLiteralStringPattern "abc")
,pass ("\"abc\\n\"", RP.literal, assertPatternMatch "testLiteral 203" $ makeLiteralStringPattern "abc\n")
,pass ("\"a\\\"bc\"", RP.literal, assertPatternMatch "testLiteral 204" $ makeLiteralStringPattern "a\"bc")
,pass ("\"\"", RP.literal, assertPatternMatch "testLiteral 201" $ makeLiteralStringRainPattern "")
,pass ("\"abc\"", RP.literal, assertPatternMatch "testLiteral 202" $ makeLiteralStringRainPattern "abc")
,pass ("\"abc\\n\"", RP.literal, assertPatternMatch "testLiteral 203" $ makeLiteralStringRainPattern "abc\n")
,pass ("\"a\\\"bc\"", RP.literal, assertPatternMatch "testLiteral 204" $ makeLiteralStringRainPattern "a\"bc")
,fail ("\"",RP.literal)
,fail ("\"\"\"",RP.literal)
,fail ("a\"\"",RP.literal)
@ -372,10 +372,10 @@ testEach :: [ParseTest A.Process]
testEach =
[
pass ("seqeach (c : \"1\") par {c = 7;}", RP.statement,
assertPatternMatch "Each Test 0" (stopCaringPattern m $ mkPattern $ A.Seq m $ A.Rep m (A.ForEach m (simpleName "c") (makeLiteralString "1")) $
assertPatternMatch "Each Test 0" (stopCaringPattern m $ mkPattern $ A.Seq m $ A.Rep m (A.ForEach m (simpleName "c") (makeLiteralStringRain "1")) $
A.OnlyP m $ makePar [(makeAssign (variable "c") (A.Literal m A.Int (A.IntLiteral m "7")))] ))
,pass ("pareach (c : \"345\") {c = 1; c = 2;}", RP.statement,
assertEqual "Each Test 1" $ A.Par m A.PlainPar $ A.Rep m (A.ForEach m (simpleName "c") (makeLiteralString "345")) $
assertEqual "Each Test 1" $ A.Par m A.PlainPar $ A.Rep m (A.ForEach m (simpleName "c") (makeLiteralStringRain "345")) $
A.OnlyP m $ makeSeq[(makeAssign (variable "c") (A.Literal m A.Int (A.IntLiteral m "1"))),(makeAssign (variable "c") (A.Literal m A.Int (A.IntLiteral m "2")))] )
]

2
frontends/RainPasses.hs
View File

@ -235,7 +235,7 @@ transformRangeRep = everywhereM (mkM transformRangeRep')
transformRangeRep'' :: Meta -> Integer -> Integer -> PassM A.Expression
transformRangeRep'' m begin end
= if (end < begin)
then return $ A.Literal m (A.Array [A.Dimension 0] A.Int) $ A.ArrayLiteral m []
then dieP m $ "End of range is before beginning: " ++ show begin ++ " > " ++ show end
else do A.Specification _ rep _ <- makeNonceVariable "rep_constr" m A.Int A.VariableName A.ValAbbrev
let count = end - begin + 1
return $ A.ExprConstr m $ A.RepConstr m

23
frontends/RainPassesTest.hs
View File

@ -51,13 +51,13 @@ testEachPass0 = TestCase $ testPassWithItemsStateCheck "testEachPass0" exp (tran
orig = A.Seq m
(A.Rep m
(A.ForEach m (simpleName "c") (makeLiteralString "1"))
(A.ForEach m (simpleName "c") (makeLiteralStringRain "1"))
(A.OnlyP m (makeAssign (variable "c") (intLiteral 7)))
)
exp = tag2 A.Seq DontCare
(tag3 A.Spec DontCare
(tag3 A.Specification DontCare listVarName
(tag4 A.IsExpr DontCare A.ValAbbrev (A.Array [A.Dimension 1] A.Byte) (makeLiteralString "1"))
(tag4 A.IsExpr DontCare A.ValAbbrev (A.List A.Byte) (makeLiteralStringRain "1"))
)
(tag3 A.Rep DontCare
(tag4 A.For DontCare indexVar (intLiteral 0) (tag2 A.SizeVariable DontCare listVar))
@ -88,15 +88,15 @@ testEachPass0 = TestCase $ testPassWithItemsStateCheck "testEachPass0" exp (tran
Nothing -> assertFailure "testEachPass0: Internal error, indexVar not found"
case castADI (Map.lookup "listVarName" items) of
Just listVarName -> assertVarDef "testEachPass0" st (A.nameName listVarName)
(simpleDefPattern (A.nameName listVarName) A.ValAbbrev (tag4 A.IsExpr DontCare A.ValAbbrev (A.Array [A.Dimension 1] A.Byte) (makeLiteralStringPattern "1") ))
(simpleDefPattern (A.nameName listVarName) A.ValAbbrev (tag4 A.IsExpr DontCare A.ValAbbrev (A.List A.Byte) (makeLiteralStringRainPattern "1") ))
Nothing -> assertFailure "testEachPass0: Internal error, listVarName not found"
testEachPass1 :: Test
testEachPass1 = TestCase $ testPassWithItemsStateCheck "testEachPass0" exp (transformEach orig) startState' check
where
startState' :: State CompState ()
startState' = do defineName (simpleName "c") $ simpleDef "c" (A.Declaration m A.Byte Nothing)
defineName (simpleName "d") $ simpleDef "d" (A.Declaration m (A.Array [A.Dimension 10] A.Byte) Nothing)
startState' = do defineName (simpleName "c") $ simpleDef "c" (A.Declaration m A.Byte)
defineName (simpleName "d") $ simpleDef "d" (A.Declaration m (A.Array [A.Dimension 10] A.Byte))
orig = A.Par m A.PlainPar
(A.Rep m
@ -266,7 +266,7 @@ testUnique4 = TestCase $ testPassWithItemsStateCheck "testUnique4" exp (uniquify
testRecordInfNames0 :: Test
testRecordInfNames0 = TestCase $ testPassWithStateCheck "testRecordInfNames0" exp (recordInfNameTypes orig) (return ()) check
where
orig = (A.Rep m (A.ForEach m (simpleName "c") (makeLiteralString "hello")) skipP)
orig = (A.Rep m (A.ForEach m (simpleName "c") (makeLiteralStringRain "hello")) skipP)
exp = orig
check state = assertVarDef "testRecordInfNames0" state "c"
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m A.Byte Nothing) A.Original A.Unplaced)
@ -276,7 +276,7 @@ testRecordInfNames1 :: Test
testRecordInfNames1 = TestCase $ testPassWithStateCheck "testRecordInfNames1" exp (recordInfNameTypes orig) (startState') check
where
startState' :: State CompState ()
startState' = do defineName (simpleName "str") $ simpleDef "str" (A.Declaration m (A.Array [A.Dimension 10] A.Byte) Nothing)
startState' = do defineName (simpleName "str") $ simpleDef "str" (A.Declaration m (A.Array [A.Dimension 10] A.Byte))
orig = (A.Rep m (A.ForEach m (simpleName "c") (exprVariable "str")) skipP)
exp = orig
check state = assertVarDef "testRecordInfNames1" state "c"
@ -287,12 +287,12 @@ testRecordInfNames2 :: Test
testRecordInfNames2 = TestCase $ testPassWithStateCheck "testRecordInfNames2" exp (recordInfNameTypes orig) (startState') check
where
startState' :: State CompState ()
startState' = do defineName (simpleName "multi") $ simpleDef "multi" (A.Declaration m (A.Array [A.Dimension 10, A.Dimension 20] A.Byte) Nothing)
startState' = do defineName (simpleName "multi") $ simpleDef "multi" (A.Declaration m (A.Array [A.Dimension 10, A.Dimension 20] A.Byte))
orig = A.Rep m (A.ForEach m (simpleName "c") (exprVariable "multi")) $
A.OnlyP m $ A.Seq m $ A.Rep m (A.ForEach m (simpleName "d") (exprVariable "c")) skipP
exp = orig
check state = do assertVarDef "testRecordInfNames2" state "c"
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m (A.Array [A.Dimension 20] A.Byte) Nothing) A.Original A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m (A.Array [A.Dimension 20] A.Byte)) A.Original A.Unplaced)
assertVarDef "testRecordInfNames2" state "d"
(tag7 A.NameDef DontCare "d" "d" A.VariableName (A.Declaration m A.Byte Nothing) A.Original A.Unplaced)
@ -453,12 +453,11 @@ testRangeRepPass0 = TestCase $ testPass "testRangeRepPass0" exp (transformRangeR
exp = tag2 A.ExprConstr DontCare $ tag3 A.RepConstr DontCare (tag4 A.For DontCare (Named "repIndex" DontCare) (intLiteral 0) (intLiteral 2))
(tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare $ Named "repIndex" DontCare)
-- | Lists with negative counts should be turned into an empty literal list
-- | Lists with negative counts should give an error
testRangeRepPass1 :: Test
testRangeRepPass1 = TestCase $ testPass "testRangeRepPass1" exp (transformRangeRep orig) (return())
testRangeRepPass1 = TestCase $ testPassShouldFail "testRangeRepPass1" (transformRangeRep orig) (return())
where
orig = A.ExprConstr m $ A.RangeConstr m (intLiteral 1) (intLiteral 0)
exp = A.Literal m (A.Array [A.Dimension 0] A.Int) $ A.ArrayLiteral m []
--TODO consider/test pulling up the definitions of variables involved in return statements in functions

7
frontends/RainTypes.hs
View File

@ -39,11 +39,8 @@ recordInfNameTypes = everywhereM (mkM recordInfNameTypes')
recordInfNameTypes' input@(A.ForEach m n e)
= do arrType <- typeOfExpression e
innerT <- case arrType of
A.Array (_:innerDims) t ->
return $ case innerDims of
[] -> t
_ -> A.Array innerDims t
_ -> dieP m "Cannot do a foreach loop over a non-array type (or array with zero dimensions)"
A.List t -> return t
_ -> diePC m $ formatCode "Cannot do a foreach loop over a non-list type: %" arrType
defineName n A.NameDef {A.ndMeta = m, A.ndName = A.nameName n, A.ndOrigName = A.nameName n,
A.ndNameType = A.VariableName, A.ndType = (A.Declaration m innerT Nothing),
A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced}