[start letting type analysis work on partial programs
John Meacham <john@repetae.net>**20060223043122] hunk ./E/FromHs.hs 182
-            theMain = (theMainName,theMainTvr,be)
+            theMain = (theMainName,setProperty prop_EXPORTED theMainTvr,be)
hunk ./E/TypeAnalysis.hs 4
-module E.TypeAnalysis(typeAnalyze, pruneE) where
+module E.TypeAnalysis(typeAnalyze, Typ(), pruneE) where
hunk ./E/TypeAnalysis.hs 21
+import Info.Types
hunk ./E/TypeAnalysis.hs 44
-        lamread _ nfo = do
-            rv <- readValue (runIdentity $ Info.lookup nfo)
+        lamread _ nfo | Just v <- Info.lookup nfo = do
+            rv <- readValue v
hunk ./E/TypeAnalysis.hs 47
+        lamread _ nfo = return nfo
hunk ./E/TypeAnalysis.hs 51
-    calcDs (usedVals,extractValMap ds) ds
-    mapM_ (calcE (usedVals,extractValMap ds) . EVar ) (progEntryPoints prog)
+        env = (usedVals,extractValMap ds)
+        entries = progEntryPoints prog ++ [ t | (t,_) <- ds, getProperty prop_INSTANCE t]
+    calcDs env ds
+    mapM_ (calcE env . EVar ) entries
+    mapM_ (sillyEntry env) entries
hunk ./E/TypeAnalysis.hs 61
+sillyEntry :: Env -> TVr -> IO ()
+sillyEntry env t = mapM_ (addRule . (`isSuperSetOf` value (vmapSingleton v_silly))) args where
+    args = lookupArgs t env
+
+lookupArgs t (_,tm) = maybe [] id (Map.lookup (tvrIdent t) tm)
+
hunk ./E/TypeAnalysis.hs 85
+    d (t, EPi TVr { tvrType = a} b) = do
+        let Just t' = Info.lookup (tvrInfo t)
+            v = vmapSingleton tc_Arrow
+        addRule $ t' `isSuperSetOf` (value v)
+        xs' <- mapM getValue [a,b]
+        flip mapM_ (zip xs' [0.. ])  $ \ (v,i) -> do
+            addRule $ modifiedSuperSetOf t' v (vmapArgSingleton tc_Arrow i)
hunk ./E/TypeAnalysis.hs 128
+    when (length as < length ts) $ fail "calcE: unsaturated call to function"
hunk ./Fixer/VMap.hs 40
-        f a = (if a `Set.member` s then tshow a else char '#' <> tshow a) <> tshow (g a)
+        f a = (if a `Set.member` s then tshow a else char '#' <> tshow a) <> (if null (g a) then empty else tshow (g a))
hunk ./Main.hs 209
+    wdump FD.Lambdacube $ printProgram prog
+
+    if (fopts  FO.TypeAnalysis) then do
+            prog <- typeAnalyze prog
+            putStrLn "-- Type analyzed methods"
+            flip mapM_  (programDs prog) $ \ (t,e) -> case fromLam e of
+                (_,ts@(ft:_)) | sortStarLike (getType ft) -> putStrLn $  (prettyE (EVar t)) ++ " \\" ++ concat [ "(" ++ show  (Info.fetch (tvrInfo t) :: Typ) ++ ")" | t <- ts, sortStarLike (getType t) ]
+                _ -> return ()
+            prog <- programMapBodies pruneE prog
+            return $ programPruneUnreachable prog
+        else return prog
+
hunk ./Main.hs 370
+    return $ programPruneUnreachable prog
+
hunk ./Main.hs 384
+    prog <- annotateProgram mempty (\_ nfo -> return $ unsetProperty prop_INSTANCE nfo) (\_ nfo -> return nfo) (\_ nfo -> return nfo) prog