suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Implement array slices

Browse Source
This commit is contained in:
Adam Sampson 2007-04-13 17:34:09 +00:00
parent 1a76e91c7f
commit 5840659ade
8 changed files with 93 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
fco2/AST.hs
View File

@ -204,8 +204,8 @@ data Formal =
deriving (Show, Eq, Typeable, Data)
data Actual =
ActualVariable Variable
| ActualExpression Expression
ActualVariable AbbrevMode Type Variable
| ActualExpression Type Expression
deriving (Show, Eq, Typeable, Data)
data ValueProcess =

47
fco2/GenerateC.hs
View File

@ -489,8 +489,26 @@ 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 [" }"]))
-- | 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 am (A.Array _ _) v
= (genVariable v, Just $ do { genVariable v; tell ["_sizes"] })
abbrevVariable am (A.Chan _) v
@ -708,21 +726,21 @@ removeSpec _ = return ()
prefixComma :: [CGen ()] -> CGen ()
prefixComma cs = sequence_ [genComma >> c | c <- cs]
genActuals :: [(A.Actual, A.Formal)] -> CGen ()
genActuals afs = prefixComma (map genActual afs)
genActuals :: [A.Actual] -> CGen ()
genActuals as = prefixComma (map genActual as)
genActual :: (A.Actual, A.Formal) -> CGen ()
genActual (actual, A.Formal am t _)
genActual :: A.Actual -> CGen ()
genActual actual
= case actual of
A.ActualExpression e ->
do let (rhs, rhsSizes) = abbrevExpression am t e
A.ActualExpression t e ->
do let (rhs, rhsSizes) = abbrevExpression A.ValAbbrev t e
rhs
case rhsSizes of
Just r ->
do tell [", "]
r
Nothing -> return ()
A.ActualVariable v ->
A.ActualVariable am t v ->
do let (rhs, rhsSizes) = abbrevVariable am t v
rhs
case rhsSizes of
@ -731,9 +749,10 @@ genActual (actual, A.Formal am t _)
r
Nothing -> return ()
numCArgs :: [A.Formal] -> Int
numCArgs :: [A.Actual] -> Int
numCArgs [] = 0
numCArgs (A.Formal _ (A.Array _ _) _:fs) = 2 + numCArgs fs
numCArgs (A.ActualVariable _ (A.Array _ _) _:fs) = 2 + numCArgs fs
numCArgs (A.ActualExpression (A.Array _ _) _:fs) = 2 + numCArgs fs
numCArgs (_:fs) = 1 + numCArgs fs
genFormals :: [A.Formal] -> CGen ()
@ -987,21 +1006,17 @@ genProcAlloc :: A.Process -> CGen ()
genProcAlloc (A.ProcCall m n as)
= do tell ["ProcAlloc ("]
genName n
ps <- get
let fs = case fromJust $ specTypeOfName ps n of A.Proc _ fs _ -> fs
-- FIXME stack size fixed here
let stackSize = 4096
tell [", ", show stackSize, ", ", show $ numCArgs fs]
genActuals (zip as fs)
tell [", ", show stackSize, ", ", show $ numCArgs as]
genActuals as
tell [")"]
genProcCall :: A.Name -> [A.Actual] -> CGen ()
genProcCall n as
= do genName n
ps <- get
let fs = case fromJust $ specTypeOfName ps n of A.Proc _ fs _ -> fs
tell [" (me"]
genActuals (zip as fs)
genActuals as
tell [");\n"]
--}}}

6
fco2/Parse.hs
View File

@ -1264,10 +1264,10 @@ actuals fs = intersperseP (map actual fs) sComma
actual :: A.Formal -> OccParser A.Actual
actual (A.Formal am t n)
= do case am of
A.ValAbbrev -> do { e <- expression; et <- pTypeOfExpression e; matchType t et; return $ A.ActualExpression e } <?> "actual expression for " ++ an
A.ValAbbrev -> do { e <- expression; et <- pTypeOfExpression e; matchType t et; return $ A.ActualExpression t e } <?> "actual expression for " ++ an
_ -> if isChannelType t
then do { c <- channel; ct <- pTypeOfVariable c; matchType t ct; return $ A.ActualVariable c } <?> "actual channel for " ++ an
else do { v <- variable; vt <- pTypeOfVariable v; matchType t vt; return $ A.ActualVariable v } <?> "actual variable for " ++ an
then do { c <- channel; ct <- pTypeOfVariable c; matchType t ct; return $ A.ActualVariable am t c } <?> "actual channel for " ++ an
else do { v <- variable; vt <- pTypeOfVariable v; matchType t vt; return $ A.ActualVariable am t v } <?> "actual variable for " ++ an
where
an = A.nameName n
--}}}

11
fco2/ParseState.hs
View File

@ -83,8 +83,13 @@ makeNonceProc :: MonadState ParseState m => Meta -> A.Process -> m A.Specificati
makeNonceProc m p
= defineNonce m "wrapper_proc" (A.Proc m [] p) A.ProcName A.Abbrev
-- | Generate and define a VAL abbreviation.
makeNonceValIs :: MonadState ParseState m => Meta -> A.Type -> A.Expression -> m A.Specification
makeNonceValIs m t e
-- | 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
-- | 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

24
fco2/SimplifyExprs.hs
View File

@ -17,7 +17,7 @@ simplifyExprs = pullUp
-- | Find things that need to be moved up to their enclosing process, and do
-- so.
pullUp :: Data t => t -> PassM t
pullUp = doGeneric `extM` doProcess `extM` doExpression
pullUp = doGeneric `extM` doProcess `extM` doExpression `extM` doActual
where
doGeneric :: Data t => t -> PassM t
doGeneric = gmapM pullUp
@ -52,7 +52,27 @@ pullUp = doGeneric `extM` doProcess `extM` doExpression
pull t e
= do -- FIXME Should get Meta from somewhere...
let m = []
spec@(n, _) <- makeNonceValIs m t e
spec@(n, _) <- makeNonceIsExpr m t e
addPulled $ A.ProcSpec m spec
return $ A.ExprVariable m (A.Variable m n)
-- | Pull array actual slices.
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'
_ -> 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
addPulled $ A.ProcSpec m spec
return $ A.Variable m n
doActual a = doGeneric a

5
fco2/Types.hs
View File

@ -141,6 +141,11 @@ 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

6
fco2/Unnest.hs
View File

@ -162,9 +162,9 @@ removeFreeNames = doGeneric `extM` doProcess `extM` doStructured `extM` doValueP
modify $ psDefineName n (nameDef { A.ndType = st' })
-- Add extra arguments to calls of this proc
let newAs = [case am of
A.Abbrev -> A.ActualVariable (A.Variable m n)
_ -> A.ActualExpression (A.ExprVariable m (A.Variable m n))
| (am, n) <- zip ams freeNames]
A.Abbrev -> A.ActualVariable am t (A.Variable m n)
_ -> A.ActualExpression t (A.ExprVariable m (A.Variable m n))
| (am, n, t) <- zip3 ams freeNames types]
child' <- removeFreeNames (addToCalls n newAs child)
return (spec', child')
_ ->

19
fco2/testcases/slices.occ Normal file
View File

@ -0,0 +1,19 @@
PROC A ([]INT unsized)
SKIP
:
PROC B ([5]INT sized)
SKIP
:
PROC P ()
[20]INT foo:
SEQ
A (foo)
A ([foo FROM 10 FOR 5])
A ([foo FOR 12])
A ([foo FROM 12])
B ([foo FOR 5])
[]INT a IS [foo FROM 10 FOR 3]:
SKIP
VAL []INT v IS [foo FROM 10 FOR 3]:
SKIP
: