Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
93f0a15d
Commit
93f0a15d
authored
Jun 26, 2011
by
Ian Lynagh
Browse files
Turn the
#5030
test into a performance test
parent
5505d877
Changes
3
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/indexed-types/should_compile/all.T
View file @
93f0a15d
...
...
@@ -171,7 +171,6 @@ test('T4981-V3', normal, compile, [''])
test
('
T5002
',
normal
,
compile
,
[''])
test
('
PushedInAsGivens
',
normal
,
compile
,
[''])
test
('
SlowComp
',
reqlib
('
mtl
'),
compile
,
['
-fcontext-stack=300
'])
# Superclass equalities
test
('
T4338
',
normal
,
compile
,
[''])
...
...
testsuite/tests/ghc-regress/
indexed-types/should_compile/SlowComp
.hs
→
testsuite/tests/ghc-regress/
perf/compiler/T5030
.hs
View file @
93f0a15d
{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls, FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module
SlowComp
where
import
Control.Monad
import
Control.Monad.State
-------------------------------------------------------------------------------
-- Usual Peano integers.
class
NatInt
a
where
natInt
::
a
->
Int
data
D0
n
=
D0
{
d0Arg
::
n
}
data
D1
n
=
D1
{
d1Arg
::
n
}
data
C0
data
C1
class
DPosInt
n
where
posInt
::
n
->
(
Int
,
Int
)
instance
DPosInt
()
where
posInt
_
=
(
0
,
1
)
instance
DPosInt
n
=>
DPosInt
(
D0
n
)
where
posInt
a
=
(
dsum
,
w
*
2
)
where
(
dsum
,
w
)
=
posInt
$
d0Arg
a
instance
DPosInt
n
=>
DPosInt
(
D1
n
)
where
posInt
a
=
(
dsum
+
w
,
w
*
2
)
where
(
dsum
,
w
)
=
posInt
$
d1Arg
a
instance
NatInt
()
where
natInt
_
=
0
instance
DPosInt
n
=>
NatInt
(
D0
n
)
where
natInt
a
=
fst
$
posInt
a
instance
DPosInt
n
=>
NatInt
(
D1
n
)
where
natInt
a
=
fst
$
posInt
a
type
family
DRev
a
type
instance
DRev
a
=
DRev'
a
()
type
family
DRev'
x
acc
type
instance
DRev'
()
acc
=
acc
type
instance
DRev'
(
D0
a
)
acc
=
DRev'
a
(
D0
acc
)
type
instance
DRev'
(
D1
a
)
acc
=
DRev'
a
(
D1
acc
)
type
family
DAddC
c
a
b
type
instance
DAddC
C0
(
D0
a
)
(
D0
b
)
=
D0
(
DAddC
C0
a
b
)
type
instance
DAddC
C0
(
D1
a
)
(
D0
b
)
=
D1
(
DAddC
C0
a
b
)
type
instance
DAddC
C0
(
D0
a
)
(
D1
b
)
=
D1
(
DAddC
C0
a
b
)
type
instance
DAddC
C0
(
D1
a
)
(
D1
b
)
=
D0
(
DAddC
C1
a
b
)
type
instance
DAddC
C1
(
D0
a
)
(
D0
b
)
=
D1
(
DAddC
C0
a
b
)
type
instance
DAddC
C1
(
D1
a
)
(
D0
b
)
=
D0
(
DAddC
C1
a
b
)
type
instance
DAddC
C1
(
D0
a
)
(
D1
b
)
=
D0
(
DAddC
C1
a
b
)
type
instance
DAddC
C1
(
D1
a
)
(
D1
b
)
=
D1
(
DAddC
C1
a
b
)
type
instance
DAddC
C0
()
()
=
()
type
instance
DAddC
C1
()
()
=
D1
()
type
instance
DAddC
c
(
D0
a
)
()
=
DAddC
c
(
D0
a
)
(
D0
()
)
type
instance
DAddC
c
(
D1
a
)
()
=
DAddC
c
(
D1
a
)
(
D0
()
)
type
instance
DAddC
c
()
(
D0
b
)
=
DAddC
c
(
D0
b
)
(
D0
()
)
type
instance
DAddC
c
()
(
D1
b
)
=
DAddC
c
(
D1
b
)
(
D0
()
)
type
family
DNorm
a
type
instance
DNorm
()
=
D0
()
type
instance
DNorm
(
D0
()
)
=
D0
()
type
instance
DNorm
(
D0
(
D1
a
))
=
D1
a
type
instance
DNorm
(
D0
(
D0
a
))
=
DNorm
a
type
instance
DNorm
(
D1
a
)
=
D1
a
type
family
DPlus
a
b
type
instance
DPlus
a
b
=
DNorm
(
DRev
(
DAddC
C0
(
DRev
a
)
(
DRev
b
)))
type
family
DDepth
a
type
instance
DDepth
()
=
D0
()
type
instance
DDepth
(
D0
()
)
=
D0
()
type
instance
DDepth
(
D1
()
)
=
D1
()
type
instance
DDepth
(
D1
(
D0
n
))
=
DPlus
ONE
(
DDepth
(
D1
n
))
type
instance
DDepth
(
D1
(
D1
n
))
=
DPlus
ONE
(
DDepth
(
D1
n
))
type
family
DLog2
a
type
instance
DLog2
a
=
DDepth
a
type
ZERO
=
D0
()
type
ONE
=
D1
()
type
TWO
=
DPlus
ONE
ONE
type
THREE
=
DPlus
ONE
TWO
type
FOUR
=
DPlus
TWO
TWO
type
FIVE
=
DPlus
ONE
FOUR
type
SIX
=
DPlus
TWO
FOUR
type
SEVEN
=
DPlus
ONE
SIX
type
EIGHT
=
DPlus
FOUR
FOUR
type
NINE
=
DPlus
FOUR
FIVE
type
TEN
=
DPlus
EIGHT
TWO
type
SIZE8
=
EIGHT
type
SIZE9
=
NINE
type
SIZE10
=
TEN
type
SIZE12
=
DPlus
SIX
SIX
type
SIZE15
=
DPlus
EIGHT
SEVEN
type
SIZE16
=
DPlus
EIGHT
EIGHT
type
SIZE17
=
DPlus
ONE
SIZE16
type
SIZE24
=
DPlus
SIZE8
SIZE16
type
SIZE32
=
DPlus
SIZE8
SIZE24
type
SIZE30
=
DPlus
SIZE24
SIX
-------------------------------------------------------------------------------
-- Description of CPU.
class
CPU
cpu
where
-- register address.
type
RegAddrSize
cpu
-- register width
type
RegDataSize
cpu
-- immediate width.
type
ImmSize
cpu
-- variables in CPU - register indices, command format variables, etc.
type
CPUVars
cpu
::
*
->
*
data
Const
size
=
Const
Integer
data
Var
cpu
size
where
Temp
::
Int
->
Var
cpu
size
Var
::
CPUVars
cpu
size
->
Var
cpu
size
-------------------------------------------------------------------------------
-- Command description monad.
data
Command
cpu
where
Command
::
(
Var
cpu
size
)
->
(
Operation
cpu
size
)
->
Command
cpu
type
RegVar
cpu
=
Var
cpu
(
RegDataSize
cpu
)
type
Immediate
cpu
=
Const
(
ImmSize
cpu
)
data
Operation
cpu
resultSize
where
Add
::
RegVar
cpu
->
Either
(
Immediate
cpu
)
(
RegVar
cpu
)
->
Operation
cpu
(
RegDataSize
cpu
)
Sub
::
RegVar
cpu
->
Either
(
Immediate
cpu
)
(
RegVar
cpu
)
->
Operation
cpu
(
RegDataSize
cpu
)
type
CDM
cpu
a
=
StateT
(
Int
,
[
Command
cpu
])
IO
a
(
$=
)
::
CPU
cpu
=>
Var
cpu
size
->
Operation
cpu
size
->
CDM
cpu
()
var
$=
op
=
modify
$
\
(
cnt
,
ops
)
->
(
cnt
,
ops
++
[
Command
var
op
])
tempVar
::
CPU
cpu
=>
CDM
cpu
(
Var
cpu
size
)
tempVar
=
do
cnt
<-
liftM
fst
get
modify
$
\
(
_
,
cmds
)
->
(
cnt
+
1
,
cmds
)
return
$
Temp
cnt
op
::
CPU
cpu
=>
Operation
cpu
size
->
CDM
cpu
(
Var
cpu
size
)
op
operation
=
do
v
<-
tempVar
v
$=
operation
return
v
-------------------------------------------------------------------------------
-- Dummy CPU.
data
DummyCPU
=
DummyCPU
data
DummyVar
size
where
DummyFlag
::
Flag
->
DummyVar
ONE
DummyReg
::
Int
->
DummyVar
SIZE16
DummyZero
::
DummyVar
SIZE16
data
Flag
=
C
|
Z
|
N
|
V
instance
CPU
DummyCPU
where
type
RegAddrSize
DummyCPU
=
FIVE
type
RegDataSize
DummyCPU
=
SIZE16
type
ImmSize
DummyCPU
=
SIZE12
type
CPUVars
DummyCPU
=
DummyVar
-------------------------------------------------------------------------------
-- Long compiling program.
cnst
::
Integer
->
Either
(
Immediate
DummyCPU
)
(
RegVar
DummyCPU
)
cnst
x
=
Left
(
Const
x
)
longCompilingProgram
::
CDM
DummyCPU
()
longCompilingProgram
=
do
-- the number of lines below greatly affects compilation time.
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
return
()
{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls, FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module
SlowComp
where
import
Control.Monad
-- import Control.Monad.State
-------------------------------------------------------------------------------
-- Usual Peano integers.
class
NatInt
a
where
natInt
::
a
->
Int
data
D0
n
=
D0
{
d0Arg
::
n
}
data
D1
n
=
D1
{
d1Arg
::
n
}
data
C0
data
C1
class
DPosInt
n
where
posInt
::
n
->
(
Int
,
Int
)
instance
DPosInt
()
where
posInt
_
=
(
0
,
1
)
instance
DPosInt
n
=>
DPosInt
(
D0
n
)
where
posInt
a
=
(
dsum
,
w
*
2
)
where
(
dsum
,
w
)
=
posInt
$
d0Arg
a
instance
DPosInt
n
=>
DPosInt
(
D1
n
)
where
posInt
a
=
(
dsum
+
w
,
w
*
2
)
where
(
dsum
,
w
)
=
posInt
$
d1Arg
a
instance
NatInt
()
where
natInt
_
=
0
instance
DPosInt
n
=>
NatInt
(
D0
n
)
where
natInt
a
=
fst
$
posInt
a
instance
DPosInt
n
=>
NatInt
(
D1
n
)
where
natInt
a
=
fst
$
posInt
a
type
family
DRev
a
type
instance
DRev
a
=
DRev'
a
()
type
family
DRev'
x
acc
type
instance
DRev'
()
acc
=
acc
type
instance
DRev'
(
D0
a
)
acc
=
DRev'
a
(
D0
acc
)
type
instance
DRev'
(
D1
a
)
acc
=
DRev'
a
(
D1
acc
)
type
family
DAddC
c
a
b
type
instance
DAddC
C0
(
D0
a
)
(
D0
b
)
=
D0
(
DAddC
C0
a
b
)
type
instance
DAddC
C0
(
D1
a
)
(
D0
b
)
=
D1
(
DAddC
C0
a
b
)
type
instance
DAddC
C0
(
D0
a
)
(
D1
b
)
=
D1
(
DAddC
C0
a
b
)
type
instance
DAddC
C0
(
D1
a
)
(
D1
b
)
=
D0
(
DAddC
C1
a
b
)
type
instance
DAddC
C1
(
D0
a
)
(
D0
b
)
=
D1
(
DAddC
C0
a
b
)
type
instance
DAddC
C1
(
D1
a
)
(
D0
b
)
=
D0
(
DAddC
C1
a
b
)
type
instance
DAddC
C1
(
D0
a
)
(
D1
b
)
=
D0
(
DAddC
C1
a
b
)
type
instance
DAddC
C1
(
D1
a
)
(
D1
b
)
=
D1
(
DAddC
C1
a
b
)
type
instance
DAddC
C0
()
()
=
()
type
instance
DAddC
C1
()
()
=
D1
()
type
instance
DAddC
c
(
D0
a
)
()
=
DAddC
c
(
D0
a
)
(
D0
()
)
type
instance
DAddC
c
(
D1
a
)
()
=
DAddC
c
(
D1
a
)
(
D0
()
)
type
instance
DAddC
c
()
(
D0
b
)
=
DAddC
c
(
D0
b
)
(
D0
()
)
type
instance
DAddC
c
()
(
D1
b
)
=
DAddC
c
(
D1
b
)
(
D0
()
)
type
family
DNorm
a
type
instance
DNorm
()
=
D0
()
type
instance
DNorm
(
D0
()
)
=
D0
()
type
instance
DNorm
(
D0
(
D1
a
))
=
D1
a
type
instance
DNorm
(
D0
(
D0
a
))
=
DNorm
a
type
instance
DNorm
(
D1
a
)
=
D1
a
type
family
DPlus
a
b
type
instance
DPlus
a
b
=
DNorm
(
DRev
(
DAddC
C0
(
DRev
a
)
(
DRev
b
)))
type
family
DDepth
a
type
instance
DDepth
()
=
D0
()
type
instance
DDepth
(
D0
()
)
=
D0
()
type
instance
DDepth
(
D1
()
)
=
D1
()
type
instance
DDepth
(
D1
(
D0
n
))
=
DPlus
ONE
(
DDepth
(
D1
n
))
type
instance
DDepth
(
D1
(
D1
n
))
=
DPlus
ONE
(
DDepth
(
D1
n
))
type
family
DLog2
a
type
instance
DLog2
a
=
DDepth
a
type
ZERO
=
D0
()
type
ONE
=
D1
()
type
TWO
=
DPlus
ONE
ONE
type
THREE
=
DPlus
ONE
TWO
type
FOUR
=
DPlus
TWO
TWO
type
FIVE
=
DPlus
ONE
FOUR
type
SIX
=
DPlus
TWO
FOUR
type
SEVEN
=
DPlus
ONE
SIX
type
EIGHT
=
DPlus
FOUR
FOUR
type
NINE
=
DPlus
FOUR
FIVE
type
TEN
=
DPlus
EIGHT
TWO
type
SIZE8
=
EIGHT
type
SIZE9
=
NINE
type
SIZE10
=
TEN
type
SIZE12
=
DPlus
SIX
SIX
type
SIZE15
=
DPlus
EIGHT
SEVEN
type
SIZE16
=
DPlus
EIGHT
EIGHT
type
SIZE17
=
DPlus
ONE
SIZE16
type
SIZE24
=
DPlus
SIZE8
SIZE16
type
SIZE32
=
DPlus
SIZE8
SIZE24
type
SIZE30
=
DPlus
SIZE24
SIX
-------------------------------------------------------------------------------
-- Description of CPU.
class
CPU
cpu
where
-- register address.
type
RegAddrSize
cpu
-- register width
type
RegDataSize
cpu
-- immediate width.
type
ImmSize
cpu
-- variables in CPU - register indices, command format variables, etc.
type
CPUVars
cpu
::
*
->
*
data
Const
size
=
Const
Integer
data
Var
cpu
size
where
Temp
::
Int
->
Var
cpu
size
Var
::
CPUVars
cpu
size
->
Var
cpu
size
-------------------------------------------------------------------------------
-- Command description monad.
data
Command
cpu
where
Command
::
(
Var
cpu
size
)
->
(
Operation
cpu
size
)
->
Command
cpu
type
RegVar
cpu
=
Var
cpu
(
RegDataSize
cpu
)
type
Immediate
cpu
=
Const
(
ImmSize
cpu
)
data
Operation
cpu
resultSize
where
Add
::
RegVar
cpu
->
Either
(
Immediate
cpu
)
(
RegVar
cpu
)
->
Operation
cpu
(
RegDataSize
cpu
)
Sub
::
RegVar
cpu
->
Either
(
Immediate
cpu
)
(
RegVar
cpu
)
->
Operation
cpu
(
RegDataSize
cpu
)
type
CDM
cpu
a
=
IO
a
(
$=
)
::
CPU
cpu
=>
Var
cpu
size
->
Operation
cpu
size
->
CDM
cpu
()
var
$=
op
=
undefined
tempVar
::
CPU
cpu
=>
CDM
cpu
(
Var
cpu
size
)
tempVar
=
do
cnt
<-
liftM
fst
undefined
return
$
Temp
cnt
op
::
CPU
cpu
=>
Operation
cpu
size
->
CDM
cpu
(
Var
cpu
size
)
op
operation
=
do
v
<-
tempVar
v
$=
operation
return
v
-------------------------------------------------------------------------------
-- Dummy CPU.
data
DummyCPU
=
DummyCPU
data
DummyVar
size
where
DummyFlag
::
Flag
->
DummyVar
ONE
DummyReg
::
Int
->
DummyVar
SIZE16
DummyZero
::
DummyVar
SIZE16
data
Flag
=
C
|
Z
|
N
|
V
instance
CPU
DummyCPU
where
type
RegAddrSize
DummyCPU
=
FIVE
type
RegDataSize
DummyCPU
=
SIZE16
type
ImmSize
DummyCPU
=
SIZE12
type
CPUVars
DummyCPU
=
DummyVar
-------------------------------------------------------------------------------
-- Long compiling program.
cnst
::
Integer
->
Either
(
Immediate
DummyCPU
)
(
RegVar
DummyCPU
)
cnst
x
=
Left
(
Const
x
)
longCompilingProgram
::
CDM
DummyCPU
()
longCompilingProgram
=
do
-- the number of lines below greatly affects compilation time.
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
x10
<-
op
$
Add
(
Var
DummyZero
)
(
cnst
10
)
return
()
testsuite/tests/ghc-regress/perf/compiler/all.T
View file @
93f0a15d
...
...
@@ -138,3 +138,17 @@ test('T4007',
run_command
,
['
$MAKE -s --no-print-directory T4007
'])
test
('
T5030
',
[
# expected value: 629864032 (x86/Darwin)
if_wordsize
(
32
,
compiler_stats_num_field
('
bytes allocated
',
600000000
,
650000000
)),
# expected value: 1255998208 (amd64/Linux):
if_wordsize
(
64
,
compiler_stats_num_field
('
bytes allocated
',
1200000000
,
1300000000
)),
only_ways
(['
normal
'])
],
compile
,
['
-fcontext-stack=300
'])
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