Make underlyingType merge array dimensions.

This fixes a bug that cgtest56 exposed, where an array of a user-defined type
that was itself an array wound up being an array of arrays rather than a single
array.

As part of this, makeArrayType is now called addDimensions, and takes a list of
dimensions to add rather than just one.

EvalConstants.hs

@@ -264,7 +264,7 @@ renderLiteral m (OccInt64 i) = (A.Int64, A.IntLiteral m $ show i)
 renderLiteral m (OccArray vs)
     = (t, A.ArrayLiteral m aes)
   where
-    t = makeArrayType (A.Dimension $ length vs) (head ts)
+    t = addDimensions [A.Dimension $ length vs] (head ts)
     (ts, aes) = unzip $ map (renderLiteralArray m) vs
 renderLiteral m (OccRecord n vs)
     = (A.Record n, A.RecordLiteral m (map (snd . renderValue m) vs))
@@ -285,7 +285,7 @@ renderLiteralArray :: Meta -> OccValue -> (A.Type, A.ArrayElem)
 renderLiteralArray m (OccArray vs)
     = (t, A.ArrayElemArray aes)
   where
-    t = makeArrayType (A.Dimension $ length vs) (head ts)
+    t = addDimensions [A.Dimension $ length vs] (head ts)
     (ts, aes) = unzip $ map (renderLiteralArray m) vs
 renderLiteralArray m v
     = (t, A.ArrayElemExpr e)

ParseOccam.hs

@@ -358,11 +358,11 @@ intersperseP (f:fs) sep
 tableType :: Meta -> [A.Type] -> OccParser A.Type
 tableType m l = tableType' m (length l) l
   where
-    tableType' m len [t] = return $ makeArrayType (A.Dimension len) t
+    tableType' m len [t] = return $ addDimensions [A.Dimension len] t
     tableType' m len (t1 : rest@(t2 : _))
         = if t1 == t2 then tableType' m len rest
-                      else return $ makeArrayType (A.Dimension len) A.Any
-    tableType' m len [] = return $ makeArrayType (A.Dimension 0) A.Any
+                      else return $ addDimensions [A.Dimension len] A.Any
+    tableType' m len [] = return $ addDimensions [A.Dimension 0] A.Any
 
 -- | Check that the second dimension can be used in a context where the first
 -- is expected.
@@ -538,14 +538,14 @@ arrayType :: OccParser A.Type -> OccParser A.Type
 arrayType element
     =  do (s, t) <- tryXVXV sLeft constIntExpr sRight element
           sVal <- evalIntExpression s
-          return $ makeArrayType (A.Dimension sVal) t
+          return $ addDimensions [A.Dimension sVal] t
 
 -- | Either a sized or unsized array of a production.
 specArrayType :: OccParser A.Type -> OccParser A.Type
 specArrayType element
     =   arrayType element
     <|> do t <- tryXXV sLeft sRight element
-           return $ makeArrayType A.UnknownDimension t
+           return $ addDimensions [A.UnknownDimension] t
 
 dataType :: OccParser A.Type
 dataType
@@ -1604,7 +1604,7 @@ inputItem t
           do m <- md
              v <- variableOfType ct
              sColons
-             w <- variableOfType (makeArrayType A.UnknownDimension it)
+             w <- variableOfType (addDimensions [A.UnknownDimension] it)
              return $ A.InCounted m v w
         A.Any ->
           do m <- md
@@ -1684,7 +1684,7 @@ outputItem t
           do m <- md
              a <- expressionOfType ct
              sColons
-             b <- expressionOfType (makeArrayType A.UnknownDimension it)
+             b <- expressionOfType (addDimensions [A.UnknownDimension] it)
              return $ A.OutCounted m a b
         A.Any ->
           do m <- md

Types.hs

@@ -141,7 +141,7 @@ unsubscriptType (A.SubscriptFor _ _) t
 unsubscriptType (A.SubscriptField _ _) t
     = die $ "unsubscript of record type (but we can't tell which one)"
 unsubscriptType (A.Subscript _ sub) t
-    = return $ makeArrayType A.UnknownDimension t
+    = return $ addDimensions [A.UnknownDimension] t
 
 -- | Just remove the first dimension from an array type -- like doing
 -- subscriptType with constant 0 as a subscript, but without the checking.
@@ -242,7 +242,7 @@ abbrevModeOfSpec s
 underlyingType :: (CSM m, Die m) => A.Type -> m A.Type
 underlyingType t@(A.UserDataType _)
     = resolveUserType t >>= underlyingType
-underlyingType (A.Array ds t) = liftM (A.Array ds) (underlyingType t)
+underlyingType (A.Array ds t) = liftM (addDimensions ds) (underlyingType t)
 underlyingType t = return t
 
 -- | Like underlyingType, but only do the "outer layer": if you give this a
@@ -256,11 +256,11 @@ resolveUserType (A.UserDataType n)
             _ -> die $ "not a type name " ++ show n
 resolveUserType t = return t
 
--- | Add an array dimension to a type; if it's already an array it'll just add
--- a new dimension to the existing array.
-makeArrayType :: A.Dimension -> A.Type -> A.Type
-makeArrayType d (A.Array ds t) = A.Array (d : ds) t
-makeArrayType d t = A.Array [d] t
+-- | Add array dimensions to a type; if it's already an array it'll just add
+-- the new dimensions to the existing array.
+addDimensions :: [A.Dimension] -> A.Type -> A.Type
+addDimensions newDs (A.Array ds t) = A.Array (newDs ++ ds) t
+addDimensions ds t = A.Array ds t
 
 -- | Return a type with any enclosing arrays removed; useful for identifying
 -- things that should be channel names, timer names, etc. in the parser.

testcases/arrayarray.occ

@@ -0,0 +1,68 @@
+-- From cgtest56
+
+PROC title (VAL []BYTE s)
+  SKIP
+:
+PROC check (VAL INT a, b, VAL []BYTE s)
+  ASSERT (a = b)
+:
+INT FUNCTION id (VAL INT x) IS x:
+
+PROC arrays.of.arrays()
+  VAL n IS 5 :
+  DATA TYPE m0 IS INT :
+  DATA TYPE m1 IS [n]m0 :
+  DATA TYPE m2 IS [n]m1 :
+  DATA TYPE m3 IS [n]m2 :
+  INT i, j, k :
+  m0 m.0 :
+  m1 m.1 :
+  m2 m.2 :
+  m3 m.3 :
+  SEQ
+    title("arrays of arrays")
+    i := SIZE m.3
+    check(i, n, "ARR-01")
+    i := SIZE m.3[0]
+    check(i, n, "ARR-02")
+    i := SIZE m.3[0][0]
+    check(i, n, "ARR-03")
+
+    SEQ i = 0 FOR SIZE m.3
+      SEQ j = 0 FOR SIZE m.3[0]
+        SEQ k = 0 FOR SIZE m.3[0][0]
+          m.3[i][j][k] := m0 ((i + j) + k)
+
+    i := id(1)
+    m.2 := m.3[i]
+    SEQ j = 0 FOR SIZE m.2
+      SEQ k = 0 FOR SIZE m.2[0]
+        check(INT m.2[j][k], (j + k) + 1, "ARR-04")
+
+    j := id(2)
+    m.1 := m.2[j]
+    SEQ k = 0 FOR SIZE m.1
+      check(INT m.1[k], k + 3, "ARR-05")
+
+    i := id(2)
+    j := id(3)
+    m.1 := m.3[i][j]
+    SEQ k = 0 FOR SIZE m.1
+      check(INT m.1[k], k + 5, "ARR-06")
+
+    k := id(4)
+    m.0 := m.1[k] -- m1 already has m.3[2][3]
+    check(INT m.0, 9, "ARR-07")
+
+    j := id(3)
+    k := id(4)
+    m.0 := m.2[j][k] -- m2 already has m.3[1]
+    check(INT m.0, 8, "ARR-08")
+
+    i := id(2)
+    j := id(3)
+    k := id(4)
+    m.0 := m.3[i][j][k]
+    check(INT m.0, 9, "ARR-09")
+:
+