[code cleanups
John Meacham <john@repetae.net>**20050919010725] hunk ./E/LetFloat.hs 31
-import E.SSimplify(app)
+import E.Subst(app)
hunk ./E/SSimplify.hs 1
-module E.SSimplify(Occurance(..), simplify, SimplifyOpts(..), app) where
+module E.SSimplify(Occurance(..), simplify, SimplifyOpts(..)) where
hunk ./E/Shadow.hs 3
-
+import Control.Monad.Reader
hunk ./E/Shadow.hs 5
+import E.Subst(litSMapM)
hunk ./E/Shadow.hs 7
-import Control.Monad.Reader
-import Data.FunctorM
-
-litSMapM f (LitCons s es t) = do
-    t' <- f t
-    es' <- mapM f es
-    return $ LitCons s es' t'
-litSMapM f l = fmapM f l
hunk ./E/Shadow.hs 8
+-- | This is simplified to only work on things that only occur in types and is deterministic, so can be used to compare modulo naming differences.
hunk ./E/Shadow.hs 27
+    lp lam tvr e = do
+        (tv,r) <- ntvr tvr
+        e' <- local r $ f e
+        return $ lam tv e'
+
+    ntvr tvr@(TVr { tvrIdent = i, tvrType =  t }) = do
+        t' <- f t
+        (_,i') <- ask
+        let nvr = (tvr { tvrIdent =  i', tvrType =  t'})
+        return (nvr,\ (a,b) -> (Map.insert i (EVar nvr) a,i' + 2))
+
hunk ./E/Shadow.hs 71
-    lp lam tvr e = do
-        (tv,r) <- ntvr tvr
-        e' <- local r $ f e
-        return $ lam tv e'
-
-    ntvr tvr@(TVr { tvrIdent = i, tvrType =  t }) = do
-        t' <- f t
-        (_,i') <- ask
-        let nvr = (tvr { tvrIdent =  i', tvrType =  t'})
-        return (nvr,\ (a,b) -> (Map.insert i (EVar nvr) a,i' + 2))
hunk ./E/Subst.hs 62
+substMapScope' :: Bool -> IM.IntMap E -> IS.IntSet -> E -> E
+substMapScope' allShadow im ss e = doSubst False allShadow (Map.fromAscList [ (x,Nothing) | x <- IS.toAscList ss ] `Map.union` Map.fromAscList [ (x,Just y) |  (x,y) <-  IM.toAscList im]) e
hunk ./E/Subst.hs 167
--- swiss army knife of substitution
-substMapScope' :: Bool -> IM.IntMap E -> IS.IntSet -> E -> E
-substMapScope' allShadow im ss e = doSubst False allShadow (Map.fromList $ [ (x,Nothing) | x <- IS.toList ss ] ++ [ (x,Just y) |  (x,y) <-  IM.toList im] ) e
hunk ./E/Subst.hs 194
-{-
-substMapScope' allShadow im ss e = s im ss e where
-    s im ss ev@(EVar (TVr i t)) = case IM.lookup i im of
-        Just x -> x
-        Nothing -> ev -- EVar (TVr (Just i) (s im ss t))
-    s im ss (ELam tvr e) = lp im ss ELam tvr e
-    s im ss (EPi tvr e)  =  lp im ss EPi tvr e
-    s im ss (ELetRec dl e) =   ELetRec dl' (s' e) where
-        s' = s im' ss'
-        (ss', dl', im') = foldl f (ss,[], im) dl
-        f  (ss,dl,im) ((TVr (i) t),e) |  i `IS.member` ss  =  (IS.insert v ss,(ntvr, s' e):dl,IM.insert i (EVar ntvr) im) where
-            v = nv ss
-            ntvr = TVr ( v) (s' t)
-        f  (ss,dl,im) ((TVr (i) t),e) = (IS.insert i ss,(ntvr, s' e):dl,IM.insert i (EVar ntvr) im) where
-            ntvr = TVr ( i) (s' t)
-        f _ _ = error "invalid ELetRec"
-    s im ss (EAp a b) = EAp (s im ss a) (s im ss b)
-    --s im ss (ELit (LitCons x es e)) = ELit (LitCons x (map (s im ss) es) (s im ss e))
-    s im ss (ELit l) = ELit $ sLit im ss l
-    s im ss (EError x e) = EError x (s im ss e)
-    s im ss (EPrim x es e) = EPrim x (map (s im ss) es) (s im ss e)
-    --s im ss ec@(ECase {}) = ECase { eCaseScrutinee = (s im ss $ eCaseScrutinee ec) } where
-           --v [ (sPat im ss p, s im ss e) | (p,e) <- alt]
-    s _ _ e = e
-    sLit im ss (LitCons x es e) = LitCons x (map (s im ss) es) (s im ss e)
-    sLit im ss l = fmap (s im ss) l
-    nv ss = v (2 * (IS.size ss + 1)) where
-        v n | n `IS.member` ss = v (n + 2)
-        v n = n
-    lp im ss lam (TVr (i) t) e | allShadow && not (i `IS.member` freeVars e) = lam ntvr (s (IM.delete i im) ss e) where
-        t' =  (s im ss t)
-        ntvr =  (TVr 0 t')
-    lp im ss lam (TVr 0 t) e = lam (TVr 0 (s im ss t)) (s im ss e)
-    lp im ss lam (TVr (i) t) e | allShadow || i `IS.member` ss = r  where
-        v = nv (ss `IS.union` freeVars t')
-        t' =  (s im ss t)
-        ntvr =  (TVr ( v) t')
-        r = lam ntvr (s (IM.insert i (EVar ntvr) im) (IS.insert v ss) e)
-    lp im ss lam (TVr j@(i) t) e = lam ntvr (s (IM.insert i (EVar ntvr) (IM.delete i im)) (IS.insert i ss) e) where
-        t' =  (s im ss t)
-        ntvr =  (TVr j t')
--}
hunk ./Main.hs 203
+    let mangle = mangle' (Just mempty)
hunk ./Main.hs 309
-mangle = mangle' (Just mempty)
+--mangle = mangle' (Just mempty)