Skip to content

GitLab

GHC
GHC
Commit 8f7d0163 authored by Josh Price's avatar Josh Price Committed by Ben Gamari
Browse files
Options

Add support for unicode TH quotes (#11743) 

I've also added cases for `IToparenbar` and `ITcparenbar` (aka banana
brackets) to `isUnicode`.

Document unicode TH quote alternatives (#11743)

Test Plan: ./validate

Reviewers: austin, goldfire, bgamari

Reviewed By: bgamari

Subscribers: thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D2185

GHC Trac Issues: #11743
parent 1bf5c126
Hide whitespace changes
Inline Side-by-side
Showing with 121 additions and 58 deletions
compiler/parser/Lexer.x
View file @ 8f7d0163
......@@ -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
......
compiler/parser/Parser.y
View file @ 8f7d0163
......@@ -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
......
docs/users_guide/glasgow_exts.rst
View file @ 8f7d0163
......@@ -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:
......
testsuite/tests/parser/unicode/all.T
View file @ 8f7d0163
......@@ -27,4 +27,4 @@ test('T7671', normal, compile, [''])
test('T10907', normal, compile, [''])
test('T7650', normal, compile, [''])
test('arrowsyntax', normal, compile, [''])
test('brackets', normal, compile, [''])
testsuite/tests/parser/unicode/arrowsyntax.hs → testsuite/tests/parser/unicode/brackets.hs
View file @ 8f7d0163
{-# LANGUAGE Arrows #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnicodeSyntax #-}
-- See Trac #2978 and #10162 for details
-- This test is a unicode version of tests/arrows/should_compile/arrowform1.hs
-- 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)))
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)
(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)
(\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 -< x + z)
<+>
(\z -> returnA ⤙ y + z)
(\z -> returnA -< y + z)
) (x*y)
matches :: PatQ -> ExpQ
matches pat = ⟦\x ->
case x of
$pat -> True
_ -> False
⟧
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment