Skip to content

Commit

Permalink
Parse TH-quoted list constructor: '[]
Browse files Browse the repository at this point in the history 
Teach the parser to parse the empty list constructor ([])
quoted using Template Haskell's data constructor quotation
syntax (' prefix) within expressions:

    '[]

This syntax is accepted by at least GHC 8.4.3.
  • Loading branch information
@strager @mpickering
strager authored and mpickering committed Dec 7, 2018
1 parent 3f6c154 commit 99876aa
Show file tree
Hide file tree
Showing 7 changed files with 262 additions and 2 deletions.
3 changes: 3 additions & 0 deletions src/Language/Haskell/Exts/InternalParser.ly
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1542,6 +1542,9 @@ Template Haskell - all this is enabled in the lexer.
> | VARQUOTE '(' ')' { let {l1 = $1 <^^> $3 <** [$1];
> l2 = $2 <^^> $3 <** [$2,$3];}
> in VarQuote l1 (unit_con_name l2) }
> | VARQUOTE '[' ']' { let {l1 = $1 <^^> $3 <** [$1];
> l2 = $2 <^^> $3 <** [$2,$3];}
> in VarQuote l1 (list_con_name l2) }
> | VARQUOTE qvar { VarQuote (nIS $1 <++> ann $2 <** [$1]) $2 }
> | VARQUOTE qcon { VarQuote (nIS $1 <++> ann $2 <** [$1]) $2 }
> | TYPQUOTE tyvar { TypQuote (nIS $1 <++> ann $2 <** [$1]) (UnQual (ann $2) $2) }
Expand Down
7 changes: 5 additions & 2 deletions src/Language/Haskell/Exts/Syntax.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ module Language.Haskell.Exts.Syntax (
-- ** Main function of a program
main_name,
-- ** Constructors
unit_con_name, tuple_con_name, list_cons_name, unboxed_singleton_con_name,
unit_con_name, tuple_con_name, list_con_name, list_cons_name, unboxed_singleton_con_name,
unit_con, tuple_con, unboxed_singleton_con,
-- ** Special identifiers
as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name,
Expand Down Expand Up @@ -134,7 +134,7 @@ data ModuleName l = ModuleName l String
-- data constructors.
data SpecialCon l
= UnitCon l -- ^ unit type and data constructor @()@
| ListCon l -- ^ list type constructor @[]@
| ListCon l -- ^ list type and data constructor @[]@
| FunCon l -- ^ function type constructor @->@
| TupleCon l Boxed Int -- ^ /n/-ary tuple type and data
-- constructors @(,)@ etc, possibly boxed @(\#,\#)@
Expand Down Expand Up @@ -1019,6 +1019,9 @@ unit_con_name l = Special l (UnitCon l)
tuple_con_name :: l -> Boxed -> Int -> QName l
tuple_con_name l b i = Special l (TupleCon l b (i+1))

list_con_name :: l -> QName l
list_con_name l = Special l (ListCon l)

list_cons_name :: l -> QName l
list_cons_name l = Special l (Cons l)

Expand Down
3 changes: 3 additions & 0 deletions tests/examples/TemplateHaskellQuotedNames.hs
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
{-# LANGUAGE TemplateHaskell #-}
f = g 'Constructor 'function
h = g '() '[]
1 change: 1 addition & 0 deletions tests/examples/TemplateHaskellQuotedNames.hs.exactprinter.golden
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Match
246 changes: 246 additions & 0 deletions tests/examples/TemplateHaskellQuotedNames.hs.parser.golden
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,246 @@
ParseOk
( Module
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 1 4 1
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 1 1 1
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 1
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 1
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 1
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 1 3 1
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 4 1 4 1
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 4 1 4 1
]
}
Nothing
[ LanguagePragma
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 1 1 33
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 1 1 13
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 30 1 33
]
}
[ Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 14 1 29
, srcInfoPoints = []
}
"TemplateHaskell"
]
]
[]
[ PatBind
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 29
, srcInfoPoints = []
}
(PVar
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 2
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 2
, srcInfoPoints = []
}
"f"))
(UnGuardedRhs
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 3 2 29
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 3 2 4 ]
}
(App
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 29
, srcInfoPoints = []
}
(App
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 19
, srcInfoPoints = []
}
(Var
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 6
, srcInfoPoints = []
}
(UnQual
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 6
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 6
, srcInfoPoints = []
}
"g")))
(VarQuote
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 7 2 19
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 7 2 8 ]
}
(UnQual
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 8 2 19
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 8 2 19
, srcInfoPoints = []
}
"Constructor"))))
(VarQuote
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 20 2 29
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 20 2 21
]
}
(UnQual
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 21 2 29
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 21 2 29
, srcInfoPoints = []
}
"function")))))
Nothing
, PatBind
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 1 3 14
, srcInfoPoints = []
}
(PVar
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 1 3 2
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 1 3 2
, srcInfoPoints = []
}
"h"))
(UnGuardedRhs
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 3 3 14
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 3 3 4 ]
}
(App
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 14
, srcInfoPoints = []
}
(App
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 10
, srcInfoPoints = []
}
(Var
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 6
, srcInfoPoints = []
}
(UnQual
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 6
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 6
, srcInfoPoints = []
}
"g")))
(VarQuote
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 7 3 10
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 7 3 8 ]
}
(Special
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 8 3 10
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 8 3 9
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 9 3 10
]
}
(UnitCon
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 8 3 10
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 8 3 9
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 9 3 10
]
}))))
(VarQuote
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 11 3 14
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 11 3 12
]
}
(Special
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 12 3 14
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 12 3 13
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 13 3 14
]
}
(ListCon
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 12 3 14
, srcInfoPoints =
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 12 3 13
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 13 3 14
]
})))))
Nothing
]
, []
)
1 change: 1 addition & 0 deletions tests/examples/TemplateHaskellQuotedNames.hs.prettyparser.golden
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Match
3 changes: 3 additions & 0 deletions tests/examples/TemplateHaskellQuotedNames.hs.prettyprinter.golden
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
{-# LANGUAGE TemplateHaskell #-}
f = g 'Constructor 'function
h = g '() '[]

0 comments on commit 99876aa

Please sign in to comment.