Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
jberryman
GHC
Commits
110bf0e9
Commit
110bf0e9
authored
Oct 10, 2010
by
reinerp
Browse files
Template Haskell: add view patterns (Trac #2399)
parent
b10d7d07
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/deSugar/DsMeta.hs
View file @
110bf0e9
...
...
@@ -1038,6 +1038,7 @@ repP (ConPatIn dc details)
repPinfix
p1'
con_str
p2'
}
}
repP
(
NPat
l
Nothing
_
)
=
do
{
a
<-
repOverloadedLiteral
l
;
repPlit
a
}
repP
(
ViewPat
e
p
_
)
=
do
{
e'
<-
repLE
e
;
p'
<-
repLP
p
;
repPview
e'
p'
}
repP
p
@
(
NPat
_
(
Just
_
)
_
)
=
notHandled
"Negative overloaded patterns"
(
ppr
p
)
repP
p
@
(
SigPatIn
{})
=
notHandled
"Type signatures in patterns"
(
ppr
p
)
-- The problem is to do with scoped type variables.
...
...
@@ -1270,6 +1271,9 @@ repPwild = rep2 wildPName []
repPlist
::
Core
[
TH
.
PatQ
]
->
DsM
(
Core
TH
.
PatQ
)
repPlist
(
MkC
ps
)
=
rep2
listPName
[
ps
]
repPview
::
Core
TH
.
ExpQ
->
Core
TH
.
PatQ
->
DsM
(
Core
TH
.
PatQ
)
repPview
(
MkC
e
)
(
MkC
p
)
=
rep2
viewPName
[
e
,
p
]
--------------- Expressions -----------------
repVarOrCon
::
Name
->
Core
TH
.
Name
->
DsM
(
Core
TH
.
ExpQ
)
repVarOrCon
vc
str
|
isDataOcc
(
nameOccName
vc
)
=
repCon
str
...
...
@@ -1665,7 +1669,7 @@ templateHaskellNames = [
floatPrimLName
,
doublePrimLName
,
rationalLName
,
-- Pat
litPName
,
varPName
,
tupPName
,
conPName
,
tildePName
,
bangPName
,
infixPName
,
asPName
,
wildPName
,
recPName
,
listPName
,
sigPName
,
asPName
,
wildPName
,
recPName
,
listPName
,
sigPName
,
viewPName
,
-- FieldPat
fieldPatName
,
-- Match
...
...
@@ -1802,7 +1806,7 @@ rationalLName = libFun (fsLit "rationalL") rationalLIdKey
-- data Pat = ...
litPName
,
varPName
,
tupPName
,
conPName
,
infixPName
,
tildePName
,
bangPName
,
asPName
,
wildPName
,
recPName
,
listPName
,
sigPName
::
Name
asPName
,
wildPName
,
recPName
,
listPName
,
sigPName
,
viewPName
::
Name
litPName
=
libFun
(
fsLit
"litP"
)
litPIdKey
varPName
=
libFun
(
fsLit
"varP"
)
varPIdKey
tupPName
=
libFun
(
fsLit
"tupP"
)
tupPIdKey
...
...
@@ -1815,6 +1819,7 @@ wildPName = libFun (fsLit "wildP") wildPIdKey
recPName
=
libFun
(
fsLit
"recP"
)
recPIdKey
listPName
=
libFun
(
fsLit
"listP"
)
listPIdKey
sigPName
=
libFun
(
fsLit
"sigP"
)
sigPIdKey
viewPName
=
libFun
(
fsLit
"viewP"
)
viewPIdKey
-- type FieldPat = ...
fieldPatName
::
Name
...
...
@@ -2080,7 +2085,7 @@ liftStringIdKey = mkPreludeMiscIdUnique 218
-- data Pat = ...
litPIdKey
,
varPIdKey
,
tupPIdKey
,
conPIdKey
,
infixPIdKey
,
tildePIdKey
,
bangPIdKey
,
asPIdKey
,
wildPIdKey
,
recPIdKey
,
listPIdKey
,
sigPIdKey
::
Unique
asPIdKey
,
wildPIdKey
,
recPIdKey
,
listPIdKey
,
sigPIdKey
,
viewPIdKey
::
Unique
litPIdKey
=
mkPreludeMiscIdUnique
220
varPIdKey
=
mkPreludeMiscIdUnique
221
tupPIdKey
=
mkPreludeMiscIdUnique
222
...
...
@@ -2093,6 +2098,7 @@ wildPIdKey = mkPreludeMiscIdUnique 226
recPIdKey
=
mkPreludeMiscIdUnique
227
listPIdKey
=
mkPreludeMiscIdUnique
228
sigPIdKey
=
mkPreludeMiscIdUnique
229
viewPIdKey
=
mkPreludeMiscIdUnique
360
-- type FieldPat = ...
fieldPatIdKey
::
Unique
...
...
compiler/hsSyn/Convert.lhs
View file @
110bf0e9
...
...
@@ -637,6 +637,7 @@ cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) }
cvtp (ListP ps) = do { ps' <- cvtPats ps; return $ ListPat ps' void }
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t; return $ SigPatIn p' t' }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p; return $ ViewPat e' p' void }
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (HsRecField RdrName (LPat RdrName))
cvtPatFld (s,p)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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