Brandon Chinn pushed to branch wip/bchinn-cvtlit-exhaustive at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • compiler/GHC/ThToHs.hs
    ... ... @@ -1461,10 +1461,11 @@ cvtLit (BytesPrimL (Bytes fptr off sz)) = do
    1461 1461 
                  BS.packCStringLen (ptr `plusPtr` fromIntegral off, fromIntegral sz)
    1462 1462 
       force bs
    1463 1463 
       return $ HsStringPrim NoSourceText bs
    1464 
    -cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
    1465 
    -        -- cvtLit should not be called on IntegerL, RationalL
    1466 
    -        -- That precondition is established right here in
    1467 
    -        -- "GHC.ThToHs", hence panic
    1464 
    +-- cvtLit should not be called on IntegerL, RationalL
    1465 
    +-- That precondition is established right here in
    1466 
    +-- "GHC.ThToHs", hence panic
    1467 
    +cvtLit (IntegerL _) = panic "Convert.cvtLit: Unexpected literal"
    1468 
    +cvtLit (RationalL _) = panic "Convert.cvtLit: Unexpected literal"
    1468 1469
    1469 1470 
     quotedSourceText :: String -> SourceText
    1470 1471 
     quotedSourceText s = SourceText $ fsLit $ "\"" ++ s ++ "\""

  • compiler/Language/Haskell/Syntax/Lit.hs
    ... ... @@ -81,19 +81,30 @@ data HsLit x
    81 81 
       | XLit !(XXLit x)
    82 82
    83 83 
     instance (Eq (XXLit x)) => Eq (HsLit x) where
    84 
    -  (HsChar _ x1)       == (HsChar _ x2)       = x1==x2
    85 
    -  (HsCharPrim _ x1)   == (HsCharPrim _ x2)   = x1==x2
    86 
    -  (HsString _ x1)     == (HsString _ x2)     = x1==x2
    87 
    -  (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
    88 
    -  (HsInt _ x1)        == (HsInt _ x2)        = x1==x2
    89 
    -  (HsIntPrim _ x1)    == (HsIntPrim _ x2)    = x1==x2
    90 
    -  (HsWordPrim _ x1)   == (HsWordPrim _ x2)   = x1==x2
    91 
    -  (HsInt64Prim _ x1)  == (HsInt64Prim _ x2)  = x1==x2
    92 
    -  (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
    93 
    -  (HsFloatPrim _ x1)  == (HsFloatPrim _ x2)  = x1==x2
    94 
    -  (HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2
    95 
    -  (XLit x1)           == (XLit x2)           = x1==x2
    96 
    -  _                   == _                   = False
    84 
    +  HsChar _ x1       == HsChar _ x2       = x1 == x2
    85 
    +  HsChar{}          == _                 = False
    86 
    +  HsCharPrim _ x1   == HsCharPrim _ x2   = x1 == x2
    87 
    +  HsCharPrim{}      == _                 = False
    88 
    +  HsString _ x1     == HsString _ x2     = x1 == x2
    89 
    +  HsString{}        == _                 = False
    90 
    +  HsStringPrim _ x1 == HsStringPrim _ x2 = x1 == x2
    91 
    +  HsStringPrim{}    == _                 = False
    92 
    +  HsInt _ x1        == HsInt _ x2        = x1 == x2
    93 
    +  HsInt{}           == _                 = False
    94 
    +  HsIntPrim _ x1    == HsIntPrim _ x2    = x1 == x2
    95 
    +  HsIntPrim{}       == _                 = False
    96 
    +  HsWordPrim _ x1   == HsWordPrim _ x2   = x1 == x2
    97 
    +  HsWordPrim{}      == _                 = False
    98 
    +  HsInt64Prim _ x1  == HsInt64Prim _ x2  = x1 == x2
    99 
    +  HsInt64Prim{}     == _                 = False
    100 
    +  HsWord64Prim _ x1 == HsWord64Prim _ x2 = x1 == x2
    101 
    +  HsWord64Prim{}    == _                 = False
    102 
    +  HsFloatPrim _ x1  == HsFloatPrim _ x2  = x1 == x2
    103 
    +  HsFloatPrim{}     == _                 = False
    104 
    +  HsDoublePrim _ x1 == HsDoublePrim _ x2 = x1 == x2
    105 
    +  HsDoublePrim{}    == _                 = False
    106 
    +  XLit x1           == XLit x2           = x1 == x2
    107 
    +  XLit{}            == _                 = False
    97 108
    98 109 
     -- | Haskell Overloaded Literal
    99 110 
     data HsOverLit p
    ... ... @@ -114,18 +125,23 @@ data OverLitVal
    114 125 
       deriving Data
    115 126
    116 127 
     instance Eq OverLitVal where
    117 
    -  (HsIntegral   i1)   == (HsIntegral   i2)   = i1 == i2
    118 
    -  (HsFractional f1)   == (HsFractional f2)   = f1 == f2
    119 
    -  (HsIsString _ s1)   == (HsIsString _ s2)   = s1 == s2
    120 
    -  _                   == _                   = False
    128 
    +  HsIntegral   i1 == HsIntegral   i2 = i1 == i2
    129 
    +  HsIntegral{}    == _               = False
    130 
    +  HsFractional f1 == HsFractional f2 = f1 == f2
    131 
    +  HsFractional{}  == _               = False
    132 
    +  HsIsString _ s1 == HsIsString _ s2 = s1 == s2
    133 
    +  HsIsString{}    == _               = False
    121 134
    122 135 
     instance Ord OverLitVal where
    123 
    -  compare (HsIntegral i1)     (HsIntegral i2)     = i1 `compare` i2
    124 
    -  compare (HsIntegral _)      (HsFractional _)    = LT
    125 
    -  compare (HsIntegral _)      (HsIsString _ _)    = LT
    126 
    -  compare (HsFractional f1)   (HsFractional f2)   = f1 `compare` f2
    127 
    -  compare (HsFractional _)    (HsIntegral   _)    = GT
    128 
    -  compare (HsFractional _)    (HsIsString _ _)    = LT
    129 
    -  compare (HsIsString _ s1)   (HsIsString _ s2)   = s1 `lexicalCompareFS` s2
    130 
    -  compare (HsIsString _ _)    (HsIntegral   _)    = GT
    131 
    -  compare (HsIsString _ _)    (HsFractional _)    = GT
    136 
    +  -- HsIntegral
    137 
    +  HsIntegral i1 `compare` HsIntegral i2  = i1 `compare` i2
    138 
    +  HsIntegral{}  `compare` HsFractional{} = LT
    139 
    +  HsIntegral{}  `compare` HsIsString{}   = LT
    140 
    +  -- HsFractional
    141 
    +  HsFractional{}  `compare` HsIntegral{}    = GT
    142 
    +  HsFractional f1 `compare` HsFractional f2 = f1 `compare` f2
    143 
    +  HsFractional{}  `compare` HsIsString{}    = LT
    144 
    +  -- HsIsString
    145 
    +  HsIsString{}    `compare` HsIntegral{}    = GT
    146 
    +  HsIsString{}    `compare` HsFractional{}  = GT
    147 
    +  HsIsString _ s1 `compare` HsIsString _ s2 = s1 `lexicalCompareFS` s2

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help