e457d82f0c
This may seem like an odd change, but it simplifies the logic a lot. I kept having problems with passes not operating on externals (e.g. functions-to-procs, adding array sizes, constant folding in array dimensions) and adding a special case every time to also process the externals was getting silly. Putting the externals in the AST therefore made sense, but I didn't want to just add dummy bodies as this would cause them to throw up errors (e.g. in the type-checking for functions). So I turned the bodies into a Maybe type, and that has worked out well. I also stopped storing the formals in csExternals (since they are now in csNames, and the tree), which streamlined that nicely, and stopped me having to keep them up to date.
222 lines
9.8 KiB
Haskell
222 lines
9.8 KiB
Haskell
{-
|
|
Tock: a compiler for parallel languages
|
|
Copyright (C) 2007, 2008 University of Kent
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU General Public License as published by the
|
|
Free Software Foundation, either version 2 of the License, or (at your
|
|
option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful, but
|
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License along
|
|
with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
-}
|
|
|
|
-- | Simplify processes.
|
|
module SimplifyProcs (simplifyProcs, fixLowReplicators) where
|
|
|
|
import Control.Monad.State
|
|
import Data.Generics
|
|
import qualified Data.Set as Set
|
|
|
|
import qualified AST as A
|
|
import CompState
|
|
import EvalConstants
|
|
import EvalLiterals
|
|
import Metadata
|
|
import Pass
|
|
import qualified Properties as Prop
|
|
import Traversal
|
|
import Types
|
|
import Utils
|
|
|
|
simplifyProcs :: [Pass]
|
|
simplifyProcs =
|
|
[ parsToProcs
|
|
, removeParAssign
|
|
, flattenAssign
|
|
]
|
|
|
|
-- | Wrap the subprocesses of PARs in no-arg PROCs.
|
|
parsToProcs :: Pass
|
|
parsToProcs = pass "Wrap PAR subprocesses in PROCs"
|
|
[Prop.parUsageChecked]
|
|
[Prop.parsWrapped]
|
|
(applyDepthM doProcess)
|
|
where
|
|
doProcess :: A.Process -> PassM A.Process
|
|
doProcess (A.Par m pm s)
|
|
= do s' <- doStructured s
|
|
return $ A.Par m pm s'
|
|
doProcess p = return p
|
|
|
|
-- FIXME This should be generic and in Pass.
|
|
doStructured :: A.Structured A.Process -> PassM (A.Structured A.Process)
|
|
doStructured = transformOnly wrapProcess
|
|
where
|
|
wrapProcess m p
|
|
= do s@(A.Specification _ n _) <- makeNonceProc m p
|
|
modify (\cs -> cs { csParProcs = Set.insert n (csParProcs cs) })
|
|
return $ A.Spec m s (A.Only m (A.ProcCall m n []))
|
|
|
|
-- | Turn parallel assignment into multiple single assignments through temporaries.
|
|
removeParAssign :: Pass
|
|
removeParAssign = pass "Remove parallel assignment"
|
|
[Prop.parUsageChecked, Prop.functionsRemoved, Prop.functionCallsRemoved]
|
|
[Prop.assignParRemoved]
|
|
(applyDepthM doProcess)
|
|
where
|
|
doProcess :: A.Process -> PassM A.Process
|
|
doProcess (A.Assign m vs@(_:_:_) (A.ExpressionList _ es))
|
|
= do ts <- mapM astTypeOf vs
|
|
specs <- sequence [makeNonceVariable "assign_temp" m t A.Original | t <- ts]
|
|
let temps = [A.Variable m n | A.Specification _ n _ <- specs]
|
|
let first = [A.Assign m [v] (A.ExpressionList m [e]) | (v, e) <- zip temps es]
|
|
let second = [A.Assign m [v] (A.ExpressionList m [A.ExprVariable m v']) | (v, v') <- zip vs temps]
|
|
return $ A.Seq m $ foldl (\s spec -> A.Spec m spec s) (A.Several m (map (A.Only m) (first ++ second))) specs
|
|
doProcess p = return p
|
|
|
|
-- | Turn assignment of arrays and records into multiple assignments.
|
|
flattenAssign :: Pass
|
|
flattenAssign = pass "Flatten assignment"
|
|
(Prop.agg_typesDone ++ [Prop.assignParRemoved])
|
|
[Prop.assignFlattened]
|
|
(makeRecurse ops)
|
|
where
|
|
ops :: Ops
|
|
ops = extOpD (extOpSD baseOp ops doStructured) ops doProcess
|
|
|
|
doProcess :: A.Process -> PassM A.Process
|
|
doProcess (A.Assign m [v] (A.ExpressionList m' [e]))
|
|
= do t <- astTypeOf v
|
|
assign m t v m' e
|
|
doProcess p = return p
|
|
|
|
doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
|
|
doStructured (A.Spec m (A.Specification m' n t@(A.RecordType _ _ fs)) s)
|
|
= do procSpec <- recordCopyProc n m fs
|
|
return $ A.Spec m (A.Specification m' n t) (procSpec s)
|
|
doStructured s = return s
|
|
|
|
assign :: Meta -> A.Type -> A.Variable -> Meta -> A.Expression -> PassM A.Process
|
|
assign m t@(A.Array _ _) v m' e = complexAssign m t v m' e
|
|
assign m t@(A.Record _) v m' e = complexAssign m t v m' e
|
|
assign m _ v m' e = return $ A.Assign m [v] (A.ExpressionList m' [e])
|
|
|
|
makeCopyProcName :: A.Name -> PassM A.Name
|
|
makeCopyProcName n = do file <- getCompState >>* csCurrentFile
|
|
return $ n {A.nameName = "copy_" ++ file ++ A.nameName n}
|
|
|
|
complexAssign :: Meta -> A.Type -> A.Variable -> Meta -> A.Expression -> PassM A.Process
|
|
complexAssign m t v m' e
|
|
= do -- Abbreviate the source and destination, to avoid doing the
|
|
-- subscript each time.
|
|
destAM <- liftM makeAbbrevAM $ abbrevModeOfVariable v
|
|
dest@(A.Specification _ destN _) <-
|
|
makeNonceIs "assign_dest" m t destAM v
|
|
let destV = A.Variable m destN
|
|
src@(A.Specification _ srcN _) <-
|
|
makeNonceIsExpr "assign_src" m' t e
|
|
let srcV = A.Variable m' srcN
|
|
|
|
body <- case t of
|
|
A.Array (d:_) _ ->
|
|
-- Array assignments become a loop with an assignment
|
|
-- inside.
|
|
do counter <- makeNonceCounter "i" m
|
|
let zero = A.Literal m A.Int $ A.IntLiteral m "0"
|
|
limit = case d of
|
|
A.UnknownDimension -> A.ExprVariable m $ specificDimSize 0 srcV
|
|
A.Dimension e -> e
|
|
rep = A.For m zero limit (makeConstant m 1)
|
|
itemT <- trivialSubscriptType m t
|
|
-- Don't need to check bounds, as we'll always be within bounds
|
|
let sub = A.Subscript m A.NoCheck (A.ExprVariable m
|
|
(A.Variable m counter))
|
|
inner <- assign m itemT
|
|
(A.SubscriptedVariable m sub destV) m'
|
|
(A.ExprVariable m'
|
|
(A.SubscriptedVariable m' sub srcV))
|
|
return $ A.Spec m (A.Specification m counter (A.Rep m rep)) $ A.Only m inner
|
|
A.Record n -> makeCopyProcName n >>= \n' ->
|
|
return $ A.Only m $ A.ProcCall m n'
|
|
[A.ActualVariable destV, A.ActualVariable srcV]
|
|
|
|
return $ A.Seq m $ A.Spec m src $ A.Spec m dest body
|
|
|
|
-- TODO could make this a separate pass if we wanted (to be run first)
|
|
recordCopyProc :: Data a => A.Name -> Meta -> [(A.Name, A.Type)] -> PassM (A.Structured a -> A.Structured a)
|
|
recordCopyProc n m fs
|
|
-- Record assignments become a sequence of
|
|
-- assignments, one for each field.
|
|
= do let t = A.Record n
|
|
(A.Specification _ nonceLHS _) <- makeNonceVariable "record_copy_arg" m t A.Abbrev
|
|
let destV = A.Variable m nonceLHS
|
|
(A.Specification _ nonceRHS _) <- makeNonceVariable "record_copy_arg" m t A.ValAbbrev
|
|
let srcV = A.Variable m nonceRHS
|
|
assigns <-
|
|
sequence [do let sub = A.SubscriptField m fName
|
|
assign m fType
|
|
(A.SubscriptedVariable m sub destV) m
|
|
(A.ExprVariable m
|
|
(A.SubscriptedVariable m sub srcV))
|
|
| (fName, fType) <- fs]
|
|
n' <- makeCopyProcName n
|
|
let code = A.Seq m $ A.Several m $ map (A.Only m) assigns
|
|
proc = A.Proc m (A.InlineSpec, A.PlainRec)
|
|
[A.Formal A.Abbrev t nonceLHS, A.Formal A.ValAbbrev t nonceRHS]
|
|
(Just code)
|
|
defineName n' $ A.NameDef {
|
|
A.ndMeta = m,
|
|
A.ndName = A.nameName n',
|
|
A.ndOrigName = A.nameName n',
|
|
A.ndSpecType = proc,
|
|
A.ndAbbrevMode = A.Original,
|
|
A.ndNameSource = A.NameNonce,
|
|
A.ndPlacement = A.Unplaced
|
|
}
|
|
|
|
|
|
return (A.Spec m (A.Specification m n' proc))
|
|
|
|
-- | Removes replicators with a replicator count of zero,
|
|
-- and transforms replicators with a replicator count of one.
|
|
--
|
|
-- We don't currently transform replicators in array constructors,
|
|
-- just replicators in SEQ, PAR, ALT, IF.
|
|
--
|
|
-- This pass is primarily to make sure that PAR replicators with 0 or 1 counts
|
|
-- pass the usage checking, but it doesn't hurt to remove any redundant code (or
|
|
-- simplify code) in the other replicators.
|
|
fixLowReplicators :: Pass
|
|
fixLowReplicators = pass "Fix low-count (0, 1) replicators" [] []
|
|
(applyDepthM doProcess)
|
|
where
|
|
doProcess :: Transform A.Process
|
|
doProcess (A.Seq m s) = doStructured s >>* A.Seq m
|
|
doProcess (A.Par m p s) = doStructured s >>* A.Par m p
|
|
doProcess (A.If m s) = doStructured s >>* A.If m
|
|
doProcess (A.Alt m p s) = doStructured s >>* A.Alt m p
|
|
doProcess p = return p
|
|
|
|
doStructured :: Data a => Transform (A.Structured a)
|
|
doStructured s@(A.Only {}) = return s
|
|
doStructured (A.Several m ss) = mapM doStructured ss >>* A.Several m
|
|
doStructured (A.ProcThen m p s) = doStructured s >>* A.ProcThen m p
|
|
doStructured (A.Spec m sp@(A.Specification m' n (A.Rep m''
|
|
(A.For m''' begin end _))) s)
|
|
| isConstant end
|
|
= do endVal <- evalIntExpression end
|
|
case endVal of
|
|
0 -> return $ A.Several m []
|
|
1 -> doStructured s >>*
|
|
A.Spec m (A.Specification m' n
|
|
(A.Is m'' A.ValAbbrev A.Int $ A.ActualExpression begin))
|
|
_ -> doStructured s >>* A.Spec m sp
|
|
doStructured (A.Spec m sp s) = doStructured s >>* A.Spec m sp
|
|
|