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

Altered the backend passes to use all the new VariableSizes mechanisms rather than the old stuff

Browse Source 
This is quite a big patch, as it reworks a large pass.  The three backend passes dealing with sizes stuff have now been merged into one (because the traversal order is important).

Instead of generating sizes arrays by blindly appending "_sizes", we now create nonces and store them in the csArraySizes map in CompState, which is a bit less hacky.

Added to that, we also generate constant-size arrays (e.g. for [8]) -- which are needed in case we pass the array to a PROC that has a flexible dimension -- at the top of the whole program, and use that array for every variable with that size (so if foo and bar have the same size, we use the same sizes array from the top of the program).
This commit is contained in:
Neil Brown 2009-03-31 10:22:34 +00:00
parent a10921d53a
commit 4d2cdc0a9d
1 changed files with 199 additions and 175 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

374
backends/BackendPasses.hs
View File

@ -17,7 +17,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
-} -}
-- | Passes associated with the backends -- | Passes associated with the backends
module BackendPasses (addSizesActualParameters, addSizesFormalParameters, declareSizesArray, simplifySlices, backendPasses, transformWaitFor) where module BackendPasses (backendPasses, transformWaitFor) where
import Control.Monad.State import Control.Monad.State
import Data.Generics import Data.Generics
@ -46,8 +46,6 @@ backendPasses =
, removeUnneededDirections , removeUnneededDirections
, simplifySlices , simplifySlices
, declareSizesArray , declareSizesArray
, addSizesFormalParameters
, addSizesActualParameters
, fixMinInt , fixMinInt
-- This is not needed unless forking: -- This is not needed unless forking:
-- , mobileReturn -- , mobileReturn
@ -153,8 +151,76 @@ transformWaitFor = cOnlyPass "Transform wait for guards into wait until guards"
doWaitFor m a = return $ A.Only m a doWaitFor m a = return $ A.Only m a
append_sizes :: A.Name -> A.Name -- | Declares an array filled with constant sizes
append_sizes n = n {A.nameName = A.nameName n ++ "_sizes"} -- If any extra sizes are declared, will add them to the current context
getSizes :: Meta -> [A.Expression] -> PassM A.Name
getSizes m [] = dieP m "Empty list of dimensions in getSizes"
getSizes m es
= do ces <- mapM evalIntExpression es
ss <- getCompState >>* csGlobalSizes
case Map.lookup ces ss of
Just n -> return $ A.Name m n
Nothing -> let base = "sizes" ++ concat (intersperse "_" $ map show ces)
t = A.Array [A.Dimension $ makeConstant m $ length es] A.Int
val = A.ArrayListLiteral m $ A.Several m $
map (A.Only m) $ es
e = A.Literal m t val
in do spec@(A.Specification _ n _) <- makeNonceIsExpr base m t e
addPulled (m, Left spec)
modify $ \cs -> cs { csGlobalSizes = Map.insert ces (A.nameName n) ss }
return n
-- Forms a slice that drops a certain amount of elements:
sliceDrop :: Meta -> Int -> Int -> A.Variable -> A.Variable
sliceDrop m skip total
= A.SubscriptedVariable m (A.SubscriptFromFor m A.NoCheck
(makeConstant m skip) (makeConstant m (total - skip)))
-- Used by findVarSizes when it can't descend any further:
-- The Variable returned will always be Just, but it makes use from findVarSizes
-- easier
findSizeForVar :: Meta -> Int -> A.Variable ->
PassM (Maybe A.Name, Maybe A.Variable, [A.Expression])
findSizeForVar m skip v
= do t <- astTypeOf v
case t of
A.Array ds _
| A.UnknownDimension `notElem` ds
-> do let es = drop skip [e | A.Dimension e <- ds]
n <- getSizes m es
return (Just n, Just $ A.Variable m n, es)
| otherwise
-> return (Nothing, Just $ sliceDrop m skip (length ds) $ A.VariableSizes m v,
[A.ExprVariable m $ A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant
m i) (A.VariableSizes m v)
| i <- [skip .. (length ds - 1)]])
-- Gets the variable that holds the sizes of the given variable. The first parameter
-- is the number of dimensions to skip. Assumes simplifySlices has already been
-- run
findVarSizes :: Int -> A.Variable -> PassM (Maybe A.Name, Maybe A.Variable, [A.Expression])
findVarSizes skip v@(A.Variable m _) = findSizeForVar m skip v
findVarSizes skip (A.DirectedVariable _ _ v) = findVarSizes skip v
-- Fields are either constant or need a VariableSizes:
findVarSizes skip v@(A.SubscriptedVariable m (A.SubscriptField {}) _)
= findSizeForVar m skip v
-- For a specific subscript, drop one extra dimension off the inner dimensions:
findVarSizes skip (A.SubscriptedVariable _ (A.Subscript {}) v)
= findVarSizes (skip + 1) v
-- This covers all slicing:
findVarSizes skip v@(A.SubscriptedVariable m (A.SubscriptFromFor _ _ from for) innerV)
-- If we are skipping at least one dimension, we can ignore slicing:
| skip > 0 = findVarSizes skip innerV
| otherwise = do (_, _, _:es) <- findVarSizes 0 innerV
return (Nothing, Nothing, for : es)
-- the size of a dereference is the size of the mobile array:
findVarSizes skip (A.DerefVariable _ v) = findVarSizes skip v
-- Not sure this should ever happen, but no harm:
findVarSizes skip (A.VariableSizes m v)
= do A.Array ds _ <- astTypeOf v
let es = drop skip [makeConstant m (length ds)]
n <- getSizes m es
return (Just n, Just $ A.Variable m n, es)
-- | Declares a _sizes array for every array, statically sized or dynamically sized. -- | Declares a _sizes array for every array, statically sized or dynamically sized.
@ -163,8 +229,24 @@ declareSizesArray :: Pass
declareSizesArray = occamOnlyPass "Declare array-size arrays" declareSizesArray = occamOnlyPass "Declare array-size arrays"
(prereq ++ [Prop.slicesSimplified, Prop.arrayConstructorsRemoved]) (prereq ++ [Prop.slicesSimplified, Prop.arrayConstructorsRemoved])
[Prop.arraySizesDeclared] [Prop.arraySizesDeclared]
(applyDepthSM doStructured) (passOnlyOnAST "declareSizesArray" $
\t -> do pushPullContext
t' <- recurse t >>= applyPulled
popPullContext
exts <- getCompState >>* csExternals
exts' <- sequence [do fs' <- transformExternal (findMeta t) fs
return $ (n, fs')
| (n, fs) <- exts]
modify $ \cs -> cs { csExternals = exts' }
return t'
)
where where
ops :: OpsM PassM
ops = baseOp `extOpS` doStructured `extOp` doProcess
recurse, descend :: Data a => Transform a
recurse = makeRecurse ops
descend = makeDescend ops
defineSizesName :: Meta -> A.Name -> A.SpecType -> PassM () defineSizesName :: Meta -> A.Name -> A.SpecType -> PassM ()
defineSizesName m n spec defineSizesName m n spec
= defineName n $ A.NameDef { A.ndMeta = m = defineName n $ A.NameDef { A.ndMeta = m
@ -176,17 +258,12 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
, A.ndPlacement = A.Unplaced , A.ndPlacement = A.Unplaced
} }
-- Strips all the array subscripts from a variable: addSizes :: String -> A.Name -> PassM ()
findInnerVar :: A.Variable -> (Maybe A.Expression, A.Variable) addSizes k v = modify $ \cs -> cs { csArraySizes = Map.insert k v $ csArraySizes cs }
findInnerVar wv@(A.SubscriptedVariable m sub v) = case sub of
A.SubscriptField {} -> (Nothing, wv)
A.SubscriptFromFor _ _ _ for -> (Just for, snd $ findInnerVar v) -- Keep the outer most
A.Subscript {} -> findInnerVar v
findInnerVar (A.DirectedVariable _ _ v) = findInnerVar v
findInnerVar v = (Nothing, v)
-- | Generate the @_sizes@ array for a 'Retypes' expression. -- | Generate the @_sizes@ array for a 'Retypes' expression.
retypesSizes :: Meta -> A.Name -> [A.Dimension] -> A.Type -> A.Variable -> PassM A.Specification retypesSizes :: Meta -> A.Name -> [A.Dimension] -> A.Type -> A.Variable
-> PassM (A.Name, Maybe A.SpecType)
retypesSizes m n_sizes ds elemT v@(A.Variable _ nSrc) retypesSizes m n_sizes ds elemT v@(A.Variable _ nSrc)
= do biDest <- bytesInType (A.Array ds elemT) = do biDest <- bytesInType (A.Array ds elemT)
tSrc <- astTypeOf v tSrc <- astTypeOf v
@ -203,171 +280,120 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
do BIJust elementSize <- bytesInType t do BIJust elementSize <- bytesInType t
return $ foldl mulExprs elementSize dSizes return $ foldl mulExprs elementSize dSizes
where where
srcSizes = A.Variable m $ append_sizes nSrc
dSizes = [case d of dSizes = [case d of
-- Fixed dimension. -- Fixed dimension.
A.Dimension e -> e A.Dimension e -> e
-- Variable dimension -- use the corresponding -- Variable dimension -- use the corresponding
-- element of its _sizes array. -- element of its _sizes array.
A.UnknownDimension -> A.UnknownDimension -> A.ExprVariable m $ specificDimSize i v
A.ExprVariable m $ A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m i) srcSizes
| (d, i) <- zip ds [0..]] | (d, i) <- zip ds [0..]]
_ -> dieP m "Cannot compute size of source type" _ -> dieP m "Cannot compute size of source type"
-- Build the _sizes array for the destination. -- Build the _sizes array for the destination.
sizeSpecType <- sizeSpecType <- return $
case biDest of case biDest of
-- Destination size is fixed -- so we must know the dimensions. -- Destination size is fixed -- so we must know the dimensions.
BIJust _ -> BIJust _ -> makeSizeSpec m [e | A.Dimension e <- ds]
return $ makeStaticSizeSpec m n_sizes ds
-- Destination has one free dimension, so we need to compute -- Destination has one free dimension, so we need to compute
-- it. -- it.
BIOneFree destSize n -> BIOneFree destSize n ->
let newDim = A.Dimension $ divExprs srcSize destSize let newDim = A.Dimension $ divExprs srcSize destSize
ds' = replaceAt n newDim ds in ds' = replaceAt n newDim ds in
return $ makeStaticSizeSpec m n_sizes ds' makeSizeSpec m [e | A.Dimension e <- ds']
defineSizesName m n_sizes sizeSpecType return (n_sizes, Just sizeSpecType)
return $ A.Specification m n_sizes sizeSpecType
abbrevVarSizes :: Meta -> A.Name -> [A.Dimension] -> A.Variable -> PassM A.Specification varSizes :: Meta -> A.Name -> A.Variable -> PassM (A.Name, Maybe A.SpecType)
abbrevVarSizes m n_sizes ds outerV varSizes m n_sizes abbrevV
= do -- Find the inner most variable (i.e. strip all the array subscripts) = do sizeExpr <- findVarSizes 0 abbrevV
let (sliceSize, innerV) = findInnerVar outerV case sizeExpr of
-- Figure out the _sizes variable to abbreviate; either the _sizes variable corresponding -- It was constant, and a new global declaration made, so we just
-- to the abbreviation source (for everything but record fields) -- need to return the name, and no specification
-- or the globally declared record field _sizes constant (Just sizeN, _, _) -> return (sizeN, Nothing)
varSrcSizes <- case innerV of -- We can use/slice a previous sizes item, so our abbreviation is
A.Variable _ srcN -> return (A.ExprVariable m $ A.Variable m $ append_sizes srcN) -- quite simple:
A.SubscriptedVariable _ (A.SubscriptField _ fieldName) recordV -> (Nothing, Just sizeV, _) ->
do A.Record recordName <- astTypeOf recordV do t <- astTypeOf sizeV
return (A.ExprVariable m $ A.Variable m $ A.Name m $ A.nameName recordName ++ A.nameName fieldName ++ "_sizes") return (n_sizes, Just $ A.Is m A.ValAbbrev t (A.ActualVariable sizeV))
A.DirectedVariable _ _ (A.Variable _ srcN) -> return (A.ExprVariable -- We have to declare a full array of sizes:
m $ A.Variable m $ append_sizes srcN) (Nothing, Nothing, es) -> return (n_sizes, Just $ makeSizeSpec m es)
_ -> return $ A.AllSizesVariable m innerV
-- Get the dimensions of the source variable: makeSizeSpec :: Meta -> [A.Expression] -> A.SpecType
innerVT <- astTypeOf innerV makeSizeSpec m es = A.Is m A.ValAbbrev t (A.ActualExpression e)
srcDs <- case innerVT of where
(A.Array srcDs _) -> return srcDs e = A.Literal m t lit
_ -> diePC m $ formatCode ("Unexpected type in abbrev var" lit = A.ArrayListLiteral m $ A.Several m $ map (A.Only m) es
++ " (%) in declareSizesArray: %") innerV innerVT t = A.Array [A.Dimension $ makeConstant m (length es)] A.Int
-- Calculate the correct subscript into the source _sizes variable to get to the dimensions for the destination:
let sizeDiff = length srcDs - length ds
subSrcSizeVar = A.SubscriptedExpr m (A.SubscriptFromFor m A.NoCheck (makeConstant m sizeDiff) (makeConstant m $ length ds)) varSrcSizes
sizeType = A.Array [makeDimension m $ length ds] A.Int
sizeExpr = case sliceSize of
Just exp -> let subDims = [A.SubscriptedExpr m (A.Subscript m A.NoCheck $ makeConstant m n) varSrcSizes | n <- [1 .. (length srcDs - 1)]] in
A.Literal m sizeType $ A.ArrayListLiteral m $ A.Several m $
A.Only m exp : map (A.Only m) subDims
Nothing -> subSrcSizeVar
sizeSpecType = A.Is m A.ValAbbrev sizeType (A.ActualExpression sizeExpr)
defineSizesName m n_sizes sizeSpecType
return $ A.Specification m n_sizes sizeSpecType
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 let n_sizes = append_sizes n -- nonce_sizes is a suggested name, may not actually be used:
let defineStaticSizes ds do nonce_sizes <- makeNonce (A.nameName n ++ "_sizes") >>* A.Name m
= do let st = makeStaticSizeSpec m' n_sizes ds let varSize = varSizes m nonce_sizes
defineSizesName m' n_sizes st (n_sizes, msizeSpec) <-
return $ A.Specification m' n_sizes st case spec of
sizeSpec <- -- TODO I think retyping a channel array ends up
if elem A.UnknownDimension ds -- here, and probably isn't handled right
-- At least one unknown dimension: A.Retypes _ _ _ v -> retypesSizes m' nonce_sizes ds elemT v
then case spec of A.Is _ _ _ (A.ActualVariable v) -> varSize v
-- TODO I think retyping a channel array ends up A.Is _ _ _ (A.ActualExpression (A.ExprVariable _ v)) -> varSize v
-- here, and probably isn't handled right -- For all other cases, we should be able to figure
A.Retypes _ _ _ v -> -- out the size from ourself:
retypesSizes m' n_sizes ds elemT v _ -> varSize (A.Variable m n)
A.Is _ _ _ (A.ActualVariable v) -> addSizes (A.nameName n) n_sizes
abbrevVarSizes m n_sizes ds v maybe (return ()) (defineSizesName m n_sizes) msizeSpec
A.Is _ _ _ (A.ActualChannelArray vs) -> s' <- recurse s
defineStaticSizes [makeDimension m' (length vs)] return (maybe id (A.Spec m . A.Specification m n_sizes) msizeSpec $ A.Spec m sp s')
A.Is _ _ _ (A.ActualExpression (A.ExprVariable _ v)) -> (A.Proc m' sm args body, _) ->
abbrevVarSizes m n_sizes ds v do -- We descend into the scope first, so that all the actuals get
-- The dimensions in a literal should all be -- fixed before the formals:
-- static: s' <- recurse s
A.Is _ _ _ (A.ActualExpression (A.Literal _ (A.Array ds' _) _)) -> (args', newargs) <- transformFormals False m args
defineStaticSizes ds' sequence_ [defineSizesName m' n (A.Declaration m' t)
_ -> | A.Formal _ t n <- newargs]
dieP m $ "Could not handle unknown array spec: " -- We descend into the body after the formals have been
++ pshow spec -- processed, but before our spec is updated (to avoid
-- Everything is statically sized: -- problems for recursive PROCs with arrays.
else defineStaticSizes ds body' <- recurse body
return (A.Spec m sizeSpec $ A.Spec m sp $ s) let newspec = A.Proc m' sm args' body'
(A.RecordType m _ fs, _) -> modify (\cs -> cs {csNames = Map.adjust (\nd -> nd { A.ndSpecType = newspec })
do fieldDeclarations <- (A.nameName n) (csNames cs)})
foldM (declareFieldSizes (A.nameName n) m) s fs return $ A.Spec m (A.Specification m n newspec) s'
return $ A.Spec m sp fieldDeclarations _ -> descend str
_ -> return str doStructured s = descend s
doStructured s = return s
makeStaticSizeSpec :: Meta -> A.Name -> [A.Dimension] -> A.SpecType transformExternal :: Meta -> [A.Formal] -> PassM [A.Formal]
makeStaticSizeSpec m n ds = makeDynamicSizeSpec m n es transformExternal m args
where = do (args', newargs) <- transformFormals True m args
es = [case d of A.Dimension e -> e | d <- ds] sequence_ [defineSizesName m n (A.Declaration m t)
| A.Formal _ t n <- newargs]
makeDynamicSizeSpec :: Meta -> A.Name -> [A.Expression] -> A.SpecType return args'
makeDynamicSizeSpec m n es = sizeSpecType
where
sizeType = A.Array [makeDimension m $ length es] A.Int
sizeLit = A.Literal m sizeType $ A.ArrayListLiteral m $ A.Several m $ map (A.Only m) es
sizeSpecType = A.Is m A.ValAbbrev sizeType $ A.ActualExpression sizeLit
declareFieldSizes :: Data a => String -> Meta -> A.Structured a -> (A.Name, A.Type) -> PassM (A.Structured a)
declareFieldSizes prep m inner (n, A.Array ds _)
= do let n_sizes = n {A.nameName = prep ++ A.nameName n}
sizeSpecType = makeStaticSizeSpec m n_sizes ds
defineSizesName m n_sizes sizeSpecType
return $ A.Spec m (A.Specification m n_sizes sizeSpecType) inner
declareFieldSizes _ _ s _ = return s
-- | A pass for adding _sizes parameters to PROC arguments
-- TODO in future, only add _sizes for variable-sized parameters
addSizesFormalParameters :: Pass
addSizesFormalParameters = occamOnlyPass "Add array-size arrays to PROC headers"
(prereq ++ [Prop.arraySizesDeclared])
[]
(\t -> do t' <- applyDepthM (doSpecification False) t
cs <- getCompState
sequence_ [doSpecification True $ A.Specification emptyMeta (A.Name emptyMeta n)
(A.Proc emptyMeta (A.PlainSpec, A.PlainRec)
fs (A.Skip emptyMeta))
| (n, fs) <- csExternals cs]
return t')
where
doSpecification :: Bool -> A.Specification -> PassM A.Specification
doSpecification ext (A.Specification m n (A.Proc m' sm args body))
= do (args', newargs) <- transformFormals ext m args
let newspec = A.Proc m' sm args' body
modify (\cs -> cs {csNames = Map.adjust (\nd -> nd { A.ndSpecType = newspec }) (A.nameName n) (csNames cs)})
mapM_ (recordArg m') newargs
return $ A.Specification m n newspec
doSpecification _ st = return st
recordArg :: Meta -> A.Formal -> PassM ()
recordArg m (A.Formal am t n)
= defineName n $ A.NameDef {
A.ndMeta = m
,A.ndName = A.nameName n
,A.ndOrigName = A.nameName n
,A.ndSpecType = A.Declaration m t
,A.ndAbbrevMode = A.ValAbbrev
,A.ndNameSource = A.NameNonce
,A.ndPlacement = A.Unplaced}
transformFormals :: Bool -> Meta -> [A.Formal] -> PassM ([A.Formal], [A.Formal]) transformFormals :: Bool -> Meta -> [A.Formal] -> PassM ([A.Formal], [A.Formal])
transformFormals _ _ [] = return ([],[]) transformFormals _ _ [] = return ([],[])
transformFormals ext m ((f@(A.Formal am t n)):fs) transformFormals ext m ((f@(A.Formal am t n)):fs)
= case (t, ext) of = case (t, ext) of
(A.Array ds _, False) -> -- For occam PROCs, only bother adding the extra formal if the dimension
-- is unknown:
(A.Array ds _, False)
| A.UnknownDimension `elem` ds ->
do let sizeType = A.Array [makeDimension m $ length ds] A.Int do let sizeType = A.Array [makeDimension m $ length ds] A.Int
let newf = A.Formal A.ValAbbrev sizeType (append_sizes n) n_sizes <- makeNonce (A.nameName n ++ "_sizes") >>* A.Name m
addSizes (A.nameName n) n_sizes
let newf = A.Formal A.ValAbbrev sizeType n_sizes
(rest, moreNew) <- transformFormals ext m fs (rest, moreNew) <- transformFormals ext m fs
return (f : newf : rest, newf : moreNew) return (f : newf : rest, newf : moreNew)
-- But even if all the dimensions are known, we must still add the sizes
-- as a global thingy:
| otherwise ->
do (Just n_sizes, _, _) <- findVarSizes 0 (A.Variable m n)
addSizes (A.nameName n) n_sizes
(rest, moreNew) <- transformFormals ext m fs
return (f : rest, moreNew)
-- For externals, we always add extra formals:
(A.Array ds _, True) -> (A.Array ds _, True) ->
do params <- replicateM (length ds) $ makeNonce "ext_size" do params <- replicateM (length ds) $ makeNonce "ext_size"
let newfs = map (A.Formal A.ValAbbrev A.Int . A.Name m) params let newfs = map (A.Formal A.ValAbbrev A.Int . A.Name m) params
@ -376,47 +402,45 @@ addSizesFormalParameters = occamOnlyPass "Add array-size arrays to PROC headers"
_ -> do (rest, new) <- transformFormals ext m fs _ -> do (rest, new) <- transformFormals ext m fs
return (f : rest, new) return (f : rest, new)
-- | A pass for adding _sizes parameters to actuals in PROC calls
addSizesActualParameters :: Pass
addSizesActualParameters = occamOnlyPass "Add array-size arrays to PROC calls"
(prereq ++ [Prop.arraySizesDeclared])
[]
(applyDepthM doProcess)
where
doProcess :: A.Process -> PassM A.Process doProcess :: A.Process -> PassM A.Process
doProcess (A.ProcCall m n params) doProcess (A.ProcCall m n params)
= do ext <- getCompState >>* csExternals >>* lookup (A.nameName n) >>* isJust = do ext <- getCompState >>* csExternals >>* lookup (A.nameName n) >>* isJust
concatMapM (transformActual ext) params >>* A.ProcCall m n A.Proc _ _ fs _ <- specTypeOfName n
doProcess p = return p concatMapM (transformActual ext) (zip fs params) >>* A.ProcCall m n
doProcess p = descend p
transformActual :: Bool -> A.Actual -> PassM [A.Actual] transformActual :: Bool -> (A.Formal, A.Actual) -> PassM [A.Actual]
transformActual ext a@(A.ActualVariable v) transformActual ext (A.Formal _ t _, a@(A.ActualVariable v))
= transformActualVariable ext a v = transformActualVariable ext t a v
transformActual ext a@(A.ActualExpression (A.ExprVariable _ v)) transformActual ext (A.Formal _ t _, a@(A.ActualExpression (A.ExprVariable _ v)))
= transformActualVariable ext a v = transformActualVariable ext t a v
transformActual _ a = return [a] transformActual _ (_, a) = return [a]
transformActualVariable :: Bool -> A.Actual -> A.Variable -> PassM [A.Actual] transformActualVariable :: Bool -> A.Type -> A.Actual -> A.Variable -> PassM [A.Actual]
transformActualVariable ext a v transformActualVariable ext t a v
= do t <- astTypeOf v = case (t, ext) of
case (t, ext) of -- Note that t is the formal type, not the type of the actual
(A.Array ds _, False) -> (A.Array ds _, False) | A.UnknownDimension `elem` ds ->
return [a, A.ActualExpression $ sizes v] do sizeV <- sizes v
return [a, A.ActualVariable sizeV]
(A.Array ds _, True) -> (A.Array ds _, True) ->
let acts = map sub [0 .. (length ds - 1)] let acts = map (sub $ A.VariableSizes m v) [0 .. (length ds - 1)]
in return $ a : acts in return $ a : acts
_ -> return [a] _ -> return [a]
where where
sizes v@(A.Variable m _) = A.AllSizesVariable m v sizes v@(A.Variable m n)
= do ss <- getCompState >>* csArraySizes
case Map.lookup (A.nameName n) ss of
Just n_sizes -> return $ A.Variable m n_sizes
Nothing -> return $ A.VariableSizes m v
sizes (A.DerefVariable _ v) = sizes v sizes (A.DerefVariable _ v) = sizes v
sizes (A.DirectedVariable _ _ v) = sizes v
sizes (A.SubscriptedVariable _ _ v) = sizes v
m = findMeta v m = findMeta v
sub n = A.ActualExpression $ A.SubscriptedExpr m sub v n = A.ActualVariable $ A.SubscriptedVariable m
(A.Subscript m A.NoCheck $ makeConstant m n) (A.Subscript m A.NoCheck $ makeConstant m n)
(sizes v) v
-- | Transforms all slices into the FromFor form. -- | Transforms all slices into the FromFor form.
simplifySlices :: Pass simplifySlices :: Pass
@ -432,7 +456,7 @@ simplifySlices = occamOnlyPass "Simplify array slices"
= do A.Array (d:_) _ <- astTypeOf v = do A.Array (d:_) _ <- astTypeOf v
limit <- case d of limit <- case d of
A.Dimension n -> return n A.Dimension n -> return n
A.UnknownDimension -> return $ A.SizeVariable m' v A.UnknownDimension -> return $ A.ExprVariable m $ specificDimSize 0 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