summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/parser/Lexer.x42
-rw-r--r--compiler/parser/Parser.y32
-rw-r--r--docs/users_guide/glasgow_exts.rst60
-rw-r--r--testsuite/tests/parser/unicode/all.T2
-rw-r--r--testsuite/tests/parser/unicode/arrowsyntax.hs34
-rw-r--r--testsuite/tests/parser/unicode/brackets.hs43
6 files changed, 121 insertions, 92 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 4da03c616f..39ce506094 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -366,14 +366,17 @@ $tab { warnTab }
}
<0> {
- "[|" / { ifExtension thQuotesEnabled } { token (ITopenExpQuote NoE) }
+ "[|" / { ifExtension thQuotesEnabled } { token (ITopenExpQuote NoE
+ NormalSyntax) }
"[||" / { ifExtension thQuotesEnabled } { token (ITopenTExpQuote NoE) }
- "[e|" / { ifExtension thQuotesEnabled } { token (ITopenExpQuote HasE) }
+ "[e|" / { ifExtension thQuotesEnabled } { token (ITopenExpQuote HasE
+ NormalSyntax) }
"[e||" / { ifExtension thQuotesEnabled } { token (ITopenTExpQuote HasE) }
"[p|" / { ifExtension thQuotesEnabled } { token ITopenPatQuote }
"[d|" / { ifExtension thQuotesEnabled } { layout_token ITopenDecQuote }
"[t|" / { ifExtension thQuotesEnabled } { token ITopenTypQuote }
- "|]" / { ifExtension thQuotesEnabled } { token ITcloseQuote }
+ "|]" / { ifExtension thQuotesEnabled } { token (ITcloseQuote
+ NormalSyntax) }
"||]" / { ifExtension thQuotesEnabled } { token ITcloseTExpQuote }
\$ @varid / { ifExtension thEnabled } { skip_one_varid ITidEscape }
"$$" @varid / { ifExtension thEnabled } { skip_two_varid ITidTyEscape }
@@ -386,6 +389,15 @@ $tab { warnTab }
-- qualified quasi-quote (#5555)
"[" @qvarid "|" / { ifExtension qqEnabled }
{ lex_qquasiquote_tok }
+
+ $unigraphic -- ⟦
+ / { ifCurrentChar '⟦' `alexAndPred`
+ ifExtension (\i -> unicodeSyntaxEnabled i && thQuotesEnabled i) }
+ { token (ITopenExpQuote NoE UnicodeSyntax) }
+ $unigraphic -- ⟧
+ / { ifCurrentChar '⟧' `alexAndPred`
+ ifExtension (\i -> unicodeSyntaxEnabled i && thQuotesEnabled i) }
+ { token (ITcloseQuote UnicodeSyntax) }
}
-- See Note [Lexing type applications]
@@ -692,18 +704,18 @@ data Token
| ITprimdouble FractionalLit
-- Template Haskell extension tokens
- | ITopenExpQuote HasE -- [| or [e|
- | ITopenPatQuote -- [p|
- | ITopenDecQuote -- [d|
- | ITopenTypQuote -- [t|
- | ITcloseQuote -- |]
- | ITopenTExpQuote HasE -- [|| or [e||
- | ITcloseTExpQuote -- ||]
- | ITidEscape FastString -- $x
- | ITparenEscape -- $(
- | ITidTyEscape FastString -- $$x
- | ITparenTyEscape -- $$(
- | ITtyQuote -- ''
+ | ITopenExpQuote HasE IsUnicodeSyntax -- [| or [e|
+ | ITopenPatQuote -- [p|
+ | ITopenDecQuote -- [d|
+ | ITopenTypQuote -- [t|
+ | ITcloseQuote IsUnicodeSyntax -- |]
+ | ITopenTExpQuote HasE -- [|| or [e||
+ | ITcloseTExpQuote -- ||]
+ | ITidEscape FastString -- $x
+ | ITparenEscape -- $(
+ | ITidTyEscape FastString -- $$x
+ | ITparenTyEscape -- $$(
+ | ITtyQuote -- ''
| ITquasiQuote (FastString,FastString,RealSrcSpan)
-- ITquasiQuote(quoter, quote, loc)
-- represents a quasi-quote of the form
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 4502dcae26..e1c8559933 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -464,11 +464,11 @@ output it generates.
DOCSECTION { L _ (ITdocSection _ _) }
-- Template Haskell
-'[|' { L _ (ITopenExpQuote _) }
+'[|' { L _ (ITopenExpQuote _ _) }
'[p|' { L _ ITopenPatQuote }
'[t|' { L _ ITopenTypQuote }
'[d|' { L _ ITopenDecQuote }
-'|]' { L _ ITcloseQuote }
+'|]' { L _ (ITcloseQuote _) }
'[||' { L _ (ITopenTExpQuote _) }
'||]' { L _ ITcloseTExpQuote }
TH_ID_SPLICE { L _ (ITidEscape _) } -- $x
@@ -3206,20 +3206,24 @@ getCTYPEs (L _ (ITctype src)) = src
getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l)
isUnicode :: Located Token -> Bool
-isUnicode (L _ (ITforall iu)) = iu == UnicodeSyntax
-isUnicode (L _ (ITdarrow iu)) = iu == UnicodeSyntax
-isUnicode (L _ (ITdcolon iu)) = iu == UnicodeSyntax
-isUnicode (L _ (ITlarrow iu)) = iu == UnicodeSyntax
-isUnicode (L _ (ITrarrow iu)) = iu == UnicodeSyntax
-isUnicode (L _ (ITrarrow iu)) = iu == UnicodeSyntax
-isUnicode (L _ (ITlarrowtail iu)) = iu == UnicodeSyntax
-isUnicode (L _ (ITrarrowtail iu)) = iu == UnicodeSyntax
-isUnicode (L _ (ITLarrowtail iu)) = iu == UnicodeSyntax
-isUnicode (L _ (ITRarrowtail iu)) = iu == UnicodeSyntax
-isUnicode _ = False
+isUnicode (L _ (ITforall iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdarrow iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdcolon iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrow iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrow iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrow iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITLarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITRarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (IToparenbar iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITcparenbar iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITcloseQuote iu)) = iu == UnicodeSyntax
+isUnicode _ = False
hasE :: Located Token -> Bool
-hasE (L _ (ITopenExpQuote HasE)) = True
+hasE (L _ (ITopenExpQuote HasE _)) = True
hasE (L _ (ITopenTExpQuote HasE)) = True
hasE _ = False
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 8abb2184ee..c48812cdcb 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -278,34 +278,38 @@ The language extension :ghc-flag:`-XUnicodeSyntax` enables
Unicode characters to be used to stand for certain ASCII character
sequences. The following alternatives are provided:
-+--------------+---------------+-------------+--------------------------------+
-| ASCII | Unicode | Code point | Name |
-| | alternative | | |
-+==============+===============+=============+================================+
-| ``::`` | ∷ | 0x2237 | PROPORTION |
-+--------------+---------------+-------------+--------------------------------+
-| ``=>`` | ⇒ | 0x21D2 | RIGHTWARDS DOUBLE ARROW |
-+--------------+---------------+-------------+--------------------------------+
-| ``->`` | → | 0x2192 | RIGHTWARDS ARROW |
-+--------------+---------------+-------------+--------------------------------+
-| ``<-`` | ← | 0x2190 | LEFTWARDS ARROW |
-+--------------+---------------+-------------+--------------------------------+
-| ``>-`` | ⤚ | 0x291a | RIGHTWARDS ARROW-TAIL |
-+--------------+---------------+-------------+--------------------------------+
-| ``-<`` | ⤙ | 0x2919 | LEFTWARDS ARROW-TAIL |
-+--------------+---------------+-------------+--------------------------------+
-| ``>>-`` | ⤜ | 0x291C | RIGHTWARDS DOUBLE ARROW-TAIL |
-+--------------+---------------+-------------+--------------------------------+
-| ``-<<`` | ⤛ | 0x291B | LEFTWARDS DOUBLE ARROW-TAIL |
-+--------------+---------------+-------------+--------------------------------+
-| ``*`` | ★ | 0x2605 | BLACK STAR |
-+--------------+---------------+-------------+--------------------------------+
-| ``forall`` | ∀ | 0x2200 | FOR ALL |
-+--------------+---------------+-------------+--------------------------------+
-| ``(|`` | ⦇ | 0x2987 | Z NOTATION LEFT IMAGE BRACKET |
-+--------------+---------------+-------------+--------------------------------+
-| ``|)`` | ⦈ | 0x2988 | Z NOTATION RIGHT IMAGE BRACKET |
-+--------------+---------------+-------------+--------------------------------+
++--------------+---------------+-------------+-----------------------------------------+
+| ASCII | Unicode | Code point | Name |
+| | alternative | | |
++==============+===============+=============+=========================================+
+| ``::`` | ∷ | 0x2237 | PROPORTION |
++--------------+---------------+-------------+-----------------------------------------+
+| ``=>`` | ⇒ | 0x21D2 | RIGHTWARDS DOUBLE ARROW |
++--------------+---------------+-------------+-----------------------------------------+
+| ``->`` | → | 0x2192 | RIGHTWARDS ARROW |
++--------------+---------------+-------------+-----------------------------------------+
+| ``<-`` | ← | 0x2190 | LEFTWARDS ARROW |
++--------------+---------------+-------------+-----------------------------------------+
+| ``>-`` | ⤚ | 0x291a | RIGHTWARDS ARROW-TAIL |
++--------------+---------------+-------------+-----------------------------------------+
+| ``-<`` | ⤙ | 0x2919 | LEFTWARDS ARROW-TAIL |
++--------------+---------------+-------------+-----------------------------------------+
+| ``>>-`` | ⤜ | 0x291C | RIGHTWARDS DOUBLE ARROW-TAIL |
++--------------+---------------+-------------+-----------------------------------------+
+| ``-<<`` | ⤛ | 0x291B | LEFTWARDS DOUBLE ARROW-TAIL |
++--------------+---------------+-------------+-----------------------------------------+
+| ``*`` | ★ | 0x2605 | BLACK STAR |
++--------------+---------------+-------------+-----------------------------------------+
+| ``forall`` | ∀ | 0x2200 | FOR ALL |
++--------------+---------------+-------------+-----------------------------------------+
+| ``(|`` | ⦇ | 0x2987 | Z NOTATION LEFT IMAGE BRACKET |
++--------------+---------------+-------------+-----------------------------------------+
+| ``|)`` | ⦈ | 0x2988 | Z NOTATION RIGHT IMAGE BRACKET |
++--------------+---------------+-------------+-----------------------------------------+
+| ``[|`` | ⟦ | 0x27E6 | MATHEMATICAL LEFT WHITE SQUARE BRACKET |
++--------------+---------------+-------------+-----------------------------------------+
+| ``|]`` | ⟧ | 0x27E7 | MATHEMATICAL RIGHT WHITE SQUARE BRACKET |
++--------------+---------------+-------------+-----------------------------------------+
.. _magic-hash:
diff --git a/testsuite/tests/parser/unicode/all.T b/testsuite/tests/parser/unicode/all.T
index 44adc7d797..cd69f0d161 100644
--- a/testsuite/tests/parser/unicode/all.T
+++ b/testsuite/tests/parser/unicode/all.T
@@ -27,4 +27,4 @@ test('T7671', normal, compile, [''])
test('T10907', normal, compile, [''])
test('T7650', normal, compile, [''])
-test('arrowsyntax', normal, compile, [''])
+test('brackets', normal, compile, [''])
diff --git a/testsuite/tests/parser/unicode/arrowsyntax.hs b/testsuite/tests/parser/unicode/arrowsyntax.hs
deleted file mode 100644
index 05a8495167..0000000000
--- a/testsuite/tests/parser/unicode/arrowsyntax.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-{-# LANGUAGE Arrows #-}
-{-# LANGUAGE UnicodeSyntax #-}
-
--- See Trac #2978 and #10162 for details
--- This test is a unicode version of tests/arrows/should_compile/arrowform1.hs
-
-module ShouldCompile where
-
-import Control.Arrow
-
-handle :: ArrowPlus a => a (b,s) c -> a (b,(String,s)) c -> a (b,s) c
-handle f h = proc (b,s) -> (f ⤙ (b,s)) <+> (h ⤙ (b,("FAIL",s)))
-
-f :: ArrowPlus a => a (Int,Int) String
-f = proc (x,y) ->
- ⦇handle
- (returnA ⤙ show y)
- (\s -> returnA ⤙ s ++ show x)
- ⦈
-
-g :: ArrowPlus a => a (Int,Int) String
-g = proc (x,y) ->
- ⦇handle
- (\msg -> returnA ⤙ msg ++ show y)
- (\s msg -> returnA ⤙ s ++ show x)
- ⦈ ("hello " ++ show x)
-
-h :: ArrowPlus a => a (Int,Int) Int
-h = proc (x,y) ->
- (
- (\z -> returnA ⤙ x + z)
- <+>
- (\z -> returnA ⤙ y + z)
- ) (x*y)
diff --git a/testsuite/tests/parser/unicode/brackets.hs b/testsuite/tests/parser/unicode/brackets.hs
new file mode 100644
index 0000000000..33c8e3f44f
--- /dev/null
+++ b/testsuite/tests/parser/unicode/brackets.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+-- See Trac #10162 and #11743 for details
+
+module ShouldCompile where
+
+import Control.Arrow
+import Language.Haskell.TH
+
+handle :: ArrowPlus a => a (b,s) c -> a (b,(String,s)) c -> a (b,s) c
+handle f h = proc (b,s) -> (f -< (b,s)) <+> (h -< (b,("FAIL",s)))
+
+f :: ArrowPlus a => a (Int,Int) String
+f = proc (x,y) ->
+ ⦇handle
+ (returnA -< show y)
+ (\s -> returnA -< s ++ show x)
+ ⦈
+
+g :: ArrowPlus a => a (Int,Int) String
+g = proc (x,y) ->
+ ⦇handle
+ (\msg -> returnA -< msg ++ show y)
+ (\s msg -> returnA -< s ++ show x)
+ ⦈ ("hello " ++ show x)
+
+h :: ArrowPlus a => a (Int,Int) Int
+h = proc (x,y) ->
+ (
+ (\z -> returnA -< x + z)
+ <+>
+ (\z -> returnA -< y + z)
+ ) (x*y)
+
+
+matches :: PatQ -> ExpQ
+matches pat = ⟦\x ->
+ case x of
+ $pat -> True
+ _ -> False
+ ⟧
View Lorry Controller Status