[unbox returning applications, can normalize many lets in grin
John Meacham <john@repetae.net>**20110130030657
 Ignore-this: b55192f3734fd1b8a33e65a31a3ebcd4
] hunk ./src/Grin/SSimplify.hs 3
+
hunk ./src/Grin/SSimplify.hs 104
-            let ne = if cl == 1 then App fn (gs ++ fs) ty else dstore (NodeC (partialTag fn (cl - 1)) (gs ++ fs))
hunk ./src/Grin/SSimplify.hs 105
-            return ne
+            return $ if cl == 1
+                then App fn (gs ++ fs) ty
+                else dstore (NodeC (partialTag fn (cl - 1)) (gs ++ fs))
hunk ./src/Grin/SSimplify.hs 142
-        (True,Nothing,_) -> cse "Simplify.CSE.return-node" []
-        (True,Just (n,fn),_) -> local (\s -> s { envPapp = IM.insert vn (t,vs) (envPapp s) }) $ cse' "Simplify.CSE.return-node" []
+        (True,Nothing,_) -> cse' "Simplify.CSE.return-node" []
+        (True,Just (n,fn),_) -> local (\s -> s { envPapp = IM.insert vn (t,vs) (envPapp s) }) $ cse' "Simplify.CSE.return-node-func" []
hunk ./src/Grin/SSimplify.hs 246
-                mtick "Optimize.optimize.let-shrink-tail"
+                mtick "Simplify.simplify.let-shrink-tail"
hunk ./src/Grin/SSimplify.hs 248
+            App f as ts | f `elem` map funcDefName defs, f `Set.notMember` freeVars (map funcDefBody defs) -> do
+                mtick "Simplify.simplify.let-inline-body"
+                let [fbody] = [ funcDefBody fd | fd <- defs, funcDefName fd == f]
+                return $ updateLetProps lt { expDefs = defs, expBody = Return as :>>= fbody }
hunk ./src/Grin/SSimplify.hs 299
-data UnboxingResult = UnErr [Ty] | UnStore !Bool !Atom [Unbox] | UnDemote Unbox | UnReturn [Unbox] | UnTail (Set.Set Atom) UnboxingResult
+data UnboxingResult
+    = UnErr [Ty]
+    | UnStore !Bool !Atom [Unbox]
+    | UnDemote Unbox
+    | UnReturn [Unbox]
+    | UnTail (Set.Set Atom) [Ty] [Ty]
hunk ./src/Grin/SSimplify.hs 306
-data Unbox =  UnConst Val | UnUnknown Ty
+data Unbox =  UnConst Val | UnUnknown Ty | UnBaseOp BaseOp [Unbox]
hunk ./src/Grin/SSimplify.hs 317
+    getType (UnTail _ tys _) = tys
hunk ./src/Grin/SSimplify.hs 328
+    f (UnTail a _ tys) vs | [f] <- Set.toList a = App f vs tys
hunk ./src/Grin/SSimplify.hs 334
- --   g (UnNode a ts _:xs) vs = let (ts',vs') = g ts vs; (r,y) = g xs vs' in (NodeC a ts':r,y)
hunk ./src/Grin/SSimplify.hs 337
+    f (UnTail ts tys _) | Set.size ts == 1 = Just tys
hunk ./src/Grin/SSimplify.hs 352
+    f (UnTail a tys _) | [f] <- Set.toList a = runIdentity . editTail tys (mApp f)
hunk ./src/Grin/SSimplify.hs 363
+    mApp f (App f' as tys) | f == f' = return $ Return as
+    mApp f e  = error $ "mApp: " ++ show (f,e)
+
hunk ./src/Grin/SSimplify.hs 371
-    f (UnTail t1 u1) (UnTail t2 u2) = UnTail (t1 `union` t2) (f u1 u2)
-    f (UnTail t1 u1) u2 = UnTail t1 (f u1 u2)
-    f u1 (UnTail t2 u2) = UnTail t2 (f u1 u2)
+    f (UnTail t1 a1 u1) (UnTail t2 a2 u2) | u1 == u2, a1 == a2 = UnTail (t1 `union` t2) a1 u1
hunk ./src/Grin/SSimplify.hs 379
-    --g (UnNode a1 ubs1 t1) (UnNode a2 ubs2 t2) | a1 == a2 = UnNode a1 (zipWith g ubs1 ubs2) t1
-    --                                          | otherwise = UnUnknown t1
hunk ./src/Grin/SSimplify.hs 389
-    f (App f _ ts) = UnTail (singleton f) (UnErr ts)
+    f (App f vs ts) = UnTail (singleton f) (getType vs) ts
hunk ./src/Grin/SSimplify.hs 391
-    f Let { expBody = body } = f body
+    f Let { expDefs = defs, expBody = body, expIsNormal = False } = case f body of
+        UnTail fs _ ntys | not $ Set.null (fs `Set.intersection` (Set.fromList $ map funcDefName defs)) -> UnReturn (map UnUnknown ntys)
+        e -> e
hunk ./src/Grin/SSimplify.hs 397
---    g (NodeC t xs) = UnNode t (map g xs) tyDNode