Adjusted the backends and transformations module to match the new array literal changes

This commit is contained in:
Neil Brown 2009-02-01 21:53:17 +00:00
parent 8de2dbca88
commit 3458a9197a
5 changed files with 32 additions and 36 deletions

View File

@ -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)

View File

@ -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

View File

@ -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 (),

View File

@ -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

View File

@ -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'