Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/PervEnv/Basis/c-math64.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/PervEnv/Basis/c-math64.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 89 - (view) (download)

1 : monnier 89 (* c-math64.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * An implementation of the Math64 structure based on C.
6 :     *
7 :     *)
8 :    
9 :     structure Math64 : MATH =
10 :     struct
11 :     val pi = 3.14159265358979323846
12 :     val e = 2.7182818284590452354
13 :    
14 :     structure CI = CInterface
15 :     val libname = "SMLNJ-Math"
16 :     val cfun = CI.c_function libname
17 :    
18 :     val cos : real -> real = cfun "c_cos"
19 :     val sin : real -> real = cfun "c_sin"
20 :    
21 :     type errno = int
22 :    
23 :     local
24 :     (* c_exp sets error on overflow; errno = ERANGE and res <> 0.0 *)
25 :     val exp' : real -> (real * errno) = cfun "c_exp"
26 :     in
27 :     fun exp x = let val (res,err) = exp' x
28 :     in
29 :     if err <> 0 then if res <> 0.0 then raise Overflow
30 :     else raise General.Domain
31 :     else res
32 :     end
33 :     end
34 :    
35 :     local
36 :     val ln' : real -> real = cfun "c_log"
37 :     in
38 :     fun ln x = if x <= 0.0 then raise General.Domain
39 :     else ln' x
40 :     end
41 :    
42 :     local
43 :     val sqrt' : real -> real = cfun "c_sqrt"
44 :     in
45 :     fun sqrt x = if x < 0.0 then raise General.Domain
46 :     else sqrt' x
47 :     end
48 :    
49 :     local
50 :     val PI = 3.1415926535897932385E0
51 :     val PIo2 = 1.5707963267948966192E0
52 :     val one = 1.0
53 :    
54 :     val atan' : real -> real = cfun "c_atan"
55 :     fun atanpy y = (* y>=0 *)
56 :     if y>one then PIo2 - atan'(one/y) else atan'(y)
57 :    
58 :     fun atan2pypx(x,y) =
59 :     if y>x then PIo2 - atan'(x/y) else atan'(y/x)
60 :     fun atan2py(x,y) =
61 :     if x >= 0.0 then atan2pypx(x,y)
62 :     else if x = 0.0 andalso y = 0.0 then 0.0
63 :     else PI - atan2pypx(~x,y)
64 :     in
65 :     fun atan y = if y<=0.0 then ~(atanpy(~y)) else atanpy y
66 :     fun atan2(x,y) = if y>=0.0 then atan2py(x,y) else ~(atan2py(x,~y))
67 :     end
68 :    
69 :     end (* struct Math64 *)
70 :    
71 :    
72 :     (*
73 :     * $Log: c-math64.sml,v $
74 :     * Revision 1.1.1.1 1998/04/08 18:40:04 george
75 :     * Version 110.5
76 :     *
77 :     *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0