[when atomizing applications, include module name in generated names. clean up main and E.LetFloat some.
John Meacham <john@repetae.net>**20060321015319] hunk ./E/FromHs.hs 322
-        e2 <- atomizeAp False dataTable Stats.theStats e2'
+        e2 <- atomizeAp False dataTable Stats.theStats mainModule e2'
hunk ./E/LetFloat.hs 2
---    atomizeApps,
hunk ./E/LetFloat.hs 44
-atomizeApps :: Set.Set Id -> Stats -> E -> IO E
-atomizeApps usedIds stats e = liftM fst $ traverse travOptions { pruneRecord = varElim stats } f mempty (Map.fromAscList [ (i,NotKnown) | i <- Set.toAscList usedIds ]) e where
-    f 0 (ep@(EPi tvr@TVr {tvrIdent = i, tvrType = t} b),[]) | i == 0 || i `notElem` freeVars b = do
-        (t',ds1) <- at t
-        (b',ds2) <- at b
-        liftIO $ C.putStrLn $ "atomizeApps: " ++ pprint ep
-        doLetRec stats (ds1 ++ ds2) (EPi tvr { tvrIdent = 0, tvrType = t'} b')
-    f 0 (EPrim n xs t,[]) = do
-        (xs',dss) <- fmap unzip (mapM at xs)
-        doLetRec stats (concat dss) (EPrim n xs' t)
-    f 0 (ELit (LitCons n xs t),[]) = do
-        (xs',dss) <- fmap unzip (mapM at xs)
-        doLetRec stats (concat dss) (ELit (LitCons n xs' t))
-    f n (x,xs) | n > 0 ||  all (isAtomic) xs = return $ foldl EAp x xs
-    f 0 (x,xs) = do
-        (xs',dss) <- fmap unzip (mapM at xs)
-        doLetRec stats (concat dss) (foldl EAp x xs')
-    f _ _ = error "LetFloat: odd f"
-    at (ELetRec ds e) = do
-        (x,xs) <- at e
-        return (x,ds ++ xs)
-    at e | not (isAtomic e) = do
-        liftIO $ C.putStrLn $ "at: " ++ pprint e
-        e <- f 0 (e,[])
-        lift $ tick stats (toAtom "E.LetFloat.atomizeApps")
-        case e of
-            ELetRec ds e -> do
-                nb@(tvr,_) <- newBinding e
-                return (EVar tvr,nb:ds)
-            e -> do
-                nb@(tvr,_) <- newBinding e
-                return (EVar tvr,[nb])
-
-    at e = return (e,[])
hunk ./E/LetFloat.hs 49
+    -> Module     -- ^ current module name
hunk ./E/LetFloat.hs 52
-atomizeAp atomizeTypes dataTable stats e = f e  where
+atomizeAp atomizeTypes dataTable stats modName e = f e  where
hunk ./E/LetFloat.hs 95
-        let n = toName Val ("A@",'v':show u)
+        let n = toName Val (show modName,"a@" ++ show u)
hunk ./E/LetFloat.hs 244
+{-
+newtype Level = Level Int
+    deriving(Eq,Ord,Enum,Typeable)
+
+top_level = Level 0
+
+floatOutward :: Program -> IO Program
+floatOutward prog = do
+    -- set initial levels
+    let f (t,e) = return (tvrInfo_u (Info.insert top_level) t,g top_level e)
+        g n e | (b,ts@(_:_)) <- fromLam e = foldr ELam ts' (g n' b) where
+            n' = succ n
+            ts' = map (tvrInfo_u (Info.insert n')) ts
+        g n ec@ECase {} = runIdentity $ caseBodiesMapM g' ec { eCaseBind = m (eCaseBind ec), eCaseAlts = map ma (eCaseAlts ec) } where
+            m t = tvrInfo_u (Info.insert n) t
+            ma (Alt (LitCons n xs t)  b) = Alt (LitCons n (map m xs) t) b
+            ma a = a
+        g n e = runIdentity $ (emapE' (g' n) e)
+        g' n e = return $ g n e
+    prog <- programMapDs f prog
+    return prog
+
+-}
+
+
+
+
+
+
+
+
+
+
+
+
+
hunk ./E/TypeAnalysis.hs 270
-specializeDef _(t,e) | getProperty prop_PLACEHOLDER t = return (t,e)
hunk ./E/TypeAnalysis.hs 271
+specializeDef _(t,e) | getProperty prop_PLACEHOLDER t = return (t,e)
hunk ./Grin/MangleE.hs 59
-    prog <- programMapBodies (atomizeAp True (progDataTable prog) stats) prog
+    prog <- programMapBodies (atomizeAp True (progDataTable prog) stats (progModule prog)) prog
hunk ./Main.hs 227
-        lc <- postProcessE stats n inscope usedIds fullDataTable lc
+        lc <- doopt mangle False stats "FixupLets..." (\stats x -> atomizeAp False fullDataTable stats (progModule prog) x >>= coalesceLets stats)  lc
hunk ./Main.hs 364
--- | take E directly generated from haskell source and bring it into line with
--- expected invarients. this only needs be done once.  it replaces all
--- ambiguous types with the absurd one, gets rid of all newtypes, does a basic
--- renaming pass, and makes sure applications are only to atomic variables.
-
-postProcessE :: Stats.Stats -> Name -> [Id] -> Set.Set Id -> DataTable -> E -> IO E
-postProcessE stats n inscope usedIds dataTable lc = do
---    let g (TVr { tvrIdent = 0 }) = error "absurded zero"
---        g tvr@(TVr { tvrIdent = n, tvrType = k})
---            | sortStarLike k =  tAbsurd k
---            | otherwise = EVar tvr
---    fvs <- return $ foldr Map.delete (freeVars lc)  inscope
- --   when (Map.size fvs > 0 && dump FD.Progress) $ do
-  --      putDocM putErr $ parens $ text "Absurded vars:" <+> align (hsep $ map pprint (Map.elems fvs))
-    let mangle = mangle' (Just $ Set.fromList $ inscope) dataTable
-    --lc <- mangle (return ()) False ("Absurdize") (return . substMap (Map.map g fvs)) lc
-    --lc <- mangle (return ()) False "deNewtype" (return . deNewtype dataTable) lc
-    --lc <- mangle (return ()) False ("Barendregt: " ++ show n) (return . barendregt) lc
-    lc <- doopt mangle False stats "FixupLets..." (\stats x -> atomizeAp False dataTable stats x >>= coalesceLets stats)  lc
-    return lc