Get multidimensional array literals working (by changing their AST representation)

fco2/AST.hs

@@ -74,7 +74,15 @@ data LiteralRepr =
   | HexLiteral Meta String
   | ByteLiteral Meta String
   | StringLiteral Meta String
-  | ArrayLiteral Meta [Expression]
+  | ArrayLiteral Meta [ArrayElem]
+  deriving (Show, Eq, Typeable, Data)
+
+-- | An item inside an array literal -- which might be an expression, or might
+-- be a nested array. (occam multidimensional arrays are not arrays of arrays,
+-- which is why we can't just use nested ExprLiterals.)
+data ArrayElem =
+  ArrayElemArray [ArrayElem]
+  | ArrayElemExpr Expression
   deriving (Show, Eq, Typeable, Data)
 
 data Literal =

fco2/EvalConstants.hs

@@ -29,14 +29,18 @@ constantFold e
 
 -- | Is an expression a constant literal?
 isConstant :: A.Expression -> Bool
--- Array literals are only constant if all their components are.
-isConstant (A.ExprLiteral _ (A.Literal _ _ (A.ArrayLiteral _ es)))
-    = and $ map isConstant es
+isConstant (A.ExprLiteral _ (A.Literal _ _ (A.ArrayLiteral _ aes)))
+    = and $ map isConstantArray aes
 isConstant (A.ExprLiteral _ _) = True
 isConstant (A.True _) = True
 isConstant (A.False _) = True
 isConstant _ = False
 
+-- | Is an array literal element constant?
+isConstantArray :: A.ArrayElem -> Bool
+isConstantArray (A.ArrayElemArray aes) = and $ map isConstantArray aes
+isConstantArray (A.ArrayElemExpr e) = isConstant e
+
 -- | Is a name defined as a constant expression? If so, return its definition.
 getConstantName :: (PSM m, Die m) => A.Name -> m (Maybe A.Expression)
 getConstantName n
@@ -99,10 +103,14 @@ fromRead _ _ = throwError "cannot parse literal"
 evalLiteral :: A.Literal -> EvalM OccValue
 evalLiteral (A.Literal _ A.Int (A.IntLiteral _ s)) = fromRead OccInt $ readDec s
 evalLiteral (A.Literal _ A.Int (A.HexLiteral _ s)) = fromRead OccInt $ readHex s
-evalLiteral (A.Literal _ _ (A.ArrayLiteral _ es))
-    = liftM OccArray (mapM evalExpression es)
+evalLiteral (A.Literal _ _ (A.ArrayLiteral _ aes))
+    = liftM OccArray (mapM evalLiteralArray aes)
 evalLiteral _ = throwError "bad literal"
 
+evalLiteralArray :: A.ArrayElem -> EvalM OccValue
+evalLiteralArray (A.ArrayElemArray aes) = liftM OccArray (mapM evalLiteralArray aes)
+evalLiteralArray (A.ArrayElemExpr e) = evalExpression e
+
 evalExpression :: A.Expression -> EvalM OccValue
 evalExpression (A.Monadic _ op e)
     =  do v <- evalExpression e
@@ -173,8 +181,19 @@ renderValue m v = (t, A.ExprLiteral m (A.Literal m t lr))
 renderLiteral :: Meta -> OccValue -> (A.Type, A.LiteralRepr)
 renderLiteral m (OccInt i) = (A.Int, A.IntLiteral m $ show i)
 renderLiteral m (OccArray vs)
-    = (t, A.ArrayLiteral m es)
+    = (t, A.ArrayLiteral m aes)
   where
     t = makeArrayType (A.Dimension $ length vs) (head ts)
-    (ts, es) = unzip $ map (renderValue m) vs
+    (ts, aes) = unzip $ map (renderLiteralArray m) vs
+
+renderLiteralArray :: Meta -> OccValue -> (A.Type, A.ArrayElem)
+renderLiteralArray m (OccArray vs)
+    = (t, A.ArrayElemArray aes)
+  where
+    t = makeArrayType (A.Dimension $ length vs) (head ts)
+    (ts, aes) = unzip $ map (renderLiteralArray m) vs
+renderLiteralArray m v
+    = (t, A.ArrayElemExpr e)
+  where
+    (t, e) = renderValue m v
 --}}}

fco2/GenerateC.hs

@@ -210,11 +210,23 @@ genLiteralRepr (A.IntLiteral m s) = tell [s]
 genLiteralRepr (A.HexLiteral m s) = tell ["0x", s]
 genLiteralRepr (A.ByteLiteral m s) = tell ["'", convStringLiteral s, "'"]
 genLiteralRepr (A.StringLiteral m s) = tell ["\"", convStringLiteral s, "\""]
-genLiteralRepr (A.ArrayLiteral m es)
+genLiteralRepr (A.ArrayLiteral m aes)
     =  do tell ["{"]
-          sequence_ $ intersperse genComma (map genExpression es)
+          genArrayLiteralElems aes
           tell ["}"]
 
+genArrayLiteralElems :: [A.ArrayElem] -> CGen ()
+genArrayLiteralElems aes
+    = sequence_ $ intersperse genComma $ map genElem aes
+  where
+    genElem :: A.ArrayElem -> CGen ()
+    genElem (A.ArrayElemArray aes) = genArrayLiteralElems aes
+    genElem (A.ArrayElemExpr e)
+        =  do t <- typeOfExpression e
+              case t of
+                A.Array _ _ -> missing $ "array literal containing non-literal array: " ++ show e
+                _ -> genExpression e
+
 hexToOct :: String -> String
 hexToOct h = printf "%03o" ((fst $ head $ readHex h) :: Int)
 

fco2/Parse.hs

@@ -699,7 +699,13 @@ table'
            popTypeContext
            ets <- mapM typeOfExpression es
            t <- listType m ets
-           return $ A.Literal m t (A.ArrayLiteral m es)
+           -- If any of the subelements are nested array literals, collapse them.
+           let aes = [case e of
+                        A.ExprLiteral _ (A.Literal _ _ al@(A.ArrayLiteral _ subAEs)) ->
+                          A.ArrayElemArray subAEs
+                        _ -> A.ArrayElemExpr e
+                      | e <- es]
+           return $ A.Literal m t (A.ArrayLiteral m aes)
     <|> maybeSliced table A.SubscriptedLiteral typeOfLiteral
     <?> "table'"
 

fco2/TODO

@@ -9,6 +9,8 @@ Tock would be a good name for this (Translator from occam to C from Kent).
 
 Think about simplifying the subscript types -- just have a single data type
 that takes several expressions.
+(Multi-subscript expressions like a[x][y] currently get pulled up into an array
+slice, which is inefficient.)
 
 The show instance for types should produce occam-looking types.
 
@@ -31,8 +33,6 @@ Record literals aren't implemented.
 
 Expression simplification -- this should use generics, so that we can have a
 default behaviour that simplifies expressions inside another one.
-(More generally, simplifyExpressions should really be split into a simplifier
-and a constant-finder -- or should return two values.)
 
 Output item expressions should be pulled up to variables.
 
@@ -47,8 +47,6 @@ calls have been removed, and so on.
 
 ## C backend
 
-Multidimensional array literals won't work.
-
 We could have genSpec generate {} around specs if it's not immediately inside
 another spec (which'd require some extra boolean arguments to find out).