[Efficient substitutions.
Lemmih <lemmih@gmail.com>**20080218232431] hunk ./E/SSimplify.hs 337
-    envCachedSubst :: IdMap (Maybe E),
+    envCachedSubst :: IdMap E,
hunk ./E/SSimplify.hs 353
+insertRange :: Id -> Range -> Env -> Env
hunk ./E/SSimplify.hs 362
-insertDoneSubst' t e env = cacheSubst env { envSubst = minsert t (Done e) (envSubst env) }
+insertDoneSubst' t e env = insertRange t (Done e) env
hunk ./E/SSimplify.hs 375
-applySubst :: Subst -> IdMap a -> IdMap (Maybe OutE)
+applySubst :: Subst -> IdMap a -> IdMap OutE
hunk ./E/SSimplify.hs 377
-    nn' = fmap (const Nothing) s `mappend` fmap (const Nothing) nn
-    applySubst' s = (tm `mappend` nn') where
-        tm = fmap g s
-        g (Done e) = Just e
-        g (Susp e s' _) = Just $ substMap'' (applySubst' s') e
+    check n = n `mmember` s || n `mmember` nn
+    applySubst' s = fmap g s
+    g (Done e) = e
+    g (Susp e s' _) = doSubst' False False (applySubst' s') check e
hunk ./E/SSimplify.hs 389
-dosub e = ask >>= \inb ->  coerceOpt return (substMap'' (envCachedSubst inb) e)
+dosub e = ask >>= \inb ->  coerceOpt return (doSubst' False False (envCachedSubst inb) (`mmember` envCachedSubst inb) e)
hunk ./E/Subst.hs 3
+    doSubst',
hunk ./E/Subst.hs 29
+import System.Random
+
+import qualified Data.Set as Set
hunk ./E/Subst.hs 80
-doSubst substInVars allShadow bm e  = f e bm where
-    f :: E -> IdMap (Maybe E) -> E
+doSubst substInVars allShadow bm e
+    = doSubst' substInVars allShadow (mapMaybeIdMap id bm) (`mmember` bm) e
+
+doSubst' :: Bool -> Bool -> IdMap E -> (Id -> Bool) -> E -> E
+doSubst' substInVars allShadow bm check e  = f e (Set.empty, bm) where
+    f :: E -> (Set.Set Id, IdMap E) -> E
hunk ./E/Subst.hs 87
-        mp <- ask
+        (_,mp) <- ask
hunk ./E/Subst.hs 89
-          Just (Just v) -> return v
+          Just v -> return v
hunk ./E/Subst.hs 99
-        (as,rs) <- liftM unzip $ mapMntvr (fsts dl)
+        (as,rs) <- mapMntvr (fsts dl)
hunk ./E/Subst.hs 109
-        (b',r) <- ntvr [] $ eCaseBind ec
+        (b',r) <- ntvr Set.empty $ eCaseBind ec
hunk ./E/Subst.hs 113
-                (as,rs) <- liftM unzip $ mapMntvr vs
+                (as,rs) <- mapMntvr vs
hunk ./E/Subst.hs 125
-        e' <- local (minsert n Nothing) $ f e
+        e' <- local (\(s,m) -> (Set.insert n s, mdelete n m)) $ f e
hunk ./E/Subst.hs 128
-        (tv,r) <- ntvr [] tvr
+        (tv,r) <- ntvr Set.empty tvr
hunk ./E/Subst.hs 132
-        f [] xs = return $ reverse xs
+        f [] xs = return $ unzip $ reverse xs
hunk ./E/Subst.hs 136
-        vs = [ tvrIdent x | x <- ts ]
+        vs = Set.fromList [ tvrIdent x | x <- ts ]
hunk ./E/Subst.hs 138
-    --mapMntvr [] = return []
-    --mapMntvr (t:ts) = do
-    --    (t',r) <- ntvr t
-    --    ts' <- local r (mapMntvr ts)
-    --    return ((t',r):ts')
-    --ntvr :: TVr -> Map Int (Maybe E) -> (TVr, Map Int (Maybe E) -> Map Int (Maybe E))
hunk ./E/Subst.hs 144
-        i' <- mnv allShadow xs i
+        (s,ss) <- ask
+        let i' = mnv allShadow xs i s ss
hunk ./E/Subst.hs 147
-        case i == i' of
-            True -> return (nvr,minsert i (Just $ EVar nvr))
-            False -> return (nvr,minsert i (Just $ EVar nvr) . minsert i' Nothing)
+        return (nvr,\(s,m) -> (Set.insert i' . Set.insert i $ s, minsert i (EVar nvr) . mdelete i' $ m))
hunk ./E/Subst.hs 151
-mnv allShadow xs i ss
-    | allShadow = nv ss
---    | i <= 0 || i `mmember` ss = nv (fromList [ (x,undefined) | x <- xs ] `mappend` ss)
-    | isInvalidId i || i `mmember` ss = nv (fromList [ (x,undefined) | x <- xs ] `mappend` ss)
+mnv allShadow xs i s ss
+    | allShadow = nv scheck (Set.size xs + Set.size s + size ss)
+    | isInvalidId i || scheck i = nv check (Set.size xs + Set.size s + size ss)
+            -- It is very important that we don't check for 'xs' membership in the guard above.
hunk ./E/Subst.hs 156
+    where scheck n = n `mmember` ss || n `Set.member` s
+          check n = scheck n || n `Set.member` xs
hunk ./E/Subst.hs 159
-
-nv ss = v (2 * (size ss + 1)) where
-    v n | n `mmember` ss = v (n + 2)
-    v n = n
+nv check seed = head $ filter (not . check) $ filter even $ filter (>0) ls
+    where ls  = randoms (mkStdGen seed)
hunk ./E/Subst.hs 223
-        (b',r) <- ntvr [] $ eCaseBind ec
+        (b',r) <- ntvr Set.empty $ eCaseBind ec
hunk ./E/Subst.hs 242
-        (tv,r) <- ntvr [] tvr
+        (tv,r) <- ntvr Set.empty tvr
hunk ./E/Subst.hs 250
-        vs = [ tvrIdent x | x <- ts ]
+        vs = Set.fromList [ tvrIdent x | x <- ts ]
hunk ./E/Subst.hs 268
-        let i' = mnv False xs i map
+        let i' = mnv False xs i Set.empty map
hunk ./FrontEnd/Tc/Class.hs 43
-    let mvs =  nub [ v  | v <- freeMetaVars r, not $ v `Set.member` fmvenv ]
+    let mvs =  freeMetaVars r `Set.difference` fmvenv
hunk ./Name/Id.hs 16
+    mapMaybeIdMap,
hunk ./Name/Id.hs 64
+mapMaybeIdMap :: (a -> Maybe b) -> IdMap a -> IdMap b
+mapMaybeIdMap fn (IdMap m) = IdMap (IM.mapMaybe fn m)
+