shithub: MicroHs

Download patch

ref: ea50587fb4e1e7097ad9d35de0865e56ca191491
parent: d65bc804563c41d1be4a6620ccde395555cb6da9
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Nov 2 15:44:51 EDT 2023 

Integral class


--- a/Makefile
+++ b/Makefile
@@ -64,6 +64,7 @@
 	$(GHCC) -c lib/Control/Applicative.hs
 	$(GHCC) -c lib/Control/Monad.hs
 	$(GHCC) -c lib/Data/Num.hs
+	$(GHCC) -c lib/Data/Integral.hs
 	$(GHCC) -c lib/Data/Int.hs
 	$(GHCC) -c lib/Data/Double.hs
 	$(GHCC) -c lib/Data/Char.hs
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-1191
-((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' _114) ((B _12) _1)) _218))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _217))) ((A :10 (((S' P) _2) (((C' _13) _1) _952))) ((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' _111) _12) _103))) ((A :20 (((S' B) _14) (((C' _114) _12) _104))) ((A :21 _1024) ((A :22 ((B _1067) _21)) ((A :23 (((S' _1067) _21) I)) ((A :24 _994) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1023) ((C _102) _26))) ((A :28 (((C' _27) ((_110 _1037) _91)) ((_102 (_34 _1039)) _90))) ((A :29 ((B ((S _1067) (_34 _1039))) _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) _217)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _218)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _952)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _952))) ((A :46 ((C _43) _103)) ((A :47 ((B _105) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _105) _48)) ((A :50 T) ((A :51 ((_109 ((B (B (_100 _50))) ((B ((C' C) _54)) (B P)))) (_113 _51))) ((A :52 (((((_11 _51) ((B (_100 _50)) P)) (_38 _53)) ((B (B (_100 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_100 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_102 _272)) _54)) ((A :56 ((B (_100 _50)) (B (P _952)))) ((A :57 ((B (_100 _50)) (BK (P _952)))) ((A :58 ((_100 _50) ((S P) I))) ((A :59 ((B (_100 _50)) ((C (S' P)) I))) ((A :60 ((_95 ((C ((C S') _64)) I)) (_99 _60))) ((A :61 (((_1165 (K ((P (_1174 "False")) (_1174 "True")))) (_1170 _61)) (_1171 _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 _988) _989)) ((A :69 ((((((((_250 _68) (_259 _69)) _990) _991) _992) _993) (_264 _69)) (_265 _69))) ((A :70 ((_95 _998) (_99 _70))) ((A :71 ((((((((_250 _70) _997) (((C' (C' (_96 _266))) _997) _269)) (((C' (C' (_97 _266))) _997) _271)) (((C' (C' (_96 _266))) _997) _271)) (((C' (C' (_97 _266))) _997) _271)) (_264 _71)) (_265 _71))) ((A :72 _999) ((A :73 _1000) ((A :74 (((S' _63) (_991 #97)) ((C _991) #122))) ((A :75 (((S' _63) (_991 #65)) ((C _991) #90))) ((A :76 (((S' _62) _74) _75)) ((A :77 (((S' _63) (_991 #48)) ((C _991) #57))) ((A :78 (((S' _62) _76) _77)) ((A :79 (((S' _63) (_991 #32)) ((C _991) #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) (_991 #65)) ((C _991) #90))) (_67 (((noMatch "lib/Data/Char.hs") #80) #9)))) ((B _72) (((C' (_235 _115)) (((C' (_236 _115)) _73) (_73 #65))) (_73 #97))))) ((A :82 ((S ((S (((S' _63) (_991 #97)) ((C _991) #97))) (_67 (((noMatch "lib/Data/Char.hs") #84) #9)))) ((B _72) (((C' (_235 _115)) (((C' (_236 _115)) _73) (_73 #97))) (_73 #65))))) ((A :83 (((_1165 (K ((C ((S ((C ==) #39)) ((B (_102 (_1173 #39))) (((C' _102) ((B _1174) _84)) (_1173 #39))))) (_1174 "'\92&''")))) (_1170 _83)) ((B (_102 (_1173 #34))) (Y ((B (P (_1173 #34))) (((S' C) ((B ((S' S') ((C (_96 _68)) #34))) ((C' B) ((B _102) ((B _1174) _84))))) (B (_102 (_1174 "\92&\34&"))))))))) ((A :84 (((C' Y) (((S' B) ((B P) ((S ((S _79) ((B (_219 "'\92&")) (((C' _219) ((B (_1167 _120)) _73)) ((O #39) K))))) ((C O) K)))
\ No newline at end of file
+1204
+((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' _114) ((B _12) _1)) _231))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _230))) ((A :10 (((S' P) _2) (((C' _13) _1) _965))) ((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' _111) _12) _103))) ((A :20 (((S' B) _14) (((C' _114) _12) _104))) ((A :21 _1037) ((A :22 ((B _1080) _21)) ((A :23 (((S' _1080) _21) I)) ((A :24 _1007) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1036) ((C _102) _26))) ((A :28 (((C' _27) ((_110 _1050) _91)) ((_102 (_34 _1052)) _90))) ((A :29 ((B ((S _1080) (_34 _1052))) _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) _230)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _231)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _965)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _965))) ((A :46 ((C _43) _103)) ((A :47 ((B _105) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _105) _48)) ((A :50 T) ((A :51 ((_109 ((B (B (_100 _50))) ((B ((C' C) _54)) (B P)))) (_113 _51))) ((A :52 (((((_11 _51) ((B (_100 _50)) P)) (_38 _53)) ((B (B (_100 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_100 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_102 _285)) _54)) ((A :56 ((B (_100 _50)) (B (P _965)))) ((A :57 ((B (_100 _50)) (BK (P _965)))) ((A :58 ((_100 _50) ((S P) I))) ((A :59 ((B (_100 _50)) ((C (S' P)) I))) ((A :60 ((_95 ((C ((C S') _64)) I)) (_99 _60))) ((A :61 (((_1178 (K ((P (_1187 "False")) (_1187 "True")))) (_1183 _61)) (_1184 _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 _1001) _1002)) ((A :69 ((((((((_263 _68) (_272 _69)) _1003) _1004) _1005) _1006) (_277 _69)) (_278 _69))) ((A :70 ((_95 _1011) (_99 _70))) ((A :71 ((((((((_263 _70) _1010) (((C' (C' (_96 _279))) _1010) _282)) (((C' (C' (_97 _279))) _1010) _284)) (((C' (C' (_96 _279))) _1010) _284)) (((C' (C' (_97 _279))) _1010) _284)) (_277 _71)) (_278 _71))) ((A :72 _1012) ((A :73 _1013) ((A :74 (((S' _63) (_1004 #97)) ((C _1004) #122))) ((A :75 (((S' _63) (_1004 #65)) ((C _1004) #90))) ((A :76 (((S' _62) _74) _75)) ((A :77 (((S' _63) (_1004 #48)) ((C _1004) #57))) ((A :78 (((S' _62) _76) _77)) ((A :79 (((S' _63) (_1004 #32)) ((C _1004) #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) (_1004 #65)) ((C _1004) #90))) (_67 (((noMatch "lib/Data/Char.hs") #80) #9)))) ((B _72) (((C' (_248 _115)) (((C' (_249 _115)) _73) (_73 #65))) (_73 #97))))) ((A :82 ((S ((S (((S' _63) (_1004 #97)) ((C _1004) #97))) (_67 (((noMatch "lib/Data/Char.hs") #84) #9)))) ((B _72) (((C' (_248 _115)) (((C' (_249 _115)) _73) (_73 #97))) (_73 #65))))) ((A :83 (((_1178 (K ((C ((S ((C ==) #39)) ((B (_102 (_1186 #39))) (((C' _102) ((B _1187) _84)) (_1186 #39))))) (_1187 "'\92&''")))) (_1183 _83)) ((B (_102 (_1186 #34))) (Y ((B (P (_1186 #34))) (((S' C) ((B ((S' S') ((C (_96 _68)) #34))) ((C' B) ((B _102) ((B _1187) _84))))) (B (_102 (_1187 "\92&\34&"))))))))) ((A :84 (((C' Y) (((S' B) ((B P) ((S ((S _79) ((B (_232 "'\92&")) (((C' _232) ((B (_1180 _119)) _73)) (
\ No newline at end of file
--- a/lib/Data/Int.hs
+++ b/lib/Data/Int.hs
@@ -5,13 +5,12 @@
 import Data.Bool_Type
 import Data.Char_Type
 import Data.Eq
+import Data.Integral
 import Data.List_Type
 import Data.Num
 import Data.Ord
 import Text.Show
 
-infixl 7 `quot`,`rem`
-
 instance Num Int where
   (+)  = primIntAdd
   (-)  = primIntSub
@@ -35,10 +34,9 @@
 (*)  = primIntMul
 -}
 
-quot :: Int -> Int -> Int
-quot = primIntQuot
-rem :: Int -> Int -> Int
-rem  = primIntRem
+instance Integral Int where
+  quot = primIntQuot
+  rem  = primIntRem
 
 --------------------------------
 
--- a/lib/Data/Integer.hs
+++ b/lib/Data/Integer.hs
@@ -1,16 +1,21 @@
 -- Copyright 2023 Lennart Augustsson
 -- See LICENSE file for full license.
--- *** WIP, do not use! ***
 module Data.Integer(
   Integer,
-  addI, subI, mulI, quotI, remI,
-  negateI, absI,
-  quotRemI,
-  eqI, neI, ltI, leI, gtI, geI,
   intToInteger,
-  showInteger,
   ) where
-import Prelude
+import Primitives
+import Control.Error
+import Data.Bool
+import Data.Char
+import Data.Eq
+import Data.Function
+import Data.Int
+import Data.Integral
+import Data.List
+import Data.Num
+import Data.Ord
+import Text.Show
 {-
 import Prelude hiding(Integer)
 import qualified Prelude as P
@@ -44,7 +49,7 @@
   (<)  = ltI
   (<=) = leI
   (>)  = gtI
-  (>+) = geI
+  (>=) = geI
 
 instance Show Integer where
   show i = showInteger i
@@ -62,6 +67,9 @@
       GT -> oneI
   fromInt = intToInteger
 
+instance Integral Integer where
+  quotRem = quotRemI
+
 isZero :: Integer -> Bool
 isZero (I _ ds) = null ds
 
@@ -181,12 +189,6 @@
       ss = zipWith (++) (map (`replicate` 0) [0..]) rs
   in  foldl1 add ss
 
-quotI :: Integer -> Integer -> Integer
-quotI x y = fst (quotRemI x y)
-
-remI :: Integer -> Integer -> Integer
-remI x y = snd (quotRemI x y)
-
 -- Signs:
 --  + +  -> (+,+)
 --  + -  -> (-,+)
@@ -208,6 +210,11 @@
 
 qrRes :: Sign -> Sign -> ([Digit], [Digit]) -> (Integer, Integer)
 qrRes sx sy (ds, rs) = (sI (mulSign sx sy) ds, sI sx rs)
+
+quotI :: Integer -> Integer -> Integer
+quotI x y =
+  case quotRemI x y of
+    (q, _) -> q
 
 -- Divide by a single digit.
 -- Does not return normalized numbers.
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -6,12 +6,11 @@
 import qualified Data.Char as C
 import Data.Eq
 import Data.Int()  -- insances only
+import Data.Integral
 import Data.List
 import Data.Num
 import Text.Show
 
-infixl 7 `quot`,`rem`
-
 instance Num Word where
   (+)  = primWordAdd
   (-)  = primWordSub
@@ -30,10 +29,9 @@
 (*)  = primWordMul
 -}
 
-quot :: Word -> Word -> Word
-quot = primWordQuot
-rem :: Word -> Word -> Word
-rem  = primWordRem
+instance Integral Word where
+  quot = primWordQuot
+  rem  = primWordRem
 
 --------------------------------
 
--- a/lib/Prelude.hs
+++ b/lib/Prelude.hs
@@ -11,6 +11,7 @@
   module Data.Function,
   module Data.Functor,
   module Data.Int,
+  module Data.Integral,
   module Data.List,
   module Data.Maybe,
   module Data.Num,
@@ -32,6 +33,7 @@
 import Data.Function
 import Data.Functor
 import Data.Int
+import Data.Integral
 import Data.List
 import Data.Maybe
 import Data.Num
-- 
⑨