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
Shayne Fletcher
Glasgow Haskell Compiler
Commits
3671d002
Commit
3671d002
authored
Apr 03, 2014
by
Simon Peyton Jones
Browse files
Fix desguaring of bang patterns (Trac #8952)
A palpable bug, although one that will rarely bite
parent
791f4fa2
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/deSugar/Match.lhs
View file @
3671d002
...
...
@@ -586,8 +586,6 @@ tidy1 _ non_interesting_pat
--------------------
tidy_bang_pat :: Id -> SrcSpan -> Pat Id -> DsM (DsWrapper, Pat Id)
-- BangPatterns: Pattern matching is already strict in constructors,
-- tuples etc, so the last case strips off the bang for those patterns.
-- Discard bang around strict pattern
tidy_bang_pat v _ p@(ListPat {}) = tidy1 v p
...
...
@@ -596,8 +594,7 @@ tidy_bang_pat v _ p@(PArrPat {}) = tidy1 v p
tidy_bang_pat v _ p@(ConPatOut {}) = tidy1 v p
tidy_bang_pat v _ p@(LitPat {}) = tidy1 v p
-- Discard lazy/par/sig under a bang
tidy_bang_pat v _ (LazyPat (L l p)) = tidy_bang_pat v l p
-- Discard par/sig under a bang
tidy_bang_pat v _ (ParPat (L l p)) = tidy_bang_pat v l p
tidy_bang_pat v _ (SigPatOut (L l p) _) = tidy_bang_pat v l p
...
...
@@ -607,7 +604,10 @@ tidy_bang_pat v l (AsPat v' p) = tidy1 v (AsPat v' (L l (BangPat p)))
tidy_bang_pat v l (CoPat w p t) = tidy1 v (CoPat w (BangPat (L l p)) t)
-- Default case, leave the bang there:
-- VarPat, WildPat, ViewPat, NPat, NPlusKPat
-- VarPat, LazyPat, WildPat, ViewPat, NPat, NPlusKPat
-- For LazyPat, remember that it's semantically like a VarPat
-- i.e. !(~p) is not like ~p, or p! (Trac #8952)
tidy_bang_pat _ l p = return (idDsWrapper, BangPat (L l p))
-- NB: SigPatIn, ConPatIn should not happen
\end{code}
...
...
testsuite/tests/deSugar/should_run/T8952.hs
0 → 100644
View file @
3671d002
{-# LANGUAGE BangPatterns #-}
module
Main
where
main
=
print
(
case
Nothing
of
!
(
~
(
Just
x
))
->
"ok"
Nothing
->
"bad"
)
testsuite/tests/deSugar/should_run/T8952.stdout
0 → 100644
View file @
3671d002
"ok"
testsuite/tests/deSugar/should_run/all.T
View file @
3671d002
...
...
@@ -40,3 +40,4 @@ test('mc08', normal, compile_and_run, [''])
test
('
T5742
',
normal
,
compile_and_run
,
[''])
test
('
DsLambdaCase
',
when
(
compiler_lt
('
ghc
',
'
7.5
'),
skip
),
compile_and_run
,
[''])
test
('
DsMultiWayIf
',
when
(
compiler_lt
('
ghc
',
'
7.5
'),
skip
),
compile_and_run
,
[''])
test
('
T8952
',
normal
,
compile_and_run
,
[''])
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