From 284bec158dc12251c393aa7f31e13f7e1f1f8dab Mon Sep 17 00:00:00 2001
From: "Edward Z. Yang" <ezyang@cs.stanford.edu>
Date: Sun, 12 Mar 2017 14:09:36 -0700
Subject: [PATCH] Support parsing Backpack signatures.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
---
src/Language/Haskell/Exts/InternalLexer.hs | 3 +++
src/Language/Haskell/Exts/InternalParser.ly | 7 ++++++-
src/Language/Haskell/Exts/Syntax.hs | 5 +++--
3 files changed, 12 insertions(+), 3 deletions(-)
diff --git a/src/Language/Haskell/Exts/InternalLexer.hs b/src/Language/Haskell/Exts/InternalLexer.hs
index f7d45286..49a2dc97 100644
--- a/src/Language/Haskell/Exts/InternalLexer.hs
+++ b/src/Language/Haskell/Exts/InternalLexer.hs
@@ -180,6 +180,7 @@ data Token
| KW_Instance
| KW_Let
| KW_Module
+ | KW_Signature
| KW_NewType
| KW_Of
| KW_Proc -- arrows
@@ -300,6 +301,7 @@ special_varids = [
( "as", (KW_As, Nothing) ),
( "qualified", (KW_Qualified, Nothing) ),
( "hiding", (KW_Hiding, Nothing) ),
+ ( "signature", (KW_Signature, Nothing) ),
-- FFI
( "export", (KW_Export, Just (Any [ForeignFunctionInterface])) ),
@@ -1399,6 +1401,7 @@ showToken t = case t of
KW_Instance -> "instance"
KW_Let -> "let"
KW_Module -> "module"
+ KW_Signature -> "signature"
KW_NewType -> "newtype"
KW_Of -> "of"
KW_Proc -> "proc"
diff --git a/src/Language/Haskell/Exts/InternalParser.ly b/src/Language/Haskell/Exts/InternalParser.ly
index 3b5808b9..6875281e 100644
--- a/src/Language/Haskell/Exts/InternalParser.ly
+++ b/src/Language/Haskell/Exts/InternalParser.ly
@@ -243,6 +243,7 @@ Reserved Ids
> 'let' { Loc $$ KW_Let }
> 'mdo' { Loc $$ KW_MDo }
> 'module' { Loc $$ KW_Module } -- 114
+> 'signature' { Loc $$ KW_Signature }
> 'newtype' { Loc $$ KW_NewType }
> 'of' { Loc $$ KW_Of }
> 'proc' { Loc $$ KW_Proc } -- arrows
@@ -297,7 +298,7 @@ Pragmas
> %partial ngparsePragmasAndModuleHead moduletophead
> %partial ngparsePragmasAndModuleName moduletopname
> %tokentype { Loc Token }
-> %expect 10
+> %expect 12
> %%
-----------------------------------------------------------------------------
@@ -365,6 +366,7 @@ Module Header
> optmodulehead :: { Maybe (ModuleHead L) }
> : 'module' modid maybemodwarning maybeexports 'where' { Just $ ModuleHead ($1 <^^> $5 <** [$1,$5]) $2 $3 $4 }
+> | 'signature' modid maybemodwarning maybeexports 'where' { Just $ ModuleHead ($1 <^^> $5 <** [$1,$5]) $2 $3 $4 }
> | {- empty -} { Nothing }
> maybemodwarning :: { Maybe (WarningText L) }
@@ -1609,6 +1611,7 @@ Hsx Extensions - requires XmlSyntax, but the lexer handles all that.
> | 'let' { Loc $1 "let" }
> | 'mdo' { Loc $1 "mdo" }
> | 'module' { Loc $1 "module" }
+> | 'signature' { Loc $1 "signature" }
> | 'newtype' { Loc $1 "newtype" }
> | 'of' { Loc $1 "of" }
> | 'proc' { Loc $1 "proc" }
@@ -1893,6 +1896,7 @@ Identifiers and Symbols
> : VARID { let Loc l (VarId v) = $1 in Ident (nIS l) v }
> | 'as' { as_name (nIS $1) }
> | 'qualified' { qualified_name (nIS $1) }
+> | 'signature' { signature_name (nIS $1) }
> | 'hiding' { hiding_name (nIS $1) }
> | 'export' { export_name (nIS $1) }
> | 'stdcall' { stdcall_name (nIS $1) }
@@ -2084,6 +2088,7 @@ Exported as partial parsers:
> moduletopname :: { (([ModulePragma L], [S], L), Maybe (ModuleName L)) }
> : toppragmas 'module' modid { ($1, Just $3) }
+> | toppragmas 'signature' modid { ($1, Just $3) }
> | toppragmas {- empty -} { ($1, Nothing) }
> moduletophead :: { (([ModulePragma L], [S], L), Maybe (ModuleHead L)) }
diff --git a/src/Language/Haskell/Exts/Syntax.hs b/src/Language/Haskell/Exts/Syntax.hs
index 06695486..1a426a56 100644
--- a/src/Language/Haskell/Exts/Syntax.hs
+++ b/src/Language/Haskell/Exts/Syntax.hs
@@ -99,7 +99,7 @@ module Language.Haskell.Exts.Syntax (
unit_con_name, tuple_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,
+ as_name, qualified_name, signature_name, hiding_name, minus_name, bang_name, dot_name, star_name,
export_name, safe_name, unsafe_name, interruptible_name, threadsafe_name,
stdcall_name, ccall_name, cplusplus_name, dotnet_name, jvm_name, js_name,
javascript_name, capi_name, forall_name, family_name, role_name,
@@ -1013,9 +1013,10 @@ tuple_con l b i = Con l (tuple_con_name l b i)
unboxed_singleton_con :: l -> Exp l
unboxed_singleton_con l = Con l (unboxed_singleton_con_name l)
-as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name :: l -> Name l
+as_name, qualified_name, signature_name, hiding_name, minus_name, bang_name, dot_name, star_name :: l -> Name l
as_name l = Ident l "as"
qualified_name l = Ident l "qualified"
+signature_name l = Ident l "signature"
hiding_name l = Ident l "hiding"
minus_name l = Symbol l "-"
bang_name l = Symbol l "!"