diff options
Diffstat (limited to 'ocamldoc/odoc_dep.ml')
| -rw-r--r-- | ocamldoc/odoc_dep.ml | 219 |
1 files changed, 0 insertions, 219 deletions
diff --git a/ocamldoc/odoc_dep.ml b/ocamldoc/odoc_dep.ml deleted file mode 100644 index c02d66066f..0000000000 --- a/ocamldoc/odoc_dep.ml +++ /dev/null @@ -1,219 +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$ *) - -(** Top modules dependencies. *) - -module StrS = Depend.StringSet -module Module = Odoc_module -module Type = Odoc_type - -let set_to_list s = - let l = ref [] in - StrS.iter (fun e -> l := e :: !l) s; - !l - -let impl_dependencies ast = - Depend.free_structure_names := StrS.empty; - Depend.add_use_file StrS.empty [Parsetree.Ptop_def ast]; - set_to_list !Depend.free_structure_names - -let intf_dependencies ast = - Depend.free_structure_names := StrS.empty; - Depend.add_signature StrS.empty ast; - set_to_list !Depend.free_structure_names - - -module Dep = - struct - type id = string - - module S = Set.Make (struct type t = string let compare = compare end) - - let set_to_list s = - let l = ref [] in - S.iter (fun e -> l := e :: !l) s; - !l - - type node = { - id : id ; - mutable near : S.t ; (** fils directs *) - mutable far : (id * S.t) list ; (** fils indirects, par quel fils *) - reflex : bool ; (** reflexive or not, we keep - information here to remove the node itself from its direct children *) - } - - type graph = node list - - let make_node s children = - let set = List.fold_right - S.add - children - S.empty - in - { id = s; - near = S.remove s set ; - far = [] ; - reflex = List.mem s children ; - } - - let get_node graph s = - try List.find (fun n -> n.id = s) graph - with Not_found -> - make_node s [] - - let rec trans_closure graph acc n = - if S.mem n.id acc then - acc - else - (* optimisation plus tard : utiliser le champ far si non vide ? *) - S.fold - (fun child -> fun acc2 -> - trans_closure graph acc2 (get_node graph child)) - n.near - (S.add n.id acc) - - let node_trans_closure graph n = - let far = List.map - (fun child -> - let set = trans_closure graph S.empty (get_node graph child) in - (child, set) - ) - (set_to_list n.near) - in - n.far <- far - - let compute_trans_closure graph = - List.iter (node_trans_closure graph) graph - - let prune_node graph node = - S.iter - (fun child -> - let set_reachables = List.fold_left - (fun acc -> fun (ch, reachables) -> - if child = ch then - acc - else - S.union acc reachables - ) - S.empty - node.far - in - let set = S.remove node.id set_reachables in - if S.exists (fun n2 -> S.mem child (get_node graph n2).near) set then - ( - node.near <- S.remove child node.near ; - node.far <- List.filter (fun (ch,_) -> ch <> child) node.far - ) - else - () - ) - node.near; - if node.reflex then - node.near <- S.add node.id node.near - else - () - - let kernel graph = - (* compute transitive closure *) - compute_trans_closure graph ; - - (* remove edges to keep a transitive kernel *) - List.iter (prune_node graph) graph; - - graph - - end - -(** [type_deps t] returns the list of fully qualified type names - [t] depends on. *) -let type_deps t = - let module T = Odoc_type in - let l = ref [] in - let re = Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)" in - let f s = - let s2 = Str.matched_string s in - l := s2 :: !l ; - s2 - in - (match t.T.ty_kind with - T.Type_abstract -> () - | T.Type_variant (cl, _) -> - List.iter - (fun c -> - List.iter - (fun e -> - let s = Odoc_misc.string_of_type_expr e in - ignore (Str.global_substitute re f s) - ) - c.T.vc_args - ) - cl - | T.Type_record (rl, _) -> - List.iter - (fun r -> - let s = Odoc_misc.string_of_type_expr r.T.rf_type in - ignore (Str.global_substitute re f s) - ) - rl - ); - - (match t.T.ty_manifest with - None -> () - | Some e -> - let s = Odoc_misc.string_of_type_expr e in - ignore (Str.global_substitute re f s) - ); - - !l - -(** Modify the modules depencies of the given list of modules, - to get the minimum transitivity kernel. *) -let kernel_deps_of_modules modules = - let graph = List.map - (fun m -> Dep.make_node m.Module.m_name m.Module.m_top_deps) - modules - in - let k = Dep.kernel graph in - List.iter - (fun m -> - let node = Dep.get_node k m.Module.m_name in - m.Module.m_top_deps <- - List.filter (fun m2 -> Dep.S.mem m2 node.Dep.near) m.Module.m_top_deps) - modules - -(** Return the list of dependencies between the given types, - in the form of a list [(type, names of types it depends on)]. - @param kernel indicates if we must keep only the transitivity kernel - of the dependencies. Default is [false]. -*) -let deps_of_types ?(kernel=false) types = - let deps_pre = List.map (fun t -> (t, type_deps t)) types in - let deps = - if kernel then - ( - let graph = List.map - (fun (t, names) -> Dep.make_node t.Type.ty_name names) - deps_pre - in - let k = Dep.kernel graph in - List.map - (fun t -> - let node = Dep.get_node k t.Type.ty_name in - (t, Dep.set_to_list node.Dep.near) - ) - types - ) - else - deps_pre - in - deps |