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

Support array assignment (and check that assignments are sensible), and nested slicing

Browse Source
This commit is contained in:
Adam Sampson 2007-04-20 16:01:15 +00:00
parent e8d61dcac7
commit dfa1f6c5e6
6 changed files with 116 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
fco2/GenerateC.hs
View File

@ -56,18 +56,31 @@ checkJust :: Monad m => Maybe t -> m t
checkJust (Just v) = return v
checkJust Nothing = fail "checkJust failed"
overArray :: CGen () -> A.Type -> (CGen () -> Maybe (CGen ())) -> CGen ()
overArray name (A.Array ds _) func
= do indices <- mapM (\_ -> makeNonce "i") ds
let arg = sequence_ [tell ["[", i, "]"] | i <- indices]
type SubscripterFunction = A.Variable -> A.Variable
overArray :: A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen ()
overArray var func
= do ps <- get
let A.Array ds _ = fromJust $ typeOfVariable ps var
let m = []
specs <- sequence [makeNonceVariable "i" m A.Int A.VariableName A.Original | _ <- ds]
let indices = [A.Variable m n | A.Specification _ n _ <- specs]
let arg = (\var -> foldl (\v s -> A.SubscriptedVariable m s v) var [A.Subscript m $ A.ExprVariable m i | i <- indices])
case func arg of
Just p ->
do sequence_ [do tell ["for (int ", i, " = 0; ", i, " < "]
name
tell ["_sizes[", show v, "]; ", i, "++) {\n"]
do sequence_ [do tell ["for (int "]
genVariable i
tell [" = 0; "]
genVariable i
tell [" < "]
genVariable var
tell ["_sizes[", show v, "]; "]
genVariable i
tell ["++) {\n"]
| (v, i) <- zip [0..] indices]
p
sequence_ [tell ["}\n"] | i <- indices]
sequence_ [tell ["}\n"] | _ <- indices]
Nothing -> return ()
-- | Generate code for one of the Structured types.
@ -274,13 +287,8 @@ genVariable v
inner (A.Variable _ n) = genName n
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 ["]"]
genArraySubscript v es
inner (A.SubscriptedVariable _ (A.SubscriptField m n) v)
= do genVariable v
tell ["->"]
@ -300,6 +308,15 @@ genVariable v
(es', v') = collectSubs v
collectSubs v = ([], v)
genArraySubscript :: A.Variable -> [A.Expression] -> CGen ()
genArraySubscript v es
= do ps <- get
t <- checkJust $ typeOfVariable ps v
let numDims = case t of A.Array ds _ -> length ds
tell ["["]
sequence_ $ intersperse (tell [" + "]) $ genPlainSub v es [0..(numDims - 1)]
tell ["]"]
where
-- | 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
@ -654,32 +671,34 @@ declareArraySizes ds name
tell [" };\n"]
-- | Initialise an item being declared.
declareInit :: A.Type -> CGen () -> CGen () -> Maybe (CGen ())
declareInit (A.Chan _) name index
= Just $ do tell ["ChanInit (&"]
name
index
declareInit :: A.Type -> A.Variable -> Maybe (CGen ())
declareInit (A.Chan _) var
= Just $ do tell ["ChanInit ("]
genVariable var
tell [");\n"]
declareInit t@(A.Array ds t') name _ -- index ignored because arrays can't nest
declareInit t@(A.Array ds t') var
= Just $ do init <- case t' of
A.Chan _ ->
do store <- makeNonce "storage"
tell ["Channel ", store]
do let m = []
A.Specification _ store _ <- makeNonceVariable "storage" m (A.Array ds A.Int) A.VariableName A.Original
let storeV = A.Variable m store
tell ["Channel "]
genName store
genDimensions ds
tell [";\n"]
return (\index -> Just $ do fromJust $ declareInit t' (tell [store]) index
name
index
tell [" = &", store]
index
tell [";\n"])
_ -> return $ declareInit t' name
overArray name t init
declareInit _ _ _ = Nothing
declareArraySizes ds (genName store)
return (\sub -> Just $ do genVariable (sub var)
tell [" = &"]
genVariable (sub storeV)
tell [";\n"]
fromJust $ declareInit t' (sub var))
_ -> return (\sub -> declareInit t' (sub var))
overArray var init
declareInit _ _ = Nothing
-- | Free a declared item that's going out of scope.
declareFree :: A.Type -> CGen () -> CGen () -> Maybe (CGen ())
declareFree _ _ _ = Nothing
declareFree :: A.Type -> A.Variable -> Maybe (CGen ())
declareFree _ _ = Nothing
{-
Original Abbrev
@ -697,12 +716,12 @@ CHAN OF INT c IS d: Channel *c = d;
const int *ds_sizes = cs_sizes;
-}
introduceSpec :: A.Specification -> CGen ()
introduceSpec (A.Specification _ n (A.Declaration _ t))
introduceSpec (A.Specification m n (A.Declaration _ t))
= do genDeclaration t n
case t of
A.Array ds _ -> declareArraySizes ds (genName n)
_ -> return ()
case declareInit t (genName n) (return ()) of
case declareInit t (A.Variable m n) of
Just p -> p
Nothing -> return ()
introduceSpec (A.Specification _ n (A.Is _ am t v))
@ -770,13 +789,15 @@ introduceSpec (A.Specification _ n (A.Function _ _ _ _)) = missing "introduceSpe
introduceSpec n = missing $ "introduceSpec " ++ show n
removeSpec :: A.Specification -> CGen ()
removeSpec (A.Specification _ n (A.Declaration _ t))
removeSpec (A.Specification m n (A.Declaration _ t))
= case t of
A.Array _ t' -> overArray (genName n) t (declareFree t' (genName n))
A.Array _ t' -> overArray var (\sub -> declareFree t' (sub var))
_ ->
do case declareFree t (genName n) (return ()) of
do case declareFree t var of
Just p -> p
Nothing -> return ()
where
var = A.Variable m n
removeSpec _ = return ()
--}}}
@ -857,11 +878,22 @@ genAssign :: [A.Variable] -> A.ExpressionList -> CGen ()
genAssign [v] el
= case el of
A.FunctionCallList m n es -> missing "function call"
A.ExpressionList m es ->
do genVariable v
tell [" = "]
genExpression (head es)
tell [";\n"]
A.ExpressionList m [e] ->
do ps <- get
let t = fromJust $ typeOfVariable ps v
doAssign t v e
where
doAssign :: A.Type -> A.Variable -> A.Expression -> CGen ()
doAssign t@(A.Array _ subT) toV (A.ExprVariable m fromV)
= overArray fromV (\sub -> Just $ doAssign subT (sub toV) (A.ExprVariable m (sub fromV)))
doAssign t v e
= case scalarType t of
Just _ ->
do genVariable v
tell [" = "]
genExpression e
tell [";\n"]
Nothing -> missing $ "assignment of type " ++ show t
--}}}
--{{{ input
genInput :: A.Variable -> A.InputMode -> CGen ()

50
fco2/SimplifyExprs.hs
View File

@ -52,7 +52,7 @@ functionsToProcs = doGeneric `extM` doSpecification
-- | 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 `extM` doActual `extM` doExpressionList
pullUp = doGeneric `extM` doProcess `extM` doSpecification `extM` doExpression `extM` doVariable `extM` doExpressionList
where
doGeneric :: Data t => t -> PassM t
doGeneric = gmapM pullUp
@ -70,6 +70,16 @@ pullUp = doGeneric `extM` doProcess `extM` doExpression `extM` doActual `extM` d
modify (\ps -> ps { psPulledItems = psPulledItems origPS })
return p'
-- | *Don't* pull anything that's already an abbreviation.
doSpecification :: A.Specification -> PassM A.Specification
doSpecification (A.Specification m n (A.Is m' am t v))
= do v' <- doGeneric v -- note doGeneric rather than pullUp
return $ A.Specification m n (A.Is m' am t v')
doSpecification (A.Specification m n (A.IsExpr m' am t e))
= do e' <- doGeneric e -- note doGeneric rather than pullUp
return $ A.Specification m n (A.IsExpr m' am t e')
doSpecification s = doGeneric s
-- | Pull array expressions that aren't already non-subscripted variables.
doExpression :: A.Expression -> PassM A.Expression
doExpression e
@ -78,7 +88,7 @@ pullUp = doGeneric `extM` doProcess `extM` doExpression `extM` doActual `extM` d
let t = fromJust $ typeOfExpression ps e'
case t of
A.Array _ _ ->
case e of
case e' of
A.ExprVariable _ (A.Variable _ _) -> return e'
_ -> pull t e'
_ -> return e'
@ -91,26 +101,22 @@ pullUp = doGeneric `extM` doProcess `extM` doExpression `extM` doActual `extM` d
addPulled $ A.ProcSpec m spec
return $ A.ExprVariable m (A.Variable m n)
-- | 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 _ _ ->
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@(A.Specification _ n _) <- makeNonceIs "subscript_actual" m t am v
addPulled $ A.ProcSpec m spec
return $ A.Variable m n
doActual a = doGeneric a
-- | Pull any variable subscript that results in an array.
doVariable :: A.Variable -> PassM A.Variable
doVariable v@(A.SubscriptedVariable m _ _)
= do v' <- doGeneric v
ps <- get
let t = fromJust $ typeOfVariable ps v'
case t of
A.Array _ _ ->
do let am = case fromJust $ abbrevModeOfVariable ps v' of
A.Original -> A.Abbrev
t -> t
spec@(A.Specification _ n _) <- makeNonceIs "array_slice" m t am v'
addPulled $ A.ProcSpec m spec
return $ A.Variable m n
_ -> return v'
doVariable v = doGeneric v
-- | Convert a FUNCTION call into some variables and a PROC call.
convertFuncCall :: Meta -> A.Name -> [A.Expression] -> PassM [A.Variable]

10
fco2/TODO
View File

@ -68,10 +68,6 @@ The indentation parser is way too simplistic.
ParseState should be called something more sensible, since most of it has
nothing to do with parsing.
pullUp should pull *any* array slice that isn't already an abbreviation and
turn it into one -- should be straightforward using a rule that matches
abbrevs. This would make nested slicing work.
Types needs cleaning up and Haddocking.
Types should provide versions of the functions that work in a state monad.
@ -80,3 +76,9 @@ MonadState for it?), that'd be even better.
If we have constant folding, we're three-quarters of the way towards having an
occam *interpreter*.
Pass to turn subscripted expressions into subscripted variables.
Think about simplifying the subscript types -- just have a single data type
that takes several expressions.

2
fco2/testcases/arrays.occ
View File

@ -56,4 +56,6 @@ PROC P ()
chan.abbrev.abbrev[0] ! 42
chan.abbrev2 IS chan.array:
S (chan.abbrev2)
[4][2]CHAN OF INT chan.array.2d:
SKIP
:

3
fco2/testcases/assign.occ
View File

@ -1,7 +1,10 @@
PROC P ()
INT a, b, c:
INT d, e, f:
[10]INT as, bs:
SEQ
a := d
a, b, c := d, e, f
as := bs
[as FROM 5] := [bs FROM 2 FOR 5]
:

2
fco2/testcases/slices.occ
View File

@ -16,4 +16,6 @@ PROC P ()
SKIP
VAL []INT v IS [foo FROM 10 FOR 3]:
SKIP
VAL INT nasty IS [[[foo FROM 1] FOR 3] FROM 1 FOR 2][1]:
SKIP
: