[clean up a lot of code. get rid of various unused imports and definitions
John Meacham <john@repetae.net>**20061031031911] hunk ./DataConstructors.hs 68
-tipe t = runVarName (tipe' t)
hunk ./DataConstructors.hs 94
---tipe (TForAll (Forall xs (_ :=> t))) = foldr EPi (tipe t) [ tVr n (kind k) | n <- [2,4..] | k <- xs ]
hunk ./DataConstructors.hs 264
-        rn = toName RawType y
hunk ./DataConstructors.hs 505
-constructionExpression dataTable n typ@(ELit LitCons { litName = pn, litArgs = xs, litType = _ })
+constructionExpression dataTable n typ@(ELit LitCons { litName = pn, litArgs = xs })
hunk ./DataConstructors.hs 563
-            conName = conName,
hunk ./E/FromHs.hs 12
-import Control.Monad.State
hunk ./E/FromHs.hs 14
-import Data.Generics
hunk ./E/FromHs.hs 19
-import qualified Data.Set as Set
hunk ./E/FromHs.hs 34
-import E.Program
hunk ./E/FromHs.hs 41
-import FrontEnd.KindInfer(hoistType)
hunk ./E/FromHs.hs 45
-import FrontEnd.Tc.Type(prettyPrintType)
hunk ./E/FromHs.hs 46
-import GenUtil
hunk ./E/FromHs.hs 53
-import Representation
hunk ./E/FromHs.hs 63
-import qualified Util.Seq as Seq
hunk ./E/FromHs.hs 66
---eIf e a b = ECase { eCaseScrutinee = e, eCaseType = getType a, eCaseBind = (tVr 0 tBool),  eCaseAlts =  [Alt vTrue a,Alt vFalse b], eCaseDefault = Nothing }
-
hunk ./E/FromHs.hs 154
-lookupCoercion n = do
-    assumps <- asks ceAssumps
-    cs <- asks ceCoerce
-    case Map.lookup n assumps of
-        Just x -> return (Left x)
-        Nothing -> Right `liftM` Map.lookup n cs
hunk ./E/FromHs.hs 156
-convertVal assumps n = (foldr ePi t vs, flip (foldr eLam) vs) where
-    (vs,t) = case Map.lookup n assumps of
-        Just z -> fromSigma  z
-        Nothing -> error $ "convertVal.Lookup failed: " ++ (show n)
hunk ./E/FromHs.hs 158
-convertOneVal = tipe
+--convertType t = do
+--    dataTable <- asks ceDataTable
+--    return $ removeNewtypes dataTable (tipe t)
hunk ./E/FromHs.hs 162
-toTVr assumps n = tVr (toId n) (typeOfName n) where
-    typeOfName n = fst $ convertVal assumps n
hunk ./E/FromHs.hs 198
-            (ty',xs) = fromPi ty
+            (_,xs) = fromPi ty
hunk ./E/FromHs.hs 234
+getTypeCons (TCon (Tycon n _)) = n
+getTypeCons (TAp a _) = getTypeCons a
+getTypeCons (TArrow {}) = tc_Arrow
+getTypeCons x = error $ "getTypeCons: " ++ show x
+
hunk ./E/FromHs.hs 270
-methodNames ::  ClassHierarchy ->  [TVr]
-methodNames  classHierarchy =  ans where
-    ans = concatMap cClass (classRecords classHierarchy)
-    cClass classRecord =  [ setProperty prop_METHOD $ tVr (toId n) (convertOneVal t) | (n,t) <- classAssumps classRecord ]
hunk ./E/FromHs.hs 515
-    cExpr (HsAsPat n' (HsVar n)) = do
-        cv <- lookupCoercion (toName Val n')
-        let t = getAssump n
-        case cv of
-            -- Left t' -> return $ foldl eAp (EVar (tv n)) (map tipe $ specialize t t')
-            Right c -> applyCoersion c $ EVar (tv n)
hunk ./E/FromHs.hs 544
-    getAssumpCon n  = case Map.lookup (toName Name.DataConstructor n) assumps of
-        Just z -> z
-        Nothing -> error $ "Lookup failed: " ++ (show n)
hunk ./E/FromHs.hs 570
-            method n = do
-                let defaultName = defaultInstanceName n
-                    (TVr { tvrType = ty}) = tv (nameName n)
-                tels <- case [ d | d <- ds, maybeGetDeclName d == Just n] of
-                    [] -> return []
-                    (d:_) -> cDecl d >>= \ [(_,_,v)] -> return [v]
-                return [(defaultName,tVr (toId defaultName) ty,els) | els <- tels ]
-            cClass classRecord =  [ f n (toId n) (convertOneVal t) | (n,t) <- classAssumps classRecord ] where
+            cClass classRecord =  [ f n (toId n) (removeNewtypes dataTable $ tipe t) | (n,t) <- classAssumps classRecord ] where
hunk ./E/FromHs.hs 575
-        --mthds <- mconcatMapM method  [  n | n :>: _ <- classAssumps cr]
-        let mthds = []
-        return (cClass cr ++ mthds ++ primitiveInstances className)
+        return (cClass cr ++ primitiveInstances className)
hunk ./E/FromHs.hs 578
-{-
--- | determine what arguments must be passed to something of the first type, to transform it into something of the second type.
-specialize :: Type -> Type -> [Type]
-specialize (TForAll vs _) (TForAll vs' _) | sameLength vs vs'= []  -- we assume program is typesafe
-specialize (TForAll vs (ps :=> t)) b@(TForAll vs' _) | length vs' < length vs = specialize' (TForAll rs (ps :=> TForAll ls ([] :=> t))) b where
-    nd = length vs - length vs'
-    (rs,ls) = splitAt nd vs
-specialize x y = specialize' x y
-
-specialize' g@(TForAll vs (_ :=> t)) s = snds (gg t s)  where
-    ps = zip vs [0 :: Int ..]
-    gg a b = snubFst $ gg' a b
-    gg' (TAp t1 t2) (TAp ta tb) = gg' t1 ta ++ gg' t2 tb
-    gg' (TArrow t1 t2) (TArrow ta tb) = gg' t1 ta ++ gg' t2 tb
-    gg' (TCon a) (TCon b) = if a /= b then error "constructors don't match." else []
-    gg' (TVar a) t | Just n <- lookup a ps = [(n,t)]
-    gg' (TVar a) (TVar b) | a == b = []
-    gg' (TMetaVar a) (TMetaVar b) | a == b = []
-    gg' (TForAll as1 (_ :=> r1)) (TForAll as2 (_ :=> r2)) | sameLength as1 as2 = do
-      let r2' = TM.inst mempty (Map.fromList [ (tyvarAtom a2,TVar a1) | a1 <- as1 | a2 <- as2 ]) r2
-      gg' r1 r2' -- assume names are unique
-    gg' a b = error $ "specialization: " <> parens  (prettyPrintType a) <+> parens (prettyPrintType b) <+> "\nin spec\n" <+> vcat (map parens [prettyPrintType g, prettyPrintType s])
-specialize' _g _s = []
+toTVr assumps n = tVr (toId n) (typeOfName n) where
+    typeOfName n = fst $ convertVal assumps n
+convertVal assumps n = (foldr ePi t vs, flip (foldr eLam) vs) where
+    (vs,t) = case Map.lookup n assumps of
+        Just z -> fromSigma  z
+        Nothing -> error $ "convertVal.Lookup failed: " ++ (show n)
hunk ./E/FromHs.hs 585
-ctgen t = map snd $ snubFst $ Seq.toList $ everything (Seq.<>) (mkQ Seq.empty gg) t where
-    gg (TGen n g) = Seq.single (n,g)
-    gg _ =  Seq.empty
--}
hunk ./E/FromHs.hs 742
-    f ECase { eCaseScrutinee = e, eCaseAlts =  ((Alt (LitCons { litName = n, litArgs = [v], litType = t }) z):_) } | alias == ErasedAlias = eLet v (f e)  (f z) where
+    f ECase { eCaseScrutinee = e, eCaseAlts =  ((Alt (LitCons { litName = n, litArgs = [v], litType = t }) z):_) } | alias == ErasedAlias = f (eLet v e z) where
hunk ./E/FromHs.hs 744
-    f ECase { eCaseScrutinee = e, eCaseAlts =  ((Alt (LitCons { litName = n, litArgs = [v], litType = t }) z):_) } | alias == RecursiveAlias = eLet v (prim_unsafeCoerce (f e) (getType v)) (f z) where
+    f ECase { eCaseScrutinee = e, eCaseAlts =  ((Alt (LitCons { litName = n, litArgs = [v], litType = t }) z):_) } | alias == RecursiveAlias = f $ eLet v (prim_unsafeCoerce e (getType v)) z where
hunk ./E/LetFloat.hs 37
-import Util.UniqueMonad
+import Util.UniqueMonad()
hunk ./E/LetFloat.hs 45
-varElim :: Stats -> Int -> IO ()
-varElim stats n = do
-    ticks stats n (toAtom "E.Simplify.var-elimination")
hunk ./E/LetFloat.hs 67
-    g (ELit LitCons { litName = n, litArgs = xs, litType = t }) = do
+    g (ELit lc@LitCons { litArgs = xs }) = do
hunk ./E/LetFloat.hs 69
-        return (ELit (litCons { litName = n, litArgs = xs', litType = t }), concat dss)
+        return (ELit lc { litArgs = xs'}, concat dss)
hunk ./E/LetFloat.hs 107
-doCoalesce :: Stats -> (E,[E]) -> IO (E,[E])
-doCoalesce stats (x,xs) = ans where
-    ans = do
-        (xs',dss) <- fmap unzip (mapM at xs)
-        case x of
-            ELetRec { eDefs = ds', eBody = ELetRec { eDefs = ds'', eBody = x' } } -> do
-                liftIO $ tick stats (toAtom "E.LetFloat.coalesce.fromLet")
-                fromLet2 (concat $ ds'':ds':dss) (foldl EAp x' xs')
-            ec@ECase { eCaseScrutinee = (ELetRec ds' x') }  -> do
-                liftIO $ tick stats (toAtom "E.LetFloat.coalesce.fromCase")
-                fromLet2 (concat $ ds':dss) (foldl EAp (ec { eCaseScrutinee = x' } ) xs')
-            ELetRec { eDefs = ds', eBody = x' } | not (List.null xs) -> do
-                liftIO $ tick stats (toAtom "E.LetFloat.coalesce.fromAp")
-                fromLet2 (concat $ ds':dss) (foldl EAp x' xs')
-            ELetRec { eDefs = ds, eBody = x' } -> do
-                fromLet2 (concat $ ds:dss) (foldl EAp x' xs')
-            x -> fromLet2 (concat dss) (foldl EAp x xs')
-    at ELetRec { eDefs = ds, eBody = e } = do
-        liftIO $ tick stats (toAtom "E.LetFloat.coalesce.fromArg")
-        return (e,ds)
-    at e = return (e,[])
-    --at' (t,(ELetRec ds e)) = do
-    --    liftIO $ tick stats (toAtom "E.LetFloat.coalesce.fromLet2")
-    --    return ((t,e),ds)
-    at' e = return (e,[])
-    fromLet2 ds e = do
-        (ds',dss) <- fmap unzip (mapM at' ds)
-        let ds'' = (concat $ ds':dss)
-        r <- doLetRec stats ds''  e
-        return $ fromAp r
hunk ./E/LetFloat.hs 224
-    comb (a,b) (c,d) = (a ++ c, zipWith (++) b d)
hunk ./FrontEnd/Representation.hs 26
-    getTypeCons,
hunk ./FrontEnd/Representation.hs 40
-import Control.Monad.Trans
hunk ./FrontEnd/Representation.hs 42
-import qualified Data.Map as Map
hunk ./FrontEnd/Representation.hs 53
-import Options
hunk ./FrontEnd/Representation.hs 54
-import qualified FlagDump as FD
hunk ./FrontEnd/Representation.hs 214
-getTypeCons (TCon (Tycon n _)) = n
-getTypeCons (TAp a _) = getTypeCons a
-getTypeCons (TArrow {}) = tc_Arrow
-getTypeCons x = error $ "getTypeCons: " ++ show x
hunk ./FrontEnd/Representation.hs 226
-            put_ bh aa
-            put_ bh ab
-            put_ bh ac
+        put_ bh aa
+        put_ bh ab
+        put_ bh ac
hunk ./FrontEnd/Representation.hs 230
-    aa <- get bh
-    ab <- get bh
-    ac <- get bh
-    return (Tyvar aa ab ac)
+        aa <- get bh
+        ab <- get bh
+        ac <- get bh
+        return (Tyvar aa ab ac)
hunk ./FrontEnd/Representation.hs 268
-    y@(Star `Kfun` Star) -> newName (map (('f':) . show) [0 ..]) y t
-    z -> newLookupName (map (('t':) . show) [0 ..]) z t
+    y@(Star `Kfun` Star) -> newName (map (('f':) . show) [0 :: Int ..]) y t
+    z -> newLookupName (map (('t':) . show) [0 :: Int ..]) z t
hunk ./Main.hs 289
-        mangle = mangle' (Just namesInscope) fullDataTable
hunk ./Main.hs 505
-        let toName t
-                | Just n <- fromId (tvrIdent t) = n
-                | otherwise = error $ "toName: " ++ tvrShowName t
hunk ./Main.hs 1079
-onerrProg prog = putErrLn ">>> Before" >> printProgram prog
hunk ./Makefile 6
-GHCDEBUGOPTS= -W -fno-warn-unused-matches -fno-warn-unused-binds    # -O2 -ddump-simpl-stats -ddump-rules
+GHCDEBUGOPTS= -W -fno-warn-unused-matches # -fno-warn-unused-binds    # -O2 -ddump-simpl-stats -ddump-rules