[float constant returns from case statements out
John Meacham <john@repetae.net>**20060128060959] hunk ./C/FromGrin.hs 76
+        f (TyTup []) = return emptyExpression
hunk ./Grin/Simplify.hs 217
+data UnboxingResult = UnboxTag | UnboxTup (Atom,[Ty]) | UnboxConst Val
+    deriving(Eq,Ord)
+
hunk ./Grin/Simplify.hs 221
-isCombinable :: Monad m => Bool -> Exp -> m (Maybe (Atom,[Ty]))
+isCombinable :: Monad m => Bool -> Exp -> m UnboxingResult
hunk ./Grin/Simplify.hs 229
-    f (Return (NodeV t [])) | postEval = return [Nothing]
-    f (Return (NodeC t [])) | postEval = return [Nothing]
-    f (Return (NodeC t xs)) = return [Just (t,map getType xs)]
+    f (Return (NodeV t [])) | postEval = return [UnboxTag]
+    f (Return (NodeC t [])) | postEval = return [UnboxTag]
+    f (Return z) | z /= unit && valIsConstant z = return [UnboxConst z]
+    f (Return (NodeC t xs)) = return [UnboxTup (t,map getType xs)]
hunk ./Grin/Simplify.hs 240
-combine nty (Return (NodeV t [])) = Return (Var t TyTag)
-combine nty (Return (NodeC t [])) = Return (Tag t)
-combine nty (Return (NodeC t xs)) = Return (tuple xs)
-combine nty (Error s ty) = Error s nty
-combine nty (Case x ls) = Case x (map (combineLam nty) ls)
-combine nty (e1 :>>= p :-> e2) = e1 :>>= p :-> combine nty e2
-combineLam nty (p :-> e) = p :-> combine nty e
+combine postEval nty (Return (NodeV t [])) = Return (Var t TyTag)
+combine postEval nty (Return (NodeC t [])) | postEval  = Return (Tag t)
+combine postEval nty (Return v) | valIsConstant v  = Return unit
+combine postEval nty (Return (NodeC t xs)) = Return (tuple xs)
+combine postEval nty (Error s ty) = Error s nty
+combine postEval nty (Case x ls) = Case x (map (combineLam postEval nty) ls)
+combine postEval nty (e1 :>>= p :-> e2) = e1 :>>= p :-> combine postEval nty e2
+combineLam postEval nty (p :-> e) = p :-> combine postEval nty e
hunk ./Grin/Simplify.hs 325
-    f cs@(Case x as) | Just Nothing <- isCombinable postEval cs = do
+    f cs@(Case x as) | Just UnboxTag <- isCombinable postEval cs = do
hunk ./Grin/Simplify.hs 329
-        f (Case x (map (combineLam TyTag) as) :>>= Var va TyTag :-> Return (NodeV va []))
-    f cs@(Case x as) | Just (Just (t,ts)) <- isCombinable postEval cs = do
+        f (Case x (map (combineLam postEval TyTag) as) :>>= Var va TyTag :-> Return (NodeV va []))
+    f cs@(Case x as) | Just (UnboxTup (t,ts)) <- isCombinable postEval cs = do
hunk ./Grin/Simplify.hs 335
-        f (Case x (map (combineLam (tuple ts)) as) :>>= tuple vars  :-> Return (NodeC t vars))
+        f (Case x (map (combineLam postEval (tuple ts)) as) :>>= tuple vars  :-> Return (NodeC t vars))
+    f cs@(Case x as) | Just (UnboxConst val) <- isCombinable postEval cs = do
+        mtick $ "Optimize.optimize.case-unbox-const.{" ++ show val
+        f (Case x (map (combineLam postEval tyUnit) as) :>>= unit :-> Return val)
hunk ./Grin/Simplify.hs 512
+valIsConstant :: Val -> Bool
+valIsConstant (Tup xs) = all valIsConstant xs
+valIsConstant (NodeC _ xs) = all valIsConstant xs
+valIsConstant Tag {} = True
+valIsConstant Lit {} = True
+valIsConstant Const {} = True
+valIsConstant (Var v _) | v < v0 = True
+valIsConstant ValPrim {} = True
+valIsConstant _ = False
+