ref: 2c97bc13a89d9245882e5df62ee872003e8e86c3
parent: ea50587fb4e1e7097ad9d35de0865e56ca191491
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Nov 2 15:51:03 EDT 2023
Fractional type class
--- a/Makefile
+++ b/Makefile
@@ -65,6 +65,7 @@
$(GHCC) -c lib/Control/Monad.hs
$(GHCC) -c lib/Data/Num.hs
$(GHCC) -c lib/Data/Integral.hs
+ $(GHCC) -c lib/Data/Fractional.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
-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
+1212
+((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' _122) ((B _12) _1)) _239))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _238))) ((A :10 (((S' P) _2) (((C' _13) _1) _973))) ((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' _119) _12) _111))) ((A :20 (((S' B) _14) (((C' _122) _12) _112))) ((A :21 _1045) ((A :22 ((B _1088) _21)) ((A :23 (((S' _1088) _21) I)) ((A :24 _1015) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1044) ((C _110) _26))) ((A :28 (((C' _27) ((_118 _1058) _91)) ((_110 (_34 _1060)) _90))) ((A :29 ((B ((S _1088) (_34 _1060))) _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) _238)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _239)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _973)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _973))) ((A :46 ((C _43) _111)) ((A :47 ((B _113) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _113) _48)) ((A :50 T) ((A :51 ((_117 ((B (B (_108 _50))) ((B ((C' C) _54)) (B P)))) (_121 _51))) ((A :52 (((((_11 _51) ((B (_108 _50)) P)) (_38 _53)) ((B (B (_108 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_108 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_110 _293)) _54)) ((A :56 ((B (_108 _50)) (B (P _973)))) ((A :57 ((B (_108 _50)) (BK (P _973)))) ((A :58 ((_108 _50) ((S P) I))) ((A :59 ((B (_108 _50)) ((C (S' P)) I))) ((A :60 ((_95 ((C ((C S') _64)) I)) (_99 _60))) ((A :61 (((_1186 (K ((P (_1195 "False")) (_1195 "True")))) (_1191 _61)) (_1192 _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 _1009) _1010)) ((A :69 ((((((((_271 _68) (_280 _69)) _1011) _1012) _1013) _1014) (_285 _69)) (_286 _69))) ((A :70 ((_95 _1019) (_99 _70))) ((A :71 ((((((((_271 _70) _1018) (((C' (C' (_96 _287))) _1018) _290)) (((C' (C' (_97 _287))) _1018) _292)) (((C' (C' (_96 _287))) _1018) _292)) (((C' (C' (_97 _287))) _1018) _292)) (_285 _71)) (_286 _71))) ((A :72 _1020) ((A :73 _1021) ((A :74 (((S' _63) (_1012 #97)) ((C _1012) #122))) ((A :75 (((S' _63) (_1012 #65)) ((C _1012) #90))) ((A :76 (((S' _62) _74) _75)) ((A :77 (((S' _63) (_1012 #48)) ((C _1012) #57))) ((A :78 (((S' _62) _76) _77)) ((A :79 (((S' _63) (_1012 #32)) ((C _1012) #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) (_1012 #65)) ((C _1012) #90))) (_67 (((noMatch "lib/Data/Char.hs") #80) #9)))) ((B _72) (((C' (_256 _123)) (((C' (_257 _123)) _73) (_73 #65))) (_73 #97))))) ((A :82 ((S ((S (((S' _63) (_1012 #97)) ((C _1012) #97))) (_67 (((noMatch "lib/Data/Char.hs") #84) #9)))) ((B _72) (((C' (_256 _123)) (((C' (_257 _123)) _73) (_73 #97))) (_73 #65))))) ((A :83 (((_1186 (K ((C ((S ((C ==) #39)) ((B (_110 (_1194 #39))) (((C' _110) ((B _1195) _84)) (_1194 #39))))) (_1195 "'\92&''")))) (_1191 _83)) ((B (_110 (_1194 #34))) (Y ((B (P (_1194 #34))) (((S' C) ((B ((S' S') ((C (_96 _68)) #34))) ((C' B) ((B _110) ((B _1195) _84))))) (B (_110 (_1195 "\92&\34&"))))))))) ((A :84 (((C' Y) (((S' B) ((B P) ((S ((S _79) ((B (_240 "'\92&")) (((C' _240) ((B (_1188 _127)) _73)) (
\ No newline at end of file
--- a/lib/Data/Double.hs
+++ b/lib/Data/Double.hs
@@ -5,6 +5,7 @@
import Control.Error
import Data.Bool_Type
import Data.Eq
+import Data.Fractional
import Data.Ord
import Data.Num
import Text.Show
@@ -31,8 +32,9 @@
(*) = primDoubleMul
-}
-(/) :: Double -> Double -> Double
-(/) = primDoubleDiv
+instance Fractional Double where
+ (/) = primDoubleDiv
+ fromDouble x = x
{-negate :: Double -> Double
--- /dev/null
+++ b/lib/Data/Fractional.hs
@@ -1,0 +1,11 @@
+module Data.Fractional(module Data.Fractional) where
+import Primitives
+import Data.Num
+
+class Num a => Fractional a where
+ (/) :: a -> a -> a
+ recip :: a -> a
+-- fromRational :: Rational -> a
+ fromDouble :: Double -> a
+
+ recip x = fromDouble 1.0 / x
--- /dev/null
+++ b/lib/Data/Integral.hs
@@ -1,0 +1,23 @@
+module Data.Integral(module Data.Integral) where
+import Primitives
+import Data.Eq
+import Data.Num
+
+infixl 7 `quot`,`rem`
+
+class {-(Real a, Enum a) => -} (Eq a, Num a) => Integral a where+ quot :: a -> a -> a
+ rem :: a -> a -> a
+ div :: a -> a -> a
+ mod :: a -> a -> a
+ quotRem :: a -> a -> (a, a)
+ divMod :: a -> a -> (a, a)
+-- toInteger :: a -> Integer
+
+ n `quot` d = q where (q,r) = quotRem n d
+ n `rem` d = r where (q,r) = quotRem n d
+ n `div` d = q where (q,r) = divMod n d
+ n `mod` d = r where (q,r) = divMod n d
+ divMod n d = if signum r == negate (signum d) then (q - fromInt 1, r + d) else qr
+ where qr@(q,r) = quotRem n d
+ quotRem n d = (quot n d, rem n d)
--- a/lib/Prelude.hs
+++ b/lib/Prelude.hs
@@ -6,8 +6,10 @@
module Control.Monad,
module Data.Bool,
module Data.Char,
+ module Data.Double,
module Data.Either,
module Data.Eq,
+ module Data.Fractional,
module Data.Function,
module Data.Functor,
module Data.Int,
@@ -28,8 +30,10 @@
import Control.Monad
import Data.Bool
import Data.Char
+import Data.Double
import Data.Either
import Data.Eq
+import Data.Fractional
import Data.Function
import Data.Functor
import Data.Int
--- a/tests/FArith.hs
+++ b/tests/FArith.hs
@@ -1,7 +1,7 @@
module FArith(module FArith) where
import Prelude
-import Data.Double as D
+import Data.Double
import Text.String
list1 :: [Double]
@@ -11,14 +11,14 @@
list2 = [-100.343241, -53.3248973, -0.0, 0.0, 1.0, 1.23453523, 3243534.34534, 999.999]
divide :: Double -> Double -> Double
-divide x y = if y == 0.0 then 0.0 else x D./ y
+divide x y = if y == 0.0 then 0.0 else x / y
main :: IO ()
main = do
putStrLn $ show [ op x y | x <- list1, y <- list2, op <- [(+), (-), (*), divide] ]
putStrLn $ show [ op x y | x <- list1, y <- list2, op <- [(==), (/=), (<), (<=), (>), (>=)] ]
- putStrLn $ show [ x D./ y | x <- [2.234983, 1.232, 23.0], y <- [1.0, 5.0, 10.0, 100.0]]
- putStrLn $ show [ x D./ y | x <- [-2.234983, -1.232, -23.0], y <- [1.0, -5.0, 10.0, -100.0]]
+ putStrLn $ show [ x / y | x <- [2.234983, 1.232, 23.0], y <- [1.0, 5.0, 10.0, 100.0]]
+ putStrLn $ show [ x / y | x <- [-2.234983, -1.232, -23.0], y <- [1.0, -5.0, 10.0, -100.0]]
let str = readDouble "1.576"
putStrLn $ show str
putStrLn $ show $ 1.0 + readDouble "2.5"
--
⑨