Skip to content

Commit ecd76f9

Browse files
stragermpickering
strager
authored and
mpickering
committed
Parse TH-quoted list constructor: '[]
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.
1 parent cc31887 commit ecd76f9

7 files changed

+262
-2
lines changed

‎src/Language/Haskell/Exts/InternalParser.ly

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1542,6 +1542,9 @@ Template Haskell - all this is enabled in the lexer.
15421542
> | VARQUOTE '(' ')' { let {l1 = $1 <^^> $3 <** [$1];
15431543
> l2 = $2 <^^> $3 <** [$2,$3];}
15441544
> in VarQuote l1 (unit_con_name l2) }
1545+
> | VARQUOTE '[' ']' { let {l1 = $1 <^^> $3 <** [$1];
1546+
> l2 = $2 <^^> $3 <** [$2,$3];}
1547+
> in VarQuote l1 (list_con_name l2) }
15451548
> | VARQUOTE qvar { VarQuote (nIS $1 <++> ann $2 <** [$1]) $2 }
15461549
> | VARQUOTE qcon { VarQuote (nIS $1 <++> ann $2 <** [$1]) $2 }
15471550
> | TYPQUOTE tyvar { TypQuote (nIS $1 <++> ann $2 <** [$1]) (UnQual (ann $2) $2) }

‎src/Language/Haskell/Exts/Syntax.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -97,7 +97,7 @@ module Language.Haskell.Exts.Syntax (
9797
-- ** Main function of a program
9898
main_name,
9999
-- ** Constructors
100-
unit_con_name, tuple_con_name, list_cons_name, unboxed_singleton_con_name,
100+
unit_con_name, tuple_con_name, list_con_name, list_cons_name, unboxed_singleton_con_name,
101101
unit_con, tuple_con, unboxed_singleton_con,
102102
-- ** Special identifiers
103103
as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name,
@@ -134,7 +134,7 @@ data ModuleName l = ModuleName l String
134134
-- data constructors.
135135
data SpecialCon l
136136
= UnitCon l -- ^ unit type and data constructor @()@
137-
| ListCon l -- ^ list type constructor @[]@
137+
| ListCon l -- ^ list type and data constructor @[]@
138138
| FunCon l -- ^ function type constructor @->@
139139
| TupleCon l Boxed Int -- ^ /n/-ary tuple type and data
140140
-- constructors @(,)@ etc, possibly boxed @(\#,\#)@
@@ -1019,6 +1019,9 @@ unit_con_name l = Special l (UnitCon l)
10191019
tuple_con_name :: l -> Boxed -> Int -> QName l
10201020
tuple_con_name l b i = Special l (TupleCon l b (i+1))
10211021

1022+
list_con_name :: l -> QName l
1023+
list_con_name l = Special l (ListCon l)
1024+
10221025
list_cons_name :: l -> QName l
10231026
list_cons_name l = Special l (Cons l)
10241027

‎tests/examples/TemplateHaskellQuotedNames.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
f = g 'Constructor 'function
3+
h = g '() '[]

‎tests/examples/TemplateHaskellQuotedNames.hs.exactprinter.golden

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
Match

‎tests/examples/TemplateHaskellQuotedNames.hs.parser.golden

Lines changed: 246 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,246 @@
1+
ParseOk
2+
( Module
3+
SrcSpanInfo
4+
{ srcInfoSpan =
5+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 1 4 1
6+
, srcInfoPoints =
7+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 1 1 1
8+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 1
9+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 1
10+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 1
11+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 1 3 1
12+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 4 1 4 1
13+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 4 1 4 1
14+
]
15+
}
16+
Nothing
17+
[ LanguagePragma
18+
SrcSpanInfo
19+
{ srcInfoSpan =
20+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 1 1 33
21+
, srcInfoPoints =
22+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 1 1 13
23+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 30 1 33
24+
]
25+
}
26+
[ Ident
27+
SrcSpanInfo
28+
{ srcInfoSpan =
29+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 1 14 1 29
30+
, srcInfoPoints = []
31+
}
32+
"TemplateHaskell"
33+
]
34+
]
35+
[]
36+
[ PatBind
37+
SrcSpanInfo
38+
{ srcInfoSpan =
39+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 29
40+
, srcInfoPoints = []
41+
}
42+
(PVar
43+
SrcSpanInfo
44+
{ srcInfoSpan =
45+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 2
46+
, srcInfoPoints = []
47+
}
48+
(Ident
49+
SrcSpanInfo
50+
{ srcInfoSpan =
51+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 1 2 2
52+
, srcInfoPoints = []
53+
}
54+
"f"))
55+
(UnGuardedRhs
56+
SrcSpanInfo
57+
{ srcInfoSpan =
58+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 3 2 29
59+
, srcInfoPoints =
60+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 3 2 4 ]
61+
}
62+
(App
63+
SrcSpanInfo
64+
{ srcInfoSpan =
65+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 29
66+
, srcInfoPoints = []
67+
}
68+
(App
69+
SrcSpanInfo
70+
{ srcInfoSpan =
71+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 19
72+
, srcInfoPoints = []
73+
}
74+
(Var
75+
SrcSpanInfo
76+
{ srcInfoSpan =
77+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 6
78+
, srcInfoPoints = []
79+
}
80+
(UnQual
81+
SrcSpanInfo
82+
{ srcInfoSpan =
83+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 6
84+
, srcInfoPoints = []
85+
}
86+
(Ident
87+
SrcSpanInfo
88+
{ srcInfoSpan =
89+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 5 2 6
90+
, srcInfoPoints = []
91+
}
92+
"g")))
93+
(VarQuote
94+
SrcSpanInfo
95+
{ srcInfoSpan =
96+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 7 2 19
97+
, srcInfoPoints =
98+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 7 2 8 ]
99+
}
100+
(UnQual
101+
SrcSpanInfo
102+
{ srcInfoSpan =
103+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 8 2 19
104+
, srcInfoPoints = []
105+
}
106+
(Ident
107+
SrcSpanInfo
108+
{ srcInfoSpan =
109+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 8 2 19
110+
, srcInfoPoints = []
111+
}
112+
"Constructor"))))
113+
(VarQuote
114+
SrcSpanInfo
115+
{ srcInfoSpan =
116+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 20 2 29
117+
, srcInfoPoints =
118+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 20 2 21
119+
]
120+
}
121+
(UnQual
122+
SrcSpanInfo
123+
{ srcInfoSpan =
124+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 21 2 29
125+
, srcInfoPoints = []
126+
}
127+
(Ident
128+
SrcSpanInfo
129+
{ srcInfoSpan =
130+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 2 21 2 29
131+
, srcInfoPoints = []
132+
}
133+
"function")))))
134+
Nothing
135+
, PatBind
136+
SrcSpanInfo
137+
{ srcInfoSpan =
138+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 1 3 14
139+
, srcInfoPoints = []
140+
}
141+
(PVar
142+
SrcSpanInfo
143+
{ srcInfoSpan =
144+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 1 3 2
145+
, srcInfoPoints = []
146+
}
147+
(Ident
148+
SrcSpanInfo
149+
{ srcInfoSpan =
150+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 1 3 2
151+
, srcInfoPoints = []
152+
}
153+
"h"))
154+
(UnGuardedRhs
155+
SrcSpanInfo
156+
{ srcInfoSpan =
157+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 3 3 14
158+
, srcInfoPoints =
159+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 3 3 4 ]
160+
}
161+
(App
162+
SrcSpanInfo
163+
{ srcInfoSpan =
164+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 14
165+
, srcInfoPoints = []
166+
}
167+
(App
168+
SrcSpanInfo
169+
{ srcInfoSpan =
170+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 10
171+
, srcInfoPoints = []
172+
}
173+
(Var
174+
SrcSpanInfo
175+
{ srcInfoSpan =
176+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 6
177+
, srcInfoPoints = []
178+
}
179+
(UnQual
180+
SrcSpanInfo
181+
{ srcInfoSpan =
182+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 6
183+
, srcInfoPoints = []
184+
}
185+
(Ident
186+
SrcSpanInfo
187+
{ srcInfoSpan =
188+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 5 3 6
189+
, srcInfoPoints = []
190+
}
191+
"g")))
192+
(VarQuote
193+
SrcSpanInfo
194+
{ srcInfoSpan =
195+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 7 3 10
196+
, srcInfoPoints =
197+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 7 3 8 ]
198+
}
199+
(Special
200+
SrcSpanInfo
201+
{ srcInfoSpan =
202+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 8 3 10
203+
, srcInfoPoints =
204+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 8 3 9
205+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 9 3 10
206+
]
207+
}
208+
(UnitCon
209+
SrcSpanInfo
210+
{ srcInfoSpan =
211+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 8 3 10
212+
, srcInfoPoints =
213+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 8 3 9
214+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 9 3 10
215+
]
216+
}))))
217+
(VarQuote
218+
SrcSpanInfo
219+
{ srcInfoSpan =
220+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 11 3 14
221+
, srcInfoPoints =
222+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 11 3 12
223+
]
224+
}
225+
(Special
226+
SrcSpanInfo
227+
{ srcInfoSpan =
228+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 12 3 14
229+
, srcInfoPoints =
230+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 12 3 13
231+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 13 3 14
232+
]
233+
}
234+
(ListCon
235+
SrcSpanInfo
236+
{ srcInfoSpan =
237+
SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 12 3 14
238+
, srcInfoPoints =
239+
[ SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 12 3 13
240+
, SrcSpan "tests/examples/TemplateHaskellQuotedNames.hs" 3 13 3 14
241+
]
242+
})))))
243+
Nothing
244+
]
245+
, []
246+
)

‎tests/examples/TemplateHaskellQuotedNames.hs.prettyparser.golden

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
Match

‎tests/examples/TemplateHaskellQuotedNames.hs.prettyprinter.golden

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
f = g 'Constructor 'function
3+
h = g '() '[]

0 commit comments

Comments
 (0)