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

git.iko.soy/Idris-dev

Use native `atan2` function from backend

The implementation of `atan2` in Idris was broken. Instead of fixing the implementation the native function of the backend was used instead because it's both correct and faster. Fixes #3497.

commit2035d6cdaa923e97d10c0507500d01a2ad8ea411 authorAlex Queiroz <asandroq@gmail.com> dateFri 3 Nov 2017, 02:11 (9 years ago) parent774d1b6

11 files changed+67−3

compare with master

unifiedsplit

libs/prelude/Prelude/Doubles.idr+1−1 src/IRTS/CodegenC.hs+1 src/IRTS/JavaScript/PrimOp.hs+1 src/IRTS/Lang.hs+1−1 src/IRTS/Portable.hs+1 src/Idris/Primitives.hs+6 test/TestData.hs+2−1 test/basic025/basic025.idr+28 test/basic025/expected+12 test/basic025/input+7 test/basic025/run+7

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

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

4343atan x = prim__floatATan x

4444

4545atan2 : Double -> Double -> Double

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

46+atan2 y x = prim__floatATan2 y x

4747

4848sinh : Double -> Double

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

src/IRTS/CodegenC.hs+1

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

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

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

578578doOp 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 ++ ")))"

579580

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

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

src/IRTS/JavaScript/PrimOp.hs+1

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

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

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

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

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

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

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

222223 , 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

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

8282

84− | LFSqrt | LFFloor | LFCeil | LFNegate

8585

8787 | LReadStr | LWriteStr

src/IRTS/Portable.hs+1

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

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

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

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

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

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

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

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

src/Idris/Primitives.hs+6

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

148148 (1, LFACos) total,

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

150150 (1, LFATan) total,

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

152+ (2, LFATan2) total,

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

152154 (1, LFSqrt) total,

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

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

462464p_floatFloor = p_fPrim (fromInteger . floor)

463465p_floatCeil = p_fPrim (fromInteger . ceiling)

464466

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

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

469+p_floatATan2 _ = Nothing

470+

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

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

467473p_strLen _ = Nothing

test/TestData.hs+2−1

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

7575 ( 21, C_CG ),

7676 ( 22, NODE_CG ),

7777 ( 23, ANY ),

78− ( 24, ANY )]),

78+ ( 24, ANY ),

79+ ( 25, ANY )]),

7980 ("bignum", "Bignum",

8081 [ ( 1, ANY ),

8182 ( 2, ANY )]),

test/basic025/basic025.idrnew file+28

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

1+module basic025

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)

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

5+./basic025 input

7+rm -f basic025 *.ibc