From 99876aaefc0d8f639c3531a629bab2210a82f18a Mon Sep 17 00:00:00 2001 From: Matthew Glazar Date: Mon, 3 Sep 2018 10:34:19 -0700 Subject: [PATCH] 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. --- src/Language/Haskell/Exts/InternalParser.ly | 3 + src/Language/Haskell/Exts/Syntax.hs | 7 +- tests/examples/TemplateHaskellQuotedNames.hs | 3 + ...eHaskellQuotedNames.hs.exactprinter.golden | 1 + ...emplateHaskellQuotedNames.hs.parser.golden | 246 ++++++++++++++++++ ...eHaskellQuotedNames.hs.prettyparser.golden | 1 + ...HaskellQuotedNames.hs.prettyprinter.golden | 3 + 7 files changed, 262 insertions(+), 2 deletions(-) create mode 100644 tests/examples/TemplateHaskellQuotedNames.hs create mode 100644 tests/examples/TemplateHaskellQuotedNames.hs.exactprinter.golden create mode 100644 tests/examples/TemplateHaskellQuotedNames.hs.parser.golden create mode 100644 tests/examples/TemplateHaskellQuotedNames.hs.prettyparser.golden create mode 100644 tests/examples/TemplateHaskellQuotedNames.hs.prettyprinter.golden diff --git a/src/Language/Haskell/Exts/InternalParser.ly b/src/Language/Haskell/Exts/InternalParser.ly index 4373c702..87eb4b42 100644 --- a/src/Language/Haskell/Exts/InternalParser.ly +++ b/src/Language/Haskell/Exts/InternalParser.ly @@ -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) } diff --git a/src/Language/Haskell/Exts/Syntax.hs b/src/Language/Haskell/Exts/Syntax.hs index e8caea9a..aa544215 100644 --- a/src/Language/Haskell/Exts/Syntax.hs +++ b/src/Language/Haskell/Exts/Syntax.hs @@ -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, @@ -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 @(\#,\#)@ @@ -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) diff --git a/tests/examples/TemplateHaskellQuotedNames.hs b/tests/examples/TemplateHaskellQuotedNames.hs new file mode 100644 index 00000000..f5a0933a --- /dev/null +++ b/tests/examples/TemplateHaskellQuotedNames.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE TemplateHaskell #-} +f = g 'Constructor 'function +h = g '() '[] diff --git a/tests/examples/TemplateHaskellQuotedNames.hs.exactprinter.golden b/tests/examples/TemplateHaskellQuotedNames.hs.exactprinter.golden new file mode 100644 index 00000000..1796dc27 --- /dev/null +++ b/tests/examples/TemplateHaskellQuotedNames.hs.exactprinter.golden @@ -0,0 +1 @@ +Match diff --git a/tests/examples/TemplateHaskellQuotedNames.hs.parser.golden b/tests/examples/TemplateHaskellQuotedNames.hs.parser.golden new file mode 100644 index 00000000..2a48bc05 --- /dev/null +++ b/tests/examples/TemplateHaskellQuotedNames.hs.parser.golden @@ -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 + ] + , [] + ) diff --git a/tests/examples/TemplateHaskellQuotedNames.hs.prettyparser.golden b/tests/examples/TemplateHaskellQuotedNames.hs.prettyparser.golden new file mode 100644 index 00000000..1796dc27 --- /dev/null +++ b/tests/examples/TemplateHaskellQuotedNames.hs.prettyparser.golden @@ -0,0 +1 @@ +Match diff --git a/tests/examples/TemplateHaskellQuotedNames.hs.prettyprinter.golden b/tests/examples/TemplateHaskellQuotedNames.hs.prettyprinter.golden new file mode 100644 index 00000000..f5a0933a --- /dev/null +++ b/tests/examples/TemplateHaskellQuotedNames.hs.prettyprinter.golden @@ -0,0 +1,3 @@ +{-# LANGUAGE TemplateHaskell #-} +f = g 'Constructor 'function +h = g '() '[]