diff --git a/common/TestUtil.hs b/common/TestUtil.hs index 3caca07..8536ce6 100644 --- a/common/TestUtil.hs +++ b/common/TestUtil.hs @@ -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 diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index 0608c13..c09bfda 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -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} diff --git a/frontends/ParseRainTest.hs b/frontends/ParseRainTest.hs index 23c99d8..ed813ea 100644 --- a/frontends/ParseRainTest.hs +++ b/frontends/ParseRainTest.hs @@ -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")))] ) ] diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index 4c69e9d..7b0b5a6 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -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 diff --git a/frontends/RainPassesTest.hs b/frontends/RainPassesTest.hs index 1aa8906..7546215 100644 --- a/frontends/RainPassesTest.hs +++ b/frontends/RainPassesTest.hs @@ -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 diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs index 9a21324..e4ba4e6 100644 --- a/frontends/RainTypes.hs +++ b/frontends/RainTypes.hs @@ -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}