Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
fca85c9b
Commit
fca85c9b
authored
Dec 10, 2014
by
Simon Peyton Jones
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Tests for Trac
#9872
parent
37b3646c
Changes
5
Hide whitespace changes
Inline
Sidebyside
Showing
5 changed files
with
392 additions
and
0 deletions
+392
0
testsuite/tests/perf/compiler/T9872a.hs
testsuite/tests/perf/compiler/T9872a.hs
+167
0
testsuite/tests/perf/compiler/T9872a.stderr
testsuite/tests/perf/compiler/T9872a.stderr
+66
0
testsuite/tests/perf/compiler/T9872b.hs
testsuite/tests/perf/compiler/T9872b.hs
+115
0
testsuite/tests/perf/compiler/T9872b.stderr
testsuite/tests/perf/compiler/T9872b.stderr
+24
0
testsuite/tests/perf/compiler/all.T
testsuite/tests/perf/compiler/all.T
+20
0
No files found.
testsuite/tests/perf/compiler/T9872a.hs
0 → 100644
View file @
fca85c9b
{
 Instant Insanity using Type Families.

 See: The Monad Read, Issue #8  http://www.haskell.org/wikiupload/d/dd/TMRIssue8.pdf
}
{# OPTIONS_GHC ftypefunctiondepth=400 #}
{# LANGUAGE MultiParamTypeClasses #}
{# LANGUAGE TypeFamilies #}
{# LANGUAGE UndecidableInstances #}
import
Prelude
hiding
(
all
,
flip
,
map
,
filter
)
data
Proxy
a
=
Proxy
main
=
print
(
Proxy
::
Proxy
(
Solutions
Cubes
))
data
R
 Red
data
G
 Green
data
B
 Blue
data
W
 White
data
Cube
u
f
r
b
l
d
data
True
data
False
type
family
And
b1
b2
::
*
type
instance
And
True
True
=
True
type
instance
And
True
False
=
False
type
instance
And
False
False
=
False
type
instance
And
False
True
=
False
type
family
NE
x
y
::
*
type
instance
NE
R
R
=
False
type
instance
NE
R
G
=
True
type
instance
NE
R
B
=
True
type
instance
NE
R
W
=
True
type
instance
NE
G
R
=
True
type
instance
NE
G
G
=
False
type
instance
NE
G
B
=
True
type
instance
NE
G
W
=
True
type
instance
NE
B
R
=
True
type
instance
NE
B
G
=
True
type
instance
NE
B
B
=
False
type
instance
NE
B
W
=
True
type
instance
NE
W
R
=
True
type
instance
NE
W
G
=
True
type
instance
NE
W
B
=
True
type
instance
NE
W
W
=
False
type
family
EQ
x
y
::
*
type
instance
EQ
R
R
=
True
type
instance
EQ
R
G
=
False
type
instance
EQ
R
B
=
False
type
instance
EQ
R
W
=
False
type
instance
EQ
G
R
=
False
type
instance
EQ
G
G
=
True
type
instance
EQ
G
B
=
False
type
instance
EQ
G
W
=
False
type
instance
EQ
B
R
=
False
type
instance
EQ
B
G
=
False
type
instance
EQ
B
B
=
True
type
instance
EQ
B
W
=
False
type
instance
EQ
W
R
=
False
type
instance
EQ
W
G
=
False
type
instance
EQ
W
B
=
False
type
instance
EQ
W
W
=
True
data
Nil
=
Nil
data
Cons
x
xs
=
Cons
x
xs
type
family
All
l
::
*
type
instance
All
Nil
=
True
type
instance
All
(
Cons
False
xs
)
=
False
type
instance
All
(
Cons
True
xs
)
=
All
xs
type
family
ListConcat
xs
ys
::
*
type
instance
ListConcat
Nil
ys
=
ys
type
instance
ListConcat
(
Cons
x
xs
)
ys
=
Cons
x
(
ListConcat
xs
ys
)
type
family
AppendIf
b
a
as
::
*
type
instance
AppendIf
False
a
as
=
as
type
instance
AppendIf
True
a
as
=
Cons
a
as
data
Rotate
data
Twist
data
Flip
type
family
Apply
f
a
::
*
type
instance
Apply
Rotate
(
Cube
u
f
r
b
l
d
)
=
(
Cube
u
r
b
l
f
d
)
type
instance
Apply
Twist
(
Cube
u
f
r
b
l
d
)
=
(
Cube
f
r
u
l
d
b
)
type
instance
Apply
Flip
(
Cube
u
f
r
b
l
d
)
=
(
Cube
d
l
b
r
f
u
)
 orientations c = [ z  x < [ c, flip c ], y < [ x, twist x, twist (twist x) ], z < [y, rot y, rot(rot y), rot(rot(rot(y))) ] ]
type
family
Map
f
as
::
*
type
instance
Map
f
Nil
=
Nil
type
instance
Map
f
(
Cons
a
as
)
=
Cons
(
Apply
f
a
)
(
Map
f
as
)
type
family
MapAppend
f
as
::
*
type
instance
MapAppend
f
xs
=
ListConcat
xs
(
Map
f
xs
)
type
family
MapAppend2
f
as
::
*
type
instance
MapAppend2
f
xs
=
ListConcat
xs
(
MapAppend
f
(
Map
f
xs
))
type
family
MapAppend3
f
as
::
*
type
instance
MapAppend3
f
xs
=
ListConcat
xs
(
MapAppend2
f
(
Map
f
xs
))
type
family
Iterate2
f
as
::
*
type
instance
Iterate2
f
Nil
=
Nil
type
instance
Iterate2
f
(
Cons
a
as
)
=
ListConcat
(
Cons
(
Apply
f
a
)
(
Cons
a
Nil
))
(
Iterate2
f
as
)
type
family
Iterate3
f
as
::
*
type
instance
Iterate3
f
(
Cons
a
as
)
=
ListConcat
(
Cons
a
(
Cons
(
Apply
f
a
)
(
Cons
(
Apply
f
(
Apply
f
a
))
Nil
)))
(
Iterate3
f
as
)
type
family
Iterate4
f
as
::
*
type
instance
Iterate4
f
Nil
=
Nil
type
instance
Iterate4
f
(
Cons
a
as
)
=
ListConcat
(
Cons
a
(
Cons
(
Apply
f
a
)
(
Cons
(
Apply
f
(
Apply
f
a
))
(
Cons
(
Apply
f
(
Apply
f
(
Apply
f
a
)))
Nil
))))
(
Iterate4
f
as
)
type
family
Orientations
c
::
*
 type instance Orientations c = Iterate4 Rotate (Iterate3 Twist (Iterate2 Flip (Cons c Nil)))
type
instance
Orientations
c
=
MapAppend3
Rotate
(
MapAppend2
Twist
(
MapAppend
Flip
(
Cons
c
Nil
)))
type
Cube1
=
Cube
B
G
W
G
B
R
type
Cube2
=
Cube
W
G
B
W
R
R
type
Cube3
=
Cube
G
W
R
B
R
R
type
Cube4
=
Cube
B
R
G
G
W
W
type
Cubes
=
Cons
Cube1
(
Cons
Cube2
(
Cons
Cube3
(
Cons
Cube4
Nil
)))
type
family
Compatible
c
d
::
*
type
instance
Compatible
(
Cube
u1
f1
r1
b1
l1
d1
)
(
Cube
u2
f2
r2
b2
l2
d2
)
=
All
(
Cons
(
NE
f1
f2
)
(
Cons
(
NE
r1
r2
)
(
Cons
(
NE
b1
b2
)
(
Cons
(
NE
l1
l2
)
Nil
))))
type
family
Allowed
c
cs
::
*
type
instance
Allowed
c
Nil
=
True
type
instance
Allowed
c
(
Cons
s
ss
)
=
And
(
Compatible
c
s
)
(
Allowed
c
ss
)
type
family
MatchingOrientations
as
sol
::
*
type
instance
MatchingOrientations
Nil
sol
=
Nil
type
instance
MatchingOrientations
(
Cons
o
os
)
sol
=
AppendIf
(
Allowed
o
sol
)
(
Cons
o
sol
)
(
MatchingOrientations
os
sol
)
type
family
AllowedCombinations
os
sols
::
*
type
instance
AllowedCombinations
os
Nil
=
Nil
type
instance
AllowedCombinations
os
(
Cons
sol
sols
)
=
ListConcat
(
MatchingOrientations
os
sol
)
(
AllowedCombinations
os
sols
)
type
family
Solutions
c
::
*
type
instance
Solutions
Nil
=
Cons
Nil
Nil
type
instance
Solutions
(
Cons
c
cs
)
=
AllowedCombinations
(
Orientations
c
)
(
Solutions
cs
)
{
 solutions [] = [ [] ]
 solutions (c:cs) = [ (o:sol)  sol < solutions cs, o < orientations c, allowed o
}
\ No newline at end of file
testsuite/tests/perf/compiler/T9872a.stderr
0 → 100644
View file @
fca85c9b
T9872a.hs:16:8:
No instance for (Show
(Proxy
(Cons
(Cons
(Cube G B W R B G)
(Cons
(Cube W G B W R R)
(Cons (Cube R W R B G R) (Cons (Cube B R G G W W) Nil))))
(Cons
(Cons
(Cube G B R W B G)
(Cons
(Cube R R W B G W)
(Cons (Cube R G B R W R) (Cons (Cube W W G G R B) Nil))))
(Cons
(Cons
(Cube G W R B B G)
(Cons
(Cube W B W R G R)
(Cons (Cube R R B G W R) (Cons (Cube B G G W R W) Nil))))
(Cons
(Cons
(Cube G R W B B G)
(Cons
(Cube R W B G R W)
(Cons
(Cube R B R W G R) (Cons (Cube W G G R W B) Nil))))
(Cons
(Cons
(Cube G R B B W G)
(Cons
(Cube W W R G B R)
(Cons
(Cube R B G W R R)
(Cons (Cube B G W R G W) Nil))))
(Cons
(Cons
(Cube G W B B R G)
(Cons
(Cube R B G R W W)
(Cons
(Cube R R W G B R)
(Cons (Cube W G R W G B) Nil))))
(Cons
(Cons
(Cube G B B W R G)
(Cons
(Cube W R G B W R)
(Cons
(Cube R G W R B R)
(Cons (Cube B W R G G W) Nil))))
(Cons
(Cons
(Cube G B B R W G)
(Cons
(Cube R G R W B W)
(Cons
(Cube R W G B R R)
(Cons (Cube W R W G G B) Nil))))
Nil))))))))))
arising from a use of ‘print’
In the expression: print (Proxy :: Proxy (Solutions Cubes))
In an equation for ‘main’:
main = print (Proxy :: Proxy (Solutions Cubes))
testsuite/tests/perf/compiler/T9872b.hs
0 → 100644
View file @
fca85c9b
{
 Instant Insanity using Closed Type Families and DataKinds.

 See: http://stackoverflow.com/questions/26538595
}
{# OPTIONS_GHC ftypefunctiondepth=400 #}
{# LANGUAGE MultiParamTypeClasses #}
{# LANGUAGE TypeFamilies #}
{# LANGUAGE UndecidableInstances #}
{# LANGUAGE DataKinds, KindSignatures, PolyKinds #}
{# LANGUAGE TypeOperators #}
import
Prelude
hiding
(
all
,
flip
,
map
,
filter
)
data
Proxy
(
a
::
k
)
=
Proxy
main
=
print
(
Proxy
::
Proxy
(
Solutions
Cubes
))
data
Color
=
R

G

B

W
data
Cube
=
Cube
Color
Color
Color
Color
Color
Color
type
family
And
(
b1
::
Bool
)
(
b2
::
Bool
)
::
Bool
where
And
True
True
=
True
And
b1
b2
=
False
type
family
NE
(
x
::
Color
)
(
y
::
Color
)
::
Bool
where
NE
x
x
=
False
NE
x
y
=
True
type
family
EQ
(
x
::
Color
)
(
y
::
Color
)
::
Bool
where
EQ
a
a
=
True
EQ
a
b
=
False
type
family
All
(
l
::
[
Bool
])
::
Bool
where
All
'
[]
=
True
All
(
False
'
:
xs
)
=
False
All
(
True
'
:
xs
)
=
All
xs
type
family
ListConcat
(
xs
::
[
k
])
(
ys
::
[
k
])
::
[
k
]
where
ListConcat
'
[]
ys
=
ys
ListConcat
(
x
'
:
xs
)
ys
=
x
'
:
ListConcat
xs
ys
type
family
AppendIf
(
b
::
Bool
)
(
a
::
[
Cube
])
(
as
::
[[
Cube
]])
::
[[
Cube
]]
where
AppendIf
False
a
as
=
as
AppendIf
True
a
as
=
a
'
:
as
data
Transform
=
Rotate

Twist

Flip
type
family
Apply
(
f
::
Transform
)
(
a
::
Cube
)
::
Cube
where
Apply
Rotate
(
'Cube
u
f
r
b
l
d
)
=
(
'Cube
u
r
b
l
f
d
)
Apply
Twist
(
'Cube
u
f
r
b
l
d
)
=
(
'Cube
f
r
u
l
d
b
)
Apply
Flip
(
'Cube
u
f
r
b
l
d
)
=
(
'Cube
d
l
b
r
f
u
)
type
family
Map
(
f
::
Transform
)
(
as
::
[
Cube
])
::
[
Cube
]
where
Map
f
'
[]
=
'
[]
Map
f
(
a
'
:
as
)
=
(
Apply
f
a
)
'
:
(
Map
f
as
)
type
family
MapAppend
(
f
::
Transform
)
(
as
::
[
Cube
])
::
[
Cube
]
where
MapAppend
f
xs
=
ListConcat
xs
(
Map
f
xs
)
type
family
MapAppend2
(
f
::
Transform
)
(
as
::
[
Cube
])
::
[
Cube
]
where
MapAppend2
f
xs
=
ListConcat
xs
(
MapAppend
f
(
Map
f
xs
))
type
family
MapAppend3
(
f
::
Transform
)
(
as
::
[
Cube
])
::
[
Cube
]
where
MapAppend3
f
xs
=
ListConcat
xs
(
MapAppend2
f
(
Map
f
xs
))
type
family
Iterate2
(
f
::
Transform
)
(
as
::
[
Cube
])
::
[
Cube
]
where
Iterate2
f
'
[]
=
'
[]
Iterate2
f
(
a
'
:
as
)
=
ListConcat
[
Apply
f
a
,
a
]
(
Iterate2
f
as
)
type
family
Iterate3
(
f
::
Transform
)
(
as
::
[
Cube
])
::
[
Cube
]
where
Iterate3
f
'
[]
=
'
[]
Iterate3
f
(
a
'
:
as
)
=
ListConcat
[
a
,
Apply
f
a
,
Apply
f
(
Apply
f
a
)]
(
Iterate3
f
as
)
type
family
Iterate4
(
f
::
Transform
)
(
as
::
[
Cube
])
::
[
Cube
]
where
Iterate4
f
'
[]
=
'
[]
Iterate4
f
(
a
'
:
as
)
=
ListConcat
[
a
,
Apply
f
a
,
Apply
f
(
Apply
f
a
),
Apply
f
(
Apply
f
(
Apply
f
a
))]
(
Iterate4
f
as
)
type
family
Orientations
(
c
::
Cube
)
::
[
Cube
]
where
Orientations
c
=
MapAppend3
Rotate
(
MapAppend2
Twist
(
MapAppend
Flip
'
[
c
]))
type
Cube1
=
'Cube
B
G
W
G
B
R
type
Cube2
=
'Cube
W
G
B
W
R
R
type
Cube3
=
'Cube
G
W
R
B
R
R
type
Cube4
=
'Cube
B
R
G
G
W
W
type
Cubes
=
[
Cube1
,
Cube2
,
Cube3
,
Cube4
]
type
family
Compatible
(
c
::
Cube
)
(
d
::
Cube
)
::
Bool
where
Compatible
(
'Cube
u1
f1
r1
b1
l1
d1
)
(
'Cube
u2
f2
r2
b2
l2
d2
)
=
All
[
NE
f1
f2
,
NE
r1
r2
,
NE
b1
b2
,
NE
l1
l2
]
type
family
Allowed
(
c
::
Cube
)
(
cs
::
[
Cube
])
::
Bool
where
Allowed
c
'
[]
=
True
Allowed
c
(
s
'
:
ss
)
=
And
(
Compatible
c
s
)
(
Allowed
c
ss
)
type
family
MatchingOrientations
(
as
::
[
Cube
])
(
sol
::
[
Cube
])
::
[[
Cube
]]
where
MatchingOrientations
'
[]
sol
=
'
[]
MatchingOrientations
(
o
'
:
os
)
sol
=
AppendIf
(
Allowed
o
sol
)
(
o
'
:
sol
)
(
MatchingOrientations
os
sol
)
type
family
AllowedCombinations
(
os
::
[
Cube
])
(
sols
::
[[
Cube
]])
where
AllowedCombinations
os
'
[]
=
'
[]
AllowedCombinations
os
(
sol
'
:
sols
)
=
ListConcat
(
MatchingOrientations
os
sol
)
(
AllowedCombinations
os
sols
)
type
family
Solutions
(
cs
::
[
Cube
])
::
[[
Cube
]]
where
Solutions
'
[]
=
'
[
'
[]
]
Solutions
(
c
'
:
cs
)
=
AllowedCombinations
(
Orientations
c
)
(
Solutions
cs
)
testsuite/tests/perf/compiler/T9872b.stderr
0 → 100644
View file @
fca85c9b
T9872b.hs:19:8:
No instance for (Show
(Proxy
'['['Cube 'G 'B 'W 'R 'B 'G, 'Cube 'W 'G 'B 'W 'R 'R,
'Cube 'R 'W 'R 'B 'G 'R, 'Cube 'B 'R 'G 'G 'W 'W],
'['Cube 'G 'B 'R 'W 'B 'G, 'Cube 'R 'R 'W 'B 'G 'W,
'Cube 'R 'G 'B 'R 'W 'R, 'Cube 'W 'W 'G 'G 'R 'B],
'['Cube 'G 'W 'R 'B 'B 'G, 'Cube 'W 'B 'W 'R 'G 'R,
'Cube 'R 'R 'B 'G 'W 'R, 'Cube 'B 'G 'G 'W 'R 'W],
'['Cube 'G 'R 'W 'B 'B 'G, 'Cube 'R 'W 'B 'G 'R 'W,
'Cube 'R 'B 'R 'W 'G 'R, 'Cube 'W 'G 'G 'R 'W 'B],
'['Cube 'G 'R 'B 'B 'W 'G, 'Cube 'W 'W 'R 'G 'B 'R,
'Cube 'R 'B 'G 'W 'R 'R, 'Cube 'B 'G 'W 'R 'G 'W],
'['Cube 'G 'W 'B 'B 'R 'G, 'Cube 'R 'B 'G 'R 'W 'W,
'Cube 'R 'R 'W 'G 'B 'R, 'Cube 'W 'G 'R 'W 'G 'B],
'['Cube 'G 'B 'B 'W 'R 'G, 'Cube 'W 'R 'G 'B 'W 'R,
'Cube 'R 'G 'W 'R 'B 'R, 'Cube 'B 'W 'R 'G 'G 'W],
'['Cube 'G 'B 'B 'R 'W 'G, 'Cube 'R 'G 'R 'W 'B 'W,
'Cube 'R 'W 'G 'B 'R 'R, 'Cube 'W 'R 'W 'G 'G 'B]]))
arising from a use of ‘print’
In the expression: print (Proxy :: Proxy (Solutions Cubes))
In an equation for ‘main’:
main = print (Proxy :: Proxy (Solutions Cubes))
testsuite/tests/perf/compiler/all.T
View file @
fca85c9b
...
...
@@ 545,3 +545,23 @@ test('T9675',
],
compile
,
[''])
test
('
T9872a
',
[
only_ways
(['
normal
']),
compiler_stats_num_field
('
bytes allocated
',
[(
wordsize
(
64
),
5521332656
,
5
)
# 20141210 5521332656 Initally created
]),
],
compile_fail
,
[''])
test
('
T9872b
',
[
only_ways
(['
normal
']),
compiler_stats_num_field
('
bytes allocated
',
[(
wordsize
(
64
),
6483306280
,
5
)
# 20141210 6483306280 Initally created
]),
],
compile_fail
,
[''])
Simon Peyton Jones
@simonpj
mentioned in issue
#9872 (closed)
·
Dec 08, 2014
mentioned in issue
#9872 (closed)
mentioned in issue #9872
Toggle commit list
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