Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC

Commits:

6 changed files:

Changes:

  • libraries/base/src/Data/Data.hs
    ... ... @@ -99,3 +99,38 @@ module Data.Data (
    99 99
    100 100 
     import GHC.Internal.Data.Data
    101 101 
     import Data.Typeable
    102 
    +
    103 
    +import GHC.Real (toRational)
    104 
    +import GHC.Float (Double)
    105 
    +import Data.Eq ((==))
    106 
    +import Data.Function ((.))
    107 
    +import Data.Maybe (Maybe (Nothing, Just))
    108 
    +import Data.List (filter)
    109 
    +import Data.String (String)
    110 
    +import Text.Read (Read, reads)
    111 
    +
    112 
    +-- | Lookup a constructor via a string
    113 
    +readConstr :: DataType -> String -> Maybe Constr
    114 
    +readConstr dt str =
    115 
    +      case dataTypeRep dt of
    116 
    +        AlgRep cons -> idx cons
    117 
    +        IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
    118 
    +        FloatRep    -> mkReadCon ffloat
    119 
    +        CharRep     -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
    120 
    +        NoRep       -> Nothing
    121 
    +  where
    122 
    +
    123 
    +    -- Read a value and build a constructor
    124 
    +    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
    125 
    +    mkReadCon f = case (reads str) of
    126 
    +                    [(t,"")] -> Just (f t)
    127 
    +                    _ -> Nothing
    128 
    +
    129 
    +    -- Traverse list of algebraic datatype constructors
    130 
    +    idx :: [Constr] -> Maybe Constr
    131 
    +    idx cons = case filter ((==) str . showConstr) cons of
    132 
    +                [] -> Nothing
    133 
    +                hd : _ -> Just hd
    134 
    +
    135 
    +    ffloat :: Double -> Constr
    136 
    +    ffloat =  mkPrimCon dt str . FloatConstr . toRational

  • libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
    ... ... @@ -61,6 +61,7 @@ module GHC.Internal.Data.Data (
    61 61 
             mkIntType,
    62 62 
             mkFloatType,
    63 63 
             mkCharType,
    64 
    +        mkPrimCon,
    64 65 
             mkNoRepType,
    65 66 
             -- ** Observers
    66 67 
             dataTypeName,
    ... ... @@ -94,7 +95,6 @@ module GHC.Internal.Data.Data (
    94 95 
             constrIndex,
    95 96 
             -- ** From strings to constructors and vice versa: all data types
    96 97 
             showConstr,
    97 
    -        readConstr,
    98 98
    99 99 
             -- * Convenience functions: take type constructors apart
    100 100 
             tyconUQname,
    ... ... @@ -126,10 +126,8 @@ import GHC.Internal.Base (
    126 126 
     import GHC.Internal.Err (errorWithoutStackTrace)
    127 127 
     import GHC.Internal.List
    128 128 
     import GHC.Internal.Num
    129 
    -import GHC.Internal.Read
    130 129 
     import GHC.Internal.Show
    131 130 
     import GHC.Internal.Tuple (Solo (..))
    132 
    -import GHC.Internal.Text.Read( reads )
    133 131 
     import GHC.Internal.Types (
    134 132 
         Bool(..), Char, Coercible, Float, Double, Type, type (~), type (~~),
    135 133 
       )
    ... ... @@ -688,32 +686,6 @@ showConstr :: Constr -> String
    688 686 
     showConstr = constring
    689 687
    690 688
    691 
    --- | Lookup a constructor via a string
    692 
    -readConstr :: DataType -> String -> Maybe Constr
    693 
    -readConstr dt str =
    694 
    -      case dataTypeRep dt of
    695 
    -        AlgRep cons -> idx cons
    696 
    -        IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
    697 
    -        FloatRep    -> mkReadCon ffloat
    698 
    -        CharRep     -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
    699 
    -        NoRep       -> Nothing
    700 
    -  where
    701 
    -
    702 
    -    -- Read a value and build a constructor
    703 
    -    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
    704 
    -    mkReadCon f = case (reads str) of
    705 
    -                    [(t,"")] -> Just (f t)
    706 
    -                    _ -> Nothing
    707 
    -
    708 
    -    -- Traverse list of algebraic datatype constructors
    709 
    -    idx :: [Constr] -> Maybe Constr
    710 
    -    idx cons = case filter ((==) str . showConstr) cons of
    711 
    -                [] -> Nothing
    712 
    -                hd : _ -> Just hd
    713 
    -
    714 
    -    ffloat :: Double -> Constr
    715 
    -    ffloat =  mkPrimCon dt str . FloatConstr . toRational
    716 
    -
    717 689 
     ------------------------------------------------------------------------------
    718 690 
     --
    719 691 
     --      Convenience functions: algebraic data types

  • testsuite/tests/interface-stability/base-exports.stdout
    ... ... @@ -12545,13 +12545,12 @@ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.S
    12545 12545 
     instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
    12546 12546 
     instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
    12547 12547 
     instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
    12548 
    -instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12549 12548 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
    12550 12549 
     instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
    12551 12550 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
    12552 12551 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
    12553 12552 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
    12554 
    -instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12553 
    +instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12555 12554 
     instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
    12556 12555 
     instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
    12557 12556 
     instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Real.Fractional (f (g a)) => GHC.Internal.Real.Fractional (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’

  • testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
    ... ... @@ -12574,13 +12574,12 @@ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.S
    12574 12574 
     instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
    12575 12575 
     instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
    12576 12576 
     instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
    12577 
    -instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12578 12577 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
    12579 12578 
     instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
    12580 12579 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
    12581 12580 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
    12582 12581 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
    12583 
    -instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12582 
    +instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12584 12583 
     instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
    12585 12584 
     instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
    12586 12585 
     instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Real.Fractional (f (g a)) => GHC.Internal.Real.Fractional (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’

  • testsuite/tests/interface-stability/base-exports.stdout-mingw32
    ... ... @@ -12817,13 +12817,12 @@ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.S
    12817 12817 
     instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
    12818 12818 
     instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
    12819 12819 
     instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
    12820 
    -instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12821 12820 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
    12822 12821 
     instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
    12823 12822 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
    12824 12823 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
    12825 12824 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
    12826 
    -instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12825 
    +instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12827 12826 
     instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
    12828 12827 
     instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
    12829 12828 
     instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Real.Fractional (f (g a)) => GHC.Internal.Real.Fractional (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’

  • testsuite/tests/interface-stability/base-exports.stdout-ws-32
    ... ... @@ -12545,13 +12545,12 @@ instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.S
    12545 12545 
     instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
    12546 12546 
     instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
    12547 12547 
     instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
    12548 
    -instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12549 12548 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
    12550 12549 
     instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
    12551 12550 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
    12552 12551 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
    12553 12552 
     instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
    12554 
    -instance forall a k (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12553 
    +instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
    12555 12554 
     instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
    12556 12555 
     instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
    12557 12556 
     instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Internal.Real.Fractional (f (g a)) => GHC.Internal.Real.Fractional (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’

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