diff options
Diffstat (limited to 'ocamldoc/odoc_search.ml')
| -rw-r--r-- | ocamldoc/odoc_search.ml | 632 |
1 files changed, 0 insertions, 632 deletions
diff --git a/ocamldoc/odoc_search.ml b/ocamldoc/odoc_search.ml deleted file mode 100644 index 990930d695..0000000000 --- a/ocamldoc/odoc_search.ml +++ /dev/null @@ -1,632 +0,0 @@ -(***********************************************************************) -(* 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.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.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$ *) |