module IInline(iInline, iSortDs) where import Data.List(group, sort, nub) import Util import qualified Data.Set as S import qualified Data.Map as M import SCC(tsort) import PPrint import ErrorUtil import Id import ISyntax import ISyntaxUtil(irulesMap, iDefsMap) import IInlineUtil(iSubst, iSubstIfc) import Prim import Data.Maybe(catMaybes) -- import Debug.Trace(trace) iInline :: Bool -> IModule a -> IModule a iInline inlSimp = iInline1 . iInlineS inlSimp -- . iSortDs --iInline inlSimp = iInlineAll -- Sort definitions in dependency order iSortDs :: IModule a -> IModule a iSortDs imod@(IModule { imod_local_defs = ds }) = let g = [(i, fdVars e) | IDef i _ e _ <- ds ] m = M.fromList [(i, d) | d@(IDef i _ _ _) <- ds] get i = case M.lookup i m of Nothing -> internalError ("iSortDs: lookup: " ++ ppReadable i) Just d -> d ds' = case tsort g of Left iss -> internalError ("iSortDs: cyclic definition: " ++ ppReadable iss) Right is -> map get is in imod { imod_local_defs = ds' } -- Inline definitions that are simple iInlineS :: Bool -> IModule a -> IModule a iInlineS False m = m iInlineS True imod@(IModule { imod_local_defs = ds, imod_rules = rs, imod_interface = ifc}) = let smap = M.fromList [ (i, iSubst smap dmap e) | IDef i _ e _ <- ds, not (isKeepId i), simple e ] ds' = iDefsMap (iSubst smap dmap) ds dmap = M.fromList [ (i, e) | IDef i t e _ <- ds' ] ifc' = map (iSubstIfc smap dmap) ifc rs' = irulesMap (iSubst smap dmap) rs state_vars' = [ (name, sv { isv_iargs = es' }) | (name, sv@(IStateVar { isv_iargs = es })) <- imod_state_insts imod, let es' = map (iSubst smap dmap) es ] -- concatenation and bit selection are just wires, inline them -- this is to improve the performance of the ITransform pass -- ITransform should re-CSE anything that it does not simplify simple (IAps (ICon _ (ICPrim _ PrimConcat)) _ [e1, e2]) = simple e1 && simple e2 simple (IAps (ICon _ (ICPrim _ PrimSelect)) _ [e]) = simple e simple (IAps (ICon _ (ICPrim _ PrimExtract)) _ [e1,e2,e3]) = simple e1 && simple e2 && simple e3 -- boolean expressions are just gates, inline them simple (IAps (ICon _ (ICPrim _ PrimBAnd)) _ [e1, e2]) = simple e1 && simple e2 simple (IAps (ICon _ (ICPrim _ PrimBOr)) _ [e1, e2]) = simple e1 && simple e2 simple (IAps (ICon _ (ICPrim _ PrimBNot)) _ [e]) = simple e -- these are noops, inline them simple (ICon _ (ICMethArg { })) = True simple (ICon _ (ICModPort { })) = True simple (ICon _ (ICModParam { })) = True simple (ICon _ (ICStateVar { })) = True simple (ICon _ (ICValue { })) = True simple (ICon _ (ICInt { })) = True simple (ICon _ (ICReal { })) = True -- simple _ = False in imod { imod_local_defs = ds', imod_rules = rs', imod_interface = ifc', imod_state_insts = state_vars' } ruleVars :: IRules a -> [Id] ruleVars (IRules sps rs) = concatMap leafVars rs where leafVars r = iValVars (irule_pred r) ++ iValVars (irule_body r) varVars :: (a, IStateVar b) -> [Id] varVars (_, IStateVar { isv_iargs = es }) = let vs = concatMap iValVars es in vs ++ vs -- XXX -- Inline definitions used once iInline1 :: IModule a -> IModule a iInline1 = iInlineUseLimit 1 -- iInlineAll :: IModule a -> IModule a -- iInlineAll = iInlineUseLimit 100000 iInlineUseLimit :: Int -> IModule a -> IModule a iInlineUseLimit use_limit imod@(IModule { imod_state_insts = itvs, imod_local_defs = ds, imod_rules = rs, imod_interface = ifc }) = let ifcRuleVars = concatMap ruleVars (catMaybes [ mrs | IEFace _ _ _ mrs _ _ <- ifc ]) is = [ i | (IEFace i _ (Just (e, _)) _ _ _) <- ifc ] ++ ruleVars rs ++ concatMap varVars itvs ++ ifcRuleVars ++ [ i | (IDef i _ _ _) <- ds, keepEvenUnused i] keepEvenUnused :: Id -> Bool keepEvenUnused i = hasIdProp i IdP_keepEvenUnused defids = S.fromList [ i | IDef i _ _ _ <- ds ] dm = M.fromList ([(i, e) | IDef i _ e _ <- ds ] ++ [ (i, e) | (IEFace i _ (Just (e,_)) _ _ _) <- ifc ]) get i = case M.lookup i dm of (Just e) -> e; _-> internalError ("iInlineUseLimit " ++ ppString use_limit ++ ": " ++ ppReadable i) step allIds done [] = allIds step allIds done (i:pend) = if i `S.member` done then step allIds done pend else let is = iValVars (get i) in -- trace ("add " ++ ppReadable (i, is)) $ step (is ++ allIds) (S.insert i done) (nub is ++ pend) dis = step is S.empty (remOrdDup (sort is)) ics = [ (i, length is) | is@(i:_) <- group (sort dis), i `S.member` defids ] onemap = M.fromList [ (i, iSubst onemap dmap (get i)) | (i, n_uses) <- ics, not (isKeepId i), n_uses <= use_limit ] ds' = iDefsMap (iSubst onemap dmap) ds ifc' = map (iSubstIfc onemap dmap) ifc rs' = irulesMap (iSubst onemap dmap) rs uses = M.fromList ics getc' i = M.findWithDefault 0 i uses getc i = {- trace ("getc: " ++ ppReadable (i, getc' i)) $ -} getc' i ds'' = filter (\ (IDef i _ _ _) -> let uses = getc i in (keepEvenUnused i || uses > 0 && isKeepId i) || uses > use_limit) ds' dmap = M.fromList [(i, e) | IDef i t e _ <- ds'] state_vars' = [ (name, sv { isv_iargs = es' }) | (name, sv@(IStateVar { isv_iargs = es })) <- imod_state_insts imod, let es' = map (iSubst onemap dmap) es ] new_imod = imod { imod_local_defs = ds'', imod_rules = rs', imod_interface = ifc', imod_state_insts = state_vars' } in new_imod iValVars :: IExpr a -> [Id] iValVars (IAps e _ es) = iValVars e ++ concatMap iValVars es iValVars (ICon i (ICValue { })) = [i] iValVars (ICon i (ICUndet {imVal = Just e})) = iValVars e iValVars (ICon _ _) = [] iValVars e = internalError ("iValVars: " ++ ppReadable e) -- ############################################################################# -- # -- ############################################################################# -- zshow (IAps (ICon _ (ICPrim _ PrimFmtConcat)) _ [e0, e1]) = text "(FmtConcat " <+> (zshow e0) <+> (zshow e1) <+> text ")" -- zshow x@(IAps (ICon _ (ICPrim _ PrimIf)) _ [cond, e0, e1]) = text "(? " <> (zshow e0) <+> text " : " <+> (zshow e1) <+> text ")" -- zshow (IAps (ICon fid f@(ICForeign {fcallNo = n, iConType = ict})) ts es) = text (pfpString (unQualId fid)) <> text (show n) <> text "# (" <> sep (map zshow es) <> text ")" -- zshow (IAps _ _ [e]) | isAVFFWithFmts e = text(" (zshow e) <> text(">") -- zshow (IAps icJoinActions _ es@(a:b:rest)) = text("action { ") <> sep (map zshow es) <> text("} endaction") -- zshow (ICon _ ICString {iStr = xx}) = text ("\"" ++ xx ++ "\"") -- zshow x@(ICon i ICValue {}) = text (" ") -- -- zshow x | (myGetType "K1") x == itFmt = text "" -- -- zshow x | (myGetType "K1") x == itAction = text (" " ++ (show x)) -- -- zshow x | isitActionValue_ ((myGetType "K1") x) = text (" " ++ (show x)) -- zshow (IAps x ts es) = sep (map zshow es) -- zshow x = text "" -- -- zshow x = text (" " ++ ppReadable x) -- -- zshow x = text (show x)