Skip to content

Simplify idents #1176

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Aug 27, 2024
Merged

Simplify idents #1176

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
030d173
Simplify idents
jonludlam Jun 18, 2024
a1e91ce
Fix missing entries in module map in Lang_of
jonludlam Aug 27, 2024
8555bf1
Update tests
jonludlam Aug 27, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
84 changes: 26 additions & 58 deletions src/xref2/component.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,32 +12,14 @@ module TypeMap = Map.Make (struct
let compare a b = Ident.compare (a :> Ident.any) (b :> Ident.any)
end)

module PathModuleMap = Map.Make (struct
type t = Ident.path_module

let compare a b = Ident.compare (a :> Ident.any) (b :> Ident.any)
end)

module ModuleTypeMap = Map.Make (struct
type t = Ident.module_type

let compare a b = Ident.compare (a :> Ident.any) (b :> Ident.any)
end)

module PathTypeMap = Map.Make (struct
type t = Ident.path_type

let compare a b = Ident.compare (a :> Ident.any) (b :> Ident.any)
end)

module PathValueMap = Map.Make (struct
type t = Ident.path_value

let compare a b = Ident.compare (a :> Ident.any) (b :> Ident.any)
end)

module PathClassTypeMap = Map.Make (struct
type t = Ident.path_class_type
module ValueMap = Map.Make (struct
type t = Ident.value

let compare a b = Ident.compare (a :> Ident.any) (b :> Ident.any)
end)
Expand Down Expand Up @@ -182,7 +164,7 @@ end =
Exception

and FunctorParameter : sig
type parameter = { id : Ident.functor_parameter; expr : ModuleType.expr }
type parameter = { id : Ident.module_; expr : ModuleType.expr }

type t = Named of parameter | Unit
end =
Expand Down Expand Up @@ -320,8 +302,8 @@ and Signature : sig
| Exception of Ident.exception_ * Exception.t
| TypExt of Extension.t
| Value of Ident.value * Value.t Delayed.t
| Class of Ident.class_ * recursive * Class.t
| ClassType of Ident.class_type * recursive * ClassType.t
| Class of Ident.type_ * recursive * Class.t
| ClassType of Ident.type_ * recursive * ClassType.t
| Include of Include.t
| Open of Open.t
| Comment of CComment.docs_or_stop
Expand Down Expand Up @@ -440,28 +422,27 @@ and Substitution : sig
type subst_module =
[ `Prefixed of Cpath.module_ * Cpath.Resolved.module_
| `Substituted
| `Renamed of Ident.path_module ]
| `Renamed of Ident.module_ ]

type subst_module_type =
[ `Prefixed of Cpath.module_type * Cpath.Resolved.module_type
| `Renamed of Ident.module_type ]

type subst_type =
[ `Prefixed of Cpath.type_ * Cpath.Resolved.type_
| `Renamed of Ident.path_type ]
[ `Prefixed of Cpath.type_ * Cpath.Resolved.type_ | `Renamed of Ident.type_ ]

type subst_class_type =
[ `Prefixed of Cpath.class_type * Cpath.Resolved.class_type
| `Renamed of Ident.path_class_type ]
| `Renamed of Ident.type_ ]

type t = {
module_ : subst_module PathModuleMap.t;
module_ : subst_module ModuleMap.t;
module_type : subst_module_type ModuleTypeMap.t;
type_ : subst_type PathTypeMap.t;
class_type : subst_class_type PathClassTypeMap.t;
type_replacement : (TypeExpr.t * TypeDecl.Equation.t) PathTypeMap.t;
type_ : subst_type TypeMap.t;
class_type : subst_class_type TypeMap.t;
type_replacement : (TypeExpr.t * TypeDecl.Equation.t) TypeMap.t;
module_type_replacement : ModuleType.expr ModuleTypeMap.t;
path_invalidating_modules : Ident.path_module list;
path_invalidating_modules : Ident.module_ list;
unresolve_opaque_paths : bool;
}
end =
Expand Down Expand Up @@ -1815,14 +1796,12 @@ module Of_Lang = struct
type map = {
modules : Ident.module_ Paths.Identifier.Maps.Module.t;
module_types : Ident.module_type Paths.Identifier.Maps.ModuleType.t;
functor_parameters :
Ident.functor_parameter Paths.Identifier.Maps.FunctorParameter.t;
functor_parameters : Ident.module_ Paths.Identifier.Maps.FunctorParameter.t;
types : Ident.type_ Paths.Identifier.Maps.Type.t;
path_types : Ident.path_type Paths.Identifier.Maps.Path.Type.t;
path_class_types :
Ident.path_class_type Paths.Identifier.Maps.Path.ClassType.t;
classes : Ident.class_ Paths.Identifier.Maps.Class.t;
class_types : Ident.class_type Paths.Identifier.Maps.ClassType.t;
path_types : Ident.type_ Paths.Identifier.Maps.Path.Type.t;
path_class_types : Ident.type_ Paths.Identifier.Maps.Path.ClassType.t;
classes : Ident.type_ Paths.Identifier.Maps.Class.t;
class_types : Ident.type_ Paths.Identifier.Maps.ClassType.t;
}

let empty () =
Expand All @@ -1848,10 +1827,7 @@ module Of_Lang = struct
(fun (types, path_types) i ->
let id = Ident.Of_Identifier.type_ i in
( Maps.Type.add i id types,
Maps.Path.Type.add
(i :> Path.Type.t)
(id :> Ident.path_type)
path_types ))
Maps.Path.Type.add (i :> Path.Type.t) id path_types ))
(map.types, map.path_types)
ids.LocalIdents.types
in
Expand All @@ -1860,10 +1836,8 @@ module Of_Lang = struct
(fun (classes, path_class_types) i ->
let id = Ident.Of_Identifier.class_ i in
( Maps.Class.add i id classes,
Maps.Path.ClassType.add
(i :> Path.ClassType.t)
(id :> Ident.path_class_type)
path_class_types ))
Maps.Path.ClassType.add (i :> Path.ClassType.t) id path_class_types
))
(map.classes, map.path_class_types)
ids.LocalIdents.classes
in
Expand All @@ -1872,14 +1846,9 @@ module Of_Lang = struct
(fun (class_types, path_types, path_class_types) i ->
let id = Ident.Of_Identifier.class_type i in
( Maps.ClassType.add i id class_types,
Maps.Path.Type.add
(i :> Path.Type.t)
(id :> Ident.path_type)
path_types,
Maps.Path.ClassType.add
(i :> Path.ClassType.t)
(id :> Ident.path_class_type)
path_class_types ))
Maps.Path.Type.add (i :> Path.Type.t) id path_types,
Maps.Path.ClassType.add (i :> Path.ClassType.t) id path_class_types
))
(map.class_types, path_types_new, path_class_types_new)
ids.LocalIdents.class_types
in
Expand Down Expand Up @@ -1925,13 +1894,12 @@ module Of_Lang = struct
let find_any_module i ident_map =
match i with
| { Odoc_model.Paths.Identifier.iv = `Root _ | `Module _; _ } as id ->
(Maps.Module.find id ident_map.modules :> Ident.path_module)
Maps.Module.find id ident_map.modules
| {
Odoc_model.Paths.Identifier.iv = #Paths.Identifier.FunctorParameter.t_pv;
_;
} as id ->
(Maps.FunctorParameter.find id ident_map.functor_parameters
:> Ident.path_module)
Maps.FunctorParameter.find id ident_map.functor_parameters
| _ -> raise Not_found

let rec resolved_module_path :
Expand Down
34 changes: 13 additions & 21 deletions src/xref2/component.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,16 +4,9 @@ module ModuleMap : Map.S with type key = Ident.module_

module TypeMap : Map.S with type key = Ident.type_

module PathModuleMap : Map.S with type key = Ident.path_module
(** Useful maps *)

module ModuleTypeMap : Map.S with type key = Ident.module_type

module PathTypeMap : Map.S with type key = Ident.path_type

module PathValueMap : Map.S with type key = Ident.path_value

module PathClassTypeMap : Map.S with type key = Ident.path_class_type
module ValueMap : Map.S with type key = Ident.value

module IdentMap : Map.S with type key = Ident.any

Expand Down Expand Up @@ -162,7 +155,7 @@ and Exception : sig
end

and FunctorParameter : sig
type parameter = { id : Ident.functor_parameter; expr : ModuleType.expr }
type parameter = { id : Ident.module_; expr : ModuleType.expr }

type t = Named of parameter | Unit
end
Expand Down Expand Up @@ -285,8 +278,8 @@ and Signature : sig
| Exception of Ident.exception_ * Exception.t
| TypExt of Extension.t
| Value of Ident.value * Value.t Delayed.t
| Class of Ident.class_ * recursive * Class.t
| ClassType of Ident.class_type * recursive * ClassType.t
| Class of Ident.type_ * recursive * Class.t
| ClassType of Ident.type_ * recursive * ClassType.t
| Include of Include.t
| Open of Open.t
| Comment of CComment.docs_or_stop
Expand Down Expand Up @@ -407,28 +400,27 @@ and Substitution : sig
type subst_module =
[ `Prefixed of Cpath.module_ * Cpath.Resolved.module_
| `Substituted
| `Renamed of Ident.path_module ]
| `Renamed of Ident.module_ ]

type subst_module_type =
[ `Prefixed of Cpath.module_type * Cpath.Resolved.module_type
| `Renamed of Ident.module_type ]

type subst_type =
[ `Prefixed of Cpath.type_ * Cpath.Resolved.type_
| `Renamed of Ident.path_type ]
[ `Prefixed of Cpath.type_ * Cpath.Resolved.type_ | `Renamed of Ident.type_ ]

type subst_class_type =
[ `Prefixed of Cpath.class_type * Cpath.Resolved.class_type
| `Renamed of Ident.path_class_type ]
| `Renamed of Ident.type_ ]

type t = {
module_ : subst_module PathModuleMap.t;
module_ : subst_module ModuleMap.t;
module_type : subst_module_type ModuleTypeMap.t;
type_ : subst_type PathTypeMap.t;
class_type : subst_class_type PathClassTypeMap.t;
type_replacement : (TypeExpr.t * TypeDecl.Equation.t) PathTypeMap.t;
type_ : subst_type TypeMap.t;
class_type : subst_class_type TypeMap.t;
type_replacement : (TypeExpr.t * TypeDecl.Equation.t) TypeMap.t;
module_type_replacement : ModuleType.expr ModuleTypeMap.t;
path_invalidating_modules : Ident.path_module list;
path_invalidating_modules : Ident.module_ list;
unresolve_opaque_paths : bool;
}
end
Expand Down Expand Up @@ -773,7 +765,7 @@ module Of_Lang : sig

val functor_parameter :
map ->
Ident.functor_parameter ->
Ident.module_ ->
Odoc_model.Lang.FunctorParameter.parameter ->
FunctorParameter.parameter

Expand Down
12 changes: 6 additions & 6 deletions src/xref2/cpath.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ module rec Resolved : sig
[ `Module of module_ | `ModuleType of module_type | `FragmentRoot ]

and module_ =
[ `Local of Ident.path_module
[ `Local of Ident.module_
| `Gpath of Path.Resolved.Module.t
| `Substituted of module_
| `Subst of module_type * module_
Expand All @@ -28,7 +28,7 @@ module rec Resolved : sig
| `OpaqueModuleType of module_type ]

and type_ =
[ `Local of Ident.path_type
[ `Local of Ident.type_
| `Gpath of Path.Resolved.Type.t
| `Substituted of type_
| `CanonicalType of type_ * Path.Type.t
Expand All @@ -40,7 +40,7 @@ module rec Resolved : sig
[ `Value of parent * ValueName.t | `Gpath of Path.Resolved.Value.t ]

and class_type =
[ `Local of Ident.path_class_type
[ `Local of Ident.type_
| `Substituted of class_type
| `Gpath of Path.Resolved.ClassType.t
| `Class of parent * TypeName.t
Expand All @@ -52,7 +52,7 @@ and Cpath : sig
type module_ =
[ `Resolved of Resolved.module_
| `Substituted of module_
| `Local of Ident.path_module * bool
| `Local of Ident.module_ * bool
| `Identifier of Identifier.Path.Module.t * bool
| `Root of ModuleName.t
| `Forward of string
Expand All @@ -71,7 +71,7 @@ and Cpath : sig
and type_ =
[ `Resolved of Resolved.type_
| `Substituted of type_
| `Local of Ident.path_type * bool
| `Local of Ident.type_ * bool
| `Identifier of Odoc_model.Paths.Identifier.Path.Type.t * bool
| `DotT of module_ * TypeName.t
| `Type of Resolved.parent * TypeName.t
Expand All @@ -87,7 +87,7 @@ and Cpath : sig
and class_type =
[ `Resolved of Resolved.class_type
| `Substituted of class_type
| `Local of Ident.path_class_type * bool
| `Local of Ident.type_ * bool
| `Identifier of Odoc_model.Paths.Identifier.Path.ClassType.t * bool
| `DotT of module_ * TypeName.t
| `Class of Resolved.parent * TypeName.t
Expand Down
6 changes: 2 additions & 4 deletions src/xref2/env.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -667,9 +667,7 @@ let add_functor_args' :
| ModuleType.Functor (Named arg, res) ->
( arg.Component.FunctorParameter.id,
Paths.Identifier.Mk.parameter
( parent,
Ident.Name.typed_functor_parameter
arg.Component.FunctorParameter.id ),
(parent, Ident.Name.typed_module arg.Component.FunctorParameter.id),
mk_functor_parameter arg.expr )
:: find_args (Paths.Identifier.Mk.result parent) res
| ModuleType.Functor (Unit, res) ->
Expand All @@ -682,7 +680,7 @@ let add_functor_args' :
themselves *)
let fold_fn (env, subst) (ident, identifier, m) =
let ident, identifier =
((ident, identifier) :> Ident.path_module * Identifier.Path.Module.t)
((ident, identifier) :> Ident.module_ * Identifier.Path.Module.t)
in
let doc = m.Component.Module.doc in
let m = Component.Delayed.put_val (Subst.module_ subst m) in
Expand Down
6 changes: 3 additions & 3 deletions src/xref2/errors.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ module Tools_error = struct

and simple_module_lookup_error =
[ `Local of
Env.t * Ident.path_module
Env.t * Ident.module_
(* Internal error: Found local path during lookup *)
| `Find_failure
| (* Internal error: the module was not found in the parent signature *)
Expand Down Expand Up @@ -71,7 +71,7 @@ module Tools_error = struct

and simple_type_lookup_error =
[ `LocalType of
Env.t * Ident.path_type
Env.t * Ident.type_
(* Internal error: Found local path during lookup *)
| `Class_replaced
(* Class was replaced with a destructive substitution and we're not sure
Expand All @@ -86,7 +86,7 @@ module Tools_error = struct

and simple_value_lookup_error =
[ `LocalValue of
Env.t * Ident.path_value
Env.t * Ident.value
(* Internal error: Found local path during lookup *)
| `Find_failure
(* Internal error: the type was not found in the parent signature *)
Expand Down
6 changes: 2 additions & 4 deletions src/xref2/expand_tools.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,7 @@ let handle_expansion env id expansion =
| Named arg ->
let identifier =
Paths.Identifier.Mk.parameter
( parent,
Ident.Name.typed_functor_parameter
arg.Component.FunctorParameter.id )
(parent, Ident.Name.typed_module arg.Component.FunctorParameter.id)
in
let m = Component.module_of_functor_argument arg in
let env' =
Expand All @@ -22,7 +20,7 @@ let handle_expansion env id expansion =
let rp = `Gpath (`Identifier identifier) in
let p = `Resolved rp in
let subst =
Subst.add_module (arg.id :> Ident.path_module) p rp Subst.identity
Subst.add_module (arg.id :> Ident.module_) p rp Subst.identity
in
(env', Subst.module_type_expr subst expr)
in
Expand Down
Loading