New patches: [Cache scoping info, avoid unnecessary maps. Lemmih **20080219151410] { hunk ./E/Inline.hs 116 - let smap = substMap'' $ fromList [ (tvrIdent x,Just $ EVar x) | (x,y) <- nds] + let smap = substMap' $ fromList [ (tvrIdent x,EVar x) | (x,y) <- nds] hunk ./E/Inline.hs 151 - smap = substMap'' $ fromList [ (tvrIdent x,Just $ EVar x) | (x,y) <- nds] + smap = substMap' $ fromList [ (tvrIdent x,EVar x) | (x,y) <- nds] hunk ./E/SSimplify.hs 339 - envInScope :: IdMap Binding + envInScope :: IdMap Binding, + envInScopeCache :: IdMap E hunk ./E/SSimplify.hs 345 -susp e sub = Susp e sub Unknown -- (substMap'' (fmap mkSubst sub) e) +susp e sub = Susp e sub Unknown hunk ./E/SSimplify.hs 368 -insertInScope t b env = cacheSubst env { envInScope = minsert t b (envInScope env) } +insertInScope t b env = extendScope (msingleton t b) env + +extendScope :: IdMap Binding -> Env -> Env +extendScope m env = cacheSubst env { envInScope = m `union` envInScope env + , envInScopeCache = cachedM `union` envInScopeCache env } + where cachedM = mapMaybeIdMap fromBinding m + fromBinding (IsBoundTo {bindingE = e}) = Just e + fromBinding _ = Nothing + +changeScope :: (Binding -> Binding) -> Env -> Env +changeScope fn env = cacheScope $ cacheSubst env { envInScope = fmap fn (envInScope env) } + +cacheScope :: Env -> Env +cacheScope env = env { envInScopeCache = mapMaybeIdMap fromBinding (envInScope env) } + where fromBinding (IsBoundTo {bindingE = e}) = Just e + fromBinding _ = Nothing hunk ./E/SSimplify.hs 457 - in cacheSubst mempty { envSubst = fromList $ concatMap bb (massocs $ so_boundVars sopts), envInScope = fmap (\ (t,e) -> fixInline finalPhase t $ isBoundTo noUseInfo e) (so_boundVars sopts) } + initScope = fmap (\ (t,e) -> fixInline finalPhase t $ isBoundTo noUseInfo e) (so_boundVars sopts) + in cacheSubst (extendScope initScope mempty { envSubst = fromList $ concatMap bb (massocs $ so_boundVars sopts) }) hunk ./E/SSimplify.hs 557 - let t'' = substMap'' (fmap (\ IsBoundTo { bindingE = e } -> Just e) $ mfilter isIsBoundTo (envInScope inb)) t' + let t'' = substMap' (envInScopeCache inb) t' hunk ./E/SSimplify.hs 589 - doCase ic@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d } t b' as' d' | length (filter (not . isBottom) (caseBodies ic)) <= 1 || all whnfOrBot (caseBodies ic) || all whnfOrBot (caseBodies emptyCase { eCaseAlts = as', eCaseDefault = d'} ) = do + doCase ic@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d } t b' as' d' + | length (filter (not . isBottom) (caseBodies ic)) <= 1 || + all whnfOrBot (caseBodies ic) || + all whnfOrBot (caseBodies emptyCase { eCaseAlts = as', eCaseDefault = d'} ) = do hunk ./E/SSimplify.hs 595 - e' <- localEnv (envInScope_u (fromList [ (n,NotKnown) | TVr { tvrIdent = n } <- litBinds l ] `union`)) $ doCaseCont StartContext e t b' as' d' + e' <- localEnv (extendScope (fromList [ (n,NotKnown) | TVr { tvrIdent = n } <- litBinds l ])) + $ doCaseCont StartContext e t b' as' d' hunk ./E/SSimplify.hs 682 - let dd e' = localEnv (const $ ids $ envInScope_u (newinb `union`) inb) $ f cont e' where + let dd e' = localEnv (const $ ids $ extendScope newinb inb) $ f cont e' where hunk ./E/SSimplify.hs 696 - e' <- localEnv (const $ ids $ substAddList nsub (envInScope_u (ninb `union`) $ mins e (patToLitEE p') inb)) $ f cont ae + e' <- localEnv (const $ ids $ substAddList nsub (extendScope ninb $ mins e (patToLitEE p') inb)) $ f cont ae hunk ./E/SSimplify.hs 698 - --mins (EVar v) e = envInScope_u (minsert (tvrIdent v) (isBoundTo Many e)) hunk ./E/SSimplify.hs 700 - --mins _ _ = id hunk ./E/SSimplify.hs 733 - e' <- localEnv (substAddList [ (n,Done $ EVar nt) | (_,TVr { tvrIdent = n },nt) <- binds] . envInScope_u (fromList [ (n,isBoundTo noUseInfo e) | (e,_,TVr { tvrIdent = n }) <- binds] `union`)) $ f StartContext e + e' <- localEnv (substAddList [ (n,Done $ EVar nt) | (_,TVr { tvrIdent = n },nt) <- binds] . extendScope (fromList [ (n,isBoundTo noUseInfo e) | (e,_,TVr { tvrIdent = n }) <- binds])) $ f StartContext e hunk ./E/SSimplify.hs 872 - inb <- ask - let inb' = case isForced of - ForceInline -> (cacheSubst $ envInScope_u (fmap nogrowth) inb) - _ -> inb + let inb = case isForced of + ForceInline -> cacheSubst . changeScope nogrowth + _ -> id hunk ./E/SSimplify.hs 878 - e' <- localEnv (const inb') $ f (LazyContext t') e + e' <- localEnv inb $ f (LazyContext t') e hunk ./E/SSimplify.hs 889 - (ds',inb') <- localEnv (envSubst_s sub'' . envInScope_u (fromList [ (tvrIdent t',NotKnown) | (_,n,t',_) <- s', useOccurance n /= Once] `union`)) $ w s' [] + (ds',inb') <- localEnv (envSubst_s sub'' . extendScope (fromList [ (tvrIdent t',NotKnown) | (_,n,t',_) <- s', useOccurance n /= Once])) $ w s' [] hunk ./E/Subst.hs 9 - substMap'', + substMap', hunk ./E/Subst.hs 46 -subst (TVr { tvrIdent = i }) w e = doSubst False False (minsert i (Just w) $ (freeVars w `union` freeVars e)) e +subst (TVr { tvrIdent = i }) w e = doSubst' False False (msingleton i w) (\n -> n `member` (freeVars w `union` freeVars e :: IdSet)) e hunk ./E/Subst.hs 56 -subst' (TVr { tvrIdent = (i) }) w e = doSubst True False (minsert i (Just w) $ (freeVars w `union` freeVars e)) e +subst' (TVr { tvrIdent = (i) }) w e = doSubst' True False (msingleton i w) (\n -> n `member` (freeVars w `union` freeVars e :: IdSet)) e hunk ./E/Subst.hs 72 -substMap im e = doSubst False False (fmap ( (`mlookup` im) . tvrIdent) (unions $ (freeVars e :: IdMap TVr):map freeVars (melems im))) e +substMap im e = doSubst' False False im (\n -> n `member` (unions $ (freeVars e :: IdSet):map freeVars (melems im))) e hunk ./E/Subst.hs 75 -substMap'' :: IdMap (Maybe E) -> E -> E -substMap'' im = doSubst False False im -- (fmap Just im) +substMap' :: IdMap E -> E -> E +substMap' im = doSubst' False False im (`mmember` im) + +{- +data E = EAp E E + | ELam TVr E + | EPi TVr E + | EVar TVr + | Unknown + | ESort ESort + | ELit !(Lit E E) + | ELetRec { eDefs :: [(TVr, E)], eBody :: E } + | EPrim APrim [E] E + | EError String E +-} + +litE = ELit (LitInt 10 Unknown) +idE = ELam (TVr 2 Unknown mempty) (EVar (TVr 2 Unknown mempty)) + +testE = EAp (EVar (TVr 2 Unknown mempty)) idE hunk ./E/TypeAnalysis.hs 255 - sub = substMap'' $ fromList [ (tvrIdent t,Just v) | (t,Just v) <- sts ] + sub = substMap' $ fromList [ (tvrIdent t,v) | (t,Just v) <- sts ] hunk ./FrontEnd/Tc/Class.hs 146 - +-- FIXME: Use sets. } [Remove debug code. Lemmih **20080219151554] { hunk ./E/Subst.hs 77 - -{- -data E = EAp E E - | ELam TVr E - | EPi TVr E - | EVar TVr - | Unknown - | ESort ESort - | ELit !(Lit E E) - | ELetRec { eDefs :: [(TVr, E)], eBody :: E } - | EPrim APrim [E] E - | EError String E --} - -litE = ELit (LitInt 10 Unknown) -idE = ELam (TVr 2 Unknown mempty) (EVar (TVr 2 Unknown mempty)) - -testE = EAp (EVar (TVr 2 Unknown mempty)) idE } Context: [add 'prelude.m4' for common m4 definitons, make m4 use the same include path as haskell source, prefix all builtins with m4_ to avoid name clashes John Meacham **20080218182546] [TAG didgigdy John Meacham **20080218150752] [add pretty printing method for HsClassHead John Meacham **20080218143804] [remove duplicate top level code in renamer John Meacham **20080218141430] [remove all the old 'updateSubTable' code from the renamer John Meacham **20080218135347] [replace most of the module renaming code with a custom monad and a type class to greatly simplify code John Meacham **20080218125920] [add HsClassHead type to represent class heads (rather than using HsQualType) John Meacham **20080218093414] [remove a lot of cruft from the deriving code John Meacham **20080218093400] [remove a bunch of stuff from DerivingDrift that is not relevant. John Meacham **20080218074626] [Only use atoms when absolutely necessary. Lemmih **20080218232922] [Avoid lists. They are the bane of performance if badly used. Lemmih **20080218232646] [Efficient substitutions. Lemmih **20080218232431] [add parsing of standalone deriving, clean up some code involving names and the parser John Meacham **20080218030815] [rearrange library a bunch more. move 'Read' to Jhc.Text.Read John Meacham **20080218011716] [rearrange prelude some more. add Prelude.CType John Meacham **20080215044413] [fix shortenPath when working on invalid directories John Meacham **20080215040425] [Optimize simple type-checking. Lemmih **20080215142652] [change chos to only build their ho's lazily, so we don't end up with duplicate copies of hos. John Meacham **20080214060556] [rearrange a lot of the library to break more cyclic dependencies John Meacham **20080213072101] [print binding groups again when -dscc-modules is passed to jhc John Meacham **20080213072044] [clean up Atom.hsc some, make the internal name format use pritable characters when creating atoms to aid in debugging. John Meacham **20080213054653] [Fix makefile for jhcp. Lemmih **20080214115032] [TAG bygniettucu John Meacham **20080213051714] Patch bundle hash: accf92ca7c49477b2b4fa8e6312c6dfcdeb3263c