shithub: MicroHs

Download patch

ref: 255edbba41f792c9920278dd222fe821098b1eb1
parent: 61cf95de95be27a6a02e3c67046250946daee4f3
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Fri Nov 3 20:26:40 EDT 2023

More functions

--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-1333
-((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' _152) ((B _12) _1)) _328))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _327))) ((A :10 (((S' P) _2) (((C' _13) _1) _1091))) ((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' _149) _12) _140))) ((A :20 (((S' B) _14) (((C' _152) _12) _141))) ((A :21 _1164) ((A :22 ((B _1207) _21)) ((A :23 (((S' _1207) _21) I)) ((A :24 _1134) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1163) ((C _139) _26))) ((A :28 (((C' _27) ((_148 _1177) _98)) ((_139 (_34 _1179)) _97))) ((A :29 ((B ((S _1207) (_34 _1179))) _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) _327)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _328)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1091)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1091))) ((A :46 ((C _43) _140)) ((A :47 ((B _142) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _142) _48)) ((A :50 T) ((A :51 ((_147 ((B (B (_137 _50))) ((B ((C' C) _54)) (B P)))) (_151 _51))) ((A :52 (((((_11 _51) ((B (_137 _50)) P)) (_38 _53)) ((B (B (_137 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_137 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_139 _399)) _54)) ((A :56 ((B (_137 _50)) (B (P _1091)))) ((A :57 ((B (_137 _50)) (BK (P _1091)))) ((A :58 ((_137 _50) ((S P) I))) ((A :59 ((B (_137 _50)) ((C (S' P)) I))) ((A :60 ((_124 ((C ((C S') _65)) I)) (_128 _60))) ((A :61 (((_1305 (K ((P (_1314 "False")) (_1314 "True")))) (_1310 _61)) (_1311 _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 ((_124 _1128) _1129)) ((A :75 ((((((((_360 _74) (_369 _75)) _1130) _1131) _1132) _1133) (_374 _75)) (_375 _75))) ((A :76 ((_124 _1138) (_128 _76))) ((A :77 ((((((((_360 _76) _1137) (((C' (C' (_125 _376))) _1137) _380)) (((C' (C' (_126 _376))) _1137) _382)) (((C' (C' (_125 _376))) _1137) _382)) (((C' (C' (_126 _376))) _1137) _382)) (_374 _77)) (_375 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1139) ((A :80 _1140) ((A :81 (((S' _64) (_1131 #97)) ((C _1131) #122))) ((A :82 (((S' _64) (_1131 #65)) ((C _1131) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1131 #48)) ((C _1131) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1131 #32)) ((C _1131) #126))) ((A :87 (((S' _63) ((C (_125 _74)) #32)) (((S' _63) ((C (_125 _74)) #9)) ((C (_125 _74)) #10)))) ((A :88 ((S ((S (((S' _64) (_1131 #65)) ((C _1131) #90))) (_68 (((noMatch "lib/Data/Char.hs") #72) #9)))) ((B _79) (((C' (_345 _153)) (((C' (_346 _153)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1131 #97)) ((C _1131) #97))) (_68 (((noMatch "lib/Data/Char.hs") #76) #9)))) ((B _79) (((C' (_345 _153)) (((C' (_346 _153)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1305 (K ((C ((S ((C ==) #39)) ((B (_139 (_1313 #39))) (((C' _139) ((B _1314) _91)) (_1313 #39))))) (_1314 "'\92&''")))) (_1310 _90)) ((B (_139 (_1313 #34))) (Y ((B (P (_1313 #34))) (((S' C) ((B 
\ No newline at end of file
+1337
+((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' _153) ((B _12) _1)) _332))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _331))) ((A :10 (((S' P) _2) (((C' _13) _1) _1095))) ((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' _150) _12) _141))) ((A :20 (((S' B) _14) (((C' _153) _12) _142))) ((A :21 _1168) ((A :22 ((B _1211) _21)) ((A :23 (((S' _1211) _21) I)) ((A :24 _1138) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1167) ((C _140) _26))) ((A :28 (((C' _27) ((_149 _1181) _98)) ((_140 (_34 _1183)) _97))) ((A :29 ((B ((S _1211) (_34 _1183))) _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) _331)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _332)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1095)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1095))) ((A :46 ((C _43) _141)) ((A :47 ((B _143) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _143) _48)) ((A :50 T) ((A :51 ((_148 ((B (B (_138 _50))) ((B ((C' C) _54)) (B P)))) (_152 _51))) ((A :52 (((((_11 _51) ((B (_138 _50)) P)) (_38 _53)) ((B (B (_138 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_138 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_140 _403)) _54)) ((A :56 ((B (_138 _50)) (B (P _1095)))) ((A :57 ((B (_138 _50)) (BK (P _1095)))) ((A :58 ((_138 _50) ((S P) I))) ((A :59 ((B (_138 _50)) ((C (S' P)) I))) ((A :60 ((_124 ((C ((C S') _65)) I)) (_128 _60))) ((A :61 (((_1309 (K ((P (_1318 "False")) (_1318 "True")))) (_1314 _61)) (_1315 _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 ((_124 _1132) _1133)) ((A :75 ((((((((_364 _74) (_373 _75)) _1134) _1135) _1136) _1137) (_378 _75)) (_379 _75))) ((A :76 ((_124 _1142) (_128 _76))) ((A :77 ((((((((_364 _76) _1141) (((C' (C' (_125 _380))) _1141) _384)) (((C' (C' (_126 _380))) _1141) _386)) (((C' (C' (_125 _380))) _1141) _386)) (((C' (C' (_126 _380))) _1141) _386)) (_378 _77)) (_379 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1143) ((A :80 _1144) ((A :81 (((S' _64) (_1135 #97)) ((C _1135) #122))) ((A :82 (((S' _64) (_1135 #65)) ((C _1135) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1135 #48)) ((C _1135) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1135 #32)) ((C _1135) #126))) ((A :87 (((S' _63) ((C (_125 _74)) #32)) (((S' _63) ((C (_125 _74)) #9)) ((C (_125 _74)) #10)))) ((A :88 ((S ((S (((S' _64) (_1135 #65)) ((C _1135) #90))) (_68 (((noMatch "lib/Data/Char.hs") #72) #9)))) ((B _79) (((C' (_349 _154)) (((C' (_350 _154)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1135 #97)) ((C _1135) #97))) (_68 (((noMatch "lib/Data/Char.hs") #76) #9)))) ((B _79) (((C' (_349 _154)) (((C' (_350 _154)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1309 (K ((C ((S ((C ==) #39)) ((B (_140 (_1317 #39))) (((C' _140) ((B _1318) _91)) (_1317 #39))))) (_1318 "'\92&''")))) (_1314 _90)) ((B (_140 (_1317 #34))) (Y ((B (P (_1317 #34))) (((S' C) ((B 
\ No newline at end of file
--- a/lib/Data/Fractional.hs
+++ b/lib/Data/Fractional.hs
@@ -2,8 +2,10 @@
 -- See LICENSE file for full license.
 module Data.Fractional(module Data.Fractional) where
 import Primitives
-import Data.Ratio_Type
+import Data.Integral
 import Data.Num
+import Data.Ord
+import Data.Ratio_Type
 
 class Num a => Fractional a where
   (/) :: a -> a -> a
@@ -11,3 +13,7 @@
   fromRational :: Rational -> a
 
   recip x = 1 / x
+
+infixr 8 ^^
+(^^) :: forall a b . (Fractional a, Integral b, Ord b) => a -> b -> a
+x ^^ n = if n >= 0 then x^n else recip (x^(negate n))
--- a/lib/Data/Integral.hs
+++ b/lib/Data/Integral.hs
@@ -2,10 +2,12 @@
 -- See LICENSE file for full license.
 module Data.Integral(module Data.Integral) where
 import Primitives
+import Control.Error
 import Data.Bool
 import Data.Eq
 import Data.Integer_Type
 import Data.Num
+import Data.Ord
 
 infixl 7 `quot`,`rem`
 
@@ -36,3 +38,18 @@
     0
   else
     abs ((x `quot` (gcd x y)) * y)
+
+even :: forall a . (Integral a) => a -> Bool
+even n = n `rem` 2 == 0
+
+odd :: forall a . (Integral a) => a -> Bool
+odd n = not (even n)
+
+infixr 8 ^
+(^) :: forall a b . (Num a, Integral b, Ord b) => a -> b -> a
+x0 ^ y0 | y0 < 0    = error "Data.Integral.^: negative exponent"
+        | otherwise = pow x0 y0
+  -- This does not do the minimal number of multiplications, but it's simple.
+  where pow x y | y == 0    = 1
+                | even y    =     pow (x * x) (y `quot` 2)
+                | otherwise = x * pow (x * x) (y `quot` 2)
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -5,6 +5,7 @@
 import Data.Bool_Type
 import Data.Bounded
 import Data.Char
+import Data.Enum
 import Data.Eq
 import Data.Int()  -- instances only
 import Data.Integer
@@ -44,6 +45,10 @@
   (<=) = primWordLE
   (>)  = primWordGT
   (>=) = primWordGE
+
+instance Enum Word where
+  toEnum = intToWord
+  fromEnum = wordToInt
 
 intToWord :: Int -> Word
 intToWord = primUnsafeCoerce
--