cannam@95: (* cannam@95: * Copyright (c) 1997-1999 Massachusetts Institute of Technology cannam@95: * Copyright (c) 2003, 2007-11 Matteo Frigo cannam@95: * Copyright (c) 2003, 2007-11 Massachusetts Institute of Technology cannam@95: * cannam@95: * This program is free software; you can redistribute it and/or modify cannam@95: * it under the terms of the GNU General Public License as published by cannam@95: * the Free Software Foundation; either version 2 of the License, or cannam@95: * (at your option) any later version. cannam@95: * cannam@95: * This program is distributed in the hope that it will be useful, cannam@95: * but WITHOUT ANY WARRANTY; without even the implied warranty of cannam@95: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the cannam@95: * GNU General Public License for more details. cannam@95: * cannam@95: * You should have received a copy of the GNU General Public License cannam@95: * along with this program; if not, write to the Free Software cannam@95: * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA cannam@95: * cannam@95: *) cannam@95: cannam@95: (* Here, we define the data type encapsulating a symbolic arithmetic cannam@95: expression, and provide some routines for manipulating it. *) cannam@95: cannam@95: (* I will regret this hack : *) cannam@95: (* NEWS: I did *) cannam@95: type transcendent = I | MULTI_A | MULTI_B | CONJ cannam@95: cannam@95: type expr = cannam@95: | Num of Number.number cannam@95: | NaN of transcendent cannam@95: | Plus of expr list cannam@95: | Times of expr * expr cannam@95: | CTimes of expr * expr cannam@95: | CTimesJ of expr * expr (* CTimesJ (a, b) = conj(a) * b *) cannam@95: | Uminus of expr cannam@95: | Load of Variable.variable cannam@95: | Store of Variable.variable * expr cannam@95: cannam@95: type assignment = Assign of Variable.variable * expr cannam@95: cannam@95: (* various hash functions *) cannam@95: let hash_float x = cannam@95: let (mantissa, exponent) = frexp x cannam@95: in truncate (float_of_int(exponent) *. 1234.567 +. mantissa *. 10000.0) cannam@95: cannam@95: let sum_list l = List.fold_right (+) l 0 cannam@95: cannam@95: let transcendent_to_float = function cannam@95: | I -> 2.718281828459045235360287471 (* any transcendent number will do *) cannam@95: | MULTI_A -> 0.6931471805599453094172321214 cannam@95: | MULTI_B -> -0.3665129205816643270124391582 cannam@95: | CONJ -> 0.6019072301972345747375400015 cannam@95: cannam@95: let rec hash = function cannam@95: | Num x -> hash_float (Number.to_float x) cannam@95: | NaN x -> hash_float (transcendent_to_float x) cannam@95: | Load v -> 1 + 1237 * Variable.hash v cannam@95: | Store (v, x) -> 2 * Variable.hash v - 2345 * hash x cannam@95: | Plus l -> 5 + 23451 * sum_list (List.map Hashtbl.hash l) cannam@95: | Times (a, b) -> 41 + 31415 * (Hashtbl.hash a + Hashtbl.hash b) cannam@95: | CTimes (a, b) -> 49 + 3245 * (Hashtbl.hash a + Hashtbl.hash b) cannam@95: | CTimesJ (a, b) -> 31 + 3471 * (Hashtbl.hash a + Hashtbl.hash b) cannam@95: | Uminus x -> 42 + 12345 * (hash x) cannam@95: cannam@95: (* find all variables *) cannam@95: let rec find_vars x = cannam@95: match x with cannam@95: | Load y -> [y] cannam@95: | Plus l -> List.flatten (List.map find_vars l) cannam@95: | Times (a, b) -> (find_vars a) @ (find_vars b) cannam@95: | CTimes (a, b) -> (find_vars a) @ (find_vars b) cannam@95: | CTimesJ (a, b) -> (find_vars a) @ (find_vars b) cannam@95: | Uminus a -> find_vars a cannam@95: | _ -> [] cannam@95: cannam@95: cannam@95: (* TRUE if expression is a constant *) cannam@95: let is_constant = function cannam@95: | Num _ -> true cannam@95: | NaN _ -> true cannam@95: | Load v -> Variable.is_constant v cannam@95: | _ -> false cannam@95: cannam@95: let is_known_constant = function cannam@95: | Num _ -> true cannam@95: | NaN _ -> true cannam@95: | _ -> false cannam@95: cannam@95: (* expr to string, used for debugging *) cannam@95: let rec foldr_string_concat l = cannam@95: match l with cannam@95: [] -> "" cannam@95: | [a] -> a cannam@95: | a :: b -> a ^ " " ^ (foldr_string_concat b) cannam@95: cannam@95: let string_of_transcendent = function cannam@95: | I -> "I" cannam@95: | MULTI_A -> "MULTI_A" cannam@95: | MULTI_B -> "MULTI_B" cannam@95: | CONJ -> "CONJ" cannam@95: cannam@95: let rec to_string = function cannam@95: | Load v -> Variable.unparse v cannam@95: | Num n -> string_of_float (Number.to_float n) cannam@95: | NaN n -> string_of_transcendent n cannam@95: | Plus x -> "(+ " ^ (foldr_string_concat (List.map to_string x)) ^ ")" cannam@95: | Times (a, b) -> "(* " ^ (to_string a) ^ " " ^ (to_string b) ^ ")" cannam@95: | CTimes (a, b) -> "(c* " ^ (to_string a) ^ " " ^ (to_string b) ^ ")" cannam@95: | CTimesJ (a, b) -> "(cj* " ^ (to_string a) ^ " " ^ (to_string b) ^ ")" cannam@95: | Uminus a -> "(- " ^ (to_string a) ^ ")" cannam@95: | Store (v, a) -> "(:= " ^ (Variable.unparse v) ^ " " ^ cannam@95: (to_string a) ^ ")" cannam@95: cannam@95: let rec to_string_a d x = cannam@95: if (d = 0) then "..." else match x with cannam@95: | Load v -> Variable.unparse v cannam@95: | Num n -> Number.to_konst n cannam@95: | NaN n -> string_of_transcendent n cannam@95: | Plus x -> "(+ " ^ (foldr_string_concat (List.map (to_string_a (d - 1)) x)) ^ ")" cannam@95: | Times (a, b) -> "(* " ^ (to_string_a (d - 1) a) ^ " " ^ (to_string_a (d - 1) b) ^ ")" cannam@95: | CTimes (a, b) -> "(c* " ^ (to_string_a (d - 1) a) ^ " " ^ (to_string_a (d - 1) b) ^ ")" cannam@95: | CTimesJ (a, b) -> "(cj* " ^ (to_string_a (d - 1) a) ^ " " ^ (to_string_a (d - 1) b) ^ ")" cannam@95: | Uminus a -> "(- " ^ (to_string_a (d-1) a) ^ ")" cannam@95: | Store (v, a) -> "(:= " ^ (Variable.unparse v) ^ " " ^ cannam@95: (to_string_a (d-1) a) ^ ")" cannam@95: cannam@95: let to_string = to_string_a 10 cannam@95: cannam@95: let assignment_to_string = function cannam@95: | Assign (v, a) -> "(:= " ^ (Variable.unparse v) ^ " " ^ (to_string a) ^ ")" cannam@95: cannam@95: let dump print = List.iter (fun x -> print ((assignment_to_string x) ^ "\n")) cannam@95: cannam@95: (* find all constants in a given expression *) cannam@95: let rec expr_to_constants = function cannam@95: | Num n -> [n] cannam@95: | Plus a -> List.flatten (List.map expr_to_constants a) cannam@95: | Times (a, b) -> (expr_to_constants a) @ (expr_to_constants b) cannam@95: | CTimes (a, b) -> (expr_to_constants a) @ (expr_to_constants b) cannam@95: | CTimesJ (a, b) -> (expr_to_constants a) @ (expr_to_constants b) cannam@95: | Uminus a -> expr_to_constants a cannam@95: | _ -> [] cannam@95: cannam@95: cannam@95: let add_float_key_value list_so_far k = cannam@95: if List.exists (fun k2 -> Number.equal k k2) list_so_far then cannam@95: list_so_far cannam@95: else cannam@95: k :: list_so_far cannam@95: cannam@95: let unique_constants = List.fold_left add_float_key_value []