ref: b36e72a80a8d1a90f84da10a09055d9a450d3410
parent: fec89394a4817f5cbf8e1f734da08b4ba6cc49cf
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Fri Nov 3 15:23:38 EDT 2023
More instances
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.0
-1291
-((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)) _301))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _300))) ((A :10 (((S' P) _2) (((C' _13) _1) _1049))) ((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 _1122) ((A :22 ((B _1165) _21)) ((A :23 (((S' _1165) _21) I)) ((A :24 _1092) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1121) ((C _117) _26))) ((A :28 (((C' _27) ((_125 _1135) _98)) ((_117 (_34 _1137)) _97))) ((A :29 ((B ((S _1165) (_34 _1137))) _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) _300)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _301)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1049)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1049))) ((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 _356)) _54)) ((A :56 ((B (_115 _50)) (B (P _1049)))) ((A :57 ((B (_115 _50)) (BK (P _1049)))) ((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 (((_1263 (K ((P (_1272 "False")) (_1272 "True")))) (_1268 _61)) (_1269 _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 _1086) _1087)) ((A :75 ((((((((_333 _74) (_342 _75)) _1088) _1089) _1090) _1091) (_347 _75)) (_348 _75))) ((A :76 ((_102 _1096) (_106 _76))) ((A :77 ((((((((_333 _76) _1095) (((C' (C' (_103 _349))) _1095) _353)) (((C' (C' (_104 _349))) _1095) _355)) (((C' (C' (_103 _349))) _1095) _355)) (((C' (C' (_104 _349))) _1095) _355)) (_347 _77)) (_348 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1097) ((A :80 _1098) ((A :81 (((S' _64) (_1089 #97)) ((C _1089) #122))) ((A :82 (((S' _64) (_1089 #65)) ((C _1089) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1089 #48)) ((C _1089) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1089 #32)) ((C _1089) #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) (_1089 #65)) ((C _1089) #90))) (_68 (((noMatch "lib/Data/Char.hs") #86) #9)))) ((B _79) (((C' (_318 _130)) (((C' (_319 _130)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1089 #97)) ((C _1089) #97))) (_68 (((noMatch "lib/Data/Char.hs") #90) #9)))) ((B _79) (((C' (_318 _130)) (((C' (_319 _130)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1263 (K ((C ((S ((C ==) #39)) ((B (_117 (_1271 #39))) (((C' _117) ((B _1272) _91)) (_1271 #39))))) (_1272 "'\92&''")))) (_1268 _90)) ((B (_117 (_1271 #34))) (Y ((B (P (_1271 #34))) (((S' C) ((B
\ No newline at end of file
+1293
+((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)) _303))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _302))) ((A :10 (((S' P) _2) (((C' _13) _1) _1051))) ((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 _1124) ((A :22 ((B _1167) _21)) ((A :23 (((S' _1167) _21) I)) ((A :24 _1094) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1123) ((C _117) _26))) ((A :28 (((C' _27) ((_125 _1137) _98)) ((_117 (_34 _1139)) _97))) ((A :29 ((B ((S _1167) (_34 _1139))) _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) _302)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _303)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1051)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1051))) ((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 _358)) _54)) ((A :56 ((B (_115 _50)) (B (P _1051)))) ((A :57 ((B (_115 _50)) (BK (P _1051)))) ((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 (((_1265 (K ((P (_1274 "False")) (_1274 "True")))) (_1270 _61)) (_1271 _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 _1088) _1089)) ((A :75 ((((((((_335 _74) (_344 _75)) _1090) _1091) _1092) _1093) (_349 _75)) (_350 _75))) ((A :76 ((_102 _1098) (_106 _76))) ((A :77 ((((((((_335 _76) _1097) (((C' (C' (_103 _351))) _1097) _355)) (((C' (C' (_104 _351))) _1097) _357)) (((C' (C' (_103 _351))) _1097) _357)) (((C' (C' (_104 _351))) _1097) _357)) (_349 _77)) (_350 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1099) ((A :80 _1100) ((A :81 (((S' _64) (_1091 #97)) ((C _1091) #122))) ((A :82 (((S' _64) (_1091 #65)) ((C _1091) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1091 #48)) ((C _1091) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1091 #32)) ((C _1091) #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) (_1091 #65)) ((C _1091) #90))) (_68 (((noMatch "lib/Data/Char.hs") #86) #9)))) ((B _79) (((C' (_320 _130)) (((C' (_321 _130)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1091 #97)) ((C _1091) #97))) (_68 (((noMatch "lib/Data/Char.hs") #90) #9)))) ((B _79) (((C' (_320 _130)) (((C' (_321 _130)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1265 (K ((C ((S ((C ==) #39)) ((B (_117 (_1273 #39))) (((C' _117) ((B _1274) _91)) (_1273 #39))))) (_1274 "'\92&''")))) (_1270 _90)) ((B (_117 (_1273 #34))) (Y ((B (P (_1273 #34))) (((S' C) ((B
\ No newline at end of file
--- a/lib/Data/Int.hs
+++ b/lib/Data/Int.hs
@@ -29,6 +29,7 @@
instance Integral Int where
quot = primIntQuot
rem = primIntRem
+ toInteger = _intToInteger
{-instance Bounded Int where
--- a/lib/Data/Integer.hs
+++ b/lib/Data/Integer.hs
@@ -71,6 +71,7 @@
instance Integral Integer where
quotRem = quotRemI
+ toInteger x = x
isZero :: Integer -> Bool
isZero (I _ ds) = null ds
@@ -86,15 +87,6 @@
case trim0 ds of
[] -> I Plus []
ds' -> I s ds'
-
-_intToInteger :: Int -> Integer
-_intToInteger i | i >= 0 = I Plus (f i)
- | i == negate i = I Minus [0,0,2] -- we are at minBound::Int. XXX deal with this in a more portable way.
- | otherwise = I Minus (f (negate i))
- where
- f :: Int -> [Int]
- f 0 = []
- f x = rem x maxD : f (quot x maxD)
zeroD :: Digit
zeroD = 0
--- a/lib/Data/Integer_Type.hs
+++ b/lib/Data/Integer_Type.hs
@@ -2,6 +2,7 @@
-- See LICENSE file for full license.
module Data.Integer_Type(module Data.Integer_Type) where
import Primitives
+import Data.Bool_Type
--Yimport PrimFromInteger
import Data.List_Type
@@ -13,6 +14,16 @@
maxD :: Digit
maxD = 2147483648 -- 2^31, this is used so multiplication of two digit doesn't overflow a 64 bit Int
+
+_intToInteger :: Int -> Integer
+_intToInteger i | i `primIntGE` 0 = I Plus (f i)
+ | i `primIntEQ` ni = I Minus [0::Int,0::Int,2::Int] -- we are at minBound::Int. XXX deal with this in a more portable way.
+ | True = I Minus (f ni)
+ where
+ ni = (0::Int) `primIntSub` i
+ f :: Int -> [Int]
+ f 0 = []
+ f x = primIntRem x maxD : f (primIntQuot x maxD)
_integerToInt :: Integer -> Int
_integerToInt (I sign ds) = s `primIntMul` i
--- a/lib/Data/Integral.hs
+++ b/lib/Data/Integral.hs
@@ -3,6 +3,7 @@
module Data.Integral(module Data.Integral) where
import Primitives
import Data.Eq
+import Data.Integer_Type
import Data.Num
infixl 7 `quot`,`rem`
@@ -14,7 +15,7 @@
mod :: a -> a -> a
quotRem :: a -> a -> (a, a)
divMod :: a -> a -> (a, a)
--- toInteger :: a -> Integer
+ toInteger :: a -> Integer
n `quot` d = q where (q,r) = quotRem n d
n `rem` d = r where (q,r) = quotRem n d
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -11,6 +11,7 @@
import Data.Integral
import Data.List
import Data.Num
+import Data.Ord
import Text.Show
instance Num Word where
@@ -19,11 +20,12 @@
(*) = primWordMul
abs x = x
signum x = if x == 0 then 0 else 1
- fromInteger x = primUnsafeCoerce (_integerToInt x)
+ fromInteger x = intToWord (_integerToInt x)
instance Integral Word where
quot = primWordQuot
rem = primWordRem
+ toInteger x = _intToInteger (wordToInt x)
{-instance Bounded Word where
@@ -33,33 +35,16 @@
--------------------------------
---infix 4 ==,/=
-infix 4 <,<=,>,>=
-
-{---- Comparison
-(==) :: Word -> Word -> Bool
-(==) = primWordEQ
-(/=) :: Word -> Word -> Bool
-(/=) = primWordNE
--}
-
instance Eq Word where
(==) = primWordEQ
(/=) = primWordNE
-(<) :: Word -> Word -> Bool
-(<) = primWordLT
-(<=) :: Word -> Word -> Bool
-(<=) = primWordLE
-(>) :: Word -> Word -> Bool
-(>) = primWordGT
-(>=) :: Word -> Word -> Bool
-(>=) = primWordGE
+instance Ord Word where
+ (<) = primWordLT
+ (<=) = primWordLE
+ (>) = primWordGT
+ (>=) = primWordGE
-eqWord :: Word -> Word -> Bool
-eqWord = (==)
-
intToWord :: Int -> Word
intToWord = primUnsafeCoerce
@@ -74,7 +59,7 @@
showWord :: Word -> String
showWord n =
let
- c = chr ((+) (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]
--- a/src/MicroHs/Desugar.hs
+++ b/src/MicroHs/Desugar.hs
@@ -173,7 +173,7 @@
encodeInteger :: Integer -> Exp
encodeInteger i | -1000 < i && i < 1000 = -- XXX use better bounds
-- trace ("*** small integer " ++ show i) $- App (Var (mkIdent "Data.Integer._intToInteger")) (Lit (LInt (_integerToInt i)))
+ App (Var (mkIdent "Data.Integer_Type._intToInteger")) (Lit (LInt (_integerToInt i)))
| otherwise =
-- trace ("*** large integer " ++ show i) $App (Var (mkIdent "Data.Integer._intListToInteger")) (encodeList (map (Lit . LInt) (_integerToIntList i)))
--
⑨