[add initial ho processing routine
John Meacham <john@repetae.net>**20050929005206] hunk ./FrontEnd/FrontEnd.hs 29
+               -> (Ho -> IO Ho) -- ^ Process initial data loaded from ho files
hunk ./FrontEnd/FrontEnd.hs 32
-parseFiles fs deps func = do
+parseFiles fs deps ifunc func = do
hunk ./FrontEnd/FrontEnd.hs 38
-            ho' <- findModule ho x (doModules func)
+            ho' <- findModule ho x ifunc (doModules func)
hunk ./Ho.hs 137
+              -> (Ho -> IO Ho)                   -- ^ Process initial ho loaded from files and library
hunk ./Ho.hs 140
-findModule have (Left m) _ | m `Map.member` (hoExports have) = return have
-findModule have need func  = do
+findModule have (Left m) ifunc _ | m `Map.member` (hoExports have) = ifunc have
+findModule have need ifunc func  = do
hunk ./Ho.hs 159
-    f (ho `mappend` have) scc
+    ho <- ifunc (ho `mappend` have)
+    f ho scc
hunk ./Main.hs 88
-    once <- newOnce
-    me <- parseFiles [] (map Module ms) (processDecls once stats)
+    me <- parseFiles [] (map Module ms) processInitialHo (processDecls stats)
hunk ./Main.hs 98
-    once <- newOnce
-    me <- parseFiles [] [Module m] (processDecls once stats)
+    me <- parseFiles [] [Module m] processInitialHo (processDecls stats)
hunk ./Main.hs 102
-    once <- newOnce
-    me <- parseFiles  fs [] (processDecls once stats)
+    me <- parseFiles  fs [] processInitialHo (processDecls stats)
hunk ./Main.hs 111
+
+letann e = return (Info.singleton $ manifestLambdas e)
+idann ps i = return (props ps i)
+props ps i = case tvrName (TVr { tvrIdent = i }) of
+    Just n -> case Map.lookup n ps of
+        Just ps ->  Info.singleton (Properties $ Set.fromList ps)
+        Nothing ->  mempty
+    Nothing -> mempty
+
+processInitialHo :: Ho -> IO Ho
+processInitialHo ho = do
+    putStrLn $ "Initial annotate: " ++ show (Map.keys $ hoModules ho)
+    let lamann _ = return mempty
+    let Identity (ELetRec ds (ESort 0)) = annotate mempty (idann (hoProps ho) ) letann lamann (ELetRec (Map.elems $ hoEs ho) eStar)
+    return ho { hoEs = Map.fromAscList [ (k,d) | k <- Map.keys $ hoEs ho | d <- ds ] }
hunk ./Main.hs 131
-    Once ()
-    -> Stats.Stats   -- ^ statistics
+    Stats.Stats   -- ^ statistics
hunk ./Main.hs 136
-processDecls once stats ho ho' tiData = do
-    ho <- flip (altOnce once) (return ho) $ do
-        putStrLn "Initial annotate..."
-        let lamann _ = return mempty
-            letann e = return (Info.singleton $ manifestLambdas e)
-            idann i = return (props i)
-            props i = case fromId i of
-                Just n -> case Map.lookup n (hoProps ho) of
-                    Just ps ->  Info.singleton (Properties $ Set.fromList ps)
-                    Nothing ->  mempty
-                Nothing -> mempty
-        let Identity (ELetRec ds (ESort 0)) = annotate mempty idann letann lamann (ELetRec (Map.elems $ hoEs ho) eStar)
-        return ho { hoEs = Map.fromAscList [ (k,d) | k <- Map.keys $ hoEs ho | d <- ds ] }
-    let initMap = Map.fromList [ (tvrIdent t, Just t) | (t,_) <- (Map.elems (hoEs ho))]
+processDecls stats ho ho' tiData = do
+    --mapM_ print [ (EVar t) | (t,_) <- (Map.elems (hoEs ho))]
+    let initMap = Map.fromList [ (tvrIdent t, Just (EVar t)) | (t,_) <- (Map.elems (hoEs ho))]
hunk ./Main.hs 156
-    let f (ds,smap) (n,v,lc) = do
+    let f (ds,(smap,annmap)) (n,v,lc) = do
hunk ./Main.hs 162
+        nfo <- idann (hoProps ho') (tvrIdent v)
+        v <- return  v { tvrInfo = nfo `mappend` tvrInfo v }
hunk ./Main.hs 168
-        lc <- mangle  False ("Barendregt: " ++ show n) (return . barendregt) lc
-        lc <- mangle  False "deNewtype" (return . deNewtype fullDataTable) lc
+        lc <- mangle False ("Barendregt: " ++ show n) (return . barendregt) lc
+        lc <- mangle False "deNewtype" (return . deNewtype fullDataTable) lc
hunk ./Main.hs 171
-        lc <- mangle  False ("Barendregt: " ++ show n) (return . barendregt) lc
+        lc <- mangle False ("Barendregt: " ++ show n) (return . barendregt) lc
+        lc <- mangle False ("Annotate") (annotate annmap (idann (hoProps ho `mappend` hoProps ho')) letann (\_ -> return mempty)) lc
hunk ./Main.hs 182
-        return ((n,v,lc):ds, Map.insert (tvrNum v) lc smap )
+        nfo <- letann lc
+        v <- return $ v { tvrInfo = Info.insert LetBound nfo `mappend` tvrInfo v }
+        return ((n,v,lc):ds, (Map.insert (tvrNum v) lc smap, Map.insert (tvrNum v) (Just (EVar v)) annmap))
hunk ./Main.hs 189
-    (ds,_) <- foldM f ([],Map.fromList [ (tvrNum v,e) | (v,e) <- Map.elems (hoEs ho)]) [ x | x@(_,b,_) <- dog, tvrNum b `Set.member` reached ]
+    (ds,_) <- foldM f ([],(Map.fromList [ (tvrNum v,e) | (v,e) <- Map.elems (hoEs ho)], initMap)) [ x | x@(_,b,_) <- dog, tvrNum b `Set.member` reached ]