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

backends/BackendPasses.hs

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

backends/BackendPassesTest.hs

@@ -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]
+    testFoo 0 $ declFoo [4]
-   ,testFooVal 1 [4,5]
+   ,testFoo 1 $ declFoo [4,5]
-   ,testFooVal 2 [4,5,6,7,8]
+   ,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)
+    -- spectype of foo, spectype of foo_sizes
-    testFooVal :: Int -> [Int] -> Test
+    testFoo :: Int -> (A.SpecType, A.SpecType, State CompState ()) -> Test
-    testFooVal n ns = test n (declFoo t $ valFooSizes ns $ term) (declFoo t term) (checkValFooSizes ns)
+    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
+    checkFooSizes :: A.SpecType -> CompState -> Assertion
-    checkValFooSizes ns cs
+    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 "ndType" spec (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 "ndAbbrevMode" A.ValAbbrev (A.ndAbbrevMode nd)
   
     term = A.Only emptyMeta ()
     
-    test :: Int -> A.Structured () -> A.Structured () -> (CompState -> Assertion) -> Test
+    test :: Int -> A.Structured () -> A.Structured () -> State CompState () -> (CompState -> Assertion) -> Test
-    test n exp inp chk = TestLabel label $ TestCase $ testPassWithStateCheck label exp (declareSizesArray inp) (return ()) chk
+    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: