Ticket #7266: NumDecimals.patch

File NumDecimals.patch, 2.1 KB (added by shachaf, 19 months ago)
  • compiler/main/DynFlags.hs

    diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
    index 080539a..bf8fec7 100644
    a b data ExtensionFlag 
    452452   | Opt_BangPatterns 
    453453   | Opt_TypeFamilies 
    454454   | Opt_OverloadedStrings 
     455   | Opt_NumDecimals 
    455456   | Opt_DisambiguateRecordFields 
    456457   | Opt_RecordWildCards 
    457458   | Opt_RecordPuns 
    xFlags = [ 
    23972398    deprecatedForExtension "NamedFieldPuns" ), 
    23982399  ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields, nop ), 
    23992400  ( "OverloadedStrings",                Opt_OverloadedStrings, nop ), 
     2401  ( "NumDecimals",                      Opt_NumDecimals, nop ), 
    24002402  ( "GADTs",                            Opt_GADTs, nop ), 
    24012403  ( "GADTSyntax",                       Opt_GADTSyntax, nop ), 
    24022404  ( "ViewPatterns",                     Opt_ViewPatterns, nop ), 
  • compiler/rename/RnPat.lhs

    diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
    index e37860a..405e4c7 100644
    a b import SrcLoc 
    6161import FastString 
    6262import Literal          ( inCharRange ) 
    6363import Control.Monad    ( when ) 
     64import Data.Ratio 
    6465\end{code} 
    6566 
    6667 
    rnLit :: HsLit -> RnM () 
    607608rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c) 
    608609rnLit _ = return () 
    609610 
     611-- Turn a Fractional-looking literal which happens to be an integer into an 
     612-- Integer-looking literal. 
     613generalizeOverLitVal :: OverLitVal -> OverLitVal 
     614generalizeOverLitVal (HsFractional (FL {fl_value=val})) 
     615    | denominator val == 1 = HsIntegral (numerator val) 
     616generalizeOverLitVal lit = lit 
     617 
    610618rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars) 
    611 rnOverLit lit@(OverLit {ol_val=val}) 
    612   = do  { let std_name = hsOverLitName val 
     619rnOverLit origLit 
     620  = do  { opt_NumDecimals <- xoptM Opt_NumDecimals 
     621        ; let { lit@(OverLit {ol_val=val}) 
     622            | opt_NumDecimals = origLit {ol_val = generalizeOverLitVal (ol_val origLit)} 
     623            | otherwise       = origLit 
     624          } 
     625        ; let std_name = hsOverLitName val 
    613626        ; (from_thing_name, fvs) <- lookupSyntaxName std_name 
    614627        ; let rebindable = case from_thing_name of 
    615628                                HsVar v -> v /= std_name