diff --git a/EvalConstants.hs b/EvalConstants.hs index f64116f..7375d96 100644 --- a/EvalConstants.hs +++ b/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) diff --git a/ParseOccam.hs b/ParseOccam.hs index 22ba713..5e6c96c 100644 --- a/ParseOccam.hs +++ b/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 diff --git a/Types.hs b/Types.hs index b167a37..a1d5782 100644 --- a/Types.hs +++ b/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. diff --git a/testcases/arrayarray.occ b/testcases/arrayarray.occ new file mode 100644 index 0000000..7df0542 --- /dev/null +++ b/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") +: +