diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs index b7857f1..a68eebc 100644 --- a/backends/BackendPasses.hs +++ b/backends/BackendPasses.hs @@ -249,8 +249,8 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays" sizeType = A.Array [makeDimension m $ length ds] A.Int sizeExpr = case sliceSize of Just exp -> let subDims = [A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m n) varSrcSizes | n <- [1 .. (length srcDs - 1)]] in - A.Literal m sizeType $ A.ArrayLiteral m $ - [A.ArrayElemExpr exp] ++ map (A.ArrayElemExpr . A.ExprVariable m) subDims + A.Literal m sizeType $ A.ArrayListLiteral m $ A.Several m $ + A.Only m exp : map (A.Only m . A.ExprVariable m) subDims Nothing -> A.ExprVariable m subSrcSizeVar sizeSpecType = A.IsExpr m A.ValAbbrev sizeType sizeExpr defineSizesName m n_sizes sizeSpecType @@ -306,7 +306,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays" makeDynamicSizeSpec m n es = sizeSpecType where sizeType = A.Array [makeDimension m $ length es] A.Int - sizeLit = A.Literal m sizeType $ A.ArrayLiteral m $ map A.ArrayElemExpr es + sizeLit = A.Literal m sizeType $ A.ArrayListLiteral m $ A.Several m $ map (A.Only m) es sizeSpecType = A.IsExpr m A.ValAbbrev sizeType sizeLit declareFieldSizes :: Data a => String -> Meta -> A.Structured a -> (A.Name, A.Type) -> PassM (A.Structured a) diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 422fcfc..aa50e48 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -521,18 +521,17 @@ cgenLiteral :: A.LiteralRepr -> A.Type -> CGen () cgenLiteral lr t = if isStringLiteral lr then do tell ["\""] - let A.ArrayLiteral _ aes = lr + let A.ArrayListLiteral _ (A.Several _ aes) = lr sequence_ [genByteLiteral m s - | A.ArrayElemExpr (A.Literal _ _ (A.ByteLiteral m s)) <- aes] + | A.Only _ (A.Literal _ _ (A.ByteLiteral m s)) <- aes] tell ["\""] else call genLiteralRepr lr t -- | Does a LiteralRepr represent something that can be a plain string literal? isStringLiteral :: A.LiteralRepr -> Bool -isStringLiteral (A.ArrayLiteral _ []) = False -isStringLiteral (A.ArrayLiteral _ aes) +isStringLiteral (A.ArrayListLiteral _ (A.Several _ aes)) = and [case ae of - A.ArrayElemExpr (A.Literal _ _ (A.ByteLiteral _ _)) -> True + A.Only _ (A.Literal _ _ (A.ByteLiteral _ _)) -> True _ -> False | ae <- aes] isStringLiteral _ = False @@ -545,9 +544,9 @@ genLitSuffix A.Real32 = tell ["F"] genLitSuffix _ = return () -- TODO don't allocate for things less than 64-bits in size -cgenListLiteral :: [A.Expression] -> A.Type -> CGen () -cgenListLiteral es t - = foldl addItem (tell ["g_queue_new()"]) es +cgenListLiteral :: A.Structured A.Expression -> A.Type -> CGen () +cgenListLiteral (A.Several _ es) t + = foldl addItem (tell ["g_queue_new()"]) [e | A.Only _ e <- es] where addItem :: CGen () -> A.Expression -> CGen () addItem prev add @@ -587,15 +586,14 @@ cgenLiteralRepr (A.HexLiteral m s) t tell [")"] cgenLiteralRepr (A.ByteLiteral m s) _ = tell ["'"] >> genByteLiteral m s >> tell ["'"] -cgenLiteralRepr (A.ArrayLiteral m aes) _ - = do genLeftB - call genArrayLiteralElems aes - genRightB cgenLiteralRepr (A.RecordLiteral _ es) _ = do genLeftB seqComma $ map (call genUnfoldedExpression) es genRightB -cgenLiteralRepr (A.ListLiteral _ es) t = call genListLiteral es t +cgenLiteralRepr (A.ArrayListLiteral m aes) (A.Array {}) + = call genArrayLiteralElems aes +cgenLiteralRepr (A.ArrayListLiteral _ es) t@(A.List {}) + = call genListLiteral es t -- | Generate an expression inside a record literal. -- @@ -647,13 +645,10 @@ genDecimal ('0':s) = genDecimal s genDecimal ('-':s) = tell ["-"] >> genDecimal s genDecimal s = tell [s] -cgenArrayLiteralElems :: [A.ArrayElem] -> CGen () -cgenArrayLiteralElems aes - = seqComma $ map genElem aes - where - genElem :: A.ArrayElem -> CGen () - genElem (A.ArrayElemArray aes) = call genArrayLiteralElems aes - genElem (A.ArrayElemExpr e) = call genUnfoldedExpression e +cgenArrayLiteralElems :: A.Structured A.Expression -> CGen () +cgenArrayLiteralElems (A.Only _ e) = call genUnfoldedExpression e +cgenArrayLiteralElems (A.Several _ aes) + = genLeftB >> (seqComma $ map cgenArrayLiteralElems aes) >> genRightB genByteLiteral :: Meta -> String -> CGen () genByteLiteral m s diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs index 7d3bfd1..30447df 100644 --- a/backends/GenerateCBased.hs +++ b/backends/GenerateCBased.hs @@ -96,7 +96,7 @@ data GenOps = GenOps { genAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen(), genAlt :: Bool -> A.Structured A.Alternative -> CGen (), -- | Generates the given array element expressions as a flattened (one-dimensional) list of literals - genArrayLiteralElems :: [A.ArrayElem] -> CGen (), + genArrayLiteralElems :: A.Structured A.Expression -> CGen (), -- | Writes out the actual data storage array name. genArrayStoreName :: A.Name -> CGen(), -- | Generates an array subscript for the given variable (with error checking according to the first variable), using the given expression list as subscripts @@ -136,7 +136,7 @@ data GenOps = GenOps { genIntrinsicProc :: Meta -> String -> [A.Actual] -> CGen (), genListAssign :: A.Variable -> A.Expression -> CGen (), genListConcat :: A.Expression -> A.Expression -> CGen (), - genListLiteral :: [A.Expression] -> A.Type -> CGen (), + genListLiteral :: A.Structured A.Expression -> A.Type -> CGen (), genListSize :: A.Variable -> CGen (), genLiteral :: A.LiteralRepr -> A.Type -> CGen (), genLiteralRepr :: A.LiteralRepr -> A.Type -> CGen (), diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index d31d36c..d909aba 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -725,11 +725,11 @@ cppgenListSize v = do call genVariable v tell [".size()"] -cppgenListLiteral :: [A.Expression] -> A.Type -> CGen () -cppgenListLiteral es t +cppgenListLiteral :: A.Structured A.Expression -> A.Type -> CGen () +cppgenListLiteral (A.Several _ es) t = do call genType t tell ["()"] - mapM_ (\e -> tell ["("] >> call genExpression e >> tell [")"]) es + sequence_ [tell ["("] >> call genExpression e >> tell [")"] | A.Only _ e <- es] cppgenListConcat :: A.Expression -> A.Expression -> CGen () cppgenListConcat a b diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs index 495f6e9..9d6b1fb 100644 --- a/transformations/SimplifyExprs.hs +++ b/transformations/SimplifyExprs.hs @@ -33,6 +33,7 @@ import qualified Properties as Prop import ShowCode import Traversal import Types +import Utils simplifyExprs :: [Pass] simplifyExprs = @@ -124,16 +125,16 @@ expandArrayLiterals = pass "Expand array literals" [Prop.arrayLiteralsExpanded] (applyDepthM doArrayElem) where - doArrayElem :: A.ArrayElem -> PassM A.ArrayElem - doArrayElem ae@(A.ArrayElemExpr e) + doArrayElem :: A.Structured A.Expression -> PassM (A.Structured A.Expression) + doArrayElem ae@(A.Only _ e) = do t <- astTypeOf e case t of A.Array ds _ -> expand ds e _ -> return ae doArrayElem ae = return ae - expand :: [A.Dimension] -> A.Expression -> PassM A.ArrayElem - expand [] e = return $ A.ArrayElemExpr e + expand :: [A.Dimension] -> A.Expression -> PassM (A.Structured A.Expression) + expand [] e = return $ A.Only (findMeta e) e expand (A.UnknownDimension:_) e = dieP (findMeta e) "array literal containing non-literal array of unknown size" expand (A.Dimension n:ds) e @@ -143,7 +144,7 @@ expandArrayLiterals = pass "Expand array literals" (A.Subscript m A.NoCheck $ makeConstant m i) e) | i <- [0 .. size - 1]] - return $ A.ArrayElemArray elems + return $ A.Several (findMeta e) elems where m = findMeta e -- | We pull up the loop (Rep) counts into a temporary expression, whenever the loop @@ -209,7 +210,8 @@ transformConstr = pass "Transform array constructors into initialisation code" -- name += [expr] doStructured :: Data a => A.Structured a -> PassM (A.Structured a) doStructured (A.Spec m (A.Specification m' n (A.IsExpr _ _ _ - expr@(A.ExprConstr m'' (A.RepConstr _ t repn rep exp)))) scope) + expr@(A.Literal m'' t (A.ArrayListLiteral _ (A.Spec _ (A.Specification _ + repn (A.Rep _ rep)) (A.Only _ exp)))))) scope) = do case t of A.Array {} -> do indexVarSpec@(A.Specification _ indexName _) <- makeNonceVariable "array_constr_index" m'' A.Int A.Original @@ -250,7 +252,7 @@ transformConstr = pass "Transform array constructors into initialisation code" appendItem = A.Only m'' $ A.Assign m'' [A.Variable m'' n] $ A.ExpressionList m'' [A.Dyadic m'' A.Concat (A.ExprVariable m'' $ A.Variable m'' n) - (A.Literal m'' t $ A.ListLiteral m'' [exp])] + (A.Literal m'' t $ A.ArrayListLiteral m'' $ A.Several m'' [A.Only m'' exp])] replicateCode :: Data a => A.Structured a -> A.Structured a replicateCode = A.Spec m'' (A.Specification m'' repn (A.Rep m'' rep)) @@ -348,7 +350,6 @@ pullUp pullUpArraysInsideRecords = pass "Pull up definitions" _ -> pull t e' A.List _ -> case e' of - A.ExprConstr {} -> pull t e' A.Literal {} -> pull t e' _ -> return e' _ -> return e'