[omit updates on eval of all-linear node locations
John Meacham <john@repetae.net>**20060126054437] hunk ./Grin/PointsToAnalysis.hs 310
-                    [] ->  return $ (Return vr :>>= createEval NoUpdate typeEnv (tagsp v)) -- :>>= vb :-> Error "Update: no alternatives" (getType e)
+                    [] ->  do
+                        mtick "Grin.eval.update-no-alts"
+                        return $ (Return vr :>>= createEval NoUpdate typeEnv (tagsp v))
hunk ./Grin/PointsToAnalysis.hs 319
-                        return $ (Return vr :>>= createEval (HoistedUpdate node) typeEnv (tagsp v)) :>>= vb :-> e'
+                        update <- getNeedUpdate (HoistedUpdate node) v
+                        return $ (Return vr :>>= createEval update typeEnv (tagsp v)) :>>= vb :-> e'
hunk ./Grin/PointsToAnalysis.hs 324
-                        return $ (Return vr :>>= createEval (SwitchingUpdate stags) typeEnv (tagsp v)) :>>= vb :-> e'
+                        update <- getNeedUpdate (SwitchingUpdate stags) v
+                        return $ (Return vr :>>= createEval update typeEnv (tagsp v)) :>>= vb :-> e'
hunk ./Grin/PointsToAnalysis.hs 341
-        {-
-        trailingCase vr@Var {expVar = v} vb rs rl = do
-                mtick "Grin.eval.case"
-                rl' <- fmapM f rl
-                let eval = createEval NoUpdate typeEnv (tagsp v)
-                    rs' = [  l :-> rs ]
-                g (Case vb rs)
-                return $ (Return vr :>>= eval) :>>= vb :-> Return vb' :>>= node :-> e'
-
-        g (App a [vr@(Var v _)] _ :>>= vb :-> Return vb' :>>= node@(NodeC {}) :-> e) | vb == vb', a == funcEval = do
-                mtick "Grin.eval.hoisted"
-                e' <- g e
-                return $ (Return vr :>>= createEval (HoistedUpdate node) typeEnv (tagsp v)) :>>= vb :-> Return vb' :>>= node :-> e'
-                -}
-
hunk ./Grin/PointsToAnalysis.hs 351
+        getNeedUpdate u v | notNeedUpdate v = do
+            mtick "Grin.eval.update-linear"
+            return NoUpdate
+        getNeedUpdate u _ = return u
+
+        notNeedUpdate v = all (== UnsharedEval) hs where
+            hs = concatMap (`Map.lookup` ptHeapType pt) hls
+            hls = Set.toList $ getHeaps x
+            Just x = Map.lookup v (ptVars pt)
hunk ./Grin/PointsToAnalysis.hs 362
-        --docase v xs (Just ts) | null vs && any (`notElem` ns') ts = error $ "Odd Case: " ++ show (v,ns',ts)  where
-        --    (ns,vs) = span isNodeC xs
-        --    ns' = [ t | NodeC t _ :-> _ <- ns ]
-        --    isNodeC (NodeC {} :-> _) = True
-        --   isNodeC _ = False
hunk ./Grin/PointsToAnalysis.hs 372
-        -- docase _ ((_ :-> x):_) _ = return $ Error "No Valid alternatives. This Should Not be reachable." (getType x)
-        --docase _ _ _ = error $ "docase: strange argument"