shithub: MicroHs

Download patch

ref: c99286fb6b400110099e678bd061701dec9b681f
parent: 8ac1a80eb76e4dd9b52f2524e359671fa3d96d2c
author: Rewbert <krookr@chalmers.se>
date: Wed Sep 20 18:10:00 EDT 2023 

add test case for doubles


--- a/lib/Data/Double.hs
+++ b/lib/Data/Double.hs
@@ -18,8 +18,15 @@
 negate :: Double -> Double
 negate x = 0.0 - x
 
---------------------------------
-
+addDouble :: Double -> Double -> Double
+addDouble = (+)
+subDouble :: Double -> Double -> Double
+subDouble = (-)
+mulDouble :: Double -> Double -> Double
+mulDouble = (*)
+
+--------------------------------
+
 --Yinfix 4 ==,/=,<,<=,>,>=
 
 -- Comparison
@@ -28,6 +35,11 @@
 (/=) :: Double -> Double -> Bool
 (/=) = primDoubleNE
 
+eqDouble :: Double -> Double -> Bool
+eqDouble = (==)
+neqDouble :: Double -> Double -> Bool
+neqDouble = (/=)
+
 (<)  :: Double -> Double -> Bool
 (<)  = primDoubleLT
 (<=) :: Double -> Double -> Bool
@@ -37,16 +49,19 @@
 (>=) :: Double -> Double -> Bool
 (>=) = primDoubleGE
 
-eqDouble :: Double -> Double -> Bool
-eqDouble = (==)
-
 ltDouble :: Double -> Double -> Bool
 ltDouble = (<)
 
+leDouble :: Double -> Double -> Bool
+leDouble = (<=)
+
+gtDouble :: Double -> Double -> Bool
+gtDouble = (>)
+
+geDouble :: Double -> Double -> Bool
+geDouble = (>=)
+
 showDouble :: Double -> String
 showDouble = primDoubleShow
-
-addDouble :: Double -> Double -> Double
-addDouble = (+)
 
 --------------------------------
--- a/lib/Prelude.hs
+++ b/lib/Prelude.hs
@@ -7,7 +7,6 @@
   module Data.Either,
   module Data.Function,
   module Data.Int,
-  module Data.Double,
   module Data.List,
   module Data.Maybe,
   module Data.Tuple,
@@ -20,7 +19,6 @@
 import Data.Either
 import Data.Function
 import Data.Int
-import Data.Double
 import Data.List
 import Data.Maybe
 import Data.Tuple
--- /dev/null
+++ b/tests/FArith.hs
@@ -1,0 +1,15 @@
+module FArith(module FArith) where
+
+import Data.Double
+import Prelude
+
+list1 :: [Double]
+list1 = [-100.343241, -53.3248973, -0.0, 0.0, 1.0, 1.23453523, 3243534.34534, 999.999]
+
+list2 :: [Double]
+list2 = [-100.343241, -53.3248973, -0.0, 0.0, 1.0, 1.23453523, 3243534.34534, 999.999]
+
+main :: IO ()
+main = do
+  putStrLn $ showList showDouble [ op x y | x <- list1, y <- list2, op <- [addDouble, subDouble, mulDouble] ]
+  putStrLn $ showList showBool [ op x y | x <- list1, y <- list2, op <- [eqDouble, neqDouble, ltDouble, leDouble, gtDouble, geDouble] ]
\ No newline at end of file
--- /dev/null
+++ b/tests/FArith.ref
@@ -1,0 +1,2 @@
+[-200.686482,0.0,10068.766014,-153.668138,-47.018344,5350.793021,-100.343241,-100.343241,0.0,-100.343241,-100.343241,-0.0,-99.343241,-101.343241,-100.343241,-99.108706,-101.577776,-123.877266,3243434.002099,-3243634.688581,-325466748.506229,899.655759,-1100.342241,-100343.140657,-153.668138,47.018344,5350.793021,-106.649795,0.0,2843.544672,-53.324897,-53.324897,0.0,-53.324897,-53.324897,-0.0,-52.324897,-54.324897,-53.324897,-52.090362,-54.559433,-65.831464,3243481.020443,-3243587.670237,-172961135.854278,946.674103,-1053.323897,-53324.843975,-100.343241,100.343241,0.0,-53.324897,53.324897,0.0,-0.0,0.0,0.0,0.0,-0.0,-0.0,1.0,-1.0,-0.0,1.234535,-1.234535,-0.0,3243534.34534,-3243534.34534,-0.0,999.999,-999.999,-0.0,-100.343241,100.343241,-0.0,-53.324897,53.324897,-0.0,0.0,0.0,-0.0,0.0,0.0,0.0,1.0,-1.0,0.0,1.234535,-1.234535,0.0,3243534.34534,-3243534.34534,0.0,999.999,-999.999,0.0,-99.343241,101.343241,-100.343241,-52.324897,54.324897,-53.324897,1.0,1.0,-0.0,1.0,1.0,0.0,2.0,0.0,1.0,2.234535,-0.234535,1.234535,3243535.34534,-3243533.34534,3243534.34534,1000.999,-998.999,999.999,-99.108706,101.577776,-123.877266,-52.090362,54.559433,-65.831464,1.234535,1.234535,-0.0,1.234535,1.234535,0.0,2.234535,0.234535,1.234535,2.46907,0.0,1.524077,3243535.579875,-3243533.110805,4004257.419037,1001.233535,-998.764465,1234.533995,3243434.002099,3243634.688581,-325466748.506229,3243481.020443,3243587.670237,-172961135.854278,3243534.34534,3243534.34534,-0.0,3243534.34534,3243534.34534,0.0,3243535.34534,3243533.34534,3243534.34534,3243535.579875,3243533.110805,4004257.419037,6487068.69068,0.0,10520515049400.181641,3244534.34434,3242534.34634,3243531101.805655,899.655759,1100.342241,-100343.140657,946.674103,1053.323897,-53324.843975,999.999,999.999,-0.0,999.999,999.999,0.0,1000.999,998.999,999.999,1001.233535,998.764465,1234.533995,3244534.34434,-3242534.34634,3243531101.805655,1999.998,0.0,999998.000001]
+[True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,True,True,False,False,True,False,False,True,False,True]
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -14,6 +14,7 @@
 	$(MHS) Newtype && $(EVAL) > Newtype.out && diff Newtype.ref Newtype.out
 	$(MHS) LitMatch && $(EVAL) > LitMatch.out && diff LitMatch.ref LitMatch.out
 	$(MHS) Word && $(EVAL) > Word.out && diff Word.ref Word.out
+	$(MHS) FArith && $(EVAL) > FArith.out && diff FArith.ref FArith.out
 
 time:
 	@echo Expect about 10s runtime
-- 
⑨