From dfa1f6c5e62b5fac516d59965986a59226f97327 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Fri, 20 Apr 2007 16:01:15 +0000 Subject: [PATCH] Support array assignment (and check that assignments are sensible), and nested slicing --- fco2/GenerateC.hs | 118 ++++++++++++++++++++++++-------------- fco2/SimplifyExprs.hs | 50 +++++++++------- fco2/TODO | 10 ++-- fco2/testcases/arrays.occ | 2 + fco2/testcases/assign.occ | 3 + fco2/testcases/slices.occ | 2 + 6 files changed, 116 insertions(+), 69 deletions(-) diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index db22b4a..b8d2b16 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -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 () diff --git a/fco2/SimplifyExprs.hs b/fco2/SimplifyExprs.hs index fc5f2b3..0e52a62 100644 --- a/fco2/SimplifyExprs.hs +++ b/fco2/SimplifyExprs.hs @@ -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] diff --git a/fco2/TODO b/fco2/TODO index f2cc8f7..876ff24 100644 --- a/fco2/TODO +++ b/fco2/TODO @@ -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. + diff --git a/fco2/testcases/arrays.occ b/fco2/testcases/arrays.occ index a57bc5c..7a35d3f 100644 --- a/fco2/testcases/arrays.occ +++ b/fco2/testcases/arrays.occ @@ -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 : diff --git a/fco2/testcases/assign.occ b/fco2/testcases/assign.occ index be81f35..77719ad 100644 --- a/fco2/testcases/assign.occ +++ b/fco2/testcases/assign.occ @@ -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] : diff --git a/fco2/testcases/slices.occ b/fco2/testcases/slices.occ index 93c9150..45b1a25 100644 --- a/fco2/testcases/slices.occ +++ b/fco2/testcases/slices.occ @@ -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 :