├── .gitignore ├── .travis.yml ├── CHANGES ├── Makefile ├── README.md ├── dune-project ├── lazy-trie.opam └── lib ├── dune ├── lazy_trie.ml └── lazy_trie.mli /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | *~ 3 | .merlin 4 | *.install 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh 3 | script: bash -ex .travis-docker.sh 4 | services: 5 | - docker 6 | env: 7 | global: 8 | - PACKAGE="lazy-trie" 9 | - PINS="lazy-trie:." 10 | - DISTRO="alpine" 11 | matrix: 12 | - OCAML_VERSION="4.04" 13 | - OCAML_VERSION="4.05" 14 | - OCAML_VERSION="4.06" 15 | - OCAML_VERSION="4.07" 16 | -------------------------------------------------------------------------------- /CHANGES: -------------------------------------------------------------------------------- 1 | ## v1.2.0 (2019-03-07): 2 | * Use ppx instead of camlp4 for sexp converters (#3 by @vasilisp) 3 | * Build with dune (#7 @verbosemode) 4 | * Update CI matrix up to OCaml 4.07 (@avsm) 5 | 6 | ## 1.1.0 (2014-06-15): 7 | * Add sexplib serializers to the trie. 8 | 9 | ## 1.0.0 (2014-01-02): 10 | * Initial release of the library 11 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean 2 | 3 | all: 4 | dune build 5 | 6 | clean: 7 | dune clean 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Lazy prefix trees in OCaml 2 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | (name lazy-trie) 3 | -------------------------------------------------------------------------------- /lazy-trie.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "thomas@gazagnaire.org" 3 | authors: [ "Louis Gesbert" "Thomas Gazagnaire" ] 4 | license: "ISC" 5 | build: [ 6 | ["dune" "subst"] {pinned} 7 | ["dune" "build" "-p" name "-j" jobs] 8 | ] 9 | depends: [ 10 | "ocaml" {>="4.03.0"} 11 | "sexplib" 12 | "ppx_sexp_conv" 13 | "dune" {>= "1.0"} 14 | ] 15 | dev-repo: "git+https://github.com/mirage/ocaml-lazy-trie" 16 | doc: "https://mirage.github.io/ocaml-lazy-trie/" 17 | homepage: "https://github.com/mirage/ocaml-lazy-trie" 18 | bug-reports: "https://github.com/mirage/ocaml-lazy-trie/issues" 19 | synopsis: "Implementation of lazy prefix trees" 20 | description: "Implementation of lazy prefix trees" 21 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lazy_trie) 3 | (public_name lazy-trie) 4 | (libraries sexplib) 5 | (preprocess 6 | (pps ppx_sexp_conv))) 7 | -------------------------------------------------------------------------------- /lib/lazy_trie.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2012-2013 Louis Gesbert 3 | * Copyright (c) 2012-2013 Thomas Gazagnaire 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | let (!!) = Lazy.force 19 | 20 | open Sexplib.Std 21 | 22 | type ('a,'b) t = { 23 | value: 'b option; 24 | children: ('a * ('a,'b) t) list Lazy.t; 25 | } [@@deriving sexp] 26 | 27 | let create ?(children = lazy []) ?value () = 28 | { children; value; } 29 | 30 | let empty = create () 31 | 32 | let rec list_map_filter f = function 33 | | [] -> [] 34 | | h :: tl -> match f h with 35 | | Some h -> h :: list_map_filter f tl 36 | | None -> list_map_filter f tl 37 | 38 | (* actually a map_filter, which causes it to force all the lazies (it's 39 | otherwise impossible to know which branches to prune) *) 40 | let map_filter_values f tree = 41 | let rec aux value children = { 42 | value = ( 43 | match value with 44 | | None -> None 45 | | Some value -> f value 46 | ); 47 | children = lazy ( 48 | list_map_filter 49 | (fun (key, {value; children}) -> match aux value children with 50 | | { value = None; children = lazy [] } -> None 51 | | r -> Some (key, r)) 52 | !!children 53 | ) 54 | } 55 | in 56 | aux tree.value tree.children 57 | 58 | let iter f tree = 59 | let rec aux rev_path tree = 60 | (match tree.value with Some v -> f (List.rev rev_path) v | None -> ()); 61 | List.iter (fun (k,v) -> aux (k::rev_path) v) !!(tree.children) 62 | in 63 | aux [] tree 64 | 65 | let fold f tree acc = 66 | let rec aux acc t rev_path = 67 | let acc = 68 | List.fold_left 69 | (fun acc (key,n) -> aux acc n (key::rev_path)) 70 | acc 71 | !!(t.children) 72 | in 73 | match t.value with Some v -> f acc (List.rev rev_path) v | None -> acc 74 | in 75 | aux acc tree [] 76 | 77 | let sub tree path = 78 | let rec aux tree = function 79 | | [] -> tree 80 | | h :: tl -> aux (List.assoc h !!(tree.children)) tl 81 | in 82 | try aux tree path with Not_found -> empty 83 | 84 | let rec find tree = function 85 | | h :: tl -> find (List.assoc h !!(tree.children)) tl 86 | | [] -> match tree.value with 87 | | Some v -> v 88 | | None -> raise Not_found 89 | 90 | let mem tree path = 91 | let rec aux tree = function 92 | | h :: tl -> aux (List.assoc h !!(tree.children)) tl 93 | | [] -> tree.value <> None 94 | in 95 | try aux tree path with Not_found -> false 96 | 97 | (* maps f on the element of assoc list children with key [key], appending a 98 | new empty child if necessary *) 99 | let list_map_assoc f children key empty = 100 | let rec aux acc = function 101 | | [] -> List.rev_append acc [key, f empty] 102 | | (k,v) as child :: children -> 103 | if k = key then 104 | List.rev_append acc ((key, f v) :: children) 105 | else 106 | aux (child::acc) children 107 | in 108 | aux [] children 109 | 110 | let rec map_subtree tree path f = 111 | match path with 112 | | [] -> f tree 113 | | h :: tl -> 114 | let children = lazy ( 115 | list_map_assoc (fun n -> map_subtree n tl f) !!(tree.children) h empty 116 | ) in 117 | { tree with children } 118 | 119 | let set tree path value = 120 | map_subtree tree path (fun t -> { t with value = Some value }) 121 | 122 | let set_lazy tree path lazy_value = 123 | map_subtree tree path (fun t -> { t with value = Some !!lazy_value }) 124 | 125 | let unset tree path = 126 | map_subtree tree path (fun t -> { t with value = None }) 127 | 128 | let rec filter_keys f tree = 129 | { tree with 130 | children = lazy ( 131 | list_map_filter 132 | (fun (key,n) -> if f key then Some (key, filter_keys f n) else None) 133 | !!(tree.children) 134 | )} 135 | 136 | let graft tree path node = map_subtree tree path (fun _ -> node) 137 | 138 | let graft_lazy tree path lazy_node = 139 | map_subtree tree path (fun _ -> !!lazy_node) 140 | -------------------------------------------------------------------------------- /lib/lazy_trie.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2012-2013 Louis Gesbert 3 | * Copyright (c) 2012-2013 Thomas Gazagnaire 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Lazy tries based on lists *) 19 | 20 | type ('a, 'b) t [@@deriving sexp] 21 | (** Type of tries mapping from ['a list] to ['b] *) 22 | 23 | val empty: ('a,'b) t 24 | 25 | val create : 26 | ?children: ('a * ('a,'b) t) list Lazy.t -> 27 | ?value: 'b -> 28 | unit -> 29 | ('a,'b) t 30 | (** Create a new trie with the given components *) 31 | 32 | val mem: ('a,'b) t -> 'a list -> bool 33 | (** Returns true if there is a value associated with the given path *) 34 | 35 | val find: ('a, 'b) t -> 'a list -> 'b 36 | (** Returns the value associated with the given path. 37 | @raise [Not_found] *) 38 | 39 | val set: ('a, 'b) t -> 'a list -> 'b -> ('a, 'b) t 40 | (** Associates a value with the given path, or replaces if there was already 41 | one *) 42 | 43 | val set_lazy: ('a, 'b) t -> 'a list -> 'b Lazy.t -> ('a, 'b) t 44 | (** The same but taking a lazy value *) 45 | 46 | val unset: ('a, 'b) t -> 'a list -> ('a, 'b) t 47 | (** Removes an association from the trie. Warning: doesn't cleanup branches that 48 | don't point to anything anymore *) 49 | 50 | val map_subtree : 51 | ('a, 'b) t -> 'a list -> 52 | (('a, 'b) t -> ('a, 'b) t) -> 53 | ('a, 'b) t 54 | (** [map_subtree tree path f] applies [f] on value and children of the node 55 | found at [path] in [tree], and bind the returned node back at that position 56 | in the tree *) 57 | 58 | val iter: ('a list -> 'b -> unit) -> ('a, 'b) t -> unit 59 | (** iters over all the bindings in the trie, top-down *) 60 | 61 | val fold: ('acc -> 'a list -> 'b -> 'acc) -> ('a, 'b) t -> 'acc -> 'acc 62 | (** folds over all bindings of the trie, bottom-up *) 63 | 64 | val map_filter_values: ('b -> 'c option) -> ('a,'b) t -> ('a,'c) t 65 | (** Maps and filters over all values in the trie, removing the value if [None] 66 | is returned *) 67 | 68 | val sub: ('a, 'b) t -> 'a list -> ('a,'b) t 69 | (** [sub t p] returns the sub-trie associated with the path [p] in the trie 70 | [t]. If [p] is not a valid path of [t], it returns an empty trie. *) 71 | 72 | val filter_keys: ('a -> bool) -> ('a, 'b) t -> ('a, 'b) t 73 | (** [filter f t] returns t with all subtrees for which [f key = false] pruned *) 74 | 75 | val graft: ('a, 'b) t -> 'a list -> ('a, 'b) t -> ('a, 'b) t 76 | (** [graft tree path node] grafts [node] in [tree] at [path] *) 77 | 78 | val graft_lazy: ('a, 'b) t -> 'a list -> ('a, 'b) t Lazy.t -> ('a, 'b) t 79 | (** Same as [graft], but using lazy parameters. *) 80 | --------------------------------------------------------------------------------