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

Fixed some more Rain tests related to the old method of inferring types

Browse Source
This commit is contained in:
Neil Brown 2008-06-01 17:21:14 +00:00
parent 155f58c174
commit d4938a166c
2 changed files with 16 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
frontends/RainPassesTest.hs
View File

@ -212,7 +212,8 @@ testRecordInfNames0 = TestCase $ testPassWithStateCheck "testRecordInfNames0" ex
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 ) A.Abbrev A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName
(A.Declaration m $ A.UnknownVarType $ Left $ simpleName "c") A.Abbrev A.Unplaced)
-- | checks that c's type is recorded in: ***each (c : str) {}, where str is known to be of type string
testRecordInfNames1 :: Test
@ -223,7 +224,8 @@ testRecordInfNames1 = TestCase $ testPassWithStateCheck "testRecordInfNames1" ex
orig = (A.Rep m (A.ForEach m (simpleName "c") (exprVariable "str")) skipP)
exp = orig
check state = assertVarDef "testRecordInfNames1" state "c"
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m A.Byte ) A.Abbrev A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName
(A.Declaration m $ A.UnknownVarType $ Left $ simpleName "c") A.Abbrev A.Unplaced)
-- | checks that c's and d's type are recorded in: ***each (c : multi) { seqeach (d : c) {} } where multi is known to be of type [string]
testRecordInfNames2 :: Test
@ -235,15 +237,13 @@ testRecordInfNames2 = TestCase $ testPassWithStateCheck "testRecordInfNames2" ex
A.Only 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.List A.Byte) ) A.Abbrev A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName
(A.Declaration m $ A.UnknownVarType $ Left $ simpleName
"c") A.Abbrev A.Unplaced)
assertVarDef "testRecordInfNames2" state "d"
(tag7 A.NameDef DontCare "d" "d" A.VariableName (A.Declaration m A.Byte ) A.Abbrev A.Unplaced)
-- | checks that doing a foreach over a non-array type is barred:
testRecordInfNames3 :: Test
testRecordInfNames3 = TestCase $ testPassShouldFail "testRecordInfNames3" (recordInfNameTypes orig) (return ())
where
orig = A.Rep m (A.ForEach m (simpleName "c") (intLiteral 0)) skipP
(tag7 A.NameDef DontCare "d" "d" A.VariableName
(A.Declaration m $ A.UnknownVarType $ Left $ simpleName
"d") A.Abbrev A.Unplaced)
--Easy way to string two passes together; creates a pass-like function that applies the left-hand pass then the right-hand pass. Associative.
(>>>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
@ -455,7 +455,6 @@ tests = TestLabel "RainPassesTest" $ TestList
,testRecordInfNames0
,testRecordInfNames1
,testRecordInfNames2
,testRecordInfNames3
,testFindMain0
,testFindMain1
,testFindMain2

13
frontends/RainTypes.hs
View File

@ -138,16 +138,15 @@ substituteUnknownTypes mt = applyDepthM sub
-- | A pass that records inferred types. Currently the only place where types are inferred is in seqeach\/pareach loops.
recordInfNameTypes :: PassType
recordInfNameTypes = applyDepthM recordInfNameTypes'
recordInfNameTypes = checkDepthM recordInfNameTypes'
where
recordInfNameTypes' :: A.Replicator -> PassM A.Replicator
recordInfNameTypes' :: Check A.Replicator
recordInfNameTypes' input@(A.ForEach m n e)
= do let innerT = A.UnknownVarType $ Left n
defineName n A.NameDef {A.ndMeta = m, A.ndName = A.nameName n, A.ndOrigName = A.nameName n,
A.ndNameType = A.VariableName, A.ndSpecType = (A.Declaration m innerT),
= let innerT = A.UnknownVarType $ Left n in
defineName n A.NameDef {A.ndMeta = m, A.ndName = A.nameName n, A.ndOrigName = A.nameName n,
A.ndNameType = A.VariableName, A.ndSpecType = A.Declaration m innerT,
A.ndAbbrevMode = A.Abbrev, A.ndPlacement = A.Unplaced}
return input
recordInfNameTypes' r = return r
recordInfNameTypes' _ = return ()
markReplicators :: PassType
markReplicators = checkDepthM mark