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

Altered the code and the tests for declareSizesArray to approach what it should be doing

Browse Source
This commit is contained in:
Neil Brown 2008-03-03 17:50:57 +00:00
parent 81ea069707
commit 41303eb993
2 changed files with 71 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
backends/BackendPasses.hs
View File

@ -26,6 +26,7 @@ import qualified Data.Set as Set
import qualified AST as A
import CompState
import Pass
import Types
-- | Identify processes that we'll need to compute the stack size of.
identifyParProcs :: Data t => t -> PassM t
@ -77,8 +78,45 @@ transformWaitFor = doGeneric `extM` doAlt
-- | Declares a _sizes array for every array, statically sized or dynamically sized.
-- For each record type it declares a _sizes array too.
-- TODO must make sure that each expression is already pulled out into a variable
declareSizesArray :: Data t => t -> PassM t
declareSizesArray = return -- TODO
declareSizesArray = doGeneric `ext1M` doStructured
where
append_sizes :: A.Name -> A.Name
append_sizes n = n {A.nameName = A.nameName n ++ "_sizes"}
doGeneric :: Data t => t -> PassM t
doGeneric = makeGeneric declareSizesArray
doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
doStructured str@(A.Spec m sp@(A.Specification m' n spec) s)
= do t <- typeOfSpec spec
case t of
Just (A.Array ds _) -> if elem A.UnknownDimension ds
then do let sizeSpec = A.Specification m' (append_sizes n) (A.Declaration m' (A.Array [A.Dimension $ length ds] A.Int) Nothing)
return (A.Spec m sp $ A.Spec m sizeSpec $ s) -- TODO fix this
else do let n_sizes = append_sizes n
sizeType = A.Array [A.Dimension $ length ds] A.Int
sizeLit = A.Literal m' sizeType $ A.ArrayLiteral m' $
map (A.ArrayElemExpr . A.Literal m' A.Int . A.IntLiteral m' . show . \(A.Dimension d) -> d) ds
sizeSpecType = A.IsExpr m' A.ValAbbrev sizeType sizeLit
sizeSpec = A.Specification m' n_sizes sizeSpecType
defineName n_sizes $ A.NameDef {
A.ndMeta = m'
,A.ndName = A.nameName n_sizes
,A.ndOrigName = A.nameName n_sizes
,A.ndNameType = A.VariableName
,A.ndType = sizeSpecType
,A.ndAbbrevMode = A.ValAbbrev
,A.ndPlacement = A.Unplaced}
return (A.Spec m sp $ A.Spec m sizeSpec $ s)
_ -> return str
doStructured s = doGeneric s
--TODO add a pass for adding _sizes parameters to PROC arguments
-- | Flattens all multi-dimensional arrays into one-dimensional arrays, transforming all indexes
-- as appropriate.

69
backends/BackendPassesTest.hs
View File

@ -22,7 +22,6 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
module BackendPassesTest (tests) where
import Control.Monad.State
import Data.Generics
import qualified Data.Map as Map
import Test.HUnit hiding (State)
@ -147,70 +146,66 @@ testTransformWaitFor5 = TestCase $ testPass "testTransformWaitFor5" exp (transfo
testDeclareSizes :: Test
testDeclareSizes = TestList
[
testFooVal 0 [4]
,testFooVal 1 [4,5]
,testFooVal 2 [4,5,6,7,8]
testFoo 0 $ declFoo [4]
,testFoo 1 $ declFoo [4,5]
,testFoo 2 $ declFoo [4,5,6,7,8]
,testFoo 10 $ isChanArrFoo 1
,testFoo 11 $ isChanArrFoo 2
,testFoo 12 $ isChanArrFoo 3
{-
,testFooDecl 10 [Nothing]
,testFooDecl 11 [Just 4, Nothing]
,testFooDecl 12 [Nothing, Nothing]
,testFooDecl 13 [Nothing, Nothing, Nothing, Nothing]
,testFooDecl 14 [Nothing, Just 5, Just 6]
,testFooDecl 15 [Just 4, Nothing, Just 5, Nothing, Nothing]
-}
--TODO test that arrays that are abbreviations (Is and IsExpr) also get _sizes arrays, and that they are initialised correctly
--TODO test records getting sizes arrays
--TODO test reshapes/retypes abbreviations
]
where
-- Tests static arrays (where the _sizes will be a val abbrev)
testFooVal :: Int -> [Int] -> Test
testFooVal n ns = test n (declFoo t $ valFooSizes ns $ term) (declFoo t term) (checkValFooSizes ns)
-- spectype of foo, spectype of foo_sizes
testFoo :: Int -> (A.SpecType, A.SpecType, State CompState ()) -> Test
testFoo n (fooSpec, fooSizesSpec, st) = test n
(strFoo $ strFooSizes term)
(strFoo term) st (checkFooSizes fooSizesSpec)
where
strFoo = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo") fooSpec)
strFooSizes = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") fooSizesSpec)
isChanArrFoo :: Int -> (A.SpecType, A.SpecType, State CompState ())
isChanArrFoo n = (A.IsChannelArray emptyMeta (A.Array [A.Dimension n] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Byte) (replicate n $ variable "c")
,valFoo [n], return ())
declFoo :: [Int] -> (A.SpecType, A.SpecType, State CompState ())
declFoo ns = (A.Declaration emptyMeta t Nothing, valFoo ns, return ())
where
t = A.Array (map A.Dimension ns) A.Byte
-- Tests non-static arrays (where the _sizes will be declared but not initialised)
testFooDecl :: Int -> [Maybe Int] -> Test
testFooDecl n ns = test n (declFoo t $ declFooSizes (length ns) $ term) (declFoo t term) (checkDeclFooSizes $ length ns)
where
t = A.Array (map (maybe A.UnknownDimension A.Dimension) ns) A.Byte
declFoo :: Data a => A.Type -> (A.Structured a -> A.Structured a)
declFoo t = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo") $ A.Declaration emptyMeta t Nothing)
valFoo :: [Int] -> A.SpecType
valFoo ds = A.IsExpr emptyMeta A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) $ makeSizesLiteral ds
valFooSizes :: Data a => [Int] -> (A.Structured a -> A.Structured a)
valFooSizes ds = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") $ valFoo ds)
declFooSizes :: Data a => Int -> (A.Structured a -> A.Structured a)
declFooSizes x = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") $ A.Declaration emptyMeta (A.Array [A.Dimension x] A.Int) Nothing)
makeSizesLiteral :: [Int] -> A.Expression
makeSizesLiteral xs = A.Literal emptyMeta (A.Array [A.Dimension $ length xs] A.Int) $ A.ArrayLiteral emptyMeta $
map (A.ArrayElemExpr . A.Literal emptyMeta A.Int . A.IntLiteral emptyMeta . show) xs
checkValFooSizes :: [Int] -> CompState -> Assertion
checkValFooSizes ns cs
checkFooSizes :: A.SpecType -> CompState -> Assertion
checkFooSizes spec cs
= do nd <- case Map.lookup "foo_sizes" (csNames cs) of
Just nd -> return nd
Nothing -> assertFailure "Could not find foo_sizes" >> return undefined
assertEqual "ndName" "foo_sizes" (A.ndName nd)
assertEqual "ndOrigName" "foo_sizes" (A.ndOrigName nd)
assertEqual "ndType" (valFoo ns) (A.ndType nd)
assertEqual "ndAbbrevMode" A.ValAbbrev (A.ndAbbrevMode nd)
checkDeclFooSizes :: Int -> CompState -> Assertion
checkDeclFooSizes x cs
= do nd <- case Map.lookup "foo_sizes" (csNames cs) of
Just nd -> return nd
Nothing -> assertFailure "Could not find foo_sizes" >> return undefined
assertEqual "ndName" "foo_sizes" (A.ndName nd)
assertEqual "ndOrigName" "foo_sizes" (A.ndOrigName nd)
assertEqual "ndType" (A.Declaration emptyMeta (A.Array [A.Dimension x] A.Int) Nothing) (A.ndType nd)
assertEqual "ndType" spec (A.ndType nd)
assertEqual "ndAbbrevMode" A.ValAbbrev (A.ndAbbrevMode nd)
term = A.Only emptyMeta ()
test :: Int -> A.Structured () -> A.Structured () -> (CompState -> Assertion) -> Test
test n exp inp chk = TestLabel label $ TestCase $ testPassWithStateCheck label exp (declareSizesArray inp) (return ()) chk
test :: Int -> A.Structured () -> A.Structured () -> State CompState () -> (CompState -> Assertion) -> Test
test n exp inp st chk = TestLabel label $ TestCase $ testPassWithStateCheck label exp (declareSizesArray inp) st chk
where
label = "testDeclareSizes " ++ show n
---Returns the list of tests: