Ticket #5239: mdash.patch

File mdash.patch, 5.1 KB (added by porges, 4 years ago)

patch

  • compiler/parser/Lexer.x

    diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
    index 43be73f..d61cc75 100644
    a b $small = [$ascsmall $unismall \_] 
    110110$unigraphic = \x06 -- Trick Alex into handling Unicode. See alexGetChar.
    111111$graphic   = [$small $large $symbol $digit $special $unigraphic \:\"\']
    112112
     113$mdash     = \x07 -- Trick Alex into handling Unicode. See alexGetChar.
     114
    113115$octit     = 0-7
    114116$hexit     = [$decdigit A-F a-f]
    115117$symchar   = [$symbol \:]
    $tab+ { warn Opt_WarnTabs (text "Warning: Tab character") } 
    172174"-- " ~[$docsym \#] .* { lineCommentToken }
    173175"--" [^$symbol : \ ] .* { lineCommentToken }
    174176
     177-- Ditto, for unicode syntax:
     178
     179$mdash " " ~[$docsym \#] .* / { ifExtension unicodeSyntaxEnabled } { lineCommentToken }
     180$mdash [^$symbol : \ ] .* / { ifExtension unicodeSyntaxEnabled } { lineCommentToken }
     181
    175182-- Next, match Haddock comments if no -haddock flag
    176183
    177184"-- " [$docsym \#] .* / { ifExtension (not . haddockEnabled) } { lineCommentToken }
     185$mdash " " [$docsym \#] .* / { ifExtension (not . haddockEnabled) `aapAnd` ifExtension unicodeSyntaxEnabled } { lineCommentToken }
    178186
    179187-- Now, when we've matched comments that begin with 2 dashes and continue
    180188-- with a different character, we need to match comments that begin with three
    $tab+ { warn Opt_WarnTabs (text "Warning: Tab character") } 
    188196-- character, we also need to match a whole line filled with just dashes.
    189197
    190198"--"\-* / { atEOL } { lineCommentToken }
     199$mdash $mdash* / { atEOL `aapAnd` ifExtension unicodeSyntaxEnabled } { lineCommentToken }
    191200
    192201-- We need this rule since none of the other single line comment rules
    193202-- actually match this case.
    194203
    195204"-- " / { atEOL } { lineCommentToken }
     205$mdash " " / { atEOL `aapAnd` ifExtension unicodeSyntaxEnabled } { lineCommentToken }
    196206
    197207-- 'bol' state: beginning of a line.  Slurp up all the whitespace (including
    198208-- blank lines) until we find a non-whitespace character, then do layout
    $tab+ { warn Opt_WarnTabs (text "Warning: Tab character") } 
    270280                                   { dispatch_pragmas fileHeaderPrags }
    271281
    272282  "-- #"                           { multiline_doc_comment }
     283  $mdash " #" / { ifExtension unicodeSyntaxEnabled } { multiline_doc_comment }
    273284}
    274285
    275286<0> {
    $tab+ { warn Opt_WarnTabs (text "Warning: Tab character") } 
    280291
    281292<0> {
    282293  "-- #" .* { lineCommentToken }
     294  $mdash " #" .* / { ifExtension unicodeSyntaxEnabled } { lineCommentToken }
    283295}
    284296
    285297<0,option_prags> {
    $tab+ { warn Opt_WarnTabs (text "Warning: Tab character") } 
    293305
    294306<0,option_prags> {
    295307  "-- " $docsym      / { ifExtension haddockEnabled } { multiline_doc_comment }
     308  $mdash " " $docsym       / { ifExtension haddockEnabled `aapAnd` ifExtension unicodeSyntaxEnabled } { multiline_doc_comment }
    296309  "{-" \ ? $docsym   / { ifExtension haddockEnabled } { nested_doc_comment }
    297310}
    298311
    atEOL _ _ _ (AI _ buf) = atEnd buf || currentChar buf == '\n' 
    783796ifExtension :: (Int -> Bool) -> AlexAccPred Int
    784797ifExtension pred bits _ _ _ = pred bits
    785798
     799aapAnd :: AlexAccPred Int -> AlexAccPred Int -> AlexAccPred Int
     800aapAnd a b x y z w = a x y z w && b x y z w
     801
    786802multiline_doc_comment :: Action
    787803multiline_doc_comment span buf _len = withLexedDocType (worker "")
    788804  where
    alexGetByte (AI loc s) 
    16101626        symbol          = '\x4'
    16111627        space           = '\x5'
    16121628        other_graphic   = '\x6'
     1629        mdash_char      = '\x7'
    16131630
    16141631        adj_c
    1615           | c <= '\x06' = non_graphic
     1632          | c <= '\x07' = non_graphic
    16161633          | c <= '\x7f' = c
     1634           | c == '—'    = mdash_char
    16171635          -- Alex doesn't handle Unicode, so when Unicode
    16181636          -- character is encountered we output these values
    16191637          -- with the actual character value hidden in the state.
  • compiler/rename/RnEnv.lhs

    diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
    index 9771ab1..37f0a61 100644
    a b unboundName where_look rdr_name 
    10851085        ; return (mkUnboundName rdr_name) }
    10861086
    10871087unknownNameErr :: RdrName -> SDoc
    1088 unknownNameErr rdr_name
    1089   = vcat [ hang (ptext (sLit "Not in scope:"))
    1090               2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
    1091                           <+> quotes (ppr rdr_name))
    1092         , extra ]
     1088unknownNameErr rdr_name =
     1089                vcat [ hang (ptext (sLit "Not in scope:"))
     1090                 2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
     1091                                  <+> quotes (ppr rdr_name))
     1092                , extra ]
    10931093  where
    10941094    extra | rdr_name == forall_tv_RDR = perhapsForallMsg
     1095          | rdr_name == mkUnqual varName (fsLit "—") = perhapsUnicodeMsg
    10951096          | otherwise                 = empty
    10961097
    10971098type HowInScope = Either SrcSpan ImpDeclSpec
    perhapsForallMsg 
    13391340  = vcat [ ptext (sLit "Perhaps you intended to use -XExplicitForAll or similar flag")
    13401341         , ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")]
    13411342
     1343perhapsUnicodeMsg :: SDoc
     1344perhapsUnicodeMsg
     1345        = ptext (sLit "Perhaps you intended to use -XUnicodeSyntax?")
     1346
    13421347unknownSubordinateErr :: SDoc -> RdrName -> SDoc
    13431348unknownSubordinateErr doc op    -- Doc is "method of class" or
    13441349                                -- "field of constructor"