637 lines
18 KiB
OCaml
637 lines
18 KiB
OCaml
(***********************************************************************)
|
|
(* OCamldoc *)
|
|
(* *)
|
|
(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *)
|
|
(* *)
|
|
(* Copyright 2001 Institut National de Recherche en Informatique et *)
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
(* under the terms of the Q Public License version 1.0. *)
|
|
(* *)
|
|
(***********************************************************************)
|
|
|
|
(* $Id$ *)
|
|
|
|
(** Research of elements through modules. *)
|
|
|
|
module Name = Odoc_name
|
|
open Odoc_parameter
|
|
open Odoc_value
|
|
open Odoc_type
|
|
open Odoc_exception
|
|
open Odoc_class
|
|
open Odoc_module
|
|
|
|
type result_element =
|
|
Res_module of t_module
|
|
| Res_module_type of t_module_type
|
|
| Res_class of t_class
|
|
| Res_class_type of t_class_type
|
|
| Res_value of t_value
|
|
| Res_type of t_type
|
|
| Res_exception of t_exception
|
|
| Res_attribute of t_attribute
|
|
| Res_method of t_method
|
|
| Res_section of string * Odoc_types.text
|
|
|
|
type result = result_element list
|
|
|
|
module type Predicates =
|
|
sig
|
|
type t
|
|
val p_module : t_module -> t -> bool * bool
|
|
val p_module_type : t_module_type -> t -> bool * bool
|
|
val p_class : t_class -> t -> bool * bool
|
|
val p_class_type : t_class_type -> t -> bool * bool
|
|
val p_value : t_value -> t -> bool
|
|
val p_type : t_type -> t -> bool
|
|
val p_exception : t_exception -> t -> bool
|
|
val p_attribute : t_attribute -> t -> bool
|
|
val p_method : t_method -> t -> bool
|
|
val p_section : string -> t -> bool
|
|
end
|
|
|
|
module Search =
|
|
functor (P : Predicates) ->
|
|
struct
|
|
let search_section t s v = if P.p_section s v then [Res_section (s,t)] else []
|
|
|
|
let rec search_text root t v =
|
|
List.flatten (List.map (fun e -> search_text_ele root e v) t)
|
|
|
|
and search_text_ele root e v =
|
|
let module T = Odoc_types in
|
|
match e with
|
|
| T.Raw _
|
|
| T.Code _
|
|
| T.CodePre _
|
|
| T.Latex _
|
|
| T.Verbatim _
|
|
| T.Ref (_, _, _) -> []
|
|
| T.Bold t
|
|
| T.Italic t
|
|
| T.Center t
|
|
| T.Left t
|
|
| T.Right t
|
|
| T.Emphasize t
|
|
| T.Block t
|
|
| T.Superscript t
|
|
| T.Subscript t
|
|
| T.Custom (_,t)
|
|
| T.Link (_, t) -> search_text root t v
|
|
| T.List l
|
|
| T.Enum l -> List.flatten (List.map (fun t -> search_text root t v) l)
|
|
| T.Newline
|
|
| T.Module_list _
|
|
| T.Index_list -> []
|
|
| T.Target _ -> []
|
|
| T.Title (n, l_opt, t) ->
|
|
(match l_opt with
|
|
None -> []
|
|
| Some s -> search_section t (Name.concat root s) v) @
|
|
(search_text root t v)
|
|
|
|
let search_value va v = if P.p_value va v then [Res_value va] else []
|
|
|
|
let search_type t v = if P.p_type t v then [Res_type t] else []
|
|
|
|
let search_exception e v = if P.p_exception e v then [Res_exception e] else []
|
|
|
|
let search_attribute a v = if P.p_attribute a v then [Res_attribute a] else []
|
|
|
|
let search_method m v = if P.p_method m v then [Res_method m] else []
|
|
|
|
let search_class c v =
|
|
let (go_deeper, ok) = P.p_class c v in
|
|
let l =
|
|
if go_deeper then
|
|
let res_att =
|
|
List.fold_left
|
|
(fun acc -> fun att -> acc @ (search_attribute att v))
|
|
[]
|
|
(Odoc_class.class_attributes c)
|
|
in
|
|
let res_met =
|
|
List.fold_left
|
|
(fun acc -> fun m -> acc @ (search_method m v))
|
|
[]
|
|
(Odoc_class.class_methods c)
|
|
in
|
|
let res_sec =
|
|
List.fold_left
|
|
(fun acc -> fun t -> acc @ (search_text c.cl_name t v))
|
|
[]
|
|
(Odoc_class.class_comments c)
|
|
in
|
|
let l = res_att @ res_met @ res_sec in
|
|
l
|
|
else
|
|
[]
|
|
in
|
|
if ok then
|
|
(Res_class c) :: l
|
|
else
|
|
l
|
|
|
|
let search_class_type ct v =
|
|
let (go_deeper, ok) = P.p_class_type ct v in
|
|
let l =
|
|
if go_deeper then
|
|
let res_att =
|
|
List.fold_left
|
|
(fun acc -> fun att -> acc @ (search_attribute att v))
|
|
[]
|
|
(Odoc_class.class_type_attributes ct)
|
|
in
|
|
let res_met =
|
|
List.fold_left
|
|
(fun acc -> fun m -> acc @ (search_method m v))
|
|
[]
|
|
(Odoc_class.class_type_methods ct)
|
|
in
|
|
let res_sec =
|
|
List.fold_left
|
|
(fun acc -> fun t -> acc @ (search_text ct.clt_name t v))
|
|
[]
|
|
(Odoc_class.class_type_comments ct)
|
|
in
|
|
let l = res_att @ res_met @ res_sec in
|
|
l
|
|
else
|
|
[]
|
|
in
|
|
if ok then
|
|
(Res_class_type ct) :: l
|
|
else
|
|
l
|
|
|
|
let rec search_module_type mt v =
|
|
let (go_deeper, ok) = P.p_module_type mt v in
|
|
let l =
|
|
if go_deeper then
|
|
let res_val =
|
|
List.fold_left
|
|
(fun acc -> fun va -> acc @ (search_value va v))
|
|
[]
|
|
(Odoc_module.module_type_values mt)
|
|
in
|
|
let res_typ =
|
|
List.fold_left
|
|
(fun acc -> fun t -> acc @ (search_type t v))
|
|
[]
|
|
(Odoc_module.module_type_types mt)
|
|
in
|
|
let res_exc =
|
|
List.fold_left
|
|
(fun acc -> fun e -> acc @ (search_exception e v))
|
|
[]
|
|
(Odoc_module.module_type_exceptions mt)
|
|
in
|
|
let res_mod = search (Odoc_module.module_type_modules mt) v in
|
|
let res_modtyp =
|
|
List.fold_left
|
|
(fun acc -> fun mt -> acc @ (search_module_type mt v))
|
|
[]
|
|
(Odoc_module.module_type_module_types mt)
|
|
in
|
|
let res_cl =
|
|
List.fold_left
|
|
(fun acc -> fun cl -> acc @ (search_class cl v))
|
|
[]
|
|
(Odoc_module.module_type_classes mt)
|
|
in
|
|
let res_cltyp =
|
|
List.fold_left
|
|
(fun acc -> fun clt -> acc @ (search_class_type clt v))
|
|
[]
|
|
(Odoc_module.module_type_class_types mt)
|
|
in
|
|
let res_sec =
|
|
List.fold_left
|
|
(fun acc -> fun t -> acc @ (search_text mt.mt_name t v))
|
|
[]
|
|
(Odoc_module.module_type_comments mt)
|
|
in
|
|
let l = res_val @ res_typ @ res_exc @ res_mod @
|
|
res_modtyp @ res_cl @ res_cltyp @ res_sec
|
|
in
|
|
l
|
|
else
|
|
[]
|
|
in
|
|
if ok then
|
|
(Res_module_type mt) :: l
|
|
else
|
|
l
|
|
|
|
and search_module m v =
|
|
let (go_deeper, ok) = P.p_module m v in
|
|
let l =
|
|
if go_deeper then
|
|
let res_val =
|
|
List.fold_left
|
|
(fun acc -> fun va -> acc @ (search_value va v))
|
|
[]
|
|
(Odoc_module.module_values m)
|
|
in
|
|
let res_typ =
|
|
List.fold_left
|
|
(fun acc -> fun t -> acc @ (search_type t v))
|
|
[]
|
|
(Odoc_module.module_types m)
|
|
in
|
|
let res_exc =
|
|
List.fold_left
|
|
(fun acc -> fun e -> acc @ (search_exception e v))
|
|
[]
|
|
(Odoc_module.module_exceptions m)
|
|
in
|
|
let res_mod = search (Odoc_module.module_modules m) v in
|
|
let res_modtyp =
|
|
List.fold_left
|
|
(fun acc -> fun mt -> acc @ (search_module_type mt v))
|
|
[]
|
|
(Odoc_module.module_module_types m)
|
|
in
|
|
let res_cl =
|
|
List.fold_left
|
|
(fun acc -> fun cl -> acc @ (search_class cl v))
|
|
[]
|
|
(Odoc_module.module_classes m)
|
|
in
|
|
let res_cltyp =
|
|
List.fold_left
|
|
(fun acc -> fun clt -> acc @ (search_class_type clt v))
|
|
[]
|
|
(Odoc_module.module_class_types m)
|
|
in
|
|
let res_sec =
|
|
List.fold_left
|
|
(fun acc -> fun t -> acc @ (search_text m.m_name t v))
|
|
[]
|
|
(Odoc_module.module_comments m)
|
|
in
|
|
let l = res_val @ res_typ @ res_exc @ res_mod @
|
|
res_modtyp @ res_cl @ res_cltyp @ res_sec
|
|
in
|
|
l
|
|
else
|
|
[]
|
|
in
|
|
if ok then
|
|
(Res_module m) :: l
|
|
else
|
|
l
|
|
|
|
and search module_list v =
|
|
List.fold_left
|
|
(fun acc -> fun m ->
|
|
List.fold_left
|
|
(fun acc2 -> fun ele ->
|
|
if List.mem ele acc2 then acc2 else acc2 @ [ele]
|
|
)
|
|
acc
|
|
(search_module m v)
|
|
)
|
|
[]
|
|
module_list
|
|
end
|
|
|
|
module P_name =
|
|
struct
|
|
type t = Str.regexp
|
|
let (=~) name regexp = Str.string_match regexp name 0
|
|
let p_module m r = (true, m.m_name =~ r)
|
|
let p_module_type mt r = (true, mt.mt_name =~ r)
|
|
let p_class c r = (true, c.cl_name =~ r)
|
|
let p_class_type ct r = (true, ct.clt_name =~ r)
|
|
let p_value v r = v.val_name =~ r
|
|
let p_type t r = t.ty_name =~ r
|
|
let p_exception e r = e.ex_name =~ r
|
|
let p_attribute a r = a.att_value.val_name =~ r
|
|
let p_method m r = m.met_value.val_name =~ r
|
|
let p_section s r = s =~ r
|
|
end
|
|
|
|
module Search_by_name = Search ( P_name )
|
|
|
|
module P_values =
|
|
struct
|
|
type t = unit
|
|
let p_module _ _ = (true, false)
|
|
let p_module_type _ _ = (true, false)
|
|
let p_class _ _ = (false, false)
|
|
let p_class_type _ _ = (false, false)
|
|
let p_value _ _ = true
|
|
let p_type _ _ = false
|
|
let p_exception _ _ = false
|
|
let p_attribute _ _ = false
|
|
let p_method _ _ = false
|
|
let p_section _ _ = false
|
|
end
|
|
module Search_values = Search ( P_values )
|
|
let values l =
|
|
let l_ele = Search_values.search l () in
|
|
let p v1 v2 = v1.val_name = v2.val_name in
|
|
let rec iter acc = function
|
|
(Res_value v) :: q -> if List.exists (p v) acc then iter acc q else iter (v :: acc) q
|
|
| _ :: q -> iter acc q
|
|
| [] -> acc
|
|
in
|
|
iter [] l_ele
|
|
|
|
module P_exceptions =
|
|
struct
|
|
type t = unit
|
|
let p_module _ _ = (true, false)
|
|
let p_module_type _ _ = (true, false)
|
|
let p_class _ _ = (false, false)
|
|
let p_class_type _ _ = (false, false)
|
|
let p_value _ _ = false
|
|
let p_type _ _ = false
|
|
let p_exception _ _ = true
|
|
let p_attribute _ _ = false
|
|
let p_method _ _ = false
|
|
let p_section _ _ = false
|
|
end
|
|
module Search_exceptions = Search ( P_exceptions )
|
|
let exceptions l =
|
|
let l_ele = Search_exceptions.search l () in
|
|
let p e1 e2 = e1.ex_name = e2.ex_name in
|
|
let rec iter acc = function
|
|
(Res_exception t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
|
|
| _ :: q -> iter acc q
|
|
| [] -> acc
|
|
in
|
|
iter [] l_ele
|
|
|
|
module P_types =
|
|
struct
|
|
type t = unit
|
|
let p_module _ _ = (true, false)
|
|
let p_module_type _ _ = (true, false)
|
|
let p_class _ _ = (false, false)
|
|
let p_class_type _ _ = (false, false)
|
|
let p_value _ _ = false
|
|
let p_type _ _ = true
|
|
let p_exception _ _ = false
|
|
let p_attribute _ _ = false
|
|
let p_method _ _ = false
|
|
let p_section _ _ = false
|
|
end
|
|
module Search_types = Search ( P_types )
|
|
let types l =
|
|
let l_ele = Search_types.search l () in
|
|
let p t1 t2 = t1.ty_name = t2.ty_name in
|
|
let rec iter acc = function
|
|
(Res_type t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
|
|
| _ :: q -> iter acc q
|
|
| [] -> acc
|
|
in
|
|
iter [] l_ele
|
|
|
|
module P_attributes =
|
|
struct
|
|
type t = unit
|
|
let p_module _ _ = (true, false)
|
|
let p_module_type _ _ = (true, false)
|
|
let p_class _ _ = (true, false)
|
|
let p_class_type _ _ = (true, false)
|
|
let p_value _ _ = false
|
|
let p_type _ _ = false
|
|
let p_exception _ _ = false
|
|
let p_attribute _ _ = true
|
|
let p_method _ _ = false
|
|
let p_section _ _ = false
|
|
end
|
|
module Search_attributes = Search ( P_attributes )
|
|
let attributes l =
|
|
let l_ele = Search_attributes.search l () in
|
|
let p a1 a2 = a1.att_value.val_name = a2.att_value.val_name in
|
|
let rec iter acc = function
|
|
(Res_attribute t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
|
|
| _ :: q -> iter acc q
|
|
| [] -> acc
|
|
in
|
|
iter [] l_ele
|
|
|
|
module P_methods =
|
|
struct
|
|
type t = unit
|
|
let p_module _ _ = (true, false)
|
|
let p_module_type _ _ = (true, false)
|
|
let p_class _ _ = (true, false)
|
|
let p_class_type _ _ = (true, false)
|
|
let p_value _ _ = false
|
|
let p_type _ _ = false
|
|
let p_exception _ _ = false
|
|
let p_attribute _ _ = false
|
|
let p_method _ _ = true
|
|
let p_section _ _ = true
|
|
end
|
|
module Search_methods = Search ( P_methods )
|
|
let methods l =
|
|
let l_ele = Search_methods.search l () in
|
|
let p m1 m2 = m1.met_value.val_name = m2.met_value.val_name in
|
|
let rec iter acc = function
|
|
(Res_method t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
|
|
| _ :: q -> iter acc q
|
|
| [] -> acc
|
|
in
|
|
iter [] l_ele
|
|
|
|
module P_classes =
|
|
struct
|
|
type t = unit
|
|
let p_module _ _ = (true, false)
|
|
let p_module_type _ _ = (true, false)
|
|
let p_class _ _ = (false, true)
|
|
let p_class_type _ _ = (false, false)
|
|
let p_value _ _ = false
|
|
let p_type _ _ = false
|
|
let p_exception _ _ = false
|
|
let p_attribute _ _ = false
|
|
let p_method _ _ = false
|
|
let p_section _ _ = false
|
|
end
|
|
module Search_classes = Search ( P_classes )
|
|
let classes l =
|
|
let l_ele = Search_classes.search l () in
|
|
let p c1 c2 = c1.cl_name = c2.cl_name in
|
|
let rec iter acc = function
|
|
(Res_class c) :: q -> if List.exists (p c) acc then iter acc q else iter (c :: acc) q
|
|
| _ :: q -> iter acc q
|
|
| [] -> acc
|
|
in
|
|
iter [] l_ele
|
|
|
|
module P_class_types =
|
|
struct
|
|
type t = unit
|
|
let p_module _ _ = (true, false)
|
|
let p_module_type _ _ = (true, false)
|
|
let p_class _ _ = (false, false)
|
|
let p_class_type _ _ = (false, true)
|
|
let p_value _ _ = false
|
|
let p_type _ _ = false
|
|
let p_exception _ _ = false
|
|
let p_attribute _ _ = false
|
|
let p_method _ _ = false
|
|
let p_section _ _ = false
|
|
end
|
|
module Search_class_types = Search ( P_class_types )
|
|
let class_types l =
|
|
let l_ele = Search_class_types.search l () in
|
|
let p c1 c2 = c1.clt_name = c2.clt_name in
|
|
let rec iter acc = function
|
|
(Res_class_type c) :: q -> if List.exists (p c) acc then iter acc q else iter (c :: acc) q
|
|
| _ :: q -> iter acc q
|
|
| [] -> acc
|
|
in
|
|
iter [] l_ele
|
|
|
|
module P_modules =
|
|
struct
|
|
type t = unit
|
|
let p_module _ _ = (true, true)
|
|
let p_module_type _ _ = (true, false)
|
|
let p_class _ _ = (false, false)
|
|
let p_class_type _ _ = (false, false)
|
|
let p_value _ _ = false
|
|
let p_type _ _ = false
|
|
let p_exception _ _ = false
|
|
let p_attribute _ _ = false
|
|
let p_method _ _ = false
|
|
let p_section _ _ = false
|
|
end
|
|
module Search_modules = Search ( P_modules )
|
|
let modules l =
|
|
let l_ele = Search_modules.search l () in
|
|
let p m1 m2 = m1.m_name = m2.m_name in
|
|
let rec iter acc = function
|
|
(Res_module m) :: q -> if List.exists (p m) acc then iter acc q else iter (m :: acc) q
|
|
| _ :: q -> iter acc q
|
|
| [] -> acc
|
|
in
|
|
iter [] l_ele
|
|
|
|
module P_module_types =
|
|
struct
|
|
type t = unit
|
|
let p_module _ _ = (true, false)
|
|
let p_module_type _ _ = (true, true)
|
|
let p_class _ _ = (false, false)
|
|
let p_class_type _ _ = (false, false)
|
|
let p_value _ _ = false
|
|
let p_type _ _ = false
|
|
let p_exception _ _ = false
|
|
let p_attribute _ _ = false
|
|
let p_method _ _ = false
|
|
let p_section _ _ = false
|
|
end
|
|
module Search_module_types = Search ( P_module_types )
|
|
let module_types l =
|
|
let l_ele = Search_module_types.search l () in
|
|
let p m1 m2 = m1.mt_name = m2.mt_name in
|
|
let rec iter acc = function
|
|
(Res_module_type m) :: q -> if List.exists (p m) acc then iter acc q else iter (m :: acc) q
|
|
| _ :: q -> iter acc q
|
|
| [] -> acc
|
|
in
|
|
iter [] l_ele
|
|
|
|
let type_exists mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
List.exists
|
|
(function
|
|
Res_type _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
|
|
let value_exists mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
List.exists
|
|
(function
|
|
Res_value _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
|
|
let class_exists mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
List.exists
|
|
(function
|
|
Res_class _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
|
|
let class_type_exists mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
List.exists
|
|
(function
|
|
Res_class_type _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
|
|
let module_exists mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
List.exists
|
|
(function
|
|
Res_module _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
|
|
let module_type_exists mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
List.exists
|
|
(function
|
|
Res_module_type _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
|
|
let exception_exists mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
List.exists
|
|
(function
|
|
Res_exception _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
|
|
let attribute_exists mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
List.exists
|
|
(function
|
|
Res_attribute _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
|
|
let method_exists mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
List.exists
|
|
(function
|
|
Res_method _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
|
|
let find_section mods regexp =
|
|
let l = Search_by_name.search mods regexp in
|
|
match
|
|
List.find
|
|
(function
|
|
Res_section _ -> true
|
|
| _ -> false
|
|
)
|
|
l
|
|
with
|
|
Res_section (_,t) -> t
|
|
| _ -> assert false
|
|
|
|
(* eof $Id$ *)
|