Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
85514ae1
Commit
85514ae1
authored
Jul 02, 2008
by
rl@cse.unsw.edu.au
Browse files
Command-line options for selecting DPH backend
It's -fdph-seq and -fdph-par at the moment, I'll think of a nicer setup later.
parent
efe7a8d4
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
85514ae1
...
...
@@ -23,6 +23,7 @@ module DynFlags (
Option
(
..
),
DynLibLoader
(
..
),
fFlags
,
xFlags
,
DPHBackend
(
..
),
-- Configuration of the core-to-core and stg-to-stg phases
CoreToDo
(
..
),
...
...
@@ -310,6 +311,8 @@ data DynFlags = DynFlags {
mainFunIs
::
Maybe
String
,
ctxtStkDepth
::
Int
,
-- Typechecker context stack depth
dphBackend
::
DPHBackend
,
thisPackage
::
PackageId
,
-- ways
...
...
@@ -501,6 +504,8 @@ defaultDynFlags =
mainFunIs
=
Nothing
,
ctxtStkDepth
=
mAX_CONTEXT_REDUCTION_DEPTH
,
dphBackend
=
DPHPar
,
thisPackage
=
mainPackageId
,
objectDir
=
Nothing
,
...
...
@@ -807,7 +812,7 @@ data CoreToDo -- These are diff core-to-core passes,
|
CoreCSE
|
CoreDoRuleCheck
Int
{-CompilerPhase-}
String
-- Check for non-application of rules
-- matching this string
|
CoreDoVectorisation
|
CoreDoVectorisation
DPHBackend
|
CoreDoNothing
-- Useful when building up
|
CoreDoPasses
[
CoreToDo
]
-- lists of these things
...
...
@@ -848,7 +853,6 @@ getCoreToDo dflags
spec_constr
=
dopt
Opt_SpecConstr
dflags
liberate_case
=
dopt
Opt_LiberateCase
dflags
rule_check
=
ruleCheck
dflags
vectorisation
=
dopt
Opt_Vectorise
dflags
static_args
=
dopt
Opt_StaticArgumentTransformation
dflags
maybe_rule_check
phase
=
runMaybe
rule_check
(
CoreDoRuleCheck
phase
)
...
...
@@ -861,6 +865,11 @@ getCoreToDo dflags
maybe_rule_check
phase
]
vectorisation
=
runWhen
(
dopt
Opt_Vectorise
dflags
)
$
CoreDoPasses
[
simpl_gently
,
CoreDoVectorisation
(
dphBackend
dflags
)
]
-- By default, we have 2 phases before phase 0.
-- Want to run with inline phase 2 after the specialiser to give
...
...
@@ -895,7 +904,7 @@ getCoreToDo dflags
core_todo
=
if
opt_level
==
0
then
[
runWhen
vectorisation
(
CoreDoPasses
[
simpl_gently
,
CoreDoVectorisation
])
,
[
vectorisation
,
simpl_phase
0
[
"final"
]
max_iter
]
else
{- opt_level >= 1 -}
[
...
...
@@ -905,12 +914,12 @@ getCoreToDo dflags
-- after this before anything else
runWhen
static_args
(
CoreDoPasses
[
simpl_gently
,
CoreDoStaticArgs
]),
-- initial simplify: mk specialiser happy: minimum effort please
simpl_gently
,
-- We run vectorisation here for now, but we might also try to run
-- it later
runWhen
vectorisation
(
CoreDoPasses
[
CoreDoVectorisation
,
simpl_gently
]),
vectorisation
,
-- initial simplify: mk specialiser happy: minimum effort please
simpl_gently
,
-- Specialisation is best done before full laziness
-- so that overloaded functions have all their dictionary lambdas manifest
...
...
@@ -1323,6 +1332,15 @@ dynamic_flags = [
(
IntSuffix
$
\
n
->
upd
$
\
dfs
->
dfs
{
ctxtStkDepth
=
n
})
Supported
------ DPH flags ----------------------------------------------------
,
Flag
"fdph-seq"
(
NoArg
(
upd
(
setDPHBackend
DPHSeq
)))
Supported
,
Flag
"fdph-par"
(
NoArg
(
upd
(
setDPHBackend
DPHPar
)))
Supported
------ Compiler flags -----------------------------------------------
,
Flag
"fasm"
(
NoArg
(
setObjTarget
HscAsm
))
Supported
...
...
@@ -1711,6 +1729,11 @@ setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
`
dopt_set
`
Opt_DictsCheap
`
dopt_unset
`
Opt_MethodSharing
data
DPHBackend
=
DPHPar
|
DPHSeq
setDPHBackend
::
DPHBackend
->
DynFlags
->
DynFlags
setDPHBackend
backend
dflags
=
dflags
{
dphBackend
=
backend
}
setMainIs
::
String
->
DynP
()
...
...
compiler/simplCore/SimplCore.lhs
View file @
85514ae1
...
...
@@ -161,7 +161,7 @@ doCorePass CoreDoWorkerWrapper = {-# SCC "WorkWrap" #-} trBindsU ww
doCorePass CoreDoSpecialising = {-# SCC "Specialise" #-} trBindsU specProgram
doCorePass CoreDoSpecConstr = {-# SCC "SpecConstr" #-} trBindsU specConstrProgram
doCorePass CoreDoGlomBinds = trBinds glomBinds
doCorePass CoreDoVectorisation
= {-# SCC "Vectorise" #-} vectorise
doCorePass
(
CoreDoVectorisation
be)
= {-# SCC "Vectorise" #-} vectorise
be
doCorePass CoreDoPrintCore = observe printCore
doCorePass (CoreDoRuleCheck phase pat) = ruleCheck phase pat
doCorePass CoreDoNothing = observe (\ _ _ -> return ())
...
...
compiler/vectorise/VectMonad.hs
View file @
85514ae1
...
...
@@ -37,7 +37,7 @@ module VectMonad (
import
VectBuiltIn
import
HscTypes
import
Module
(
dphSeq
PackageId
)
import
Module
(
PackageId
)
import
CoreSyn
import
TyCon
import
DataCon
...
...
@@ -479,8 +479,8 @@ lookupFamInst tycon tys
(
ppr
$
mkTyConApp
tycon
tys
)
}
initV
::
HscEnv
->
ModGuts
->
VectInfo
->
VM
a
->
IO
(
Maybe
(
VectInfo
,
a
))
initV
hsc_env
guts
info
p
initV
::
PackageId
->
HscEnv
->
ModGuts
->
VectInfo
->
VM
a
->
IO
(
Maybe
(
VectInfo
,
a
))
initV
pkg
hsc_env
guts
info
p
=
do
Just
r
<-
initDs
hsc_env
(
mg_module
guts
)
(
mg_rdr_env
guts
)
...
...
@@ -491,7 +491,7 @@ initV hsc_env guts info p
go
=
do
builtins
<-
initBuiltins
dphSeqPackageId
builtins
<-
initBuiltins
pkg
builtin_vars
<-
initBuiltinVars
builtins
builtin_tycons
<-
initBuiltinTyCons
builtins
let
builtin_datacons
=
initBuiltinDataCons
builtins
...
...
compiler/vectorise/Vectorise.hs
View file @
85514ae1
...
...
@@ -10,6 +10,7 @@ import VectCore
import
DynFlags
import
HscTypes
import
Module
(
dphSeqPackageId
,
dphParPackageId
)
import
CoreLint
(
showPass
,
endPass
)
import
CoreSyn
import
CoreUtils
...
...
@@ -36,19 +37,23 @@ import FastString
import
Control.Monad
(
liftM
,
liftM2
,
zipWithM
)
import
Data.List
(
sortBy
,
unzip4
)
vectorise
::
HscEnv
->
UniqSupply
->
RuleBase
->
ModGuts
vectorise
::
DPHBackend
->
HscEnv
->
UniqSupply
->
RuleBase
->
ModGuts
->
IO
(
SimplCount
,
ModGuts
)
vectorise
hsc_env
_
_
guts
vectorise
backend
hsc_env
_
_
guts
=
do
showPass
dflags
"Vectorisation"
eps
<-
hscEPS
hsc_env
let
info
=
hptVectInfo
hsc_env
`
plusVectInfo
`
eps_vect_info
eps
Just
(
info'
,
guts'
)
<-
initV
hsc_env
guts
info
(
vectModule
guts
)
Just
(
info'
,
guts'
)
<-
initV
(
backendPackage
backend
)
hsc_env
guts
info
(
vectModule
guts
)
endPass
dflags
"Vectorisation"
Opt_D_dump_vect
(
mg_binds
guts'
)
return
(
zeroSimplCount
dflags
,
guts'
{
mg_vect_info
=
info'
})
where
dflags
=
hsc_dflags
hsc_env
backendPackage
DPHSeq
=
dphSeqPackageId
backendPackage
DPHPar
=
dphParPackageId
vectModule
::
ModGuts
->
VM
ModGuts
vectModule
guts
=
do
...
...
Write
Preview
Supports
Markdown
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