ref: 367493ba64a9b541fbf882af7f3ead26cc6ea787
parent: 6242f443b5caaa1319295d1781c9ffe6f667d634
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Fri Nov 3 19:27:07 EDT 2023
More Real instances
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.0
-1310
-((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)) _306))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _305))) ((A :10 (((S' P) _2) (((C' _13) _1) _1068))) ((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 _1141) ((A :22 ((B _1184) _21)) ((A :23 (((S' _1184) _21) I)) ((A :24 _1111) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1140) ((C _117) _26))) ((A :28 (((C' _27) ((_125 _1154) _98)) ((_117 (_34 _1156)) _97))) ((A :29 ((B ((S _1184) (_34 _1156))) _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) _305)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _306)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1068)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1068))) ((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 _376)) _54)) ((A :56 ((B (_115 _50)) (B (P _1068)))) ((A :57 ((B (_115 _50)) (BK (P _1068)))) ((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 (((_1282 (K ((P (_1291 "False")) (_1291 "True")))) (_1287 _61)) (_1288 _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 _1105) _1106)) ((A :75 ((((((((_338 _74) (_347 _75)) _1107) _1108) _1109) _1110) (_352 _75)) (_353 _75))) ((A :76 ((_102 _1115) (_106 _76))) ((A :77 ((((((((_338 _76) _1114) (((C' (C' (_103 _354))) _1114) _358)) (((C' (C' (_104 _354))) _1114) _360)) (((C' (C' (_103 _354))) _1114) _360)) (((C' (C' (_104 _354))) _1114) _360)) (_352 _77)) (_353 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1116) ((A :80 _1117) ((A :81 (((S' _64) (_1108 #97)) ((C _1108) #122))) ((A :82 (((S' _64) (_1108 #65)) ((C _1108) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1108 #48)) ((C _1108) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1108 #32)) ((C _1108) #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) (_1108 #65)) ((C _1108) #90))) (_68 (((noMatch "lib/Data/Char.hs") #72) #9)))) ((B _79) (((C' (_323 _130)) (((C' (_324 _130)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1108 #97)) ((C _1108) #97))) (_68 (((noMatch "lib/Data/Char.hs") #76) #9)))) ((B _79) (((C' (_323 _130)) (((C' (_324 _130)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1282 (K ((C ((S ((C ==) #39)) ((B (_117 (_1290 #39))) (((C' _117) ((B _1291) _91)) (_1290 #39))))) (_1291 "'\92&''")))) (_1287 _90)) ((B (_117 (_1290 #34))) (Y ((B (P (_1290 #34))) (((S' C) ((B
\ No newline at end of file
+1313
+((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)) _308))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _307))) ((A :10 (((S' P) _2) (((C' _13) _1) _1071))) ((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 _1144) ((A :22 ((B _1187) _21)) ((A :23 (((S' _1187) _21) I)) ((A :24 _1114) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1143) ((C _117) _26))) ((A :28 (((C' _27) ((_125 _1157) _98)) ((_117 (_34 _1159)) _97))) ((A :29 ((B ((S _1187) (_34 _1159))) _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) _307)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _308)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1071)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1071))) ((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 _379)) _54)) ((A :56 ((B (_115 _50)) (B (P _1071)))) ((A :57 ((B (_115 _50)) (BK (P _1071)))) ((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 (((_1285 (K ((P (_1294 "False")) (_1294 "True")))) (_1290 _61)) (_1291 _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 _1108) _1109)) ((A :75 ((((((((_340 _74) (_349 _75)) _1110) _1111) _1112) _1113) (_354 _75)) (_355 _75))) ((A :76 ((_102 _1118) (_106 _76))) ((A :77 ((((((((_340 _76) _1117) (((C' (C' (_103 _356))) _1117) _360)) (((C' (C' (_104 _356))) _1117) _362)) (((C' (C' (_103 _356))) _1117) _362)) (((C' (C' (_104 _356))) _1117) _362)) (_354 _77)) (_355 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1119) ((A :80 _1120) ((A :81 (((S' _64) (_1111 #97)) ((C _1111) #122))) ((A :82 (((S' _64) (_1111 #65)) ((C _1111) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1111 #48)) ((C _1111) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1111 #32)) ((C _1111) #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) (_1111 #65)) ((C _1111) #90))) (_68 (((noMatch "lib/Data/Char.hs") #72) #9)))) ((B _79) (((C' (_325 _130)) (((C' (_326 _130)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1111 #97)) ((C _1111) #97))) (_68 (((noMatch "lib/Data/Char.hs") #76) #9)))) ((B _79) (((C' (_325 _130)) (((C' (_326 _130)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1285 (K ((C ((S ((C ==) #39)) ((B (_117 (_1293 #39))) (((C' _117) ((B _1294) _91)) (_1293 #39))))) (_1294 "'\92&''")))) (_1290 _90)) ((B (_117 (_1293 #34))) (Y ((B (P (_1293 #34))) (((S' C) ((B
\ No newline at end of file
--- a/lib/Data/Int.hs
+++ b/lib/Data/Int.hs
@@ -11,7 +11,7 @@
import Data.List_Type
import Data.Num
import Data.Ord
---import Data.Ratio
+import Data.Ratio_Type
import Data.Real
import Text.Show
@@ -39,8 +39,8 @@
maxBound = 9223372036854775807 -- 2^63-1
-}
---instance Real Int where
--- toRational i = i % 1
+instance Real Int where
+ toRational i = _integerToRational (_intToInteger i)
--------------------------------
--- a/lib/Data/Integer.hs
+++ b/lib/Data/Integer.hs
@@ -21,7 +21,7 @@
import Data.List
import Data.Num
import Data.Ord
---import Data.Ratio
+import Data.Ratio_Type
import Data.Real
import Text.Show
@@ -75,8 +75,8 @@
quotRem = quotRemI
toInteger x = x
---instance Real Int where
--- toRational i = i % 1
+instance Real Integer where
+ toRational i = _integerToRational i
isZero :: Integer -> Bool
isZero (I _ ds) = null ds
--- a/lib/Data/Ratio_Type.hs
+++ b/lib/Data/Ratio_Type.hs
@@ -6,3 +6,5 @@
type Rational = Ratio Integer
+_integerToRational :: Integer -> Rational
+_integerToRational x = x :% (1::Integer)
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -1431,8 +1431,9 @@
case mex of
-- Convert to Int in the compiler, that way (99::Int) will never involve fromInteger
-- (which is not always in scope).
- Just v | v == mkIdent nameInt -> tcLit mt loc' (LInt (_integerToInt i))
- | v == mkIdent nameDouble -> tcLit mt loc' (LDouble (_integerToDouble i))
+ Just v | v == mkIdent nameInt -> tcLit mt loc' (LInt (_integerToInt i))
+ | v == mkIdent nameDouble -> tcLit mt loc' (LDouble (_integerToDouble i))
+ | v == mkIdent nameInteger -> tcLit mt loc' l
_ -> do
(f, ft) <- tInferExpr (EVar (mkIdentSLoc loc' "fromInteger")) -- XXX should have this qualified somehow
(_at, rt) <- unArrow loc ft
--
⑨