ref: c2f9686b0303f3568cc45284f90ebc52d3a17db0
parent: 52b1309ae4cf31a5aa4bed01e5dcee492ebd645e
author: Rewbert <krookr@chalmers.se>
date: Mon Sep 25 10:14:28 EDT 2023
double division
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.5
-922
-(($A :0 _807) (($A :1 (($B _853) _0)) (($A :2 ((($S' _853) _0) $I)) (($A :3 _777) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _806) (($C _69) _5))) (($A :7 ((($C' _6) (_824 _66)) ((_69 _822) _65))) (($A :8 (($B (($S _853) _822)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_69 _181)) _10)) (($A :12 (($B ($B (_68 _9))) ((($C' $B) (($B $C) _10)) ($B _10)))) (($A :13 (($B ($B (_68 _9))) ((($C' $B) (($B $C) _10)) ($BK _10)))) (($A :14 (($B (_68 _9)) $P)) (($A :15 (($B ($B (_68 _9))) (($B (($C' $C) _10)) ($B $P)))) (($A :16 _15) (($A :17 (($B (_68 _9)) ($B ($P _736)))) (($A :18 (($B (_68 _9)) ($BK ($P _736)))) (($A :19 ((_68 _9) (($S $P) $I))) (($A :20 (($B (_68 _9)) (($C ($S' $P)) $I))) (($A :21 (($B $Y) (($B ($B ($P (_14 _109)))) ((($C' $B) (($B ($C' $B)) ($B _12))) ((($C' ($C' $B)) ($B _12)) (($B ($B _14)) _110)))))) (($A :22 (($B $Y) (($B ($B ($P (_14 _736)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _736))) (($A :25 (($C $C) _32)) (($A :26 ($T _31)) (($A :27 (($P _32) _31)) (($A :28 _32) (($A :29 (($C (($C $S') _27)) $I)) (($A :30 (($C $S) _27)) (($A :31 $K) (($A :32 $A) (($A :33 _782) (($A :34 _783) (($A :35 ((($S' _26) (_774 97)) (($C _774) 122))) (($A :36 ((($S' _26) (_774 65)) (($C _774) 90))) (($A :37 ((($S' _25) _35) _36)) (($A :38 ((($S' _26) (_774 48)) (($C _774) 57))) (($A :39 ((($S' _26) (_774 32)) (($C _774) 126))) (($A :40 _771) (($A :41 _772) (($A :42 _774) (($A :43 _773) (($A :44 ((($S' _25) (($C _40) 32)) ((($S' _25) (($C _40) 9)) (($C _40) 10)))) (($A :45 _743) (($A :46 _744) (($A :47 _745) (($A :48 (_46 %0.0)) (($A :49 _45) (($A :50 _46) (($A :51 _47) (($A :52 _746) (($A :53 _747) (($A :54 _52) (($A :55 _53) (($A :56 _748) (($A :57 _749) (($A :58 _750) (($A :59 _751) (($A :60 _56) (($A :61 _57) (($A :62 _58) (($A :63 _59) (($A :64 _752) (($A :65 (($B $BK) $T)) (($A :66 ($BK $T)) (($A :67 $P) (($A :68 $I) (($A :69 $B) (($A :70 $I) (($A :71 $K) (($A :72 $C) (($A :73 _778) (($A :74 (($C (($C $S') _181)) _182)) (($A :75 ((($C' ($S' ($C' $B))) $B) $I)) (($A :76 _737) (($A :77 _738) (($A :78 _739) (($A :79 _740) (($A :80 _741) (($A :81 _742) (($A :82 (_77 0)) (($A :83 _759) (($A :84 _760) (($A :85 _761) (($A :86 _762) (($A :87 _763) (($A :88 _764) (($A :89 _83) (($A :90 ($BK $K)) (($A :91 (($B $BK) (($B ($B $BK)) $P))) (($A :92 (($B ($B ($B $BK))) (($B ($B ($B $BK))) (($B ($B ($B $C))) (($B ($B $C)) $P))))) (($A :93 ((($S' $S) ((($S' ($S' $C)) ((($C' ($C' $S)) ((($C' $B) (($B ($S' $S')) ((($C' $B) (($B _25) (_86 0))) (_83 0)))) (($B ($B (($C' $P) (_81 1)))) _76))) ($C $P))) _79)) _80)) (($A :94 _90) (($A :95 ((($S' $C) (($B ($P _170)) ((($C' ($C' $B)) ((($C' $C) _83) _170)) _171))) (($B (($C' ($C' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) (($B (($C' ($C' ($C' $C))) (($B ($B ($B (($S' $S') (_83 0))))) (($B (($C' ($C' $C)) (($B ($B (($S' $S') (_83 1)))) (($B (($C' $C) (($B (($C' $S') (_83 2))) ($C _95)))) ($C _95))))) ($C _95))))) ($C _95)))) ($T $K))) ($T $A)))) (($C _93) 4)))) (($A :96 (_102 _71)) (($A :97 ((_117 (_74 _96)) _94)) (($A :98 (($C ((($C' $B) (($P _109) ((($C' ($C' $O)) $P) $K))) ((($S' ($C' ($C' ($C' $B)))) (($B ($B ($B ($B _99)))) ((($S' ($C' ($C' $B))) (($B ($B ($B _99))) ((($S' ($C' $B)) (($B ($B _99)) ((($C' $B) (($B _115) ($T 0))) _98))) ((($C' $B) (($B _115) ($T 1))) _98)))) ((($C' $B) (($B _115) ($T 2))) _98)))) ((($C' $B) (($B _115) ($T 3))) _98)))) (($B $T) (($B ($B $P)) (($C' _76) (_78 4)))))) (($A :99 (($S $S) (($B $BK) (($B $BK) ((($S' $S) $T) (($B $BK) (($B $BK) (($C ((($S' $C') $S) (($B ($B ($B ($S $B)))) (($B ($B ($B ($B ($B $BK))))) (($B (($S' ($C' $B)) (($B $B') $B'))) (($B ($B ($B ($B ($B ($S $B)))))) (($B ($B ($B ($B ($B ($B ($B $BK))))))) ((($C' $B) ($B' ($B' (($B ($C' ($C' ($C' $C)))) (($B (($C' $B) ($B' (($B $C) _85)))) (($B (($C' $B) _110)) _99)))))) (($B (($C' $B) _110)) ($C _99)))))))))) (((_735 "lib/Data/IntMap.hs") 3) 8))))))))) (($A :100 ((_69 (_115 _181)) _98)) (($A :101 ((($C' $C) ((($C' $C) ($C _95)) (_3 "Data.IntMap.!"))) $I)) (($A :102 (($B (($C' $B) $T)) (($B ($B $Y)) ((($C' ($C' ($
\ No newline at end of file
+925
+(($A :0 _810) (($A :1 (($B _856) _0)) (($A :2 ((($S' _856) _0) $I)) (($A :3 _780) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _809) (($C _71) _5))) (($A :7 ((($C' _6) (_827 _68)) ((_71 _825) _67))) (($A :8 (($B (($S _856) _825)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_71 _183)) _10)) (($A :12 (($B ($B (_70 _9))) ((($C' $B) (($B $C) _10)) ($B _10)))) (($A :13 (($B ($B (_70 _9))) ((($C' $B) (($B $C) _10)) ($BK _10)))) (($A :14 (($B (_70 _9)) $P)) (($A :15 (($B ($B (_70 _9))) (($B (($C' $C) _10)) ($B $P)))) (($A :16 _15) (($A :17 (($B (_70 _9)) ($B ($P _738)))) (($A :18 (($B (_70 _9)) ($BK ($P _738)))) (($A :19 ((_70 _9) (($S $P) $I))) (($A :20 (($B (_70 _9)) (($C ($S' $P)) $I))) (($A :21 (($B $Y) (($B ($B ($P (_14 _111)))) ((($C' $B) (($B ($C' $B)) ($B _12))) ((($C' ($C' $B)) ($B _12)) (($B ($B _14)) _112)))))) (($A :22 (($B $Y) (($B ($B ($P (_14 _738)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _738))) (($A :25 (($C $C) _32)) (($A :26 ($T _31)) (($A :27 (($P _32) _31)) (($A :28 _32) (($A :29 (($C (($C $S') _27)) $I)) (($A :30 (($C $S) _27)) (($A :31 $K) (($A :32 $A) (($A :33 _785) (($A :34 _786) (($A :35 ((($S' _26) (_777 97)) (($C _777) 122))) (($A :36 ((($S' _26) (_777 65)) (($C _777) 90))) (($A :37 ((($S' _25) _35) _36)) (($A :38 ((($S' _26) (_777 48)) (($C _777) 57))) (($A :39 ((($S' _26) (_777 32)) (($C _777) 126))) (($A :40 _774) (($A :41 _775) (($A :42 _777) (($A :43 _776) (($A :44 ((($S' _25) (($C _40) 32)) ((($S' _25) (($C _40) 9)) (($C _40) 10)))) (($A :45 _745) (($A :46 _746) (($A :47 _747) (($A :48 _748) (($A :49 (_46 %0.0)) (($A :50 _45) (($A :51 _46) (($A :52 _47) (($A :53 _48) (($A :54 _749) (($A :55 _750) (($A :56 _54) (($A :57 _55) (($A :58 _751) (($A :59 _752) (($A :60 _753) (($A :61 _754) (($A :62 _58) (($A :63 _59) (($A :64 _60) (($A :65 _61) (($A :66 _755) (($A :67 (($B $BK) $T)) (($A :68 ($BK $T)) (($A :69 $P) (($A :70 $I) (($A :71 $B) (($A :72 $I) (($A :73 $K) (($A :74 $C) (($A :75 _781) (($A :76 (($C (($C $S') _183)) _184)) (($A :77 ((($C' ($S' ($C' $B))) $B) $I)) (($A :78 _739) (($A :79 _740) (($A :80 _741) (($A :81 _742) (($A :82 _743) (($A :83 _744) (($A :84 (_79 0)) (($A :85 _762) (($A :86 _763) (($A :87 _764) (($A :88 _765) (($A :89 _766) (($A :90 _767) (($A :91 _85) (($A :92 ($BK $K)) (($A :93 (($B $BK) (($B ($B $BK)) $P))) (($A :94 (($B ($B ($B $BK))) (($B ($B ($B $BK))) (($B ($B ($B $C))) (($B ($B $C)) $P))))) (($A :95 ((($S' $S) ((($S' ($S' $C)) ((($C' ($C' $S)) ((($C' $B) (($B ($S' $S')) ((($C' $B) (($B _25) (_88 0))) (_85 0)))) (($B ($B (($C' $P) (_83 1)))) _78))) ($C $P))) _81)) _82)) (($A :96 _92) (($A :97 ((($S' $C) (($B ($P _172)) ((($C' ($C' $B)) ((($C' $C) _85) _172)) _173))) (($B (($C' ($C' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) (($B (($C' ($C' ($C' $C))) (($B ($B ($B (($S' $S') (_85 0))))) (($B (($C' ($C' $C)) (($B ($B (($S' $S') (_85 1)))) (($B (($C' $C) (($B (($C' $S') (_85 2))) ($C _97)))) ($C _97))))) ($C _97))))) ($C _97)))) ($T $K))) ($T $A)))) (($C _95) 4)))) (($A :98 (_104 _73)) (($A :99 ((_119 (_76 _98)) _96)) (($A :100 (($C ((($C' $B) (($P _111) ((($C' ($C' $O)) $P) $K))) ((($S' ($C' ($C' ($C' $B)))) (($B ($B ($B ($B _101)))) ((($S' ($C' ($C' $B))) (($B ($B ($B _101))) ((($S' ($C' $B)) (($B ($B _101)) ((($C' $B) (($B _117) ($T 0))) _100))) ((($C' $B) (($B _117) ($T 1))) _100)))) ((($C' $B) (($B _117) ($T 2))) _100)))) ((($C' $B) (($B _117) ($T 3))) _100)))) (($B $T) (($B ($B $P)) (($C' _78) (_80 4)))))) (($A :101 (($S $S) (($B $BK) (($B $BK) ((($S' $S) $T) (($B $BK) (($B $BK) (($C ((($S' $C') $S) (($B ($B ($B ($S $B)))) (($B ($B ($B ($B ($B $BK))))) (($B (($S' ($C' $B)) (($B $B') $B'))) (($B ($B ($B ($B ($B ($S $B)))))) (($B ($B ($B ($B ($B ($B ($B $BK))))))) ((($C' $B) ($B' ($B' (($B ($C' ($C' ($C' $C)))) (($B (($C' $B) ($B' (($B $C) _87)))) (($B (($C' $B) _112)) _101)))))) (($B (($C' $B) _112)) ($C _101)))))))))) (((_737 "lib/Data/IntMap.hs") 3) 8))))))))) (($A :102 ((_71 (_117 _183)) _100)) (($A :103 ((($C' $C) ((($C' $C) ($C _97)) (_3 "Data.IntMap.!"))) $I)) (($A :104 (($B ((
\ No newline at end of file
--- a/ghc/Primitives.hs
+++ b/ghc/Primitives.hs
@@ -137,6 +137,9 @@
primDoubleMul :: Double -> Double -> Double
primDoubleMul = (*)
+primDoubleDiv :: Double -> Double -> Double
+primDoubleDiv = (/)
+
primDoubleEQ :: Double -> Double -> Bool
primDoubleEQ = (==)
--- a/lib/Data/Double.hs
+++ b/lib/Data/Double.hs
@@ -14,6 +14,8 @@
(-) = primDoubleSub
(*) :: Double -> Double -> Double
(*) = primDoubleMul
+(/) :: Double -> Double -> Double
+(/) = primDoubleDiv
negate :: Double -> Double
negate x = 0.0 - x
@@ -24,6 +26,8 @@
subDouble = (-)
mulDouble :: Double -> Double -> Double
mulDouble = (*)
+divDouble :: Double -> Double -> Double
+divDouble = (/)
--------------------------------
--- a/lib/Primitives.hs
+++ b/lib/Primitives.hs
@@ -35,6 +35,8 @@
primDoubleSub = primitive "fsub"
primDoubleMul :: Double -> Double -> Double
primDoubleMul = primitive "fmul"
+primDoubleDiv :: Double -> Double -> Double
+primDoubleDiv = primitive "fdiv"
primDoubleEQ :: Double -> Double -> Bool
primDoubleEQ = primitive "feq"
primDoubleNE :: Double -> Double -> Bool
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -149,7 +149,7 @@
enum node_tag { T_FREE, T_IND, T_AP, T_INT, T_DOUBLE, T_HDL, T_S, T_K, T_I, T_B, T_C,T_A, T_Y, T_SS, T_BB, T_CC, T_P, T_O, T_T, T_BK, T_ADD, T_SUB, T_MUL,
T_QUOT, T_REM, T_SUBR, T_UQUOT, T_UREM,
- T_FADD, T_FSUB, T_FMUL,
+ T_FADD, T_FSUB, T_FMUL, T_FDIV,
T_FEQ, T_FNE, T_FLT, T_FLE, T_FGT, T_FGE, T_FSHOW, T_FREAD,
T_EQ, T_NE, T_LT, T_LE, T_GT, T_GE, T_ULT, T_ULE, T_UGT, T_UGE,
T_ERROR, T_SEQ, T_EQUAL, T_COMPARE, T_RNF,
@@ -447,14 +447,15 @@
{ "fadd" , T_FADD}, { "fsub" , T_FSUB}, { "fmul" , T_FMUL},- {"feq", T_FEQ},- {"fne", T_FNE},- {"flt", T_FLT},- {"fle", T_FLE},- {"fgt", T_FGT},- {"fge", T_FGE},- {"fshow", T_FSHOW},- {"fread", T_FREAD},+ { "fdiv", T_FDIV},+ { "feq", T_FEQ},+ { "fne", T_FNE},+ { "flt", T_FLT},+ { "fle", T_FLE},+ { "fgt", T_FGT},+ { "fge", T_FGE},+ { "fshow", T_FSHOW},+ { "fread", T_FREAD}, { "==", T_EQ }, { "/=", T_NE }, { "<", T_LT },@@ -1186,9 +1187,10 @@
case T_UQUOT: fprintf(f, "$uquot"); break;
case T_UREM: fprintf(f, "$urem"); break;
case T_SUBR: fprintf(f, "$subtract"); break;
- case T_FADD: fprintf(f, "$fadd"); break;
- case T_FSUB: fprintf(f, "$fsub"); break;
- case T_FMUL: fprintf(f, "$fmul"); break;
+ case T_FADD: fprintf(f, "$fadd"); break;
+ case T_FSUB: fprintf(f, "$fsub"); break;
+ case T_FMUL: fprintf(f, "$fmul"); break;
+ case T_FDIV: fprintf(f, "$fdiv"); break;
case T_FEQ: fprintf(f, "$feq"); break;
case T_FNE: fprintf(f, "$fne"); break;
case T_FLT: fprintf(f, "$flt"); break;
@@ -1624,9 +1626,10 @@
case T_QUOT: ARITHBIN(/);
case T_REM: ARITHBIN(%);
case T_SUBR: OPINT2(r = yi - xi); SETINT(n, r); RET;
- case T_FADD: FARITHBIN(+);
- case T_FSUB: FARITHBIN(-);
- case T_FMUL: FARITHBIN(*);
+ case T_FADD: FARITHBIN(+);
+ case T_FSUB: FARITHBIN(-);
+ case T_FMUL: FARITHBIN(*);
+ case T_FDIV: FARITHBIN(/);
case T_FEQ: CMPF(==);
case T_FNE: CMPF(!=);
case T_FLT: CMPF(<);
--- a/tests/FArith.hs
+++ b/tests/FArith.hs
@@ -15,6 +15,8 @@
main = do
putStrLn $ showList D.showDouble [ op x y | x <- list1, y <- list2, op <- [D.addDouble, D.subDouble, D.mulDouble] ]
putStrLn $ showList showBool [ op x y | x <- list1, y <- list2, op <- [D.eqDouble, D.neqDouble, D.ltDouble, D.leDouble, D.gtDouble, D.geDouble] ]
+ putStrLn $ showList D.showDouble [ D.divDouble x y | x <- [2.234983, 1.232, 23.0], y <- [1.0, 5.0, 10.0, 100.0]]
+ putStrLn $ showList D.showDouble [ D.divDouble x y | x <- [-2.234983, -1.232, -23.0], y <- [1.0, -5.0, 10.0, -100.0]]
let str = readDouble "1.576"
putStrLn $ D.showDouble str
putStrLn $ D.showDouble $ D.addDouble 1.0 $ readDouble "2.5"
\ No newline at end of file
--- a/tests/FArith.ref
+++ b/tests/FArith.ref
@@ -1,4 +1,6 @@
[-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]
+[2.234983,0.446997,0.223498,0.02235,1.232,0.2464,0.1232,0.01232,23.0,4.6,2.3,0.23]
+[-2.234983,0.446997,-0.223498,0.02235,-1.232,0.2464,-0.1232,0.01232,-23.0,4.6,-2.3,0.23]
1.576
3.5
--
⑨