From patchwork Mon Aug 17 18:45:49 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?b?RWR3aW4gVMO2csO2aw==?= X-Patchwork-Id: 11719119 Return-Path: Received: from mail.kernel.org (pdx-korg-mail-1.web.codeaurora.org [172.30.200.123]) by pdx-korg-patchwork-2.web.codeaurora.org (Postfix) with ESMTP id F0C25618 for ; Mon, 17 Aug 2020 18:47:17 +0000 (UTC) Received: from lists.xenproject.org (lists.xenproject.org [192.237.175.120]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by mail.kernel.org (Postfix) with ESMTPS id CB037204EC for ; Mon, 17 Aug 2020 18:47:17 +0000 (UTC) Authentication-Results: mail.kernel.org; dkim=fail reason="signature verification failed" (1024-bit key) header.d=citrix.com header.i=@citrix.com header.b="YarQVwnh" DMARC-Filter: OpenDMARC Filter v1.3.2 mail.kernel.org CB037204EC Authentication-Results: mail.kernel.org; dmarc=fail (p=reject dis=none) header.from=citrix.com Authentication-Results: mail.kernel.org; spf=pass smtp.mailfrom=xen-devel-bounces@lists.xenproject.org Received: from localhost ([127.0.0.1] helo=lists.xenproject.org) by lists.xenproject.org with esmtp (Exim 4.92) (envelope-from ) id 1k7k9H-0007BD-Ta; Mon, 17 Aug 2020 18:46:23 +0000 Received: from all-amaz-eas1.inumbo.com ([34.197.232.57] helo=us1-amaz-eas2.inumbo.com) by lists.xenproject.org with esmtp (Exim 4.92) (envelope-from ) id 1k7k9G-00077W-75 for xen-devel@lists.xenproject.org; Mon, 17 Aug 2020 18:46:22 +0000 X-Inumbo-ID: 6ef2805e-1acc-4e5f-a61a-c504d5ab3eaa Received: from esa3.hc3370-68.iphmx.com (unknown [216.71.145.155]) by us1-amaz-eas2.inumbo.com (Halon) with ESMTPS id 6ef2805e-1acc-4e5f-a61a-c504d5ab3eaa; Mon, 17 Aug 2020 18:46:12 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=simple/simple; d=citrix.com; s=securemail; t=1597689973; h=from:to:cc:subject:date:message-id:in-reply-to: references:mime-version:content-transfer-encoding; bh=+Bs+Fxq+yO/S2L4Mgyr+mCqf669K6A0XW3wC71rhZYE=; b=YarQVwnhk4b4IT1LUe6IKMhdmpF+AOec++vuHWXWlikwJpnDdVhLJ7OR 5sDCC4wKSq07V6D7I6M8ObwXtDlgolXig9sGB6PQXta0utuDsEuCLzfqT S346eg+zx5ezZedSOwx5rp1pFyFiE6SP1714ePYhuZl2hPsZCvCx661G4 0=; Authentication-Results: esa3.hc3370-68.iphmx.com; dkim=none (message not signed) header.i=none IronPort-SDR: BuaZh/DF1t0UIsGC8/rozmT7BIXmNHCeYw9ecpYu2h7H91NleIEeqlXDsinXhBXChQXo6Ach1g QVY96YuNEylQoCtBcaEOrxY820A9JC3Wb7jq06gWN+ZFgE8O/4NQS6YFjHwLoB+jqZcGxHMfsn y6AKM/09sm3W9/N4X8lr9vG8RgzCSismBYui7hfpZ/ERg1C2xs5NPr2E4npnpGQ2wE1MC5xA/0 q7EdMiM9ljEM3nLUM9xugZzpd0pb9pTMvfq6VZDLwvEyCebkhZeqswIpUazFJ7VVua0yq8kVJI wUU= X-SBRS: 2.7 X-MesageID: 24693226 X-Ironport-Server: esa3.hc3370-68.iphmx.com X-Remote-IP: 162.221.158.21 X-Policy: $RELAYED X-IronPort-AV: E=Sophos;i="5.76,324,1592884800"; d="scan'208";a="24693226" From: =?utf-8?b?RWR3aW4gVMO2csO2aw==?= To: CC: =?utf-8?b?RWR3aW4gVMO2csO2aw==?= Subject: [PATCH v3 6/6] tools/ocaml/xenstored: use more efficient tries Date: Mon, 17 Aug 2020 19:45:49 +0100 Message-ID: X-Mailer: git-send-email 2.25.1 In-Reply-To: References: MIME-Version: 1.0 X-BeenThere: xen-devel@lists.xenproject.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Xen developer discussion List-Unsubscribe: , List-Post: List-Help: List-Subscribe: , Errors-To: xen-devel-bounces@lists.xenproject.org Sender: "Xen-devel" No functional change, just an optimization. Signed-off-by: Edwin Török --- Changed since v1: * fix missing 'set_node' in 'set' that got lost in conversion to map * simplify 'compare' function --- tools/ocaml/xenstored/connections.ml | 2 +- tools/ocaml/xenstored/symbol.ml | 6 +-- tools/ocaml/xenstored/trie.ml | 59 ++++++++++++---------------- tools/ocaml/xenstored/trie.mli | 26 ++++++------ 4 files changed, 43 insertions(+), 50 deletions(-) diff --git a/tools/ocaml/xenstored/connections.ml b/tools/ocaml/xenstored/connections.ml index f02ef6b526..4983c7370b 100644 --- a/tools/ocaml/xenstored/connections.ml +++ b/tools/ocaml/xenstored/connections.ml @@ -21,7 +21,7 @@ type t = { anonymous: (Unix.file_descr, Connection.t) Hashtbl.t; domains: (int, Connection.t) Hashtbl.t; ports: (Xeneventchn.t, Connection.t) Hashtbl.t; - mutable watches: (string, Connection.watch list) Trie.t; + mutable watches: Connection.watch list Trie.t; } let create () = { diff --git a/tools/ocaml/xenstored/symbol.ml b/tools/ocaml/xenstored/symbol.ml index 2697915623..85b3f265de 100644 --- a/tools/ocaml/xenstored/symbol.ml +++ b/tools/ocaml/xenstored/symbol.ml @@ -31,9 +31,9 @@ let equal a b = (* compare using physical equality, both members have to be part of the above weak table *) a == b -let compare a b = - if equal a b then 0 - else -(String.compare a b) +(* the sort order is reversed here, so that Map.fold constructs a list + in ascending order *) +let compare a b = String.compare b a let stats () = let len, entries, _, _, _, _ = WeakTable.stats tbl in diff --git a/tools/ocaml/xenstored/trie.ml b/tools/ocaml/xenstored/trie.ml index dc42535092..5b4831cf02 100644 --- a/tools/ocaml/xenstored/trie.ml +++ b/tools/ocaml/xenstored/trie.ml @@ -13,24 +13,26 @@ * GNU Lesser General Public License for more details. *) +module StringMap = Map.Make(String) + module Node = struct - type ('a,'b) t = { - key: 'a; - value: 'b option; - children: ('a,'b) t list; + type 'a t = { + key: string; + value: 'a option; + children: 'a t StringMap.t; } let _create key value = { key = key; value = Some value; - children = []; + children = StringMap.empty; } let empty key = { key = key; value = None; - children = [] + children = StringMap.empty; } let _get_key node = node.key @@ -47,41 +49,31 @@ struct { node with children = children } let _add_child node child = - { node with children = child :: node.children } + { node with children = StringMap.add child.key child node.children } end -type ('a,'b) t = ('a,'b) Node.t list +type 'a t = 'a Node.t StringMap.t let mem_node nodes key = - List.exists (fun n -> n.Node.key = key) nodes + StringMap.mem key nodes let find_node nodes key = - List.find (fun n -> n.Node.key = key) nodes + StringMap.find key nodes let replace_node nodes key node = - let rec aux = function - | [] -> [] - | h :: tl when h.Node.key = key -> node :: tl - | h :: tl -> h :: aux tl - in - aux nodes + StringMap.update key (function None -> None | Some _ -> Some node) nodes let remove_node nodes key = - let rec aux = function - | [] -> raise Not_found - | h :: tl when h.Node.key = key -> tl - | h :: tl -> h :: aux tl - in - aux nodes + StringMap.update key (function None -> raise Not_found | Some _ -> None) nodes -let create () = [] +let create () = StringMap.empty let rec iter f tree = - let aux node = - f node.Node.key node.Node.value; + let aux key node = + f key node.Node.value; iter f node.Node.children in - List.iter aux tree + StringMap.iter aux tree let rec map f tree = let aux node = @@ -92,13 +84,14 @@ let rec map f tree = in { node with Node.value = value; Node.children = map f node.Node.children } in - List.filter (fun n -> n.Node.value <> None || n.Node.children <> []) (List.map aux tree) + tree |> StringMap.map aux + |> StringMap.filter (fun _ n -> n.Node.value <> None || not (StringMap.is_empty n.Node.children) ) let rec fold f tree acc = - let aux accu node = - fold f node.Node.children (f node.Node.key node.Node.value accu) + let aux key node accu = + fold f node.Node.children (f key node.Node.value accu) in - List.fold_left aux acc tree + StringMap.fold aux tree acc (* return a sub-trie *) let rec sub_node tree = function @@ -115,7 +108,7 @@ let rec sub_node tree = function let sub tree path = try (sub_node tree path).Node.children - with Not_found -> [] + with Not_found -> StringMap.empty let find tree path = Node.get_value (sub_node tree path) @@ -159,7 +152,7 @@ and set tree path value = replace_node tree h (set_node node t value) end else begin let node = Node.empty h in - set_node node t value :: tree + StringMap.add node.Node.key (set_node node t value) tree end let rec unset tree = function @@ -174,7 +167,7 @@ let rec unset tree = function then Node.set_children (Node.empty h) children else Node.set_children node children in - if children = [] && new_node.Node.value = None + if StringMap.is_empty children && new_node.Node.value = None then remove_node tree h else replace_node tree h new_node end else diff --git a/tools/ocaml/xenstored/trie.mli b/tools/ocaml/xenstored/trie.mli index 5dc53c1cb1..27785154f5 100644 --- a/tools/ocaml/xenstored/trie.mli +++ b/tools/ocaml/xenstored/trie.mli @@ -15,46 +15,46 @@ (** Basic Implementation of polymorphic tries (ie. prefix trees) *) -type ('a, 'b) t -(** The type of tries. ['a list] is the type of keys, ['b] the type of values. +type 'a t +(** The type of tries. ['a] the type of values. Internally, a trie is represented as a labeled tree, where node contains values - of type ['a * 'b option]. *) + of type [string * 'a option]. *) -val create : unit -> ('a,'b) t +val create : unit -> 'a t (** Creates an empty trie. *) -val mem : ('a,'b) t -> 'a list -> bool +val mem : 'a t -> string list -> bool (** [mem t k] returns true if a value is associated with the key [k] in the trie [t]. Otherwise, it returns false. *) -val find : ('a, 'b) t -> 'a list -> 'b +val find : 'a t -> string list -> 'a (** [find t k] returns the value associated with the key [k] in the trie [t]. Returns [Not_found] if no values are associated with [k] in [t]. *) -val set : ('a, 'b) t -> 'a list -> 'b -> ('a, 'b) t +val set : 'a t -> string list -> 'a -> 'a t (** [set t k v] associates the value [v] with the key [k] in the trie [t]. *) -val unset : ('a, 'b) t -> 'a list -> ('a, 'b) t +val unset : 'a t -> string list -> 'a t (** [unset k v] removes the association of value [v] with the key [k] in the trie [t]. Moreover, it automatically clean the trie, ie. it removes recursively every nodes of [t] containing no values and having no chil. *) -val iter : ('a -> 'b option -> unit) -> ('a, 'b) t -> unit +val iter : (string -> 'a option -> unit) -> 'a t -> unit (** [iter f t] applies the function [f] to every node of the trie [t]. As nodes of the trie [t] do not necessary contains a value, the second argument of [f] is an option type. *) -val iter_path : ('a -> 'b option -> unit) -> ('a, 'b) t -> 'a list -> unit +val iter_path : (string -> 'a option -> unit) -> 'a t -> string list -> unit (** [iter_path f t p] iterates [f] over nodes associated with the path [p] in the trie [t]. If [p] is not a valid path of [t], it iterates on the longest valid prefix of [p]. *) -val fold : ('a -> 'b option -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c +val fold : (string -> 'a option -> 'c -> 'c) -> 'a t -> 'c -> 'c (** [fold f t x] fold [f] over every nodes of [t], with [x] as initial value. *) -val map : ('b -> 'c option) -> ('a,'b) t -> ('a,'c) t +val map : ('a -> 'b option) -> 'a t -> 'b t (** [map f t] maps [f] over every values stored in [t]. The return value of [f] is of type 'c option as one may wants to remove value associated to a key. This function is not tail-recursive. *) -val sub : ('a, 'b) t -> 'a list -> ('a,'b) t +val sub : 'a t -> string list -> 'a t (** [sub t p] returns the sub-trie associated with the path [p] in the trie [t]. If [p] is not a valid path of [t], it returns an empty trie. *)