Trying to fix an efficiency issue noted in a TODO in SAT.hs

[David Feuer]

compiler/simplCore/SAT.hs has a TODO comment about the fact that it does a
fair bit of appending onto the ends of lists, and that should be done
differently. I made an attempt to fix it. The complexity of the recursion,
however, leaves me uncertain as to whether I really did or not. I've
attached a diff and I hope someone will be able to take a look at it. The
only use of Sequence.fromList is source line 172, and the only significant
use of Foldable.toList (aside from pretty-printing) is on source line 402.
Note that the use of Sequence may be temporary—I want to get the right code
structure down before choosing the best data structure.

Thanks,
David Feuer
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/ghc-devs/attachments/20140906/14956a24/attachment.html>
-------------- next part --------------
diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs
index a0b3151..aae3e69 100644
--- a/compiler/simplCore/SAT.lhs
+++ b/compiler/simplCore/SAT.lhs
@@ -67,10 +67,16 @@ import VarSet
 import Unique
 import UniqSet
 import Outputable
-
 import Data.List
 import FastString
 
+--We're probably not really going to use Data.Sequence
+--this is just a temporary temporary thing to see what we'll
+--actually need.
+import qualified Data.Sequence as S
+import Data.Foldable (toList)
+import Data.Sequence (Seq, (|>), (<|), (><), fromList)
+
 #include "HsVersions.h"
 \end{code}
 
@@ -118,7 +124,7 @@ data Staticness a = Static a | NotStatic
 
 type IdAppInfo = (Id, SATInfo)
 
-type SATInfo = [Staticness App]
+type SATInfo = Seq (Staticness App) -- [Staticness App]
 type IdSATInfo = IdEnv SATInfo
 emptyIdSATInfo :: IdSATInfo
 emptyIdSATInfo = emptyUFM
@@ -129,7 +135,7 @@ pprIdSATInfo id_sat_info = vcat (map pprIdAndSATInfo (Map.toList id_sat_info))
 -}
 
 pprSATInfo :: SATInfo -> SDoc
-pprSATInfo staticness = hcat $ map pprStaticness staticness
+pprSATInfo staticness = hcat $ map pprStaticness $ toList staticness
 
 pprStaticness :: Staticness App -> SDoc
 pprStaticness (Static (VarApp _))  = ptext (sLit "SV")
@@ -139,15 +145,22 @@ pprStaticness NotStatic            = ptext (sLit "NS")
 
 
 mergeSATInfo :: SATInfo -> SATInfo -> SATInfo
-mergeSATInfo [] _  = []
-mergeSATInfo _  [] = []
-mergeSATInfo (NotStatic:statics) (_:apps) = NotStatic : mergeSATInfo statics apps
-mergeSATInfo (_:statics) (NotStatic:apps) = NotStatic : mergeSATInfo statics apps
-mergeSATInfo ((Static (VarApp v)):statics)  ((Static (VarApp v')):apps)  = (if v == v' then Static (VarApp v) else NotStatic) : mergeSATInfo statics apps
-mergeSATInfo ((Static (TypeApp t)):statics) ((Static (TypeApp t')):apps) = (if t `eqType` t' then Static (TypeApp t) else NotStatic) : mergeSATInfo statics apps
-mergeSATInfo ((Static (CoApp c)):statics) ((Static (CoApp c')):apps)     = (if c `coreEqCoercion` c' then Static (CoApp c) else NotStatic) : mergeSATInfo statics apps
-mergeSATInfo l  r  = pprPanic "mergeSATInfo" $ ptext (sLit "Left:") <> pprSATInfo l <> ptext (sLit ", ")
-                                            <> ptext (sLit "Right:") <> pprSATInfo r
+mergeSATInfo l r = S.zipWith mergeSA l r
+  where
+    mergeSA NotStatic _ = NotStatic
+    mergeSA _ NotStatic = NotStatic
+    mergeSA (Static (VarApp v)) (Static (VarApp v'))
+      | v == v'   = Static (VarApp v)
+      | otherwise = NotStatic
+    mergeSA (Static (TypeApp t)) (Static (TypeApp t'))
+      | t `eqType` t' = Static (TypeApp t)
+      | otherwise     = NotStatic
+    mergeSA (Static (CoApp c)) (Static (CoApp c'))
+      | c `coreEqCoercion` c' = Static (CoApp c)
+      | otherwise             = NotStatic
+    mergeSA _ _  = pprPanic "mergeSATInfo" $ ptext (sLit "Left:")
+                       <> pprSATInfo l <> ptext (sLit ", ")
+                       <> ptext (sLit "Right:") <> pprSATInfo r
 
 mergeIdSATInfo :: IdSATInfo -> IdSATInfo -> IdSATInfo
 mergeIdSATInfo = plusUFM_C mergeSATInfo
@@ -156,7 +169,7 @@ mergeIdSATInfos :: [IdSATInfo] -> IdSATInfo
 mergeIdSATInfos = foldl' mergeIdSATInfo emptyIdSATInfo
 
 bindersToSATInfo :: [Id] -> SATInfo
-bindersToSATInfo vs = map (Static . binderToApp) vs
+bindersToSATInfo vs = fromList $ map (Static . binderToApp) vs
     where binderToApp v | isId v    = VarApp v
                         | isTyVar v = TypeApp $ mkTyVarTy v
                         | otherwise = CoApp $ mkCoVarCo v
@@ -178,7 +191,7 @@ satTopLevelExpr expr interesting_ids = do
 satExpr :: CoreExpr -> IdSet -> SatM (CoreExpr, IdSATInfo, Maybe IdAppInfo)
 satExpr var@(Var v) interesting_ids = do
     let app_info = if v `elementOfUniqSet` interesting_ids
-                   then Just (v, [])
+                   then Just (v, S.empty)
                    else Nothing
     return (var, emptyIdSATInfo, app_info)
 
@@ -195,8 +208,7 @@ satExpr (App fn arg) interesting_ids = do
     case fn_app of
         Nothing -> satRemainder Nothing
         Just (fn_id, fn_app_info) ->
-            -- TODO: remove this use of append somehow (use a data structure with O(1) append but a left-to-right kind of interface)
-            let satRemainderWithStaticness arg_staticness = satRemainder $ Just (fn_id, fn_app_info ++ [arg_staticness])
+            let satRemainderWithStaticness arg_staticness = satRemainder $ Just (fn_id, fn_app_info |> arg_staticness)
             in case arg of
                 Type t     -> satRemainderWithStaticness $ Static (TypeApp t)
                 Coercion c -> satRemainderWithStaticness $ Static (CoApp c)
@@ -371,7 +383,7 @@ saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body
   where
     should_transform staticness = n_static_args > 1 -- THIS IS THE DECISION POINT
       where
-        n_static_args = length (filter isStaticValue staticness)
+        n_static_args = S.length (S.filter isStaticValue staticness)
 
 saTransform :: Id -> SATInfo -> [Id] -> CoreExpr -> SatM CoreBind
 saTransform binder arg_staticness rhs_binders rhs_body
@@ -385,13 +397,17 @@ saTransform binder arg_staticness rhs_binders rhs_body
     -- rhs_binders = [\alpha, \beta, c, n, xs]
     -- rhs_body = e
 
-    binders_w_staticness = rhs_binders `zip` (arg_staticness ++ repeat NotStatic)
+    (rhs_binders_known_staticness, rhs_binders_unknown_staticness) = splitAt (S.length arg_staticness) rhs_binders
+
+    binders_w_known_staticness = rhs_binders_known_staticness `zip` toList arg_staticness
+    binders_w_staticness = binders_w_known_staticness ++
+                             map (\x->(x,NotStatic)) rhs_binders_unknown_staticness
                                         -- Any extra args are assumed NotStatic
 
     non_static_args :: [Var]
             -- non_static_args = [xs]
             -- rhs_binders_without_type_capture = [\alpha', \beta', c, n, xs]
-    non_static_args = [v | (v, NotStatic) <- binders_w_staticness]
+    non_static_args = [v | (v, NotStatic) <- binders_w_known_staticness] ++ rhs_binders_unknown_staticness
 
     clone (bndr, NotStatic) = return bndr
     clone (bndr, _        ) = do { uniq <- newUnique