2
* Copyright (c) 1997-1999 Massachusetts Institute of Technology
3
* Copyright (c) 2003, 2006 Matteo Frigo
4
* Copyright (c) 2003, 2006 Massachusetts Institute of Technology
6
* This program is free software; you can redistribute it and/or modify
7
* it under the terms of the GNU General Public License as published by
8
* the Free Software Foundation; either version 2 of the License, or
9
* (at your option) any later version.
11
* This program is distributed in the hope that it will be useful,
12
* but WITHOUT ANY WARRANTY; without even the implied warranty of
13
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14
* GNU General Public License for more details.
16
* You should have received a copy of the GNU General Public License
17
* along with this program; if not, write to the Free Software
18
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21
(* $Id: oracle.ml,v 1.9 2006-02-13 01:12:10 athena Exp $ *)
24
* the oracle decrees whether the sign of an expression should
27
* Say the expression (A - B) appears somewhere. Elsewhere in the
28
* expression dag the expression (B - A) may appear.
29
* The oracle determines which of the two forms is canonical.
31
* Algorithm: evaluate the expression at a random input, and
32
* keep the expression with the positive sign.
35
let make_memoizer hash equal =
36
let table = ref Assoctable.empty
39
match Assoctable.lookup hash equal k !table with
44
table := Assoctable.insert hash k value !table;
48
let almost_equal x y =
49
let epsilon = 1.0E-8 in
50
(abs_float (x -. y) < epsilon) ||
51
(abs_float (x -. y) < epsilon *. (abs_float x +. abs_float y))
53
let absid = make_memoizer
54
(fun x -> Expr.hash_float (abs_float x))
55
(fun a b -> almost_equal a b || almost_equal (-. a) b)
58
let make_random_oracle () = make_memoizer
61
(fun _ -> (float (Random.bits())) /. 1073741824.0)
63
let the_random_oracle = make_random_oracle ()
65
let sum_list l = List.fold_right (+.) l 0.0
67
let eval_aux random_oracle =
68
let memoizing = make_memoizer Expr.hash (==) in
72
| Expr.Num x -> Number.to_float x
73
| Expr.NaN x -> Expr.transcendent_to_float x
74
| Expr.Load v -> random_oracle v
75
| Expr.Store (v, x) -> eval x
76
| Expr.Plus l -> sum_list (List.map eval l)
77
| Expr.Times (a, b) -> (eval a) *. (eval b)
78
| Expr.CTimes (a, b) ->
79
1.098612288668109691395245236 +.
80
1.609437912434100374600759333 *. (eval a) *. (eval b)
81
| Expr.CTimesJ (a, b) ->
82
0.9102392266268373936142401657 +.
83
0.6213349345596118107071993881 *. (eval a) *. (eval b)
84
| Expr.Uminus x -> -. (eval x))
88
let eval = eval_aux the_random_oracle
90
let should_flip_sign node =
93
not (almost_equal v v')
96
* determine with high probability if two expressions are equal.
98
* The test is randomized: if the two expressions have the
99
* same value for NTESTS random inputs, then they are proclaimed
100
* equal. (Note that two distinct linear functions L1(x0, x1, ..., xn)
101
* and L2(x0, x1, ..., xn) have the same value with probability
102
* 0 for random x's, and thus this test is way more paranoid than
105
let likely_equal a b =
106
let tolerance = 1.0e-8
113
let r = make_random_oracle () in
114
let va = eval_aux r a
115
and vb = eval_aux r b
117
if (abs_float (va -. vb)) >
118
tolerance *. (abs_float va +. abs_float vb +. 0.0001)
127
* Because of the way eval is constructed, we have
128
* eval (Store (v, x)) == eval x
129
* However, we never consider the two expressions equal
131
| (Expr.Store _, _) -> false
132
| (_, Expr.Store _) -> false
135
* Expressions of the form ``Uminus (Store _)''
136
* are artifacts of algsimp
138
| ((Expr.Uminus (Expr.Store _)), _) -> false
139
| (_, Expr.Uminus (Expr.Store _)) -> false
145
truncate (f *. 65536.0)