Ticket #5239: mdash.patch

File mdash.patch, 5.1 KB (added by porges, 3 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"