[commit: ghc] master: Add unicode syntax for banana brackets (03a1bb4)
git at git.haskell.org
git at git.haskell.org
Thu Mar 24 09:51:24 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/03a1bb4d010f94bed233ca261bf44e00c7bd9878/ghc
>---------------------------------------------------------------
commit 03a1bb4d010f94bed233ca261bf44e00c7bd9878
Author: Josh Price <joshprice247+git at gmail.com>
Date: Wed Mar 23 16:19:01 2016 +0100
Add unicode syntax for banana brackets
Summary:
Add "⦇" and "⦈" as unicode alternatives for "(|" and "|)" respectively.
This must be implemented differently than other unicode additions
because ⦇" and "⦈" are interpretted as a $unigraphic rather than
a $unisymbol.
Test Plan: validate
Reviewers: goldfire, bgamari, austin
Reviewed By: bgamari, austin
Subscribers: thomie, mpickering
Differential Revision: https://phabricator.haskell.org/D2012
GHC Trac Issues: #10162
>---------------------------------------------------------------
03a1bb4d010f94bed233ca261bf44e00c7bd9878
compiler/parser/Lexer.x | 21 ++++++++++---
compiler/parser/Parser.y | 4 +--
docs/users_guide/glasgow_exts.rst | 4 +++
.../tests/arrows/should_compile/arrowform1.hs | 26 ++++++++---------
testsuite/tests/parser/unicode/all.T | 2 ++
testsuite/tests/parser/unicode/arrowsyntax.hs | 34 ++++++++++++++++++++++
6 files changed, 72 insertions(+), 19 deletions(-)
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 650b302..4eb8fd3 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -395,8 +395,17 @@ $tab { warnTab }
<0> {
"(|" / { ifExtension arrowsEnabled `alexAndPred` notFollowedBySymbol }
- { special IToparenbar }
- "|)" / { ifExtension arrowsEnabled } { special ITcparenbar }
+ { special (IToparenbar NormalSyntax) }
+ "|)" / { ifExtension arrowsEnabled } { special (ITcparenbar NormalSyntax) }
+
+ $unigraphic -- ⦇
+ / { ifCurrentChar '⦇' `alexAndPred`
+ ifExtension (\i -> unicodeSyntaxEnabled i && arrowsEnabled i) }
+ { special (IToparenbar UnicodeSyntax) }
+ $unigraphic -- ⦈
+ / { ifCurrentChar '⦈' `alexAndPred`
+ ifExtension (\i -> unicodeSyntaxEnabled i && arrowsEnabled i) }
+ { special (ITcparenbar UnicodeSyntax) }
}
<0> {
@@ -704,8 +713,8 @@ data Token
-- Arrow notation extension
| ITproc
| ITrec
- | IToparenbar -- (|
- | ITcparenbar -- |)
+ | IToparenbar IsUnicodeSyntax -- (|
+ | ITcparenbar IsUnicodeSyntax -- |)
| ITlarrowtail IsUnicodeSyntax -- -<
| ITrarrowtail IsUnicodeSyntax -- >-
| ITLarrowtail IsUnicodeSyntax -- -<<
@@ -942,6 +951,10 @@ followedByDigit :: AlexAccPred ExtsBitmap
followedByDigit _ _ _ (AI _ buf)
= afterOptionalSpace buf (\b -> nextCharIs b (`elem` ['0'..'9']))
+ifCurrentChar :: Char -> AlexAccPred ExtsBitmap
+ifCurrentChar char _ (AI _ buf) _ _
+ = nextCharIs buf (== char)
+
-- We must reject doc comments as being ordinary comments everywhere.
-- In some cases the doc comment will be selected as the lexeme due to
-- maximal munch, but not always, because the nested comment rule is
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index a640bcb..0b11b04 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -427,8 +427,8 @@ output it generates.
')' { L _ ITcparen }
'(#' { L _ IToubxparen }
'#)' { L _ ITcubxparen }
- '(|' { L _ IToparenbar }
- '|)' { L _ ITcparenbar }
+ '(|' { L _ (IToparenbar _) }
+ '|)' { L _ (ITcparenbar _) }
';' { L _ ITsemi }
',' { L _ ITcomma }
'`' { L _ ITbackquote }
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index a4a0830..978fe8b 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -302,6 +302,10 @@ sequences. The following alternatives are provided:
+--------------+---------------+-------------+--------------------------------+
| ``forall`` | ∀ | 0x2200 | FOR ALL |
+--------------+---------------+-------------+--------------------------------+
+| ``(|`` | ⦇ | 0x2987 | Z NOTATION LEFT IMAGE BRACKET |
++--------------+---------------+-------------+--------------------------------+
+| ``|)`` | ⦈ | 0x2988 | Z NOTATION RIGHT IMAGE BRACKET |
++--------------+---------------+-------------+--------------------------------+
.. _magic-hash:
diff --git a/testsuite/tests/arrows/should_compile/arrowform1.hs b/testsuite/tests/arrows/should_compile/arrowform1.hs
index 70b9669..c41e6c7 100644
--- a/testsuite/tests/arrows/should_compile/arrowform1.hs
+++ b/testsuite/tests/arrows/should_compile/arrowform1.hs
@@ -9,22 +9,22 @@ 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)
- |)
+ (|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)
+ (|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)
+ (
+ (\z -> returnA -< x + z)
+ <+>
+ (\z -> returnA -< y + z)
+ ) (x*y)
diff --git a/testsuite/tests/parser/unicode/all.T b/testsuite/tests/parser/unicode/all.T
index 36554cc..6876fe7 100644
--- a/testsuite/tests/parser/unicode/all.T
+++ b/testsuite/tests/parser/unicode/all.T
@@ -26,3 +26,5 @@ test('T7671', normal, compile, [''])
# supported by the test suite (see 10907)
test('T10907', normal, compile, [''])
test('T7650', normal, compile, [''])
+
+test('arrowsyntax', normal, compile, [''])
\ No newline at end of file
diff --git a/testsuite/tests/parser/unicode/arrowsyntax.hs b/testsuite/tests/parser/unicode/arrowsyntax.hs
new file mode 100644
index 0000000..05a8495
--- /dev/null
+++ b/testsuite/tests/parser/unicode/arrowsyntax.hs
@@ -0,0 +1,34 @@
+{-# 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)
More information about the ghc-commits
mailing list