annotate src/fftw-3.3.5/genfft/variable.ml @ 83:ae30d91d2ffe

Replace these with versions built using an older toolset (so as to avoid ABI compatibilities when linking on Ubuntu 14.04 for packaging purposes)
author Chris Cannam
date Fri, 07 Feb 2020 11:51:13 +0000
parents 2cd0e3b3e1fd
children
rev   line source
Chris@42 1 (*
Chris@42 2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
Chris@42 3 * Copyright (c) 2003, 2007-14 Matteo Frigo
Chris@42 4 * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
Chris@42 5 *
Chris@42 6 * This program is free software; you can redistribute it and/or modify
Chris@42 7 * it under the terms of the GNU General Public License as published by
Chris@42 8 * the Free Software Foundation; either version 2 of the License, or
Chris@42 9 * (at your option) any later version.
Chris@42 10 *
Chris@42 11 * This program is distributed in the hope that it will be useful,
Chris@42 12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@42 13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
Chris@42 14 * GNU General Public License for more details.
Chris@42 15 *
Chris@42 16 * You should have received a copy of the GNU General Public License
Chris@42 17 * along with this program; if not, write to the Free Software
Chris@42 18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Chris@42 19 *
Chris@42 20 *)
Chris@42 21
Chris@42 22 type variable =
Chris@42 23 (* temporary variables generated automatically *)
Chris@42 24 | Temporary of int
Chris@42 25 (* memory locations, e.g., array elements *)
Chris@42 26 | Locative of (Unique.unique * Unique.unique *
Chris@42 27 (int -> string) * int * string)
Chris@42 28 (* constant values, e.g., twiddle factors *)
Chris@42 29 | Constant of (Unique.unique * string)
Chris@42 30
Chris@42 31 let hash v = Hashtbl.hash v
Chris@42 32
Chris@42 33 let same a b = (a == b)
Chris@42 34
Chris@42 35 let is_constant = function
Chris@42 36 | Constant _ -> true
Chris@42 37 | _ -> false
Chris@42 38
Chris@42 39 let is_temporary = function
Chris@42 40 | Temporary _ -> true
Chris@42 41 | _ -> false
Chris@42 42
Chris@42 43 let is_locative = function
Chris@42 44 | Locative _ -> true
Chris@42 45 | _ -> false
Chris@42 46
Chris@42 47 let same_location a b =
Chris@42 48 match (a, b) with
Chris@42 49 | (Locative (location_a, _, _, _, _), Locative (location_b, _, _, _, _)) ->
Chris@42 50 Unique.same location_a location_b
Chris@42 51 | _ -> false
Chris@42 52
Chris@42 53 let same_class a b =
Chris@42 54 match (a, b) with
Chris@42 55 | (Locative (_, class_a, _, _, _), Locative (_, class_b, _, _, _)) ->
Chris@42 56 Unique.same class_a class_b
Chris@42 57 | (Constant (class_a, _), Constant (class_b, _)) ->
Chris@42 58 Unique.same class_a class_b
Chris@42 59 | _ -> false
Chris@42 60
Chris@42 61 let make_temporary =
Chris@42 62 let tmp_count = ref 0
Chris@42 63 in fun () -> begin
Chris@42 64 tmp_count := !tmp_count + 1;
Chris@42 65 Temporary !tmp_count
Chris@42 66 end
Chris@42 67
Chris@42 68 let make_constant class_token name =
Chris@42 69 Constant (class_token, name)
Chris@42 70
Chris@42 71 let make_locative location_token class_token name i vs =
Chris@42 72 Locative (location_token, class_token, name, i, vs)
Chris@42 73
Chris@42 74 let vstride_of_locative = function
Chris@42 75 | Locative (_, _, _, _, vs) -> vs
Chris@42 76 | _ -> failwith "vstride_of_locative"
Chris@42 77
Chris@42 78 (* special naming conventions for variables *)
Chris@42 79 let rec base62_of_int k =
Chris@42 80 let x = k mod 62
Chris@42 81 and y = k / 62 in
Chris@42 82 let c =
Chris@42 83 if x < 10 then
Chris@42 84 Char.chr (x + Char.code '0')
Chris@42 85 else if x < 36 then
Chris@42 86 Char.chr (x + Char.code 'a' - 10)
Chris@42 87 else
Chris@42 88 Char.chr (x + Char.code 'A' - 36)
Chris@42 89 in
Chris@42 90 let s = String.make 1 c in
Chris@42 91 let r = if y == 0 then "" else base62_of_int y in
Chris@42 92 r ^ s
Chris@42 93
Chris@42 94 let varname_of_int k =
Chris@42 95 if !Magic.compact then
Chris@42 96 base62_of_int k
Chris@42 97 else
Chris@42 98 string_of_int k
Chris@42 99
Chris@42 100 let unparse = function
Chris@42 101 | Temporary k -> "T" ^ (varname_of_int k)
Chris@42 102 | Constant (_, name) -> name
Chris@42 103 | Locative (_, _, name, i, _) -> name i
Chris@42 104
Chris@42 105 let unparse_for_alignment m = function
Chris@42 106 | Locative (_, _, name, i, _) -> name (i mod m)
Chris@42 107 | _ -> failwith "unparse_for_alignment"
Chris@42 108