Commit 7f929862 authored by cactus's avatar cactus

If pattern synonym is bidirectional and its type is some unboxed type T#,

generate a worker function of type Void# -> T#, and redirect the wrapper
(via a compulsory unfolding) to the worker. Fixes #9732.
parent 745c4c0e
......@@ -14,7 +14,8 @@ module PatSyn (
-- ** Type deconstruction
patSynName, patSynArity, patSynIsInfix,
patSynArgs, patSynTyDetails, patSynType,
patSynWrapper, patSynMatcher,
patSynMatcher,
patSynWrapper, patSynWorker,
patSynExTyVars, patSynSig,
patSynInstArgTys, patSynInstResTy,
tidyPatSynIds
......@@ -36,6 +37,7 @@ import HsBinds( HsPatSynDetails(..) )
import qualified Data.Data as Data
import qualified Data.Typeable
import Data.Function
import Control.Arrow (second)
\end{code}
......@@ -109,6 +111,37 @@ Injectivity of bidirectional pattern synonyms is checked in
tcPatToExpr which walks the pattern and returns its corresponding
expression when available.
Note [Wrapper/worker for pattern synonyms with unboxed type]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For bidirectional pattern synonyms that have no arguments and have
an unboxed type, we add an extra level of indirection, since $WP would
otherwise be a top-level declaration with an unboxed type. In this case,
a separate worker function is generated that has an extra Void# argument,
and the wrapper redirects to it via a compulsory unfolding (that just
applies it on Void#). Example:
pattern P = 0#
$WP :: Int#
$WP unfolded to ($wP Void#)
$wP :: Void# -> Int#
$wP _ = 0#
To make things more uniform, we always store two `Id`s in `PatSyn` for
the wrapper and the worker, with the following behaviour:
if `psWrapper` == Just (`wrapper`, `worker`), then
* `wrapper` should always be used when compiling the pattern synonym
in an expression context (and its type is as prescribed)
* `worker` is always an `Id` with a binding that needs to be exported
as part of the definition of the pattern synonym
If a separate worker is not needed (because the pattern synonym has arguments
or has a non-unboxed type), the two `Id`s are the same.
%************************************************************************
%* *
\subsection{Pattern synonyms}
......@@ -149,12 +182,14 @@ data PatSyn
-- -> (Void# -> r)
-- -> r
psWrapper :: Maybe Id
psWrapper :: Maybe (Id, Id)
-- Nothing => uni-directional pattern synonym
-- Just wid => bi-direcitonal
-- Just (wrapper, worker) => bi-direcitonal
-- Wrapper function, of type
-- forall univ_tvs, ex_tvs. (prov_theta, req_theta)
-- => arg_tys -> res_ty
--
-- See Note [Wrapper/worker for pattern synonyms with unboxed type]
}
deriving Data.Typeable.Typeable
\end{code}
......@@ -215,7 +250,7 @@ mkPatSyn :: Name
-> [Type] -- ^ Original arguments
-> Type -- ^ Original result type
-> Id -- ^ Name of matcher
-> Maybe Id -- ^ Name of wrapper
-> Maybe (Id, Id) -- ^ Name of wrapper/worker
-> PatSyn
mkPatSyn name declared_infix
(univ_tvs, req_theta)
......@@ -276,14 +311,17 @@ patSynSig (MkPatSyn { psUnivTyVars = univ_tvs, psExTyVars = ex_tvs
= (univ_tvs, ex_tvs, prov, req, arg_tys, res_ty)
patSynWrapper :: PatSyn -> Maybe Id
patSynWrapper = psWrapper
patSynWrapper = fmap fst . psWrapper
patSynWorker :: PatSyn -> Maybe Id
patSynWorker = fmap snd . psWrapper
patSynMatcher :: PatSyn -> Id
patSynMatcher = psMatcher
tidyPatSynIds :: (Id -> Id) -> PatSyn -> PatSyn
tidyPatSynIds tidy_fn ps@(MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id })
= ps { psMatcher = tidy_fn match_id, psWrapper = fmap tidy_fn mb_wrap_id }
= ps { psMatcher = tidy_fn match_id, psWrapper = fmap (second tidy_fn) mb_wrap_id }
patSynInstArgTys :: PatSyn -> [Type] -> [Type]
-- Return the types of the argument patterns
......
......@@ -574,6 +574,7 @@ compiler_stage2_dll0_MODULES = \
StringBuffer \
TcEvidence \
TcIface \
TcMType \
TcRnMonad \
TcRnTypes \
TcType \
......
......@@ -179,7 +179,7 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
------------------------------------------------------
buildPatSyn :: Name -> Bool
-> Id -> Maybe Id
-> Id -> Maybe (Id, Id)
-> ([TyVar], ThetaType) -- ^ Univ and req
-> ([TyVar], ThetaType) -- ^ Ex and prov
-> [Type] -- ^ Argument types
......
......@@ -128,7 +128,7 @@ data IfaceDecl
| IfacePatSyn { ifName :: IfaceTopBndr, -- Name of the pattern synonym
ifPatIsInfix :: Bool,
ifPatMatcher :: IfExtName,
ifPatWrapper :: Maybe IfExtName,
ifPatWorker :: Maybe IfExtName,
-- Everything below is redundant,
-- but needed to implement pprIfaceDecl
ifPatUnivTvs :: [IfaceTvBndr],
......@@ -759,15 +759,15 @@ pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars
$$ ppShowIface ss (ptext (sLit "axiom") <+> ppr ax)
pp_branches _ = Outputable.empty
pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWrapper = wrapper,
pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWorker = worker,
ifPatIsInfix = is_infix,
ifPatUnivTvs = _univ_tvs, ifPatExTvs = _ex_tvs,
ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
ifPatArgs = args,
ifPatTy = ty })
= pprPatSynSig name has_wrap args' ty' (pprCtxt prov_ctxt) (pprCtxt req_ctxt)
= pprPatSynSig name is_bidirectional args' ty' (pprCtxt prov_ctxt) (pprCtxt req_ctxt)
where
has_wrap = isJust wrapper
is_bidirectional = isJust worker
args' = case (is_infix, args) of
(True, [left_ty, right_ty]) ->
InfixPatSyn (pprParendIfaceType left_ty) (pprParendIfaceType right_ty)
......@@ -1131,7 +1131,7 @@ freeNamesIfDecl d@IfaceAxiom{} =
fnList freeNamesIfAxBranch (ifAxBranches d)
freeNamesIfDecl d@IfacePatSyn{} =
unitNameSet (ifPatMatcher d) &&&
maybe emptyNameSet unitNameSet (ifPatWrapper d) &&&
maybe emptyNameSet unitNameSet (ifPatWorker d) &&&
freeNamesIfTvBndrs (ifPatUnivTvs d) &&&
freeNamesIfTvBndrs (ifPatExTvs d) &&&
freeNamesIfContext (ifPatProvCtxt d) &&&
......
......@@ -1534,7 +1534,7 @@ patSynToIfaceDecl :: PatSyn -> IfaceDecl
patSynToIfaceDecl ps
= IfacePatSyn { ifName = getOccName . getName $ ps
, ifPatMatcher = matcher
, ifPatWrapper = wrapper
, ifPatWorker = worker
, ifPatIsInfix = patSynIsInfix ps
, ifPatUnivTvs = toIfaceTvBndrs univ_tvs'
, ifPatExTvs = toIfaceTvBndrs ex_tvs'
......@@ -1549,7 +1549,7 @@ patSynToIfaceDecl ps
(env2, ex_tvs') = tidyTyVarBndrs env1 ex_tvs
matcher = idName (patSynMatcher ps)
wrapper = fmap idName (patSynWrapper ps)
worker = fmap idName (patSynWorker ps)
--------------------------
......
......@@ -14,7 +14,8 @@ module TcIface (
tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
tcIfaceVectInfo, tcIfaceAnnotations,
tcIfaceExpr, -- Desired by HERMIT (Trac #7683)
tcIfaceGlobal
tcIfaceGlobal,
mkPatSynWrapperId, mkPatSynWorkerId -- Have to be here to avoid circular import
) where
#include "HsVersions.h"
......@@ -27,7 +28,8 @@ import BuildTyCl
import TcRnMonad
import TcType
import Type
import Coercion
import TcMType
import Coercion hiding (substTy)
import TypeRep
import HscTypes
import Annotations
......@@ -37,7 +39,7 @@ import CoreSyn
import CoreUtils
import CoreUnfold
import CoreLint
import MkCore ( castBottomExpr )
import MkCore
import Id
import MkId
import IdInfo
......@@ -75,6 +77,7 @@ import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 709
import Data.Traversable ( traverse )
#endif
import Data.Traversable ( for )
\end{code}
This module takes
......@@ -582,7 +585,7 @@ tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
, ifPatMatcher = matcher_name
, ifPatWrapper = wrapper_name
, ifPatWorker = worker_name
, ifPatIsInfix = is_infix
, ifPatUnivTvs = univ_tvs
, ifPatExTvs = ex_tvs
......@@ -593,10 +596,7 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
= do { name <- lookupIfaceTop occ_name
; traceIf (ptext (sLit "tc_iface_decl") <+> ppr name)
; matcher <- tcExt "Matcher" matcher_name
; wrapper <- case wrapper_name of
Nothing -> return Nothing
Just wn -> do { wid <- tcExt "Wrapper" wn
; return (Just wid) }
; worker <- traverse (tcExt "Worker") worker_name
; bindIfaceTyVars univ_tvs $ \univ_tvs -> do
{ bindIfaceTyVars ex_tvs $ \ex_tvs -> do
{ patsyn <- forkM (mk_doc name) $
......@@ -604,6 +604,14 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
; req_theta <- tcIfaceCtxt req_ctxt
; pat_ty <- tcIfaceType pat_ty
; arg_tys <- mapM tcIfaceType args
; wrapper <- for worker $ \worker_id -> do
{ wrapper_id <- mkPatSynWrapperId (noLoc name)
(univ_tvs ++ ex_tvs)
(req_theta ++ prov_theta)
arg_tys pat_ty
worker_id
; return (wrapper_id, worker_id)
}
; return $ buildPatSyn name is_infix matcher wrapper
(univ_tvs, req_theta) (ex_tvs, prov_theta)
arg_tys pat_ty }
......@@ -1520,3 +1528,41 @@ bindIfaceTyVars_AT (b@(tv_occ,_) : bs) thing_inside
bindIfaceTyVars_AT bs $ \bs' ->
thing_inside (b':bs') }
\end{code}
%************************************************************************
%* *
PatSyn wrapper/worker helpers
%* *
%************************************************************************
\begin{code}
-- These are here (and not in TcPatSyn) just to avoid circular imports.
mkPatSynWrapperId :: Located Name
-> [TyVar] -> ThetaType -> [Type] -> Type
-> Id
-> TcRnIf gbl lcl Id
mkPatSynWrapperId name qtvs theta arg_tys pat_ty worker_id
| need_dummy_arg = do
{ wrapper_id <- mkPatSynWorkerId name mkDataConWrapperOcc qtvs theta arg_tys pat_ty
; let unfolding = mkCoreApp (Var worker_id) (Var voidPrimId)
wrapper_id' = setIdUnfolding wrapper_id $ mkCompulsoryUnfolding unfolding
; return wrapper_id' }
| otherwise = return worker_id -- No indirection needed
where
need_dummy_arg = null arg_tys && isUnLiftedType pat_ty
mkPatSynWorkerId :: Located Name -> (OccName -> OccName)
-> [TyVar] -> ThetaType -> [Type] -> Type
-> TcRnIf gbl loc Id
mkPatSynWorkerId (L loc name) mk_occ_name qtvs theta arg_tys pat_ty
= do { worker_name <- newImplicitBinder name mk_occ_name
; (subst, worker_tvs) <- tcInstSigTyVarsLoc loc qtvs
; let worker_theta = substTheta subst theta
pat_ty' = substTy subst pat_ty
arg_tys' = map (substTy subst) arg_tys
worker_tau = mkFunTys arg_tys' pat_ty'
-- TODO: just substitute worker_sigma...
worker_sigma = mkSigmaTy worker_tvs worker_theta worker_tau
; return $ mkVanillaGlobal worker_name worker_sigma }
\end{code}
......@@ -16,7 +16,7 @@ module TcBinds ( tcLocalBinds, tcTopBinds, tcRecSelBinds,
import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun )
import {-# SOURCE #-} TcExpr ( tcMonoExpr )
import {-# SOURCE #-} TcPatSyn ( tcPatSynDecl, tcPatSynWrapper )
import {-# SOURCE #-} TcPatSyn ( tcPatSynDecl, tcPatSynWorker )
import DynFlags
import HsSyn
......@@ -320,8 +320,8 @@ tcValBinds top_lvl binds sigs thing_inside
{ (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do
{ thing <- thing_inside
-- See Note [Pattern synonym wrappers don't yield dependencies]
; patsyn_wrappers <- mapM tcPatSynWrapper patsyns
; let extra_binds = [ (NonRecursive, wrapper) | wrapper <- patsyn_wrappers ]
; patsyn_workers <- mapM tcPatSynWorker patsyns
; let extra_binds = [ (NonRecursive, worker) | worker <- patsyn_workers ]
; return (extra_binds, thing) }
; return (binds' ++ extra_binds', thing) }}
where
......@@ -424,7 +424,7 @@ tc_single _top_lvl _sig_fn _prag_fn (L _ (PatSynBind psb)) thing_inside
; let tything = AConLike (PatSynCon pat_syn)
implicit_ids = (patSynMatcher pat_syn) :
(maybeToList (patSynWrapper pat_syn))
(maybeToList (patSynWorker pat_syn))
; thing <- tcExtendGlobalEnv [tything] $
tcExtendGlobalEnvImplicit (map AnId implicit_ids) $
......
......@@ -7,13 +7,14 @@
\begin{code}
{-# LANGUAGE CPP #-}
module TcPatSyn (tcPatSynDecl, tcPatSynWrapper) where
module TcPatSyn (tcPatSynDecl, mkPatSynWrapperId, tcPatSynWorker) where
import HsSyn
import TcPat
import TcRnMonad
import TcEnv
import TcMType
import TcIface
import TysPrim
import Name
import SrcLoc
......@@ -37,6 +38,7 @@ import Bag
import TcEvidence
import BuildTyCl
import TypeRep
import Data.Maybe
#include "HsVersions.h"
\end{code}
......@@ -48,7 +50,6 @@ tcPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
psb_def = lpat, psb_dir = dir }
= do { traceTc "tcPatSynDecl {" $ ppr name $$ ppr lpat
; tcCheckPatSynPat lpat
;
; let (arg_names, is_infix) = case details of
PrefixPatSyn names -> (map unLoc names, False)
......@@ -78,6 +79,7 @@ tcPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
; req_theta <- zonkTcThetaType req_theta
; pat_ty <- zonkTcType pat_ty
; args <- mapM zonkId args
; let arg_tys = map varType args
; traceTc "tcPatSynDecl: ex" (ppr ex_tvs $$
ppr prov_theta $$
......@@ -87,7 +89,8 @@ tcPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
ppr req_dicts $$
ppr ev_binds)
; let theta = prov_theta ++ req_theta
; let qtvs = univ_tvs ++ ex_tvs
; let theta = req_theta ++ prov_theta
; traceTc "tcPatSynDecl: type" (ppr name $$
ppr univ_tvs $$
......@@ -101,17 +104,19 @@ tcPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
prov_theta req_theta
pat_ty
; wrapper_id <- if isBidirectional dir
then fmap Just $ mkPatSynWrapperId lname args univ_tvs ex_tvs theta pat_ty
else return Nothing
; wrapper_ids <- if isBidirectional dir
then fmap Just $ mkPatSynWrapperIds lname
qtvs theta
arg_tys pat_ty
else return Nothing
; traceTc "tcPatSynDecl }" $ ppr name
; let patSyn = mkPatSyn name is_infix
(univ_tvs, req_theta)
(ex_tvs, prov_theta)
(map varType args)
arg_tys
pat_ty
matcher_id wrapper_id
matcher_id wrapper_ids
; return (patSyn, matcher_bind) }
\end{code}
......@@ -201,73 +206,69 @@ isBidirectional Unidirectional = False
isBidirectional ImplicitBidirectional = True
isBidirectional ExplicitBidirectional{} = True
tcPatSynWrapper :: PatSynBind Name Name
tcPatSynWorker :: PatSynBind Name Name
-> TcM (LHsBinds Id)
-- See Note [Matchers and wrappers for pattern synonyms] in PatSyn
tcPatSynWrapper PSB{ psb_id = L loc name, psb_def = lpat, psb_dir = dir, psb_args = details }
tcPatSynWorker PSB{ psb_id = lname, psb_def = lpat, psb_dir = dir, psb_args = details }
= case dir of
Unidirectional -> return emptyBag
ImplicitBidirectional ->
do { wrapper_id <- tcLookupPatSynWrapper name
; lexpr <- case tcPatToExpr (mkNameSet args) lpat of
do { lexpr <- case tcPatToExpr (mkNameSet args) lpat of
Nothing -> cannotInvertPatSynErr lpat
Just lexpr -> return lexpr
; let wrapper_args = map (noLoc . VarPat) args
wrapper_lname = L (getLoc lpat) (idName wrapper_id)
wrapper_match = mkMatch wrapper_args lexpr EmptyLocalBinds
wrapper_bind = mkTopFunBind Generated wrapper_lname [wrapper_match]
; mkPatSynWrapper wrapper_id wrapper_bind }
ExplicitBidirectional mg ->
do { wrapper_id <- tcLookupPatSynWrapper name
; mkPatSynWrapper wrapper_id $
FunBind{ fun_id = L loc (idName wrapper_id)
, fun_infix = False
, fun_matches = mg
, fun_co_fn = idHsWrapper
, bind_fvs = placeHolderNamesTc
, fun_tick = Nothing }}
; mkPatSynWorker lname $ mkMatchGroupName Generated [wrapper_match] }
ExplicitBidirectional mg -> mkPatSynWorker lname mg
where
args = map unLoc $ case details of
PrefixPatSyn args -> args
InfixPatSyn arg1 arg2 -> [arg1, arg2]
tcLookupPatSynWrapper name
= do { patsyn <- tcLookupPatSyn name
; case patSynWrapper patsyn of
Nothing -> panic "tcLookupPatSynWrapper"
Just wrapper_id -> return wrapper_id }
mkPatSynWrapperId :: Located Name
-> [Var] -> [TyVar] -> [TyVar] -> ThetaType -> Type
-> TcM Id
mkPatSynWrapperId (L _ name) args univ_tvs ex_tvs theta pat_ty
= do { let qtvs = univ_tvs ++ ex_tvs
; (subst, wrapper_tvs) <- tcInstSkolTyVars qtvs
; let wrapper_theta = substTheta subst theta
pat_ty' = substTy subst pat_ty
args' = map (\arg -> setVarType arg $ substTy subst (varType arg)) args
wrapper_tau = mkFunTys (map varType args') pat_ty'
wrapper_sigma = mkSigmaTy wrapper_tvs wrapper_theta wrapper_tau
; wrapper_name <- newImplicitBinder name mkDataConWrapperOcc
; return $ mkVanillaGlobal wrapper_name wrapper_sigma }
mkPatSynWrapper :: Id
-> HsBind Name
mkPatSynWrapperIds :: Located Name
-> [TyVar] -> ThetaType -> [Type] -> Type
-> TcM (Id, Id)
mkPatSynWrapperIds lname qtvs theta arg_tys pat_ty
= do { worker_id <- mkPatSynWorkerId lname mkDataConWorkerOcc qtvs theta worker_arg_tys pat_ty
; wrapper_id <- mkPatSynWrapperId lname qtvs theta arg_tys pat_ty worker_id
; return (wrapper_id, worker_id) }
where
worker_arg_tys | need_dummy_arg = [voidPrimTy]
| otherwise = arg_tys
need_dummy_arg = null arg_tys && isUnLiftedType pat_ty
mkPatSynWorker :: Located Name
-> MatchGroup Name (LHsExpr Name)
-> TcM (LHsBinds Id)
mkPatSynWrapper wrapper_id bind
= do { (wrapper_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig (noLoc bind)
; traceTc "tcPatSynDecl wrapper" $ ppr wrapper_binds
; traceTc "tcPatSynDecl wrapper type" $ ppr (varType wrapper_id)
; return wrapper_binds }
mkPatSynWorker (L loc name) mg
= do { patsyn <- tcLookupPatSyn name
; let worker_id = fromMaybe (panic "mkPatSynWrapper") $
patSynWorker patsyn
need_dummy_arg = null (patSynArgs patsyn) && isUnLiftedType (patSynType patsyn)
; let match_dummy = mkMatch [nlWildPatName] (noLoc $ HsLam mg) emptyLocalBinds
mg' | need_dummy_arg = mkMatchGroupName Generated [match_dummy]
| otherwise = mg
; let (worker_tvs, worker_theta, worker_tau) = tcSplitSigmaTy (idType worker_id)
bind = FunBind { fun_id = L loc (idName worker_id)
, fun_infix = False
, fun_matches = mg'
, fun_co_fn = idHsWrapper
, bind_fvs = placeHolderNamesTc
, fun_tick = Nothing }
sig = TcSigInfo{ sig_id = worker_id
, sig_tvs = map (\tv -> (Nothing, tv)) worker_tvs
, sig_theta = worker_theta
, sig_tau = worker_tau
, sig_loc = noSrcSpan
}
; (worker_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig (noLoc bind)
; traceTc "tcPatSynDecl worker" $ ppr worker_binds
; return worker_binds }
where
sig = TcSigInfo{ sig_id = wrapper_id
, sig_tvs = map (\tv -> (Nothing, tv)) wrapper_tvs
, sig_theta = wrapper_theta
, sig_tau = wrapper_tau
, sig_loc = noSrcSpan
}
(wrapper_tvs, wrapper_theta, wrapper_tau) = tcSplitSigmaTy (idType wrapper_id)
\end{code}
......
......@@ -10,6 +10,6 @@ import PatSyn ( PatSyn )
tcPatSynDecl :: PatSynBind Name Name
-> TcM (PatSyn, LHsBinds Id)
tcPatSynWrapper :: PatSynBind Name Name
-> TcM (LHsBinds Id)
tcPatSynWorker :: PatSynBind Name Name
-> TcM (LHsBinds Id)
\end{code}
......@@ -1098,6 +1098,7 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk
/tests/patsyn/should_run/ex-prov-run
/tests/patsyn/should_run/match
/tests/patsyn/should_run/match-unboxed
/tests/patsyn/should_run/unboxed-wrapper
/tests/perf/compiler/T1969.comp.stats
/tests/perf/compiler/T3064.comp.stats
/tests/perf/compiler/T3294.comp.stats
......
{-# LANGUAGE PatternSynonyms, MagicHash #-}
module ShouldCompile where
pattern P = 0#
......@@ -11,3 +11,4 @@ test('export', normal, compile, [''])
test('T8966', normal, compile, [''])
test('T9023', normal, compile, [''])
test('unboxed-bind-bang', normal, compile, [''])
test('T9732', normal, compile, [''])
......@@ -8,3 +8,4 @@ test('T9161-2', normal, compile_fail, [''])
test('T9705-1', normal, compile_fail, [''])
test('T9705-2', normal, compile_fail, [''])
test('unboxed-bind', normal, compile_fail, [''])
test('unboxed-wrapper-naked', normal, compile_fail, [''])
{-# LANGUAGE PatternSynonyms, MagicHash #-}
module ShouldFail where
import GHC.Base
pattern P1 = 42#
x = P1
unboxed-wrapper-naked.hs:8:1:
Top-level bindings for unlifted types aren't allowed: x = P1
......@@ -4,3 +4,5 @@ test('ex-prov-run', normal, compile_and_run, [''])
test('bidir-explicit', normal, compile_and_run, [''])
test('bidir-explicit-scope', normal, compile_and_run, [''])
test('T9783', normal, compile_and_run, [''])
test('match-unboxed', normal, compile_and_run, [''])
test('unboxed-wrapper', normal, compile_and_run, [''])
{-# LANGUAGE PatternSynonyms, MagicHash #-}
module Main where
import GHC.Base
pattern P1 <- 0#
pattern P2 <- 1#
f :: Int# -> Int#
f P1 = 42#
f P2 = 44#
g :: Int# -> Int
g P1 = 42
g P2 = 44
main = do
print $ I# (f 0#)
print $ I# (f 1#)
print $ g 0#
print $ g 1#
{-# LANGUAGE PatternSynonyms, MagicHash #-}
module Main where
import GHC.Base
pattern P1 = 42#
main = do
print $ I# P1
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment