2035d6c · Idris-dev · git.iko.soy

libs/prelude/Prelude/Doubles.idr+1−1

compare with master

unifiedsplit

@@ -43,7 +43,7 @@ atan : Double -> Double

43atan x = prim__floatATan x

44

45atan2 : Double -> Double -> Double

46−atan2 y x = atan (y/x)

46+atan2 y x = prim__floatATan2 y x

47

48sinh : Double -> Double

49sinh x = (exp x - exp (-x)) / 2

src/IRTS/CodegenC.hs+1

@@ -576,6 +576,7 @@ doOp v LFSqrt [x] = v ++ flUnOp "sqrt" (creg x)

576doOp v LFFloor [x] = v ++ flUnOp "floor" (creg x)

577doOp v LFCeil [x] = v ++ flUnOp "ceil" (creg x)

578doOp v LFNegate [x] = v ++ "MKFLOAT(vm, -GETFLOAT(" ++ (creg x) ++ "))"

579+doOp v LFATan2 [y, x] = v ++ "MKFLOAT(vm, atan2(GETFLOAT(" ++ creg y ++ "), GETFLOAT(" ++ creg x ++ ")))"

579

580

580-- String functions which don't need to know we're UTF8

581-- String functions which don't need to know we're UTF8

581doOp v LStrConcat [l,r] = v ++ "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

582doOp v LStrConcat [l,r] = v ++ "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

src/IRTS/JavaScript/PrimOp.hs+1

@@ -217,6 +217,7 @@ primDB =

217 , item LFASin False PTAny $ jsAppN "Math.asin"

218 , item LFACos False PTAny $ jsAppN "Math.acos"

219 , item LFATan False PTAny $ jsAppN "Math.atan"

220+ , item LFATan2 False PTAny $ jsAppN "Math.atan2"

220 , item LFSqrt False PTAny $ jsAppN "Math.sqrt"

221 , item LFSqrt False PTAny $ jsAppN "Math.sqrt"

221 , item LFFloor False PTAny $ jsAppN "Math.floor"

222 , item LFFloor False PTAny $ jsAppN "Math.floor"

222 , item LFCeil False PTAny $ jsAppN "Math.ceil"

223 , item LFCeil False PTAny $ jsAppN "Math.ceil"

src/IRTS/Lang.hs+1−1

@@ -81,7 +81,7 @@ data PrimFn = LPlus ArithTy | LMinus ArithTy | LTimes ArithTy

81 | LBitCast ArithTy ArithTy -- Only for values of equal width

82

84− | LFSqrt | LFFloor | LFCeil | LFNegate

85

87 | LReadStr | LWriteStr

src/IRTS/Portable.hs+1

@@ -184,6 +184,7 @@ instance ToJSON PrimFn where

184 toJSON LFASin = object ["LFASin" .= Null]

185 toJSON LFACos = object ["LFACos" .= Null]

186 toJSON LFATan = object ["LFATan" .= Null]

187+ toJSON LFATan2 = object ["LFATan2" .= Null]

187 toJSON LFSqrt = object ["LFSqrt" .= Null]

188 toJSON LFSqrt = object ["LFSqrt" .= Null]

188 toJSON LFFloor = object ["LFFloor" .= Null]

189 toJSON LFFloor = object ["LFFloor" .= Null]

189 toJSON LFCeil = object ["LFCeil" .= Null]

190 toJSON LFCeil = object ["LFCeil" .= Null]

src/Idris/Primitives.hs+6

@@ -148,6 +148,8 @@ primitives =

148 (1, LFACos) total,

149 Prim (sUN "prim__floatATan") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatATan)

150 (1, LFATan) total,

151+ Prim (sUN "prim__floatATan2") (ty [(AType ATFloat), (AType ATFloat)] (AType ATFloat)) 2 (p_floatATan2)

152+ (2, LFATan2) total,

151 Prim (sUN "prim__floatSqrt") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatSqrt)

153 Prim (sUN "prim__floatSqrt") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatSqrt)

152 (1, LFSqrt) total,

154 (1, LFSqrt) total,

153 Prim (sUN "prim__floatFloor") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatFloor)

155 Prim (sUN "prim__floatFloor") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatFloor)

@@ -462,6 +464,10 @@ p_floatSqrt = p_fPrim sqrt

462p_floatFloor = p_fPrim (fromInteger . floor)

464p_floatFloor = p_fPrim (fromInteger . floor)

463p_floatCeil = p_fPrim (fromInteger . ceiling)

465p_floatCeil = p_fPrim (fromInteger . ceiling)

464

466

467+p_floatATan2 :: [Const] -> Maybe Const

468+p_floatATan2 [Fl y, Fl x] = Just $ Fl (atan2 y x)

469+p_floatATan2 _ = Nothing

470+

465p_strLen, p_strHead, p_strTail, p_strIndex, p_strCons, p_strRev, p_strSubstr :: [Const] -> Maybe Const

471p_strLen, p_strHead, p_strTail, p_strIndex, p_strCons, p_strRev, p_strSubstr :: [Const] -> Maybe Const

466p_strLen [Str xs] = Just $ I (length xs)

472p_strLen [Str xs] = Just $ I (length xs)

467p_strLen _ = Nothing

473p_strLen _ = Nothing

test/TestData.hs+2−1

@@ -75,7 +75,8 @@ testFamiliesData = [

75 ( 21, C_CG ),

76 ( 22, NODE_CG ),

77 ( 23, ANY ),

78− ( 24, ANY )]),

78+ ( 24, ANY ),

79+ ( 25, ANY )]),

79 ("bignum", "Bignum",

80 ("bignum", "Bignum",

80 [ ( 1, ANY ),

81 [ ( 1, ANY ),

81 ( 2, ANY )]),

82 ( 2, ANY )]),

test/basic025/basic025.idrnew file+28

@@ -0,0 +1,28 @@

1+module basic025

2+

3+-- converting data from strings at runtime so as to prevent the

4+-- compiler of eliding the calls to atan2 via constant folding

5+input : List (String, String, String)

6+input = [

7+ ("atan2", " 1", " 1"),

8+ ("atan2", "-1", " 1"),

9+ ("atan2", " 1", "-1"),

10+ ("atan2", "-1", "-1"),

11+ ("atan2", " 0", " 1"),

12+ ("atan2", " 1", " 0")

13+]

14+

15+round : Double -> Double

16+round x = let y = x * 1e10

17+ z = if y < 0 then (ceiling y) else (floor y)

18+ in z / 1e10

19+

20+-- the input file is read at runtime so as to prevent the compiler of

21+-- eliding the calls to atan2 via constant folding

22+namespace Main

23+ main : IO ()

24+ main = traverse_ evalInput input

25+ where

26+ evalInput : (String, String, String) -> IO ()

27+ evalInput ("atan2", y, x) = printLn $ round $ atan2 (cast y) (cast x)

28+ evalInput _ = putStrLn $ "Could not eval line"

test/basic025/expectednew file+12

@@ -0,0 +1,12 @@

1+0.7853981633974483 : Double

2+-0.7853981633974483 : Double

3+2.356194490192345 : Double

4+-2.356194490192345 : Double

5+0.0 : Double

6+1.5707963267948966 : Double

7+0.7853981633

8+-0.7853981633

9+2.3561944901

10+-2.3561944901

11+0

12+1.5707963267

test/basic025/inputnew file+7

@@ -0,0 +1,7 @@

1+:x atan2 1 1

2+:x atan2 (-1) 1

3+:x atan2 1 (-1)

4+:x atan2 (-1) (-1)

5+

6+:x atan2 0 1

7+:x atan2 1 0

test/basic025/runnew file+7

@@ -0,0 +1,7 @@

1+#!/usr/bin/env bash

2+${IDRIS:-idris} $@ --quiet --port none < input

3+${IDRIS:-idris} $@ -o basic025 basic025.idr

4+

5+./basic025 input

6+

7+rm -f basic025 *.ibc