{- 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 . -} -- | Simplify processes. module SimplifyProcs (simplifyProcs, fixLowReplicators) where import Control.Monad.State import Data.Generics (Data) 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 A.AST] simplifyProcs = [ parsToProcs , removeParAssign , flattenAssign ] -- | Wrap the subprocesses of PARs in no-arg PROCs. parsToProcs :: PassOn A.Process parsToProcs = pass "Wrap PAR subprocesses in PROCs" [Prop.parUsageChecked] [Prop.parsWrapped] (applyBottomUpM 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 :: PassOn A.Process removeParAssign = pass "Remove parallel assignment" [Prop.parUsageChecked, Prop.functionsRemoved, Prop.functionCallsRemoved] [Prop.assignParRemoved] (applyBottomUpM 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 :: PassOnOps (ExtOpMSP BaseOp `ExtOpMP` A.Process) flattenAssign = pass "Flatten assignment" (Prop.agg_typesDone ++ [Prop.assignParRemoved]) [Prop.assignFlattened] (makeRecurseM ops) where ops = baseOp `extOpMS` (ops, makeBottomUpM ops doStructured) `extOpM` makeBottomUpM 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 let m = Meta (Just file) 0 0 return $ n {A.nameName = "copy_" ++ mungeMeta m ++ 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 :: PassOn A.Process fixLowReplicators = pass "Fix low-count (0, 1) replicators" [] [] (applyBottomUpM 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