Skip to content

Commit

Permalink
Prefer List.concat_map (#6029)
Browse files Browse the repository at this point in the history 
Initially, this was solely a large-scale exercise in replacing all
occurrences of `List.flatten` with `List.concat` (`concat` is an alias
of `flatten` and is more consistent with the naming of `concat_map`). In
the end, I made a small effort to attempt to replace occurrences of the
pattern `concat (map f xs)` with `concat_map f xs`. There are probably a
few places that I've missed.

---

I'm keen on:

- Squashing all of this
- Adding the squashed commit's hash to `.git-blame-ignore-revs` (there
is a lot of whitespace churn due to the general code style of writing
lots of anonymous function)
- Finding missed occurrences using structural grepping
- Adding a rule to quality gate that disallows `List.flatten`

---

In future, we should define a bunch of list-related optimisations
(fusing, reordering, etc.) and try to replace those as well.
  • Loading branch information
@contificate
contificate authored Oct 1, 2024
2 parents 2f251e1 + 2f7deb3 commit 4d9090e
Show file tree
Hide file tree
Showing 67 changed files with 799 additions and 961 deletions.
3 changes: 3 additions & 0 deletions .git-blame-ignore-revs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,3 +37,6 @@ f43c221ad556bc85870faebc3ce3c9d6e9c2efd8

# strip trailing whitespace
5a003f446391ca05ec791c38c69e93fb1e718e78

# prefer concat_map
f1a1ee1c0dc6e228921ebc9e1ac39c2740d649c5
4 changes: 2 additions & 2 deletions doc/content/xapi/storage/sxm.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -230,8 +230,8 @@ Next, we determine which VDIs to copy:
let vifs = Db.VM.get_VIFs ~__context ~self:vm in
let snapshots = Db.VM.get_snapshots ~__context ~self:vm in
let vm_and_snapshots = vm :: snapshots in
let snapshots_vbds = List.flatten (List.map (fun self -> Db.VM.get_VBDs ~__context ~self) snapshots) in
let snapshot_vifs = List.flatten (List.map (fun self -> Db.VM.get_VIFs ~__context ~self) snapshots) in
let snapshots_vbds = List.concat_map (fun self -> Db.VM.get_VBDs ~__context ~self) snapshots in
let snapshot_vifs = List.concat_map (fun self -> Db.VM.get_VIFs ~__context ~self) snapshots in
```

we now decide whether we're intra-pool or not, and if we're intra-pool whether we're migrating onto the same host (localhost migrate). Intra-pool is decided by trying to do a lookup of our current host uuid on the destination pool.
Expand Down
47 changes: 22 additions & 25 deletions ocaml/idl/datamodel_utils.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ module Types = struct
| Field f ->
[f.ty]
| Namespace (_, fields) ->
List.concat (List.map of_content fields)
List.concat_map of_content fields

(** Decompose a recursive type into a list of component types
(eg a Set(String) -> String :: Set(String) ) *)
Expand All @@ -62,20 +62,19 @@ module Types = struct

(** All types in a list of objects (automatically decomposes) *)
let of_objects system =
let fields = List.concat (List.map (fun x -> x.contents) system) in
let field_types = List.concat (List.map of_content fields) in
let fields = List.concat_map (fun x -> x.contents) system in
let field_types = List.concat_map of_content fields in

let messages = List.concat (List.map (fun x -> x.messages) system) in
let messages = List.concat_map (fun x -> x.messages) system in
let return_types =
let aux accu msg =
match msg.msg_result with None -> accu | Some (ty, _) -> ty :: accu
in
List.fold_left aux [] messages
in
let param_types =
List.map
(fun p -> p.param_type)
(List.concat (List.map (fun x -> x.msg_params) messages))
List.(concat_map (fun x -> map (fun p -> p.param_type) x.msg_params))
messages
in
let selves = List.map (fun obj -> Ref obj.name) system in
let set_self = List.map (fun t -> Set t) selves in
Expand All @@ -84,7 +83,7 @@ module Types = struct
Listext.List.setify
(selves @ set_self @ field_types @ return_types @ param_types)
in
Listext.List.setify (List.concat (List.map decompose all))
Listext.List.setify (List.concat_map decompose all)
end

(** Functions for processing relationships from the model *)
Expand Down Expand Up @@ -124,18 +123,16 @@ module Relations = struct
let other_end_of api ((a, b) as one_end) =
let rels = relations_of_api api in
match
List.concat
(List.map
(function
| x, other_end when x = one_end ->
[other_end]
| other_end, x when x = one_end ->
[other_end]
| _ ->
[]
)
rels
)
List.concat_map
(function
| x, other_end when x = one_end ->
[other_end]
| other_end, x when x = one_end ->
[other_end]
| _ ->
[]
)
rels
with
| [other_end] ->
other_end
Expand All @@ -155,11 +152,11 @@ end
let fields_of_obj (x : obj) : field list =
let rec of_contents = function
| Namespace (_, xs) ->
List.concat (List.map of_contents xs)
List.concat_map of_contents xs
| Field x ->
[x]
in
List.concat (List.map of_contents x.contents)
List.concat_map of_contents x.contents

(* True if an object has a label (and therefore should have a get_by_name_label message *)
let obj_has_get_by_name_label x =
Expand Down Expand Up @@ -784,7 +781,7 @@ let messages_of_obj (x : obj) document_order : message list =
messages
@ get_all_public
@ [get_all]
@ List.concat (List.map (all_new_messages_of_field x) all_fields)
@ List.concat_map (all_new_messages_of_field x) all_fields
@ constructor_destructor
@ [uuid; get_record]
@ name_label
Expand All @@ -793,8 +790,8 @@ let messages_of_obj (x : obj) document_order : message list =
[get_record; get_record_internal; get_all; uuid]
@ constructor_destructor
@ name_label
@ List.concat (List.map (new_messages_of_field x 0) all_fields)
@ List.concat (List.map (new_messages_of_field x 1) all_fields)
@ List.concat_map (new_messages_of_field x 0) all_fields
@ List.concat_map (new_messages_of_field x 1) all_fields
@ messages
@ get_all_public

Expand Down
9 changes: 4 additions & 5 deletions ocaml/idl/dm_api.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,12 +79,11 @@ let field_exists api ~objname ~fieldname =
*)
let filter_field (pred : field -> bool) (system : obj list) =
(* NB using lists rather than options - maybe change later? *)
let concat_map f xs = List.concat (List.map f xs) in
let rec content = function
| Field field as x ->
if pred field then [x] else []
| Namespace (name, contents) ->
[Namespace (name, concat_map content contents)]
[Namespace (name, List.concat_map content contents)]
in
(* remove empty /leaf/ namespaces *)
let rec remove_leaf = function
Expand All @@ -93,7 +92,7 @@ let filter_field (pred : field -> bool) (system : obj list) =
| Namespace (_, []) ->
[] (* no children so removed *)
| Namespace (name, contents) ->
[Namespace (name, concat_map remove_leaf contents)]
[Namespace (name, List.concat_map remove_leaf contents)]
in
let rec fixpoint f x =
let result = f x in
Expand All @@ -103,8 +102,8 @@ let filter_field (pred : field -> bool) (system : obj list) =
{
x with
contents=
(let contents = concat_map content x.contents in
fixpoint (concat_map remove_leaf) contents
(let contents = List.concat_map content x.contents in
fixpoint (List.concat_map remove_leaf) contents
)
}
in
Expand Down
183 changes: 88 additions & 95 deletions ocaml/idl/dot_backend.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,107 +34,100 @@ let rec all_field_types = function
| Field fr ->
[(fr.field_name, fr.ty)]
| Namespace (_, xs) ->
List.concat (List.map all_field_types xs)
List.concat_map all_field_types xs

let of_objs api =
let xs = objects_of_api api and relations = relations_of_api api in
let names : string list = List.map (fun x -> x.name) xs in
let edges : string list =
List.concat
(List.map
(fun (obj : obj) ->
(* First consider the edges defined as relational *)
let relational =
List.filter (fun ((a, _), _) -> a = obj.name) relations
in
let edges =
List.map
(fun ((a, a_field_name), (b, b_field_name)) ->
let a_field =
get_field_by_name api ~objname:a ~fieldname:a_field_name
and b_field =
get_field_by_name api ~objname:b ~fieldname:b_field_name
in
let get_arrow which obj ty =
match Relations.of_types (Ref obj) ty with
| `None ->
failwith
(sprintf
"bad relational edge between %s.%s and %s.%s; \
object name [%s] never occurs in [%s]"
a a_field_name b b_field_name obj
(Types.to_string ty)
)
| `One ->
[which ^ "=\"none\""]
| `Many ->
[which ^ "=\"crow\""]
in
let labels =
[(* "label=\"" ^ label ^ "\"";*) "color=\"blue\""]
@ get_arrow "arrowhead" b a_field.ty
@ get_arrow "arrowtail" a b_field.ty
in
sprintf "%s -> %s [ %s ]" a b (String.concat ", " labels)
)
relational
in
(* list of pairs of (field name, type) *)
let name_types : (string * ty) list =
List.concat (List.map all_field_types obj.contents)
in
(* get rid of all those which are defined as relational *)
let name_types =
List.filter
(fun (name, _) ->
List.filter
(fun ((a, a_name), (b, b_name)) ->
(a = obj.name && a_name = name)
|| (b = obj.name && b_name = name)
)
relations
= []
)
name_types
in
(* decompose each ty into a list of references *)
let name_refs : (string * string * ty) list =
List.concat
(List.map
(fun (name, ty) ->
List.map (fun x -> (name, x, ty)) (all_refs ty)
)
name_types
)
in
let name_names : (string * string) list =
List.map
(fun (name, obj, ty) ->
let count =
match Relations.of_types (Ref obj) ty with
| `None ->
"(0)"
| `One ->
"(1)"
| `Many ->
"(*)"
in
(name ^ count, obj)
)
name_refs
in
let edges =
List.map
(fun (field, target) ->
sprintf "%s -> %s [ label=\"%s\" ]" obj.name target field
)
name_names
@ edges
in
edges
)
xs
List.concat_map
(fun (obj : obj) ->
(* First consider the edges defined as relational *)
let relational =
List.filter (fun ((a, _), _) -> a = obj.name) relations
in
let edges =
List.map
(fun ((a, a_field_name), (b, b_field_name)) ->
let a_field =
get_field_by_name api ~objname:a ~fieldname:a_field_name
and b_field =
get_field_by_name api ~objname:b ~fieldname:b_field_name
in
let get_arrow which obj ty =
match Relations.of_types (Ref obj) ty with
| `None ->
failwith
(sprintf
"bad relational edge between %s.%s and %s.%s; object \
name [%s] never occurs in [%s]"
a a_field_name b b_field_name obj (Types.to_string ty)
)
| `One ->
[which ^ "=\"none\""]
| `Many ->
[which ^ "=\"crow\""]
in
let labels =
[(* "label=\"" ^ label ^ "\"";*) "color=\"blue\""]
@ get_arrow "arrowhead" b a_field.ty
@ get_arrow "arrowtail" a b_field.ty
in
sprintf "%s -> %s [ %s ]" a b (String.concat ", " labels)
)
relational
in
(* list of pairs of (field name, type) *)
let name_types : (string * ty) list =
List.concat_map all_field_types obj.contents
in
(* get rid of all those which are defined as relational *)
let name_types =
List.filter
(fun (name, _) ->
List.filter
(fun ((a, a_name), (b, b_name)) ->
(a = obj.name && a_name = name)
|| (b = obj.name && b_name = name)
)
relations
= []
)
name_types
in
(* decompose each ty into a list of references *)
let name_refs : (string * string * ty) list =
List.concat_map
(fun (name, ty) -> List.map (fun x -> (name, x, ty)) (all_refs ty))
name_types
in
let name_names : (string * string) list =
List.map
(fun (name, obj, ty) ->
let count =
match Relations.of_types (Ref obj) ty with
| `None ->
"(0)"
| `One ->
"(1)"
| `Many ->
"(*)"
in
(name ^ count, obj)
)
name_refs
in
let edges =
List.map
(fun (field, target) ->
sprintf "%s -> %s [ label=\"%s\" ]" obj.name target field
)
name_names
@ edges
in
edges
)
xs
in
[
"digraph g{"
Expand Down
10 changes: 4 additions & 6 deletions ocaml/idl/dtd_backend.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -99,11 +99,9 @@ let rec strings_of_dtd_element known_els = function
Hashtbl.remove known_els name ;
sprintf "%s%s>" prefix body
:: (strings_of_attributes name attributes
@ List.concat
(List.map
(strings_of_dtd_element known_els)
(List.filter is_element els)
)
@ List.concat_map
(strings_of_dtd_element known_els)
(List.filter is_element els)
)
) else
[]
Expand Down Expand Up @@ -166,4 +164,4 @@ let of_objs api =
let xs = objects_of_api api in
let known_els = Hashtbl.create 10 in
let elements = List.map (dtd_element_of_obj known_els) xs in
List.concat (List.map (strings_of_dtd_element known_els) elements)
List.concat_map (strings_of_dtd_element known_els) elements
Loading

0 comments on commit 4d9090e

Please sign in to comment.