Tue Feb 19 16:14:10 CET 2008 Lemmih <[EMAIL PROTECTED]>
* Cache scoping info, avoid unnecessary maps.
Tue Feb 19 16:15:54 CET 2008 Lemmih <[EMAIL PROTECTED]>
* Remove debug code.
Wed Feb 20 19:40:27 CET 2008 Lemmih <[EMAIL PROTECTED]>
* Add a comment describing the function of E.Subst.
New patches:
[Cache scoping info, avoid unnecessary maps.
Lemmih <[EMAIL PROTECTED]>**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 [EMAIL PROTECTED] { 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 [EMAIL PROTECTED] { 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 45
-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 55
-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 71
-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 74
-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 <[EMAIL PROTECTED]>**20080219151554] {
hunk ./E/Subst.hs 76
-
-{-
-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
}
[Add a comment describing the function of E.Subst.
Lemmih <[EMAIL PROTECTED]>**20080220184027] {
hunk ./E/Subst.hs 14
--- This is tricky.
+-- This is a little tricky.
+
+{-
+
+Consider the following example.
+fn = \x0 -> let x1 = 10+x0 -- x1 is only used once, let's inline it.
+ in (\x0 -> x1+x0) -- x0 from the outer lambda isn't used.
+
+Simply inlining x1 will give this errornous result:
+fn = \x0 -> (\x0 -> (10+x0)+x0)
+
+We solve this by renaming variable whenever they clash with the current scope:
+fn = \x0 -> (\x1 -> (10+x0)+x1)
+
+
+Another solution would be to assign a globally unique id to each variable. However,
+in a pure and lazy language like Haskell, renaming variables on the fly is easier
+and quite fast.
+
+New ids are currently generated by selecting psuedo random numbers and checking if
+they're free. Another posibility would be to select the highest known id number + 1.
+See Name.Id.newId for more information.
+
+-}
}
Context:
[use newId to generate unique ids rather than using local functions
John Meacham <[EMAIL PROTECTED]>**20080220054608]
[move Id selection code to a common place in Name.Id
John Meacham <[EMAIL PROTECTED]>**20080220054522]
[remove BindType anotations from all variables as they were rarely used
John Meacham <[EMAIL PROTECTED]>**20080219153025]
[add mfilterWithKey
John Meacham <[EMAIL PROTECTED]>**20080219151259]
[add findOrphanRules and mapRuleBodies
John Meacham <[EMAIL PROTECTED]>**20080219120255]
[fix show instance for numbers
John Meacham <[EMAIL PROTECTED]>**20080219093542]
[add the ability to get at peek,poke and static type info via primitive imports
John Meacham <[EMAIL PROTECTED]>**20080219054002]
[Only use atoms when absolutely necessary.
Lemmih <[EMAIL PROTECTED]>**20080218232922]
[Avoid lists. They are the bane of performance if badly used.
Lemmih <[EMAIL PROTECTED]>**20080218232646]
[Efficient substitutions.
Lemmih <[EMAIL PROTECTED]>**20080218232431]
[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 <[EMAIL PROTECTED]>**20080218182546]
[TAG didgigdy
John Meacham <[EMAIL PROTECTED]>**20080218150752]
Patch bundle hash:
8c50db61bcb766a6ed4c28a4fb34ac49572fc05a
_______________________________________________
jhc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/jhc
