Add unicode syntax for banana brackets
authorJosh Price <joshprice247+git@gmail.com>
Wed, 23 Mar 2016 15:19:01 +0000 (16:19 +0100)
committerBen Gamari <ben@smart-cactus.org>
Thu, 24 Mar 2016 09:53:27 +0000 (10:53 +0100)
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

compiler/parser/Lexer.x
compiler/parser/Parser.y
docs/users_guide/glasgow_exts.rst
testsuite/tests/arrows/should_compile/arrowform1.hs
testsuite/tests/parser/unicode/all.T
testsuite/tests/parser/unicode/arrowsyntax.hs [new file with mode: 0644]

index 650b302..4eb8fd3 100644 (file)
@@ -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
index a640bcb..0b11b04 100644 (file)
@@ -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 }
index a4a0830..978fe8b 100644 (file)
@@ -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:
 
index 70b9669..c41e6c7 100644 (file)
@@ -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)
index 36554cc..6876fe7 100644 (file)
@@ -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 (file)
index 0000000..05a8495
--- /dev/null
@@ -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)