[various cleanups, get rid of more warnings during compile
John Meacham <john@repetae.net>**20070523102236] hunk ./C/FFI.hs 1
-module C.FFI
-    (CallConv(..), Safety(..), FfiType(..), FfiExport(..), FfiSpec(..), Requires(..), nullRequires
+module C.FFI(
+    CallConv(..),
+    Safety(..),
+    FfiType(..),
+    FfiExport(..),
+    FfiSpec(..),
+    Requires(..),
+    nullRequires
hunk ./C/FFI.hs 11
+import Data.Typeable
hunk ./C/FFI.hs 13
-import Data.Generics
hunk ./C/FFI.hs 17
-data CallConv = CCall | StdCall | Primitive | DotNet deriving(Eq,Ord,Show,Data,Typeable)
+data CallConv = CCall | StdCall | Primitive | DotNet deriving(Eq,Ord,Show)
hunk ./C/FFI.hs 20
-data Safety = Safe | Unsafe deriving(Eq,Ord,Show,Data,Typeable)
+data Safety = Safe | Unsafe deriving(Eq,Ord,Show)
hunk ./C/FFI.hs 27
-             deriving(Eq,Ord,Show,Data,Typeable)
+             deriving(Eq,Ord,Show)
hunk ./C/FFI.hs 33
-    } deriving(Typeable, Data, Eq, Ord)
+    } deriving(Eq, Ord)
hunk ./C/FFI.hs 43
-             deriving(Eq,Ord,Show,Data,Typeable)
+             deriving(Eq,Ord,Show)
hunk ./C/FFI.hs 47
-             deriving(Eq,Ord,Show,Data,Typeable)
+             deriving(Eq,Ord,Show,Typeable)
hunk ./E/E.hs 14
-import Data.Monoid
hunk ./E/E.hs 16
-import Monad
hunk ./E/E.hs 18
-import Atom
hunk ./E/E.hs 21
-import GenUtil
hunk ./E/E.hs 25
-import Number
-import Util.SetLike as S
hunk ./E/FreeVars.hs 64
-    fv ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d, eCaseType = ty } = mconcat (freeIds e:freeIds (tvrType  b):freeIds ty:(delete (tvrIdent b) $ mconcat (freeVars d:map freeVars as)  ):[])
+    fv ~(ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d, eCaseType = ty }) = mconcat (freeIds e:freeIds (tvrType  b):freeIds ty:(delete (tvrIdent b) $ mconcat (freeVars d:map freeVars as)  ):[])
hunk ./E/Type.hs 18
-import {-# SOURCE #-} Info.Binary(putInfo,getInfo)
hunk ./E/Type.hs 105
+    showsPrec _ (ESortNamed n) = shows n
hunk ./E/Values.hs 306
-    f x = fail $ "E.Values.patToE: " ++ show x
hunk ./FrontEnd/HsSyn.hs 126
-    srcLoc HsTypeDecl	 { hsDeclSrcLoc  = sl } = sl
-    srcLoc HsDataDecl	 { hsDeclSrcLoc  = sl } = sl
-    srcLoc HsInfixDecl   { hsDeclSrcLoc = sl } = sl
-    srcLoc HsNewTypeDecl { hsDeclSrcLoc = sl } = sl
+    srcLoc HsTypeDecl	  { hsDeclSrcLoc  = sl } = sl
+    srcLoc HsDeclDeriving { hsDeclSrcLoc  = sl } = sl
+    srcLoc HsSpaceDecl    { hsDeclSrcLoc  = sl } = sl
+    srcLoc HsDataDecl	  { hsDeclSrcLoc  = sl } = sl
+    srcLoc HsInfixDecl    { hsDeclSrcLoc = sl } = sl
+    srcLoc HsNewTypeDecl  { hsDeclSrcLoc = sl } = sl
hunk ./FrontEnd/HsSyn.hs 134
-    srcLoc HsForeignDecl { hsDeclSrcLoc = sl } = sl
-    srcLoc HsActionDecl { hsDeclSrcLoc = sl } = sl
+    srcLoc HsForeignDecl  { hsDeclSrcLoc = sl } = sl
+    srcLoc HsActionDecl   { hsDeclSrcLoc = sl } = sl
hunk ./FrontEnd/TypeSigs.hs 120
-aHsTypeSigToAssumps kt sig@(HsTypeSig _ names qualType) = [ (toName Val n,typ) | n <- names] where
+aHsTypeSigToAssumps kt sig@(~(HsTypeSig _ names qualType)) = [ (toName Val n,typ) | n <- names] where
hunk ./Grin/Grin.hs 568
+    typecheck _ t = return (getType t)
hunk ./Grin/Grin.hs 593
+    typecheck _ (Item _ t) = return t
hunk ./Main.hs 9
-import IO(hFlush,stderr,stdout,openFile,hClose,IOMode(..),hPutStrLn)
+import IO(hFlush,stderr,stdout)
hunk ./Main.hs 11
-import Maybe
hunk ./Main.hs 17
-import Atom
-import qualified C.FromGrin2 as FG2
hunk ./Main.hs 19
-import FrontEnd.Class
hunk ./Main.hs 27
+import E.FreeVars
hunk ./Main.hs 31
-import E.ToHs
-import E.FreeVars
hunk ./Main.hs 36
+import E.ToHs
hunk ./Main.hs 41
+import FrontEnd.Class
hunk ./Main.hs 46
-import Grin.Lint
hunk ./Main.hs 50
-import Grin.Optimize
+import Grin.Lint
hunk ./Main.hs 52
+import Grin.Optimize
hunk ./Main.hs 66
-import Support.CanType(getType)
hunk ./Main.hs 67
-import Support.ShowTable
hunk ./Main.hs 69
-import Util.NameMonad
hunk ./Main.hs 71
+import qualified C.FromGrin2 as FG2
hunk ./Main.hs 73
-import qualified E.Demand as Demand(analyzeProgram,solveDs)
+import qualified E.Demand as Demand(analyzeProgram)
hunk ./Main.hs 77
-import qualified FrontEnd.Tc.Type as Type
hunk ./Main.hs 161
-denewtype prog | null $ progCombinators prog = prog
-denewtype prog = prog' where
-    ELetRec ds _ = removeNewtypes (progDataTable prog) (programE prog)
-    prog' = programSetDs ds prog
hunk ./Main.hs 173
-collectIdAnn r p id nfo = do
-    tell $ singleton id
-    idann r p id nfo
hunk ./Main.hs 203
-    h (Just (EVar t)) = Just (EVar (tvrInfo_u (g (tvrIdent t)) t))
+    h ~(Just (EVar t)) = Just (EVar (tvrInfo_u (g (tvrIdent t)) t))
hunk ./Main.hs 538
---    prog <- denewtypeProgram prog
hunk ./Main.hs 555
---    prog <- denewtypeProgram prog
hunk ./Main.hs 680
-    let opt' s  x = do
-            stats' <- Stats.new
-            nf <- mapMsnd (grinPush stats') (grinFuncs x)
-            x <- return $ setGrinFunctions nf x
-            wdump FD.GrinPass $ printGrin x
-            x <- Grin.Simplify.simplify stats' x
-            t' <- Stats.isEmpty stats'
-            wdump FD.Progress $ Stats.print s stats'
-            Stats.combine stats stats'
-            lintCheckGrin x
-            case t' of
-                True -> return x
-                False -> opt s x
-        pushGrin grin = do
+    let pushGrin grin = do
hunk ./Main.hs 762
-dereferenceItem (HeapValue hvs) | not $ Set.null hvs = combineItems (map f $ Set.toList hvs) where
-    f (HV _ (Right v)) = valToItem v
-    f (HV _ (Left (_,i))) = i
-dereferenceItem x = x
hunk ./Main.hs 763
-buildShowTableLL xs = buildTableLL [ (show x,show y) | (x,y) <- xs ]
hunk ./Main.hs 842
--- these are way too complicated and should be simplified
hunk ./Main.hs 843
-doopt mangle dmp stats name func lc = do
-    stats' <- Stats.new
-    lc <- mangle (Stats.print "stats" stats') dmp name (func stats') lc
-    t' <- Stats.isEmpty stats'
-    case t'  of
-        False -> return lc
-        True -> do
-            when ((dmp && dump FD.Progress) || dmp && coreSteps) $ Stats.print "Optimization" stats'
-            Stats.combine stats stats'
-            doopt mangle dmp stats name func lc
hunk ./Main.hs 845
-mangle' ::
-    Maybe IdSet  -- ^ 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
-    when ((b && dump FD.Progress) || (b && dump FD.CorePass)) $ putErrLn $ "-- " ++ s
-    e' <- action e
-    if not flint then return e' else do
-        let ufreevars e | Just as <- fv = filter ( not . (`member` as) . tvrIdent) (freeVars e)
-            ufreevars e = []
-        case inferType dataTable [] e' of
-        -- temporarily disabled due to newtypes of functions
---            Right _ |  xs@(_:_) <- ufreevars e' -> do
---                putErrLn $ "\n>>> internal error: Unaccountable Free Variables\n" ++ render (pprint (xs:: [TVr]))
---                putErrLn $ "\n>>>Before" <+> s
---                printEStats e
---                putDocM CharIO.putErr (ePretty e)
---                putErrLn $ "\n>>>After" <+> s
---                printEStats e'
---                erraction
---                --let (_,e'') = E.Diff.diff e e'
---                let e''' = findOddFreeVars xs e'
---                putDocM CharIO.putErr (ePrettyEx e''')
---                putErrLn $ "\n>>> internal error: Unaccountable Free Variables\n" ++ render (pprint (xs:: [TVr]))
---                case optKeepGoing options of
---                    True -> return e'
---                    False -> putErrDie "Unusual free vars in E"
-            Left ss -> do
-                putErrLn "Type Error..."
-                putErrLn $ "\n>>>Before" <+> s
-                printEStats e
-                putDocM CharIO.putErr (ePretty e)
-                putErrLn $ "\n>>>After" <+> s
-                printEStats e'
-                erraction
-                let (_,e'') = E.Diff.diff e e'
-                putDocM CharIO.putErr (ePretty e'')
-                putErrLn $ "\n>>> internal error:\n" ++ unlines (tail ss)
-                maybeDie
-                return e'
-            Right _ -> wdump FD.Stats (printEStats e') >>  return e'
hunk ./Main.hs 913
-dumpTyEnv (TyEnv tt) = mapM_ putStrLn $ sort [ show n <+> hsep (map show as) <+> "::" <+> show t |  (n,TyTy { tySlots = as, tyReturn = t }) <- Map.toList tt]
hunk ./Main.hs 914
-printCheckName dataTable e = do
-    putErrLn  ( render $ hang 4 (pprint e <+> text "::") )
-    ty <- typecheck dataTable e
-    putErrLn  ( render $ indent 4 (pprint ty))
hunk ./data/PrimitiveOperators-in.hs 8
-import C.Prims
hunk ./data/PrimitiveOperators-in.hs 9
+import C.Prims
hunk ./data/PrimitiveOperators-in.hs 13
+import FrontEnd.Tc.Type
hunk ./data/PrimitiveOperators-in.hs 16
+import Name.Prim
hunk ./data/PrimitiveOperators-in.hs 18
-import FrontEnd.Tc.Type
-import FrontEnd.Tc.Kind
hunk ./data/PrimitiveOperators-in.hs 39
-toTypeName x = parseName TypeConstructor x
hunk ./data/PrimitiveOperators-in.hs 47
-oper_aaI op ct a b = EPrim (APrim (Operator op [ct,ct] "int") mempty) [a,b] intt
hunk ./data/PrimitiveOperators-in.hs 51
-intt = rawType "int"
-zeroI =  LitInt 0 intt
+--zeroI =  LitInt 0 intt
hunk ./data/PrimitiveOperators-in.hs 60
+    intt = rawType "int"
hunk ./data/PrimitiveOperators-in.hs 79
-op_aaI op ct cn t = ELam tvra' (ELam tvrb' (unbox' (EVar tvra') cn tvra (unbox' (EVar tvrb') cn tvrb wtd))) where
-    tvra' = tVr 2 t
-    tvrb' = tVr 4 t
-    tvra = tVr 6 st
-    tvrb = tVr 8 st
-    tvrc = tVr 10 intt
-    st = rawType ct
-    wtd = eStrictLet tvrc (oper_aaI op ct (EVar tvra) (EVar tvrb)) (rebox (EVar tvrc))
-    rebox x = ELit (litCons { litName = dc_Int, litArgs = [x], litType = t })
+--op_aaI op ct cn t = ELam tvra' (ELam tvrb' (unbox' (EVar tvra') cn tvra (unbox' (EVar tvrb') cn tvrb wtd))) where
+--    tvra' = tVr 2 t
+--    tvrb' = tVr 4 t
+--    tvra = tVr 6 st
+--    tvrb = tVr 8 st
+--    tvrc = tVr 10 intt
+--    st = rawType ct
+--    wtd = eStrictLet tvrc (oper_aaI op ct (EVar tvra) (EVar tvrb)) (rebox (EVar tvrc))
+--    rebox x = ELit (litCons { litName = dc_Int, litArgs = [x], litType = t })
hunk ./data/PrimitiveOperators-in.hs 105
-    intt =  rawType "int"
hunk ./data/PrimitiveOperators-in.hs 147
--}
hunk ./data/PrimitiveOperators-in.hs 152
+-}
hunk ./data/PrimitiveOperators-in.hs 188
--}
hunk ./data/PrimitiveOperators-in.hs 195
+-}