Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC
Commits:
-
c3c6efeb
by Wolfgang Jeltsch at 2026-04-08T16:28:18+03:00
2 changed files:
Changes:
| ... | ... | @@ -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 |
| ... | ... | @@ -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
|