[add E.Program, begin switching E optimizations to use it
John Meacham <john@repetae.net>**20060130133441] addfile ./E/Program.hs
hunk ./E/Annotate.hs 9
+import E.Program
hunk ./E/Annotate.hs 28
+annotateProgram :: Monad m =>
+    (Map.Map Id (Maybe E))
+    -> (Id -> Info -> m Info)   -- ^ annotate based on Id map
+    -> (E -> Info -> m Info)    -- ^ annotate letbound bindings
+    -> (E -> Info -> m Info)    -- ^ annotate lambdabound bindings
+    -> Program                -- ^ terms to annotate
+    -> m Program
+annotateProgram imap idann letann lamann prog = do
+    ds <- annotateDs imap idann letann lamann (programDs prog)
+    return $ programSetDs ds prog
+
+
hunk ./E/Program.hs 1
+module E.Program where
+
+import Control.Monad.Identity
+import Data.Monoid
+import List
+import qualified Data.Map as Map
+
+import Class
+import DataConstructors
+import E.E
+import E.FreeVars
+import E.TypeCheck
+import Name.Name
+import qualified Stats
+import Util.Graph
+
+
+data Program = Program {
+    progClassHierarchy :: ClassHierarchy,
+    progCombinators :: [(TVr,[TVr],E)],
+    progDataTable :: DataTable,
+    progEntryPoints :: [TVr],
+    progMainEntry :: TVr,
+    progStats :: Stats.Stat
+    }
+
+
+program = Program {
+    progClassHierarchy = mempty,
+    progCombinators = mempty,
+    progDataTable = mempty,
+    progEntryPoints = mempty,
+    progMainEntry = tvr,
+    progStats = mempty
+    }
+
+
+programDs :: Program -> [(TVr,E)]
+programDs prog = [ (t,foldr ELam e as)  | (t,as,e) <- progCombinators prog]
+
+programSetDs :: [(TVr,E)] -> Program -> Program
+programSetDs ds prog = prog { progCombinators = [ (t,as,body) | (t,e) <- ds, let (body,as) = fromLam e ] }
+
+programAddDs :: [(TVr,E)] -> Program -> Program
+programAddDs ds prog = prog { progCombinators = [ (t,as,body) | (t,e) <- ds, let (body,as) = fromLam e ] ++ progCombinators prog }
+
+programE :: Program -> E
+programE prog = ELetRec (programDs prog) (EVar (progMainEntry prog))
+
+programEsMap :: Program -> Map.Map Name (TVr,E)
+programEsMap prog = Map.fromList [ (runIdentity $ fromId (tvrIdent v),d) | d@(v,_) <- programDs prog ]
+
+programSetE :: E -> Program -> Program
+programSetE (ELetRec ds (EVar v)) prog = programSetDs ds prog { progMainEntry = v }
+programSetE (ELetRec ds mainBody) prog = programSetDs ((main,mainBody):ds) prog { progMainEntry = main } where
+    main = (tVr num (typeInfer (progDataTable prog) mainBody))
+    Just num = List.find (`notElem` [ n  | (TVr { tvrIdent = n },_) <- ds ]) [2,4 ..]
+programSetE e prog = prog { progCombinators = [(main,as,mainBody)], progMainEntry = main } where
+    (mainBody,as) = fromLam e
+    main = tVr 2 (typeInfer (progDataTable prog) e)
+
+programMapBodies f prog = do
+     ds <- sequence [ f e >>= return . (,) t | (t,e) <- programDs prog ]
+     return $ programSetDs ds prog
+
+
hunk ./E/TypeAnalysis.hs 14
-import Support.CanType
hunk ./E/TypeAnalysis.hs 18
+import E.Program
hunk ./E/TypeAnalysis.hs 26
+import Support.CanType
hunk ./E/TypeAnalysis.hs 38
-typeAnalyze :: [(TVr,E)] -> E -> IO [(TVr,E)]
-typeAnalyze ds seed = do
+typeAnalyze :: Program -> IO Program
+typeAnalyze prog = do
hunk ./E/TypeAnalysis.hs 49
-    ds <- annotateDs mempty lambind (\_ -> return) (\_ -> return) ds
+    ds <- annotateDs mempty lambind (\_ -> return) (\_ -> return) (programDs prog)
hunk ./E/TypeAnalysis.hs 51
-    calcE (usedVals,extractValMap ds) seed
+    mapM_ (calcE (usedVals,extractValMap ds) . EVar ) (progEntryPoints prog)
hunk ./E/TypeAnalysis.hs 55
-    return ds
+    return $ programSetDs ds prog
hunk ./Ho.hs 1
-module Ho(Ho(..),HoHeader(..),FileDep(..),findModule,showHoCounts,initialHo,dumpHoFile,loadLibraries,recordHoFile) where
+module Ho(
+    FileDep(..),
+    Ho(..),
+    HoHeader(..),
+    dumpHoFile,
+    findModule,
+    hoToProgram,
+    initialHo,
+    loadLibraries,
+    recordHoFile,
+    showHoCounts
+    ) where
hunk ./Ho.hs 42
+import E.Program
hunk ./Ho.hs 498
+hoToProgram :: Ho -> Program
+hoToProgram ho = programSetDs (Map.elems $ hoEs ho) program {
+    progClassHierarchy = hoClassHierarchy ho,
+    progDataTable = hoDataTable ho
+    }
hunk ./Main.hs 29
+import E.Program
hunk ./Main.hs 293
+programPruneUnreachable :: Program -> Program
+programPruneUnreachable prog = programSetDs ds' prog where
+    ds' = reachable (newGraph (programDs prog) (tvrIdent . fst) (\ (t,e) -> bindingFreeVars t e)) (map tvrIdent $ progEntryPoints prog)
+
hunk ./Main.hs 335
-    let dataTable = hoDataTable ho
-    let rules = hoRules ho
-    wdump FD.Datatable $ putErrLn (render $ showDataTable dataTable)
-
-    int <- isInteractive
-    if int then Interactive.interact ho else do
-
-    --mapM_ putErrLn ([ show x <+> "::" <+> render (ePretty ty) | (x,(TVr _ ty,_)) <- Map.toList $ hoEs ho])
-    let mainFunc = parseName Val (maybe "Main.main" snd (optMainFunc options))
+    let dataTable = progDataTable prog
+        rules = hoRules ho
+        prog = hoToProgram ho
hunk ./Main.hs 339
+    -- dump final version of various requested things
+    wdump FD.Datatable $ putErrLn (render $ showDataTable dataTable)
hunk ./Main.hs 347
+    wdump FD.Rules $ printRules rules
+
+    -- enter interactive mode
+    int <- isInteractive
+    if int then Interactive.interact ho else do
hunk ./Main.hs 353
-    es' <- createMethods dataTable (hoClassHierarchy ho) (hoEs ho)
-    let initMap = Map.fromList [ (tvrIdent t, Just (EVar t)) | (t,_) <- (Map.elems (hoEs ho)), not $ t `Set.member` tmap]
-        tmap = Set.fromList $ [ t | (_,t,_) <- es' ]
-    let Identity es'' = annotateDs initMap (idann (hoRules ho) (hoProps ho) ) letann lamann [ (y,z) | (x,y,z) <- es']
+    let mainFunc = parseName Val (maybe "Main.main" snd (optMainFunc options))
+    (_,main,mainv) <- getMainFunction dataTable mainFunc (programEsMap prog)
+    prog <- return prog { progMainEntry = main, progEntryPoints = [main], progCombinators = (main,[],mainv):progCombinators prog }
hunk ./Main.hs 357
-    es' <- return [ (x,y,floatInward rules z) | (x,_,_) <- es' | (y,z) <- es'' ]
-    wdump FD.Class $ do
-        sequence_ [ print x >> printCheckName' dataTable y z |  (x,y,z) <- es']
-    let es = Map.fromList [ (x,(y,z)) |  (x,y,z) <- es'] `mappend` hoEs ho
-    (_,main,mainv) <- getMainFunction dataTable mainFunc es
-    let ds = ((main,mainv):Map.elems es)
-    let ds' = reachable (newGraph ds (tvrIdent . fst) (\ (t,e) -> bindingFreeVars t e)) [tvrIdent main]
+    cmethods <- do
+        es' <- createMethods dataTable (hoClassHierarchy ho) (programEsMap prog)
+        let initMap = Map.fromList [ (tvrIdent t, Just (EVar t)) | (t,_) <- programDs prog, not $ t `Set.member` tmap]
+            tmap = Set.fromList $ [ t | (_,t,_) <- es' ]
+        let Identity es'' = annotateDs initMap (idann (hoRules ho) (hoProps ho) ) letann lamann [ (y,z) | (x,y,z) <- es']
+        es' <- return [ (x,y,floatInward rules z) | (x,_,_) <- es' | (y,z) <- es'' ]
+        wdump FD.Class $ do
+            sequence_ [ print x >> printCheckName' dataTable y z |  (x,y,z) <- es']
+        return [ (y,z) | (_,y,z) <- es' ]
+
+    prog <- return $ programSetDs ([ (t,e) | (t,e) <- programDs prog, t `notElem` fsts cmethods] ++ cmethods) prog
+    prog <- return $ programPruneUnreachable prog
hunk ./Main.hs 370
-    let lco = ELetRec ds'  (EVar main)
-    wdump FD.Rules $ printRules rules
hunk ./Main.hs 372
-
hunk ./Main.hs 374
+    ne <- mangle dataTable (return ()) True "Barendregt" (return . barendregt) (programE prog)
+    prog <- return $ programSetE ne prog
hunk ./Main.hs 377
-    lc <- mangle dataTable (return ()) True "Barendregt" (return . barendregt) lco
hunk ./Main.hs 378
-    lc <- if (fopts  FO.TypeAnalysis) then do
-        let ELetRec ds mn = lc in do
-            ds' <- typeAnalyze ds mn
+    prog <- if (fopts  FO.TypeAnalysis) then do
+            prog <- typeAnalyze prog
hunk ./Main.hs 381
-            mapM_ (\ (t,e) -> let (_,ts) = fromLam e in putStrLn $  (prettyE (EVar t)) ++ " \\" ++ concat [ "(" ++ show  (tvrInfo t) ++ ")" | t <- ts, sortStarLike (getType t) ] ) (filter (getProperty prop_METHOD . fst) ds')
-            ds' <- sequence [ pruneE e >>= return . (,) t | (t,e) <- ds' ]
-            return $ ELetRec ds' mn
-        else return lc
+            mapM_ (\ (t,e) -> let (_,ts) = fromLam e in putStrLn $  (prettyE (EVar t)) ++ " \\" ++ concat [ "(" ++ show  (tvrInfo t) ++ ")" | t <- ts, sortStarLike (getType t) ] ) (filter (getProperty prop_METHOD . fst) (programDs prog))
+            --mapM_ (\ (t,e) -> let (_,ts) = fromLam e in putStrLn $  (prettyE (EVar t)) ++ " \\" ++ concat [ "(" ++ show  (tvrInfo t) ++ ")" | t <- ts, sortStarLike (getType t) ] ) ds'
+            programMapBodies pruneE prog
+        else return prog
+    let lc = programE prog