Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
4,310
Issues
4,310
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
382
Merge Requests
382
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
c15fef6b
Commit
c15fef6b
authored
Jun 29, 2011
by
batterseapower
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
New functionality required for the supercompiler plugin
parent
aa40a7d3
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
63 additions
and
4 deletions
+63
-4
.gitignore
.gitignore
+4
-1
compiler/basicTypes/VarEnv.lhs
compiler/basicTypes/VarEnv.lhs
+16
-1
compiler/coreSyn/CoreSubst.lhs
compiler/coreSyn/CoreSubst.lhs
+2
-1
compiler/prelude/PrelNames.lhs
compiler/prelude/PrelNames.lhs
+7
-0
compiler/utils/Outputable.lhs
compiler/utils/Outputable.lhs
+25
-0
compiler/utils/UniqFM.lhs
compiler/utils/UniqFM.lhs
+9
-1
No files found.
.gitignore
View file @
c15fef6b
# -----------------------------------------------------------------------------
# generic generated file patterns
Thumbs.db
.DS_Store
*~
#*#
*.bak
...
...
@@ -233,4 +236,4 @@ _darcs/
/utils/unlit/unlit
/extra-gcc-opts
\ No newline at end of file
/extra-gcc-opts
compiler/basicTypes/VarEnv.lhs
View file @
c15fef6b
...
...
@@ -35,8 +35,10 @@ module VarEnv (
RnEnv2,
-- ** Operations on RnEnv2s
mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
mkRnEnv2, rnBndr2, rnBndrs2,
rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,
rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR,
delBndrL, delBndrR, delBndrsL, delBndrsR,
addRnInScopeSet,
rnEtaL, rnEtaR,
rnInScope, rnInScopeSet, lookupRnInScope,
...
...
@@ -283,11 +285,24 @@ rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
where
new_b = uniqAway in_scope bR
delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2
delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2
delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
rnOccL, rnOccR :: RnEnv2 -> Var -> Var
-- ^ Look up the renaming of an occurrence in the left or right term
rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
rnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var
-- ^ Look up the renaming of an occurrence in the left or right term
rnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v
rnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v
inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
-- ^ Tells whether a variable is locally bound
inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
...
...
compiler/coreSyn/CoreSubst.lhs
View file @
c15fef6b
...
...
@@ -8,7 +8,8 @@ Utility functions on @Core@ syntax
\begin{code}
module CoreSubst (
-- * Main data types
Subst, TvSubstEnv, IdSubstEnv, InScopeSet,
Subst(..), -- Implementation exported for supercompiler's Renaming.hs only
TvSubstEnv, IdSubstEnv, InScopeSet,
-- ** Substituting into expressions and related types
deShadowBinds, substSpec, substRulesForImportedIds,
...
...
compiler/prelude/PrelNames.lhs
View file @
c15fef6b
...
...
@@ -701,6 +701,10 @@ stringTyConName = tcQual gHC_BASE (fsLit "String") stringTyConKey
inlineIdName :: Name
inlineIdName = varQual gHC_MAGIC (fsLit "inline") inlineIdKey
-- The 'undefined' function. Used by supercompilation.
undefinedName :: Name
undefinedName = varQual gHC_ERR (fsLit "undefined") undefinedKey
-- Base classes (Eq, Ord, Functor)
fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name
eqClassName = clsQual gHC_CLASSES (fsLit "Eq") eqClassKey
...
...
@@ -1440,6 +1444,9 @@ marshalStringIdKey = mkPreludeMiscIdUnique 96
unmarshalStringIdKey = mkPreludeMiscIdUnique 97
checkDotnetResNameIdKey = mkPreludeMiscIdUnique 98
undefinedKey :: Unique
undefinedKey = mkPreludeMiscIdUnique 99
\end{code}
Certain class operations from Prelude classes. They get their own
...
...
compiler/utils/Outputable.lhs
View file @
c15fef6b
...
...
@@ -596,6 +596,10 @@ keyword = bold
-- | Class designating that some type has an 'SDoc' representation
class Outputable a where
ppr :: a -> SDoc
pprPrec :: Rational -> a -> SDoc
ppr = pprPrec 0
pprPrec _ = ppr
\end{code}
\begin{code}
...
...
@@ -656,6 +660,27 @@ instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e)
ppr d <> comma,
ppr e])
instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f) =>
Outputable (a, b, c, d, e, f) where
ppr (a,b,c,d,e,f) =
parens (sep [ppr a <> comma,
ppr b <> comma,
ppr c <> comma,
ppr d <> comma,
ppr e <> comma,
ppr f])
instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f, Outputable g) =>
Outputable (a, b, c, d, e, f, g) where
ppr (a,b,c,d,e,f,g) =
parens (sep [ppr a <> comma,
ppr b <> comma,
ppr c <> comma,
ppr d <> comma,
ppr e <> comma,
ppr f <> comma,
ppr g])
instance Outputable FastString where
ppr fs = ftext fs -- Prints an unadorned string,
-- no double quotes or anything
...
...
compiler/utils/UniqFM.lhs
View file @
c15fef6b
...
...
@@ -64,7 +64,9 @@ import Outputable
import Compiler.Hoopl hiding (Unique)
import Data.Function (on)
import qualified Data.IntMap as M
import qualified Data.Foldable as Foldable
\end{code}
%************************************************************************
...
...
@@ -161,7 +163,13 @@ ufmToList :: UniqFM elt -> [(Unique, elt)]
%************************************************************************
\begin{code}
newtype UniqFM ele = UFM (M.IntMap ele)
newtype UniqFM ele = UFM { unUFM :: M.IntMap ele }
instance Eq ele => Eq (UniqFM ele) where
(==) = (==) `on` unUFM
instance Foldable.Foldable UniqFM where
foldMap f = Foldable.foldMap f . unUFM
emptyUFM = UFM M.empty
isNullUFM (UFM m) = M.null m
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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