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