Ticket #5239: mdash.patch

compiler/parser/Lexer.x

@@ -110 +110 @@
 $unigraphic = \x06 -- Trick Alex into handling Unicode. See alexGetChar.
 $graphic   = [$small $large $symbol $digit $special $unigraphic \:\"\']
 
+$mdash     = \x07 -- Trick Alex into handling Unicode. See alexGetChar.
+
 $octit     = 0-7
 $hexit     = [$decdigit A-F a-f]
 $symchar   = [$symbol \:]
@@ -172 +174 @@
 "-- " ~[$docsym \#] .* { lineCommentToken }
 "--" [^$symbol : \ ] .* { lineCommentToken }
 
+-- Ditto, for unicode syntax:
+
+$mdash " " ~[$docsym \#] .* / { ifExtension unicodeSyntaxEnabled } { lineCommentToken }
+$mdash [^$symbol : \ ] .* / { ifExtension unicodeSyntaxEnabled } { lineCommentToken }
+
 -- Next, match Haddock comments if no -haddock flag
 
 "-- " [$docsym \#] .* / { ifExtension (not . haddockEnabled) } { lineCommentToken }
+$mdash " " [$docsym \#] .* / { ifExtension (not . haddockEnabled) `aapAnd` ifExtension unicodeSyntaxEnabled } { lineCommentToken }
 
 -- Now, when we've matched comments that begin with 2 dashes and continue
 -- with a different character, we need to match comments that begin with three
@@ -188 +196 @@
 -- character, we also need to match a whole line filled with just dashes.
 
 "--"\-* / { atEOL } { lineCommentToken }
+$mdash $mdash* / { atEOL `aapAnd` ifExtension unicodeSyntaxEnabled } { lineCommentToken }
 
 -- We need this rule since none of the other single line comment rules
 -- actually match this case.
 
 "-- " / { atEOL } { lineCommentToken }
+$mdash " " / { atEOL `aapAnd` ifExtension unicodeSyntaxEnabled } { lineCommentToken }
 
 -- 'bol' state: beginning of a line.  Slurp up all the whitespace (including
 -- blank lines) until we find a non-whitespace character, then do layout
@@ -270 +280 @@
                                    { dispatch_pragmas fileHeaderPrags }
 
   "-- #"                           { multiline_doc_comment }
+  $mdash " #" / { ifExtension unicodeSyntaxEnabled } { multiline_doc_comment }
 }
 
 <0> {
@@ -280 +291 @@
 
 <0> {
   "-- #" .* { lineCommentToken }
+  $mdash " #" .* / { ifExtension unicodeSyntaxEnabled } { lineCommentToken }
 }
 
 <0,option_prags> {
@@ -293 +305 @@
 
 <0,option_prags> {
   "-- " $docsym      / { ifExtension haddockEnabled } { multiline_doc_comment }
+  $mdash " " $docsym       / { ifExtension haddockEnabled `aapAnd` ifExtension unicodeSyntaxEnabled } { multiline_doc_comment }
   "{-" \ ? $docsym   / { ifExtension haddockEnabled } { nested_doc_comment }
 }
 
@@ -783 +796 @@
 ifExtension :: (Int -> Bool) -> AlexAccPred Int
 ifExtension pred bits _ _ _ = pred bits
 
+aapAnd :: AlexAccPred Int -> AlexAccPred Int -> AlexAccPred Int
+aapAnd a b x y z w = a x y z w && b x y z w
+
 multiline_doc_comment :: Action
 multiline_doc_comment span buf _len = withLexedDocType (worker "")
   where
@@ -1610 +1626 @@
         symbol          = '\x4'
         space           = '\x5'
         other_graphic   = '\x6'
+        mdash_char      = '\x7'
 
         adj_c
-          | c <= '\x06' = non_graphic
+          | c <= '\x07' = non_graphic
           | c <= '\x7f' = c
+           | c == '—'    = mdash_char
           -- Alex doesn't handle Unicode, so when Unicode
           -- character is encountered we output these values
           -- with the actual character value hidden in the state.

compiler/rename/RnEnv.lhs

@@ -1085 +1085 @@
         ; return (mkUnboundName rdr_name) }
 
 unknownNameErr :: RdrName -> SDoc
-unknownNameErr rdr_name
-  = vcat [ hang (ptext (sLit "Not in scope:")) 
-              2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
-                          <+> quotes (ppr rdr_name))
-         , extra ]
+unknownNameErr rdr_name =
+                vcat [ hang (ptext (sLit "Not in scope:")) 
+                 2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
+                                  <+> quotes (ppr rdr_name))
+                 , extra ]
   where
     extra | rdr_name == forall_tv_RDR = perhapsForallMsg
+          | rdr_name == mkUnqual varName (fsLit "—") = perhapsUnicodeMsg
           | otherwise                 = empty
 
 type HowInScope = Either SrcSpan ImpDeclSpec
@@ -1339 +1340 @@
   = vcat [ ptext (sLit "Perhaps you intended to use -XExplicitForAll or similar flag")
          , ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")]
 
+perhapsUnicodeMsg :: SDoc
+perhapsUnicodeMsg
+        = ptext (sLit "Perhaps you intended to use -XUnicodeSyntax?")
+
 unknownSubordinateErr :: SDoc -> RdrName -> SDoc
 unknownSubordinateErr doc op    -- Doc is "method of class" or 
                                 -- "field of constructor"