annotate src/fftw-3.3.3/genfft/assoctable.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 37bf6b4a2645
children
rev   line source
Chris@10 1 (*
Chris@10 2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
Chris@10 3 * Copyright (c) 2003, 2007-11 Matteo Frigo
Chris@10 4 * Copyright (c) 2003, 2007-11 Massachusetts Institute of Technology
Chris@10 5 *
Chris@10 6 * This program is free software; you can redistribute it and/or modify
Chris@10 7 * it under the terms of the GNU General Public License as published by
Chris@10 8 * the Free Software Foundation; either version 2 of the License, or
Chris@10 9 * (at your option) any later version.
Chris@10 10 *
Chris@10 11 * This program is distributed in the hope that it will be useful,
Chris@10 12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@10 13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
Chris@10 14 * GNU General Public License for more details.
Chris@10 15 *
Chris@10 16 * You should have received a copy of the GNU General Public License
Chris@10 17 * along with this program; if not, write to the Free Software
Chris@10 18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Chris@10 19 *
Chris@10 20 *)
Chris@10 21
Chris@10 22 (*************************************************************
Chris@10 23 * Functional associative table
Chris@10 24 *************************************************************)
Chris@10 25
Chris@10 26 (*
Chris@10 27 * this module implements a functional associative table.
Chris@10 28 * The table is parametrized by an equality predicate and
Chris@10 29 * a hash function, with the restriction that (equal a b) ==>
Chris@10 30 * hash a == hash b.
Chris@10 31 * The table is purely functional and implemented using a binary
Chris@10 32 * search tree (not balanced for now)
Chris@10 33 *)
Chris@10 34
Chris@10 35 type ('a, 'b) elem =
Chris@10 36 Leaf
Chris@10 37 | Node of int * ('a, 'b) elem * ('a, 'b) elem * ('a * 'b) list
Chris@10 38
Chris@10 39 let empty = Leaf
Chris@10 40
Chris@10 41 let lookup hash equal key table =
Chris@10 42 let h = hash key in
Chris@10 43 let rec look = function
Chris@10 44 Leaf -> None
Chris@10 45 | Node (hash_key, left, right, this_list) ->
Chris@10 46 if (hash_key < h) then look left
Chris@10 47 else if (hash_key > h) then look right
Chris@10 48 else let rec loop = function
Chris@10 49 [] -> None
Chris@10 50 | (a, b) :: rest -> if (equal key a) then Some b else loop rest
Chris@10 51 in loop this_list
Chris@10 52 in look table
Chris@10 53
Chris@10 54 let insert hash key value table =
Chris@10 55 let h = hash key in
Chris@10 56 let rec ins = function
Chris@10 57 Leaf -> Node (h, Leaf, Leaf, [(key, value)])
Chris@10 58 | Node (hash_key, left, right, this_list) ->
Chris@10 59 if (hash_key < h) then
Chris@10 60 Node (hash_key, ins left, right, this_list)
Chris@10 61 else if (hash_key > h) then
Chris@10 62 Node (hash_key, left, ins right, this_list)
Chris@10 63 else
Chris@10 64 Node (hash_key, left, right, (key, value) :: this_list)
Chris@10 65 in ins table