From e04a8d13ce4133217c6684d79f55a198acc344d4 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Mon, 1 Mar 2021 16:26:45 +0100 Subject: [PATCH 1/2] Remove hand-written hash functions This was eliding no fields and there is no data that can't be hashed by Hashtbl.hash. --- src/model/paths.ml | 82 ++++++++++++++++------------------------------ src/xref2/cpath.ml | 64 ------------------------------------ src/xref2/tools.ml | 8 ++--- 3 files changed, 33 insertions(+), 121 deletions(-) diff --git a/src/model/paths.ml b/src/model/paths.ml index 2ab010c3fa..721d8d3ec2 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -72,32 +72,6 @@ module Identifier = struct let label_parent n = label_parent_aux (n :> t) - let rec hash (id : t) = - let open Paths_types.Identifier in - match id with - | `Root (r, s) -> Hashtbl.hash (1, hash (r : container_page :> any), s) - | `RootPage s -> Hashtbl.hash (2, s) - | `Page (r, s) -> Hashtbl.hash (0, hash (r : container_page :> any), s) - | `LeafPage (r, s) -> Hashtbl.hash (20, hash (r : container_page :> any), s) - | `Module (id, s) -> Hashtbl.hash (3, hash (id : signature :> any), s) - | `Parameter (id, s) -> Hashtbl.hash (4, hash (id : signature :> any), s) - | `Result s -> Hashtbl.hash (5, hash (s : signature :> any)) - | `ModuleType (id, s) -> Hashtbl.hash (6, hash (id : signature :> any), s) - | `Type (id, s) -> Hashtbl.hash (7, hash (id : signature :> any), s) - | `CoreType s -> Hashtbl.hash (8, s) - | `Constructor (id, s) -> Hashtbl.hash (9, hash (id : type_ :> any), s) - | `Field (id, s) -> Hashtbl.hash (10, hash (id : parent :> any), s) - | `Extension (id, s) -> Hashtbl.hash (11, hash (id : signature :> any), s) - | `Exception (id, s) -> Hashtbl.hash (12, hash (id : signature :> any), s) - | `CoreException s -> Hashtbl.hash (13, s) - | `Value (id, s) -> Hashtbl.hash (14, hash (id : signature :> any), s) - | `Class (id, s) -> Hashtbl.hash (15, hash (id : signature :> any), s) - | `ClassType (id, s) -> Hashtbl.hash (16, hash (id : signature :> any), s) - | `Method (id, s) -> Hashtbl.hash (17, hash (id : class_signature :> any), s) - | `InstanceVariable (id, s) -> - Hashtbl.hash (18, hash (id : class_signature :> any), s) - | `Label (id, s) -> Hashtbl.hash (19, hash (id : label_parent :> any), s) - let constructor_id : t -> int = function | `Root _ -> 1 | `RootPage _ -> 2 @@ -185,6 +159,8 @@ module Identifier = struct let equal : t -> t -> bool = fun x y -> compare x y = 0 + let hash = Hashtbl.hash + type any = t module Signature = struct @@ -192,7 +168,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -202,7 +178,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -212,7 +188,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -222,7 +198,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -232,7 +208,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -242,7 +218,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -252,7 +228,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -262,7 +238,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -282,7 +258,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -292,7 +268,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -302,7 +278,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -312,7 +288,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -322,7 +298,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -332,7 +308,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -342,7 +318,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -352,7 +328,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -362,7 +338,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -372,7 +348,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -382,7 +358,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -392,7 +368,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -402,7 +378,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -412,7 +388,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -422,7 +398,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -433,7 +409,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -443,7 +419,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -453,7 +429,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end @@ -463,7 +439,7 @@ module Identifier = struct let equal x y = equal (x :> any) (y :> any) - let hash x = hash (x :> any) + let hash = Hashtbl.hash let compare x y = compare (x :> any) (y :> any) end diff --git a/src/xref2/cpath.ml b/src/xref2/cpath.ml index aedadf3923..bb07d2c2f7 100644 --- a/src/xref2/cpath.ml +++ b/src/xref2/cpath.ml @@ -88,70 +88,6 @@ end = include Cpath -let rec resolved_module_hash : Resolved.module_ -> int = function - | `Local id -> Hashtbl.hash (0, Ident.hash (id :> Ident.any)) - | `Identifier id -> - Hashtbl.hash - ( 1, - Odoc_model.Paths.Identifier.hash (id :> Odoc_model.Paths.Identifier.t) - ) - | `Substituted s -> Hashtbl.hash (2, resolved_module_hash s) - | `Subst (mt, m) -> - Hashtbl.hash (3, resolved_module_type_hash mt, resolved_module_hash m) - | `SubstAlias (m1, m2) -> - Hashtbl.hash (4, resolved_module_hash m1, resolved_module_hash m2) - | `Hidden h -> Hashtbl.hash (5, resolved_module_hash h) - | `Module (m, n) -> Hashtbl.hash (6, resolved_parent_hash m, n) - | `Canonical (m, m2) -> - Hashtbl.hash (7, resolved_module_hash m, module_hash m2) - | `Apply (m1, m2) -> - Hashtbl.hash (8, resolved_module_hash m1, resolved_module_hash m2) - | `Alias (m1, m2) -> - Hashtbl.hash (9, resolved_module_hash m1, resolved_module_hash m2) - | `OpaqueModule m -> Hashtbl.hash (10, resolved_module_hash m) - -and module_hash : module_ -> int = function - | `Resolved r -> Hashtbl.hash (10, resolved_module_hash r) - | `Substituted s -> Hashtbl.hash (11, module_hash s) - | `Root r -> Hashtbl.hash (12, r) - | `Forward f -> Hashtbl.hash (13, f) - | `Identifier (id, b) -> - Hashtbl.hash - ( 14, - Odoc_model.Paths.Identifier.hash (id :> Odoc_model.Paths.Identifier.t), - b ) - | `Local (id, b) -> Hashtbl.hash (15, Ident.hash (id :> Ident.any), b) - | `Dot (m, s) -> Hashtbl.hash (16, module_hash m, s) - | `Module (m, s) -> Hashtbl.hash (17, resolved_parent_hash m, s) - | `Apply (m1, m2) -> Hashtbl.hash (18, module_hash m1, module_hash m2) - -and resolved_module_type_hash : Resolved.module_type -> int = function - | `Local id -> Hashtbl.hash (19, Ident.hash (id :> Ident.any)) - | `Substituted m -> Hashtbl.hash (20, resolved_module_type_hash m) - | `Identifier id -> - Hashtbl.hash (21, Odoc_model.Paths.Identifier.(hash (id :> t))) - | `ModuleType (p, n) -> Hashtbl.hash (22, resolved_parent_hash p, n) - | `SubstT (p1, p2) -> - Hashtbl.hash - (23, resolved_module_type_hash p1, resolved_module_type_hash p2) - | `CanonicalModuleType (p1, p2) -> - Hashtbl.hash (24, resolved_module_type_hash p1, module_type_hash p2) - | `OpaqueModuleType m -> Hashtbl.hash (25, resolved_module_type_hash m) - -and resolved_parent_hash : Resolved.parent -> int = function - | `Module m -> Hashtbl.hash (26, resolved_module_hash m) - | `ModuleType m -> Hashtbl.hash (27, resolved_module_type_hash m) - | `FragmentRoot -> Hashtbl.hash 28 - -and module_type_hash : module_type -> int = function - | `Resolved r -> Hashtbl.hash (29, resolved_module_type_hash r) - | `Substituted m -> Hashtbl.hash (30, module_type_hash m) - | `Local (id, b) -> Hashtbl.hash (31, Ident.hash (id :> Ident.any), b) - | `Identifier (id, b) -> - Hashtbl.hash (32, Odoc_model.Paths.Identifier.(hash (id :> t)), b) - | `Dot (p, s) -> Hashtbl.hash (33, module_hash p, s) - | `ModuleType (m, s) -> Hashtbl.hash (34, resolved_parent_hash m, s) - type local_path_error = | ErrModule of module_ | ErrModuleType of module_type diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml index 3d264a5c1e..f41f196e97 100644 --- a/src/xref2/tools.ml +++ b/src/xref2/tools.ml @@ -278,7 +278,7 @@ module LookupModuleMemo = MakeMemo (struct let equal = ( = ) - let hash (b, m) = Hashtbl.hash (b, Cpath.resolved_module_hash m) + let hash = Hashtbl.hash end) module LookupParentMemo = MakeMemo (struct @@ -291,7 +291,7 @@ module LookupParentMemo = MakeMemo (struct let equal = ( = ) - let hash (b, p) = Hashtbl.hash (b, Cpath.resolved_parent_hash p) + let hash = Hashtbl.hash end) module LookupAndResolveMemo = MakeMemo (struct @@ -301,7 +301,7 @@ module LookupAndResolveMemo = MakeMemo (struct let equal = ( = ) - let hash (b1, b2, p) = Hashtbl.hash (b1, b2, Cpath.module_hash p) + let hash = Hashtbl.hash end) module SignatureOfModuleMemo = MakeMemo (struct @@ -311,7 +311,7 @@ module SignatureOfModuleMemo = MakeMemo (struct let equal = ( = ) - let hash p = Cpath.resolved_module_hash p + let hash = Hashtbl.hash end) let disable_all_caches () = From 9d1e074c2c0da6b6b45b855c545c44c00b3ab4d7 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Mon, 1 Mar 2021 16:34:08 +0100 Subject: [PATCH 2/2] Remove hand-written compare functions Stdlib.compare can be used on these types. --- src/model/names.ml | 7 +--- src/model/paths.ml | 89 ++-------------------------------------------- 2 files changed, 4 insertions(+), 92 deletions(-) diff --git a/src/model/names.ml b/src/model/names.ml index 02adaabcd8..dc1e4bbd1b 100644 --- a/src/model/names.ml +++ b/src/model/names.ml @@ -68,12 +68,7 @@ module Name : Name = struct let equal (x : t) (y : t) = x = y - let compare x y = - match (x, y) with - | Internal (x, _), Internal (y, _) -> String.compare x y - | Std x, Std y -> String.compare x y - | Internal _, Std _ -> -1 - | Std _, Internal _ -> 1 + let compare = compare let fmt ppf x = Format.fprintf ppf "%s" (to_string x) diff --git a/src/model/paths.ml b/src/model/paths.ml index 721d8d3ec2..aa7412edd2 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -72,95 +72,12 @@ module Identifier = struct let label_parent n = label_parent_aux (n :> t) - let constructor_id : t -> int = function - | `Root _ -> 1 - | `RootPage _ -> 2 - | `Module _ -> 3 - | `Parameter _ -> 4 - | `Result _ -> 5 - | `ModuleType _ -> 6 - | `Type _ -> 7 - | `CoreType _ -> 8 - | `Constructor _ -> 9 - | `Field _ -> 10 - | `Extension _ -> 11 - | `Exception _ -> 12 - | `CoreException _ -> 13 - | `Value _ -> 14 - | `Class _ -> 15 - | `ClassType _ -> 16 - | `Method _ -> 17 - | `InstanceVariable _ -> 18 - | `Label _ -> 19 - | `Page _ -> 20 - | `LeafPage _ -> 21 - - let std_compare = compare - - let rec compare : t -> t -> int = - fun x y -> - match (x, y) with - | `Root (r, s), `Root (r', s') -> - let s = ModuleName.compare s s' in - if s <> 0 then s else compare (r :> t) (r' :> t) - | `RootPage s, `RootPage s' -> PageName.compare s s' - | `Page (r, s), `Page (r', s') -> - let s = PageName.compare s s' in - if s <> 0 then s else compare (r :> t) (r' :> t) - | `LeafPage (r, s), `LeafPage (r', s') -> - let s = PageName.compare s s' in - if s <> 0 then s else compare (r :> t) (r' :> t) - | `Module (p, s), `Module (p', s') -> - let s = ModuleName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `Parameter (p, s), `Parameter (p', s') -> - let s = ParameterName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `Result p, `Result p' -> compare (p :> t) (p' :> t) - | `ModuleType (p, s), `ModuleType (p', s') -> - let s = ModuleTypeName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `Type (p, s), `Type (p', s') -> - let s = TypeName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `CoreType s, `CoreType s' -> TypeName.compare s s' - | `Constructor (p, s), `Constructor (p', s') -> - let s = ConstructorName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `Field (p, s), `Field (p', s') -> - let s = FieldName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `Extension (p, s), `Extension (p', s') -> - let s = ExtensionName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `Exception (p, s), `Exception (p', s') -> - let s = ExceptionName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `CoreException s, `CoreException s' -> ExceptionName.compare s s' - | `Value (p, s), `Value (p', s') -> - let s = ValueName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `Class (p, s), `Class (p', s') -> - let s = ClassName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `ClassType (p, s), `ClassType (p', s') -> - let s = ClassTypeName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `Method (p, s), `Method (p', s') -> - let s = MethodName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `InstanceVariable (p, s), `InstanceVariable (p', s') -> - let s = InstanceVariableName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | `Label (p, s), `Label (p', s') -> - let s = LabelName.compare s s' in - if s <> 0 then s else compare (p :> t) (p' :> t) - | x, y -> std_compare (constructor_id x) (constructor_id y) - - let equal : t -> t -> bool = fun x y -> compare x y = 0 + let equal = ( = ) let hash = Hashtbl.hash + let compare = compare + type any = t module Signature = struct