shithub: MicroHs

Download patch

ref: 2e92c0cfdb63109961ef9e3a00a5e12ca6670b1c
parent: 4cd0b4de639053b89d0c7236245a731fc69033a5
author: Lennart Augustsson <lennart@augustsson.net>
date: Fri Nov 3 05:09:16 EDT 2023

Split Integer type into it's own module.

--- a/Makefile
+++ b/Makefile
@@ -64,6 +64,7 @@
 	$(GHCC) -c lib/Data/Functor.hs
 	$(GHCC) -c lib/Control/Applicative.hs
 	$(GHCC) -c lib/Control/Monad.hs
+	$(GHCC) -c lib/Data/Integer_Type.hs
 	$(GHCC) -c lib/Data/Num.hs
 	$(GHCC) -c lib/Data/Integral.hs
 	$(GHCC) -c lib/Data/Fractional.hs
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-1277
-((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)) _297))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _296))) ((A :10 (((S' P) _2) (((C' _13) _1) _1037))) ((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 _1110) ((A :22 ((B _1153) _21)) ((A :23 (((S' _1153) _21) I)) ((A :24 _1080) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1109) ((C _117) _26))) ((A :28 (((C' _27) ((_125 _1123) _98)) ((_117 (_34 _1125)) _97))) ((A :29 ((B ((S _1153) (_34 _1125))) _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) _296)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _297)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1037)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1037))) ((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 _352)) _54)) ((A :56 ((B (_115 _50)) (B (P _1037)))) ((A :57 ((B (_115 _50)) (BK (P _1037)))) ((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 (((_1251 (K ((P (_1260 "False")) (_1260 "True")))) (_1256 _61)) (_1257 _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 _1074) _1075)) ((A :75 ((((((((_329 _74) (_338 _75)) _1076) _1077) _1078) _1079) (_343 _75)) (_344 _75))) ((A :76 ((_102 _1084) (_106 _76))) ((A :77 ((((((((_329 _76) _1083) (((C' (C' (_103 _345))) _1083) _349)) (((C' (C' (_104 _345))) _1083) _351)) (((C' (C' (_103 _345))) _1083) _351)) (((C' (C' (_104 _345))) _1083) _351)) (_343 _77)) (_344 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1085) ((A :80 _1086) ((A :81 (((S' _64) (_1077 #97)) ((C _1077) #122))) ((A :82 (((S' _64) (_1077 #65)) ((C _1077) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1077 #48)) ((C _1077) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1077 #32)) ((C _1077) #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) (_1077 #65)) ((C _1077) #90))) (_68 (((noMatch "lib/Data/Char.hs") #86) #9)))) ((B _79) (((C' (_314 _130)) (((C' (_315 _130)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1077 #97)) ((C _1077) #97))) (_68 (((noMatch "lib/Data/Char.hs") #90) #9)))) ((B _79) (((C' (_314 _130)) (((C' (_315 _130)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1251 (K ((C ((S ((C ==) #39)) ((B (_117 (_1259 #39))) (((C' _117) ((B _1260) _91)) (_1259 #39))))) (_1260 "'\92&''")))) (_1256 _90)) ((B (_117 (_1259 #34))) (Y ((B (P (_1259 #34))) (((S' C) ((B 
\ No newline at end of file
+1280
+((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)) _297))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _296))) ((A :10 (((S' P) _2) (((C' _13) _1) _1040))) ((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 _1113) ((A :22 ((B _1156) _21)) ((A :23 (((S' _1156) _21) I)) ((A :24 _1083) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1112) ((C _117) _26))) ((A :28 (((C' _27) ((_125 _1126) _98)) ((_117 (_34 _1128)) _97))) ((A :29 ((B ((S _1156) (_34 _1128))) _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) _296)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _297)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1040)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1040))) ((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 _352)) _54)) ((A :56 ((B (_115 _50)) (B (P _1040)))) ((A :57 ((B (_115 _50)) (BK (P _1040)))) ((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 (((_1254 (K ((P (_1263 "False")) (_1263 "True")))) (_1259 _61)) (_1260 _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 _1077) _1078)) ((A :75 ((((((((_329 _74) (_338 _75)) _1079) _1080) _1081) _1082) (_343 _75)) (_344 _75))) ((A :76 ((_102 _1087) (_106 _76))) ((A :77 ((((((((_329 _76) _1086) (((C' (C' (_103 _345))) _1086) _349)) (((C' (C' (_104 _345))) _1086) _351)) (((C' (C' (_103 _345))) _1086) _351)) (((C' (C' (_104 _345))) _1086) _351)) (_343 _77)) (_344 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1088) ((A :80 _1089) ((A :81 (((S' _64) (_1080 #97)) ((C _1080) #122))) ((A :82 (((S' _64) (_1080 #65)) ((C _1080) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1080 #48)) ((C _1080) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1080 #32)) ((C _1080) #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) (_1080 #65)) ((C _1080) #90))) (_68 (((noMatch "lib/Data/Char.hs") #86) #9)))) ((B _79) (((C' (_314 _130)) (((C' (_315 _130)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1080 #97)) ((C _1080) #97))) (_68 (((noMatch "lib/Data/Char.hs") #90) #9)))) ((B _79) (((C' (_314 _130)) (((C' (_315 _130)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1254 (K ((C ((S ((C ==) #39)) ((B (_117 (_1262 #39))) (((C' _117) ((B _1263) _91)) (_1262 #39))))) (_1263 "'\92&''")))) (_1259 _90)) ((B (_117 (_1262 #34))) (Y ((B (P (_1262 #34))) (((S' C) ((B 
\ No newline at end of file
--- /dev/null
+++ b/lib/Data/Bounded.hs
@@ -1,0 +1,6 @@
+module Data.Bounded(module Data.Bounded) where
+import Primitives
+
+class Bounded a where
+  minBound :: a
+  maxBound :: a
--- a/lib/Data/Integer.hs
+++ b/lib/Data/Integer.hs
@@ -14,6 +14,7 @@
 import Data.Eq
 import Data.Function
 import Data.Int
+import Data.Integer_Type
 import Data.Integral
 import Data.List
 import Data.Num
@@ -27,7 +28,7 @@
 --  * least signification digits first, most significant last
 --  * no trailing 0s in the digits
 --  * 0 is positive
-data Integer = I Sign [Digit]
+--data Integer = I Sign [Digit]
   --deriving Show
 
 type Digit = Int
@@ -35,7 +36,7 @@
 maxD :: Digit
 maxD = 2147483648  -- 2^31, this is used so multiplication of two digit doesn't overflow a 64 bit Int
 
-data Sign = Plus | Minus
+--data Sign = Plus | Minus
   --deriving Show
 
 instance Eq Integer where
--- /dev/null
+++ b/lib/Data/Integer_Type.hs
@@ -1,0 +1,6 @@
+module Data.Integer_Type(module Data.Integer_Type) where
+import Primitives
+
+data Integer = I Sign [{-Digit-}Int]
+
+data Sign = Plus | Minus
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -32,6 +32,20 @@
 listPrefix :: String
 listPrefix = "Data.List_Type."
 
+nameInt :: String
+nameInt = "Primitives.Int"
+
+nameDouble :: String
+nameDouble = "Primitives.Double"
+
+nameChar :: String
+nameChar = "Primitives.Char"
+
+--nameInteger :: String
+--nameInteger = "Data.Integer_Type.Integer"
+
+----------------------
+
 data TModule a = TModule
   IdentModule     -- module names
   [FixDef]        -- all fixities, exported or not
@@ -1513,11 +1527,11 @@
 tcLit mt loc l = do
   let lit t = instSigma loc (ELit loc l) t mt
   case l of
-    LInt _  -> lit (tConI loc "Primitives.Int")
-    LDouble _ -> lit (tConI loc "Primitives.Double")
-    LChar _ -> lit (tConI loc "Primitives.Char")
-    LStr _  -> lit (tApp (tList loc) (tConI loc "Primitives.Char"))
-    LPrim _ -> newUVar >>= lit  -- pretend it is anything
+    LInt _    -> lit (tConI loc nameInt)
+    LDouble _ -> lit (tConI loc nameDouble)
+    LChar _   -> lit (tConI loc nameChar)
+    LStr _    -> lit (tApp (tList loc) (tConI loc nameChar))
+    LPrim _   -> newUVar >>= lit  -- pretend it is anything
     LForImp _ -> impossible
 
 tcOper :: --XHasCallStack =>
--