Multidimensional arrays and slices

This commit is contained in:
Adam Sampson 2007-04-13 23:58:40 +00:00
parent 5840659ade
commit 2ec22a5c24
4 changed files with 159 additions and 118 deletions

View File

@ -182,20 +182,6 @@ genConversion A.DefaultConversion t e
genConversion cm t e = missing $ "genConversion " ++ show cm
--}}}
--{{{ subscripts
genSubscript :: A.Subscript -> CGen () -> CGen ()
genSubscript (A.Subscript m e) p
= do p
tell ["["]
genExpression e
tell ["]"]
genSubscript (A.SubscriptField m n) p
= do p
tell ["->"]
genName n
genSubscript s p = missing $ "genSubscript " ++ show s
--}}}
--{{{ literals
genLiteral :: A.Literal -> CGen ()
genLiteral (A.Literal m t lr) = genLiteralRepr lr
@ -235,13 +221,26 @@ The various types are generated like this:
--------------------------------------
INT x: int x; int x; int *x;
x x x *x
[10]INT xs: int xs[10]; int *xs; int *xs;
xs xs xs xs
xs[i] xs[i] xs[i] xs[i]
[20][10]INT xss: int xss[20*10]; int *xss; int *xss;
xss xss xss xss
xss[i] &xss[i*10] &xss[i*10] &xss[i*10] (where 10 = xss_sizes[1])
xss[i][j] xss[i*10+j] xss[i*10+j] xss[i*10+j]
[6][4][2]INT xsss: int xsss[6*4*2]; int *xsss;
xsss xsss (as left)
xsss[i] &xsss[i*4*2]
xsss[i][j] &xsss[i*4*2+j*2]
xsss[i][j][k] xsss[i*4*2+j*2+k]
MYREC r: MYREC r; MYREC *r; MYREC *r;
r &r r r
r[F] (&r)->F (r)->F (r)->F
[10]MYREC rs: MYREC rs[10]; MYREC *rs; MYREC *rs;
rs rs rs rs
rs[i] &rs[i] &rs[i] &rs[i]
@ -250,14 +249,11 @@ MYREC r: MYREC r; MYREC *r; MYREC *r;
CHAN OF INT c: Channel c; Channel *c;
c &c c
[10]CHAN OF INT cs: Channel **cs; Channel **cs;
cs cs cs
cs[i] cs[i] cs[i]
Should treat record fields as if they're Originals.
FIXME: Deal with multidimensional arrays, which are (slightly) more awkward again.
I suspect there's probably a nicer way of doing this, but as a translation of
the above table this isn't too horrible...
-}
@ -280,8 +276,47 @@ genVariable v
inner v
when (prefix /= "") $ tell [")"]
where
inner :: A.Variable -> CGen ()
inner (A.Variable _ n) = genName n
inner (A.SubscriptedVariable _ s v) = genSubscript s (genVariable v)
inner sv@(A.SubscriptedVariable _ (A.Subscript _ _) _)
= do let (es, v) = collectSubs sv
ps <- get
t <- checkJust $ typeOfVariable ps v
let numDims = case t of A.Array ds _ -> length ds
genVariable v
tell ["["]
sequence_ $ intersperse (tell [" + "]) $ genPlainSub v es [0..(numDims - 1)]
tell ["]"]
inner (A.SubscriptedVariable _ (A.SubscriptField m n) v)
= do genVariable v
tell ["->"]
genName n
inner (A.SubscriptedVariable m (A.SubscriptFromFor m' start _) v)
= inner (A.SubscriptedVariable m (A.Subscript m' start) v)
inner (A.SubscriptedVariable m (A.SubscriptFrom m' start) v)
= inner (A.SubscriptedVariable m (A.Subscript m' start) v)
inner (A.SubscriptedVariable m (A.SubscriptFor m' _) v)
= inner (A.SubscriptedVariable m (A.Subscript m' (makeConstant m' 0)) v)
-- | Collect all the plain subscripts on a variable, so we can combine them.
collectSubs :: A.Variable -> ([A.Expression], A.Variable)
collectSubs (A.SubscriptedVariable _ (A.Subscript _ e) v)
= (es' ++ [e], v')
where
(es', v') = collectSubs v
collectSubs v = ([], v)
-- | Generate the individual offsets that need adding together to find the
-- right place in the array.
-- FIXME This is obviously not the best way to factor this, but I figure a
-- smart C compiler should be able to work it out...
genPlainSub :: A.Variable -> [A.Expression] -> [Int] -> [CGen ()]
genPlainSub _ [] _ = []
genPlainSub v (e:es) (_:subs)
= gen : genPlainSub v es subs
where
gen = sequence_ $ intersperse (tell [" * "]) $ genExpression e : genChunks
genChunks = [genVariable v >> tell ["_sizes[", show i, "]"] | i <- subs]
--}}}
--{{{ expressions
@ -373,8 +408,7 @@ genInputItem c (A.InCounted m cv av)
tell ["ChanIn ("]
genVariable c
tell [", "]
let (rhs, rhsS) = abbrevVariable A.Abbrev t av
rhs
fst $ abbrevVariable A.Abbrev t av
tell [", "]
let subT = fromJust $ subscriptType ps (A.Subscript m $ makeConstant m 0) t
genVariable cv
@ -384,7 +418,7 @@ genInputItem c (A.InCounted m cv av)
genInputItem c (A.InVariable m v)
= do ps <- get
t <- checkJust $ typeOfVariable ps v
let (rhs, rhsS) = abbrevVariable A.Abbrev t v
let rhs = fst $ abbrevVariable A.Abbrev t v
case t of
A.Int ->
do tell ["ChanInInt ("]
@ -411,8 +445,7 @@ genOutputItem c (A.OutCounted m ce ae)
do tell ["ChanOut ("]
genVariable c
tell [", "]
let (rhs, rhsS) = abbrevVariable A.Abbrev t v
rhs
fst $ abbrevVariable A.Abbrev t v
tell [", "]
let subT = fromJust $ subscriptType ps (A.Subscript m $ makeConstant m 0) t
genExpression ce
@ -433,8 +466,7 @@ genOutputItem c (A.OutExpression m e)
do tell ["ChanOut ("]
genVariable c
tell [", "]
let (rhs, rhsS) = abbrevVariable A.Abbrev t v
rhs
fst $ abbrevVariable A.Abbrev t v
tell [", "]
genBytesInType t
tell [");\n"]
@ -489,55 +521,82 @@ genReplicatorSize (A.For m n base count) = genExpression count
--}}}
--{{{ abbreviations
genSlice :: A.Variable -> A.Expression -> A.Expression -> (CGen (), Maybe (CGen ()))
genSlice v start count
= ((do tell ["&"]
genVariable v
tell ["["]
genExpression start
tell ["]"]),
(Just $ do tell ["{ "]
genExpression count
-- FIXME Add remaining dimensions
tell [" }"]))
-- FIXME: This code is horrible, and I can't easily convince myself that it's correct.
genSlice :: A.Variable -> A.Variable -> A.Expression -> A.Expression -> [A.Dimension] -> (CGen (), A.Name -> CGen ())
genSlice v (A.Variable _ on) start count ds
= (tell ["&"] >> genVariable v,
genArraySize False
(do genExpression count
sequence_ [do tell [", "]
genName on
tell ["_sizes[", show i, "]"]
| i <- [1..(length ds - 1)]]))
genArrayAbbrev :: A.Variable -> (CGen (), A.Name -> CGen ())
genArrayAbbrev v
= (genVariable v, genAASize v 0)
where
genAASize (A.SubscriptedVariable _ (A.Subscript _ _) v) arg
= genAASize v (arg + 1)
genAASize (A.Variable _ on) arg
= genArraySize True
(tell ["&"] >> genName on >> tell ["_sizes[", show arg, "]"])
genArraySize :: Bool -> CGen () -> A.Name -> CGen ()
genArraySize isPtr size n
= if isPtr
then do tell ["const int *"]
genName n
tell ["_sizes = "]
size
tell [";\n"]
else do tell ["const int "]
genName n
tell ["_sizes[] = { "]
size
tell [" };\n"]
noSize :: A.Name -> CGen ()
noSize n = return ()
-- | Generate the right-hand side of an abbreviation of a variable.
abbrevVariable :: A.AbbrevMode -> A.Type -> A.Variable -> (CGen (), Maybe (CGen ()))
abbrevVariable am _ (A.SubscriptedVariable _ (A.SubscriptFromFor _ start count) v)
= genSlice v start count
abbrevVariable am _ (A.SubscriptedVariable m (A.SubscriptFrom _ start) v)
= genSlice v start (A.Dyadic m A.Minus (A.SizeExpr m (A.ExprVariable m v)) start)
abbrevVariable am _ (A.SubscriptedVariable m (A.SubscriptFor _ count) v)
= genSlice v (makeConstant m 0) count
abbrevVariable :: A.AbbrevMode -> A.Type -> A.Variable -> (CGen (), A.Name -> CGen ())
abbrevVariable am (A.Array _ _) v@(A.SubscriptedVariable _ (A.Subscript _ _) _)
= genArrayAbbrev v
abbrevVariable am (A.Array ds _) v@(A.SubscriptedVariable _ (A.SubscriptFromFor _ start count) v')
= genSlice v v' start count ds
abbrevVariable am (A.Array ds _) v@(A.SubscriptedVariable m (A.SubscriptFrom _ start) v')
= genSlice v v' start (A.Dyadic m A.Minus (A.SizeExpr m (A.ExprVariable m v')) start) ds
abbrevVariable am (A.Array ds _) v@(A.SubscriptedVariable m (A.SubscriptFor _ count) v')
= genSlice v v' (makeConstant m 0) count ds
abbrevVariable am (A.Array _ _) v
= (genVariable v, Just $ do { genVariable v; tell ["_sizes"] })
= (genVariable v, genArraySize True (genVariable v >> tell ["_sizes"]))
abbrevVariable am (A.Chan _) v
= (genVariable v, Nothing)
= (genVariable v, noSize)
abbrevVariable am (A.UserDataType _) v
= (genVariable v, Nothing)
= (genVariable v, noSize)
abbrevVariable am t v
= (do { when (am == A.Abbrev) $ tell ["&"]; genVariable v }, Nothing)
= (do { when (am == A.Abbrev) $ tell ["&"]; genVariable v }, noSize)
-- | Generate the right-hand side of an abbreviation of an expression.
abbrevExpression :: A.AbbrevMode -> A.Type -> A.Expression -> (CGen (), Maybe (CGen ()))
abbrevExpression :: A.AbbrevMode -> A.Type -> A.Expression -> (CGen (), A.Name -> CGen ())
abbrevExpression am t@(A.Array _ _) e
= case e of
A.ExprVariable _ v -> abbrevVariable am t v
A.ExprLiteral _ l ->
case l of
A.Literal _ litT r -> (genExpression e, Just $ genTypeSize litT)
A.Literal _ litT r -> (genExpression e, genTypeSize litT)
A.SubscriptedLiteral _ _ _ -> bad
_ -> bad
where
bad = (missing "array expression abbreviation", Just $ missing "AEA size")
bad = (missing "array expression abbreviation", noSize)
genTypeSize :: A.Type -> CGen ()
genTypeSize :: A.Type -> (A.Name -> CGen ())
genTypeSize (A.Array ds _)
= do tell ["{ "]
sequence_ $ intersperse genComma [genExpression e | A.Dimension e <- ds]
tell [" }"]
= genArraySize False $ sequence_ $ intersperse genComma [genExpression e | A.Dimension e <- ds]
abbrevExpression am _ e
= (genExpression e, Nothing)
= (genExpression e, noSize)
--}}}
--{{{ specifications
@ -555,14 +614,10 @@ declareType t = genType t
genDimensions :: [A.Dimension] -> CGen ()
genDimensions ds
= sequence_ $ [case d of
A.Dimension e ->
do tell ["["]
genExpression e
tell ["]"]
A.UnknownDimension ->
missing "unknown dimension in declaration"
| d <- ds]
= do tell ["["]
sequence $ intersperse (tell [" * "])
[case d of A.Dimension e -> genExpression e | d <- ds]
tell ["]"]
genDeclaration :: A.Type -> A.Name -> CGen ()
genDeclaration A.Timer n = return ()
@ -648,28 +703,14 @@ introduceSpec (n, A.Is m am t v)
tell [" = "]
rhs
tell [";\n"]
case rhsSizes of
Just r ->
do tell ["const int *"]
genName n
tell ["_sizes = "]
r
tell [";\n"]
Nothing -> return ()
rhsSizes n
introduceSpec (n, A.IsExpr m am t e)
= do let (rhs, rhsSizes) = abbrevExpression am t e
genDecl am t n
tell [" = "]
rhs
tell [";\n"]
case rhsSizes of
Just r ->
do tell ["const int "]
genName n
tell ["_sizes[] = "]
r
tell [";\n"]
Nothing -> return ()
rhsSizes n
introduceSpec (n, A.IsChannelArray m t cs)
= do genDecl A.Abbrev t n
tell [" = {"]
@ -733,21 +774,21 @@ genActual :: A.Actual -> CGen ()
genActual actual
= case actual of
A.ActualExpression t e ->
do let (rhs, rhsSizes) = abbrevExpression A.ValAbbrev t e
rhs
case rhsSizes of
Just r ->
do tell [", "]
r
Nothing -> return ()
case (t, e) of
(A.Array _ _, A.ExprVariable _ v) ->
do genVariable v
tell [", "]
genVariable v
tell ["_sizes"]
_ -> genExpression e
A.ActualVariable am t v ->
do let (rhs, rhsSizes) = abbrevVariable am t v
rhs
case rhsSizes of
Just r ->
do tell [", "]
r
Nothing -> return ()
case t of
A.Array _ _ ->
do genVariable v
tell [", "]
genVariable v
tell ["_sizes"]
_ -> fst $ abbrevVariable am t v
numCArgs :: [A.Actual] -> Int
numCArgs [] = 0
@ -761,11 +802,11 @@ genFormals fs = prefixComma (map genFormal fs)
genFormal :: A.Formal -> CGen ()
genFormal (A.Formal am t n)
= case t of
(A.Array _ t) ->
A.Array _ t' ->
do genDecl am t n
tell ["[], const int "]
tell [", const int *"]
genName n
tell ["_sizes[]"]
tell ["_sizes"]
_ -> genDecl am t n
--}}}

View File

@ -84,12 +84,12 @@ makeNonceProc m p
= defineNonce m "wrapper_proc" (A.Proc m [] p) A.ProcName A.Abbrev
-- | Generate and define a variable abbreviation.
makeNonceIs :: MonadState ParseState m => Meta -> A.Type -> A.AbbrevMode -> A.Variable -> m A.Specification
makeNonceIs m t am v
= defineNonce m "var" (A.Is m am t v) A.VariableName am
makeNonceIs :: MonadState ParseState m => String -> Meta -> A.Type -> A.AbbrevMode -> A.Variable -> m A.Specification
makeNonceIs s m t am v
= defineNonce m s (A.Is m am t v) A.VariableName am
-- | Generate and define an expression abbreviation.
makeNonceIsExpr :: MonadState ParseState m => Meta -> A.Type -> A.Expression -> m A.Specification
makeNonceIsExpr m t e
= defineNonce m "expr" (A.IsExpr m A.ValAbbrev t e) A.VariableName A.ValAbbrev
makeNonceIsExpr :: MonadState ParseState m => String -> Meta -> A.Type -> A.Expression -> m A.Specification
makeNonceIsExpr s m t e
= defineNonce m s (A.IsExpr m A.ValAbbrev t e) A.VariableName A.ValAbbrev

View File

@ -35,7 +35,7 @@ pullUp = doGeneric `extM` doProcess `extM` doExpression `extM` doActual
modify (\ps -> ps { psPulledItems = psPulledItems origPS })
return p'
-- | Pull array expressions that aren't already variables.
-- | Pull array expressions that aren't already non-subscripted variables.
doExpression :: A.Expression -> PassM A.Expression
doExpression e
= do e' <- doGeneric e
@ -44,7 +44,7 @@ pullUp = doGeneric `extM` doProcess `extM` doExpression `extM` doActual
case t of
A.Array _ _ ->
case e of
A.ExprVariable _ _ -> return e'
A.ExprVariable _ (A.Variable _ _) -> return e'
_ -> pull t e'
_ -> return e'
where
@ -52,26 +52,31 @@ pullUp = doGeneric `extM` doProcess `extM` doExpression `extM` doActual
pull t e
= do -- FIXME Should get Meta from somewhere...
let m = []
spec@(n, _) <- makeNonceIsExpr m t e
spec@(n, _) <- makeNonceIsExpr "array_expr" m t e
addPulled $ A.ProcSpec m spec
return $ A.ExprVariable m (A.Variable m n)
-- | Pull array actual slices.
-- FIXME: We really want to pull *any* array slice that isn't already
-- an abbreviation and turn it into one -- should be straightforward using
-- a rule that matches abbrevs.
-- | Pull any actual that's a subscript resulting in an array.
doActual :: A.Actual -> PassM A.Actual
doActual a@(A.ActualVariable _ _ _)
= do a' <- doGeneric a
let (am, t, v) = case a' of A.ActualVariable am t v -> (am, t, v)
case v of
A.SubscriptedVariable m s _ ->
if isSliceSubscript s
then do v' <- pull m am t v
return $ A.ActualVariable am t v'
else return a'
A.SubscriptedVariable m _ _ ->
case t of
A.Array _ _ ->
do v' <- pull m am t v
return $ A.ActualVariable am t v'
_ -> return a'
_ -> return a'
where
pull :: Meta -> A.AbbrevMode -> A.Type -> A.Variable -> PassM A.Variable
pull m am t v
= do spec@(n, _) <- makeNonceIs m t am v
= do spec@(n, _) <- makeNonceIs "subscript_actual" m t am v
addPulled $ A.ProcSpec m spec
return $ A.Variable m n
doActual a = doGeneric a

View File

@ -141,11 +141,6 @@ isChannelType (A.Array _ t) = isChannelType t
isChannelType (A.Chan _) = True
isChannelType _ = False
isSliceSubscript :: A.Subscript -> Bool
isSliceSubscript (A.Subscript _ _) = False
isSliceSubscript (A.SubscriptField _ _) = False
isSliceSubscript _ = True
stripArrayType :: A.Type -> A.Type
stripArrayType (A.Array _ t) = stripArrayType t
stripArrayType t = t