[add SUPERINLINE pragma, clean up code, improve optimization messages
John Meacham <john@repetae.net>**20051004070121] hunk ./E/CPR.hs 8
+import Binary
hunk ./E/CPR.hs 12
+import GenUtil
hunk ./E/CPR.hs 16
-import Binary
hunk ./E/CPR.hs 56
-
-smerge :: Ord a => [a] -> [a] -> [a]
-smerge (x:xs) (y:ys)
-    | x == y = x:smerge xs ys
-    | x < y = x:smerge xs (y:ys)
-    | otherwise = y:smerge (x:xs) ys
-smerge [] ys = ys
-smerge xs [] = xs
hunk ./E/Rules.hs 154
-    mappend (ARules a) (ARules b) = ARules (sortUnder ruleNArgs (a ++ b))
+    mappend (ARules a) (ARules b) = ARules (sortUnder ruleNArgs (snubUnder ruleName $ a ++ b))
hunk ./E/SSimplify.hs 9
+import Maybe
hunk ./E/SSimplify.hs 158
+    so_superInline :: Bool,
hunk ./E/SSimplify.hs 271
-                mtick $ "E.Simplify.inline.Once.{" ++ tvrShowName (tVr t Unknown) ++ "}"
+                mtick $ "E.Simplify.inline.Once.{" ++ showName t ++ "}"
hunk ./E/SSimplify.hs 277
-                        when (n /= Unused) $ mtick $ "E.Simplify.inline.Atomic.{" ++ tvrShowName (tVr t Unknown) ++ "}"
+                        when (n /= Unused) $ mtick $ "E.Simplify.inline.Atomic.{" ++ showName t ++ "}"
hunk ./E/SSimplify.hs 316
+    showName t | odd t = tvrShowName (tVr t Unknown)
+             | otherwise = "(epheremal)"
hunk ./E/SSimplify.hs 441
-        | Properties p <- Info.fetch (tvrInfo x) = Set.member prop_INLINE p  || Set.member prop_WRAPPER p
+        | Properties p <- Info.fetch (tvrInfo x) = Set.member prop_INLINE p  || Set.member prop_WRAPPER p || Set.member prop_SUPERINLINE p
+
+    forceSuperInline x
+        | not (fopts FO.InlinePragmas) = False
+        | Properties p <- Info.fetch (tvrInfo x) =  Set.member prop_SUPERINLINE p
hunk ./E/SSimplify.hs 455
+
+    h v xs' inb  | so_superInline sopts, si@(_:_) <- [ (tvr,fromJust body) | EVar tvr <- xs', forceSuperInline tvr, let body = haveBody tvr, isJust body ] = do
+        mapM_ (\v -> mtick  (toAtom $ "E.Simplify.inline.superforced.{" ++ tvrShowName v  ++ "}")) (fsts si)
+        let siName x = case fromId x of
+                Just y ->  [toId (toName Val ("SI@",'f':show y ++ "$" ++ show i)) | i <- [(1::Int)..] ]
+                Nothing -> [toId (toName Val ("SI@",'f':show x ++ "$" ++ show i)) | i <- [(1::Int)..] ]
+        zs <- flip mapM si $ \ (t,b) -> do
+            nn <- newNameFrom (siName (tvrIdent t))
+            let t' = unsetProperty prop_SUPERINLINE t { tvrIdent = nn }
+            return (t,t',subst t (EVar t') b)
+        let xs'' = map (substLet [ (t,EVar t') | (t,t',_) <- zs]) xs'
+        e <- app (v,xs'')
+        return (eLetRec [ (t',b) | (_,t',b) <- zs] e)
+       where
+            haveBody tvr = case Map.lookup (tvrIdent tvr) (envInScope inb) of
+                (Just (IsBoundTo _ e)) -> Just e
+                _ -> Nothing
+
hunk ./E/SSimplify.hs 491
-                    mtick  (toAtom $ "E.Simplify.inline.OnceInLam.{" ++ tvrShowName v  ++ "}")
+                    mtick  (toAtom $ "E.Simplify.inline.OnceInLam.{" ++ showName (tvrIdent v)  ++ "}")
hunk ./E/SSimplify.hs 494
-                    mtick  (toAtom $ "E.Simplify.inline.ManyBranch.{" ++ tvrShowName v  ++ "}")
+                    mtick  (toAtom $ "E.Simplify.inline.ManyBranch.{" ++ showName (tvrIdent v)  ++ "}")
hunk ./E/SSimplify.hs 497
-                    mtick  (toAtom $ "E.Simplify.inline.Many.{" ++ tvrShowName v  ++ "}")
+                    mtick  (toAtom $ "E.Simplify.inline.Many.{" ++ showName (tvrIdent v)  ++ "}")
hunk ./FrontEnd/Lexer.hs 573
+    ["SUPERINLINE"],
hunk ./GenUtil.hs 2
---  $Id: GenUtil.hs,v 1.45 2005/09/30 04:57:28 john Exp $
+--  $Id: GenUtil.hs,v 1.46 2005/10/04 07:01:10 john Exp $
hunk ./GenUtil.hs 46
-    snub, snubFst, sortFst, groupFst, foldl',
+    snub, snubFst, snubUnder, smerge, sortFst, groupFst, foldl',
hunk ./GenUtil.hs 137
+-- | sorted nub of list based on function of values
+snubUnder :: Ord b => (a -> b) -> [a] -> [a]
+snubUnder f = map head . groupUnder f . sortUnder f
+
hunk ./GenUtil.hs 156
+-- | merge sorted lists in linear time
+smerge :: Ord a => [a] -> [a] -> [a]
+smerge (x:xs) (y:ys)
+    | x == y = x:smerge xs ys
+    | x < y = x:smerge xs (y:ys)
+    | otherwise = y:smerge (x:xs) ys
+smerge [] ys = ys
+smerge xs [] = xs
+
hunk ./GenUtil.hs 703
+
hunk ./Grin/Simplify.hs 3
-import Grin.Grin
-import Grin.Whiz
+import Control.Monad.Identity
hunk ./Grin/Simplify.hs 5
-import Stats
+import Control.Monad.Trans
hunk ./Grin/Simplify.hs 7
-import Data.Set as Set
-import FreeVars
hunk ./Grin/Simplify.hs 8
-import MonoidUtil()
+import Data.Set as Set
hunk ./Grin/Simplify.hs 10
+
hunk ./Grin/Simplify.hs 12
-import GenUtil
-import Control.Monad.Identity
+import FreeVars
+import Grin.Grin
+import Grin.Whiz
+import MonoidUtil()
+import Stats
hunk ./Grin/Simplify.hs 24
-import Control.Monad.State
-import Control.Monad.Trans
hunk ./Info/Types.hs 41
+prop_SUPERINLINE = toAtom "SUPERINLINE"
hunk ./Main.hs 170
+        wdump FD.Lambdacube $ printCheckName fullDataTable lc
hunk ./Main.hs 173
-            let sopt = mempty { SS.so_exports = inscope, SS.so_boundVars = smap, SS.so_rules = allRules, SS.so_dataTable = fullDataTable }
+            let sopt = mempty { SS.so_superInline = True, SS.so_exports = inscope, SS.so_boundVars = smap, SS.so_rules = allRules, SS.so_dataTable = fullDataTable }
hunk ./Main.hs 265
-        let sopt = mempty { SS.so_rules = rules, SS.so_dataTable = dataTable }
+        let sopt = mempty { SS.so_superInline = True, SS.so_rules = rules, SS.so_dataTable = dataTable }
hunk ./lib/Prelude.hs 380
-{-# INLINE id, const, (.), ($), ($!), flip #-}
+{-# SUPERINLINE id, const, (.), ($), ($!), flip #-}
hunk ./lib/Prelude.hs 437
-{-# INLINE asTypeOf #-}
+{-# SUPERINLINE asTypeOf #-}
hunk ./lib/Prelude.hs 498
-{-# INLINE head, tail, null #-}
+{-# SUPERINLINE head, tail, null #-}
hunk ./lib/Prelude.hs 816
-
+-- We don't inline this so there is a better chance calls to it will be recognized as bottom