[GHC] #9732: Pattern synonyms and unboxed values
GHC
ghc-devs at haskell.org
Thu Oct 30 12:01:30 UTC 2014
#9732: Pattern synonyms and unboxed values
-------------------------------------+-------------------------------------
Reporter: monoidal | Owner: cactus
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.8.3
Resolution: | Keywords:
Operating System: | Architecture: Unknown/Multiple
Unknown/Multiple | Difficulty: Unknown
Type of failure: Compile- | Blocked By:
time crash | Related Tickets:
Test Case: |
Blocking: |
Differential Revisions: |
-------------------------------------+-------------------------------------
Comment (by cactus):
As for the unidirectional case, I was accidentally looking at the
simplified output instead of just the desugared one. So with this code:
{{{
{-# LANGUAGE PatternSynonyms, MagicHash #-}
pattern PAT <- 0#
f PAT = 42#
}}}
the Core generated for `f` is:
{{{
Main.f :: GHC.Prim.Int# -> GHC.Prim.Int#
[LclIdX, Str=DmdType]
Main.f =
\ (ds_dpR :: GHC.Prim.Int#) ->
break<2>()
case (\ _ [Occ=Dead, OS=OneShot] ->
Control.Exception.Base.patError
@ GHC.Prim.Int# "T9732.hs:7:1-11|function f"#)
GHC.Prim.void#
of wild_00 { __DEFAULT ->
(case break<1>() 42 of wild_X4 { __DEFAULT ->
Main.$mPAT @ GHC.Prim.Int# ds_dpR wild_X4
})
wild_00
}
}}}
which is close enough: it would be correct if only `wild_00` wasn't
floated out...
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/9732#comment:9>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list