[add removal of constant members of tuples in return types
John Meacham <john@repetae.net>**20060128021547] hunk ./C/FromGrin.hs 273
-perhapsM :: Monad m => Bool -> a -> m a
-perhapsM True a = return a
-perhapsM False _ = fail "perhapsM"
hunk ./GenUtil.hs 2
---  $Id: GenUtil.hs,v 1.46 2005/10/04 07:01:10 john Exp $
+--  $Id: GenUtil.hs,v 1.47 2006/01/28 02:15:30 john Exp $
hunk ./GenUtil.hs 41
+    isLeft,isRight,
hunk ./GenUtil.hs 56
+    sameLength,
hunk ./GenUtil.hs 59
+    perhapsM,
hunk ./GenUtil.hs 333
+isLeft Left {} = True
+isLeft _ = False
+
+isRight Right {} = True
+isRight _ = False
+
+perhapsM :: Monad m => Bool -> a -> m a
+perhapsM True a = return a
+perhapsM False _ = fail "perhapsM"
+
+sameLength (_:xs) (_:ys) = sameLength xs ys
+sameLength [] [] = True
+sameLength _ _ = False
+
hunk ./GenUtil.hs 721
+
hunk ./Grin/PointsToAnalysis.hs 36
-sameLength (_:xs) (_:ys) = sameLength xs ys
-sameLength [] [] = True
-sameLength _ _ = False
hunk ./Grin/PointsToAnalysis.hs 394
+valueSetToItem _ _ ty (VsBas "()") = TupledValue []
hunk ./Grin/Unboxing.hs 10
+import Monad
hunk ./Grin/Unboxing.hs 61
+-- returning known node of several arguments
+unboxFunction fn (TupledValue vs) | any isLeft rvs = return (unboxReturn, unboxCall, returnType, nvs) where
+    rvs = [ case constantItem v of Just x -> Left x ; _ -> Right v | v <- vs ]
+    nvs = tupledValue (rights rvs)
+    returnType = getType nvs
+    unboxReturn e = e :>>= Tup vars :-> Return (tup vars')
+    unboxCall (App a as _) | a == fn = App a as returnType :>>= tup vars' :-> Return (tup [ case x of Left x -> x ; Right _ -> v |  v <- vars | x <- rvs ])
+    vars  = [Var v t | v <- [v1 ..] | t <- map getType vs ]
+    vars' = concat [ perhapsM (isRight r) (Var v t)  | v <- [v1 ..] | t <- map getType vs | r <- rvs ]
+    tup [x] = x
+    tup xs = Tup xs
+    tupledValue [x] = x
+    tupledValue xs = TupledValue xs
hunk ./Grin/Unboxing.hs 113
-    return grin {
+    let newgrin = grin {
hunk ./Grin/Unboxing.hs 118
+    if Map.null fns then return newgrin else unboxReturnValues newgrin