[add ability to modify arguments of suspsended functions to the node analyzer.
John Meacham <john@repetae.net>**20090828142943
 Ignore-this: 51382fa482ae2eef4a8de79743e4f5b9
] hunk ./src/Grin/Grin.hs 273
+      ++ [ (tagFlipFunction (funcDefName d),tyTy { tySlots = ss, tyReturn = r }) |  d <- ds, let (ss,r) = funcType $ funcDefProps d, r == [TyNode]]
hunk ./src/Grin/NodeAnalyze.hs 32
-
-
hunk ./src/Grin/NodeAnalyze.hs 121
-    -- putStrLn "-- NodeAnalyze"
-    --(rm,res) <- solve (const (return ())) cs
-    (rm,res) <- solve putStrLn cs
+    --putStrLn "-- NodeAnalyze"
+    (rm,res) <- solve (const (return ())) cs
+    --(rm,res) <- solve putStrLn cs
hunk ./src/Grin/NodeAnalyze.hs 135
-    return $ transformFuncs (fixupFuncs (grinSuspFunctions grin `Set.union` grinPartFunctions grin) cmap) grin
+    return $ transformFuncs (fixupFuncs (grinSuspFunctions grin) (grinPartFunctions grin) cmap) grin
hunk ./src/Grin/NodeAnalyze.hs 174
-    --isfn (Todo True  _) x y = Left x `equals` y
-    --isfn (Todo False _) x y = Left x `isgte` y
-    isfn (Todo _ _) x y = Left x `isgte` y
+    isfn (Todo True  _) x y = Left x `equals` y
+    isfn (Todo False _) x y = Left x `isgte` y
+    --isfn (Todo _ _) x y = Left x `isgte` y
hunk ./src/Grin/NodeAnalyze.hs 219
---        f (BaseOp Demote w) = do
---            ww <- mapM convertVal w
---            dres ww
---        f (Store w) = do
---            ww <- convertVal w
---            dunno [TyPtr (getType w)]
hunk ./src/Grin/NodeAnalyze.hs 221
-            --dres [ww]
-            dres [Right (N WHNF Top)]
+            tell $ ww `islte` Right (N WHNF Top)
+            dres [ww]
+            --dres [Right (N WHNF Top)]
hunk ./src/Grin/NodeAnalyze.hs 226
-            --dres [ww]
-            dres [Right (N WHNF Top)]
+            tell $ ww `islte` Right (N WHNF Top)
+            dres [ww]
+            --dres [Right (N WHNF Top)]
hunk ./src/Grin/NodeAnalyze.hs 239
---            dres [v']
hunk ./src/Grin/NodeAnalyze.hs 253
---        f (Update (Var vname ty) v) | ty == TyINode  = do
---            v' <- convertVal v
---            tell $ Left (vr vname ty) `isgte` v'
---            dres []
---        f (Update (Var vname ty) v) | ty == TyPtr TyINode  = do
---            v' <- convertVal v
---            dres []
---        f (Update v1 v)  = do
---            v' <- convertVal v
---            v' <- convertVal v1
---            dres []
hunk ./src/Grin/NodeAnalyze.hs 257
---        f _ = dres []
hunk ./src/Grin/NodeAnalyze.hs 292
-transformFuncs :: (Atom -> ([Ty],[Ty]) -> ([WhatToDo],[WhatToDo])) -> Grin -> Grin
+transformFuncs :: (Atom -> [Ty] -> Maybe [Ty] -> (Maybe [WhatToDo],Maybe [WhatToDo])) -> Grin -> Grin
hunk ./src/Grin/NodeAnalyze.hs 297
-    fs (n,l@(ps :-> e)) = (n,f (fn n (map getType ps,getType e)) l)
-    f (ats,rts) (p :-> e) = ans where
-        ans = if all isWhatUnchanged (ats ++ rts) then p :-> j e else p' :-> e'
+    fs (n,l@(ps :-> e)) = (n,f (fn n (map getType ps) (Just $ getType e)) l)
+    f (Nothing,Nothing) (p :-> e) = p :-> j e
+    f (Just ats,rts') (p :-> e) = p' :-> e' where
+        rts = maybe (map (const WhatUnchanged) (getType e)) id rts'
hunk ./src/Grin/NodeAnalyze.hs 319
+    j app@(BaseOp (StoreNode False) [NodeC a xs]) = res where
+        res = if isNothing ats' then app else e'
+        ats = maybe (repeat WhatUnchanged) id ats'
+        (ats',_) = fn (tagFlipFunction a) (map getType xs) Nothing
+        lvars = zipWith Var [ v1 .. ] (map getType xs)
+        e' = Return xs :>>= lvars :-> f (zip lvars ats) []
+
+        f ((v,WhatUnchanged):xs) rs = f xs (v:rs)
+        f ((_,WhatDelete):xs) rs = f xs rs
+        f ((_,WhatConstant _):xs) rs = f xs rs
+        f ((Var v oty,WhatSubs nty tt _):xs) rs = tt (Var v oty) :>>= [Var v nty] :-> f xs (Var v nty:rs)
+        f [] rs = BaseOp (StoreNode False) [NodeC a (reverse rs)]
+
+
hunk ./src/Grin/NodeAnalyze.hs 335
-        res = if all isWhatUnchanged (ats ++ rts) then app else e'
-        (ats,rts) = fn a (map getType xs,ts)
+        res = if isNothing ats' && isNothing rts'  then app else e'
+        ats = maybe (repeat WhatUnchanged) id ats'
+        rts = maybe (repeat WhatUnchanged) id rts'
+        (ats',rts') = fn a (map getType xs) (Just ts)
hunk ./src/Grin/NodeAnalyze.hs 368
-fixupFuncs sfuncs cmap  = ans where
-    ans a (as,rs) | a `Set.member` sfuncs = (map (const WhatUnchanged) as,map (const WhatUnchanged) rs)
-                  | otherwise = (map (bool pnode WhatUnchanged) largs,map (bool pnode WhatUnchanged) rargs) where
+fixupFuncs sfuncs pfuncs cmap  = ans where
+    ans a as jrs | a `Set.member` pfuncs = (Nothing,Nothing)
+                 | a `Set.member` sfuncs = (Just aargs,Nothing)
+                 | otherwise =  (Just aargs,fmap rargs jrs) where
+        aargs = map (bool pnode WhatUnchanged) largs
hunk ./src/Grin/NodeAnalyze.hs 374
-        rargs = map (lupArg fr a) (zip rs [0 ..  ])
+        rargs rs = map (bool pnode WhatUnchanged) (map (lupArg fr a) (zip rs [0 ..  ]))