[allow return unboxing of multi-argument constructors
John Meacham <john@repetae.net>**20060128014002] hunk ./Grin/Unboxing.hs 29
+-- any fully constant values are done first
+unboxFunction fn x | getType x /= tyUnit, Just v <- constantItem  x  =  let
+    returnType = tyUnit
+    unboxReturn Return {} = Return unit
+    unboxReturn e = e :>>= var :-> Return unit
+    unboxCall (App a as _) | a == fn = App a as returnType :>>= unit :-> Return v
+    var = Var v1 (getType x)
+    in return (unboxReturn, unboxCall, returnType, TupledValue [])
hunk ./Grin/Unboxing.hs 42
+-- returning node of exactly one value
hunk ./Grin/Unboxing.hs 49
-    --unboxCall x = x
hunk ./Grin/Unboxing.hs 51
-unboxFunction fn x | getType x /= tyUnit, Just v <- constantItem  x  =  let
-    returnType = tyUnit
-    unboxReturn Return {} = Return unit
-    unboxReturn e = e :>>= var :-> Return unit
-    unboxCall (App a as _) | a == fn = App a as returnType :>>= unit :-> Return v
-    var = Var v1 (getType x)
-    in return (unboxReturn, unboxCall, returnType, TupledValue [])
+-- returning known node of several arguments
+unboxFunction fn (NodeValue vs) | [NV t args] <- Set.toList vs  =  let
+    returnType = TyTup (map getType args)
+    unboxReturn (Return (NodeC t' xs)) | t == t' = Return (Tup xs)
+                                        | otherwise = error "returning wrong node"
+    unboxReturn e = e :>>= NodeC t vars :-> Return (Tup vars)
+    unboxCall (App a as _) | a == fn = App a as returnType :>>= Tup vars :-> Return (NodeC t vars)
+    vars  = [Var v t | v <- [v1 ..] | t <- map getType args ]
+    in return (unboxReturn, unboxCall, returnType, TupledValue args)
hunk ./Main.hs 468
-    --mapM_ putStrLn (buildShowTableLL $ Map.toList $ grinReturnTags x)
+    mapM_ putStrLn (buildShowTableLL $ Map.toList $ grinReturnTags x)