[improve datalog dump
John Meacham <john@repetae.net>**20090327003453
 Ignore-this: 66b4593d93787d1ed96156ecba96098c
] hunk ./Grin/Lint.hs 88
-    dshow v | v == tyINode = "'inode'"
-            | v == tyDNode = "'dnode'"
-            | otherwise = "'unknown'"
+    dshow v = dshow $ show v
+
+
+instance (DShow a,DShow b) => DShow (Either a b) where
+    dshow (Left x) = dshow x
+    dshow (Right x) = dshow x
hunk ./Grin/Lint.hs 121
-bindUnknown h l = do
-    mapM_ (\x -> hPrintf h "unknown(%s,'bindUnknown').\n" (dshow x)) (freeVars l :: [Var])
+bindUnknown h l r = do
+    mapM_ (\ (x,t) -> when (tyInteresting t) $ setUnknown h x r) (Set.toList $ freeVars l :: [(Var,Ty)])
+
+setUnknown :: DShow a => Handle -> a -> String -> IO ()
+setUnknown h x r = do hPrintf h "unknown(%s,%s).\n" (dshow x) (dshow r)
+
+
hunk ./Grin/Lint.hs 134
-    f [b] (Store x) = do assign "store" b x
-    f [b] (Fetch x) = do assign "fetch" b x
+    f [Left b] (Store (NodeC n vs)) = hPrintf h "store(%s,%s,%s).\n" (dshow b) (dshow n) (if tagIsWHNF n then "true" else "false")
+    f [Right (Var b _)] (Store (NodeC n vs)) = hPrintf h "store(%s,%s,%s).\n" (dshow b) (dshow n) (if tagIsWHNF n then "true" else "false")
+    f [b] (Store x@Var {}) = do assign "demote" b x
+    f [b] (Fetch x@Var {}) = do assign "promote" b x
hunk ./Grin/Lint.hs 144
-    f b   (Case v ls) = mapM_ (\l -> f b (Return [v] :>>= l)) ls
+    f b (Case v ls) = mapM_ (\l -> f b (Return [v] :>>= l)) ls
hunk ./Grin/Lint.hs 146
-
+        forM_ defs $ \d -> printFunc h (funcDefName d) (funcDefBody d)
+        forM_ defs $ \d -> hPrintf h "subfunc(%s,%s).\n" (dshow $ funcDefName d) (dshow n)
hunk ./Grin/Lint.hs 149
+    f b Error {} = return ()
+    f b Call { expValue = Item fn _, expArgs =  as, expType = ty} = do
+        forM_ (zip naturals as) $ \ (i,a) -> do
+            assign "assign" (Left $ funArg fn i) a
+        forM_ (zip naturals b) $ \ (i,a) -> do
+            genAssign "assign" a (Left $ funRet fn i)
hunk ./Grin/Lint.hs 156
-    f bs e = do
-        zipWithM_ (assign "assign") bs (map ValUnknown (getType e))
+    f bs e = do zipWithM_ (assign "assign") bs (map ValUnknown (getType e))
hunk ./Grin/Lint.hs 165
-    genAssign op (Left b) rv = hPrintf h "unknown(%s,%s).\n" (dshow b) (dshow $ show rv)
-    genAssign op (Right b) rv =  bindUnknown h b
+    genAssign op (Left b) (Right v) = when (tyInteresting $ getType v) $ setUnknown h b (show v)
+    genAssign op (Right b) rv =  bindUnknown h b (take 20 $ show rv)
+
hunk ./Grin/Lint.hs 169
+tyInteresting ty = ty == TyNode || ty == tyINode