diff --git a/fco2/AST.hs b/fco2/AST.hs index 1f49e5c..e6fcfd6 100644 --- a/fco2/AST.hs +++ b/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 = diff --git a/fco2/EvalConstants.hs b/fco2/EvalConstants.hs index 584c00e..130a9c2 100644 --- a/fco2/EvalConstants.hs +++ b/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 --}}} diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index c00ea76..fe61f58 100644 --- a/fco2/GenerateC.hs +++ b/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) diff --git a/fco2/Parse.hs b/fco2/Parse.hs index 0be1444..e14646f 100644 --- a/fco2/Parse.hs +++ b/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'" diff --git a/fco2/TODO b/fco2/TODO index 8f98c68..cd0986a 100644 --- a/fco2/TODO +++ b/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).