ref: 7e3092ebb2672a8cfaf0f2ed95c283fd41bf263d
parent: e3da74f84da2a17e8f9528eb1d1b139482b3c167
author: Lennart Augustsson <lennart@augustsson.net>
date: Fri Nov 3 04:43:31 EDT 2023
Add Bounded class
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,7 @@
BOOTDIR=ghc-boot
OUTDIR=ghc-out
TOOLS=Tools
-PROF= #-prof -fprof-auto
+PROF= -prof -fprof-late #-prof -fprof-auto
EXTS= -XScopedTypeVariables -XTupleSections
GHCB=ghc $(PROF) -outputdir $(BOOTDIR)
GHCFLAGS=-i -ighc -ilib -i$(BOOTDIR) -hide-all-packages -XNoImplicitPrelude -XRebindableSyntax $(EXTS) -F -pgmF $(TOOLS)/convertY.sh
@@ -56,6 +56,7 @@
$(GHCC) -c lib/Control/Error.hs
$(GHCC) -c lib/Data/Eq.hs
$(GHCC) -c lib/Text/Show.hs
+ $(GHCC) -c lib/Data/Bounded.hs
$(GHCC) -c lib/Data/Ord.hs
$(GHCC) -c lib/Data/Bool.hs
$(GHCC) -c lib/Data/Function.hs
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.0
-1261
-((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _122) ((B _12) _1)) _287))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _286))) ((A :10 (((S' P) _2) (((C' _13) _1) _1021))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _119) _12) _111))) ((A :20 (((S' B) _14) (((C' _122) _12) _112))) ((A :21 _1094) ((A :22 ((B _1137) _21)) ((A :23 (((S' _1137) _21) I)) ((A :24 _1064) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1093) ((C _110) _26))) ((A :28 (((C' _27) ((_118 _1107) _91)) ((_110 (_34 _1109)) _90))) ((A :29 ((B ((S _1137) (_34 _1109))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _286)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _287)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1021)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1021))) ((A :46 ((C _43) _111)) ((A :47 ((B _113) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _113) _48)) ((A :50 T) ((A :51 ((_117 ((B (B (_108 _50))) ((B ((C' C) _54)) (B P)))) (_121 _51))) ((A :52 (((((_11 _51) ((B (_108 _50)) P)) (_38 _53)) ((B (B (_108 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_108 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_110 _341)) _54)) ((A :56 ((B (_108 _50)) (B (P _1021)))) ((A :57 ((B (_108 _50)) (BK (P _1021)))) ((A :58 ((_108 _50) ((S P) I))) ((A :59 ((B (_108 _50)) ((C (S' P)) I))) ((A :60 ((_95 ((C ((C S') _64)) I)) (_99 _60))) ((A :61 (((_1235 (K ((P (_1244 "False")) (_1244 "True")))) (_1240 _61)) (_1241 _61))) ((A :62 (R _67)) ((A :63 (T _66)) ((A :64 ((P _67) _66)) ((A :65 _67) ((A :66 K) ((A :67 A) ((A :68 ((_95 _1058) _1059)) ((A :69 ((((((((_319 _68) (_328 _69)) _1060) _1061) _1062) _1063) (_333 _69)) (_334 _69))) ((A :70 ((_95 _1068) (_99 _70))) ((A :71 ((((((((_319 _70) _1067) (((C' (C' (_96 _335))) _1067) _338)) (((C' (C' (_97 _335))) _1067) _340)) (((C' (C' (_96 _335))) _1067) _340)) (((C' (C' (_97 _335))) _1067) _340)) (_333 _71)) (_334 _71))) ((A :72 _1069) ((A :73 _1070) ((A :74 (((S' _63) (_1061 #97)) ((C _1061) #122))) ((A :75 (((S' _63) (_1061 #65)) ((C _1061) #90))) ((A :76 (((S' _62) _74) _75)) ((A :77 (((S' _63) (_1061 #48)) ((C _1061) #57))) ((A :78 (((S' _62) _76) _77)) ((A :79 (((S' _63) (_1061 #32)) ((C _1061) #126))) ((A :80 (((S' _62) ((C (_96 _68)) #32)) (((S' _62) ((C (_96 _68)) #9)) ((C (_96 _68)) #10)))) ((A :81 ((S ((S (((S' _63) (_1061 #65)) ((C _1061) #90))) (_67 (((noMatch "lib/Data/Char.hs") #80) #9)))) ((B _72) (((C' (_304 _123)) (((C' (_305 _123)) _73) (_73 #65))) (_73 #97))))) ((A :82 ((S ((S (((S' _63) (_1061 #97)) ((C _1061) #97))) (_67 (((noMatch "lib/Data/Char.hs") #84) #9)))) ((B _72) (((C' (_304 _123)) (((C' (_305 _123)) _73) (_73 #97))) (_73 #65))))) ((A :83 (((_1235 (K ((C ((S ((C ==) #39)) ((B (_110 (_1243 #39))) (((C' _110) ((B _1244) _84)) (_1243 #39))))) (_1244 "'\92&''")))) (_1240 _83)) ((B (_110 (_1243 #34))) (Y ((B (P (_1243 #34))) (((S' C) ((B ((S' S') ((C (_96 _68)) #34))) ((C' B) ((B _110) ((B _1244) _84))))) (B (_110 (_1244 "\92&\34&"))))))))) ((A :84 (((C' Y) (((S' B) ((B P) ((S ((S _79) ((B (_288 "'\92&")) (((C' _288) ((B (_1237 _127)) _7
\ No newline at end of file
+1274
+((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _129) ((B _12) _1)) _294))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _293))) ((A :10 (((S' P) _2) (((C' _13) _1) _1034))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _126) _12) _118))) ((A :20 (((S' B) _14) (((C' _129) _12) _119))) ((A :21 _1107) ((A :22 ((B _1150) _21)) ((A :23 (((S' _1150) _21) I)) ((A :24 _1077) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1106) ((C _117) _26))) ((A :28 (((C' _27) ((_125 _1120) _98)) ((_117 (_34 _1122)) _97))) ((A :29 ((B ((S _1150) (_34 _1122))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _293)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _294)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1034)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1034))) ((A :46 ((C _43) _118)) ((A :47 ((B _120) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _120) _48)) ((A :50 T) ((A :51 ((_124 ((B (B (_115 _50))) ((B ((C' C) _54)) (B P)))) (_128 _51))) ((A :52 (((((_11 _51) ((B (_115 _50)) P)) (_38 _53)) ((B (B (_115 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_115 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_117 _349)) _54)) ((A :56 ((B (_115 _50)) (B (P _1034)))) ((A :57 ((B (_115 _50)) (BK (P _1034)))) ((A :58 ((_115 _50) ((S P) I))) ((A :59 ((B (_115 _50)) ((C (S' P)) I))) ((A :60 ((_102 ((C ((C S') _65)) I)) (_106 _60))) ((A :61 (((_1248 (K ((P (_1257 "False")) (_1257 "True")))) (_1253 _61)) (_1254 _61))) ((A :62 ((_69 _67) _68)) ((A :63 (R _68)) ((A :64 (T _67)) ((A :65 ((P _68) _67)) ((A :66 _68) ((A :67 K) ((A :68 A) ((A :69 P) ((A :70 (T K)) ((A :71 (T A)) ((A :72 (K (noDefault "Bounded.minBound"))) ((A :73 (K (noDefault "Bounded.maxBound"))) ((A :74 ((_102 _1071) _1072)) ((A :75 ((((((((_326 _74) (_335 _75)) _1073) _1074) _1075) _1076) (_340 _75)) (_341 _75))) ((A :76 ((_102 _1081) (_106 _76))) ((A :77 ((((((((_326 _76) _1080) (((C' (C' (_103 _342))) _1080) _346)) (((C' (C' (_104 _342))) _1080) _348)) (((C' (C' (_103 _342))) _1080) _348)) (((C' (C' (_104 _342))) _1080) _348)) (_340 _77)) (_341 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1082) ((A :80 _1083) ((A :81 (((S' _64) (_1074 #97)) ((C _1074) #122))) ((A :82 (((S' _64) (_1074 #65)) ((C _1074) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1074 #48)) ((C _1074) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1074 #32)) ((C _1074) #126))) ((A :87 (((S' _63) ((C (_103 _74)) #32)) (((S' _63) ((C (_103 _74)) #9)) ((C (_103 _74)) #10)))) ((A :88 ((S ((S (((S' _64) (_1074 #65)) ((C _1074) #90))) (_68 (((noMatch "lib/Data/Char.hs") #86) #9)))) ((B _79) (((C' (_311 _130)) (((C' (_312 _130)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1074 #97)) ((C _1074) #97))) (_68 (((noMatch "lib/Data/Char.hs") #90) #9)))) ((B _79) (((C' (_311 _130)) (((C' (_312 _130)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1248 (K ((C ((S ((C ==) #39)) ((B (_117 (_1256 #39))) (((C' _117) ((B _1257) _91)) (_1256 #39))))) (_1257 "'\92&''")))) (_1253 _90)) ((B (_117 (_1256 #34))) (Y ((B (P (_1256 #34))) (((S' C) ((B
\ No newline at end of file
--- a/lib/Data/Bool.hs
+++ b/lib/Data/Bool.hs
@@ -6,6 +6,7 @@
) where
import Primitives
import Data.Bool_Type
+import Data.Bounded
import Data.Eq
import Text.Show
@@ -16,6 +17,10 @@
instance Show Bool where
showsPrec _ False = showString "False"
showsPrec _ True = showString "True"
+
+instance Bounded Bool where
+ minBound = False
+ maxBound = True
infixr 2 ||
(||) :: Bool -> Bool -> Bool
--- a/lib/Data/Char.hs
+++ b/lib/Data/Char.hs
@@ -6,6 +6,7 @@
) where
import Primitives
import Data.Bool
+import Data.Bounded
import Data.Char_Type
import Data.Eq
import Data.Function
@@ -34,6 +35,11 @@
x <= y = primCompare x y /= GT
x > y = primCompare x y == GT
x >= y = primCompare x y /= GT
+
+-- ASCII only for now
+instance Bounded Char where
+ minBound = chr 0
+ maxBound = chr 127
chr :: Int -> Char
chr = primChr
--- a/lib/Data/Int.hs
+++ b/lib/Data/Int.hs
@@ -3,6 +3,7 @@
module Data.Int(module Data.Int, Int) where
import Primitives
import Data.Bool_Type
+import Data.Bounded
import Data.Char_Type
import Data.Eq
import Data.Integral
@@ -24,19 +25,15 @@
GT -> 1
fromInt x = x
-{---- Arithmetic
-(+) :: Int -> Int -> Int
-(+) = primIntAdd
-(-) :: Int -> Int -> Int
-(-) = primIntSub
-(*) :: Int -> Int -> Int
-(*) = primIntMul
--}
-
instance Integral Int where
quot = primIntQuot
rem = primIntRem
+
+{-+instance Bounded Int where
+ minBound = -9223372036854775808 -- -2^63
+ maxBound = 9223372036854775807 -- 2^63-1
+-}
--------------------------------
--- a/lib/Data/Ord.hs
+++ b/lib/Data/Ord.hs
@@ -4,6 +4,7 @@
) where
import Primitives
import Data.Bool_Type
+import Data.Bounded
import Data.Ordering_Type
import Data.Eq
import Text.Show
@@ -40,3 +41,8 @@
showsPrec _ LT = showString "LT"
showsPrec _ EQ = showString "EQ"
showsPrec _ GT = showString "GT"
+
+instance Bounded Ordering where
+ minBound = LT
+ maxBound = GT
+
--- a/lib/Data/Tuple.hs
+++ b/lib/Data/Tuple.hs
@@ -1,12 +1,14 @@
-- Copyright 2023 Lennart Augustsson
-- See LICENSE file for full license.
-module Data.Tuple(module Data.Tuple
+module Data.Tuple(
+ module Data.Tuple,
--Y{-- , ()(..)
+ ()(..)
--Y-}
- ) where
+ ) where
import Primitives -- for ()
import Data.Bool
+import Data.Bounded
import Data.Eq
import Data.Function
import Text.Show
@@ -41,3 +43,23 @@
instance forall a b c . (Show a, Show b, Show c) => Show (a, b, c) where
showsPrec _ (a, b, c) = showParen True (showsPrec 0 a . showString "," . showsPrec 0 b . showString "," . showsPrec 0 c)
+
+instance forall a b c d . (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
+ showsPrec _ (a, b, c, d) = showParen True (showsPrec 0 a . showString "," . showsPrec 0 b . showString "," . showsPrec 0 c .
+ showString "," . showsPrec 0 d)
+
+instance Bounded () where
+ minBound = ()
+ maxBound = ()
+
+instance forall a b . (Bounded a, Bounded b) => Bounded (a, b) where
+ minBound = (minBound, minBound)
+ maxBound = (maxBound, maxBound)
+
+instance forall a b c . (Bounded a, Bounded b, Bounded c) => Bounded (a, b, c) where
+ minBound = (minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound)
+
+instance forall a b c d . (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a, b, c, d) where
+ minBound = (minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound)
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -3,7 +3,8 @@
module Data.Word(module Data.Word, Word) where
import Primitives
import Data.Bool_Type
-import qualified Data.Char as C
+import Data.Bounded
+import Data.Char
import Data.Eq
import Data.Int() -- insances only
import Data.Integral
@@ -19,22 +20,18 @@
signum x = if x == fromInt 0 then fromInt 0 else fromInt 1
fromInt = primUnsafeCoerce
-{---- Arithmetic
-(+) :: Word -> Word -> Word
-(+) = primWordAdd
-(-) :: Word -> Word -> Word
-(-) = primWordSub
-(*) :: Word -> Word -> Word
-(*) = primWordMul
--}
-
instance Integral Word where
quot = primWordQuot
rem = primWordRem
---------------------------------
-
+{-+instance Bounded Word where
+ minBound = 0
+ maxBound = 18446744073709551615 -- 2^64-1
+-}
+
+--------------------------------
+
--infix 4 ==,/=
infix 4 <,<=,>,>=
@@ -73,10 +70,10 @@
instance Show Word where
show = showWord
where
- showWord :: Word -> C.String
+ showWord :: Word -> String
showWord n =
let
- c = C.chr ((+) (C.ord '0') (wordToInt (rem n (intToWord 10))))
+ c = chr ((+) (ord '0') (wordToInt (rem n (intToWord 10))))
in case n < intToWord 10 of
False -> showWord (quot n (intToWord 10)) ++ [c]
True -> [c]
--
⑨