X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=e131e962cd712e7984c20d3bd54f9734add328d9;hb=edc033b1b0e4ed4dccfaeb59a68b3e49b569d6ea;hp=1bb8a636e40c39d531a14d8b84249f61f3265874;hpb=9568347eb0ae5d11354e0e4744c0f6af8b65b0be;p=ghc-hetmet.git

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 1bb8a63..e131e96 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -702,6 +702,14 @@ reservedSymsFM = listToUFM $
        ,("→",   ITrarrow, unicodeSyntaxEnabled)
        ,("←",   ITlarrow, unicodeSyntaxEnabled)
        ,("⋯",   ITdotdot, unicodeSyntaxEnabled)
+
+       ,("⤙",   ITlarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
+       ,("⤚",   ITrarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
+       ,("⤛",   ITLarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
+       ,("⤜",   ITRarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
+
+       ,("★", ITstar, unicodeSyntaxEnabled)
+
         -- ToDo: ideally, → and ∷ should be "specials", so that they cannot
         -- form part of a large operator.  This would let us have a better
         -- syntax for kinds: ɑ∷*→* would be a legal kind signature. (maybe).
@@ -1983,7 +1991,9 @@ alternativeLayoutRuleToken t
                     setNextToken t
                     lexTokenAlr
              (_, ALRLayout _ col : ls, Just expectingOCurly)
-              | thisCol > col ->
+              | (thisCol > col) ||
+                (thisCol == col &&
+                 isNonDecreasingIntentation expectingOCurly) ->
                  do setAlrExpectingOCurly Nothing
                     setALRContext (ALRLayout expectingOCurly thisCol : context)
                     setNextToken t
@@ -2018,6 +2028,7 @@ alternativeLayoutRuleToken t
                     return (L thisLoc ITsemi)
               | newLine && thisCol < col ->
                  do setALRContext ls
+                    setNextToken t
                     -- Note that we use lastLoc, as we may need to close
                     -- more layouts, or give a semicolon
                     return (L lastLoc ITccurly)
@@ -2080,6 +2091,10 @@ isALRclose ITccurly = True
 isALRclose ITcubxparen = True
 isALRclose _        = False
 
+isNonDecreasingIntentation :: ALRLayout -> Bool
+isNonDecreasingIntentation ALRLayoutDo = True
+isNonDecreasingIntentation _           = False
+
 containsCommas :: Token -> Bool
 containsCommas IToparen = True
 containsCommas ITobrack = True