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

Handle IsChannelArray when adding _sizes.

Browse Source 
This also refactors the sizes-array-declaring code, pulling the
declaration of static sizes out to a helper function, and does a
couple of other minor cleanups to match.
This commit is contained in:
Adam Sampson 2008-06-09 21:32:04 +00:00
parent ad875bd477
commit 04f72a62db
1 changed files with 36 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
backends/BackendPasses.hs
View File

@ -181,35 +181,41 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
doStructured :: Data a => A.Structured a -> PassM (A.Structured a) doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
doStructured str@(A.Spec m sp@(A.Specification m' n spec) s) doStructured str@(A.Spec m sp@(A.Specification m' n spec) s)
= do t <- typeOfSpec spec = do t <- typeOfSpec spec
case (spec,t) of case (spec, t) of
(_,Just (A.Array ds elemT)) -> (_, Just (A.Array ds elemT)) ->
do sizeSpec <- if elem A.UnknownDimension ds do let n_sizes = append_sizes n
then let defineStaticSizes ds
= do let st = makeStaticSizeSpec m' n_sizes ds
defineSizesName m' n_sizes st
return $ A.Specification m' n_sizes st
sizeSpec <-
if elem A.UnknownDimension ds
-- At least one unknown dimension: -- At least one unknown dimension:
case spec of then case spec of
-- TODO I think retyping a channel array ends up here, and probably isn't handled right -- TODO I think retyping a channel array ends up
(A.Retypes _ _ _ v) -> retypesSizes m' (append_sizes n) ds elemT v -- here, and probably isn't handled right
_ -> A.Retypes _ _ _ v ->
let n_sizes = append_sizes n in retypesSizes m' n_sizes ds elemT v
case spec of A.Is _ _ _ v ->
A.Is _ _ _ v -> abbrevVarSizes m n_sizes ds v abbrevVarSizes m n_sizes ds v
A.IsExpr _ _ _ (A.ExprVariable _ v) -> abbrevVarSizes m n_sizes ds v A.IsChannelArray _ _ vs ->
-- The dimensions in a literal should all be static: defineStaticSizes [makeDimension m' (length vs)]
A.IsExpr _ _ _ (A.Literal _ (A.Array ds _) _) -> A.IsExpr _ _ _ (A.ExprVariable _ v) ->
do let sizeSpecType = makeStaticSizeSpec m' n_sizes ds abbrevVarSizes m n_sizes ds v
defineSizesName m' n_sizes sizeSpecType -- The dimensions in a literal should all be
return $ A.Specification m' n_sizes sizeSpecType -- static:
_ -> dieP m $ "Could not handle unknown array spec: " ++ pshow spec A.IsExpr _ _ _ (A.Literal _ (A.Array ds' _) _) ->
-- Everything is statically sized: defineStaticSizes ds'
else do let n_sizes = append_sizes n _ ->
sizeSpecType = makeStaticSizeSpec m' n_sizes ds dieP m $ "Could not handle unknown array spec: "
sizeSpec = A.Specification m' n_sizes sizeSpecType ++ pshow spec
defineSizesName m' n_sizes sizeSpecType -- Everything is statically sized:
return sizeSpec else defineStaticSizes ds
return (A.Spec m sizeSpec $ A.Spec m sp $ s) return (A.Spec m sizeSpec $ A.Spec m sp $ s)
(A.RecordType m _ fs, _) -> (A.RecordType m _ fs, _) ->
do fieldDeclarations <- foldM (declareFieldSizes (A.nameName n) m) s fs do fieldDeclarations <-
return $ A.Spec m sp fieldDeclarations foldM (declareFieldSizes (A.nameName n) m) s fs
return $ A.Spec m sp fieldDeclarations
_ -> return str _ -> return str
doStructured s = return s doStructured s = return s
@ -279,7 +285,8 @@ addSizesActualParameters = occamOnlyPass "Add array-size arrays to PROC calls"
(applyDepthM doProcess) (applyDepthM doProcess)
where where
doProcess :: A.Process -> PassM A.Process doProcess :: A.Process -> PassM A.Process
doProcess (A.ProcCall m n params) = concatMapM transformActual params >>* A.ProcCall m n doProcess (A.ProcCall m n params)
= concatMapM transformActual params >>* A.ProcCall m n
doProcess p = return p doProcess p = return p
transformActual :: A.Actual -> PassM [A.Actual] transformActual :: A.Actual -> PassM [A.Actual]
@ -317,3 +324,4 @@ simplifySlices = occamOnlyPass "Simplify array slices"
A.UnknownDimension -> return $ A.SizeVariable m' v A.UnknownDimension -> return $ A.SizeVariable m' v
return (A.SubscriptedVariable m (A.SubscriptFromFor m' check from (A.Dyadic m A.Subtr limit from)) v) return (A.SubscriptedVariable m (A.SubscriptFromFor m' check from (A.Dyadic m A.Subtr limit from)) v)
doVariable v = return v doVariable v = return v