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
Alex D
GHC
Commits
869df3c7
Commit
869df3c7
authored
Dec 29, 2011
by
Simon Peyton Jones
Browse files
Performance test for Trac #5321
parent
4976d0e0
Changes
3
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/perf/compiler/T5321FD.hs
0 → 100644
View file @
869df3c7
{-# OPTIONS_GHC -fcontext-stack=1000 #-}
{-# LANGUAGE
FlexibleContexts, FlexibleInstances, FunctionalDependencies,
MultiParamTypeClasses, OverlappingInstances, TypeSynonymInstances,
TypeOperators, UndecidableInstances, TypeFamilies #-}
module
T5321FD
where
-------- USES FUNCTIONAL DEPENDENCIES -------------
-- Our running example, for simplicity's sake, is a type-level map of a
-- single function. For reference, here is the code for a simple
-- value-level map of a single function.
-- vfoo = id
-- mapfoo (x : xs) = vfoo x : mapfoo xs
-- mapfoo [] = []
-- Because Haskell is a lazy language, this runs in O(n) time and constant stack.
-- We now lift map to the type level, to operate over HLists.
-- First, the basic HList types
infixr
3
:*
data
x
:*
xs
=
x
:*
xs
deriving
Show
data
HNil
=
HNil
deriving
Show
-- Next, a large boring HList
-- Adds ten cells
addData
x
=
i
:*
i
:*
d
:*
d
:*
s
:*
i
:*
i
:*
d
:*
d
:*
s
:*
x
where
i
=
1
::
Int
d
=
1
::
Double
s
=
""
-- Has 70 cells.
sampleData
=
addData
$
addData
$
addData
$
addData
$
addData
$
addData
$
addData
$
HNil
-- Next, a simple polymorphic function to map
class
Foo
x
y
|
x
->
y
where
foo
::
x
->
y
foo
=
undefined
instance
Foo
Int
Double
instance
Foo
Double
Int
instance
Foo
String
String
------------------------
-- Now, our map
class
HMapFoo1
as
bs
|
as
->
bs
where
hMapFoo1
::
as
->
bs
instance
(
Foo
a
b
,
HMapFoo1
as
bs
)
=>
HMapFoo1
(
a
:*
as
)
(
b
:*
bs
)
where
hMapFoo1
(
x
:*
xs
)
=
foo
x
:*
hMapFoo1
xs
instance
HMapFoo1
HNil
HNil
where
hMapFoo1
_
=
HNil
-- If we enable the following line, compilation time is ~ 9 seconds.
testHMapFoo1
=
hMapFoo1
sampleData
------------------------
class
HMapFoo2
acc
as
bs
|
acc
as
->
bs
where
hMapFoo2
::
acc
->
as
->
bs
instance
(
Foo
a
b
,
HMapFoo2
(
b
:*
bs
)
as
res
)
=>
HMapFoo2
bs
(
a
:*
as
)
res
where
hMapFoo2
acc
(
x
:*
xs
)
=
hMapFoo2
(
foo
x
:*
acc
)
xs
instance
HMapFoo2
acc
HNil
acc
where
hMapFoo2
acc
_
=
acc
-- If we enable the following line, compilation time is a much more satisfying ~0.5s.
testHMapFoo2
=
hMapFoo2
HNil
sampleData
------------------------
-- But wait, there's trouble on the horizon! Consider the following version:
class
HMapFoo3
acc
as
bs
|
acc
as
->
bs
where
hMapFoo3
::
acc
->
as
->
bs
instance
(
HMapFoo3
(
b
:*
bs
)
as
res
,
Foo
a
b
)
=>
HMapFoo3
bs
(
a
:*
as
)
res
where
hMapFoo3
acc
(
x
:*
xs
)
=
hMapFoo3
(
foo
x
:*
acc
)
xs
instance
HMapFoo3
acc
HNil
acc
where
hMapFoo3
acc
_
=
acc
-- The only difference between hMapFoo2 and hMapFoo3 is that the order of
-- constraints on the inductive case has been reversed, with the
-- recursive constraint first and the immediately checkable constraint
-- second. Now, if we enable the following line, compilation time rockets
-- to ~6s!
testHMapFoo3
=
hMapFoo3
HNil
sampleData
testsuite/tests/perf/compiler/T5321Fun.hs
0 → 100644
View file @
869df3c7
{-# OPTIONS_GHC -fcontext-stack=1000 #-}
{-# LANGUAGE
FlexibleContexts, FlexibleInstances, FunctionalDependencies,
MultiParamTypeClasses, OverlappingInstances, TypeSynonymInstances,
TypeOperators, UndecidableInstances, TypeFamilies #-}
module
T5321Fun
where
-- As the below code demonstrates, the same issues demonstrated with
-- Functional Dependencies also appear with Type Families, although less
--horribly, as their code-path seems more optimized in the current
-- constraint solver:
-- Our running example, for simplicity's sake, is a type-level map of a
-- single function. For reference, here is the code for a simple
-- value-level map of a single function.
-- > vfoo = id
-- > mapfoo (x : xs) = vfoo x : mapfoo xs
-- > mapfoo [] = []
-- Because Haskell is a lazy language, this runs in O(n) time and constant stack.
-- We now lift map to the type level, to operate over HLists.
-- First, the basic HList types
infixr
3
:*
data
x
:*
xs
=
x
:*
xs
deriving
Show
data
HNil
=
HNil
deriving
Show
-- Next, a large boring HList
-- Adds ten cells
addData
x
=
i
:*
i
:*
d
:*
d
:*
s
:*
i
:*
i
:*
d
:*
d
:*
s
:*
x
where
i
=
1
::
Int
d
=
1
::
Double
s
=
""
-- Has 70 cells.
sampleData
=
addData
$
addData
$
addData
$
addData
$
addData
$
addData
$
addData
$
HNil
class
TFoo
x
where
type
TFooFun
x
tfoo
::
x
->
TFooFun
x
tfoo
=
undefined
instance
TFoo
Int
where
type
TFooFun
Int
=
Double
instance
TFoo
Double
where
type
TFooFun
Double
=
Int
instance
TFoo
String
where
type
TFooFun
String
=
String
class
THMapFoo1
as
where
type
THMapFoo1Res
as
thMapFoo1
::
as
->
THMapFoo1Res
as
instance
(
TFoo
a
,
THMapFoo1
as
)
=>
THMapFoo1
(
a
:*
as
)
where
type
THMapFoo1Res
(
a
:*
as
)
=
TFooFun
a
:*
THMapFoo1Res
as
thMapFoo1
(
x
:*
xs
)
=
tfoo
x
:*
thMapFoo1
xs
instance
THMapFoo1
HNil
where
type
THMapFoo1Res
HNil
=
HNil
thMapFoo1
_
=
HNil
-- The following, when enabled, takes ~3.5s. This demonstrates that slowdown occurs with type families as well.
testTHMapFoo1
=
thMapFoo1
sampleData
class
THMapFoo2
acc
as
where
type
THMapFoo2Res
acc
as
thMapFoo2
::
acc
->
as
->
THMapFoo2Res
acc
as
instance
(
TFoo
a
,
THMapFoo2
(
TFooFun
a
:*
acc
)
as
)
=>
THMapFoo2
acc
(
a
:*
as
)
where
type
THMapFoo2Res
acc
(
a
:*
as
)
=
THMapFoo2Res
(
TFooFun
a
:*
acc
)
as
thMapFoo2
acc
(
x
:*
xs
)
=
thMapFoo2
(
tfoo
x
:*
acc
)
xs
instance
THMapFoo2
acc
HNil
where
type
THMapFoo2Res
acc
HNil
=
acc
thMapFoo2
acc
_
=
acc
-- The following, when enabled, takes ~0.6s. This demonstrates that the
-- tail recursive transform fixes the slowdown with type families just as
-- with fundeps.
testTHMapFoo2
=
thMapFoo2
HNil
sampleData
class
THMapFoo3
acc
as
where
type
THMapFoo3Res
acc
as
thMapFoo3
::
acc
->
as
->
THMapFoo3Res
acc
as
instance
(
THMapFoo3
(
TFooFun
a
:*
acc
)
as
,
TFoo
a
)
=>
THMapFoo3
acc
(
a
:*
as
)
where
type
THMapFoo3Res
acc
(
a
:*
as
)
=
THMapFoo3Res
(
TFooFun
a
:*
acc
)
as
thMapFoo3
acc
(
x
:*
xs
)
=
thMapFoo3
(
tfoo
x
:*
acc
)
xs
instance
THMapFoo3
acc
HNil
where
type
THMapFoo3Res
acc
HNil
=
acc
thMapFoo3
acc
_
=
acc
-- The following, when enabled, also takes ~0.6s. This demonstrates that,
-- unlike the fundep case, the order of type class constraints does not,
-- in this instance, affect the performance of type families.
testTHMapFoo3
=
thMapFoo3
HNil
sampleData
testsuite/tests/perf/compiler/all.T
View file @
869df3c7
...
...
@@ -206,3 +206,29 @@ test('T783',
450000000
))
],
compile
,[''])
test
('
T5321Fun
',
[
only_ways
(['
normal
']),
# no optimisation for this one
# expected value: 175,569,928 (x86/Linux)
if_wordsize
(
32
,
compiler_stats_num_field
('
bytes allocated
',
1000000000
,
1100000000
)),
# expected value: 390895576 (amd64/Linux):
if_wordsize
(
64
,
compiler_stats_num_field
('
bytes allocated
',
2000000000
,
2200000000
))
],
compile
,[''])
test
('
T5321FD
',
[
only_ways
(['
normal
']),
# no optimisation for this one
# expected value: 175,569,928 (x86/Linux)
if_wordsize
(
32
,
compiler_stats_num_field
('
bytes allocated
',
500000000
,
600000000
)),
# expected value: 390895576 (amd64/Linux):
if_wordsize
(
64
,
compiler_stats_num_field
('
bytes allocated
',
1000000000
,
1200000000
))
],
compile
,[''])
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