shithub: MicroHs

Download patch

ref: 392a92e391d27510e076d3c337425e572e1d6716
parent: 4b77541001916182ec3fa44992164dc975010657
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Mon Feb 5 14:54:34 EST 2024

More Read

--- a/lib/Data/Double.hs
+++ b/lib/Data/Double.hs
@@ -5,11 +5,13 @@
 import Control.Error
 import Data.Bits
 import Data.Bool
+import Data.Char
 import Data.Eq
 import Data.Floating
 import Data.Fractional
 import Data.Function
 import Data.Integer
+import Data.List
 import Data.Ord
 import Data.Ratio
 import Data.Real
@@ -16,6 +18,8 @@
 import Data.RealFloat
 import Data.Num
 import Data.Word
+import Text.Read
+import Text.Read.Numeric
 import Text.Show
 
 --
@@ -55,6 +59,9 @@
 -- For now, cheat and call C
 instance Show Double where
   show = primDoubleShow
+
+instance Read Double where
+  readsPrec _ = readSigned $ \ r -> [ (primDoubleRead s, t) | (s@(c:_), t) <- lex r, isDigit c ]
 
 instance Real Double where
   toRational x =
--- a/lib/Numeric.hs
+++ b/lib/Numeric.hs
@@ -1,24 +1,22 @@
 module Numeric(
   showSigned,
-    showIntAtBase,
-    showInt,
-    showBin,
-    showHex,
-    showOct,
-    showIntegral,
+  showIntAtBase,
+  showInt,
+  showBin,
+  showHex,
+  showOct,
+  showIntegral,
     
-    readSigned,
-    readInt,
-    readBin,
-    readDec,
-    readOct,
-    readHex,
-    readIntegral,
-    ) where
+  readSigned,
+  readInt,
+  readBin,
+  readDec,
+  readOct,
+  readHex,
+  readIntegral,
+  ) where
 import Primitives
 import Control.Error
-import Control.Monad
-import Control.Monad.Fail
 import Data.Bool
 import Data.Char
 import Data.Eq
@@ -27,56 +25,8 @@
 import Data.List
 import Data.Num
 import Data.Ord
-import Text.Read(ReadS, readParen)
+import Text.Read.Numeric
 import Text.Show(ShowS, showChar)
-
-readInt :: forall a . Num a => a -> (Char -> Bool)  -> (Char -> Int) -> ReadS a
-readInt base isDig valDig s = do
-  (c, cs) <- lex s
-  guard (isDig c)
-  let loop r (c:cs) | isDig c = loop (r * base + fromIntegral (valDig c)) cs
-      loop r ds = return (r, ds)
-  loop 0 (c:cs)
-
-readBin :: forall a . (Num a) => ReadS a
-readBin = readInt 2 isBinDigit digitToInt
-
-isBinDigit :: Char -> Bool
-isBinDigit c = c `primCharEQ` '0' || c `primCharEQ` '1'
-
-readOct :: forall a . (Num a) => ReadS a
-readOct = readInt 8 isOctDigit digitToInt
-
-readDec :: forall a . (Num a) => ReadS a
-readDec = readInt 10 isDigit digitToInt
-
-readHex :: forall a . (Num a) => ReadS a
-readHex = readInt 16 isDigit digitToInt
-
-readSigned :: forall a . (Num a) => ReadS a -> ReadS a
-readSigned readPos = readParen False read'
-  where
-    read' :: ReadS a
-    read' r  = readPos r ++
-                do
-                  ('-',s) <- lex r
-                  (x, t) <- readPos s
-                  return (- x, t)
-
-readIntegral :: forall a . (Integral a) => Int -> ReadS a
-readIntegral _ = readSigned readAny
-  where readAny ('0':'x':cs) = readHex cs            -- XXX not quite right, allows space after 'x'
-        readAny ('0':'o':cs) = readOct cs            -- XXX not quite right, allows space after 'x'
-        readAny ('0':'b':cs) = readBin cs            -- XXX not quite right, allows space after 'x'
-        readAny cs = readDec cs
-
--- Really bad lexer
-lex :: ReadS Char
-lex "" = []
-lex (c:cs) | isSpace c = lex cs
-           | True = [(c, cs)]
-
--------------------------------------------------------------------------------
 
 showSigned :: forall a . (Ord a, Integral a) => (a -> ShowS) -> Int -> a -> ShowS
 showSigned showPos p n r
--- a/lib/Text/Read.hs
+++ b/lib/Text/Read.hs
@@ -20,6 +20,7 @@
 import Data.Maybe_Type
 import Data.Num
 import Data.Int
+import Text.Read.Numeric
 import Text.Read.Lex
 
 type ReadS a = String -> [(a, String)]
@@ -28,7 +29,7 @@
   readsPrec    :: Int -> ReadS a
   readList     :: ReadS [a]
 
-  readList = readParen False (\r -> [pr
+  readList = readParen False (\r -> [ pr
                                     | ("[",s) <- lex r
                                     , pr <- readl s])
     where readl  s = [([],t)   | ("]",t)  <- lex s] ++
@@ -42,13 +43,6 @@
 reads :: forall a . Read a => ReadS a
 reads = readsPrec 0
 
-readParen :: forall a . Bool -> ReadS a -> ReadS a  
-readParen b g =  if b then mandatory else optional  
-  where optional r  = g r ++ mandatory r  
-        mandatory r = [(x,u) | ("(",s) <- lex r,  
-                               (x,t)   <- optional s,  
-                               (")",u) <- lex t ]
-
 read :: forall a . Read a => String -> a
 read s =
   case readMaybe s of
@@ -65,13 +59,7 @@
 -- To avoid circular imports, some instances go here.
 
 instance Read Int where
-  readsPrec _ = readParen False $ \ s ->
-    [ ( i, t) |                   (cs@(c:_), t) <- lex s, isDigit c, i <- loop 0 cs] ++
-    [ (-i, t) | ("-",r) <- lex s, (cs@(c:_), t) <- lex r, isDigit c, i <- loop 0 cs]
-   where
-      loop res (c:cs) | isDigit c = loop (res * (10::Int) + ord c - ord '0') cs
-      loop res [] = [res]
-      loop _ _ = []
+  readsPrec = readIntegral
 
 instance forall a . Read a => Read [a] where
   readsPrec _ = readList
--- a/lib/Text/String.hs
+++ b/lib/Text/String.hs
@@ -21,9 +21,6 @@
 import Text.Read
 import Text.Show
 
-readDouble :: String -> Double
-readDouble = primDoubleRead
-
 showListS :: forall a . (a -> String) -> [a] -> String
 showListS sa as = showListWith (\ a s -> sa a ++ s) as ""
 
--- a/tests/Read.hs
+++ b/tests/Read.hs
@@ -9,6 +9,9 @@
   print (read "123 "  :: Int)
   print (read "-123"  :: Int)
   print (read "(123)" :: Int)
+  print (read "0x7b"  :: Int)
+  print (read "0o173" :: Int)
+  print (read "0b01111011" :: Int)
   print (read "2147483647" :: Int)
   print (read "-2147483648" :: Int)
   if _wordSize == 64 then do
@@ -29,3 +32,8 @@
   print (reads "123 4" :: [(Int, String)])
   print (readMaybe "123" :: Maybe Int)
   print (readMaybe "apa" :: Maybe Int)
+  print (read "1.25" :: Double)
+  print (read "-1e20" :: Double)
+  print (read "-1e+5" :: Double)
+  print (read "1.5e+5" :: Double)
+  print (read "5e-1" :: Double)
--- a/tests/Read.ref
+++ b/tests/Read.ref
@@ -3,6 +3,9 @@
 123
 -123
 123
+123
+123
+123
 2147483647
 -2147483648
 9223372036854775807
@@ -19,3 +22,8 @@
 [(123," 4")]
 Just 123
 Nothing
+1.25
+-1e+20
+-100000.0
+150000.0
+0.5
--