shithub: MicroHs

Download patch

ref: 053395e9a32c8c94ca2fd847128847a4579eb600
parent: c101325aaf8ed0ec3c8c4ff4b7d425bba799825a
parent: 68db361d357d02a1616037a92b7be59cea625944
author: Lennart Augustsson <lennart@augustsson.net>
date: Wed Jan 8 05:19:10 EST 2025 

Merge pull request #83 from konsumlamm/report

Add some missing functions/instances from the report


--- a/lib/Control/Monad.hs
+++ b/lib/Control/Monad.hs
@@ -32,6 +32,8 @@
   liftM,
   liftM2,
   liftM3,
+  liftM4,
+  liftM5,
   ap,
   ) where
 import Prelude()              -- do not import Prelude
@@ -171,6 +173,10 @@
 liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) }
 liftM3 :: forall m r a1 a2 a3 . (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
 liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }
+liftM4 :: forall m r a1 a2 a3 a4 . (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
+liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }
+liftM5 :: forall m r a1 a2 a3 a4 a5 . (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
+liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }
 
 ap :: forall m a b . Monad m => m (a -> b) -> m a -> m b
 ap f a = do
--- a/lib/Data/Array.hs
+++ b/lib/Data/Array.hs
@@ -43,8 +43,8 @@
 instance (Ix a, Eq b)  => Eq (Array a b) where
   (==) (Array b1 _ a1) (Array b2 _ a2) = b1 == b2 && primArrEQ a1 a2
 
-instance (Ix a, Ord b) => Ord  (Array a b) where
-  compare = undefined
+instance (Ix a, Ord b) => Ord (Array a b) where
+  compare arr1 arr2 = compare (assocs arr1) (assocs arr2)
 
 instance (Ix a, Show a, Show b) => Show (Array a b) where
   showsPrec p a =
--- a/lib/Data/Char.hs
+++ b/lib/Data/Char.hs
@@ -87,6 +87,12 @@
 isAscii :: Char -> Bool
 isAscii c = c <= '\127'
 
+isControl :: Char -> Bool
+isControl c = c <= '\31' || c == '\127'
+
+isLetter :: Char -> Bool
+isLetter = isAlpha
+
 digitToInt :: Char -> Int
 digitToInt c | (primCharLE '0' c) && (primCharLE c '9') = ord c - ord '0'
              | (primCharLE 'a' c) && (primCharLE c 'f') = ord c - (ord 'a' - 10)
--- a/lib/Data/Enum.hs
+++ b/lib/Data/Enum.hs
@@ -40,6 +40,25 @@
     i_n1 = fromEnum n1
     i_n2 = fromEnum n2
 
+numericEnumFrom :: (Num a) => a -> [a]
+numericEnumFrom n = n : numericEnumFrom (n + 1)
+
+numericEnumFromThen :: (Num a) => a -> a -> [a]
+numericEnumFromThen n m = from n
+  where
+    d = m - n
+    from i = i : from (i + d)
+
+numericEnumFromTo :: (Num a, Ord a) => a -> a -> [a]
+numericEnumFromTo l h = takeWhile (<= h) (numericEnumFrom l)
+
+numericEnumFromThenTo :: (Num a, Ord a) => a -> a -> a -> [a]
+numericEnumFromThenTo l m h =
+    if m > l then
+      takeWhile (<= h) (numericEnumFromThen l m)
+    else
+      takeWhile (>= h) (numericEnumFromThen l m)
+
 -- This instance is difficult to put in Data.Int,
 -- so it gets to live here.
 instance Enum Int where
@@ -47,16 +66,10 @@
   pred x = x - 1
   toEnum x = x
   fromEnum x = x
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 -- Likewise for Bool
 instance Enum Bool where
--- a/lib/Data/Int/Instances.hs
+++ b/lib/Data/Int/Instances.hs
@@ -72,16 +72,10 @@
   pred x = x - 1
   toEnum = i8
   fromEnum = unI8
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 instance Eq Int8 where
   (==) = cmp8 primIntEQ
@@ -162,16 +156,10 @@
   pred x = x - 1
   toEnum = i16
   fromEnum = unI16
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 instance Eq Int16 where
   (==) = cmp16 primIntEQ
@@ -252,16 +240,10 @@
   pred x = x - 1
   toEnum = i32
   fromEnum = unI32
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 instance Eq Int32 where
   (==) = cmp32 primIntEQ
@@ -340,16 +322,10 @@
   pred x = x - 1
   toEnum = i64
   fromEnum = unI64
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 instance Eq Int64 where
   (==) = cmp64 primIntEQ
--- a/lib/Data/Integer.hs
+++ b/lib/Data/Integer.hs
@@ -93,16 +93,10 @@
   pred x = x - 1
   toEnum x = _intToInteger x
   fromEnum x = _integerToInt x
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 ------------------------------------------------
 
--- a/lib/Data/Ratio.hs
+++ b/lib/Data/Ratio.hs
@@ -9,6 +9,7 @@
   ) where
 import Prelude()              -- do not import Prelude
 import Data.Bool
+import Data.Enum
 import Data.Eq
 import Data.Fractional
 import Data.Function
@@ -42,6 +43,16 @@
 -- NOTE. Experimentally, we extend this with:
 --  x/0 ==  1/0 when x > 0
 --  x/0 == -1/0 when x < 0
+
+instance (Integral a) => Enum (Ratio a) where
+  succ x         = x + 1
+  pred x         = x - 1
+  toEnum         = fromIntegral
+  fromEnum       = fromInteger . truncate
+  enumFrom       = numericEnumFrom
+  enumFromThen   = numericEnumFromThen
+  enumFromTo     = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 instance forall a . Eq a => Eq (Ratio a) where
   (x :% y) == (x' :% y')  =  x == x' && y == y'
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -57,16 +57,10 @@
   pred x = x - 1
   toEnum = primIntToWord
   fromEnum = primWordToInt
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 --------------------------------
 
@@ -154,16 +148,10 @@
   pred x = x - 1
   toEnum = w8 . primIntToWord
   fromEnum = primWordToInt . unW8
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 instance Eq Word8 where
   (==) = cmp8 primWordEQ
@@ -245,17 +233,10 @@
   succ x = x + 1
   pred x = x - 1
   toEnum = w16 . primIntToWord
-  fromEnum = primWordToInt . unW16
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 instance Eq Word16 where
   (==) = cmp16 primWordEQ
@@ -338,16 +319,10 @@
   pred x = x - 1
   toEnum = w32 . primIntToWord
   fromEnum = primWordToInt . unW32
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 instance Eq Word32 where
   (==) = cmp32 primWordEQ
@@ -430,16 +405,10 @@
   pred x = x - 1
   toEnum = w64 . primIntToWord
   fromEnum = primWordToInt . unW64
-  enumFrom n = n : enumFrom (n+1)
-  enumFromThen n m = from n
-    where d = m - n
-          from i = i : from (i+d)
-  enumFromTo l h = takeWhile (<= h) (enumFrom l)
-  enumFromThenTo l m h =
-    if m > l then
-      takeWhile (<= h) (enumFromThen l m)
-    else
-      takeWhile (>= h) (enumFromThen l m)
+  enumFrom = numericEnumFrom
+  enumFromThen = numericEnumFromThen
+  enumFromTo = numericEnumFromTo
+  enumFromThenTo = numericEnumFromThenTo
 
 instance Eq Word64 where
   (==) = cmp64 primWordEQ
--- a/lib/System/Exit.hs
+++ b/lib/System/Exit.hs
@@ -11,7 +11,7 @@
 import System.IO
 
 data ExitCode = ExitSuccess | ExitFailure Int
-  deriving (Eq, Typeable, Show)
+  deriving (Eq, Ord, Typeable, Show)
 
 instance Exception ExitCode