[rearrange conversion code, cleanups, use EXPORTED property
John Meacham <john@repetae.net>**20051003030344] hunk ./E/SSimplify.hs 193
-    exports = Set.fromList (so_exports sopts)
-    --(e',fvs,occ) = collectOcc (Set.toList exports) (so_rules sopts) (so_dataTable sopts)  e
hunk ./Main.hs 66
-printCheckName dataTable e = do
-    putErrLn  ( render $ hang 4 (pprint e <+> text "::") )
-    ty <- typecheck dataTable e
-    putErrLn  ( render $ hang 4 (pprint ty))
hunk ./Main.hs 96
-processFiles  fs = do
+processFiles fs = do
hunk ./Main.hs 140
-        isExported n | "Instance@" `isPrefixOf` show n = True
-        isExported n = n `Set.member` exports
-        exports = Set.fromList $ concat $ Map.elems (hoExports ho')
hunk ./Main.hs 155
-    -- some more useful values including reachable names
+    -- some more useful values.
hunk ./Main.hs 157
-    let mangle = mangle' (Just $ Set.fromList $ inscope) fullDataTable
-    let reached = Set.fromList [ tvrNum b | (_,b,_) <- reachable graph  [ tvrNum b | (n,b,_) <- ds, isExported n]]
-        graph =  (newGraph ds (\ (_,b,_) -> tvrNum b) (\ (_,_,c) -> freeVars c))
-        (_,dog)  = findLoopBreakers (const 0) graph
+        mangle = mangle' (Just $ Set.fromList $ inscope) fullDataTable
+        exports = getExports ho'
hunk ./Main.hs 160
-    -- This is the main function that processes the E's before passing them into the ho file.
-    let f (ds,(smap,annmap)) (n,v,lc) = do
-        wdump FD.Lambdacube $ putErrLn (show n)
+    -- initial pass over functions to put them into a normalized form
+    ds <- flip mapM ds $ \ (n,v,lc) -> do
hunk ./Main.hs 164
-        v <- return  v { tvrInfo = nfo }
-        lc <- mangle False ("Annotate") (annotate annmap (idann (hoRules allHo) (hoProps allHo)) letann lamann) lc
-        lc <- mangle False ("Barendregt: " ++ show n) (return . barendregt) lc
+        v <- return $ v { tvrInfo = Info.insert LetBound nfo }
+        return (n, shouldBeExported exports v,lc)
+
+    -- This is the main function that optimizes the routines before writing them out
+    let f (ds,(smap,annmap)) (n,v,lc) = do
+        wdump FD.Lambdacube $ putErrLn ("----\n" ++ show n)
+        lc <- mangle (return ()) False ("Annotate") (annotate annmap (idann (hoRules allHo) (hoProps allHo)) letann lamann) lc
hunk ./Main.hs 176
-        lc <- doopt mangle False stats "Float Inward..." (\stats x -> return (floatInward allRules x))  lc
hunk ./Main.hs 177
+        lc <- mangle (return ()) False ("Barendregt: " ++ show n) (return . barendregt) lc
+        lc <- doopt mangle False stats "Float Inward..." (\stats x -> return (floatInward allRules x)) lc
+        lc <- doopt mangle False stats "SuperSimplify" cm lc
hunk ./Main.hs 183
-        nfo <- return $ if isExported n then setProperty prop_EXPORTED nfo else nfo
-        v <- return $ v { tvrInfo = Info.insert LetBound nfo }
hunk ./Main.hs 185
+    -- preparing for optimization
hunk ./Main.hs 187
-    let initMap = Map.fromList [ (tvrIdent t, Just (EVar t)) | (t,_) <- (Map.elems (hoEs ho))] `mappend` imap
+        initMap = Map.fromList [ (tvrIdent t, Just (EVar t)) | (t,_) <- (Map.elems (hoEs ho))] `mappend` imap
+        reached = Set.fromList [ tvrNum b | (_,b,_) <- reachable graph  [ tvrNum b | (n,b,_) <- ds, getProperty prop_EXPORTED b]]
+        graph =  (newGraph ds (\ (_,b,_) -> tvrNum b) (\ (_,_,c) -> freeVars c))
+        (_,dog)  = findLoopBreakers (const 0) graph
hunk ./Main.hs 213
-    lc <- mangle False ("Absurdize") (return . substMap (IM.map g fvs)) lc
-    lc <- mangle False "deNewtype" (return . deNewtype dataTable) lc
-    lc <- mangle False ("Barendregt: " ++ show n) (return . barendregt) lc
+    lc <- mangle (return ()) False ("Absurdize") (return . substMap (IM.map g fvs)) lc
+    lc <- mangle (return ()) False "deNewtype" (return . deNewtype dataTable) lc
+    lc <- mangle (return ()) False ("Barendregt: " ++ show n) (return . barendregt) lc
hunk ./Main.hs 220
-shouldBeExported exports tvr =  tvrIdent tvr `Set.member` exports || getProperty prop_INSTANCE tvr || getProperty prop_SRCLOC_ANNOTATE_FUN tvr
+shouldBeExported exports tvr
+    | tvrIdent tvr `Set.member` exports || getProperty prop_INSTANCE tvr || getProperty prop_SRCLOC_ANNOTATE_FUN tvr  = setProperty prop_EXPORTED tvr
+    | otherwise = tvr
hunk ./Main.hs 224
-doopt mangle dmp stats name func lc = do
-    stats' <- Stats.new
-    lc <- mangle dmp name (func stats') lc
-    t' <- Stats.getTicks stats'
-    case t'  of
-        0 -> return lc
-        _ -> do
-            when ((dmp && dump FD.Progress) || dump FD.Pass) $ Stats.print "Optimization" stats'
-            Stats.combine stats stats'
-            doopt mangle dmp stats name func lc
hunk ./Main.hs 225
+
hunk ./Main.hs 255
-    --typecheck dataTable lco
hunk ./Main.hs 256
-    let mangle = mangle' (Just mempty)
+    let mangle = mangle'  (Just mempty)
hunk ./Main.hs 259
-    lc <- mangle dataTable True "Barendregt" (return . barendregt) lco
+    lc <- mangle dataTable (return ()) True "Barendregt" (return . barendregt) lco
hunk ./Main.hs 271
-    lc <- mangle dataTable True "Barendregt" (return . barendregt) lc
+    lc <- mangle dataTable (return ()) True "Barendregt" (return . barendregt) lc
hunk ./Main.hs 292
-    lc <- mangle dataTable True "LambdaLift" (lambdaLiftE stats dataTable) lc
-    lc <- mangle dataTable True  "FixupLets..." (\x -> atomizeApps stats x >>= coalesceLets stats)  lc
+    lc <- mangle dataTable (return ()) True "LambdaLift" (lambdaLiftE stats dataTable) lc
+    lc <- mangle dataTable (return ()) True  "FixupLets..." (\x -> atomizeApps stats x >>= coalesceLets stats)  lc
hunk ./Main.hs 362
+
+mangle ::
+    DataTable                -- ^ the datatable used for typechecking
+    -> Maybe (Set.Set Id)    -- ^ acceptable free variables
+    -> String                -- ^ the name of the pass
+    -> Bool                  -- ^ whether to dump progress
+    -> Int                   -- ^ maximum number of passes to run. -1 for unlimited
+    -> Stats.Stats                 -- ^ the stats to add results to
+    -> (Stats.Stats -> E -> IO E)  -- ^ the modification routine
+    -> E                     -- ^ the input term
+    -> IO E                  -- ^ out it comes
+mangle dataTable fv name dumpProgress count stats action e = do
+    --when ((dumpProgress && dump FD.Progress) || dump FD.Pass) $ putErrLn $ "-- " ++ name
+    let opt 0 e = return e
+        opt n e = do
+            stats' <- Stats.new
+            e' <- mangle' fv dataTable (Stats.print "stats" stats') dumpProgress name (action stats') e
+            t <- Stats.getTicks stats'
+            case t of
+                0 -> return e'
+                _ -> do
+                    when ((dumpProgress && dump FD.Progress) || dump FD.Pass) $ Stats.print "Optimization" stats'
+                    Stats.combine stats stats'
+                    opt (n - 1) e'
+    opt count e
+
+-- these are way to complicated and should be simplified
hunk ./Main.hs 390
+doopt mangle dmp stats name func lc = do
+    stats' <- Stats.new
+    lc <- mangle (Stats.print "stats" stats') dmp name (func stats') lc
+    t' <- Stats.getTicks stats'
+    case t'  of
+        0 -> return lc
+        _ -> do
+            when ((dmp && dump FD.Progress) || dump FD.Pass) $ Stats.print "Optimization" stats'
+            Stats.combine stats stats'
+            doopt mangle dmp stats name func lc
hunk ./Main.hs 402
---mangle = mangle' (Just mempty)
-
-mangle' :: Maybe (Set.Set Int) -- ^ Acceptable free variables
-    -> DataTable
-    -> Bool    -- ^ Whether to dump progress
-    -> String      -- ^ Name of pass
-    -> (E -> IO E) -- ^ Mangling function
-    -> E           -- ^ What to mangle
-    -> IO E        -- ^ Out it comes
-mangle' fv dataTable b  s action e = do
+mangle' ::
+    Maybe (Set.Set Id)  -- ^ Acceptable free variables
+    -> DataTable        -- ^ The datatable needed for typechecking
+    -> IO ()            -- ^ run on error
+    -> Bool             -- ^ Whether to dump progress
+    -> String           -- ^ Name of pass
+    -> (E -> IO E)      -- ^ Mangling function
+    -> E                -- ^ What to mangle
+    -> IO E             -- ^ Out it comes
+mangle'  fv dataTable erraction b  s action e = do
hunk ./Main.hs 425
+                erraction
hunk ./Main.hs 440
+                erraction
hunk ./Main.hs 459
+printCheckName dataTable e = do
+    putErrLn  ( render $ hang 4 (pprint e <+> text "::") )
+    ty <- typecheck dataTable e
+    putErrLn  ( render $ hang 4 (pprint ty))