Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
4550f26c
Commit
4550f26c
authored
Apr 25, 2007
by
simonpj@microsoft.com
Browse files
Improve hashing of expressions for CSE (reduces warnings about extendCSEnv)
parent
e49ced85
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/Name.lhs
View file @
4550f26c
...
...
@@ -260,8 +260,11 @@ localiseName n = n { n_sort = Internal }
%************************************************************************
\begin{code}
hashName :: Name -> Int
hashName name = getKey (nameUnique name)
hashName :: Name -> Int -- ToDo: should really be Word
hashName name = getKey (nameUnique name) + 1
-- The +1 avoids keys with lots of zeros in the ls bits, which
-- interacts badly with the cheap and cheerful multiplication in
-- hashExpr
\end{code}
...
...
compiler/coreSyn/CoreUtils.lhs
View file @
4550f26c
...
...
@@ -1386,10 +1386,10 @@ fast_hash_expr env other = 1
fast_hash_type :: HashEnv -> Type -> Word32
fast_hash_type env ty
| Just tv <- getTyVar_maybe ty = hashVar env tv
| Just (tc,
_
) <- splitTyConApp_maybe ty
= fromIntegral (hashName (tyConName tc))
| otherwise = 1
| Just tv <- getTyVar_maybe ty
= hashVar env tv
| Just (tc,
tys
) <- splitTyConApp_maybe ty
= let hash_tc = fromIntegral (hashName (tyConName tc))
in foldr (\t n -> fast_hash_type env t + n) hash_tc tys
| otherwise
= 1
extend_env :: HashEnv -> Var -> (Int, VarEnv Int)
extend_env (n,env) b = (n+1, extendVarEnv env b n)
...
...
compiler/simplCore/CSE.lhs
View file @
4550f26c
...
...
@@ -315,7 +315,9 @@ extendCSEnv (CS cs in_scope sub) expr expr'
= CS (addToUFM_C combine cs hash [(expr, expr')]) in_scope sub
where
hash = hashExpr expr
combine old new = WARN( result `lengthExceeds` 4, text "extendCSEnv: long list:" <+> ppr result )
combine old new = WARN( result `lengthExceeds` 4, ((text "extendCSEnv: long list (length" <+> int (length result) <> comma
<+> text "hash code" <+> text (show hash) <> char ')')
$$ nest 4 (ppr result)) )
result
where
result = new ++ old
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment