+6 -5

odoc/sherlodoc/index/typename.ml

reviewed

··· 20 20 21 21 let rec show_type_name_verbose h : Path.Type.t -> _ = function 22 22 | `Resolved t -> 23 23 - (match Path.Resolved.(identifier (t :> t)) with 23 23 + let i = Path.Resolved.(identifier (t :> t)) in 24 24 + (match i with 24 25 | Some i -> Format.fprintf h "%a" show_ident_long i 25 25 - | None -> 26 26 - (match t with 27 27 - | `CoreType n -> Format.fprintf h "%s" (Odoc_model.Names.TypeName.to_string n) 28 28 - | _ -> Format.fprintf h "%s" "Core type")) 26 26 + | None -> Format.fprintf h "<unresolved>") 29 27 | `Identifier (path, _hidden) -> 30 28 let name = String.concat "." @@ Identifier.fullname path in 31 29 Format.fprintf h "%s" name ··· 36 34 (Odoc_document.Url.render_path (mdl :> Path.t)) 37 35 (Odoc_model.Names.TypeName.to_string x) 38 36 | `SubstitutedT x -> show_type_name_verbose h x 37 37 + | `SubstitutedCT x -> show_type_name_verbose h (x :> Path.Type.t) 38 38 + | `LocalTy (`Na _) -> . 39 39 + | `Type (`Na _, _, _) -> . 39 40 40 41 let to_string t = Format.asprintf "%a" show_type_name_verbose t

+14 -10

odoc/src/document/generator.ml

reviewed

··· 138 138 let link1 = from_path (p1 :> Path.t) in 139 139 let link2 = from_path (p2 :> Path.t) in 140 140 link1 ++ O.txt "(" ++ link2 ++ O.txt ")" 141 141 + | `Module (`Na _, _, _) -> . 142 142 + | `ModuleType (`Na _, _, _) -> . 143 143 + | `Type (`Na _, _, _) -> . 144 144 + | `LocalMod (`Na _) -> . 145 145 + | `LocalModTy (`Na _) -> . 146 146 + | `LocalTy (`Na _) -> . 147 147 + | `LocalVal (`Na _) -> . 141 148 | `Resolved _ when Paths.Path.is_hidden path -> 142 149 let txt = Url.render_path path in 143 150 unresolved [ inline @@ Text txt ] 151 151 + | `Resolved (`CoreType n) -> 152 152 + O.elt [ inline @@ Text (TypeName.to_string n) ] 144 153 | `Resolved rp -> ( 145 154 (* If the path is pointing to an opaque module or module type 146 155 there won't be a page generated - so we stop before; at ··· 152 161 | _ -> false 153 162 in 154 163 let txt = [ inline @@ Text (Url.render_path path) ] in 155 155 - match Paths.Path.Resolved.identifier rp with 156 156 - | Some id -> 157 157 - let href = Url.from_identifier ~stop_before id in 158 158 - resolved href txt 159 159 - | None -> O.elt txt) 164 164 + let id = Option.get (Paths.Path.Resolved.identifier rp) in 165 165 + let href = Url.from_identifier ~stop_before id in 166 166 + resolved href txt) 160 167 161 168 let dot prefix suffix = prefix ^ "." ^ suffix 162 169 ··· 200 207 let open Fragment in 201 208 let id = Resolved.identifier (fragment :> Resolved.t) in 202 209 let txt = render_resolved_fragment (fragment :> Resolved.t) in 203 203 - match id with 204 204 - | Some id -> 205 205 - let href = Url.from_identifier ~stop_before:false id in 206 206 - resolved href [ inline @@ Text txt ] 207 207 - | None -> unresolved [ inline @@ Text txt ] 210 210 + let href = Url.from_identifier ~stop_before:false id in 211 211 + resolved href [ inline @@ Text txt ] 208 212 209 213 let from_fragment : Fragment.leaf -> text = function 210 214 | `Resolved r

+24 -8

odoc/src/document/url.ml

reviewed

··· 52 52 let render_path : Path.t -> string = 53 53 let rec render_resolved : Path.Resolved.t -> string = 54 54 let open Path.Resolved in 55 55 + let render_parent : (na, na, na) Path.Resolved.parent_gen -> string = function 56 56 + | `Module m -> render_resolved (m :> t) 57 57 + | `ModuleType (_, `Na _) -> . 58 58 + | `FragmentRoot (`Na _) -> . 59 59 + in 55 60 function 56 61 | `Identifier id -> full_ident_name id 57 62 | `CoreType n -> TypeName.to_string n ··· 59 64 | `OpaqueModuleType p -> render_resolved (p :> t) 60 65 | `Subst (_, p) -> render_resolved (p :> t) 61 66 | `SubstT (_, p) -> render_resolved (p :> t) 62 62 - | `Alias (dest, `Resolved src) -> 67 67 + | `Alias (dest, `Resolved src, _) -> 63 68 if Path.Resolved.(is_hidden (src :> t)) then render_resolved (dest :> t) 64 69 else render_resolved (src :> t) 65 65 - | `Alias (dest, src) -> 70 70 + | `Alias (dest, src, _) -> 66 71 if Path.is_hidden (src :> Path.t) then render_resolved (dest :> t) 67 72 else render_path (src :> Path.t) 68 73 | `AliasModuleType (p1, p2) -> 69 74 if Path.Resolved.(is_hidden (p2 :> t)) then render_resolved (p1 :> t) 70 75 else render_resolved (p2 :> t) 71 76 | `Hidden p -> render_resolved (p :> t) 72 72 - | `Module (p, s) -> render_resolved (p :> t) ^ "." ^ ModuleName.to_string s 77 77 + | `Module (p, s) -> render_parent p ^ "." ^ ModuleName.to_string s 73 78 | `Canonical (_, `Resolved p) -> render_resolved (p :> t) 74 79 | `Canonical (p, _) -> render_resolved (p :> t) 75 80 | `CanonicalModuleType (_, `Resolved p) -> render_resolved (p :> t) ··· 86 91 ^ render_resolved (p :> Path.Resolved.t) 87 92 ^ ")" 88 93 | `ModuleType (p, s) -> 89 89 - render_resolved (p :> t) ^ "." ^ ModuleTypeName.to_string s 90 90 - | `Type (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s 91 91 - | `Value (p, s) -> render_resolved (p :> t) ^ "." ^ ValueName.to_string s 92 92 - | `Class (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s 93 93 - | `ClassType (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s 94 94 + render_parent p ^ "." ^ ModuleTypeName.to_string s 95 95 + | `Type (p, s) -> render_parent p ^ "." ^ TypeName.to_string s 96 96 + | `Value (p, s) -> render_parent p ^ "." ^ ValueName.to_string s 97 97 + | `Class (p, s) -> render_parent p ^ "." ^ TypeName.to_string s 98 98 + | `ClassType (p, s) -> render_parent p ^ "." ^ TypeName.to_string s 99 99 + | `LocalMod (`Na _) -> . 100 100 + | `LocalModTy (`Na _) -> . 101 101 + | `LocalTy (`Na _) -> . 102 102 + | `LocalVal (`Na _) -> . 94 103 and dot p s = render_path (p : Path.Module.t :> Path.t) ^ "." ^ s 95 104 and render_path : Path.t -> string = 96 105 fun x -> ··· 109 118 | `SubstitutedMT m -> render_path (m :> Path.t) 110 119 | `SubstitutedT m -> render_path (m :> Path.t) 111 120 | `SubstitutedCT m -> render_path (m :> Path.t) 121 121 + | `Module (`Na _, _, _) -> . 122 122 + | `ModuleType (`Na _, _, _) -> . 123 123 + | `Type (`Na _, _, _) -> . 124 124 + | `LocalMod (`Na _) -> . 125 125 + | `LocalModTy (`Na _) -> . 126 126 + | `LocalTy (`Na _) -> . 127 127 + | `LocalVal (`Na _) -> . 112 128 in 113 129 114 130 render_path

+7 -2

odoc/src/loader/doc_attr.cppo.ml

reviewed

··· 219 219 | None -> `Return 220 220 in 221 221 let rec extract_tail_alerts acc = function 222 222 - (* Accumulate the alerts after the top-comment. Stop at the next comment. *) 222 222 + (* Accumulate the alerts after the top-comment. Stop at the next comment. 223 223 + [`Skip] items (open statements, unrecognised attributes) are preserved 224 224 + in the returned items list — dropping them silently loses [open 225 225 + struct ... end] declarations that follow the top docstring. *) 223 226 | hd :: tl as items -> ( 224 227 match classify hd with 225 228 | `Text _ | `Return -> (items, acc) 226 229 | `Alert alert -> extract_tail_alerts (alert :: acc) tl 227 227 - | `Skip -> extract_tail_alerts acc tl) 230 230 + | `Skip -> 231 231 + let items, alerts = extract_tail_alerts acc tl in 232 232 + (hd :: items, alerts)) 228 233 | [] -> ([], acc) 229 234 and extract = function 230 235 (* Extract the first comment and accumulate the alerts before and after

+512 -324

odoc/src/model/paths.ml

reviewed

··· 19 19 20 20 open Names 21 21 22 22 + type na_ty = | 23 23 + type na = [ `Na of na_ty ] 24 24 + 22 25 module Identifier = struct 23 26 type 'a id = 'a Paths_types.id = { iv : 'a; ihash : int; ikey : string } 24 27 ··· 666 669 end 667 670 end 668 671 672 672 + module P = Paths_types.Path 673 673 + module RP = Paths_types.Resolved_path 674 674 + 669 675 module Path = struct 670 670 - type t = Paths_types.Path.any 676 676 + type ('lmod, 'lmodty, 'pty, 'a) genfn3 = { 677 677 + lmod : 'lmod -> 'a; 678 678 + lmodty : 'lmodty -> 'a; 679 679 + pty : 'pty -> 'a; 680 680 + } 671 681 672 672 - let rec is_resolved_hidden : 673 673 - weak_canonical_test:bool -> Paths_types.Resolved_path.any -> bool = 674 674 - fun ~weak_canonical_test x -> 675 675 - let open Paths_types.Resolved_path in 676 676 - let rec inner : Paths_types.Resolved_path.any -> bool = function 677 677 - | `Identifier { iv = `ModuleType (_, m); _ } 678 678 - when Names.ModuleTypeName.is_hidden m -> 679 679 - true 680 680 - | `Identifier { iv = `Type (_, t); _ } when Names.TypeName.is_hidden t -> 681 681 - true 682 682 - | `Identifier { iv = `Module (_, m); _ } when Names.ModuleName.is_hidden m 683 683 - -> 684 684 - true 682 682 + type ('lmod, 'lmodty, 'pty, 'lty, 'lval, 'a) genfn5 = { 683 683 + g : ('lmod, 'lmodty, 'pty, 'a) genfn3; 684 684 + lty : 'lty -> 'a; 685 685 + lval : 'lval -> 'a; 686 686 + } 687 687 + 688 688 + module Hidden = struct 689 689 + let rec rgen : 690 690 + wct:bool -> 691 691 + ('lmod, 'lmodty, 'pty, 'lty, 'lval, bool) genfn5 -> 692 692 + ('lmod, 'lmodty, 'pty, 'lty, 'lval) RP.any -> 693 693 + bool = 694 694 + fun ~wct f x -> 695 695 + match x with 696 696 + | `Identifier { iv = `ModuleType (_, m); _ } -> ModuleTypeName.is_hidden m 697 697 + | `Identifier { iv = `Type (_, t); _ } -> TypeName.is_hidden t 698 698 + | `Identifier { iv = `Module (_, m); _ } -> ModuleName.is_hidden m 685 699 | `Identifier _ -> false 686 700 | `Canonical (_, `Resolved _) -> false 687 687 - | `Canonical (x, _) -> 688 688 - (not weak_canonical_test) && inner (x : module_ :> any) 701 701 + | `Canonical (x, _) -> (not wct) && rmod ~wct f x 689 702 | `Hidden _ -> true 690 690 - | `Subst (p1, p2) -> 691 691 - inner (p1 : module_type :> any) || inner (p2 : module_ :> any) 692 692 - | `Module (p, _) -> inner (p : module_ :> any) 693 693 - | `Apply (p, _) -> inner (p : module_ :> any) 694 694 - | `ModuleType (_, m) when Names.ModuleTypeName.is_hidden m -> true 695 695 - | `ModuleType (p, _) -> inner (p : module_ :> any) 696 696 - | `Type (_, t) when Names.TypeName.is_hidden t -> true 697 697 - | `CoreType t -> Names.TypeName.is_hidden t 698 698 - | `Type (p, _) -> inner (p : module_ :> any) 699 699 - | `Value (_, t) when Names.ValueName.is_hidden t -> true 700 700 - | `Value (p, _) -> inner (p : module_ :> any) 701 701 - | `Class (p, _) -> inner (p : module_ :> any) 702 702 - | `ClassType (p, _) -> inner (p : module_ :> any) 703 703 - | `Alias (dest, `Resolved src) -> 704 704 - inner (dest : module_ :> any) && inner (src : module_ :> any) 705 705 - | `Alias (dest, src) -> 706 706 - inner (dest : module_ :> any) 707 707 - && is_path_hidden (src :> Paths_types.Path.any) 708 708 - | `AliasModuleType (p1, p2) -> 709 709 - inner (p1 : module_type :> any) && inner (p2 : module_type :> any) 710 710 - | `SubstT (p1, p2) -> inner (p1 :> any) || inner (p2 :> any) 711 711 - | `Substituted m -> inner (m :> any) 712 712 - | `SubstitutedMT m -> inner (m :> any) 713 713 - | `SubstitutedT m -> inner (m :> any) 714 714 - | `SubstitutedCT m -> inner (m :> any) 703 703 + | `Subst (p1, p2) -> rmodty ~wct f p1 || rmod ~wct f p2 704 704 + | `Module (p, _) -> parent ~wct f p 705 705 + | `Apply (p, _) -> rmod ~wct f p 706 706 + | `ModuleType (_, m) when ModuleTypeName.is_hidden m -> true 707 707 + | `ModuleType (p, _) -> parent ~wct f p 708 708 + | `Type (_, t) when TypeName.is_hidden t -> true 709 709 + | `Type (p, _) -> parent ~wct f p 710 710 + | `CoreType _ -> false 711 711 + | `Value (_, t) when ValueName.is_hidden t -> true 712 712 + | `Value (p, _) -> parent ~wct f p 713 713 + | `Class (p, _) -> parent ~wct f p 714 714 + | `ClassType (p, _) -> parent ~wct f p 715 715 + | `Alias (dest, `Resolved src, _) -> rmod ~wct f dest && rmod ~wct f src 716 716 + | `Alias (dest, src, _) -> rmod ~wct f dest && mod_ f src 717 717 + | `AliasModuleType (p1, p2) -> rmodty ~wct f p1 && rmodty ~wct f p2 718 718 + | `SubstT (p1, p2) -> rmodty ~wct f p1 || rmodty ~wct f p2 719 719 + | `Substituted m -> rmod ~wct f m 720 720 + | `SubstitutedMT m -> rmodty ~wct f m 721 721 + | `SubstitutedT m -> rty ~wct f m 722 722 + | `SubstitutedCT m -> rcty ~wct f m 715 723 | `CanonicalModuleType (_, `Resolved _) -> false 716 716 - | `CanonicalModuleType (x, _) -> inner (x : module_type :> any) 724 724 + | `CanonicalModuleType (m, _) -> rmodty ~wct f m 717 725 | `CanonicalType (_, `Resolved _) -> false 718 718 - | `CanonicalType (x, _) -> inner (x : type_ :> any) 719 719 - | `OpaqueModule m -> inner (m :> any) 720 720 - | `OpaqueModuleType mt -> inner (mt :> any) 721 721 - in 722 722 - inner x 726 726 + | `CanonicalType (x, _) -> rty ~wct f x 727 727 + | `OpaqueModule m -> rmod ~wct f m 728 728 + | `OpaqueModuleType mt -> rmodty ~wct f mt 729 729 + | `LocalMod m -> f.g.lmod m 730 730 + | `LocalModTy mt -> f.g.lmodty mt 731 731 + | `LocalTy ty -> f.lty ty 732 732 + | `LocalVal v -> f.lval v 733 733 + 734 734 + and[@ocaml.inline always] parent : 735 735 + wct:bool -> 736 736 + ('lmod, 'lmodty, 'pty, 'lty, 'lval, bool) genfn5 -> 737 737 + ('lmod, 'lmodty, 'pty) RP.parent -> 738 738 + bool = 739 739 + fun ~wct f parent -> 740 740 + match parent with 741 741 + | `Module m -> rmod ~wct f m 742 742 + | `ModuleType (mty, _) -> rmodty ~wct f mty 743 743 + | `FragmentRoot fr -> f.g.pty fr 744 744 + 745 745 + and gen : 746 746 + ('lmod, 'lmodty, 'pty, 'lty, 'lval, bool) genfn5 -> 747 747 + ('lmod, 'lmodty, 'pty, 'lty, 'lval) P.any -> 748 748 + bool = 749 749 + fun f p -> 750 750 + match p with 751 751 + | `Resolved r -> rgen ~wct:false f r 752 752 + | `Identifier (_, hidden) -> hidden 753 753 + | `Substituted r -> mod_ f r 754 754 + | `SubstitutedMT r -> modty f r 755 755 + | `SubstitutedT r -> ty f r 756 756 + | `SubstitutedCT r -> cty f r 757 757 + | `Root s -> ModuleName.is_hidden s 758 758 + | `Forward _ -> false 759 759 + | `Dot (p, n) -> ModuleName.is_hidden n || mod_ f p 760 760 + | `DotMT (p, n) -> ModuleTypeName.is_hidden n || mod_ f p 761 761 + | `DotT (p, n) -> TypeName.is_hidden n || mod_ f p 762 762 + | `DotV (p, n) -> ValueName.is_hidden n || mod_ f p 763 763 + | `Apply (p1, p2) -> mod_ f p1 || mod_ f p2 764 764 + | `Module (_, p, n) -> ModuleName.is_hidden n || parent ~wct:false f p 765 765 + | `ModuleType (_, p, n) -> 766 766 + ModuleTypeName.is_hidden n || parent ~wct:false f p 767 767 + | `Type (_, p, n) -> TypeName.is_hidden n || parent ~wct:false f p 768 768 + | `LocalMod m -> f.g.lmod m 769 769 + | `LocalModTy mty -> f.g.lmodty mty 770 770 + | `LocalTy ty -> f.lty ty 771 771 + | `LocalVal v -> f.lval v 772 772 + 773 773 + (* Coercion functions, always inlined! *) 774 774 + 775 775 + and[@ocaml.inline always] mod_ f m = 776 776 + gen f 777 777 + (m 778 778 + : ('lmod, 'lmodty, 'pty) P.module_ 779 779 + :> ('lmod, 'lmodty, 'pty, _, _) P.any) 780 780 + 781 781 + and[@ocaml.inline always] modty f m = 782 782 + gen f 783 783 + (m 784 784 + : ('lmod, 'lmodty, 'pty) P.module_type 785 785 + :> ('lmod, 'lmodty, 'pty, _, _) P.any) 786 786 + 787 787 + and[@ocaml.inline always] ty f t = 788 788 + gen f 789 789 + (t 790 790 + : ('lmod, 'lmodty, 'pty, 'lty) P.type_ 791 791 + :> ('lmod, 'lmodty, 'pty, 'lty, _) P.any) 792 792 + 793 793 + and[@ocaml.inline always] cty f t = 794 794 + gen f 795 795 + (t 796 796 + : ('lmod, 'lmodty, 'pty, 'lty) P.class_type 797 797 + :> ('lmod, 'lmodty, 'pty, 'lty, _) P.any) 798 798 + 799 799 + and[@ocaml.inline always] rmod ~wct f 800 800 + (m : ('lmod, 'lmodty, 'pty) RP.module_) = 801 801 + rgen ~wct f (m :> ('lmod, 'lmodty, 'pty, _, _) RP.any) 802 802 + 803 803 + and[@ocaml.inline always] rmodty ~wct f 804 804 + (m : ('lmod, 'lmodty, 'pty) RP.module_type) = 805 805 + rgen ~wct f (m :> ('lmod, 'lmodty, 'pty, _, _) RP.any) 806 806 + 807 807 + and[@ocaml.inline always] rty ~wct f 808 808 + (t : ('lmod, 'lmodty, 'pty, 'lty) RP.type_) = 809 809 + rgen ~wct f (t :> ('lmod, 'lmodty, 'pty, 'lty, _) RP.any) 810 810 + 811 811 + and[@ocaml.inline always] rcty ~wct f 812 812 + (t : ('lmod, 'lmodty, 'pty, 'lty) RP.class_type) = 813 813 + rgen ~wct f (t :> ('lmod, 'lmodty, 'pty, 'lty, _) RP.any) 814 814 + end 815 815 + 816 816 + let is_resolved_hidden_gen : 817 817 + weak_canonical_test:bool -> 818 818 + ('lmod, 'lmodty, 'pty, 'lty, 'lval, bool) genfn5 -> 819 819 + ('lmod, 'lmodty, 'pty, 'lty, 'lval) RP.any -> 820 820 + bool = 821 821 + fun ~weak_canonical_test:wct f p -> Hidden.rgen ~wct f p 822 822 + 823 823 + let is_hidden_gen : 824 824 + ('lmod, 'lmodty, 'pty, 'lty, 'lval, bool) genfn5 -> 825 825 + ('lmod, 'lmodty, 'pty, 'lty, 'lval) P.any -> 826 826 + bool = 827 827 + fun f p -> Hidden.gen f p 828 828 + 829 829 + type ('a, 'b, 'c, 'd, 'e) gen = ('a, 'b, 'c, 'd, 'e) P.any 830 830 + type t = (na, na, na, na, na) P.any 831 831 + type rt = (na, na, na, na, na) RP.any 832 832 + type parent = (na, na, na) RP.parent 833 833 + 834 834 + type rmodule = (na, na, na) RP.module_ 835 835 + 836 836 + let get_parent_module : parent -> rmodule = function 837 837 + | `Module p -> p 838 838 + | `ModuleType (_, `Na _) | `FragmentRoot (`Na _) -> . 839 839 + 840 840 + let f = 841 841 + { 842 842 + g = 843 843 + { 844 844 + lmod = (fun _ -> false); 845 845 + lmodty = (fun _ -> false); 846 846 + pty = (fun _ -> false); 847 847 + }; 848 848 + lty = (fun _ -> false); 849 849 + lval = (fun _ -> false); 850 850 + } 723 851 724 724 - and is_path_hidden : Paths_types.Path.any -> bool = 725 725 - let open Paths_types.Path in 726 726 - function 727 727 - | `Resolved r -> is_resolved_hidden ~weak_canonical_test:false r 728 728 - | `Identifier (_, hidden) -> hidden 729 729 - | `Substituted r -> is_path_hidden (r :> any) 730 730 - | `SubstitutedMT r -> is_path_hidden (r :> any) 731 731 - | `SubstitutedT r -> is_path_hidden (r :> any) 732 732 - | `SubstitutedCT r -> is_path_hidden (r :> any) 733 733 - | `Root s -> ModuleName.is_hidden s 734 734 - | `Forward _ -> false 735 735 - | `Dot (p, n) -> 736 736 - ModuleName.is_hidden n || is_path_hidden (p : module_ :> any) 737 737 - | `DotMT (p, n) -> 738 738 - ModuleTypeName.is_hidden n || is_path_hidden (p : module_ :> any) 739 739 - | `DotT (p, n) -> 740 740 - TypeName.is_hidden n || is_path_hidden (p : module_ :> any) 741 741 - | `DotV (p, n) -> 742 742 - ValueName.is_hidden n || is_path_hidden (p : module_ :> any) 743 743 - | `Apply (p1, p2) -> 744 744 - is_path_hidden (p1 : module_ :> any) 745 745 - || is_path_hidden (p2 : module_ :> any) 852 852 + let is_resolved_hidden ~weak_canonical_test p = 853 853 + is_resolved_hidden_gen ~weak_canonical_test f p 854 854 + 855 855 + let is_path_hidden p = is_hidden_gen f p 746 856 747 857 module Resolved = struct 748 748 - type t = Paths_types.Resolved_path.any 858 858 + type ('lmod, 'lmodty, 'pty, 'lty, 'lval) gen = 859 859 + ('lmod, 'lmodty, 'pty, 'lty, 'lval) RP.any 860 860 + type t = (na, na, na, na, na) gen 861 861 + type nonrec parent = parent 862 862 + type nonrec ('a, 'b, 'c) parent_gen = ('a, 'b, 'c) RP.parent 749 863 750 864 let rec parent_module_type_identifier : 751 751 - Paths_types.Resolved_path.module_type -> Identifier.ModuleType.t option 752 752 - = function 753 753 - | `Identifier id -> Some (id : Identifier.ModuleType.t) 754 754 - | `ModuleType (m, n) -> ( 755 755 - match parent_module_identifier m with 756 756 - | None -> None 757 757 - | Some p -> Some (Identifier.Mk.module_type (p, n))) 865 865 + (na, na, na) RP.module_type -> Identifier.Signature.t = function 866 866 + | `Identifier id -> 867 867 + (id : Identifier.ModuleType.t :> Identifier.Signature.t) 868 868 + | `ModuleType (p, n) -> 869 869 + let m = get_parent_module p in 870 870 + Identifier.Mk.module_type (parent_module_identifier m, n) 758 871 | `SubstT (m, _n) -> parent_module_type_identifier m 759 872 | `CanonicalModuleType (_, `Resolved p) -> parent_module_type_identifier p 760 873 | `CanonicalModuleType (p, _) -> parent_module_type_identifier p ··· 764 877 if is_resolved_hidden ~weak_canonical_test:false (sub :> t) then 765 878 parent_module_type_identifier orig 766 879 else parent_module_type_identifier sub 880 880 + | `LocalModTy (`Na _) -> . 767 881 768 882 and parent_module_identifier : 769 769 - Paths_types.Resolved_path.module_ -> Identifier.Signature.t option = 770 770 - function 883 883 + (na, na, na) RP.module_ -> Identifier.Signature.t = function 771 884 | `Identifier id -> 772 772 - Some (id : Identifier.Path.Module.t :> Identifier.Signature.t) 773 773 - | `Subst (sub, _) -> 774 774 - (parent_module_type_identifier sub :> Identifier.Signature.t option) 775 775 - | `Hidden _ -> None 776 776 - | `Module (m, n) -> ( 777 777 - match parent_module_identifier m with 778 778 - | None -> None 779 779 - | Some p -> Some (Identifier.Mk.module_ (p, n))) 885 885 + (id : Identifier.Path.Module.t :> Identifier.Signature.t) 886 886 + | `Subst (sub, _) -> parent_module_type_identifier sub 887 887 + | `Hidden p -> parent_module_identifier p 888 888 + | `Module (p, n) -> 889 889 + let m = get_parent_module p in 890 890 + Identifier.Mk.module_ (parent_module_identifier m, n) 780 891 | `Canonical (_, `Resolved p) -> parent_module_identifier p 781 892 | `Canonical (p, _) -> parent_module_identifier p 782 893 | `Apply (m, _) -> parent_module_identifier m 783 783 - | `Alias (dest, `Resolved src) -> 894 894 + | `Alias (dest, `Resolved src, _) -> 784 895 if is_resolved_hidden ~weak_canonical_test:false (dest :> t) then 785 896 parent_module_identifier src 786 897 else parent_module_identifier dest 787 787 - | `Alias (dest, _src) -> parent_module_identifier dest 898 898 + | `Alias (dest, _src, _) -> parent_module_identifier dest 788 899 | `Substituted m -> parent_module_identifier m 789 900 | `OpaqueModule m -> parent_module_identifier m 901 901 + | `LocalMod (`Na _) -> . 790 902 791 903 module Module = struct 792 792 - type t = Paths_types.Resolved_path.module_ 904 904 + type ('lmod, 'lmodty, 'pty) gen = ('lmod, 'lmodty, 'pty) RP.module_ 905 905 + type t = (na, na, na) gen 793 906 794 794 - let is_hidden m = 795 795 - is_resolved_hidden (m : t :> Paths_types.Resolved_path.any) 907 907 + let is_hidden m = is_resolved_hidden (m : t :> rt) 796 908 end 797 909 798 910 module ModuleType = struct 799 799 - type t = Paths_types.Resolved_path.module_type 800 800 - 801 801 - let identifier : t -> Identifier.ModuleType.t option = 802 802 - parent_module_type_identifier 911 911 + type ('lmod, 'lmodty, 'pty) gen = ('lmod, 'lmodty, 'pty) RP.module_type 912 912 + type t = (na, na, na) gen 803 913 end 804 914 805 915 module Type = struct 806 806 - type t = Paths_types.Resolved_path.type_ 916 916 + type ('lmod, 'lmodty, 'pty, 'lty) gen = 917 917 + ('lmod, 'lmodty, 'pty, 'lty) RP.type_ 918 918 + type t = (na, na, na, na) gen 807 919 end 808 920 809 921 module Value = struct 810 810 - type t = Paths_types.Resolved_path.value 922 922 + type ('lmod, 'lmodty, 'pty, 'lval) gen = 923 923 + ('lmod, 'lmodty, 'pty, 'lval) RP.value 924 924 + type t = (na, na, na, na) gen 811 925 end 812 926 813 927 module ClassType = struct 814 814 - type t = Paths_types.Resolved_path.class_type 928 928 + type ('lmod, 'lmodty, 'pty, 'lty) gen = 929 929 + ('lmod, 'lmodty, 'pty, 'lty) RP.class_type 930 930 + type t = (na, na, na, na) gen 815 931 end 816 932 817 817 - let rec identifier : t -> Identifier.t option = 818 818 - let parent p f = 819 819 - match parent_module_identifier p with 820 820 - | None -> None 821 821 - | Some id -> Some (f id :> Identifier.t) 822 822 - in 823 823 - function 933 933 + let rec identifier : rt -> Identifier.t option = function 824 934 | `Identifier id -> Some id 935 935 + | `Subst (sub, _) -> identifier (sub :> rt) 936 936 + | `Hidden p -> identifier (p :> rt) 937 937 + | `Module (p, n) -> 938 938 + let m = get_parent_module p in 939 939 + Some (Identifier.Mk.module_ (parent_module_identifier m, n)) 940 940 + | `Canonical (_, `Resolved p) -> identifier (p :> rt) 941 941 + | `Canonical (p, _) -> identifier (p :> rt) 942 942 + | `Apply (m, _) -> identifier (m :> rt) 943 943 + | `Type (p, n) -> 944 944 + let m = get_parent_module p in 945 945 + Some (Identifier.Mk.type_ (parent_module_identifier m, n)) 946 946 + | `Value (p, n) -> 947 947 + let m = get_parent_module p in 948 948 + Some (Identifier.Mk.value (parent_module_identifier m, n)) 949 949 + | `ModuleType (p, n) -> 950 950 + let m = get_parent_module p in 951 951 + Some (Identifier.Mk.module_type (parent_module_identifier m, n)) 952 952 + | `Class (p, n) -> 953 953 + let m = get_parent_module p in 954 954 + Some (Identifier.Mk.class_ (parent_module_identifier m, n)) 955 955 + | `ClassType (p, n) -> 956 956 + let m = get_parent_module p in 957 957 + Some (Identifier.Mk.class_type (parent_module_identifier m, n)) 958 958 + | `Alias (dest, `Resolved src, _) -> 959 959 + if is_resolved_hidden ~weak_canonical_test:false (dest :> rt) then 960 960 + identifier (src :> rt) 961 961 + else identifier (dest :> rt) 962 962 + | `Alias (dest, _src, _) -> identifier (dest :> rt) 963 963 + | `AliasModuleType (sub, orig) -> 964 964 + if is_resolved_hidden ~weak_canonical_test:false (sub :> rt) then 965 965 + identifier (orig :> rt) 966 966 + else identifier (sub :> rt) 967 967 + | `SubstT (p, _) -> identifier (p :> rt) 968 968 + | `CanonicalModuleType (_, `Resolved p) -> identifier (p :> rt) 969 969 + | `CanonicalModuleType (p, _) -> identifier (p :> rt) 970 970 + | `CanonicalType (_, `Resolved p) -> identifier (p :> rt) 971 971 + | `CanonicalType (p, _) -> identifier (p :> rt) 972 972 + | `OpaqueModule m -> identifier (m :> rt) 973 973 + | `OpaqueModuleType mt -> identifier (mt :> rt) 974 974 + | `Substituted m -> identifier (m :> rt) 975 975 + | `SubstitutedMT m -> identifier (m :> rt) 976 976 + | `SubstitutedCT m -> identifier (m :> rt) 977 977 + | `SubstitutedT m -> identifier (m :> rt) 825 978 | `CoreType _ -> None 826 826 - | `Subst (sub, _) -> identifier (sub :> t) 827 827 - | `Hidden _p -> None 828 828 - | `Module (m, n) -> parent m (fun p -> Identifier.Mk.module_ (p, n)) 829 829 - | `Canonical (_, `Resolved p) -> identifier (p :> t) 830 830 - | `Canonical (p, _) -> identifier (p :> t) 831 831 - | `Apply (m, _) -> identifier (m :> t) 832 832 - | `Type (m, n) -> parent m (fun p -> Identifier.Mk.type_ (p, n)) 833 833 - | `Value (m, n) -> parent m (fun p -> Identifier.Mk.value (p, n)) 834 834 - | `ModuleType (m, n) -> 835 835 - parent m (fun p -> Identifier.Mk.module_type (p, n)) 836 836 - | `Class (m, n) -> parent m (fun p -> Identifier.Mk.class_ (p, n)) 837 837 - | `ClassType (m, n) -> parent m (fun p -> Identifier.Mk.class_type (p, n)) 838 838 - | `Alias (dest, `Resolved src) -> 839 839 - if is_resolved_hidden ~weak_canonical_test:false (dest :> t) then 840 840 - identifier (src :> t) 841 841 - else identifier (dest :> t) 842 842 - | `Alias (dest, _src) -> identifier (dest :> t) 843 843 - | `AliasModuleType (sub, orig) -> 844 844 - if is_resolved_hidden ~weak_canonical_test:false (sub :> t) then 845 845 - identifier (orig :> t) 846 846 - else identifier (sub :> t) 847 847 - | `SubstT (p, _) -> identifier (p :> t) 848 848 - | `CanonicalModuleType (_, `Resolved p) -> identifier (p :> t) 849 849 - | `CanonicalModuleType (p, _) -> identifier (p :> t) 850 850 - | `CanonicalType (_, `Resolved p) -> identifier (p :> t) 851 851 - | `CanonicalType (p, _) -> identifier (p :> t) 852 852 - | `OpaqueModule m -> identifier (m :> t) 853 853 - | `OpaqueModuleType mt -> identifier (mt :> t) 854 854 - | `Substituted m -> identifier (m :> t) 855 855 - | `SubstitutedMT m -> identifier (m :> t) 856 856 - | `SubstitutedCT m -> identifier (m :> t) 857 857 - | `SubstitutedT m -> identifier (m :> t) 979 979 + | `LocalMod (`Na _) -> . 980 980 + | `LocalModTy (`Na _) -> . 981 981 + | `LocalTy (`Na _) -> . 982 982 + | `LocalVal (`Na _) -> . 858 983 859 984 let is_hidden r = is_resolved_hidden ~weak_canonical_test:false r 860 985 end 861 986 862 987 module Module = struct 863 863 - type t = Paths_types.Path.module_ 988 988 + type ('lmod, 'lmodty, 'pty) gen = ('lmod, 'lmodty, 'pty) P.module_ 989 989 + type t = (na, na, na) gen 864 990 end 865 991 866 992 module ModuleType = struct 867 867 - type t = Paths_types.Path.module_type 993 993 + type ('lmod, 'lmodty, 'pty) gen = ('lmod, 'lmodty, 'pty) P.module_type 994 994 + type t = (na, na, na) gen 868 995 end 869 996 870 997 module Type = struct 871 871 - type t = Paths_types.Path.type_ 998 998 + type ('lmod, 'lmodty, 'pty, 'lty) gen = ('lmod, 'lmodty, 'pty, 'lty) P.type_ 999 999 + type t = (na, na, na, na) gen 872 1000 end 873 1001 874 1002 module Value = struct 875 875 - type t = Paths_types.Path.value 1003 1003 + type ('lmod, 'lmodty, 'pty, 'lval) gen = 1004 1004 + ('lmod, 'lmodty, 'pty, 'lval) P.value 1005 1005 + type t = (na, na, na, na) gen 876 1006 end 877 1007 878 1008 module ClassType = struct 879 879 - type t = Paths_types.Path.class_type 1009 1009 + type ('lmod, 'lmodty, 'pty, 'lty) gen = 1010 1010 + ('lmod, 'lmodty, 'pty, 'lty) P.class_type 1011 1011 + type t = (na, na, na, na) gen 880 1012 end 881 1013 882 1014 let is_hidden = is_path_hidden ··· 884 1016 885 1017 module Fragment = struct 886 1018 module Resolved = struct 887 887 - type t = Paths_types.Resolved_fragment.any 1019 1019 + type ('lmod, 'lmodty, 'pty) gen = 1020 1020 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.any 1021 1021 + type t = (na, na, na) gen 888 1022 889 889 - type root = Paths_types.Resolved_fragment.root 890 890 - 1023 1023 + type ('lmod, 'lmodty, 'pty) root_gen = 1024 1024 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.root 1025 1025 + type root = (na, na, na) root_gen 891 1026 module Signature = struct 892 892 - type t = Paths_types.Resolved_fragment.signature 893 893 - 894 894 - let rec sgidentifier : t -> Identifier.Signature.t option = function 895 895 - | `Root (`ModuleType i) -> 896 896 - (Path.Resolved.parent_module_type_identifier i 897 897 - :> Identifier.Signature.t option) 1027 1027 + type ('lmod, 'lmodty, 'pty) gen = 1028 1028 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.signature 1029 1029 + type t = (na, na, na) gen 1030 1030 + let rec sgidentifier : t -> Identifier.Signature.t = function 1031 1031 + | `Root (`ModuleType i) -> Path.Resolved.parent_module_type_identifier i 898 1032 | `Root (`Module i) -> Path.Resolved.parent_module_identifier i 899 899 - | `Subst (s, _) -> 900 900 - (Path.Resolved.parent_module_type_identifier s 901 901 - :> Identifier.Signature.t option) 1033 1033 + | `Subst (s, _) -> Path.Resolved.parent_module_type_identifier s 902 1034 | `Alias (i, _) -> Path.Resolved.parent_module_identifier i 903 903 - | `Module (m, n) -> ( 904 904 - match sgidentifier m with 905 905 - | None -> None 906 906 - | Some p -> Some (Identifier.Mk.module_ (p, n))) 1035 1035 + | `Module (m, n) -> Identifier.Mk.module_ (sgidentifier m, n) 907 1036 | `OpaqueModule m -> sgidentifier (m :> t) 908 1037 end 909 1038 910 1039 module Module = struct 911 911 - type t = Paths_types.Resolved_fragment.module_ 1040 1040 + type ('lmod, 'lmodty, 'pty) gen = 1041 1041 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.module_ 1042 1042 + type t = (na, na, na) gen 912 1043 end 913 1044 914 1045 module ModuleType = struct 915 915 - type t = Paths_types.Resolved_fragment.module_type 1046 1046 + type ('lmod, 'lmodty, 'pty) gen = 1047 1047 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.module_type 1048 1048 + type t = (na, na, na) gen 916 1049 end 917 1050 918 1051 module Type = struct 919 919 - type t = Paths_types.Resolved_fragment.type_ 1052 1052 + type ('lmod, 'lmodty, 'pty) gen = 1053 1053 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.type_ 1054 1054 + type t = (na, na, na) gen 920 1055 end 921 1056 922 922 - type leaf = Paths_types.Resolved_fragment.leaf 1057 1057 + type ('lmod, 'lmodty, 'pty) leaf_gen = 1058 1058 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.leaf 1059 1059 + type leaf = (na, na, na) leaf_gen 923 1060 924 924 - let rec identifier : t -> Identifier.t option = function 1061 1061 + let rec identifier : t -> Identifier.t = function 925 1062 | `Root (`ModuleType _r) -> assert false 926 1063 | `Root (`Module _r) -> assert false 927 927 - | `Subst (s, _) -> 928 928 - (Path.Resolved.ModuleType.identifier s :> Identifier.t option) 1064 1064 + | `Subst (s, _) -> Option.get (Path.Resolved.identifier (s :> Path.Resolved.t)) 929 1065 | `Alias (p, _) -> 930 930 - (Path.Resolved.parent_module_identifier p :> Identifier.t option) 931 931 - | `Module (m, n) -> ( 932 932 - match Signature.sgidentifier m with 933 933 - | None -> None 934 934 - | Some p -> Some (Identifier.Mk.module_ (p, n))) 935 935 - | `Module_type (m, n) -> ( 936 936 - match Signature.sgidentifier m with 937 937 - | None -> None 938 938 - | Some p -> Some (Identifier.Mk.module_type (p, n))) 939 939 - | `Type (m, n) -> ( 940 940 - match Signature.sgidentifier m with 941 941 - | None -> None 942 942 - | Some p -> Some (Identifier.Mk.type_ (p, n))) 943 943 - | `Class (m, n) -> ( 944 944 - match Signature.sgidentifier m with 945 945 - | None -> None 946 946 - | Some p -> Some (Identifier.Mk.class_ (p, n))) 947 947 - | `ClassType (m, n) -> ( 948 948 - match Signature.sgidentifier m with 949 949 - | None -> None 950 950 - | Some p -> Some (Identifier.Mk.class_type (p, n))) 1066 1066 + (Path.Resolved.parent_module_identifier p :> Identifier.t) 1067 1067 + | `Module (m, n) -> Identifier.Mk.module_ (Signature.sgidentifier m, n) 1068 1068 + | `Module_type (m, n) -> 1069 1069 + Identifier.Mk.module_type (Signature.sgidentifier m, n) 1070 1070 + | `Type (m, n) -> Identifier.Mk.type_ (Signature.sgidentifier m, n) 1071 1071 + | `Class (m, n) -> Identifier.Mk.class_ (Signature.sgidentifier m, n) 1072 1072 + | `ClassType (m, n) -> 1073 1073 + Identifier.Mk.class_type (Signature.sgidentifier m, n) 951 1074 | `OpaqueModule m -> identifier (m :> t) 952 1075 953 1076 let rec is_hidden : t -> bool = function ··· 964 1087 | `OpaqueModule m -> is_hidden (m :> t) 965 1088 end 966 1089 967 967 - type t = Paths_types.Fragment.any 1090 1090 + type ('lmod, 'lmodty, 'pty) gen = 1091 1091 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.any 1092 1092 + type t = (na, na, na) gen 968 1093 969 1094 module Signature = struct 970 970 - type t = Paths_types.Fragment.signature 1095 1095 + type ('lmod, 'lmodty, 'pty) gen = 1096 1096 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.signature 1097 1097 + type t = (na, na, na) gen 971 1098 end 972 1099 973 1100 module Module = struct 974 974 - type t = Paths_types.Fragment.module_ 1101 1101 + type ('lmod, 'lmodty, 'pty) gen = 1102 1102 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.module_ 1103 1103 + type t = (na, na, na) gen 975 1104 end 976 1105 977 1106 module ModuleType = struct 978 978 - type t = Paths_types.Fragment.module_type 1107 1107 + type ('lmod, 'lmodty, 'pty) gen = 1108 1108 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.module_type 1109 1109 + type t = (na, na, na) gen 979 1110 end 980 1111 981 1112 module Type = struct 982 982 - type t = Paths_types.Fragment.type_ 1113 1113 + type ('lmod, 'lmodty, 'pty) gen = 1114 1114 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.type_ 1115 1115 + type t = (na, na, na) gen 983 1116 end 984 1117 985 985 - type leaf = Paths_types.Fragment.leaf 1118 1118 + type ('lmod, 'lmodty, 'pty) leaf_gen = 1119 1119 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.leaf 1120 1120 + type leaf = (na, na, na) leaf_gen 986 1121 end 987 1122 988 1123 module Reference = struct 989 1124 module Resolved = struct 990 1125 open Paths_types.Resolved_reference 991 1126 992 992 - type t = Paths_types.Resolved_reference.any 1127 1127 + type ('lmod, 'lmodty, 'pty) gen = 1128 1128 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.any 1129 1129 + type t = (na, na, na) gen 993 1130 994 1131 let rec parent_signature_identifier : 995 995 - signature -> Identifier.Signature.t option = function 996 996 - | `Identifier id -> Some id 997 997 - | `Hidden _s -> None 1132 1132 + (na, na, na) signature -> Identifier.Signature.t = function 1133 1133 + | `Identifier id -> id 1134 1134 + | `Hidden s -> parent_signature_identifier (s :> (na, na, na) signature) 998 1135 | `Alias (sub, orig) -> 999 1136 if Path.Resolved.(is_hidden (sub :> t)) then 1000 1000 - parent_signature_identifier (orig :> signature) 1137 1137 + parent_signature_identifier (orig :> (na, na, na) signature) 1001 1138 else 1002 1139 (Path.Resolved.parent_module_identifier sub 1003 1003 - :> Identifier.Signature.t option) 1140 1140 + :> Identifier.Signature.t) 1004 1141 | `AliasModuleType (sub, orig) -> 1005 1142 if Path.Resolved.(is_hidden (sub :> t)) then 1006 1006 - parent_signature_identifier (orig :> signature) 1143 1143 + parent_signature_identifier (orig :> (na, na, na) signature) 1007 1144 else 1008 1145 (Path.Resolved.parent_module_type_identifier sub 1009 1009 - :> Identifier.Signature.t option) 1010 1010 - | `Module (m, n) -> ( 1011 1011 - match parent_signature_identifier m with 1012 1012 - | None -> None 1013 1013 - | Some p -> Some (Identifier.Mk.module_ (p, n))) 1014 1014 - | `ModuleType (m, n) -> ( 1015 1015 - match parent_signature_identifier m with 1016 1016 - | None -> None 1017 1017 - | Some p -> Some (Identifier.Mk.module_type (p, n))) 1146 1146 + :> Identifier.Signature.t) 1147 1147 + | `Module (m, n) -> 1148 1148 + Identifier.Mk.module_ (parent_signature_identifier m, n) 1149 1149 + | `ModuleType (m, s) -> 1150 1150 + Identifier.Mk.module_type (parent_signature_identifier m, s) 1018 1151 1019 1019 - and parent_type_identifier : datatype -> Identifier.DataType.t option = 1020 1020 - function 1021 1021 - | `Identifier id -> Some id 1022 1022 - | `Type (sg, s) -> ( 1023 1023 - match parent_signature_identifier sg with 1024 1024 - | None -> None 1025 1025 - | Some p -> Some (Identifier.Mk.type_ (p, s))) 1152 1152 + and parent_type_identifier : (na, na, na) datatype -> Identifier.DataType.t 1153 1153 + = function 1154 1154 + | `Identifier id -> id 1155 1155 + | `Type (sg, s) -> Identifier.Mk.type_ (parent_signature_identifier sg, s) 1026 1156 1027 1157 and parent_class_signature_identifier : 1028 1028 - class_signature -> Identifier.ClassSignature.t option = function 1029 1029 - | `Identifier id -> Some id 1030 1030 - | `Class (sg, s) -> ( 1031 1031 - match parent_signature_identifier sg with 1032 1032 - | None -> None 1033 1033 - | Some p -> Some (Identifier.Mk.class_ (p, s))) 1034 1034 - | `ClassType (sg, s) -> ( 1035 1035 - match parent_signature_identifier sg with 1036 1036 - | None -> None 1037 1037 - | Some p -> Some (Identifier.Mk.class_type (p, s))) 1158 1158 + (na, na, na) class_signature -> Identifier.ClassSignature.t = function 1159 1159 + | `Identifier id -> id 1160 1160 + | `Class (sg, s) -> 1161 1161 + Identifier.Mk.class_ (parent_signature_identifier sg, s) 1162 1162 + | `ClassType (sg, s) -> 1163 1163 + Identifier.Mk.class_type (parent_signature_identifier sg, s) 1038 1164 1039 1165 and field_parent_identifier : 1040 1040 - field_parent -> Identifier.FieldParent.t option = function 1041 1041 - | `Identifier id -> Some id 1166 1166 + (na, na, na) field_parent -> Identifier.FieldParent.t = function 1167 1167 + | `Identifier id -> id 1042 1168 | (`Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `ModuleType _) 1043 1169 as sg -> 1044 1044 - (parent_signature_identifier sg :> Identifier.FieldParent.t option) 1045 1045 - | `Type _ as t -> 1046 1046 - (parent_type_identifier t :> Identifier.FieldParent.t option) 1170 1170 + (parent_signature_identifier sg :> Identifier.FieldParent.t) 1171 1171 + | `Type _ as t -> (parent_type_identifier t :> Identifier.FieldParent.t) 1047 1172 1048 1048 - and unboxed_field_parent_identifier : unboxed_field_parent -> Identifier.UnboxedFieldParent.t option = 1173 1173 + and unboxed_field_parent_identifier : (na, na, na) unboxed_field_parent -> Identifier.UnboxedFieldParent.t option = 1049 1174 function 1050 1175 | `Identifier id -> Some id 1051 1051 - | `Type _ as t -> (parent_type_identifier t :> Identifier.UnboxedFieldParent.t option) 1176 1176 + | `Type _ as t -> Some (parent_type_identifier t :> Identifier.UnboxedFieldParent.t) 1052 1177 1053 1178 and label_parent_identifier : 1054 1054 - label_parent -> Identifier.LabelParent.t option = function 1055 1055 - | `Identifier id -> Some id 1179 1179 + (na, na, na) label_parent -> Identifier.LabelParent.t = function 1180 1180 + | `Identifier id -> id 1056 1181 | (`Class _ | `ClassType _) as c -> 1057 1057 - (parent_class_signature_identifier c 1058 1058 - :> Identifier.LabelParent.t option) 1182 1182 + (parent_class_signature_identifier c :> Identifier.LabelParent.t) 1059 1183 | ( `Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `ModuleType _ 1060 1184 | `Type _ ) as r -> 1061 1061 - (field_parent_identifier r :> Identifier.LabelParent.t option) 1185 1185 + (field_parent_identifier r :> Identifier.LabelParent.t) 1062 1186 1063 1187 and identifier : t -> Identifier.t option = function 1064 1188 | `Identifier id -> Some id ··· 1068 1192 | Some p -> Some (Identifier.Mk.unboxed_field (p, n))) 1069 1193 | ( `Alias _ | `AliasModuleType _ | `Module _ | `Hidden _ | `Type _ 1070 1194 | `Class _ | `ClassType _ | `ModuleType _ ) as r -> 1071 1071 - (label_parent_identifier r :> Identifier.t option) 1072 1072 - | `Field (p, n) -> ( 1073 1073 - match field_parent_identifier p with 1074 1074 - | None -> None 1075 1075 - | Some p -> Some (Identifier.Mk.field (p, n))) 1076 1076 - | `PolyConstructor (s, n) -> ( 1077 1077 - (* Uses an identifier for constructor even though it is not 1078 1078 - one. Document must make the links correspond. *) 1079 1079 - match parent_type_identifier s with 1080 1080 - | None -> None 1081 1081 - | Some p -> Some (Identifier.Mk.constructor (p, n))) 1082 1082 - | `Constructor (s, n) -> ( 1083 1083 - match parent_type_identifier s with 1084 1084 - | None -> None 1085 1085 - | Some p -> Some (Identifier.Mk.constructor (p, n))) 1086 1086 - | `Extension (p, q) -> ( 1087 1087 - match parent_signature_identifier p with 1088 1088 - | None -> None 1089 1089 - | Some p -> Some (Identifier.Mk.extension (p, q))) 1090 1090 - | `ExtensionDecl (p, q, r) -> ( 1091 1091 - match parent_signature_identifier p with 1092 1092 - | None -> None 1093 1093 - | Some p -> Some (Identifier.Mk.extension_decl (p, (q, r)))) 1094 1094 - | `Exception (p, q) -> ( 1095 1095 - match parent_signature_identifier p with 1096 1096 - | None -> None 1097 1097 - | Some p -> Some (Identifier.Mk.exception_ (p, q))) 1098 1098 - | `Value (p, q) -> ( 1099 1099 - match parent_signature_identifier p with 1100 1100 - | None -> None 1101 1101 - | Some p -> Some (Identifier.Mk.value (p, q))) 1102 1102 - | `Method (p, q) -> ( 1103 1103 - match parent_class_signature_identifier p with 1104 1104 - | None -> None 1105 1105 - | Some p -> Some (Identifier.Mk.method_ (p, q))) 1106 1106 - | `InstanceVariable (p, q) -> ( 1107 1107 - match parent_class_signature_identifier p with 1108 1108 - | None -> None 1109 1109 - | Some p -> Some (Identifier.Mk.instance_variable (p, q))) 1110 1110 - | `Label (p, q) -> ( 1111 1111 - match label_parent_identifier p with 1112 1112 - | None -> None 1113 1113 - | Some p -> Some (Identifier.Mk.label (p, q))) 1195 1195 + Some (label_parent_identifier r :> Identifier.t) 1196 1196 + | `Field (p, n) -> Some (Identifier.Mk.field (field_parent_identifier p, n)) 1197 1197 + | `PolyConstructor (s, n) -> 1198 1198 + Some (Identifier.Mk.constructor 1199 1199 + ((parent_type_identifier s :> Identifier.DataType.t), n)) 1200 1200 + | `Constructor (s, n) -> 1201 1201 + Some (Identifier.Mk.constructor 1202 1202 + ((parent_type_identifier s :> Identifier.DataType.t), n)) 1203 1203 + | `Extension (p, q) -> 1204 1204 + Some (Identifier.Mk.extension (parent_signature_identifier p, q)) 1205 1205 + | `ExtensionDecl (p, q, r) -> 1206 1206 + Some (Identifier.Mk.extension_decl (parent_signature_identifier p, (q, r))) 1207 1207 + | `Exception (p, q) -> 1208 1208 + Some (Identifier.Mk.exception_ (parent_signature_identifier p, q)) 1209 1209 + | `Value (p, q) -> Some (Identifier.Mk.value (parent_signature_identifier p, q)) 1210 1210 + | `Method (p, q) -> 1211 1211 + Some (Identifier.Mk.method_ (parent_class_signature_identifier p, q)) 1212 1212 + | `InstanceVariable (p, q) -> 1213 1213 + Some (Identifier.Mk.instance_variable 1214 1214 + (parent_class_signature_identifier p, q)) 1215 1215 + | `Label (p, q) -> Some (Identifier.Mk.label (label_parent_identifier p, q)) 1114 1216 1115 1217 module Signature = struct 1116 1116 - type t = Paths_types.Resolved_reference.signature 1218 1218 + type ('lmod, 'lmodty, 'pty) gen = 1219 1219 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.signature 1220 1220 + type t = (na, na, na) gen 1117 1221 end 1118 1222 1119 1223 module ClassSignature = struct 1120 1120 - type t = Paths_types.Resolved_reference.class_signature 1224 1224 + type ('lmod, 'lmodty, 'pty) gen = 1225 1225 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.class_signature 1226 1226 + type t = (na, na, na) gen 1121 1227 end 1122 1228 1123 1229 module DataType = struct 1124 1124 - type t = Paths_types.Resolved_reference.datatype 1230 1230 + type ('lmod, 'lmodty, 'pty) gen = 1231 1231 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.datatype 1232 1232 + type t = (na, na, na) gen 1125 1233 end 1126 1234 1127 1235 module FieldParent = struct 1128 1128 - type t = Paths_types.Resolved_reference.field_parent 1236 1236 + type ('lmod, 'lmodty, 'pty) gen = 1237 1237 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.field_parent 1238 1238 + type t = (na, na, na) gen 1129 1239 end 1130 1240 1131 1241 module UnboxedFieldParent = struct 1132 1132 - type t = Paths_types.Resolved_reference.unboxed_field_parent 1242 1242 + type ('lmod, 'lmodty, 'pty) gen = 1243 1243 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.unboxed_field_parent 1244 1244 + type t = (na, na, na) gen 1133 1245 end 1134 1246 1135 1247 module LabelParent = struct 1136 1136 - type t = Paths_types.Resolved_reference.label_parent 1248 1248 + type ('lmod, 'lmodty, 'pty) gen = 1249 1249 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.label_parent 1250 1250 + type t = (na, na, na) gen 1137 1251 end 1138 1252 1139 1253 module Module = struct 1140 1140 - type t = Paths_types.Resolved_reference.module_ 1254 1254 + type ('lmod, 'lmodty, 'pty) gen = 1255 1255 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.module_ 1256 1256 + type t = (na, na, na) gen 1141 1257 end 1142 1258 1143 1259 module ModuleType = struct 1144 1144 - type t = Paths_types.Resolved_reference.module_type 1260 1260 + type ('lmod, 'lmodty, 'pty) gen = 1261 1261 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.module_type 1262 1262 + type t = (na, na, na) gen 1145 1263 end 1146 1264 1147 1265 module Type = struct 1148 1148 - type t = Paths_types.Resolved_reference.type_ 1266 1266 + type ('lmod, 'lmodty, 'pty) gen = 1267 1267 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.type_ 1268 1268 + type t = (na, na, na) gen 1149 1269 end 1150 1270 1151 1271 module Constructor = struct 1152 1152 - type t = Paths_types.Resolved_reference.constructor 1272 1272 + type ('lmod, 'lmodty, 'pty) gen = 1273 1273 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.constructor 1274 1274 + type t = (na, na, na) gen 1153 1275 end 1154 1276 1155 1277 module Field = struct 1156 1156 - type t = Paths_types.Resolved_reference.field 1278 1278 + type ('lmod, 'lmodty, 'pty) gen = 1279 1279 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.field 1280 1280 + type t = (na, na, na) gen 1157 1281 end 1158 1282 1159 1283 module UnboxedField = struct 1160 1160 - type t = Paths_types.Resolved_reference.unboxed_field 1284 1284 + type ('lmod, 'lmodty, 'pty) gen = 1285 1285 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.unboxed_field 1286 1286 + type t = (na, na, na) gen 1161 1287 end 1162 1288 1163 1289 module Extension = struct 1164 1164 - type t = Paths_types.Resolved_reference.extension 1290 1290 + type ('lmod, 'lmodty, 'pty) gen = 1291 1291 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.extension 1292 1292 + type t = (na, na, na) gen 1165 1293 end 1166 1294 1167 1295 module ExtensionDecl = struct 1168 1168 - type t = Paths_types.Resolved_reference.extension_decl 1296 1296 + type ('lmod, 'lmodty, 'pty) gen = 1297 1297 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.extension_decl 1298 1298 + type t = (na, na, na) gen 1169 1299 end 1170 1300 1171 1301 module Exception = struct 1172 1172 - type t = Paths_types.Resolved_reference.exception_ 1302 1302 + type ('lmod, 'lmodty, 'pty) gen = 1303 1303 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.exception_ 1304 1304 + type t = (na, na, na) gen 1173 1305 end 1174 1306 1175 1307 module Value = struct 1176 1176 - type t = Paths_types.Resolved_reference.value 1308 1308 + type ('lmod, 'lmodty, 'pty) gen = 1309 1309 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.value 1310 1310 + type t = (na, na, na) gen 1177 1311 end 1178 1312 1179 1313 module Class = struct 1180 1180 - type t = Paths_types.Resolved_reference.class_ 1314 1314 + type ('lmod, 'lmodty, 'pty) gen = 1315 1315 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.class_ 1316 1316 + type t = (na, na, na) gen 1181 1317 end 1182 1318 1183 1319 module ClassType = struct 1184 1184 - type t = Paths_types.Resolved_reference.class_type 1320 1320 + type ('lmod, 'lmodty, 'pty) gen = 1321 1321 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.class_type 1322 1322 + type t = (na, na, na) gen 1185 1323 end 1186 1324 1187 1325 module Method = struct 1188 1188 - type t = Paths_types.Resolved_reference.method_ 1326 1326 + type ('lmod, 'lmodty, 'pty) gen = 1327 1327 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.method_ 1328 1328 + type t = (na, na, na) gen 1189 1329 end 1190 1330 1191 1331 module InstanceVariable = struct 1192 1192 - type t = Paths_types.Resolved_reference.instance_variable 1332 1332 + type ('lmod, 'lmodty, 'pty) gen = 1333 1333 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.instance_variable 1334 1334 + type t = (na, na, na) gen 1193 1335 end 1194 1336 1195 1337 module Label = struct 1196 1196 - type t = Paths_types.Resolved_reference.label 1338 1338 + type ('lmod, 'lmodty, 'pty) gen = 1339 1339 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.label 1340 1340 + type t = (na, na, na) gen 1197 1341 end 1198 1342 1199 1343 module Page = struct ··· 1207 1351 end 1208 1352 end 1209 1353 1210 1210 - type t = Paths_types.Reference.any 1354 1354 + type ('lmod, 'lmodty, 'pty) gen = 1355 1355 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.any 1356 1356 + type t = (na, na, na) gen 1211 1357 1212 1358 type tag_any = Paths_types.Reference.tag_any 1213 1359 type tag_hierarchy = Paths_types.Reference.tag_hierarchy 1214 1360 1215 1361 module Signature = struct 1216 1216 - type t = Paths_types.Reference.signature 1362 1362 + type ('lmod, 'lmodty, 'pty) gen = 1363 1363 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.signature 1364 1364 + type t = (na, na, na) gen 1217 1365 end 1218 1366 1219 1367 module ClassSignature = struct 1220 1220 - type t = Paths_types.Reference.class_signature 1368 1368 + type ('lmod, 'lmodty, 'pty) gen = 1369 1369 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.class_signature 1370 1370 + type t = (na, na, na) gen 1221 1371 end 1222 1372 1223 1373 module DataType = struct 1224 1224 - type t = Paths_types.Reference.datatype 1374 1374 + type ('lmod, 'lmodty, 'pty) gen = 1375 1375 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.datatype 1376 1376 + type t = (na, na, na) gen 1225 1377 end 1226 1378 1227 1379 module FragmentTypeParent = struct 1228 1228 - type t = Paths_types.Reference.fragment_type_parent 1380 1380 + type ('lmod, 'lmodty, 'pty) gen = 1381 1381 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.fragment_type_parent 1382 1382 + type t = (na, na, na) gen 1229 1383 end 1230 1384 1231 1385 module LabelParent = struct 1232 1232 - type t = Paths_types.Reference.label_parent 1386 1386 + type ('lmod, 'lmodty, 'pty) gen = 1387 1387 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.label_parent 1388 1388 + type t = (na, na, na) gen 1233 1389 end 1234 1390 1235 1391 module Module = struct 1236 1236 - type t = Paths_types.Reference.module_ 1392 1392 + type ('lmod, 'lmodty, 'pty) gen = 1393 1393 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.module_ 1394 1394 + type t = (na, na, na) gen 1237 1395 end 1238 1396 1239 1397 module ModuleType = struct 1240 1240 - type t = Paths_types.Reference.module_type 1398 1398 + type ('lmod, 'lmodty, 'pty) gen = 1399 1399 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.module_type 1400 1400 + type t = (na, na, na) gen 1241 1401 end 1242 1402 1243 1403 module Type = struct 1244 1244 - type t = Paths_types.Reference.type_ 1404 1404 + type ('lmod, 'lmodty, 'pty) gen = 1405 1405 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.type_ 1406 1406 + type t = (na, na, na) gen 1245 1407 end 1246 1408 1247 1409 module Constructor = struct 1248 1248 - type t = Paths_types.Reference.constructor 1410 1410 + type ('lmod, 'lmodty, 'pty) gen = 1411 1411 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.constructor 1412 1412 + type t = (na, na, na) gen 1249 1413 end 1250 1414 1251 1415 module Field = struct 1252 1252 - type t = Paths_types.Reference.field 1416 1416 + type ('lmod, 'lmodty, 'pty) gen = 1417 1417 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.field 1418 1418 + type t = (na, na, na) gen 1253 1419 end 1254 1420 1255 1421 module UnboxedField = struct 1256 1256 - type t = Paths_types.Reference.unboxed_field 1422 1422 + type ('lmod, 'lmodty, 'pty) gen = 1423 1423 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.unboxed_field 1424 1424 + type t = (na, na, na) gen 1257 1425 end 1258 1426 1259 1427 module Extension = struct 1260 1260 - type t = Paths_types.Reference.extension 1428 1428 + type ('lmod, 'lmodty, 'pty) gen = 1429 1429 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.extension 1430 1430 + type t = (na, na, na) gen 1261 1431 end 1262 1432 1263 1433 module ExtensionDecl = struct 1264 1264 - type t = Paths_types.Reference.extension_decl 1434 1434 + type ('lmod, 'lmodty, 'pty) gen = 1435 1435 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.extension_decl 1436 1436 + type t = (na, na, na) gen 1265 1437 end 1266 1438 1267 1439 module Exception = struct 1268 1268 - type t = Paths_types.Reference.exception_ 1440 1440 + type ('lmod, 'lmodty, 'pty) gen = 1441 1441 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.exception_ 1442 1442 + type t = (na, na, na) gen 1269 1443 end 1270 1444 1271 1445 module Value = struct 1272 1272 - type t = Paths_types.Reference.value 1446 1446 + type ('lmod, 'lmodty, 'pty) gen = 1447 1447 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.value 1448 1448 + type t = (na, na, na) gen 1273 1449 end 1274 1450 1275 1451 module Class = struct 1276 1276 - type t = Paths_types.Reference.class_ 1452 1452 + type ('lmod, 'lmodty, 'pty) gen = 1453 1453 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.class_ 1454 1454 + type t = (na, na, na) gen 1277 1455 end 1278 1456 1279 1457 module ClassType = struct 1280 1280 - type t = Paths_types.Reference.class_type 1458 1458 + type ('lmod, 'lmodty, 'pty) gen = 1459 1459 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.class_type 1460 1460 + type t = (na, na, na) gen 1281 1461 end 1282 1462 1283 1463 module Method = struct 1284 1284 - type t = Paths_types.Reference.method_ 1464 1464 + type ('lmod, 'lmodty, 'pty) gen = 1465 1465 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.method_ 1466 1466 + type t = (na, na, na) gen 1285 1467 end 1286 1468 1287 1469 module InstanceVariable = struct 1288 1288 - type t = Paths_types.Reference.instance_variable 1470 1470 + type ('lmod, 'lmodty, 'pty) gen = 1471 1471 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.instance_variable 1472 1472 + type t = (na, na, na) gen 1289 1473 end 1290 1474 1291 1475 module Label = struct 1292 1292 - type t = Paths_types.Reference.label 1476 1476 + type ('lmod, 'lmodty, 'pty) gen = 1477 1477 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.label 1478 1478 + type t = (na, na, na) gen 1293 1479 end 1294 1480 1295 1481 module Page = struct 1296 1296 - type t = Paths_types.Reference.page 1482 1482 + type ('lmod, 'lmodty, 'pty) gen = 1483 1483 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.page 1484 1484 + type t = (na, na, na) gen 1297 1485 end 1298 1486 1299 1487 module Asset = struct

+237 -70

odoc/src/model/paths.mli

reviewed

··· 17 17 module Ocaml_ident = Ident 18 18 module Ocaml_env = Env 19 19 20 20 + type na_ty = | 21 21 + type na = [ `Na of na_ty ] 22 22 + 20 23 (** Identifiers for definitions *) 21 24 22 25 module Identifier : sig ··· 368 371 369 372 (** Normal OCaml paths (i.e. the ones present in types) *) 370 373 module rec Path : sig 374 374 + type ('lmod, 'lmodty, 'pty, 'a) genfn3 = { 375 375 + lmod : 'lmod -> 'a; 376 376 + lmodty : 'lmodty -> 'a; 377 377 + pty : 'pty -> 'a; 378 378 + } 379 379 + 380 380 + type ('lmod, 'lmodty, 'pty, 'lty, 'lval, 'a) genfn5 = { 381 381 + g : ('lmod, 'lmodty, 'pty, 'a) genfn3; 382 382 + lty : 'lty -> 'a; 383 383 + lval : 'lval -> 'a; 384 384 + } 385 385 + 386 386 + val is_resolved_hidden_gen : 387 387 + weak_canonical_test:bool -> 388 388 + ('lmod, 'lmodty, 'pty, 'lty, 'lval, bool) genfn5 -> 389 389 + ('lmod, 'lmodty, 'pty, 'lty, 'lval) Paths_types.Resolved_path.any -> 390 390 + bool 391 391 + 392 392 + val is_hidden_gen : 393 393 + ('lmod, 'lmodty, 'pty, 'lty, 'lval, bool) genfn5 -> 394 394 + ('lmod, 'lmodty, 'pty, 'lty, 'lval) Paths_types.Path.any -> 395 395 + bool 396 396 + 371 397 module Resolved : sig 372 398 module Module : sig 373 373 - type t = Paths_types.Resolved_path.module_ 399 399 + type ('lmod, 'lmodty, 'pty) gen = 400 400 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_path.module_ 401 401 + type t = (na, na, na) gen 374 402 375 403 val is_hidden : t -> weak_canonical_test:bool -> bool 376 404 ··· 380 408 end 381 409 382 410 module ModuleType : sig 383 383 - type t = Paths_types.Resolved_path.module_type 411 411 + type ('lmod, 'lmodty, 'pty) gen = 412 412 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_path.module_type 413 413 + type t = (na, na, na) gen 384 414 385 415 (* val is_hidden : t -> weak_canonical_test:bool -> bool *) 386 416 ··· 388 418 end 389 419 390 420 module Type : sig 391 391 - type t = Paths_types.Resolved_path.type_ 421 421 + type ('lmod, 'lmodty, 'pty, 'lty) gen = 422 422 + ('lmod, 'lmodty, 'pty, 'lty) Paths_types.Resolved_path.type_ 423 423 + type t = (na, na, na, na) gen 392 424 393 425 (* val of_ident : Identifier.Path.Type.t -> t *) 394 426 ··· 398 430 end 399 431 400 432 module Value : sig 401 401 - type t = Paths_types.Resolved_path.value 433 433 + type ('lmod, 'lmodty, 'pty, 'lval) gen = 434 434 + ('lmod, 'lmodty, 'pty, 'lval) Paths_types.Resolved_path.value 435 435 + type t = (na, na, na, na) gen 402 436 end 403 437 404 438 module ClassType : sig 405 405 - type t = Paths_types.Resolved_path.class_type 439 439 + type ('lmod, 'lmodty, 'pty, 'lty) gen = 440 440 + ('lmod, 'lmodty, 'pty, 'lty) Paths_types.Resolved_path.class_type 441 441 + type t = (na, na, na, na) gen 406 442 407 443 (* val of_ident : Identifier.Path.ClassType.t -> t *) 408 444 409 445 (* val is_hidden : t -> bool *) 410 446 end 411 447 412 412 - type t = Paths_types.Resolved_path.any 448 448 + type ('lmod, 'lmodty, 'pty, 'lty, 'lval) gen = 449 449 + ('lmod, 'lmodty, 'pty, 'lty, 'lval) Paths_types.Resolved_path.any 450 450 + type t = (na, na, na, na, na) gen 451 451 + type parent = (na, na, na) Paths_types.Resolved_path.parent 452 452 + type ('lmod, 'lmodty, 'pty) parent_gen = 453 453 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_path.parent 413 454 414 455 val identifier : t -> Identifier.t option 415 456 (** If the path points to a core type, no identifier can be generated *) ··· 418 459 end 419 460 420 461 module Module : sig 421 421 - type t = Paths_types.Path.module_ 462 462 + type ('lmod, 'lmodty, 'pty) gen = 463 463 + ('lmod, 'lmodty, 'pty) Paths_types.Path.module_ 464 464 + type t = (na, na, na) gen 422 465 423 466 (* val root : t -> string option *) 424 467 end 425 468 426 469 module ModuleType : sig 427 427 - type t = Paths_types.Path.module_type 470 470 + type ('lmod, 'lmodty, 'pty) gen = 471 471 + ('lmod, 'lmodty, 'pty) Paths_types.Path.module_type 472 472 + type t = (na, na, na) gen 428 473 end 429 474 430 475 module Type : sig 431 431 - type t = Paths_types.Path.type_ 476 476 + type ('lmod, 'lmodty, 'pty, 'lty) gen = 477 477 + ('lmod, 'lmodty, 'pty, 'lty) Paths_types.Path.type_ 478 478 + type t = (na, na, na, na) gen 432 479 end 433 480 434 481 module Value : sig 435 435 - type t = Paths_types.Path.value 482 482 + type ('lmod, 'lmodty, 'pty, 'lval) gen = 483 483 + ('lmod, 'lmodty, 'pty, 'lval) Paths_types.Path.value 484 484 + type t = (na, na, na, na) gen 436 485 end 437 486 438 487 module ClassType : sig 439 439 - type t = Paths_types.Path.class_type 488 488 + type ('lmod, 'lmodty, 'pty, 'lty) gen = 489 489 + ('lmod, 'lmodty, 'pty, 'lty) Paths_types.Path.class_type 490 490 + type t = (na, na, na, na) gen 440 491 end 441 492 442 442 - type t = Paths_types.Path.any 493 493 + type ('lmod, 'lmodty, 'pty, 'lty, 'lval) gen = 494 494 + ('lmod, 'lmodty, 'pty, 'lty, 'lval) Paths_types.Path.any 495 495 + type t = (na, na, na, na, na) gen 443 496 444 497 val is_hidden : t -> bool 445 498 end ··· 448 501 module Fragment : sig 449 502 module Resolved : sig 450 503 module Signature : sig 451 451 - type t = Paths_types.Resolved_fragment.signature 504 504 + type ('lmod, 'lmodty, 'pty) gen = 505 505 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.signature 506 506 + type t = (na, na, na) gen 452 507 end 453 508 454 509 module Module : sig 455 455 - type t = Paths_types.Resolved_fragment.module_ 510 510 + type ('lmod, 'lmodty, 'pty) gen = 511 511 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.module_ 512 512 + type t = (na, na, na) gen 456 513 end 457 514 458 515 module ModuleType : sig 459 459 - type t = Paths_types.Resolved_fragment.module_type 516 516 + type ('lmod, 'lmodty, 'pty) gen = 517 517 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.module_type 518 518 + type t = (na, na, na) gen 460 519 end 461 520 462 521 module Type : sig 463 463 - type t = Paths_types.Resolved_fragment.type_ 522 522 + type ('lmod, 'lmodty, 'pty) gen = 523 523 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.type_ 524 524 + type t = (na, na, na) gen 464 525 end 465 526 466 466 - type leaf = Paths_types.Resolved_fragment.leaf 527 527 + type ('lmod, 'lmodty, 'pty) leaf_gen = 528 528 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.leaf 529 529 + type leaf = (na, na, na) leaf_gen 467 530 468 468 - type root = Paths_types.Resolved_fragment.root 531 531 + type ('lmod, 'lmodty, 'pty) root_gen = 532 532 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.root 533 533 + type root = (na, na, na) root_gen 469 534 470 470 - type t = Paths_types.Resolved_fragment.any 535 535 + type ('lmod, 'lmodty, 'pty) gen = 536 536 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_fragment.any 537 537 + type t = (na, na, na) gen 471 538 472 472 - val identifier : t -> Identifier.t option 539 539 + val identifier : t -> Identifier.t 473 540 474 541 val is_hidden : t -> bool 475 542 end 476 543 477 544 module Signature : sig 478 478 - type t = Paths_types.Fragment.signature 545 545 + type ('lmod, 'lmodty, 'pty) gen = 546 546 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.signature 547 547 + type t = (na, na, na) gen 479 548 end 480 549 481 550 module Module : sig 482 482 - type t = Paths_types.Fragment.module_ 551 551 + type ('lmod, 'lmodty, 'pty) gen = 552 552 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.module_ 553 553 + type t = (na, na, na) gen 483 554 end 484 555 485 556 module ModuleType : sig 486 486 - type t = Paths_types.Fragment.module_type 557 557 + type ('lmod, 'lmodty, 'pty) gen = 558 558 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.module_type 559 559 + type t = (na, na, na) gen 487 560 end 488 561 489 562 module Type : sig 490 490 - type t = Paths_types.Fragment.type_ 563 563 + type ('lmod, 'lmodty, 'pty) gen = 564 564 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.type_ 565 565 + type t = (na, na, na) gen 491 566 end 492 567 493 493 - type leaf = Paths_types.Fragment.leaf 568 568 + type ('lmod, 'lmodty, 'pty) leaf_gen = 569 569 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.leaf 570 570 + type leaf = (na, na, na) leaf_gen 494 571 495 495 - type t = Paths_types.Fragment.any 572 572 + type ('lmod, 'lmodty, 'pty) gen = 573 573 + ('lmod, 'lmodty, 'pty) Paths_types.Fragment.any 574 574 + type t = (na, na, na) gen 496 575 end 497 576 498 577 (** References present in documentation comments ([{!Foo.Bar}]) *) 499 578 module rec Reference : sig 500 579 module Resolved : sig 501 580 module Signature : sig 502 502 - type t = Paths_types.Resolved_reference.signature 581 581 + type ('lmod, 'lmodty, 'pty) gen = 582 582 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.signature 583 583 + type t = (na, na, na) gen 503 584 end 504 585 505 586 module ClassSignature : sig 506 506 - type t = Paths_types.Resolved_reference.class_signature 587 587 + type ('lmod, 'lmodty, 'pty) gen = 588 588 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.class_signature 589 589 + type t = (na, na, na) gen 507 590 end 508 591 509 592 module DataType : sig 510 510 - type t = Paths_types.Resolved_reference.datatype 593 593 + type ('lmod, 'lmodty, 'pty) gen = 594 594 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.datatype 595 595 + type t = (na, na, na) gen 511 596 end 512 597 513 598 module FieldParent : sig 514 514 - type t = Paths_types.Resolved_reference.field_parent 599 599 + type ('lmod, 'lmodty, 'pty) gen = 600 600 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.field_parent 601 601 + type t = (na, na, na) gen 515 602 end 516 603 517 604 module UnboxedFieldParent : sig 518 518 - type t = Paths_types.Resolved_reference.unboxed_field_parent 605 605 + type ('lmod, 'lmodty, 'pty) gen = 606 606 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.unboxed_field_parent 607 607 + type t = (na, na, na) gen 519 608 end 520 609 521 610 module LabelParent : sig 522 522 - type t = Paths_types.Resolved_reference.label_parent 611 611 + type ('lmod, 'lmodty, 'pty) gen = 612 612 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.label_parent 613 613 + type t = (na, na, na) gen 523 614 end 524 615 525 616 module Module : sig 526 526 - type t = Paths_types.Resolved_reference.module_ 617 617 + type ('lmod, 'lmodty, 'pty) gen = 618 618 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.module_ 619 619 + type t = (na, na, na) gen 527 620 end 528 621 529 622 module ModuleType : sig 530 530 - type t = Paths_types.Resolved_reference.module_type 623 623 + type ('lmod, 'lmodty, 'pty) gen = 624 624 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.module_type 625 625 + type t = (na, na, na) gen 531 626 end 532 627 533 628 module Type : sig 534 534 - type t = Paths_types.Resolved_reference.type_ 629 629 + type ('lmod, 'lmodty, 'pty) gen = 630 630 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.type_ 631 631 + type t = (na, na, na) gen 535 632 end 536 633 537 634 module Constructor : sig 538 538 - type t = Paths_types.Resolved_reference.constructor 635 635 + type ('lmod, 'lmodty, 'pty) gen = 636 636 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.constructor 637 637 + type t = (na, na, na) gen 539 638 end 540 639 541 640 module Field : sig 542 542 - type t = Paths_types.Resolved_reference.field 641 641 + type ('lmod, 'lmodty, 'pty) gen = 642 642 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.field 643 643 + type t = (na, na, na) gen 543 644 end 544 645 545 646 module UnboxedField : sig 546 546 - type t = Paths_types.Resolved_reference.unboxed_field 647 647 + type ('lmod, 'lmodty, 'pty) gen = 648 648 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.unboxed_field 649 649 + type t = (na, na, na) gen 547 650 end 548 651 549 652 module Extension : sig 550 550 - type t = Paths_types.Resolved_reference.extension 653 653 + type ('lmod, 'lmodty, 'pty) gen = 654 654 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.extension 655 655 + type t = (na, na, na) gen 551 656 end 552 657 553 658 module ExtensionDecl : sig 554 554 - type t = Paths_types.Resolved_reference.extension_decl 659 659 + type ('lmod, 'lmodty, 'pty) gen = 660 660 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.extension_decl 661 661 + type t = (na, na, na) gen 555 662 end 556 663 557 664 module Exception : sig 558 558 - type t = Paths_types.Resolved_reference.exception_ 665 665 + type ('lmod, 'lmodty, 'pty) gen = 666 666 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.exception_ 667 667 + type t = (na, na, na) gen 559 668 end 560 669 561 670 module Value : sig 562 562 - type t = Paths_types.Resolved_reference.value 671 671 + type ('lmod, 'lmodty, 'pty) gen = 672 672 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.value 673 673 + type t = (na, na, na) gen 563 674 end 564 675 565 676 module Class : sig 566 566 - type t = Paths_types.Resolved_reference.class_ 677 677 + type ('lmod, 'lmodty, 'pty) gen = 678 678 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.class_ 679 679 + type t = (na, na, na) gen 567 680 end 568 681 569 682 module ClassType : sig 570 570 - type t = Paths_types.Resolved_reference.class_type 683 683 + type ('lmod, 'lmodty, 'pty) gen = 684 684 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.class_type 685 685 + type t = (na, na, na) gen 571 686 end 572 687 573 688 module Method : sig 574 574 - type t = Paths_types.Resolved_reference.method_ 689 689 + type ('lmod, 'lmodty, 'pty) gen = 690 690 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.method_ 691 691 + type t = (na, na, na) gen 575 692 end 576 693 577 694 module InstanceVariable : sig 578 578 - type t = Paths_types.Resolved_reference.instance_variable 695 695 + type ('lmod, 'lmodty, 'pty) gen = 696 696 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.instance_variable 697 697 + type t = (na, na, na) gen 579 698 end 580 699 581 700 module Label : sig 582 582 - type t = Paths_types.Resolved_reference.label 701 701 + type ('lmod, 'lmodty, 'pty) gen = 702 702 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.label 703 703 + type t = (na, na, na) gen 583 704 end 584 705 585 706 module Page : sig ··· 592 713 val identifier : t -> Identifier.AssetFile.t 593 714 end 594 715 595 595 - type t = Paths_types.Resolved_reference.any 716 716 + type ('lmod, 'lmodty, 'pty) gen = 717 717 + ('lmod, 'lmodty, 'pty) Paths_types.Resolved_reference.any 718 718 + type t = (na, na, na) gen 596 719 597 720 val identifier : t -> Identifier.t option 598 721 end 599 722 600 723 module Signature : sig 601 601 - type t = Paths_types.Reference.signature 724 724 + type ('lmod, 'lmodty, 'pty) gen = 725 725 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.signature 726 726 + type t = (na, na, na) gen 602 727 end 603 728 604 729 module ClassSignature : sig 605 605 - type t = Paths_types.Reference.class_signature 730 730 + type ('lmod, 'lmodty, 'pty) gen = 731 731 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.class_signature 732 732 + type t = (na, na, na) gen 606 733 end 607 734 608 735 module DataType : sig 609 609 - type t = Paths_types.Reference.datatype 736 736 + type ('lmod, 'lmodty, 'pty) gen = 737 737 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.datatype 738 738 + type t = (na, na, na) gen 610 739 end 611 740 612 741 module FragmentTypeParent : sig 613 613 - type t = Paths_types.Reference.fragment_type_parent 742 742 + type ('lmod, 'lmodty, 'pty) gen = 743 743 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.fragment_type_parent 744 744 + type t = (na, na, na) gen 614 745 end 615 746 616 747 module LabelParent : sig 617 617 - type t = Paths_types.Reference.label_parent 748 748 + type ('lmod, 'lmodty, 'pty) gen = 749 749 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.label_parent 750 750 + type t = (na, na, na) gen 618 751 end 619 752 620 753 module Module : sig 621 621 - type t = Paths_types.Reference.module_ 754 754 + type ('lmod, 'lmodty, 'pty) gen = 755 755 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.module_ 756 756 + type t = (na, na, na) gen 622 757 end 623 758 624 759 module ModuleType : sig 625 625 - type t = Paths_types.Reference.module_type 760 760 + type ('lmod, 'lmodty, 'pty) gen = 761 761 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.module_type 762 762 + type t = (na, na, na) gen 626 763 end 627 764 628 765 module Type : sig 629 629 - type t = Paths_types.Reference.type_ 766 766 + type ('lmod, 'lmodty, 'pty) gen = 767 767 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.type_ 768 768 + type t = (na, na, na) gen 630 769 end 631 770 632 771 module Constructor : sig 633 633 - type t = Paths_types.Reference.constructor 772 772 + type ('lmod, 'lmodty, 'pty) gen = 773 773 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.constructor 774 774 + type t = (na, na, na) gen 634 775 end 635 776 636 777 module Field : sig 637 637 - type t = Paths_types.Reference.field 778 778 + type ('lmod, 'lmodty, 'pty) gen = 779 779 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.field 780 780 + type t = (na, na, na) gen 638 781 end 639 782 640 783 module UnboxedField : sig 641 641 - type t = Paths_types.Reference.unboxed_field 784 784 + type ('lmod, 'lmodty, 'pty) gen = 785 785 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.unboxed_field 786 786 + type t = (na, na, na) gen 642 787 end 643 788 644 789 module Extension : sig 645 645 - type t = Paths_types.Reference.extension 790 790 + type ('lmod, 'lmodty, 'pty) gen = 791 791 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.extension 792 792 + type t = (na, na, na) gen 646 793 end 647 794 648 795 module ExtensionDecl : sig 649 649 - type t = Paths_types.Reference.extension_decl 796 796 + type ('lmod, 'lmodty, 'pty) gen = 797 797 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.extension_decl 798 798 + type t = (na, na, na) gen 650 799 end 651 800 652 801 module Exception : sig 653 653 - type t = Paths_types.Reference.exception_ 802 802 + type ('lmod, 'lmodty, 'pty) gen = 803 803 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.exception_ 804 804 + type t = (na, na, na) gen 654 805 end 655 806 656 807 module Value : sig 657 657 - type t = Paths_types.Reference.value 808 808 + type ('lmod, 'lmodty, 'pty) gen = 809 809 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.value 810 810 + type t = (na, na, na) gen 658 811 end 659 812 660 813 module Class : sig 661 661 - type t = Paths_types.Reference.class_ 814 814 + type ('lmod, 'lmodty, 'pty) gen = 815 815 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.class_ 816 816 + type t = (na, na, na) gen 662 817 end 663 818 664 819 module ClassType : sig 665 665 - type t = Paths_types.Reference.class_type 820 820 + type ('lmod, 'lmodty, 'pty) gen = 821 821 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.class_type 822 822 + type t = (na, na, na) gen 666 823 end 667 824 668 825 module Method : sig 669 669 - type t = Paths_types.Reference.method_ 826 826 + type ('lmod, 'lmodty, 'pty) gen = 827 827 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.method_ 828 828 + type t = (na, na, na) gen 670 829 end 671 830 672 831 module InstanceVariable : sig 673 673 - type t = Paths_types.Reference.instance_variable 832 832 + type ('lmod, 'lmodty, 'pty) gen = 833 833 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.instance_variable 834 834 + type t = (na, na, na) gen 674 835 end 675 836 676 837 module Label : sig 677 677 - type t = Paths_types.Reference.label 838 838 + type ('lmod, 'lmodty, 'pty) gen = 839 839 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.label 840 840 + type t = (na, na, na) gen 678 841 end 679 842 680 843 module Page : sig 681 681 - type t = Paths_types.Reference.page 844 844 + type ('lmod, 'lmodty, 'pty) gen = 845 845 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.page 846 846 + type t = (na, na, na) gen 682 847 end 683 848 684 849 module Asset : sig ··· 689 854 type t = Paths_types.Reference.hierarchy 690 855 end 691 856 692 692 - type t = Paths_types.Reference.any 857 857 + type ('lmod, 'lmodty, 'pty) gen = 858 858 + ('lmod, 'lmodty, 'pty) Paths_types.Reference.any 859 859 + type t = (na, na, na) gen 693 860 694 861 type tag_any = Paths_types.Reference.tag_any 695 862 type tag_hierarchy = Paths_types.Reference.tag_hierarchy

+452 -338

odoc/src/model/paths_types.ml

reviewed

··· 325 325 end 326 326 327 327 module rec Path : sig 328 328 - type module_ = 329 329 - [ `Resolved of Resolved_path.module_ 328 328 + type ('lmod, 'lmodty, 'pty) module_ = 329 329 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_path.module_ 330 330 | `Identifier of Identifier.path_module * bool 331 331 - | `Substituted of module_ 331 331 + | `LocalMod of 'lmod 332 332 + | `Substituted of ('lmod, 'lmodty, 'pty) module_ 332 333 | `Root of ModuleName.t 333 334 | `Forward of string 334 334 - | `Dot of module_ * ModuleName.t 335 335 - | `Apply of module_ * module_ ] 336 336 - (** @canonical Odoc_model.Paths.Path.Module.t *) 335 335 + | `Dot of ('lmod, 'lmodty, 'pty) module_ * ModuleName.t 336 336 + | `Module of 337 337 + 'pty * ('lmod, 'lmodty, 'pty) Resolved_path.parent * ModuleName.t 338 338 + | `Apply of ('lmod, 'lmodty, 'pty) module_ * ('lmod, 'lmodty, 'pty) module_ 339 339 + ] 340 340 + (** @canonical Odoc_model.Paths.Path.Module.gen *) 337 341 338 338 - type module_type = 339 339 - [ `Resolved of Resolved_path.module_type 340 340 - | `SubstitutedMT of module_type 342 342 + type ('lmod, 'lmodty, 'pty) module_type = 343 343 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_path.module_type 344 344 + | `LocalModTy of 'lmodty 345 345 + | `SubstitutedMT of ('lmod, 'lmodty, 'pty) module_type 341 346 | `Identifier of Identifier.path_module_type * bool 342 342 - | `DotMT of module_ * ModuleTypeName.t ] 343 343 - (** @canonical Odoc_model.Paths.Path.ModuleType.t *) 347 347 + | `DotMT of ('lmod, 'lmodty, 'pty) module_ * ModuleTypeName.t 348 348 + | `ModuleType of 349 349 + 'pty * ('lmod, 'lmodty, 'pty) Resolved_path.parent * ModuleTypeName.t ] 350 350 + (** @canonical Odoc_model.Paths.Path.ModuleType.gen *) 344 351 345 345 - type type_ = 346 346 - [ `Resolved of Resolved_path.type_ 347 347 - | `SubstitutedT of type_ 352 352 + type ('lmod, 'lmodty, 'pty, 'lty) class_type = 353 353 + [ `Resolved of ('lmod, 'lmodty, 'pty, 'lty) Resolved_path.class_type 354 354 + | `LocalTy of 'lty 355 355 + | `SubstitutedCT of ('lmod, 'lmodty, 'pty, 'lty) class_type 356 356 + | `Identifier of Identifier.path_class_type * bool 357 357 + | `DotT of ('lmod, 'lmodty, 'pty) module_ * TypeName.t 358 358 + | `Type of 'pty * ('lmod, 'lmodty, 'pty) Resolved_path.parent * TypeName.t 359 359 + ] 360 360 + (** @canonical Odoc_model.Paths.Path.ClassType.gen *) 361 361 + 362 362 + type ('lmod, 'lmodty, 'pty, 'lty) type_ = 363 363 + [ `Resolved of ('lmod, 'lmodty, 'pty, 'lty) Resolved_path.type_ 364 364 + | `LocalTy of 'lty 365 365 + | `SubstitutedT of ('lmod, 'lmodty, 'pty, 'lty) type_ 366 366 + | `SubstitutedCT of ('lmod, 'lmodty, 'pty, 'lty) class_type 348 367 | `Identifier of Identifier.path_type * bool 349 349 - | `DotT of module_ * TypeName.t ] 350 350 - (** @canonical Odoc_model.Paths.Path.Type.t *) 368 368 + | `DotT of ('lmod, 'lmodty, 'pty) module_ * TypeName.t 369 369 + | `Type of 'pty * ('lmod, 'lmodty, 'pty) Resolved_path.parent * TypeName.t 370 370 + ] 371 371 + (** @canonical Odoc_model.Paths.Path.Type.gen *) 351 372 352 352 - type value = 353 353 - [ `Resolved of Resolved_path.value 373 373 + type ('lmod, 'lmodty, 'pty, 'lval) value = 374 374 + [ `Resolved of ('lmod, 'lmodty, 'pty, 'lval) Resolved_path.value 375 375 + | `LocalVal of 'lval 354 376 | `Identifier of Identifier.path_value * bool 355 355 - | `DotV of module_ * ValueName.t ] 356 356 - (** @canonical Odoc_model.Paths.Path.Value.t *) 377 377 + | `DotV of ('lmod, 'lmodty, 'pty) module_ * ValueName.t ] 378 378 + (** @canonical Odoc_model.Paths.Path.Value.gen *) 357 379 358 358 - type class_type = 359 359 - [ `Resolved of Resolved_path.class_type 360 360 - | `SubstitutedCT of class_type 361 361 - | `Identifier of Identifier.path_class_type * bool 362 362 - | `DotT of module_ * TypeName.t ] 363 363 - (** @canonical Odoc_model.Paths.Path.ClassType.t *) 364 364 - 365 365 - type any = 366 366 - [ `Resolved of Resolved_path.any 367 367 - | `SubstitutedT of type_ 368 368 - | `SubstitutedMT of module_type 369 369 - | `Substituted of module_ 370 370 - | `SubstitutedCT of class_type 380 380 + type ('lmod, 'lmodty, 'pty, 'lty, 'lval) any = 381 381 + [ `Resolved of ('lmod, 'lmodty, 'pty, 'lty, 'lval) Resolved_path.any 382 382 + | `SubstitutedT of ('lmod, 'lmodty, 'pty, 'lty) type_ 383 383 + | `SubstitutedMT of ('lmod, 'lmodty, 'pty) module_type 384 384 + | `Substituted of ('lmod, 'lmodty, 'pty) module_ 385 385 + | `SubstitutedCT of ('lmod, 'lmodty, 'pty, 'lty) class_type 371 386 | `Identifier of Identifier.path_any * bool 372 387 | `Root of ModuleName.t 373 388 | `Forward of string 374 374 - | `Dot of module_ * ModuleName.t 375 375 - | `DotT of module_ * TypeName.t 376 376 - | `DotMT of module_ * ModuleTypeName.t 377 377 - | `DotV of module_ * ValueName.t 378 378 - | `Apply of module_ * module_ ] 379 379 - (** @canonical Odoc_model.Paths.Path.t *) 389 389 + | `Dot of ('lmod, 'lmodty, 'pty) module_ * ModuleName.t 390 390 + | `DotT of ('lmod, 'lmodty, 'pty) module_ * TypeName.t 391 391 + | `DotMT of ('lmod, 'lmodty, 'pty) module_ * ModuleTypeName.t 392 392 + | `DotV of ('lmod, 'lmodty, 'pty) module_ * ValueName.t 393 393 + | `Apply of ('lmod, 'lmodty, 'pty) module_ * ('lmod, 'lmodty, 'pty) module_ 394 394 + | `Type of 'pty * ('lmod, 'lmodty, 'pty) Resolved_path.parent * TypeName.t 395 395 + | `ModuleType of 396 396 + 'pty * ('lmod, 'lmodty, 'pty) Resolved_path.parent * ModuleTypeName.t 397 397 + | `Module of 398 398 + 'pty * ('lmod, 'lmodty, 'pty) Resolved_path.parent * ModuleName.t 399 399 + | `LocalMod of 'lmod 400 400 + | `LocalModTy of 'lmodty 401 401 + | `LocalVal of 'lval 402 402 + | `LocalTy of 'lty ] 403 403 + (** @canonical Odoc_model.Paths.Path.gen *) 380 404 end = 381 405 Path 382 406 383 407 and Resolved_path : sig 384 384 - type module_ = 408 408 + type ('lmod, 'lmodty, 'pty) parent = 409 409 + [ `Module of ('lmod, 'lmodty, 'pty) module_ 410 410 + | `ModuleType of ('lmod, 'lmodty, 'pty) module_type * 'pty 411 411 + | `FragmentRoot of 'pty ] 412 412 + 413 413 + and ('lmod, 'lmodty, 'pty) module_ = 385 414 [ `Identifier of Identifier.path_module 386 386 - | `Subst of module_type * module_ 387 387 - | `Substituted of module_ 388 388 - | `Hidden of module_ 389 389 - | `Module of module_ * ModuleName.t 390 390 - | `Canonical of module_ * Path.module_ (** [`Canonical (mod, canonical)] *) 391 391 - | `Apply of module_ * module_ (** [`Apply (functor, argument)] *) 392 392 - | `Alias of module_ * Path.module_ (** Resolved dest *) 393 393 - | `OpaqueModule of module_ ] 415 415 + | `LocalMod of 'lmod 416 416 + | `Subst of 417 417 + ('lmod, 'lmodty, 'pty) module_type * ('lmod, 'lmodty, 'pty) module_ 418 418 + | `Substituted of ('lmod, 'lmodty, 'pty) module_ 419 419 + | `Hidden of ('lmod, 'lmodty, 'pty) module_ 420 420 + | `Module of ('lmod, 'lmodty, 'pty) parent * ModuleName.t 421 421 + | `Canonical of 422 422 + ('lmod, 'lmodty, 'pty) module_ * ('lmod, 'lmodty, 'pty) Path.module_ 423 423 + (** [`Canonical (mod, canonical)] *) 424 424 + | `Apply of ('lmod, 'lmodty, 'pty) module_ * ('lmod, 'lmodty, 'pty) module_ 425 425 + (** [`Apply (functor, argument)] *) 426 426 + | `Alias of 427 427 + ('lmod, 'lmodty, 'pty) module_ 428 428 + * ('lmod, 'lmodty, 'pty) Path.module_ 429 429 + * ('lmod, 'lmodty, 'pty) module_ option 430 430 + (** Resolved dest *) 431 431 + | `OpaqueModule of ('lmod, 'lmodty, 'pty) module_ ] 394 432 (** @canonical Odoc_model.Paths.Path.Resolved.Module.t *) 395 433 396 396 - and module_type = 434 434 + and ('lmod, 'lmodty, 'pty) module_type = 397 435 [ `Identifier of Identifier.path_module_type 398 398 - | `SubstT of module_type * module_type 399 399 - | `SubstitutedMT of module_type 400 400 - | `CanonicalModuleType of module_type * Path.module_type 401 401 - | `AliasModuleType of module_type * module_type 402 402 - | `ModuleType of module_ * ModuleTypeName.t 403 403 - | `OpaqueModuleType of module_type ] 436 436 + | `LocalModTy of 'lmodty 437 437 + | `SubstT of 438 438 + ('lmod, 'lmodty, 'pty) module_type * ('lmod, 'lmodty, 'pty) module_type 439 439 + | `SubstitutedMT of ('lmod, 'lmodty, 'pty) module_type 440 440 + | `CanonicalModuleType of 441 441 + ('lmod, 'lmodty, 'pty) module_type 442 442 + * ('lmod, 'lmodty, 'pty) Path.module_type 443 443 + | `AliasModuleType of 444 444 + ('lmod, 'lmodty, 'pty) module_type * ('lmod, 'lmodty, 'pty) module_type 445 445 + | `ModuleType of ('lmod, 'lmodty, 'pty) parent * ModuleTypeName.t 446 446 + | `OpaqueModuleType of ('lmod, 'lmodty, 'pty) module_type ] 404 447 (** @canonical Odoc_model.Paths.Path.Resolved.ModuleType.t *) 405 448 406 406 - type value = 407 407 - [ `Identifier of Identifier.path_value | `Value of module_ * ValueName.t ] 449 449 + type ('lmod, 'lmodty, 'pty, 'lval) value = 450 450 + [ `Identifier of Identifier.path_value 451 451 + | `LocalVal of 'lval 452 452 + | `Value of ('lmod, 'lmodty, 'pty) parent * ValueName.t ] 408 453 (** @canonical Odoc_model.Paths.Path.Resolved.Value.t *) 409 454 410 410 - type class_type = 455 455 + type ('lmod, 'lmodty, 'pty, 'lty) class_type = 411 456 [ `Identifier of Identifier.path_class_type 412 412 - | `SubstitutedCT of class_type 413 413 - | `Class of module_ * TypeName.t 414 414 - | `ClassType of module_ * TypeName.t ] 457 457 + | `LocalTy of 'lty 458 458 + | `SubstitutedCT of ('lmod, 'lmodty, 'pty, 'lty) class_type 459 459 + | `Class of ('lmod, 'lmodty, 'pty) parent * TypeName.t 460 460 + | `ClassType of ('lmod, 'lmodty, 'pty) parent * TypeName.t ] 415 461 416 416 - type type_ = 462 462 + type ('lmod, 'lmodty, 'pty, 'lty) type_ = 417 463 [ `Identifier of Identifier.path_type 418 418 - | `SubstitutedT of type_ 419 419 - | `SubstitutedCT of class_type 420 420 - | `CanonicalType of type_ * Path.type_ 421 421 - | `Type of module_ * TypeName.t 422 422 - | `Class of module_ * TypeName.t 423 423 - | `ClassType of module_ * TypeName.t 464 464 + | `LocalTy of 'lty 465 465 + | `SubstitutedT of ('lmod, 'lmodty, 'pty, 'lty) type_ 466 466 + | `SubstitutedCT of ('lmod, 'lmodty, 'pty, 'lty) class_type 467 467 + | `CanonicalType of 468 468 + ('lmod, 'lmodty, 'pty, 'lty) type_ 469 469 + * ('lmod, 'lmodty, 'pty, 'lty) Path.type_ 470 470 + | `Type of ('lmod, 'lmodty, 'pty) parent * TypeName.t 471 471 + | `Class of ('lmod, 'lmodty, 'pty) parent * TypeName.t 472 472 + | `ClassType of ('lmod, 'lmodty, 'pty) parent * TypeName.t 424 473 | `CoreType of TypeName.t ] 425 474 (** @canonical Odoc_model.Paths.Path.Resolved.Type.t *) 426 475 427 427 - type any = 476 476 + type ('lmod, 'lmodty, 'pty, 'lty, 'lval) any = 428 477 [ `Identifier of Identifier.any 429 429 - | `SubstitutedCT of class_type 430 430 - | `SubstitutedT of type_ 431 431 - | `SubstitutedMT of module_type 432 432 - | `Substituted of module_ 433 433 - | `Subst of module_type * module_ 434 434 - | `Hidden of module_ 435 435 - | `Module of module_ * ModuleName.t 436 436 - | `Canonical of module_ * Path.module_ 437 437 - | `Apply of module_ * module_ 438 438 - | `Alias of module_ * Path.module_ 439 439 - | `AliasModuleType of module_type * module_type 440 440 - | `OpaqueModule of module_ 441 441 - | `ModuleType of module_ * ModuleTypeName.t 442 442 - | `CanonicalModuleType of module_type * Path.module_type 443 443 - | `SubstT of module_type * module_type 444 444 - | `OpaqueModuleType of module_type 445 445 - | `CanonicalType of type_ * Path.type_ 446 446 - | `Type of module_ * TypeName.t 447 447 - | `Class of module_ * TypeName.t 448 448 - | `ClassType of module_ * TypeName.t 449 449 - | `Class of module_ * TypeName.t 450 450 - | `Value of module_ * ValueName.t 451 451 - | `ClassType of module_ * TypeName.t 478 478 + | `SubstitutedCT of ('lmod, 'lmodty, 'pty, 'lty) class_type 479 479 + | `SubstitutedT of ('lmod, 'lmodty, 'pty, 'lty) type_ 480 480 + | `SubstitutedMT of ('lmod, 'lmodty, 'pty) module_type 481 481 + | `Substituted of ('lmod, 'lmodty, 'pty) module_ 482 482 + | `Subst of 483 483 + ('lmod, 'lmodty, 'pty) module_type * ('lmod, 'lmodty, 'pty) module_ 484 484 + | `Hidden of ('lmod, 'lmodty, 'pty) module_ 485 485 + | `Module of ('lmod, 'lmodty, 'pty) parent * ModuleName.t 486 486 + | `Canonical of 487 487 + ('lmod, 'lmodty, 'pty) module_ * ('lmod, 'lmodty, 'pty) Path.module_ 488 488 + | `Apply of ('lmod, 'lmodty, 'pty) module_ * ('lmod, 'lmodty, 'pty) module_ 489 489 + | `Alias of 490 490 + ('lmod, 'lmodty, 'pty) module_ 491 491 + * ('lmod, 'lmodty, 'pty) Path.module_ 492 492 + * ('lmod, 'lmodty, 'pty) module_ option 493 493 + | `AliasModuleType of 494 494 + ('lmod, 'lmodty, 'pty) module_type * ('lmod, 'lmodty, 'pty) module_type 495 495 + | `OpaqueModule of ('lmod, 'lmodty, 'pty) module_ 496 496 + | `ModuleType of ('lmod, 'lmodty, 'pty) parent * ModuleTypeName.t 497 497 + | `CanonicalModuleType of 498 498 + ('lmod, 'lmodty, 'pty) module_type 499 499 + * ('lmod, 'lmodty, 'pty) Path.module_type 500 500 + | `SubstT of 501 501 + ('lmod, 'lmodty, 'pty) module_type * ('lmod, 'lmodty, 'pty) module_type 502 502 + | `OpaqueModuleType of ('lmod, 'lmodty, 'pty) module_type 503 503 + | `CanonicalType of 504 504 + ('lmod, 'lmodty, 'pty, 'lty) type_ 505 505 + * ('lmod, 'lmodty, 'pty, 'lty) Path.type_ 506 506 + | `Type of ('lmod, 'lmodty, 'pty) parent * TypeName.t 507 507 + | `Class of ('lmod, 'lmodty, 'pty) parent * TypeName.t 508 508 + | `ClassType of ('lmod, 'lmodty, 'pty) parent * TypeName.t 509 509 + | `Class of ('lmod, 'lmodty, 'pty) parent * TypeName.t 510 510 + | `Value of ('lmod, 'lmodty, 'pty) parent * ValueName.t 511 511 + | `ClassType of ('lmod, 'lmodty, 'pty) parent * TypeName.t 512 512 + | `LocalMod of 'lmod 513 513 + | `LocalModTy of 'lmodty 514 514 + | `LocalVal of 'lval 515 515 + | `LocalTy of 'lty 452 516 | `CoreType of TypeName.t ] 453 517 (** @canonical Odoc_model.Paths.Path.Resolved.t *) 454 518 end = 455 519 Resolved_path 456 520 457 521 module rec Fragment : sig 458 458 - type signature = 459 459 - [ `Resolved of Resolved_fragment.signature 460 460 - | `Dot of signature * string 522 522 + type ('lmod, 'lmodty, 'pty) signature = 523 523 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_fragment.signature 524 524 + | `Dot of ('lmod, 'lmodty, 'pty) signature * string 461 525 | `Root ] 462 526 (** @canonical Odoc_model.Paths.Fragment.Signature.t *) 463 527 464 464 - type module_ = 465 465 - [ `Resolved of Resolved_fragment.module_ | `Dot of signature * string ] 528 528 + type ('lmod, 'lmodty, 'pty) module_ = 529 529 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_fragment.module_ 530 530 + | `Dot of ('lmod, 'lmodty, 'pty) signature * string ] 466 531 (** @canonical Odoc_model.Paths.Fragment.Module.t *) 467 532 468 468 - type module_type = 469 469 - [ `Resolved of Resolved_fragment.module_type | `Dot of signature * string ] 533 533 + type ('lmod, 'lmodty, 'pty) module_type = 534 534 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_fragment.module_type 535 535 + | `Dot of ('lmod, 'lmodty, 'pty) signature * string ] 470 536 (** @canonical Odoc_model.Paths.Fragment.ModuleType.t *) 471 537 472 472 - type type_ = 473 473 - [ `Resolved of Resolved_fragment.type_ | `Dot of signature * string ] 538 538 + type ('lmod, 'lmodty, 'pty) type_ = 539 539 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_fragment.type_ 540 540 + | `Dot of ('lmod, 'lmodty, 'pty) signature * string ] 474 541 (** @canonical Odoc_model.Paths.Fragment.Type.t *) 475 542 476 476 - type leaf = 477 477 - [ `Resolved of Resolved_fragment.leaf | `Dot of signature * string ] 543 543 + type ('lmod, 'lmodty, 'pty) leaf = 544 544 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_fragment.leaf 545 545 + | `Dot of ('lmod, 'lmodty, 'pty) signature * string ] 478 546 (** @canonical Odoc_model.Paths.Fragment.leaf *) 479 547 480 480 - type any = 481 481 - [ `Resolved of Resolved_fragment.any | `Dot of signature * string | `Root ] 548 548 + type ('lmod, 'lmodty, 'pty) any = 549 549 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_fragment.any 550 550 + | `Dot of ('lmod, 'lmodty, 'pty) signature * string 551 551 + | `Root ] 482 552 (** @canonical Odoc_model.Paths.Fragment.t *) 483 553 end = 484 554 Fragment 485 555 486 556 and Resolved_fragment : sig 487 487 - type root = 488 488 - [ `ModuleType of Resolved_path.module_type 489 489 - | `Module of Resolved_path.module_ ] 557 557 + type ('lmod, 'lmodty, 'pty) root = 558 558 + [ `ModuleType of ('lmod, 'lmodty, 'pty) Resolved_path.module_type 559 559 + | `Module of ('lmod, 'lmodty, 'pty) Resolved_path.module_ ] 490 560 (** @canonical Odoc_model.Paths.Fragment.Resolved.root *) 491 561 492 492 - type signature = 493 493 - [ `Root of root 494 494 - | `Subst of Resolved_path.module_type * module_ 495 495 - | `Alias of Resolved_path.module_ * module_ 496 496 - | `Module of signature * ModuleName.t 497 497 - | `OpaqueModule of module_ ] 562 562 + type ('lmod, 'lmodty, 'pty) signature = 563 563 + [ `Root of ('lmod, 'lmodty, 'pty) root 564 564 + | `Subst of 565 565 + ('lmod, 'lmodty, 'pty) Resolved_path.module_type 566 566 + * ('lmod, 'lmodty, 'pty) module_ 567 567 + | `Alias of 568 568 + ('lmod, 'lmodty, 'pty) Resolved_path.module_ 569 569 + * ('lmod, 'lmodty, 'pty) module_ 570 570 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 571 571 + | `OpaqueModule of ('lmod, 'lmodty, 'pty) module_ ] 498 572 (** @canonical Odoc_model.Paths.Fragment.Resolved.Signature.t *) 499 573 500 500 - and module_ = 501 501 - [ `Subst of Resolved_path.module_type * module_ 502 502 - | `Alias of Resolved_path.module_ * module_ 503 503 - | `Module of signature * ModuleName.t 504 504 - | `OpaqueModule of module_ ] 574 574 + and ('lmod, 'lmodty, 'pty) module_ = 575 575 + [ `Subst of 576 576 + ('lmod, 'lmodty, 'pty) Resolved_path.module_type 577 577 + * ('lmod, 'lmodty, 'pty) module_ 578 578 + | `Alias of 579 579 + ('lmod, 'lmodty, 'pty) Resolved_path.module_ 580 580 + * ('lmod, 'lmodty, 'pty) module_ 581 581 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 582 582 + | `OpaqueModule of ('lmod, 'lmodty, 'pty) module_ ] 505 583 (** @canonical Odoc_model.Paths.Fragment.Resolved.Module.t *) 506 584 507 507 - type type_ = 508 508 - [ `Type of signature * TypeName.t 509 509 - | `Class of signature * TypeName.t 510 510 - | `ClassType of signature * TypeName.t ] 585 585 + type ('lmod, 'lmodty, 'pty) type_ = 586 586 + [ `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t 587 587 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 588 588 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 511 589 (** @canonical Odoc_model.Paths.Fragment.Resolved.Type.t *) 512 590 513 513 - and module_type = [ `Module_type of signature * ModuleTypeName.t ] 591 591 + and ('lmod, 'lmodty, 'pty) module_type = 592 592 + [ `Module_type of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t ] 514 593 (** @canonical Odoc_model.Paths.Fragment.Resolved.ModuleType.t *) 515 594 516 516 - type leaf = [ module_ | module_type | type_ ] 595 595 + type ('lmod, 'lmodty, 'pty) leaf = 596 596 + [ ('lmod, 'lmodty, 'pty) module_ 597 597 + | ('lmod, 'lmodty, 'pty) module_type 598 598 + | ('lmod, 'lmodty, 'pty) type_ ] 517 599 (** @canonical Odoc_model.Paths.Fragment.Resolved.leaf *) 518 600 519 601 (* Absence of `Root here might make coersions annoying *) 520 520 - type any = 521 521 - [ `Root of root 522 522 - | `Subst of Resolved_path.module_type * module_ 523 523 - | `Alias of Resolved_path.module_ * module_ 524 524 - | `Module of signature * ModuleName.t 525 525 - | `Module_type of signature * ModuleTypeName.t 526 526 - | `Type of signature * TypeName.t 527 527 - | `Class of signature * TypeName.t 528 528 - | `ClassType of signature * TypeName.t 529 529 - | `OpaqueModule of module_ ] 602 602 + type ('lmod, 'lmodty, 'pty) any = 603 603 + [ `Root of ('lmod, 'lmodty, 'pty) root 604 604 + | `Subst of 605 605 + ('lmod, 'lmodty, 'pty) Resolved_path.module_type 606 606 + * ('lmod, 'lmodty, 'pty) module_ 607 607 + | `Alias of 608 608 + ('lmod, 'lmodty, 'pty) Resolved_path.module_ 609 609 + * ('lmod, 'lmodty, 'pty) module_ 610 610 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 611 611 + | `Module_type of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t 612 612 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t 613 613 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 614 614 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t 615 615 + | `OpaqueModule of ('lmod, 'lmodty, 'pty) module_ ] 530 616 (** @canonical Odoc_model.Paths.Fragment.Resolved.t *) 531 617 end = 532 618 Resolved_fragment ··· 619 705 type hierarchy = tag_hierarchy * string list 620 706 (** @canonical Odoc_model.Paths.Reference.Hierarchy.t *) 621 707 622 622 - type signature = 623 623 - [ `Resolved of Resolved_reference.signature 708 708 + type ('lmod, 'lmodty, 'pty) signature = 709 709 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.signature 624 710 | `Root of string * tag_signature 625 625 - | `Dot of label_parent * string 711 711 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 626 712 | `Module_path of hierarchy 627 627 - | `Module of signature * ModuleName.t 628 628 - | `ModuleType of signature * ModuleTypeName.t ] 713 713 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 714 714 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t ] 629 715 (** @canonical Odoc_model.Paths.Reference.Signature.t *) 630 716 631 631 - and class_signature = 632 632 - [ `Resolved of Resolved_reference.class_signature 717 717 + and ('lmod, 'lmodty, 'pty) class_signature = 718 718 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.class_signature 633 719 | `Root of string * tag_class_signature 634 634 - | `Dot of label_parent * string 635 635 - | `Class of signature * TypeName.t 636 636 - | `ClassType of signature * TypeName.t ] 720 720 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 721 721 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 722 722 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 637 723 (** @canonical Odoc_model.Paths.Reference.ClassSignature.t *) 638 724 639 639 - and datatype = 640 640 - [ `Resolved of Resolved_reference.datatype 725 725 + and ('lmod, 'lmodty, 'pty) datatype = 726 726 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.datatype 641 727 | `Root of string * tag_datatype 642 642 - | `Dot of label_parent * string 643 643 - | `Type of signature * TypeName.t ] 728 728 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 729 729 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 644 730 (** @canonical Odoc_model.Paths.Reference.DataType.t *) 645 731 646 732 (* Parent of fields and constructor. Can be either a type or [signature] *) 647 647 - and fragment_type_parent = 648 648 - [ `Resolved of Resolved_reference.field_parent 733 733 + and ('lmod, 'lmodty, 'pty) fragment_type_parent = 734 734 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.field_parent 649 735 | `Root of string * tag_parent 650 650 - | `Dot of label_parent * string 736 736 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 651 737 | `Module_path of hierarchy 652 652 - | `Module of signature * ModuleName.t 653 653 - | `ModuleType of signature * ModuleTypeName.t 654 654 - | `Type of signature * TypeName.t ] 738 738 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 739 739 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t 740 740 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 655 741 (** @canonical Odoc_model.Paths.Reference.FragmentTypeParent.t *) 656 742 657 657 - and label_parent = 658 658 - [ `Resolved of Resolved_reference.label_parent 743 743 + and ('lmod, 'lmodty, 'pty) label_parent = 744 744 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.label_parent 659 745 | `Root of string * tag_label_parent 660 660 - | `Dot of label_parent * string 746 746 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 661 747 | `Page_path of hierarchy 662 748 | `Module_path of hierarchy 663 749 | `Any_path of hierarchy 664 664 - | `Module of signature * ModuleName.t 665 665 - | `ModuleType of signature * ModuleTypeName.t 666 666 - | `Class of signature * TypeName.t 667 667 - | `ClassType of signature * TypeName.t 668 668 - | `Type of signature * TypeName.t ] 750 750 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 751 751 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t 752 752 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 753 753 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t 754 754 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 669 755 (** @canonical Odoc_model.Paths.Reference.LabelParent.t *) 670 756 671 757 type asset = 672 758 [ `Resolved of Resolved_reference.asset | `Asset_path of hierarchy ] 673 759 674 674 - type module_ = 675 675 - [ `Resolved of Resolved_reference.module_ 760 760 + type ('lmod, 'lmodty, 'pty) module_ = 761 761 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.module_ 676 762 | `Root of string * [ `TModule | `TUnknown ] 677 677 - | `Dot of label_parent * string 763 763 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 678 764 | `Module_path of hierarchy 679 679 - | `Module of signature * ModuleName.t ] 765 765 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t ] 680 766 (** @canonical Odoc_model.Paths.Reference.Module.t *) 681 767 682 682 - type module_type = 683 683 - [ `Resolved of Resolved_reference.module_type 768 768 + type ('lmod, 'lmodty, 'pty) module_type = 769 769 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.module_type 684 770 | `Root of string * [ `TModuleType | `TUnknown ] 685 685 - | `Dot of label_parent * string 686 686 - | `ModuleType of signature * ModuleTypeName.t ] 771 771 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 772 772 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t ] 687 773 (** @canonical Odoc_model.Paths.Reference.ModuleType.t *) 688 774 689 689 - type type_ = 690 690 - [ `Resolved of Resolved_reference.type_ 775 775 + type ('lmod, 'lmodty, 'pty) type_ = 776 776 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.type_ 691 777 | `Root of string * [ `TType | `TClass | `TClassType | `TUnknown ] 692 692 - | `Dot of label_parent * string 693 693 - | `Class of signature * TypeName.t 694 694 - | `ClassType of signature * TypeName.t 695 695 - | `Type of signature * TypeName.t ] 778 778 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 779 779 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 780 780 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t 781 781 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 696 782 (** @canonical Odoc_model.Paths.Reference.Type.t *) 697 783 698 698 - type constructor = 699 699 - [ `Resolved of Resolved_reference.constructor 784 784 + type ('lmod, 'lmodty, 'pty) constructor = 785 785 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.constructor 700 786 | `Root of string * [ `TConstructor | `TExtension | `TException | `TUnknown ] 701 701 - | `Dot of label_parent * string 702 702 - | `Constructor of fragment_type_parent * ConstructorName.t 703 703 - | `Extension of signature * ExtensionName.t 704 704 - | `Exception of signature * ExceptionName.t ] 787 787 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 788 788 + | `Constructor of 789 789 + ('lmod, 'lmodty, 'pty) fragment_type_parent * ConstructorName.t 790 790 + | `Extension of ('lmod, 'lmodty, 'pty) signature * ExtensionName.t 791 791 + | `Exception of ('lmod, 'lmodty, 'pty) signature * ExceptionName.t ] 705 792 (** @canonical Odoc_model.Paths.Reference.Constructor.t *) 706 793 707 707 - type field = 708 708 - [ `Resolved of Resolved_reference.field 794 794 + type ('lmod, 'lmodty, 'pty) field = 795 795 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.field 709 796 | `Root of string * [ `TField | `TUnknown ] 710 710 - | `Dot of label_parent * string 711 711 - | `Field of fragment_type_parent * FieldName.t ] 797 797 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 798 798 + | `Field of ('lmod, 'lmodty, 'pty) fragment_type_parent * FieldName.t ] 712 799 (** @canonical Odoc_model.Paths.Reference.Field.t *) 713 800 714 714 - type unboxed_field = 715 715 - [ `Resolved of Resolved_reference.unboxed_field 801 801 + type ('lmod, 'lmodty, 'pty) unboxed_field = 802 802 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.unboxed_field 716 803 | `Root of string * [ `TField | `TUnknown ] 717 717 - | `Dot of label_parent * string 718 718 - | `UnboxedField of fragment_type_parent * UnboxedFieldName.t ] 804 804 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 805 805 + | `UnboxedField of ('lmod, 'lmodty, 'pty) fragment_type_parent * UnboxedFieldName.t ] 719 806 (** @canonical Odoc_model.Paths.Reference.UnboxedField.t *) 720 807 721 721 - type extension = 722 722 - [ `Resolved of Resolved_reference.extension 808 808 + type ('lmod, 'lmodty, 'pty) extension = 809 809 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.extension 723 810 | `Root of string * [ `TExtension | `TException | `TUnknown ] 724 724 - | `Dot of label_parent * string 725 725 - | `Extension of signature * ExtensionName.t 726 726 - | `Exception of signature * ExceptionName.t ] 811 811 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 812 812 + | `Extension of ('lmod, 'lmodty, 'pty) signature * ExtensionName.t 813 813 + | `Exception of ('lmod, 'lmodty, 'pty) signature * ExceptionName.t ] 727 814 (** @canonical Odoc_model.Paths.Reference.Extension.t *) 728 815 729 729 - type extension_decl = 730 730 - [ `Resolved of Resolved_reference.extension_decl 816 816 + type ('lmod, 'lmodty, 'pty) extension_decl = 817 817 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.extension_decl 731 818 | `Root of string * [ `TExtension | `TException | `TUnknown ] 732 732 - | `Dot of label_parent * string 733 733 - | `ExtensionDecl of signature * ExtensionName.t ] 819 819 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 820 820 + | `ExtensionDecl of ('lmod, 'lmodty, 'pty) signature * ExtensionName.t ] 734 821 (** @canonical Odoc_model.Paths.Reference.ExtensionDecl.t *) 735 822 736 736 - type exception_ = 737 737 - [ `Resolved of Resolved_reference.exception_ 823 823 + type ('lmod, 'lmodty, 'pty) exception_ = 824 824 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.exception_ 738 825 | `Root of string * [ `TException | `TUnknown ] 739 739 - | `Dot of label_parent * string 740 740 - | `Exception of signature * ExceptionName.t ] 826 826 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 827 827 + | `Exception of ('lmod, 'lmodty, 'pty) signature * ExceptionName.t ] 741 828 (** @canonical Odoc_model.Paths.Reference.Exception.t *) 742 829 743 743 - type value = 744 744 - [ `Resolved of Resolved_reference.value 830 830 + type ('lmod, 'lmodty, 'pty) value = 831 831 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.value 745 832 | `Root of string * [ `TValue | `TUnknown ] 746 746 - | `Dot of label_parent * string 747 747 - | `Value of signature * ValueName.t ] 833 833 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 834 834 + | `Value of ('lmod, 'lmodty, 'pty) signature * ValueName.t ] 748 835 (** @canonical Odoc_model.Paths.Reference.Value.t *) 749 836 750 750 - type class_ = 751 751 - [ `Resolved of Resolved_reference.class_ 837 837 + type ('lmod, 'lmodty, 'pty) class_ = 838 838 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.class_ 752 839 | `Root of string * [ `TClass | `TUnknown ] 753 753 - | `Dot of label_parent * string 754 754 - | `Class of signature * TypeName.t ] 840 840 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 841 841 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 755 842 (** @canonical Odoc_model.Paths.Reference.Class.t *) 756 843 757 757 - type class_type = 758 758 - [ `Resolved of Resolved_reference.class_type 844 844 + type ('lmod, 'lmodty, 'pty) class_type = 845 845 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.class_type 759 846 | `Root of string * [ `TClass | `TClassType | `TUnknown ] 760 760 - | `Dot of label_parent * string 761 761 - | `Class of signature * TypeName.t 762 762 - | `ClassType of signature * TypeName.t ] 847 847 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 848 848 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 849 849 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 763 850 (** @canonical Odoc_model.Paths.Reference.ClassType.t *) 764 851 765 765 - type method_ = 766 766 - [ `Resolved of Resolved_reference.method_ 852 852 + type ('lmod, 'lmodty, 'pty) method_ = 853 853 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.method_ 767 854 | `Root of string * [ `TMethod | `TUnknown ] 768 768 - | `Dot of label_parent * string 769 769 - | `Method of class_signature * MethodName.t ] 855 855 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 856 856 + | `Method of ('lmod, 'lmodty, 'pty) class_signature * MethodName.t ] 770 857 (** @canonical Odoc_model.Paths.Reference.Method.t *) 771 858 772 772 - type instance_variable = 773 773 - [ `Resolved of Resolved_reference.instance_variable 859 859 + type ('lmod, 'lmodty, 'pty) instance_variable = 860 860 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.instance_variable 774 861 | `Root of string * [ `TInstanceVariable | `TUnknown ] 775 775 - | `Dot of label_parent * string 776 776 - | `InstanceVariable of class_signature * InstanceVariableName.t ] 862 862 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 863 863 + | `InstanceVariable of 864 864 + ('lmod, 'lmodty, 'pty) class_signature * InstanceVariableName.t ] 777 865 (** @canonical Odoc_model.Paths.Reference.InstanceVariable.t *) 778 866 779 779 - type label = 780 780 - [ `Resolved of Resolved_reference.label 867 867 + type ('lmod, 'lmodty, 'pty) label = 868 868 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.label 781 869 | `Root of string * [ `TLabel | `TUnknown ] 782 782 - | `Dot of label_parent * string 783 783 - | `Label of label_parent * LabelName.t ] 870 870 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 871 871 + | `Label of ('lmod, 'lmodty, 'pty) label_parent * LabelName.t ] 784 872 (** @canonical Odoc_model.Paths.Reference.Label.t *) 785 873 786 786 - type page = 874 874 + type ('lmod, 'lmodty, 'pty) page = 787 875 [ `Resolved of Resolved_reference.page 788 876 | `Root of string * [ `TPage | `TUnknown ] 789 789 - | `Page_path of hierarchy ] 877 877 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string ] 790 878 (** @canonical Odoc_model.Paths.Reference.Page.t *) 791 879 792 792 - type any = 793 793 - [ `Resolved of Resolved_reference.any 880 880 + type ('lmod, 'lmodty, 'pty) any = 881 881 + [ `Resolved of ('lmod, 'lmodty, 'pty) Resolved_reference.any 794 882 | `Root of string * tag_any 795 795 - | `Dot of label_parent * string 883 883 + | `Dot of ('lmod, 'lmodty, 'pty) label_parent * string 796 884 | `Page_path of hierarchy 797 885 | `Module_path of hierarchy 798 886 | `Asset_path of hierarchy 799 887 | `Any_path of hierarchy 800 800 - | `Module of signature * ModuleName.t 801 801 - | `ModuleType of signature * ModuleTypeName.t 802 802 - | `Type of signature * TypeName.t 803 803 - | `Constructor of fragment_type_parent * ConstructorName.t 804 804 - | `Field of fragment_type_parent * FieldName.t 805 805 - | `UnboxedField of fragment_type_parent * UnboxedFieldName.t 806 806 - | `Extension of signature * ExtensionName.t 807 807 - | `ExtensionDecl of signature * ExtensionName.t 808 808 - | `Exception of signature * ExceptionName.t 809 809 - | `Value of signature * ValueName.t 810 810 - | `Class of signature * TypeName.t 811 811 - | `ClassType of signature * TypeName.t 812 812 - | `Method of class_signature * MethodName.t 813 813 - | `InstanceVariable of class_signature * InstanceVariableName.t 814 814 - | `Label of label_parent * LabelName.t ] 888 888 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 889 889 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t 890 890 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t 891 891 + | `Constructor of 892 892 + ('lmod, 'lmodty, 'pty) fragment_type_parent * ConstructorName.t 893 893 + | `Field of ('lmod, 'lmodty, 'pty) fragment_type_parent * FieldName.t 894 894 + | `UnboxedField of ('lmod, 'lmodty, 'pty) fragment_type_parent * UnboxedFieldName.t 895 895 + | `Extension of ('lmod, 'lmodty, 'pty) signature * ExtensionName.t 896 896 + | `ExtensionDecl of ('lmod, 'lmodty, 'pty) signature * ExtensionName.t 897 897 + | `Exception of ('lmod, 'lmodty, 'pty) signature * ExceptionName.t 898 898 + | `Value of ('lmod, 'lmodty, 'pty) signature * ValueName.t 899 899 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 900 900 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t 901 901 + | `Method of ('lmod, 'lmodty, 'pty) class_signature * MethodName.t 902 902 + | `InstanceVariable of 903 903 + ('lmod, 'lmodty, 'pty) class_signature * InstanceVariableName.t 904 904 + | `Label of ('lmod, 'lmodty, 'pty) label_parent * LabelName.t ] 815 905 (** @canonical Odoc_model.Paths.Reference.t *) 816 906 end = 817 907 Reference ··· 823 913 we define here all those types that ever appear on the right hand 824 914 side of the constructors and then below we redefine many with 825 915 the actual hierarchy made more explicit. *) 826 826 - type datatype = 827 827 - [ `Identifier of Identifier.datatype | `Type of signature * TypeName.t ] 916 916 + type ('lmod, 'lmodty, 'pty) datatype = 917 917 + [ `Identifier of Identifier.datatype 918 918 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 828 919 (** @canonical Odoc_model.Paths.Reference.Resolved.DataType.t *) 829 920 830 830 - and module_ = 921 921 + and ('lmod, 'lmodty, 'pty) module_ = 831 922 [ `Identifier of Identifier.path_module 832 832 - | `Hidden of module_ 833 833 - | `Alias of Resolved_path.module_ * module_ 834 834 - | `Module of signature * ModuleName.t ] 923 923 + | `Hidden of ('lmod, 'lmodty, 'pty) module_ 924 924 + | `Alias of 925 925 + ('lmod, 'lmodty, 'pty) Resolved_path.module_ 926 926 + * ('lmod, 'lmodty, 'pty) module_ 927 927 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t ] 835 928 (** @canonical Odoc_model.Paths.Reference.Resolved.Module.t *) 836 929 837 930 (* Signature is [ module | moduletype ] *) 838 838 - and signature = 931 931 + and ('lmod, 'lmodty, 'pty) signature = 839 932 [ `Identifier of Identifier.signature 840 840 - | `Hidden of module_ 841 841 - | `Alias of Resolved_path.module_ * module_ 842 842 - | `Module of signature * ModuleName.t 843 843 - | `ModuleType of signature * ModuleTypeName.t 844 844 - | `AliasModuleType of Resolved_path.module_type * module_type ] 933 933 + | `Hidden of ('lmod, 'lmodty, 'pty) module_ 934 934 + | `Alias of 935 935 + ('lmod, 'lmodty, 'pty) Resolved_path.module_ 936 936 + * ('lmod, 'lmodty, 'pty) module_ 937 937 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 938 938 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t 939 939 + | `AliasModuleType of 940 940 + ('lmod, 'lmodty, 'pty) Resolved_path.module_type 941 941 + * ('lmod, 'lmodty, 'pty) module_type ] 845 942 (** @canonical Odoc_model.Paths.Reference.Resolved.Signature.t *) 846 943 847 847 - and class_signature = 944 944 + and ('lmod, 'lmodty, 'pty) class_signature = 848 945 [ `Identifier of Identifier.class_signature 849 849 - | `Class of signature * TypeName.t 850 850 - | `ClassType of signature * TypeName.t ] 946 946 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 947 947 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 851 948 (** @canonical Odoc_model.Paths.Reference.Resolved.ClassSignature.t *) 852 949 853 950 (* fragment_type_parent in resolved references is for record fields parent. 854 854 - It’s type (for usual record fields) or [signature] for fields of inline 951 951 + It's type (for usual record fields) or [signature] for fields of inline 855 952 records of extension constructor. *) 856 856 - and field_parent = 953 953 + and ('lmod, 'lmodty, 'pty) field_parent = 857 954 [ `Identifier of Identifier.field_parent 858 858 - | `Alias of Resolved_path.module_ * module_ 859 859 - | `AliasModuleType of Resolved_path.module_type * module_type 860 860 - | `Module of signature * ModuleName.t 861 861 - | `Hidden of module_ 862 862 - | `ModuleType of signature * ModuleTypeName.t 863 863 - | `Type of signature * TypeName.t ] 955 955 + | `Alias of 956 956 + ('lmod, 'lmodty, 'pty) Resolved_path.module_ 957 957 + * ('lmod, 'lmodty, 'pty) module_ 958 958 + | `AliasModuleType of 959 959 + ('lmod, 'lmodty, 'pty) Resolved_path.module_type 960 960 + * ('lmod, 'lmodty, 'pty) module_type 961 961 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 962 962 + | `Hidden of ('lmod, 'lmodty, 'pty) module_ 963 963 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t 964 964 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 864 965 (** @canonical Odoc_model.Paths.Reference.Resolved.FragmentTypeParent.t *) 865 966 866 866 - and unboxed_field_parent = 967 967 + and ('lmod, 'lmodty, 'pty) unboxed_field_parent = 867 968 [ `Identifier of Identifier.unboxed_field_parent 868 868 - | `Type of signature * TypeName.t ] 969 969 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 869 970 (** @canonical Odoc_model.Paths.Reference.Resolved.FragmentTypeParent.t *) 870 971 871 972 (* The only difference between parent and label_parent 872 973 is that the Identifier allows more types *) 873 873 - and label_parent = 974 974 + and ('lmod, 'lmodty, 'pty) label_parent = 874 975 [ `Identifier of Identifier.label_parent 875 875 - | `Alias of Resolved_path.module_ * module_ 876 876 - | `AliasModuleType of Resolved_path.module_type * module_type 877 877 - | `Module of signature * ModuleName.t 878 878 - | `Hidden of module_ 879 879 - | `ModuleType of signature * ModuleTypeName.t 880 880 - | `Class of signature * TypeName.t 881 881 - | `ClassType of signature * TypeName.t 882 882 - | `Type of signature * TypeName.t ] 976 976 + | `Alias of 977 977 + ('lmod, 'lmodty, 'pty) Resolved_path.module_ 978 978 + * ('lmod, 'lmodty, 'pty) module_ 979 979 + | `AliasModuleType of 980 980 + ('lmod, 'lmodty, 'pty) Resolved_path.module_type 981 981 + * ('lmod, 'lmodty, 'pty) module_type 982 982 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 983 983 + | `Hidden of ('lmod, 'lmodty, 'pty) module_ 984 984 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t 985 985 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 986 986 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t 987 987 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 883 988 (** @canonical Odoc_model.Paths.Reference.Resolved.LabelParent.t *) 884 989 885 885 - and module_type = 990 990 + and ('lmod, 'lmodty, 'pty) module_type = 886 991 [ `Identifier of Identifier.reference_module_type 887 887 - | `ModuleType of signature * ModuleTypeName.t 888 888 - | `AliasModuleType of Resolved_path.module_type * module_type ] 992 992 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t 993 993 + | `AliasModuleType of 994 994 + ('lmod, 'lmodty, 'pty) Resolved_path.module_type 995 995 + * ('lmod, 'lmodty, 'pty) module_type ] 889 996 (** @canonical Odoc_model.Paths.Reference.Resolved.ModuleType.t *) 890 997 891 891 - type type_ = 998 998 + type ('lmod, 'lmodty, 'pty) type_ = 892 999 [ `Identifier of Identifier.reference_type 893 893 - | `Type of signature * TypeName.t 894 894 - | `Class of signature * TypeName.t 895 895 - | `ClassType of signature * TypeName.t ] 1000 1000 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t 1001 1001 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 1002 1002 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 896 1003 (** @canonical Odoc_model.Paths.Reference.Resolved.Type.t *) 897 1004 898 898 - type constructor = 1005 1005 + type ('lmod, 'lmodty, 'pty) constructor = 899 1006 [ `Identifier of Identifier.reference_constructor 900 900 - | `Constructor of datatype * ConstructorName.t 901 901 - | `Extension of signature * ExtensionName.t 902 902 - | `Exception of signature * ExceptionName.t ] 1007 1007 + | `Constructor of ('lmod, 'lmodty, 'pty) datatype * ConstructorName.t 1008 1008 + | `Extension of ('lmod, 'lmodty, 'pty) signature * ExtensionName.t 1009 1009 + | `Exception of ('lmod, 'lmodty, 'pty) signature * ExceptionName.t ] 903 1010 (** @canonical Odoc_model.Paths.Reference.Resolved.Constructor.t *) 904 1011 905 905 - type field = 1012 1012 + type ('lmod, 'lmodty, 'pty) field = 906 1013 [ `Identifier of Identifier.reference_field 907 907 - | `Field of field_parent * FieldName.t ] 1014 1014 + | `Field of ('lmod, 'lmodty, 'pty) field_parent * FieldName.t ] 908 1015 (** @canonical Odoc_model.Paths.Reference.Resolved.Field.t *) 909 1016 910 910 - type unboxed_field = 1017 1017 + type ('lmod, 'lmodty, 'pty) unboxed_field = 911 1018 [ `Identifier of Identifier.reference_unboxed_field 912 912 - | `UnboxedField of unboxed_field_parent * UnboxedFieldName.t ] 1019 1019 + | `UnboxedField of ('lmod, 'lmodty, 'pty) unboxed_field_parent * UnboxedFieldName.t ] 913 1020 (** @canonical Odoc_model.Paths.Reference.Resolved.UnboxedField.t *) 914 1021 915 915 - type extension = 1022 1022 + type ('lmod, 'lmodty, 'pty) extension = 916 1023 [ `Identifier of Identifier.reference_extension 917 917 - | `Extension of signature * ExtensionName.t 918 918 - | `Exception of signature * ExceptionName.t ] 1024 1024 + | `Extension of ('lmod, 'lmodty, 'pty) signature * ExtensionName.t 1025 1025 + | `Exception of ('lmod, 'lmodty, 'pty) signature * ExceptionName.t ] 919 1026 (** @canonical Odoc_model.Paths.Reference.Resolved.Extension.t *) 920 1027 921 921 - type extension_decl = 1028 1028 + type ('lmod, 'lmodty, 'pty) extension_decl = 922 1029 [ `Identifier of Identifier.reference_extension_decl 923 1030 | `ExtensionDecl of 924 924 - signature 1031 1031 + ('lmod, 'lmodty, 'pty) signature 925 1032 * ExtensionName.t 926 1033 (* The extension_name used in the url. 927 1034 It is the extension_name of the first constructor of the extension (there is always at least 1). *) 928 1035 * ExtensionName.t (* displayed *) ] 929 1036 (** @canonical Odoc_model.Paths.Reference.Resolved.Extension.t *) 930 1037 931 931 - type exception_ = 1038 1038 + type ('lmod, 'lmodty, 'pty) exception_ = 932 1039 [ `Identifier of Identifier.reference_exception 933 933 - | `Exception of signature * ExceptionName.t ] 1040 1040 + | `Exception of ('lmod, 'lmodty, 'pty) signature * ExceptionName.t ] 934 1041 (** @canonical Odoc_model.Paths.Reference.Resolved.Exception.t *) 935 1042 936 936 - type value = 1043 1043 + type ('lmod, 'lmodty, 'pty) value = 937 1044 [ `Identifier of Identifier.reference_value 938 938 - | `Value of signature * ValueName.t ] 1045 1045 + | `Value of ('lmod, 'lmodty, 'pty) signature * ValueName.t ] 939 1046 (** @canonical Odoc_model.Paths.Reference.Resolved.Value.t *) 940 1047 941 941 - type class_ = 1048 1048 + type ('lmod, 'lmodty, 'pty) class_ = 942 1049 [ `Identifier of Identifier.reference_class 943 943 - | `Class of signature * TypeName.t ] 1050 1050 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 944 1051 (** @canonical Odoc_model.Paths.Reference.Resolved.Class.t *) 945 1052 946 946 - type class_type = 1053 1053 + type ('lmod, 'lmodty, 'pty) class_type = 947 1054 [ `Identifier of Identifier.reference_class_type 948 948 - | `Class of signature * TypeName.t 949 949 - | `ClassType of signature * TypeName.t ] 1055 1055 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 1056 1056 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t ] 950 1057 (** @canonical Odoc_model.Paths.Reference.Resolved.ClassType.t *) 951 1058 952 952 - type method_ = 1059 1059 + type ('lmod, 'lmodty, 'pty) method_ = 953 1060 [ `Identifier of Identifier.reference_method 954 954 - | `Method of class_signature * MethodName.t ] 1061 1061 + | `Method of ('lmod, 'lmodty, 'pty) class_signature * MethodName.t ] 955 1062 (** @canonical Odoc_model.Paths.Reference.Resolved.Method.t *) 956 1063 957 957 - type instance_variable = 1064 1064 + type ('lmod, 'lmodty, 'pty) instance_variable = 958 1065 [ `Identifier of Identifier.reference_instance_variable 959 959 - | `InstanceVariable of class_signature * InstanceVariableName.t ] 1066 1066 + | `InstanceVariable of 1067 1067 + ('lmod, 'lmodty, 'pty) class_signature * InstanceVariableName.t ] 960 1068 (** @canonical Odoc_model.Paths.Reference.Resolved.InstanceVariable.t *) 961 1069 962 962 - type label = 1070 1070 + type ('lmod, 'lmodty, 'pty) label = 963 1071 [ `Identifier of Identifier.reference_label 964 964 - | `Label of label_parent * LabelName.t ] 1072 1072 + | `Label of ('lmod, 'lmodty, 'pty) label_parent * LabelName.t ] 965 1073 (** @canonical Odoc_model.Paths.Reference.Resolved.Label.t *) 966 1074 967 1075 type page = [ `Identifier of Identifier.reference_page ] ··· 970 1078 type asset = [ `Identifier of Identifier.asset_file ] 971 1079 (** @canonical Odoc_model.Paths.Reference.Resolved.Asset.t *) 972 1080 973 973 - type any = 1081 1081 + type ('lmod, 'lmodty, 'pty) any = 974 1082 [ `Identifier of Identifier.any 975 975 - | `Alias of Resolved_path.module_ * module_ 976 976 - | `AliasModuleType of Resolved_path.module_type * module_type 977 977 - | `Module of signature * ModuleName.t 978 978 - | `Hidden of module_ 979 979 - | `ModuleType of signature * ModuleTypeName.t 980 980 - | `Type of signature * TypeName.t 981 981 - | `Constructor of datatype * ConstructorName.t 982 982 - | `PolyConstructor of datatype * ConstructorName.t 983 983 - | `Field of field_parent * FieldName.t 984 984 - | `UnboxedField of unboxed_field_parent * UnboxedFieldName.t 985 985 - | `Extension of signature * ExtensionName.t 986 986 - | `ExtensionDecl of signature * ExtensionName.t * ExtensionName.t 987 987 - | `Exception of signature * ExceptionName.t 988 988 - | `Value of signature * ValueName.t 989 989 - | `Class of signature * TypeName.t 990 990 - | `ClassType of signature * TypeName.t 991 991 - | `Method of class_signature * MethodName.t 992 992 - | `InstanceVariable of class_signature * InstanceVariableName.t 993 993 - | `Label of label_parent * LabelName.t ] 1083 1083 + | `Alias of 1084 1084 + ('lmod, 'lmodty, 'pty) Resolved_path.module_ 1085 1085 + * ('lmod, 'lmodty, 'pty) module_ 1086 1086 + | `AliasModuleType of 1087 1087 + ('lmod, 'lmodty, 'pty) Resolved_path.module_type 1088 1088 + * ('lmod, 'lmodty, 'pty) module_type 1089 1089 + | `Module of ('lmod, 'lmodty, 'pty) signature * ModuleName.t 1090 1090 + | `Hidden of ('lmod, 'lmodty, 'pty) module_ 1091 1091 + | `ModuleType of ('lmod, 'lmodty, 'pty) signature * ModuleTypeName.t 1092 1092 + | `Type of ('lmod, 'lmodty, 'pty) signature * TypeName.t 1093 1093 + | `Constructor of ('lmod, 'lmodty, 'pty) datatype * ConstructorName.t 1094 1094 + | `PolyConstructor of ('lmod, 'lmodty, 'pty) datatype * ConstructorName.t 1095 1095 + | `Field of ('lmod, 'lmodty, 'pty) field_parent * FieldName.t 1096 1096 + | `UnboxedField of ('lmod, 'lmodty, 'pty) unboxed_field_parent * UnboxedFieldName.t 1097 1097 + | `Extension of ('lmod, 'lmodty, 'pty) signature * ExtensionName.t 1098 1098 + | `ExtensionDecl of 1099 1099 + ('lmod, 'lmodty, 'pty) signature * ExtensionName.t * ExtensionName.t 1100 1100 + | `Exception of ('lmod, 'lmodty, 'pty) signature * ExceptionName.t 1101 1101 + | `Value of ('lmod, 'lmodty, 'pty) signature * ValueName.t 1102 1102 + | `Class of ('lmod, 'lmodty, 'pty) signature * TypeName.t 1103 1103 + | `ClassType of ('lmod, 'lmodty, 'pty) signature * TypeName.t 1104 1104 + | `Method of ('lmod, 'lmodty, 'pty) class_signature * MethodName.t 1105 1105 + | `InstanceVariable of 1106 1106 + ('lmod, 'lmodty, 'pty) class_signature * InstanceVariableName.t 1107 1107 + | `Label of ('lmod, 'lmodty, 'pty) label_parent * LabelName.t ] 994 1108 (** @canonical Odoc_model.Paths.Reference.Resolved.t *) 995 1109 end = 996 1110 Resolved_reference

+43 -11

odoc/src/model_desc/paths_desc.ml

reviewed

··· 64 64 65 65 type id_t = Paths.Identifier.t 66 66 67 67 + type rparent = Paths.Path.Resolved.parent 68 68 + 67 69 type tag = Paths.Reference.tag_any 68 70 69 71 let rec identifier : Paths.Identifier.t t = ··· 234 236 | `Substituted m -> C ("`Substituted", (m :> p), path) 235 237 | `SubstitutedMT m -> C ("`SubstitutedMT", (m :> p), path) 236 238 | `SubstitutedT m -> C ("`SubstitutedT", (m :> p), path) 237 237 - | `SubstitutedCT m -> C ("`SubstitutedCT", (m :> p), path)) 239 239 + | `SubstitutedCT m -> C ("`SubstitutedCT", (m :> p), path) 240 240 + | `Module (`Na _, _, _) -> . 241 241 + | `ModuleType (`Na _, _, _) -> . 242 242 + | `Type (`Na _, _, _) -> . 243 243 + | `LocalMod (`Na _) -> . 244 244 + | `LocalModTy (`Na _) -> . 245 245 + | `LocalTy (`Na _) -> . 246 246 + | `LocalVal (`Na _) -> .) 247 247 + 248 248 + and resolved_parent : rparent t = 249 249 + Variant 250 250 + (function 251 251 + | `Module m -> C ("`Module", (m :> rp), resolved_path) 252 252 + | `ModuleType (_, `Na _) -> . 253 253 + | `FragmentRoot (`Na _) -> .) 238 254 239 255 and resolved_path : rp t = 240 256 Variant ··· 248 264 Pair (resolved_path, resolved_path) ) 249 265 | `Hidden x -> C ("`Hidden", (x :> rp), resolved_path) 250 266 | `Module (x1, x2) -> 251 251 - C ("`Module", ((x1 :> rp), x2), Pair (resolved_path, Names.modulename)) 267 267 + C 268 268 + ( "`Module", 269 269 + ((x1 :> rparent), x2), 270 270 + Pair (resolved_parent, Names.modulename) ) 252 271 | `Canonical (x1, x2) -> 253 272 C ("`Canonical", ((x1 :> rp), (x2 :> p)), Pair (resolved_path, path)) 254 273 | `Apply (x1, x2) -> ··· 256 275 ( "`Apply", 257 276 ((x1 :> rp), (x2 :> rp)), 258 277 Pair (resolved_path, resolved_path) ) 259 259 - | `Alias (dest, src) -> 278 278 + | `Alias (dest, src, _) -> 260 279 C ("`Alias", ((dest :> rp), (src :> p)), Pair (resolved_path, path)) 261 280 | `AliasModuleType (x1, x2) -> 262 281 C ··· 267 286 | `ModuleType (x1, x2) -> 268 287 C 269 288 ( "`ModuleType", 270 270 - ((x1 :> rp), x2), 271 271 - Pair (resolved_path, Names.moduletypename) ) 289 289 + ((x1 :> rparent), x2), 290 290 + Pair (resolved_parent, Names.moduletypename) ) 272 291 | `SubstT (x1, x2) -> 273 292 C 274 293 ( "`SubstT", ··· 286 305 Pair (resolved_path, path) ) 287 306 | `OpaqueModuleType x -> C ("`OpaqueModuleType", (x :> rp), resolved_path) 288 307 | `Type (x1, x2) -> 289 289 - C ("`Type", ((x1 :> rp), x2), Pair (resolved_path, Names.typename)) 308 308 + C 309 309 + ( "`Type", 310 310 + ((x1 :> rparent), x2), 311 311 + Pair (resolved_parent, Names.typename) ) 290 312 | `Value (x1, x2) -> 291 291 - C ("`Value", ((x1 :> rp), x2), Pair (resolved_path, Names.valuename)) 313 313 + C 314 314 + ( "`Value", 315 315 + ((x1 :> rparent), x2), 316 316 + Pair (resolved_parent, Names.valuename) ) 292 317 | `Class (x1, x2) -> 293 293 - C ("`Class", ((x1 :> rp), x2), Pair (resolved_path, Names.classname)) 318 318 + C 319 319 + ( "`Class", 320 320 + ((x1 :> rparent), x2), 321 321 + Pair (resolved_parent, Names.classname) ) 294 322 | `ClassType (x1, x2) -> 295 323 C 296 324 ( "`ClassType", 297 297 - ((x1 :> rp), x2), 298 298 - Pair (resolved_path, Names.classtypename) ) 325 325 + ((x1 :> rparent), x2), 326 326 + Pair (resolved_parent, Names.classtypename) ) 299 327 | `Substituted c -> C ("`Substituted", (c :> rp), resolved_path) 300 328 | `SubstitutedMT c -> C ("`SubstitutedMT", (c :> rp), resolved_path) 301 329 | `SubstitutedT c -> C ("`SubstitutedT", (c :> rp), resolved_path) 302 302 - | `SubstitutedCT c -> C ("`SubstitutedCT", (c :> rp), resolved_path)) 330 330 + | `SubstitutedCT c -> C ("`SubstitutedCT", (c :> rp), resolved_path) 331 331 + | `LocalMod (`Na _) -> . 332 332 + | `LocalModTy (`Na _) -> . 333 333 + | `LocalTy (`Na _) -> . 334 334 + | `LocalVal (`Na _) -> .) 303 335 304 336 and hierarchy_reference : Paths.Reference.Hierarchy.t t = 305 337 let tag_page_path =

+4 -4

odoc/src/occurrences/odoc_occurrences.ml

reviewed

··· 4 4 let incr tbl p = 5 5 let open Odoc_model.Paths.Path.Resolved in 6 6 let p = (p :> t) in 7 7 - let id = identifier p in 8 8 - match id with 9 9 - | Some id when (not (is_hidden p)) || include_hidden -> Table.add tbl id 10 10 - | _ -> () 7 7 + match identifier p with 8 8 + | Some id -> 9 9 + if (not (is_hidden p)) || include_hidden then Table.add tbl id 10 10 + | None -> () 11 11 in 12 12 let open Odoc_model.Lang in 13 13 List.iter

+69

odoc/src/odoc/bin/main.ml

reviewed

··· 9 9 open Odoc_odoc 10 10 open Cmdliner 11 11 12 12 + (* Statmemprof-based allocation profiling. 13 13 + Enable with ODOC_STATMEMPROF=<rate> e.g. ODOC_STATMEMPROF=0.001 *) 14 14 + let () = 15 15 + match Sys.getenv_opt "ODOC_STATMEMPROF" with 16 16 + | None -> () 17 17 + | Some rate_str -> 18 18 + let rate = float_of_string rate_str in 19 19 + let sites : (string, int ref) Hashtbl.t = Hashtbl.create 1024 in 20 20 + let total = ref 0 in 21 21 + let frame_of_slot slot = 22 22 + match Printexc.Slot.location slot with 23 23 + | Some l -> 24 24 + Printf.sprintf "%s:%d" l.Printexc.filename l.Printexc.line_number 25 25 + | None -> "?" 26 26 + in 27 27 + let key_of_callstack cs = 28 28 + let slots = Printexc.backtrace_slots cs in 29 29 + match slots with 30 30 + | None -> "<no backtrace>" 31 31 + | Some arr -> 32 32 + let n = min 12 (Array.length arr) in 33 33 + let parts = Array.sub arr 0 n in 34 34 + Stdlib.String.concat " <- " (Array.to_list (Array.map frame_of_slot parts)) 35 35 + in 36 36 + let tracker : (unit, unit) Gc.Memprof.tracker = { 37 37 + alloc_minor = (fun info -> 38 38 + let words = info.size in 39 39 + total := !total + words; 40 40 + let key = key_of_callstack info.callstack in 41 41 + (match Hashtbl.find_opt sites key with 42 42 + | Some r -> r := !r + words 43 43 + | None -> Hashtbl.add sites key (ref words)); 44 44 + None); 45 45 + alloc_major = (fun info -> 46 46 + let words = info.size in 47 47 + total := !total + words; 48 48 + let key = key_of_callstack info.callstack in 49 49 + (match Hashtbl.find_opt sites key with 50 50 + | Some r -> r := !r + words 51 51 + | None -> Hashtbl.add sites key (ref words)); 52 52 + None); 53 53 + promote = (fun () -> None); 54 54 + dealloc_minor = (fun () -> ()); 55 55 + dealloc_major = (fun () -> ()); 56 56 + } in 57 57 + let _profile = 58 58 + Gc.Memprof.start ~sampling_rate:rate ~callstack_size:20 tracker 59 59 + in 60 60 + at_exit (fun () -> 61 61 + Gc.Memprof.stop (); 62 62 + let entries = 63 63 + Hashtbl.fold (fun k v acc -> (k, !v) :: acc) sites [] 64 64 + in 65 65 + let sorted = 66 66 + List.sort ~cmp:(fun (_, a) (_, b) -> compare b a) entries 67 67 + in 68 68 + Printf.eprintf "\n=== Statmemprof results (sampling rate %g) ===\n" rate; 69 69 + Printf.eprintf "Total sampled words: %d (%.0f MB est.)\n" 70 70 + !total 71 71 + (float_of_int !total *. 8.0 /. 1048576.0 /. rate); 72 72 + Printf.eprintf "\nTop 40 allocation sites:\n"; 73 73 + Printf.eprintf "%-120s %10s %6s\n" "Backtrace" "MB est" "%"; 74 74 + Printf.eprintf "%s\n" (Stdlib.String.make 140 '-'); 75 75 + let top = List.filteri ~f:(fun i _ -> i < 40) sorted in 76 76 + List.iter top ~f:(fun (site, words) -> 77 77 + let mb = float_of_int words *. 8.0 /. 1048576.0 /. rate in 78 78 + let pct = 100.0 *. float_of_int words /. float_of_int (max 1 !total) in 79 79 + Printf.eprintf "%-120s %10.1f %5.1f%%\n" site mb pct)) 80 80 + 12 81 (* Load all installed extensions at startup *) 13 82 let () = Sites.Plugins.Extensions.load_all () 14 83

+12 -10

odoc/src/odoc/url.ml

reviewed

··· 29 29 in 30 30 Error (`Msg error) 31 31 | Ok (resolved_reference, _) -> ( 32 32 - match 32 32 + let identifier = 33 33 Odoc_model.Paths.Reference.Resolved.identifier resolved_reference 34 34 - with 34 34 + in 35 35 + match identifier with 36 36 + | None -> 37 37 + Error (`Msg "Could not resolve identifier") 35 38 | Some identifier -> 36 36 - (* We have a valid identifier, we can create the URL *) 37 37 - let url = 38 38 - Odoc_document.Url.from_identifier ~stop_before:false identifier 39 39 - in 40 40 - let href = url_to_string url in 41 41 - print_endline href; 42 42 - Ok () 43 43 - | None -> Error (`Msg "Hidden reference"))) 39 39 + (* We have a valid identifier, we can create the URL *) 40 40 + let url = 41 41 + Odoc_document.Url.from_identifier ~stop_before:false identifier 42 42 + in 43 43 + let href = url_to_string url in 44 44 + print_endline href; 45 45 + Ok ())) 44 46 45 47 let reference_to_url_html { Html_page.html_config = config; _ } root_url = 46 48 let url_to_string url =

+325 -141

odoc/src/xref2/component.ml

reviewed

··· 678 678 fun c ppf i -> 679 679 if c.short_paths then Ident.short_fmt ppf i else Ident.fmt ppf i 680 680 681 681 + let local_mod_fmt c ppf (id : Cpath.lmod) = 682 682 + match id with `Na _ -> . | #Ident.module_ as i -> ident_fmt c ppf i 683 683 + 684 684 + let local_modty_fmt c ppf (id : Cpath.lmodty) = 685 685 + match id with `Na _ -> . | #Ident.module_type as i -> ident_fmt c ppf i 686 686 + 687 687 + let local_ty_fmt c ppf (id : Cpath.lty) = 688 688 + match id with `Na _ -> . | #Ident.type_ as i -> ident_fmt c ppf i 689 689 + 690 690 + let local_val_fmt c ppf (id : Cpath.lval) = 691 691 + match id with `Na _ -> . | #Ident.value as i -> ident_fmt c ppf i 692 692 + 681 693 let rec model_identifier c ppf (p : id) = 682 694 match p.iv with 683 695 | `Root (_, unit_name) -> ··· 1224 1236 config -> Format.formatter -> Cpath.Resolved.module_ -> unit = 1225 1237 fun c ppf p -> 1226 1238 match p with 1227 1227 - | `Local ident -> ident_fmt c ppf ident 1239 1239 + | `LocalMod ident -> local_mod_fmt c ppf ident 1228 1240 | `Apply (p1, p2) -> 1229 1241 Format.fprintf ppf "%a(%a)" (resolved_module_path c) p1 1230 1242 (resolved_module_path c) p2 1231 1231 - | `Gpath p -> Format.fprintf ppf "%a" (model_resolved_path c) (p :> rpath) 1243 1243 + | `Identifier p -> model_identifier c ppf (p :> id) 1232 1244 | `Substituted p -> wrap c "substituted" resolved_module_path ppf p 1233 1245 | `Module (p, m) -> 1234 1246 Format.fprintf ppf "%a.%s" (resolved_parent_path c) p ··· 1240 1252 p2 1241 1253 | `Hidden p1 -> wrap c "hidden" resolved_module_path ppf p1 1242 1254 | `Canonical (p1, p2) -> 1243 1243 - wrap2 c "canonical" resolved_module_path model_path ppf p1 (p2 :> path) 1255 1255 + wrap2 c "canonical" resolved_module_path module_path ppf p1 p2 1244 1256 | `OpaqueModule m -> wrap c "opaquemodule" resolved_module_path ppf m 1245 1257 1246 1258 and module_path : config -> Format.formatter -> Cpath.module_ -> unit = ··· 1249 1261 | `Resolved p -> wrap c "resolved" resolved_module_path ppf p 1250 1262 | `Dot (p, n) -> 1251 1263 Format.fprintf ppf "%a.%a" (module_path c) p ModuleName.fmt n 1252 1252 - | `Module (p, n) -> 1264 1264 + | `Module (_, p, n) -> 1253 1265 Format.fprintf ppf "%a.%a" (resolved_parent_path c) p ModuleName.fmt n 1254 1266 | `Apply (p1, p2) -> 1255 1267 Format.fprintf ppf "%a(%a)" (module_path c) p1 (module_path c) p2 1256 1268 | `Identifier (id, b) -> 1257 1269 wrap2 c "identifier" model_identifier bool ppf (id :> id) b 1258 1258 - | `Local (id, b) -> wrap2 c "local" ident_fmt bool ppf id b 1270 1270 + | `LocalMod id -> wrap c "local" local_mod_fmt ppf id 1259 1271 | `Substituted p -> wrap c "substituted" module_path ppf p 1260 1272 | `Forward s -> wrap c "forward" str ppf s 1261 1273 | `Root r -> wrap c "unresolvedroot" str ppf (ModuleName.to_string r) ··· 1264 1276 config -> Format.formatter -> Cpath.Resolved.module_type -> unit = 1265 1277 fun c ppf p -> 1266 1278 match p with 1267 1267 - | `Local id -> ident_fmt c ppf id 1268 1268 - | `Gpath p -> model_resolved_path c ppf (p :> rpath) 1269 1269 - | `Substituted x -> wrap c "substituted" resolved_module_type_path ppf x 1279 1279 + | `LocalModTy id -> local_modty_fmt c ppf id 1280 1280 + | `Identifier p -> model_identifier c ppf (p :> id) 1281 1281 + | `SubstitutedMT x -> wrap c "substituted" resolved_module_type_path ppf x 1270 1282 | `ModuleType (p, m) -> 1271 1283 Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1272 1284 (ModuleTypeName.to_string m) 1273 1285 | `CanonicalModuleType (m1, m2) -> 1274 1274 - wrap2 c "canonicalt" resolved_module_type_path model_path ppf m1 1275 1275 - (m2 :> path) 1286 1286 + wrap2 c "canonicalt" resolved_module_type_path module_type_path ppf m1 1287 1287 + m2 1276 1288 | `OpaqueModuleType m -> 1277 1289 wrap c "opaquemoduletype" resolved_module_type_path ppf m 1278 1290 | `AliasModuleType (mt1, mt2) -> ··· 1289 1301 | `Resolved p -> wrap c "r" resolved_module_type_path ppf p 1290 1302 | `Identifier (id, b) -> 1291 1303 wrap2 c "identifier" model_identifier bool ppf (id :> id) b 1292 1292 - | `Local (id, b) -> wrap2 c "local" ident_fmt bool ppf id b 1293 1293 - | `Substituted s -> wrap c "substituted" module_type_path ppf s 1304 1304 + | `LocalModTy id -> wrap c "local" local_modty_fmt ppf id 1305 1305 + | `SubstitutedMT s -> wrap c "substituted" module_type_path ppf s 1294 1306 | `DotMT (m, s) -> 1295 1307 Format.fprintf ppf "%a.%a" (module_path c) m ModuleTypeName.fmt s 1296 1296 - | `ModuleType (m, n) -> 1308 1308 + | `ModuleType (_, m, n) -> 1297 1309 Format.fprintf ppf "%a.%a" (resolved_parent_path c) m ModuleTypeName.fmt 1298 1310 n 1299 1311 ··· 1302 1314 fun c ppf p -> 1303 1315 match p with 1304 1316 | `CoreType n -> Format.fprintf ppf "%s" (TypeName.to_string n) 1305 1305 - | `Local id -> ident_fmt c ppf id 1306 1306 - | `Gpath p -> model_resolved_path c ppf (p :> rpath) 1307 1307 - | `Substituted x -> wrap c "substituted" resolved_type_path ppf x 1317 1317 + | `LocalTy id -> local_ty_fmt c ppf id 1318 1318 + | `Identifier p -> model_identifier c ppf (p :> id) 1319 1319 + | `SubstitutedT x -> wrap c "substituted" resolved_type_path ppf x 1320 1320 + | `SubstitutedCT x -> wrap c "substituted" resolved_type_path ppf (x :> Cpath.Resolved.type_) 1308 1321 | `CanonicalType (t1, t2) -> 1309 1309 - wrap2 c "canonicaltype" resolved_type_path model_path ppf t1 1310 1310 - (t2 :> path) 1322 1322 + wrap2 c "canonicaltype" resolved_type_path type_path ppf t1 1323 1323 + t2 1311 1324 | `Class (p, t) -> 1312 1325 Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1313 1326 (TypeName.to_string t) ··· 1325 1338 | `Value (p, t) -> 1326 1339 Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1327 1340 (ValueName.to_string t) 1328 1328 - | `Gpath p -> Format.fprintf ppf "%a" (model_resolved_path c) (p :> rpath) 1341 1341 + | `Identifier p -> model_identifier c ppf (p :> id) 1342 1342 + | `LocalVal id -> local_val_fmt c ppf id 1329 1343 1330 1344 and resolved_parent_path : 1331 1345 config -> Format.formatter -> Cpath.Resolved.parent -> unit = 1332 1346 fun c ppf p -> 1333 1347 match p with 1334 1348 | `Module m -> resolved_module_path c ppf m 1335 1335 - | `ModuleType m -> 1349 1349 + | `ModuleType (m, `U) -> 1336 1350 if c.short_paths then resolved_module_type_path c ppf m 1337 1351 else Format.fprintf ppf ">>%a<<" (resolved_module_type_path c) m 1338 1338 - | `FragmentRoot -> Format.fprintf ppf "FragmentRoot" 1352 1352 + | `FragmentRoot `U -> Format.fprintf ppf "FragmentRoot" 1353 1353 + | `ModuleType (_, `Na _) -> . 1354 1354 + | `FragmentRoot (`Na _) -> . 1339 1355 1340 1356 and type_path : config -> Format.formatter -> Cpath.type_ -> unit = 1341 1357 fun c ppf p -> ··· 1343 1359 | `Resolved r -> wrap c "resolved" resolved_type_path ppf r 1344 1360 | `Identifier (id, b) -> 1345 1361 wrap2 c "identifier" model_identifier bool ppf (id :> id) b 1346 1346 - | `Local (id, b) -> wrap2 c "local" ident_fmt bool ppf id b 1347 1347 - | `Substituted s -> wrap c "substituted" type_path ppf s 1362 1362 + | `LocalTy id -> wrap c "local" local_ty_fmt ppf id 1363 1363 + | `SubstitutedT s -> wrap c "substituted" type_path ppf s 1364 1364 + | `SubstitutedCT s -> wrap c "substituted" class_type_path ppf (s :> Cpath.class_type) 1348 1365 | `DotT (m, s) -> 1349 1366 Format.fprintf ppf "%a.%a" (module_path c) m TypeName.fmt s 1350 1350 - | `Class (p, t) -> 1351 1351 - Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1352 1352 - (TypeName.to_string t) 1353 1353 - | `ClassType (p, t) -> 1354 1354 - Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1355 1355 - (TypeName.to_string t) 1356 1356 - | `Type (p, t) -> 1367 1367 + | `Type (_, p, t) -> 1357 1368 Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1358 1369 (TypeName.to_string t) 1359 1370 ··· 1363 1374 | `Resolved r -> wrap c "resolved" resolved_value_path ppf r 1364 1375 | `DotV (m, s) -> 1365 1376 Format.fprintf ppf "%a.%a" (module_path c) m ValueName.fmt s 1366 1366 - | `Value (p, t) -> 1367 1367 - Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1368 1368 - (ValueName.to_string t) 1377 1377 + | `LocalVal id -> wrap c "local" local_val_fmt ppf id 1369 1378 | `Identifier (id, b) -> 1370 1379 wrap2 c "identifier" model_identifier bool ppf (id :> id) b 1371 1380 ··· 1373 1382 config -> Format.formatter -> Cpath.Resolved.class_type -> unit = 1374 1383 fun c ppf p -> 1375 1384 match p with 1376 1376 - | `Local id -> Format.fprintf ppf "%a" Ident.fmt id 1377 1377 - | `Gpath p -> Format.fprintf ppf "%a" (model_resolved_path c) (p :> rpath) 1378 1378 - | `Substituted s -> wrap c "substituted" resolved_class_type_path ppf s 1385 1385 + | `LocalTy id -> local_ty_fmt c ppf id 1386 1386 + | `Identifier p -> model_identifier c ppf (p :> id) 1387 1387 + | `SubstitutedCT s -> wrap c "substituted" resolved_class_type_path ppf s 1379 1388 | `Class (p, t) -> 1380 1389 Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1381 1390 (TypeName.to_string t) ··· 1389 1398 | `Resolved r -> Format.fprintf ppf "%a" (resolved_class_type_path c) r 1390 1399 | `Identifier (id, b) -> 1391 1400 wrap2 c "identifier" model_identifier bool ppf (id :> id) b 1392 1392 - | `Local (id, b) -> wrap2 c "local" ident_fmt bool ppf id b 1393 1393 - | `Substituted s -> wrap c "substituted" class_type_path ppf s 1401 1401 + | `LocalTy id -> wrap c "local" local_ty_fmt ppf id 1402 1402 + | `SubstitutedCT s -> wrap c "substituted" class_type_path ppf s 1394 1403 | `DotT (m, s) -> 1395 1404 Format.fprintf ppf "%a.%a" (module_path c) m TypeName.fmt s 1396 1396 - | `Class (p, t) -> 1397 1397 - Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1398 1398 - (TypeName.to_string t) 1399 1399 - | `ClassType (p, t) -> 1405 1405 + | `Type (_, p, t) -> 1400 1406 Format.fprintf ppf "%a.%s" (resolved_parent_path c) p 1401 1407 (TypeName.to_string t) 1402 1408 ··· 1431 1437 wrap c "substitutedt" model_path ppf (m :> Odoc_model.Paths.Path.t) 1432 1438 | `SubstitutedCT m -> 1433 1439 wrap c "substitutedct" model_path ppf (m :> Odoc_model.Paths.Path.t) 1440 1440 + | `Module (_, _p, n) -> 1441 1441 + Format.fprintf ppf "%s" (ModuleName.to_string n) 1442 1442 + | `ModuleType (_, _p, n) -> 1443 1443 + Format.fprintf ppf "%s" (ModuleTypeName.to_string n) 1444 1444 + | `Type (_, _p, n) -> 1445 1445 + Format.fprintf ppf "%s" (TypeName.to_string n) 1446 1446 + | `LocalMod (`Na _) -> . 1447 1447 + | `LocalModTy (`Na _) -> . 1448 1448 + | `LocalTy (`Na _) -> . 1449 1449 + | `LocalVal (`Na _) -> . 1450 1450 + 1451 1451 + and model_resolved_parent (c : config) ppf (p : Odoc_model.Paths.Path.Resolved.parent) = 1452 1452 + match p with 1453 1453 + | `Module m -> model_resolved_path c ppf (m :> rpath) 1454 1454 + | `ModuleType (_, `Na _) -> . 1455 1455 + | `FragmentRoot (`Na _) -> . 1434 1456 1435 1457 and model_resolved_path (c : config) ppf (p : rpath) = 1436 1458 let open Odoc_model.Paths.Path.Resolved in ··· 1438 1460 | `CoreType x -> Format.fprintf ppf "%s" (TypeName.to_string x) 1439 1461 | `Identifier id -> Format.fprintf ppf "%a" (model_identifier c) (id :> id) 1440 1462 | `Module (parent, name) -> 1441 1441 - Format.fprintf ppf "%a.%s" (model_resolved_path c) 1442 1442 - (parent :> t) 1463 1463 + Format.fprintf ppf "%a.%s" (model_resolved_parent c) parent 1443 1464 (ModuleName.to_string name) 1444 1465 | `ModuleType (parent, name) -> 1445 1445 - Format.fprintf ppf "%a.%s" (model_resolved_path c) 1446 1446 - (parent :> t) 1466 1466 + Format.fprintf ppf "%a.%s" (model_resolved_parent c) parent 1447 1467 (ModuleTypeName.to_string name) 1448 1468 | `Type (parent, name) -> 1449 1449 - Format.fprintf ppf "%a.%s" (model_resolved_path c) 1450 1450 - (parent :> t) 1469 1469 + Format.fprintf ppf "%a.%s" (model_resolved_parent c) parent 1451 1470 (TypeName.to_string name) 1452 1471 | `Value (parent, name) -> 1453 1453 - Format.fprintf ppf "%a.%s" (model_resolved_path c) 1454 1454 - (parent :> t) 1472 1472 + Format.fprintf ppf "%a.%s" (model_resolved_parent c) parent 1455 1473 (ValueName.to_string name) 1456 1456 - | `Alias (dest, src) -> 1474 1474 + | `Alias (dest, src, _) -> 1457 1475 wrap2r c "alias" model_resolved_path model_path ppf 1458 1476 (dest :> t) 1459 1477 (src :> path) ··· 1488 1506 (p2 :> path) 1489 1507 | `Hidden p -> wrap c "hidden" model_resolved_path ppf (p :> t) 1490 1508 | `Class (parent, name) -> 1491 1491 - Format.fprintf ppf "%a.%s" (model_resolved_path c) 1492 1492 - (parent :> t) 1509 1509 + Format.fprintf ppf "%a.%s" (model_resolved_parent c) parent 1493 1510 (TypeName.to_string name) 1494 1511 | `ClassType (parent, name) -> 1495 1495 - Format.fprintf ppf "%a.%s" (model_resolved_path c) 1496 1496 - (parent :> t) 1512 1512 + Format.fprintf ppf "%a.%s" (model_resolved_parent c) parent 1497 1513 (TypeName.to_string name) 1498 1514 | `OpaqueModule m -> wrap c "opaquemodule" model_resolved_path ppf (m :> t) 1499 1515 | `OpaqueModuleType m -> ··· 1504 1520 | `SubstitutedT m -> wrap c "substitutedt" model_resolved_path ppf (m :> t) 1505 1521 | `SubstitutedCT m -> 1506 1522 wrap c "substitutedct" model_resolved_path ppf (m :> t) 1523 1523 + | `LocalMod (`Na _) -> . 1524 1524 + | `LocalModTy (`Na _) -> . 1525 1525 + | `LocalTy (`Na _) -> . 1526 1526 + | `LocalVal (`Na _) -> . 1507 1527 1508 1528 and model_fragment c ppf (f : Odoc_model.Paths.Fragment.t) = 1509 1529 match f with ··· 1978 1998 let option conv ident_map x = 1979 1999 match x with None -> None | Some x' -> Some (conv ident_map x') 1980 2000 1981 1981 - let identifier lookup map i = 2001 2001 + let identifier_mod lookup map i = 2002 2002 + match lookup i map with 2003 2003 + | x -> `LocalMod x 2004 2004 + | exception Not_found -> `Identifier i 2005 2005 + 2006 2006 + let identifier_modty lookup map i = 1982 2007 match lookup i map with 1983 1983 - | x -> `Local x 2008 2008 + | x -> `LocalModTy x 2009 2009 + | exception Not_found -> `Identifier i 2010 2010 + 2011 2011 + let identifier_ty lookup map i = 2012 2012 + match lookup i map with 2013 2013 + | x -> `LocalTy x 1984 2014 | exception Not_found -> `Identifier i 1985 2015 1986 2016 let find_any_module i ident_map = ··· 1994 2024 Maps.FunctorParameter.find id ident_map.functor_parameters 1995 2025 | _ -> raise Not_found 1996 2026 1997 1997 - let rec resolved_module_path : 2027 2027 + (* Path conversion with sharing: when no identifier in the path maps to a 2028 2028 + local ident, the original path is returned (coerced) without allocation. 2029 2029 + We use physical equality (==) to detect unchanged sub-paths. *) 2030 2030 + 2031 2031 + let rec resolved_parent_path : 2032 2032 + _ -> Odoc_model.Paths.Path.Resolved.parent -> Cpath.Resolved.parent = 2033 2033 + fun ident_map p -> 2034 2034 + match p with 2035 2035 + | `Module m -> 2036 2036 + let m' = resolved_module_path ident_map m in 2037 2037 + if m' == (m :> Cpath.Resolved.module_) then (p :> Cpath.Resolved.parent) 2038 2038 + else `Module m' 2039 2039 + | `ModuleType (_, `Na _) -> . 2040 2040 + | `FragmentRoot (`Na _) -> . 2041 2041 + 2042 2042 + and resolved_module_path : 1998 2043 _ -> Odoc_model.Paths.Path.Resolved.Module.t -> Cpath.Resolved.module_ = 1999 2044 fun ident_map p -> 2000 2000 - let recurse = resolved_module_path ident_map in 2045 2045 + let p_c = (p :> Cpath.Resolved.module_) in 2001 2046 match p with 2002 2047 | `Identifier i -> ( 2003 2003 - match identifier find_any_module ident_map i with 2004 2004 - | `Local l -> `Local l 2005 2005 - | `Identifier _ -> `Gpath p) 2006 2006 - | `Module (p, name) -> `Module (`Module (recurse p), name) 2007 2007 - | `Apply (p1, p2) -> `Apply (recurse p1, recurse p2) 2008 2008 - | `Alias (p1, p2) -> `Alias (recurse p1, module_path ident_map p2, None) 2048 2048 + match identifier_mod find_any_module ident_map i with 2049 2049 + | `LocalMod l -> `LocalMod (l :> Cpath.lmod) 2050 2050 + | `Identifier _ -> `Identifier i) 2051 2051 + | `Module (parent, name) -> 2052 2052 + let parent' = resolved_parent_path ident_map parent in 2053 2053 + if parent' == (parent :> Cpath.Resolved.parent) then p_c 2054 2054 + else `Module (parent', name) 2055 2055 + | `Apply (p1, p2) -> 2056 2056 + let p1' = resolved_module_path ident_map p1 in 2057 2057 + let p2' = resolved_module_path ident_map p2 in 2058 2058 + if p1' == (p1 :> Cpath.Resolved.module_) 2059 2059 + && p2' == (p2 :> Cpath.Resolved.module_) then p_c 2060 2060 + else `Apply (p1', p2') 2061 2061 + | `Alias (p1, p2, _) -> 2062 2062 + let p1' = resolved_module_path ident_map p1 in 2063 2063 + let p2' = module_path ident_map p2 in 2064 2064 + if p1' == (p1 :> Cpath.Resolved.module_) 2065 2065 + && p2' == (p2 :> Cpath.module_) then p_c 2066 2066 + else `Alias (p1', p2', None) 2009 2067 | `Subst (p1, p2) -> 2010 2010 - `Subst (resolved_module_type_path ident_map p1, recurse p2) 2011 2011 - | `Canonical (p1, p2) -> `Canonical (recurse p1, p2) 2012 2012 - | `Hidden p1 -> `Hidden (recurse p1) 2013 2013 - | `OpaqueModule m -> `OpaqueModule (recurse m) 2014 2014 - | `Substituted m -> `Substituted (recurse m) 2068 2068 + let p1' = resolved_module_type_path ident_map p1 in 2069 2069 + let p2' = resolved_module_path ident_map p2 in 2070 2070 + if p1' == (p1 :> Cpath.Resolved.module_type) 2071 2071 + && p2' == (p2 :> Cpath.Resolved.module_) then p_c 2072 2072 + else `Subst (p1', p2') 2073 2073 + | `Canonical (p1, p2) -> 2074 2074 + let p1' = resolved_module_path ident_map p1 in 2075 2075 + let p2' = module_path ident_map p2 in 2076 2076 + if p1' == (p1 :> Cpath.Resolved.module_) 2077 2077 + && p2' == (p2 :> Cpath.module_) then p_c 2078 2078 + else `Canonical (p1', p2') 2079 2079 + | `Hidden p1 -> 2080 2080 + let p1' = resolved_module_path ident_map p1 in 2081 2081 + if p1' == (p1 :> Cpath.Resolved.module_) then p_c 2082 2082 + else `Hidden p1' 2083 2083 + | `OpaqueModule m -> 2084 2084 + let m' = resolved_module_path ident_map m in 2085 2085 + if m' == (m :> Cpath.Resolved.module_) then p_c 2086 2086 + else `OpaqueModule m' 2087 2087 + | `Substituted m -> 2088 2088 + let m' = resolved_module_path ident_map m in 2089 2089 + if m' == (m :> Cpath.Resolved.module_) then p_c 2090 2090 + else `Substituted m' 2091 2091 + | `LocalMod (`Na _) -> . 2015 2092 2016 2093 and resolved_module_type_path : 2017 2094 _ -> 2018 2095 Odoc_model.Paths.Path.Resolved.ModuleType.t -> 2019 2096 Cpath.Resolved.module_type = 2020 2097 fun ident_map p -> 2098 2098 + let p_c = (p :> Cpath.Resolved.module_type) in 2021 2099 match p with 2022 2100 | `Identifier i -> ( 2023 2023 - match identifier Maps.ModuleType.find ident_map.module_types i with 2024 2024 - | `Local l -> `Local l 2025 2025 - | `Identifier _ -> `Gpath p) 2026 2026 - | `ModuleType (p, name) -> 2027 2027 - `ModuleType (`Module (resolved_module_path ident_map p), name) 2101 2101 + match identifier_modty Maps.ModuleType.find ident_map.module_types i with 2102 2102 + | `LocalModTy l -> `LocalModTy (l :> Cpath.lmodty) 2103 2103 + | `Identifier _ -> `Identifier i) 2104 2104 + | `ModuleType (parent, name) -> 2105 2105 + let parent' = resolved_parent_path ident_map parent in 2106 2106 + if parent' == (parent :> Cpath.Resolved.parent) then p_c 2107 2107 + else `ModuleType (parent', name) 2028 2108 | `CanonicalModuleType (p1, p2) -> 2029 2029 - `CanonicalModuleType (resolved_module_type_path ident_map p1, p2) 2109 2109 + let p1' = resolved_module_type_path ident_map p1 in 2110 2110 + let p2' = module_type_path ident_map p2 in 2111 2111 + if p1' == (p1 :> Cpath.Resolved.module_type) 2112 2112 + && p2' == (p2 :> Cpath.module_type) then p_c 2113 2113 + else `CanonicalModuleType (p1', p2') 2030 2114 | `OpaqueModuleType m -> 2031 2031 - `OpaqueModuleType (resolved_module_type_path ident_map m) 2115 2115 + let m' = resolved_module_type_path ident_map m in 2116 2116 + if m' == (m :> Cpath.Resolved.module_type) then p_c 2117 2117 + else `OpaqueModuleType m' 2032 2118 | `AliasModuleType (m1, m2) -> 2033 2033 - `AliasModuleType 2034 2034 - ( resolved_module_type_path ident_map m1, 2035 2035 - resolved_module_type_path ident_map m2 ) 2119 2119 + let m1' = resolved_module_type_path ident_map m1 in 2120 2120 + let m2' = resolved_module_type_path ident_map m2 in 2121 2121 + if m1' == (m1 :> Cpath.Resolved.module_type) 2122 2122 + && m2' == (m2 :> Cpath.Resolved.module_type) then p_c 2123 2123 + else `AliasModuleType (m1', m2') 2036 2124 | `SubstT (p1, p2) -> 2037 2037 - `SubstT 2038 2038 - ( resolved_module_type_path ident_map p1, 2039 2039 - resolved_module_type_path ident_map p2 ) 2040 2040 - | `SubstitutedMT m -> `Substituted (resolved_module_type_path ident_map m) 2125 2125 + let p1' = resolved_module_type_path ident_map p1 in 2126 2126 + let p2' = resolved_module_type_path ident_map p2 in 2127 2127 + if p1' == (p1 :> Cpath.Resolved.module_type) 2128 2128 + && p2' == (p2 :> Cpath.Resolved.module_type) then p_c 2129 2129 + else `SubstT (p1', p2') 2130 2130 + | `SubstitutedMT m -> 2131 2131 + let m' = resolved_module_type_path ident_map m in 2132 2132 + if m' == (m :> Cpath.Resolved.module_type) then p_c 2133 2133 + else `SubstitutedMT m' 2134 2134 + | `LocalModTy (`Na _) -> . 2041 2135 2042 2136 and resolved_type_path : 2043 2137 _ -> Odoc_model.Paths.Path.Resolved.Type.t -> Cpath.Resolved.type_ = 2044 2138 fun ident_map p -> 2139 2139 + let p_c = (p :> Cpath.Resolved.type_) in 2045 2140 match p with 2046 2046 - | `CoreType _ as c -> c 2141 2141 + | `CoreType _ -> p_c 2047 2142 | `Identifier i -> ( 2048 2048 - match identifier Maps.Path.Type.find ident_map.path_types i with 2049 2049 - | `Local l -> `Local l 2050 2050 - | `Identifier _ -> `Gpath p) 2143 2143 + match identifier_ty Maps.Path.Type.find ident_map.path_types i with 2144 2144 + | `LocalTy l -> `LocalTy (l :> Cpath.lty) 2145 2145 + | `Identifier _ -> `Identifier i) 2051 2146 | `CanonicalType (p1, p2) -> 2052 2052 - `CanonicalType (resolved_type_path ident_map p1, p2) 2053 2053 - | `Type (p, name) -> `Type (`Module (resolved_module_path ident_map p), name) 2054 2054 - | `Class (p, name) -> 2055 2055 - `Class (`Module (resolved_module_path ident_map p), name) 2056 2056 - | `ClassType (p, name) -> 2057 2057 - `ClassType (`Module (resolved_module_path ident_map p), name) 2058 2058 - | `SubstitutedT m -> `Substituted (resolved_type_path ident_map m) 2147 2147 + let p1' = resolved_type_path ident_map p1 in 2148 2148 + let p2' = type_path ident_map p2 in 2149 2149 + if p1' == (p1 :> Cpath.Resolved.type_) 2150 2150 + && p2' == (p2 :> Cpath.type_) then p_c 2151 2151 + else `CanonicalType (p1', p2') 2152 2152 + | `Type (parent, name) -> 2153 2153 + let parent' = resolved_parent_path ident_map parent in 2154 2154 + if parent' == (parent :> Cpath.Resolved.parent) then p_c 2155 2155 + else `Type (parent', name) 2156 2156 + | `Class (parent, name) -> 2157 2157 + let parent' = resolved_parent_path ident_map parent in 2158 2158 + if parent' == (parent :> Cpath.Resolved.parent) then p_c 2159 2159 + else `Class (parent', name) 2160 2160 + | `ClassType (parent, name) -> 2161 2161 + let parent' = resolved_parent_path ident_map parent in 2162 2162 + if parent' == (parent :> Cpath.Resolved.parent) then p_c 2163 2163 + else `ClassType (parent', name) 2164 2164 + | `SubstitutedT m -> 2165 2165 + let m' = resolved_type_path ident_map m in 2166 2166 + if m' == (m :> Cpath.Resolved.type_) then p_c 2167 2167 + else `SubstitutedT m' 2059 2168 | `SubstitutedCT m -> 2060 2060 - `Substituted 2061 2061 - (resolved_class_type_path ident_map m :> Cpath.Resolved.type_) 2169 2169 + let m' = resolved_class_type_path ident_map m in 2170 2170 + if m' == (m :> Cpath.Resolved.class_type) then p_c 2171 2171 + else `SubstitutedCT m' 2172 2172 + | `LocalTy (`Na _) -> . 2062 2173 2063 2174 and resolved_value_path : 2064 2175 _ -> Odoc_model.Paths.Path.Resolved.Value.t -> Cpath.Resolved.value = 2065 2176 fun ident_map p -> 2177 2177 + let p_c = (p :> Cpath.Resolved.value) in 2066 2178 match p with 2067 2067 - | `Value (p, name) -> 2068 2068 - `Value (`Module (resolved_module_path ident_map p), name) 2069 2069 - | `Identifier _ -> `Gpath p 2179 2179 + | `Value (parent, name) -> 2180 2180 + let parent' = resolved_parent_path ident_map parent in 2181 2181 + if parent' == (parent :> Cpath.Resolved.parent) then p_c 2182 2182 + else `Value (parent', name) 2183 2183 + | `Identifier _ -> p_c 2184 2184 + | `LocalVal (`Na _) -> . 2070 2185 2071 2186 and resolved_class_type_path : 2072 2187 _ -> 2073 2188 Odoc_model.Paths.Path.Resolved.ClassType.t -> 2074 2189 Cpath.Resolved.class_type = 2075 2190 fun ident_map p -> 2191 2191 + let p_c = (p :> Cpath.Resolved.class_type) in 2076 2192 match p with 2077 2193 | `Identifier i -> ( 2078 2194 match 2079 2079 - identifier Maps.Path.ClassType.find ident_map.path_class_types i 2195 2195 + identifier_ty Maps.Path.ClassType.find ident_map.path_class_types i 2080 2196 with 2081 2081 - | `Local l -> `Local l 2082 2082 - | `Identifier _ -> `Gpath p) 2083 2083 - | `Class (p, name) -> 2084 2084 - `Class (`Module (resolved_module_path ident_map p), name) 2085 2085 - | `ClassType (p, name) -> 2086 2086 - `ClassType (`Module (resolved_module_path ident_map p), name) 2087 2087 - | `SubstitutedCT c -> `Substituted (resolved_class_type_path ident_map c) 2197 2197 + | `LocalTy l -> `LocalTy (l :> Cpath.lty) 2198 2198 + | `Identifier _ -> `Identifier i) 2199 2199 + | `Class (parent, name) -> 2200 2200 + let parent' = resolved_parent_path ident_map parent in 2201 2201 + if parent' == (parent :> Cpath.Resolved.parent) then p_c 2202 2202 + else `Class (parent', name) 2203 2203 + | `ClassType (parent, name) -> 2204 2204 + let parent' = resolved_parent_path ident_map parent in 2205 2205 + if parent' == (parent :> Cpath.Resolved.parent) then p_c 2206 2206 + else `ClassType (parent', name) 2207 2207 + | `SubstitutedCT c -> 2208 2208 + let c' = resolved_class_type_path ident_map c in 2209 2209 + if c' == (c :> Cpath.Resolved.class_type) then p_c 2210 2210 + else `SubstitutedCT c' 2211 2211 + | `LocalTy (`Na _) -> . 2088 2212 2089 2213 and module_path : _ -> Odoc_model.Paths.Path.Module.t -> Cpath.module_ = 2090 2214 fun ident_map p -> 2215 2215 + let p_c = (p :> Cpath.module_) in 2091 2216 match p with 2092 2092 - | `Resolved r -> `Resolved (resolved_module_path ident_map r) 2093 2093 - | `Substituted m -> `Substituted (module_path ident_map m) 2217 2217 + | `Resolved r -> 2218 2218 + let r' = resolved_module_path ident_map r in 2219 2219 + if r' == (r :> Cpath.Resolved.module_) then p_c 2220 2220 + else `Resolved r' 2221 2221 + | `Substituted m -> 2222 2222 + let m' = module_path ident_map m in 2223 2223 + if m' == (m :> Cpath.module_) then p_c 2224 2224 + else `Substituted m' 2094 2225 | `Identifier (i, b) -> ( 2095 2095 - match identifier find_any_module ident_map i with 2096 2096 - | `Identifier i -> `Identifier (i, b) 2097 2097 - | `Local i -> `Local (i, b)) 2098 2098 - | `Dot (path', x) -> `Dot (module_path ident_map path', x) 2226 2226 + match identifier_mod find_any_module ident_map i with 2227 2227 + | `Identifier _ -> p_c 2228 2228 + | `LocalMod i -> `LocalMod (i :> Cpath.lmod)) 2229 2229 + | `Dot (path', x) -> 2230 2230 + let path'' = module_path ident_map path' in 2231 2231 + if path'' == (path' :> Cpath.module_) then p_c 2232 2232 + else `Dot (path'', x) 2099 2233 | `Apply (p1, p2) -> 2100 2100 - `Apply (module_path ident_map p1, module_path ident_map p2) 2101 2101 - | `Forward str -> `Forward str 2102 2102 - | `Root str -> `Root str 2234 2234 + let p1' = module_path ident_map p1 in 2235 2235 + let p2' = module_path ident_map p2 in 2236 2236 + if p1' == (p1 :> Cpath.module_) 2237 2237 + && p2' == (p2 :> Cpath.module_) then p_c 2238 2238 + else `Apply (p1', p2') 2239 2239 + | `Forward _ | `Root _ -> p_c 2240 2240 + | `Module (`Na _, _, _) -> . 2241 2241 + | `LocalMod (`Na _) -> . 2103 2242 2104 2243 and module_type_path : 2105 2244 _ -> Odoc_model.Paths.Path.ModuleType.t -> Cpath.module_type = 2106 2245 fun ident_map p -> 2246 2246 + let p_c = (p :> Cpath.module_type) in 2107 2247 match p with 2108 2108 - | `Resolved r -> `Resolved (resolved_module_type_path ident_map r) 2109 2109 - | `SubstitutedMT m -> `Substituted (module_type_path ident_map m) 2110 2110 - | `Identifier (i, b) -> ( 2111 2111 - match identifier Maps.ModuleType.find ident_map.module_types i with 2112 2112 - | `Identifier i -> `Identifier (i, b) 2113 2113 - | `Local i -> `Local (i, b)) 2114 2114 - | `DotMT (path', x) -> `DotMT (module_path ident_map path', x) 2248 2248 + | `Resolved r -> 2249 2249 + let r' = resolved_module_type_path ident_map r in 2250 2250 + if r' == (r :> Cpath.Resolved.module_type) then p_c 2251 2251 + else `Resolved r' 2252 2252 + | `SubstitutedMT m -> 2253 2253 + let m' = module_type_path ident_map m in 2254 2254 + if m' == (m :> Cpath.module_type) then p_c 2255 2255 + else `SubstitutedMT m' 2256 2256 + | `Identifier (i, _) -> ( 2257 2257 + match identifier_modty Maps.ModuleType.find ident_map.module_types i with 2258 2258 + | `Identifier _ -> p_c 2259 2259 + | `LocalModTy i -> `LocalModTy (i :> Cpath.lmodty)) 2260 2260 + | `DotMT (path', x) -> 2261 2261 + let path'' = module_path ident_map path' in 2262 2262 + if path'' == (path' :> Cpath.module_) then p_c 2263 2263 + else `DotMT (path'', x) 2264 2264 + | `ModuleType (`Na _, _, _) -> . 2265 2265 + | `LocalModTy (`Na _) -> . 2115 2266 2116 2267 and type_path : _ -> Odoc_model.Paths.Path.Type.t -> Cpath.type_ = 2117 2268 fun ident_map p -> 2269 2269 + let p_c = (p :> Cpath.type_) in 2118 2270 match p with 2119 2119 - | `Resolved r -> `Resolved (resolved_type_path ident_map r) 2120 2120 - | `SubstitutedT t -> `Substituted (type_path ident_map t) 2121 2121 - | `Identifier (i, b) -> ( 2122 2122 - match identifier Maps.Path.Type.find ident_map.path_types i with 2123 2123 - | `Identifier i -> `Identifier (i, b) 2124 2124 - | `Local i -> `Local (i, b)) 2125 2125 - | `DotT (path', x) -> `DotT (module_path ident_map path', x) 2271 2271 + | `Resolved r -> 2272 2272 + let r' = resolved_type_path ident_map r in 2273 2273 + if r' == (r :> Cpath.Resolved.type_) then p_c 2274 2274 + else `Resolved r' 2275 2275 + | `SubstitutedT t -> 2276 2276 + let t' = type_path ident_map t in 2277 2277 + if t' == (t :> Cpath.type_) then p_c 2278 2278 + else `SubstitutedT t' 2279 2279 + | `Identifier (i, _) -> ( 2280 2280 + match identifier_ty Maps.Path.Type.find ident_map.path_types i with 2281 2281 + | `Identifier _ -> p_c 2282 2282 + | `LocalTy i -> `LocalTy (i :> Cpath.lty)) 2283 2283 + | `DotT (path', x) -> 2284 2284 + let path'' = module_path ident_map path' in 2285 2285 + if path'' == (path' :> Cpath.module_) then p_c 2286 2286 + else `DotT (path'', x) 2287 2287 + | `Type (`Na _, _, _) -> . 2288 2288 + | `SubstitutedCT _ -> assert false (* shouldn't appear in model type paths *) 2289 2289 + | `LocalTy (`Na _) -> . 2126 2290 2127 2291 and value_path : _ -> Odoc_model.Paths.Path.Value.t -> Cpath.value = 2128 2292 fun ident_map p -> 2293 2293 + let p_c = (p :> Cpath.value) in 2129 2294 match p with 2130 2130 - | `Resolved r -> `Resolved (resolved_value_path ident_map r) 2131 2131 - | `DotV (path', x) -> `DotV (module_path ident_map path', x) 2132 2132 - | `Identifier (i, b) -> `Identifier (i, b) 2295 2295 + | `Resolved r -> 2296 2296 + let r' = resolved_value_path ident_map r in 2297 2297 + if r' == (r :> Cpath.Resolved.value) then p_c 2298 2298 + else `Resolved r' 2299 2299 + | `DotV (path', x) -> 2300 2300 + let path'' = module_path ident_map path' in 2301 2301 + if path'' == (path' :> Cpath.module_) then p_c 2302 2302 + else `DotV (path'', x) 2303 2303 + | `Identifier _ -> p_c 2304 2304 + | `LocalVal (`Na _) -> . 2133 2305 2134 2306 and class_type_path : 2135 2307 _ -> Odoc_model.Paths.Path.ClassType.t -> Cpath.class_type = 2136 2308 fun ident_map p -> 2309 2309 + let p_c = (p :> Cpath.class_type) in 2137 2310 match p with 2138 2138 - | `Resolved r -> `Resolved (resolved_class_type_path ident_map r) 2139 2139 - | `SubstitutedCT c -> `Substituted (class_type_path ident_map c) 2140 2140 - | `Identifier (i, b) -> ( 2311 2311 + | `Resolved r -> 2312 2312 + let r' = resolved_class_type_path ident_map r in 2313 2313 + if r' == (r :> Cpath.Resolved.class_type) then p_c 2314 2314 + else `Resolved r' 2315 2315 + | `SubstitutedCT c -> 2316 2316 + let c' = class_type_path ident_map c in 2317 2317 + if c' == (c :> Cpath.class_type) then p_c 2318 2318 + else `SubstitutedCT c' 2319 2319 + | `Identifier (i, _) -> ( 2141 2320 match 2142 2142 - identifier Maps.Path.ClassType.find ident_map.path_class_types i 2321 2321 + identifier_ty Maps.Path.ClassType.find ident_map.path_class_types i 2143 2322 with 2144 2144 - | `Identifier i -> `Identifier (i, b) 2145 2145 - | `Local i -> `Local (i, b)) 2146 2146 - | `DotT (path', x) -> `DotT (module_path ident_map path', x) 2323 2323 + | `Identifier _ -> p_c 2324 2324 + | `LocalTy i -> `LocalTy (i :> Cpath.lty)) 2325 2325 + | `DotT (path', x) -> 2326 2326 + let path'' = module_path ident_map path' in 2327 2327 + if path'' == (path' :> Cpath.module_) then p_c 2328 2328 + else `DotT (path'', x) 2329 2329 + | `Type (`Na _, _, _) -> . 2330 2330 + | `LocalTy (`Na _) -> . 2147 2331 2148 2332 let rec resolved_signature_fragment : 2149 2333 map ->

-3

odoc/src/xref2/component.mli

reviewed

··· 700 700 701 701 val empty : unit -> map 702 702 703 703 - val identifier : 704 704 - ('a -> 'b -> 'c) -> 'b -> 'a -> [> `Identifier of 'a | `Local of 'c ] 705 705 - 706 703 val resolved_module_path : 707 704 map -> Odoc_model.Paths.Path.Resolved.Module.t -> Cpath.Resolved.module_ 708 705

+98 -220

odoc/src/xref2/cpath.ml

reviewed

··· 1 1 open Odoc_model.Paths 2 2 open Odoc_model.Names 3 3 4 4 + type lmod = [ Ident.module_ | Odoc_model.Paths.na ] 5 5 + type lmodty = [ Ident.module_type | Odoc_model.Paths.na ] 6 6 + type lty = [ Ident.type_ | Odoc_model.Paths.na ] 7 7 + type lval = [ Ident.value | Odoc_model.Paths.na ] 8 8 + type pty = [ `U | Odoc_model.Paths.na ] 9 9 + 4 10 module rec Resolved : sig 5 5 - type parent = 6 6 - [ `Module of module_ | `ModuleType of module_type | `FragmentRoot ] 11 11 + type parent = (lmod, lmodty, pty) Odoc_model.Paths.Path.Resolved.parent_gen 7 12 8 8 - and module_ = 9 9 - [ `Local of Ident.module_ 10 10 - | `Gpath of Path.Resolved.Module.t 11 11 - | `Substituted of module_ 12 12 - | `Subst of module_type * module_ 13 13 - | `Hidden of module_ 14 14 - | `Module of parent * ModuleName.t 15 15 - | `Canonical of module_ * Path.Module.t 16 16 - | `Apply of module_ * module_ 17 17 - | `Alias of module_ * Cpath.module_ * module_ option 18 18 - | `OpaqueModule of module_ ] 13 13 + type module_ = (lmod, lmodty, pty) Odoc_model.Paths.Path.Resolved.Module.gen 19 14 20 20 - and module_type = 21 21 - [ `Local of Ident.module_type 22 22 - | `Substituted of module_type 23 23 - | `Gpath of Path.Resolved.ModuleType.t 24 24 - | `ModuleType of parent * ModuleTypeName.t 25 25 - | `SubstT of module_type * module_type 26 26 - | `AliasModuleType of module_type * module_type 27 27 - | `CanonicalModuleType of module_type * Path.ModuleType.t 28 28 - | `OpaqueModuleType of module_type ] 15 15 + type module_type = 16 16 + (lmod, lmodty, pty) Odoc_model.Paths.Path.Resolved.ModuleType.gen 29 17 30 30 - and type_ = 31 31 - [ `Local of Ident.type_ 32 32 - | `Gpath of Path.Resolved.Type.t 33 33 - | `Substituted of type_ 34 34 - | `CanonicalType of type_ * Path.Type.t 35 35 - | `CoreType of TypeName.t 36 36 - | `Type of parent * TypeName.t 37 37 - | `Class of parent * TypeName.t 38 38 - | `ClassType of parent * TypeName.t ] 18 18 + type type_ = 19 19 + (lmod, lmodty, pty, lty) Odoc_model.Paths.Path.Resolved.Type.gen 39 20 40 40 - and value = 41 41 - [ `Value of parent * ValueName.t | `Gpath of Path.Resolved.Value.t ] 21 21 + type class_type = 22 22 + (lmod, lmodty, pty, lty) Odoc_model.Paths.Path.Resolved.ClassType.gen 42 23 43 43 - and class_type = 44 44 - [ `Local of Ident.type_ 45 45 - | `Substituted of class_type 46 46 - | `Gpath of Path.Resolved.ClassType.t 47 47 - | `Class of parent * TypeName.t 48 48 - | `ClassType of parent * TypeName.t ] 24 24 + type value = 25 25 + (lmod, lmodty, pty, lval) Odoc_model.Paths.Path.Resolved.Value.gen 26 26 + 27 27 + type any = (lmod, lmodty, pty, lty, lval) Odoc_model.Paths.Path.Resolved.gen 49 28 end = 50 29 Resolved 51 30 52 31 and Cpath : sig 53 53 - type module_ = 54 54 - [ `Resolved of Resolved.module_ 55 55 - | `Substituted of module_ 56 56 - | `Local of Ident.module_ * bool 57 57 - | `Identifier of Identifier.Path.Module.t * bool 58 58 - | `Root of ModuleName.t 59 59 - | `Forward of string 60 60 - | `Dot of module_ * ModuleName.t 61 61 - | `Module of Resolved.parent * ModuleName.t (* Like dot, but typed *) 62 62 - | `Apply of module_ * module_ ] 32 32 + type module_ = (lmod, lmodty, pty) Odoc_model.Paths.Path.Module.gen 63 33 64 64 - and module_type = 65 65 - [ `Resolved of Resolved.module_type 66 66 - | `Substituted of module_type 67 67 - | `Local of Ident.module_type * bool 68 68 - | `Identifier of Identifier.ModuleType.t * bool 69 69 - | `DotMT of module_ * ModuleTypeName.t 70 70 - | `ModuleType of Resolved.parent * ModuleTypeName.t ] 34 34 + type module_type = (lmod, lmodty, pty) Odoc_model.Paths.Path.ModuleType.gen 35 35 + 36 36 + type type_ = (lmod, lmodty, pty, lty) Odoc_model.Paths.Path.Type.gen 71 37 72 72 - and type_ = 73 73 - [ `Resolved of Resolved.type_ 74 74 - | `Substituted of type_ 75 75 - | `Local of Ident.type_ * bool 76 76 - | `Identifier of Odoc_model.Paths.Identifier.Path.Type.t * bool 77 77 - | `DotT of module_ * TypeName.t 78 78 - | `Type of Resolved.parent * TypeName.t 79 79 - | `Class of Resolved.parent * TypeName.t 80 80 - | `ClassType of Resolved.parent * TypeName.t ] 38 38 + type class_type = (lmod, lmodty, pty, lty) Odoc_model.Paths.Path.ClassType.gen 81 39 82 82 - and value = 83 83 - [ `Resolved of Resolved.value 84 84 - | `DotV of module_ * ValueName.t 85 85 - | `Value of Resolved.parent * ValueName.t 86 86 - | `Identifier of Identifier.Value.t * bool ] 40 40 + type value = (lmod, lmodty, pty, lval) Odoc_model.Paths.Path.Value.gen 87 41 88 88 - and class_type = 89 89 - [ `Resolved of Resolved.class_type 90 90 - | `Substituted of class_type 91 91 - | `Local of Ident.type_ * bool 92 92 - | `Identifier of Odoc_model.Paths.Identifier.Path.ClassType.t * bool 93 93 - | `DotT of module_ * TypeName.t 94 94 - | `Class of Resolved.parent * TypeName.t 95 95 - | `ClassType of Resolved.parent * TypeName.t ] 42 42 + type any = (lmod, lmodty, pty, lty, lval) Odoc_model.Paths.Path.gen 96 43 end = 97 44 Cpath 98 45 99 46 include Cpath 100 47 48 48 + let hidden_fns : 49 49 + (lmod, lmodty, pty, lty, lval, bool) Odoc_model.Paths.Path.genfn5 = 50 50 + { 51 51 + g = 52 52 + { 53 53 + lmod = 54 54 + (function `LModule (n, _) -> ModuleName.is_hidden n | `Na _ -> .); 55 55 + lmodty = 56 56 + (function 57 57 + | `LModuleType (n, _) -> ModuleTypeName.is_hidden n | `Na _ -> .); 58 58 + pty = (function _ -> false); 59 59 + }; 60 60 + lty = (function `LType (n, _) -> TypeName.is_hidden n | `Na _ -> .); 61 61 + lval = (function `LValue (n, _) -> ValueName.is_hidden n | `Na _ -> .); 62 62 + } 63 63 + 64 64 + let is_hidden : any -> bool = 65 65 + Odoc_model.Paths.Path.is_hidden_gen hidden_fns 66 66 + 67 67 + let is_resolved_hidden : weak_canonical_test:bool -> Resolved.any -> bool = 68 68 + fun ~weak_canonical_test -> 69 69 + Odoc_model.Paths.Path.is_resolved_hidden_gen ~weak_canonical_test hidden_fns 70 70 + 101 71 let rec is_resolved_module_substituted : Resolved.module_ -> bool = function 102 102 - | `Local _ -> false 72 72 + | `LocalMod _ -> false 103 73 | `Substituted _ -> true 104 104 - | `Gpath _ -> false 74 74 + | `Identifier _ -> false 105 75 | `Subst (_a, _) -> false (* is_resolved_module_type_substituted a*) 106 76 | `Hidden a | `Apply (a, _) | `Alias (a, _, _) | `Canonical (a, _) -> 107 77 is_resolved_module_substituted a ··· 110 80 111 81 and is_resolved_parent_substituted = function 112 82 | `Module m -> is_resolved_module_substituted m 113 113 - | `ModuleType m -> is_resolved_module_type_substituted m 114 114 - | `FragmentRoot -> false 83 83 + | `ModuleType (m, `U) -> is_resolved_module_type_substituted m 84 84 + | `FragmentRoot `U -> false 85 85 + | `ModuleType (_, `Na _) -> . 86 86 + | `FragmentRoot (`Na _) -> . 115 87 116 88 and is_resolved_module_type_substituted : Resolved.module_type -> bool = 117 89 function 118 118 - | `Local _ -> false 119 119 - | `Substituted _ -> true 120 120 - | `Gpath _ -> false 90 90 + | `LocalModTy _ -> false 91 91 + | `SubstitutedMT _ -> true 92 92 + | `Identifier _ -> false 121 93 | `ModuleType (a, _) -> is_resolved_parent_substituted a 122 94 | `SubstT _ -> false 123 95 | `AliasModuleType (m1, _) -> is_resolved_module_type_substituted m1 ··· 125 97 is_resolved_module_type_substituted m 126 98 127 99 and is_resolved_type_substituted : Resolved.type_ -> bool = function 128 128 - | `Local _ -> false 100 100 + | `LocalTy _ -> false 129 101 | `CoreType _ -> false 130 130 - | `Substituted _ -> true 131 131 - | `Gpath _ -> false 102 102 + | `SubstitutedT _ -> true 103 103 + | `SubstitutedCT _ -> true 104 104 + | `Identifier _ -> false 132 105 | `CanonicalType (t, _) -> is_resolved_type_substituted t 133 106 | `Type (a, _) | `Class (a, _) | `ClassType (a, _) -> 134 107 is_resolved_parent_substituted a 135 108 136 109 and is_resolved_class_type_substituted : Resolved.class_type -> bool = function 137 137 - | `Local _ -> false 138 138 - | `Substituted _ -> true 139 139 - | `Gpath _ -> false 110 110 + | `LocalTy _ -> false 111 111 + | `SubstitutedCT _ -> true 112 112 + | `Identifier _ -> false 140 113 | `Class (a, _) | `ClassType (a, _) -> is_resolved_parent_substituted a 141 114 142 115 let rec is_module_substituted : module_ -> bool = function 143 116 | `Resolved a -> is_resolved_module_substituted a 144 117 | `Identifier _ -> false 145 145 - | `Local _ -> false 118 118 + | `LocalMod _ -> false 146 119 | `Substituted _ -> true 147 120 | `Dot (a, _) | `Apply (a, _) -> is_module_substituted a 121 121 + | `Module (_, p, _) -> is_resolved_parent_substituted p 148 122 | `Forward _ -> false 149 123 | `Root _ -> false 150 150 - | `Module (a, _) -> is_resolved_parent_substituted a 151 124 152 125 let is_module_type_substituted : module_type -> bool = function 153 126 | `Resolved a -> is_resolved_module_type_substituted a 154 127 | `Identifier _ -> false 155 155 - | `Local _ -> false 156 156 - | `Substituted _ -> true 128 128 + | `LocalModTy _ -> false 129 129 + | `SubstitutedMT _ -> true 157 130 | `DotMT (a, _) -> is_module_substituted a 158 158 - | `ModuleType (a, _) -> is_resolved_parent_substituted a 131 131 + | `ModuleType (_, p, _) -> is_resolved_parent_substituted p 159 132 160 133 let is_type_substituted : type_ -> bool = function 161 134 | `Resolved a -> is_resolved_type_substituted a 162 135 | `Identifier _ -> false 163 163 - | `Local _ -> false 164 164 - | `Substituted _ -> true 136 136 + | `LocalTy _ -> false 137 137 + | `SubstitutedT _ -> true 138 138 + | `SubstitutedCT _ -> true 165 139 | `DotT (a, _) -> is_module_substituted a 166 166 - | `Type (a, _) | `Class (a, _) | `ClassType (a, _) -> 167 167 - is_resolved_parent_substituted a 140 140 + | `Type (_, p, _) -> is_resolved_parent_substituted p 168 141 169 142 let is_class_type_substituted : class_type -> bool = function 170 143 | `Resolved a -> is_resolved_class_type_substituted a 171 144 | `Identifier _ -> false 172 172 - | `Local _ -> false 173 173 - | `Substituted _ -> true 145 145 + | `SubstitutedCT _ -> true 174 146 | `DotT (a, _) -> is_module_substituted a 175 175 - | `Class (a, _) | `ClassType (a, _) -> is_resolved_parent_substituted a 147 147 + | `LocalTy _ -> false 148 148 + | `Type (_, p, _) -> is_resolved_parent_substituted p 176 149 177 150 let rec is_module_forward : module_ -> bool = function 178 151 | `Forward _ -> true 179 152 | `Resolved _ -> false 180 153 | `Root _ -> false 181 154 | `Identifier _ -> false 182 182 - | `Local _ -> false 155 155 + | `LocalMod _ -> false 183 156 | `Substituted p | `Dot (p, _) | `Apply (p, _) -> is_module_forward p 184 184 - | `Module (_, _) -> false 185 185 - 186 186 - let rec is_module_hidden : module_ -> bool = function 187 187 - | `Resolved r -> is_resolved_module_hidden ~weak_canonical_test:false r 188 188 - | `Substituted p | `Dot (p, _) | `Apply (p, _) -> is_module_hidden p 189 189 - | `Identifier (_, b) -> b 190 190 - | `Local (_, b) -> b 191 191 - | `Forward _ -> false 192 192 - | `Root _ -> false 193 193 - | `Module (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p 194 194 - 195 195 - and is_resolved_module_hidden : 196 196 - weak_canonical_test:bool -> Resolved.module_ -> bool = 197 197 - fun ~weak_canonical_test -> 198 198 - let rec inner = function 199 199 - | `Local _ -> false 200 200 - | `Gpath p -> 201 201 - Odoc_model.Paths.Path.Resolved.Module.is_hidden ~weak_canonical_test p 202 202 - | `Hidden _ -> true 203 203 - | `Canonical (_, `Resolved _) -> false 204 204 - | `Canonical (p, _) -> (not weak_canonical_test) && inner p 205 205 - | `Substituted p -> inner p 206 206 - | `Module (p, _) -> is_resolved_parent_hidden ~weak_canonical_test p 207 207 - | `Subst (p1, p2) -> is_resolved_module_type_hidden p1 || inner p2 208 208 - | `Alias (p1, `Resolved p2, _) -> inner p1 && inner p2 209 209 - | `Alias (p1, _p2, _) -> inner p1 210 210 - | `Apply (p1, p2) -> inner p1 || inner p2 211 211 - | `OpaqueModule m -> inner m 212 212 - in 213 213 - inner 214 214 - 215 215 - and is_resolved_parent_hidden : 216 216 - weak_canonical_test:bool -> Resolved.parent -> bool = 217 217 - fun ~weak_canonical_test -> function 218 218 - | `Module m -> is_resolved_module_hidden ~weak_canonical_test m 219 219 - | `ModuleType m -> is_resolved_module_type_hidden m 220 220 - | `FragmentRoot -> false 221 221 - 222 222 - and is_module_type_hidden : module_type -> bool = function 223 223 - | `Resolved r -> is_resolved_module_type_hidden r 224 224 - | `Identifier ({ iv = `ModuleType (_, t); _ }, b) -> 225 225 - b || ModuleTypeName.is_hidden t 226 226 - | `Local (_, b) -> b 227 227 - | `Substituted p -> is_module_type_hidden p 228 228 - | `DotMT (p, _) -> is_module_hidden p 229 229 - | `ModuleType (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p 230 230 - 231 231 - and is_resolved_module_type_hidden : Resolved.module_type -> bool = function 232 232 - | `Local _ -> false 233 233 - | `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t)) 234 234 - | `Substituted p -> is_resolved_module_type_hidden p 235 235 - | `ModuleType (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p 236 236 - | `SubstT (p1, p2) -> 237 237 - is_resolved_module_type_hidden p1 || is_resolved_module_type_hidden p2 238 238 - | `AliasModuleType (p1, p2) -> 239 239 - is_resolved_module_type_hidden p1 || is_resolved_module_type_hidden p2 240 240 - | `CanonicalModuleType (_, `Resolved _) -> false 241 241 - | `CanonicalModuleType (p, _) -> is_resolved_module_type_hidden p 242 242 - | `OpaqueModuleType m -> is_resolved_module_type_substituted m 243 243 - 244 244 - and is_type_hidden : type_ -> bool = function 245 245 - | `Resolved r -> is_resolved_type_hidden r 246 246 - | `Identifier ({ iv = `Type (_, t); _ }, b) -> b || TypeName.is_hidden t 247 247 - | `Identifier ({ iv = `ClassType (_, t); _ }, b) -> b || TypeName.is_hidden t 248 248 - | `Identifier ({ iv = `Class (_, t); _ }, b) -> b || TypeName.is_hidden t 249 249 - | `Local (_, b) -> b 250 250 - | `Substituted p -> is_type_hidden (p :> type_) 251 251 - | `DotT (p, _) -> is_module_hidden p 252 252 - | `Type (p, _) | `Class (p, _) | `ClassType (p, _) -> 253 253 - is_resolved_parent_hidden ~weak_canonical_test:false p 254 254 - 255 255 - and is_resolved_type_hidden : Resolved.type_ -> bool = function 256 256 - | `CoreType n -> TypeName.is_hidden n 257 257 - | `Local _ -> false 258 258 - | `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t)) 259 259 - | `Substituted p -> is_resolved_type_hidden p 260 260 - | `CanonicalType (_, `Resolved _) -> false 261 261 - | `CanonicalType (p, _) -> is_resolved_type_hidden p 262 262 - | `Type (p, _) | `Class (p, _) | `ClassType (p, _) -> 263 263 - is_resolved_parent_hidden ~weak_canonical_test:false p 264 264 - 265 265 - and is_resolved_class_type_hidden : Resolved.class_type -> bool = function 266 266 - | `Local _ -> false 267 267 - | `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t)) 268 268 - | `Substituted p -> is_resolved_class_type_hidden p 269 269 - | `Class (p, _) | `ClassType (p, _) -> 270 270 - is_resolved_parent_hidden ~weak_canonical_test:false p 271 271 - 272 272 - and is_class_type_hidden : class_type -> bool = function 273 273 - | `Resolved r -> is_resolved_class_type_hidden r 274 274 - | `Identifier (_, b) -> b 275 275 - | `Local (_, b) -> b 276 276 - | `Substituted p -> is_class_type_hidden p 277 277 - | `DotT (p, _) -> is_module_hidden p 278 278 - | `Class (p, _) | `ClassType (p, _) -> 279 279 - is_resolved_parent_hidden ~weak_canonical_test:false p 157 157 + | `Module (_, _, _) -> false 280 158 281 159 let rec resolved_module_of_resolved_module_reference : 282 160 Reference.Resolved.Module.t -> Resolved.module_ = function 283 161 | `Module (parent, name) -> 284 162 `Module 285 163 (`Module (resolved_module_of_resolved_signature_reference parent), name) 286 286 - | `Identifier x -> `Gpath (`Identifier x) 164 164 + | `Identifier x -> `Identifier x 287 165 | `Alias (_m1, _m2) -> failwith "gah" 288 166 | `Hidden s -> `Hidden (resolved_module_of_resolved_module_reference s) 289 167 290 168 and resolved_module_of_resolved_signature_reference : 291 169 Reference.Resolved.Signature.t -> Resolved.module_ = function 292 292 - | `Identifier ({ iv = #Identifier.Module.t_pv; _ } as i) -> 293 293 - `Gpath (`Identifier i) 170 170 + | `Identifier ({ iv = #Identifier.Module.t_pv; _ } as i) -> `Identifier i 294 171 | (`Alias _ | `Module _ | `Hidden _) as r' -> 295 172 resolved_module_of_resolved_module_reference r' 296 173 | `ModuleType (_, n) -> ··· 316 193 | _ -> failwith "Not a module reference" 317 194 318 195 let rec unresolve_resolved_module_path : Resolved.module_ -> module_ = function 319 319 - | `Hidden (`Gpath (`Identifier x)) -> `Identifier (x, true) 320 320 - | `Gpath (`Identifier x) -> 196 196 + | `Hidden (`Identifier x) -> `Identifier (x, true) 197 197 + | `Identifier x -> 321 198 let hidden = 322 199 match x.iv with 323 200 | `Module (_, n) -> Odoc_model.Names.ModuleName.is_hidden n 324 201 | _ -> false 325 202 in 326 203 `Identifier (x, hidden) 327 327 - | `Gpath _ as x -> `Resolved x 328 328 - | `Hidden (`Local x) -> `Local (x, true) 329 329 - | `Local x -> `Local (x, false) 204 204 + | `Hidden (`LocalMod x) -> `LocalMod x 205 205 + | `LocalMod x -> `LocalMod x 330 206 | `Substituted x -> unresolve_resolved_module_path x 331 207 | `Subst (_, x) -> unresolve_resolved_module_path x 332 208 | `Hidden x -> unresolve_resolved_module_path x (* should assert false here *) ··· 341 217 and unresolve_module_path : module_ -> module_ = function 342 218 | `Resolved x -> unresolve_resolved_module_path x 343 219 | `Substituted x -> unresolve_module_path x 344 344 - | `Local (_, _) as x -> x 220 220 + | `LocalMod _ as x -> x 345 221 | `Identifier _ as x -> x 346 222 | `Root _ as x -> x 347 223 | `Forward _ as x -> x 348 224 | `Dot (p, x) -> `Dot (unresolve_module_path p, x) 349 349 - | `Module (p, x) -> `Dot (unresolve_resolved_parent_path p, x) 225 225 + | `Module (_, p, x) -> `Dot (unresolve_resolved_parent_path p, x) 350 226 | `Apply (x, y) -> `Apply (unresolve_module_path x, unresolve_module_path y) 351 227 352 228 and unresolve_resolved_module_type_path : Resolved.module_type -> module_type = 353 229 function 354 354 - | (`Local _ | `Gpath _) as p -> `Resolved p 355 355 - | `Substituted x -> unresolve_resolved_module_type_path x 230 230 + | `LocalModTy _ as p -> p 231 231 + | `Identifier x -> `Identifier (x, false) 232 232 + | `SubstitutedMT x -> unresolve_resolved_module_type_path x 356 233 | `ModuleType (p, n) -> `DotMT (unresolve_resolved_parent_path p, n) 357 234 | `SubstT (_, m) -> unresolve_resolved_module_type_path m 358 235 | `AliasModuleType (_, m2) -> unresolve_resolved_module_type_path m2 ··· 361 238 362 239 and unresolve_resolved_parent_path : Resolved.parent -> module_ = function 363 240 | `Module m -> unresolve_resolved_module_path m 364 364 - | `FragmentRoot | `ModuleType _ -> assert false 241 241 + | `FragmentRoot _ | `ModuleType _ -> assert false 365 242 366 243 and unresolve_resolved_type_path : Resolved.type_ -> type_ = function 367 367 - | (`Gpath _ | `Local _ | `CoreType _) as p -> `Resolved p 368 368 - | `Substituted x -> unresolve_resolved_type_path x 244 244 + | (`LocalTy _ | `Identifier _ | `CoreType _) as p -> `Resolved p 245 245 + | `SubstitutedT x -> unresolve_resolved_type_path x 246 246 + | `SubstitutedCT _x -> failwith "unhandled" 369 247 | `CanonicalType (t1, _) -> unresolve_resolved_type_path t1 370 248 | `Type (p, n) -> `DotT (unresolve_resolved_parent_path p, n) 371 249 | `Class (p, n) -> `DotT (unresolve_resolved_parent_path p, n) ··· 373 251 374 252 and unresolve_resolved_class_type_path : Resolved.class_type -> class_type = 375 253 function 376 376 - | (`Local _ | `Gpath _) as p -> `Resolved p 377 377 - | `Substituted x -> unresolve_resolved_class_type_path x 254 254 + | (`LocalTy _ | `Identifier _) as p -> `Resolved p 255 255 + | `SubstitutedCT x -> unresolve_resolved_class_type_path x 378 256 | `Class (p, n) -> `DotT (unresolve_resolved_parent_path p, n) 379 257 | `ClassType (p, n) -> `DotT (unresolve_resolved_parent_path p, n) 380 258 ··· 383 261 | y -> y 384 262 385 263 and unresolve_type_path : type_ -> type_ = function 386 386 - | `Resolved m -> (unresolve_resolved_type_path m :> type_) 264 264 + | `Resolved m -> unresolve_resolved_type_path m 387 265 | y -> y 388 266 389 267 and unresolve_class_type_path : class_type -> class_type = function ··· 415 293 | Some i -> Some (`Resolved i) 416 294 | None -> None) 417 295 | `Substituted p -> original_path_cpath p 418 418 - | `Local _ -> 296 296 + | `LocalMod _ -> 419 297 None 420 298 | `Module _ -> 421 299 None ··· 429 307 match original_path_parent_identifier sg with 430 308 | Some sg' -> Some (`Module (sg', name)) 431 309 | None -> None) 432 432 - | `Root _ -> Some (`Gpath (`Identifier id)) 310 310 + | `Root _ -> Some (`Identifier id) 433 311 | _ -> 434 312 None 435 313

+1 -1

odoc/src/xref2/env.ml

reviewed

··· 730 730 in 731 731 let doc = m.Component.Module.doc in 732 732 let m = Component.Delayed.put_val (Subst.module_ subst m) in 733 733 - let rp = `Gpath (`Identifier identifier) in 733 733 + let rp = `Identifier identifier in 734 734 let p = `Resolved rp in 735 735 let env' = add_module identifier m doc env in 736 736 (env', Subst.add_module ident p rp subst)

+2 -2

odoc/src/xref2/errors.ml

reviewed

··· 254 254 | None -> kind_of_module_cpath b) 255 255 | _ -> None 256 256 257 257 - let rec kind_of_module_type_cpath = function 258 258 - | `Substituted p' -> kind_of_module_type_cpath p' 257 257 + let rec kind_of_module_type_cpath : Cpath.module_type -> kind option = function 258 258 + | `SubstitutedMT p' -> kind_of_module_type_cpath p' 259 259 | `DotMT (p', _) -> kind_of_module_cpath p' 260 260 | _ -> None 261 261

+1 -1

odoc/src/xref2/expand_tools.ml

reviewed

··· 17 17 let env' = 18 18 Env.add_module identifier (Component.Delayed.put_val m) m.doc env 19 19 in 20 20 - let rp = `Gpath (`Identifier identifier) in 20 20 + let rp = `Identifier identifier in 21 21 let p = `Resolved rp in 22 22 let subst = 23 23 Subst.add_module (arg.id :> Ident.module_) p rp Subst.identity

+6

odoc/src/xref2/find.ml

reviewed

··· 73 73 match inner f i.Include.expansion_.items with 74 74 | Some _ as x -> x 75 75 | None -> inner f tl) 76 76 + | Signature.Open o :: tl -> ( 77 77 + match inner f o.Open.expansion.items with 78 78 + | Some _ as x -> x 79 79 + | None -> inner f tl) 76 80 | hd :: tl -> ( match f hd with Some _ as x -> x | None -> inner f tl) 77 81 | [] -> None 78 82 in ··· 82 86 let rec inner f = function 83 87 | Signature.Include i :: tl -> 84 88 inner f i.Include.expansion_.items @ inner f tl 89 89 + | Signature.Open o :: tl -> 90 90 + inner f o.Open.expansion.items @ inner f tl 85 91 | hd :: tl -> ( 86 92 match f hd with Some x -> x :: inner f tl | None -> inner f tl) 87 93 | [] -> []

+59 -43

odoc/src/xref2/lang_of.ml

reviewed

··· 56 56 let rec module_ map (p : Cpath.module_) : Odoc_model.Paths.Path.Module.t = 57 57 match p with 58 58 | `Substituted x -> `Substituted (module_ map x) 59 59 - | `Local (id, b) -> 59 59 + | `LocalMod (`Na _) -> . 60 60 + | `LocalMod (#Ident.module_ as id) -> 60 61 let m = 61 62 try lookup_module map id 62 63 with Not_found -> 63 64 failwith (Format.asprintf "Not_found: %a" Ident.fmt id) 64 65 in 65 66 let hidden = 66 66 - b 67 67 - || 68 67 match m.iv with 69 68 | `Module (_, n) -> Odoc_model.Names.ModuleName.is_hidden n 70 69 | _ -> false ··· 76 75 | `Dot (p, s) -> `Dot (module_ map p, s) 77 76 | `Forward s -> `Forward s 78 77 | `Apply (m1, m2) -> `Apply (module_ map m1, module_ map m2) 79 79 - | `Module (`Module p, n) -> `Dot (`Resolved (resolved_module map p), n) 80 80 - | `Module (_, _) -> failwith "Probably shouldn't happen" 78 78 + | `Module (_, `Module p, n) -> `Dot (`Resolved (resolved_module map p), n) 79 79 + | `Module (_, _, _) -> failwith "Probably shouldn't happen" 81 80 82 81 and module_type map (p : Cpath.module_type) : 83 82 Odoc_model.Paths.Path.ModuleType.t = 84 83 match p with 85 85 - | `Substituted x -> `SubstitutedMT (module_type map x) 84 84 + | `SubstitutedMT x -> `SubstitutedMT (module_type map x) 86 85 | `Identifier 87 86 (({ iv = #Odoc_model.Paths.Identifier.ModuleType.t_pv; _ } as y), b) -> 88 87 `Identifier (y, b) 89 89 - | `Local (id, b) -> 88 88 + | `LocalModTy (`Na _) -> . 89 89 + | `LocalModTy (#Ident.module_type as id) -> 90 90 `Identifier 91 91 ( (try Component.ModuleTypeMap.find id map.module_type 92 92 with Not_found -> 93 93 failwith (Format.asprintf "Not_found: %a" Ident.fmt id)), 94 94 - b ) 94 94 + false ) 95 95 | `Resolved x -> `Resolved (resolved_module_type map x) 96 96 | `DotMT (p, n) -> `DotMT (module_ map p, n) 97 97 - | `ModuleType (`Module p, n) -> `DotMT (`Resolved (resolved_module map p), n) 98 98 - | `ModuleType (_, _) -> failwith "Probably shouldn't happen" 97 97 + | `ModuleType (_, `Module p, n) -> `DotMT (`Resolved (resolved_module map p), n) 98 98 + | `ModuleType (_, _, _) -> failwith "Probably shouldn't happen" 99 99 100 100 and type_ map (p : Cpath.type_) : Odoc_model.Paths.Path.Type.t = 101 101 match p with 102 102 - | `Substituted x -> `SubstitutedT (type_ map x) 102 102 + | `SubstitutedT x -> `SubstitutedT (type_ map x) 103 103 + | `SubstitutedCT x -> `SubstitutedCT (class_type map x) 103 104 | `Identifier 104 105 (({ iv = #Odoc_model.Paths.Identifier.Path.Type.t_pv; _ } as y), b) -> 105 106 `Identifier (y, b) 106 106 - | `Local (id, b) -> `Identifier (Component.TypeMap.find id map.path_type, b) 107 107 + | `LocalTy (`Na _) -> . 108 108 + | `LocalTy (#Ident.type_ as id) -> `Identifier (Component.TypeMap.find id map.path_type, false) 107 109 | `Resolved x -> `Resolved (resolved_type map x) 108 110 | `DotT (p, n) -> `DotT (module_ map p, n) 109 109 - | `Type (`Module p, n) -> `DotT (`Resolved (resolved_module map p), n) 110 110 - | `Class (`Module p, n) -> `DotT (`Resolved (resolved_module map p), n) 111 111 - | `ClassType (`Module p, n) -> `DotT (`Resolved (resolved_module map p), n) 112 112 - | `Type _ | `Class _ | `ClassType _ -> failwith "Probably shouldn't happen" 111 111 + | `Type (_, `Module p, n) -> `DotT (`Resolved (resolved_module map p), n) 112 112 + | `Type (_, _, _) -> failwith "Probably shouldn't happen" 113 113 114 114 and class_type map (p : Cpath.class_type) : Odoc_model.Paths.Path.ClassType.t 115 115 = 116 116 match p with 117 117 - | `Substituted x -> `SubstitutedCT (class_type map x) 117 117 + | `SubstitutedCT x -> `SubstitutedCT (class_type map x) 118 118 | `Identifier 119 119 (({ iv = #Odoc_model.Paths.Identifier.Path.ClassType.t_pv; _ } as y), b) 120 120 -> 121 121 `Identifier (y, b) 122 122 - | `Local (id, b) -> 123 123 - `Identifier (Component.TypeMap.find id map.path_class_type, b) 122 122 + | `LocalTy (`Na _) -> . 123 123 + | `LocalTy (#Ident.type_ as id) -> 124 124 + `Identifier (Component.TypeMap.find id map.path_class_type, false) 124 125 | `Resolved x -> `Resolved (resolved_class_type map x) 125 126 | `DotT (p, n) -> `DotT (module_ map p, n) 126 126 - | `Class (`Module p, n) -> `DotT (`Resolved (resolved_module map p), n) 127 127 - | `ClassType (`Module p, n) -> `DotT (`Resolved (resolved_module map p), n) 128 128 - | `Class _ | `ClassType _ -> failwith "Probably shouldn't happen" 127 127 + | `Type (_, `Module p, n) -> `DotT (`Resolved (resolved_module map p), n) 128 128 + | `Type (_, _, _) -> failwith "Probably shouldn't happen" 129 129 130 130 and resolved_module map (p : Cpath.Resolved.module_) : 131 131 Odoc_model.Paths.Path.Resolved.Module.t = 132 132 match p with 133 133 - | `Local id -> 133 133 + | `LocalMod (`Na _) -> . 134 134 + | `LocalMod (#Ident.module_ as id) -> 134 135 `Identifier 135 136 (try lookup_module map id 136 137 with Not_found -> 137 138 failwith (Format.asprintf "Not_found: %a" Ident.fmt id)) 138 139 | `Substituted x -> `Substituted (resolved_module map x) 139 139 - | `Gpath y -> y 140 140 + | `Identifier y -> `Identifier y 140 141 | `Subst (mty, m) -> 141 142 `Subst (resolved_module_type map mty, resolved_module map m) 142 143 | `Hidden h -> `Hidden (resolved_module map h) 143 144 | `Module (p, n) -> `Module (resolved_parent map p, n) 144 144 - | `Canonical (r, m) -> `Canonical (resolved_module map r, m) 145 145 + | `Canonical (r, m) -> `Canonical (resolved_module map r, module_ map m) 145 146 | `Apply (m1, m2) -> `Apply (resolved_module map m1, resolved_module map m2) 146 146 - | `Alias (m1, m2, _) -> `Alias (resolved_module map m1, module_ map m2) 147 147 + | `Alias (m1, m2, m3opt) -> 148 148 + let m3opt' = match m3opt with 149 149 + | Some m3 -> Some (resolved_module map m3) 150 150 + | None -> None 151 151 + in 152 152 + `Alias (resolved_module map m1, module_ map m2, m3opt') 147 153 | `OpaqueModule m -> `OpaqueModule (resolved_module map m) 148 154 149 149 - and resolved_parent map (p : Cpath.Resolved.parent) = 155 155 + and resolved_parent map (p : Cpath.Resolved.parent) : 156 156 + Odoc_model.Paths.Path.Resolved.parent = 150 157 match p with 151 151 - | `Module m -> resolved_module map m 152 152 - | `ModuleType _ -> failwith "Invalid" 153 153 - | `FragmentRoot -> ( 158 158 + | `Module m -> `Module (resolved_module map m) 159 159 + | `ModuleType (_, `U) -> failwith "Invalid" 160 160 + | `FragmentRoot `U -> ( 154 161 match map.fragment_root with 155 155 - | Some r -> resolved_parent map (r :> Cpath.Resolved.parent) 162 162 + | Some (`Module m) -> resolved_parent map (`Module m) 163 163 + | Some (`ModuleType m) -> resolved_parent map (`ModuleType (m, `U)) 156 164 | None -> failwith "Invalid") 165 165 + | `ModuleType (_, `Na _) -> . 166 166 + | `FragmentRoot (`Na _) -> . 157 167 158 168 and resolved_module_type map (p : Cpath.Resolved.module_type) : 159 169 Odoc_model.Paths.Path.Resolved.ModuleType.t = 160 170 match p with 161 161 - | `Gpath y -> y 162 162 - | `Local id -> 171 171 + | `Identifier y -> `Identifier y 172 172 + | `LocalModTy (`Na _) -> . 173 173 + | `LocalModTy (#Ident.module_type as id) -> 163 174 `Identifier 164 175 (try Component.ModuleTypeMap.find id map.module_type 165 176 with Not_found -> 166 177 failwith (Format.asprintf "Not_found: %a" Ident.fmt id)) 167 178 | `ModuleType (p, name) -> `ModuleType (resolved_parent map p, name) 168 168 - | `Substituted s -> `SubstitutedMT (resolved_module_type map s) 179 179 + | `SubstitutedMT s -> `SubstitutedMT (resolved_module_type map s) 169 180 | `SubstT (p1, p2) -> 170 181 `SubstT (resolved_module_type map p1, resolved_module_type map p2) 171 182 | `AliasModuleType (p1, p2) -> 172 183 `AliasModuleType 173 184 (resolved_module_type map p1, resolved_module_type map p2) 174 185 | `CanonicalModuleType (p1, p2) -> 175 175 - `CanonicalModuleType (resolved_module_type map p1, p2) 186 186 + `CanonicalModuleType (resolved_module_type map p1, module_type map p2) 176 187 | `OpaqueModuleType m -> `OpaqueModuleType (resolved_module_type map m) 177 188 178 189 and resolved_type map (p : Cpath.Resolved.type_) : 179 190 Odoc_model.Paths.Path.Resolved.Type.t = 180 191 match p with 181 192 | `CoreType _ as c -> c 182 182 - | `Gpath y -> y 183 183 - | `Local id -> `Identifier (Component.TypeMap.find id map.path_type) 184 184 - | `CanonicalType (t1, t2) -> `CanonicalType (resolved_type map t1, t2) 193 193 + | `Identifier y -> `Identifier y 194 194 + | `LocalTy (`Na _) -> . 195 195 + | `LocalTy (#Ident.type_ as id) -> `Identifier (Component.TypeMap.find id map.path_type) 196 196 + | `CanonicalType (t1, t2) -> `CanonicalType (resolved_type map t1, type_ map t2) 185 197 | `Type (p, name) -> `Type (resolved_parent map p, name) 186 198 | `Class (p, name) -> `Class (resolved_parent map p, name) 187 199 | `ClassType (p, name) -> `ClassType (resolved_parent map p, name) 188 188 - | `Substituted s -> `SubstitutedT (resolved_type map s) 200 200 + | `SubstitutedT s -> `SubstitutedT (resolved_type map s) 201 201 + | `SubstitutedCT s -> `SubstitutedCT (resolved_class_type map s) 189 202 190 203 and resolved_value map (p : Cpath.Resolved.value) : 191 204 Odoc_model.Paths.Path.Resolved.Value.t = 192 205 match p with 193 206 | `Value (p, name) -> `Value (resolved_parent map p, name) 194 194 - | `Gpath y -> y 207 207 + | `Identifier y -> `Identifier y 208 208 + | `LocalVal (`Na _) -> . 209 209 + | `LocalVal (#Ident.value as _id) -> failwith "resolved_value: LocalVal" 195 210 196 211 and resolved_class_type map (p : Cpath.Resolved.class_type) : 197 212 Odoc_model.Paths.Path.Resolved.ClassType.t = 198 213 match p with 199 199 - | `Gpath y -> y 200 200 - | `Local id -> `Identifier (Component.TypeMap.find id map.path_class_type) 214 214 + | `Identifier y -> `Identifier y 215 215 + | `LocalTy (`Na _) -> . 216 216 + | `LocalTy (#Ident.type_ as id) -> `Identifier (Component.TypeMap.find id map.path_class_type) 201 217 | `Class (p, name) -> `Class (resolved_parent map p, name) 202 218 | `ClassType (p, name) -> `ClassType (resolved_parent map p, name) 203 203 - | `Substituted s -> `SubstitutedCT (resolved_class_type map s) 219 219 + | `SubstitutedCT s -> `SubstitutedCT (resolved_class_type map s) 204 220 205 221 let rec module_fragment : 206 222 maps -> Cfrag.module_ -> Odoc_model.Paths.Fragment.Module.t =

+1 -1

odoc/src/xref2/lang_of.mli

reviewed

··· 22 22 23 23 val resolved_module : maps -> Cpath.Resolved.module_ -> Path.Resolved.Module.t 24 24 25 25 - val resolved_parent : maps -> Cpath.Resolved.parent -> Path.Resolved.Module.t 25 25 + val resolved_parent : maps -> Cpath.Resolved.parent -> Path.Resolved.parent 26 26 27 27 val resolved_module_type : 28 28 maps -> Cpath.Resolved.module_type -> Path.Resolved.ModuleType.t

+21 -8

odoc/src/xref2/link.ml

reviewed

··· 83 83 let self = (self :> Paths.Path.Resolved.t) in 84 84 let hidden_alias = Paths.Path.Resolved.is_hidden self 85 85 and self_canonical = 86 86 - let i = Paths.Path.Resolved.identifier self in 87 87 - i = Some (target :> Paths.Identifier.t) 86 86 + match Paths.Path.Resolved.identifier self with 87 87 + | Some i -> i = (target :> Paths.Identifier.t) 88 88 + | None -> false 88 89 in 89 90 90 91 self_canonical || hidden_alias ··· 99 100 | `Dot (p, _) -> is_forward p 100 101 | `Apply (p1, p2) -> is_forward p1 || is_forward p2 101 102 | `Substituted s -> is_forward s 103 103 + | `Module _ -> false 104 104 + | `LocalMod (`Na _) -> . 102 105 103 106 let rec should_reresolve : Paths.Path.Resolved.t -> bool = 104 107 fun p -> ··· 117 120 | `Apply (x, y) -> 118 121 should_reresolve (x :> t) || should_reresolve (y :> Paths.Path.Resolved.t) 119 122 | `SubstT (x, y) -> should_reresolve (x :> t) || should_reresolve (y :> t) 120 120 - | `Alias (y, x) -> 123 123 + | `Alias (y, x, _) -> 121 124 should_resolve (x :> Paths.Path.t) || should_reresolve (y :> t) 122 125 | `AliasModuleType (x, y) -> 123 126 should_reresolve (x :> t) || should_reresolve (y :> t) ··· 126 129 | `Class (p, _) 127 130 | `ClassType (p, _) 128 131 | `ModuleType (p, _) 129 129 - | `Module (p, _) -> 130 130 - should_reresolve (p :> t) 132 132 + | `Module (p, _) -> ( 133 133 + match p with 134 134 + | `Module m -> should_reresolve (m :> t) 135 135 + | `ModuleType (_, `Na _) -> . 136 136 + | `FragmentRoot (`Na _) -> .) 131 137 | `OpaqueModule m -> should_reresolve (m :> t) 132 138 | `OpaqueModuleType m -> should_reresolve (m :> t) 133 139 | `Substituted m -> should_reresolve (m :> t) 134 140 | `SubstitutedMT m -> should_reresolve (m :> t) 135 141 | `SubstitutedT m -> should_reresolve (m :> t) 136 142 | `SubstitutedCT m -> should_reresolve (m :> t) 143 143 + | `LocalMod (`Na _) -> . 144 144 + | `LocalModTy (`Na _) -> . 145 145 + | `LocalTy (`Na _) -> . 146 146 + | `LocalVal (`Na _) -> . 137 147 138 148 and should_resolve : Paths.Path.t -> bool = 139 149 fun p -> match p with `Resolved p -> should_reresolve p | _ -> true ··· 1031 1041 match equation.Equation.manifest with 1032 1042 | Some (Constr (`Resolved path, params)) 1033 1043 when Paths.Path.Resolved.(is_hidden (path :> t)) 1034 1034 - || Paths.Path.Resolved.(identifier (path :> t)) 1035 1035 - = Some (t.id :> Paths.Identifier.t) -> 1044 1044 + || (match path with 1045 1045 + | `CoreType _ -> false 1046 1046 + | _ -> 1047 1047 + Paths.Path.Resolved.(identifier (path :> t)) 1048 1048 + = Some (t.id :> Paths.Identifier.t)) -> 1036 1049 Some (path, params) 1037 1050 | _ -> None 1038 1051 in ··· 1180 1193 let cp' = Tools.reresolve_type env cp' in 1181 1194 let p = Lang_of.(Path.resolved_type (empty ()) cp') in 1182 1195 if List.mem p visited then raise Loop 1183 1183 - else if Cpath.is_resolved_type_hidden cp' then 1196 1196 + else if Cpath.is_resolved_hidden ~weak_canonical_test:false (cp' :> Cpath.Resolved.any) then 1184 1197 match t.Component.TypeDecl.equation with 1185 1198 | { manifest = Some expr; params; _ } -> ( 1186 1199 try

+3 -3

odoc/src/xref2/ref_tools.ml

reviewed

··· 167 167 Tools.expansion_of_module_type env m 168 168 |> map_error (fun e -> `Parent (`Parent_sig e)) 169 169 >>= Tools.assert_not_functor 170 170 - >>= fun sg -> Ok ((ref :> Resolved.Signature.t), `ModuleType cp, sg) 170 170 + >>= fun sg -> Ok ((ref :> Resolved.Signature.t), `ModuleType (cp, `U), sg) 171 171 172 172 let type_lookup_to_class_signature_lookup = 173 173 let resolved p' cs = Ok ((p' :> Resolved.ClassSignature.t), cs) in ··· 216 216 let of_element env (`Module (id, m)) : t = 217 217 let m = Component.Delayed.get m in 218 218 let id = (id :> Identifier.Path.Module.t) in 219 219 - of_component env m (`Gpath (`Identifier id)) (`Identifier id) 219 219 + of_component env m (`Identifier id) (`Identifier id) 220 220 221 221 let in_env env name = 222 222 match env_lookup_by_name Env.s_module name env with ··· 287 287 (`ModuleType (parent', name))) 288 288 289 289 let of_element env (`ModuleType (id, mt)) : t = 290 290 - of_component env mt (`Gpath (`Identifier id)) (`Identifier id) 290 290 + of_component env mt (`Identifier id) (`Identifier id) 291 291 292 292 let in_env env name = 293 293 env_lookup_by_name Env.s_module_type name env >>= fun e ->

+69 -33

odoc/src/xref2/shape_tools.cppo.ml

reviewed

··· 85 85 shape_of_id env (id :> Odoc_model.Paths.Identifier.NonSrc.t) 86 86 | `Substituted m -> 87 87 shape_of_module_path env m 88 88 + | `Module _ | `LocalMod _ -> None 88 89 89 90 let rec shape_of_kind_path env kind : 90 91 Odoc_model.Paths.Path.t -> Shape.t option = ··· 108 109 | `Forward _ 109 110 | `Dot _ 110 111 | `Root _ 111 111 - | `Apply _ -> None 112 112 + | `Apply _ 113 113 + | `Module _ 114 114 + | `LocalMod _ 115 115 + | `LocalTy _ 116 116 + | `ModuleType _ 117 117 + | `LocalModTy _ 118 118 + | `Type _ 119 119 + | `LocalVal _ -> None 112 120 113 121 module MkId = Identifier.Mk 114 122 ··· 130 138 | _ -> None 131 139 #endif 132 140 141 141 + (* Cache the per-env shape reducer. [Shape_reduce.Make] allocates a lot of 142 142 + internal hashtables; we only want to do that once per env. Since the same 143 143 + env is used for a whole link traversal, caching by physical equality on 144 144 + env hits almost every call. *) 145 145 + type cached_reduce_t = { 146 146 + env : Env.t; 147 147 + #if OCAML_VERSION < (5,2,0) 148 148 + reducer : Shape.t -> Shape.reduction_result; 149 149 + #else 150 150 + reducer : Shape.t -> Shape_reduce.result; 151 151 + #endif 152 152 + } 153 153 + 154 154 + let cached_reduce : cached_reduce_t option ref = ref None 155 155 + 156 156 + let get_reducer env = 157 157 + match !cached_reduce with 158 158 + | Some c when c.env == env -> c.reducer 159 159 + | _ -> 160 160 + #if OCAML_VERSION < (5,2,0) 161 161 + let module Reduce = Shape.Make_reduce (struct 162 162 + type env = unit 163 163 + let fuel = 10 164 164 + let read_unit_shape ~unit_name = 165 165 + match Env.lookup_impl unit_name env with 166 166 + | Some impl -> ( 167 167 + match impl.shape_info with 168 168 + | Some (shape, _) -> Some shape 169 169 + | None -> None) 170 170 + | _ -> None 171 171 + let find_shape _ _ = raise Not_found 172 172 + end) in 173 173 + let reducer query = Reduce.reduce () query in 174 174 + #else 175 175 + let module Reduce = Shape_reduce.Make(struct 176 176 + let fuel = 10 177 177 + let read_unit_shape ~unit_name = 178 178 + match Env.lookup_impl unit_name env with 179 179 + | Some impl -> ( 180 180 + match impl.shape_info with 181 181 + | Some (shape, _) -> Some shape 182 182 + | None -> None) 183 183 + | _ -> None 184 184 + #if defined OXCAML 185 185 + let fuel () = Misc.Maybe_bounded.of_int fuel 186 186 + let projection_rules_for_merlin_enabled = false 187 187 + let fuel_for_compilation_units = fuel 188 188 + let max_shape_reduce_steps_per_variable = fuel 189 189 + let max_compilation_unit_depth = fuel 190 190 + let read_unit_shape ~diagnostics:_ ~unit_name = read_unit_shape ~unit_name 191 191 + #endif 192 192 + end) in 193 193 + let reducer query = Reduce.reduce_for_uid Ocaml_env.empty query in 194 194 + #endif 195 195 + cached_reduce := Some { env; reducer }; 196 196 + reducer 197 197 + 133 198 let lookup_shape : Env.t -> Shape.t -> Identifier.SourceLocation.t option = 134 199 fun env query -> 200 200 + let reducer = get_reducer env in 135 201 #if OCAML_VERSION < (5,2,0) 136 136 - let module Reduce = Shape.Make_reduce (struct 137 137 - type env = unit 138 138 - let fuel = 10 139 139 - let read_unit_shape ~unit_name = 140 140 - match Env.lookup_impl unit_name env with 141 141 - | Some impl -> ( 142 142 - match impl.shape_info with 143 143 - | Some (shape, _) -> Some shape 144 144 - | None -> None) 145 145 - | _ -> None 146 146 - let find_shape _ _ = raise Not_found 147 147 - end) in 148 148 - let result = try Some (Reduce.reduce () query) with Not_found -> None in 202 202 + let result = try Some (reducer query) with Not_found -> None in 149 203 result >>= fun result -> 150 204 result.uid >>= fun uid -> 151 205 #else 152 152 - let module Reduce = Shape_reduce.Make(struct 153 153 - let fuel = 10 154 154 - let read_unit_shape ~unit_name = 155 155 - match Env.lookup_impl unit_name env with 156 156 - | Some impl -> ( 157 157 - match impl.shape_info with 158 158 - | Some (shape, _) -> Some shape 159 159 - | None -> None) 160 160 - | _ -> None 161 161 - #if defined OXCAML 162 162 - let fuel () = Misc.Maybe_bounded.of_int fuel 163 163 - let projection_rules_for_merlin_enabled = false 164 164 - let fuel_for_compilation_units = fuel 165 165 - let max_shape_reduce_steps_per_variable = fuel 166 166 - let max_compilation_unit_depth = fuel 167 167 - let read_unit_shape ~diagnostics:_ ~unit_name = read_unit_shape ~unit_name 168 168 - #endif 169 169 - end) in 170 170 - let result = try Some (Reduce.reduce_for_uid Ocaml_env.empty query) with Not_found -> None in 206 206 + let result = try Some (reducer query) with Not_found -> None in 171 207 result >>= traverse_aliases >>= fun uid -> 172 208 #endif 173 209 unit_of_uid uid >>= fun unit_name ->

+747 -430

odoc/src/xref2/subst.ml

reviewed

··· 29 29 unresolve_opaque_paths = false; 30 30 } 31 31 32 32 + let is_identity s = 33 33 + ModuleMap.is_empty s.module_ 34 34 + && ModuleTypeMap.is_empty s.module_type 35 35 + && ModuleTypeMap.is_empty s.module_type_replacement 36 36 + && TypeMap.is_empty s.type_ 37 37 + && TypeMap.is_empty s.class_type 38 38 + && TypeMap.is_empty s.type_replacement 39 39 + && s.path_invalidating_modules = [] 40 40 + && not s.unresolve_opaque_paths 41 41 + 32 42 let pp fmt s = 33 43 let pp_map pp_binding b fmt map = 34 44 let pp_b fmt (id, v) = ··· 209 219 t -> Cpath.Resolved.module_ -> Cpath.Resolved.module_ = 210 220 fun s p -> 211 221 match p with 212 212 - | `Local id -> ( 222 222 + | `LocalMod (`Na _) -> . 223 223 + | `LocalMod (#Ident.module_ as id) -> ( 213 224 if List.mem id s.path_invalidating_modules then raise Invalidated; 214 225 match 215 215 - try Some (ModuleMap.find (id :> Ident.module_) s.module_) 226 226 + try Some (ModuleMap.find id s.module_) 216 227 with _ -> None 217 228 with 218 218 - | Some (`Renamed x) -> `Local x 229 229 + | Some (`Renamed x) -> `LocalMod (x :> Cpath.lmod) 219 230 | Some (`Prefixed (_p, rp)) -> rp 220 231 | Some `Substituted -> `Substituted p 221 232 | None -> p) 222 222 - | `Gpath _ -> p 233 233 + | `Identifier _ -> p 223 234 | `Apply (p1, p2) -> 224 224 - `Apply (resolved_module_path s p1, resolved_module_path s p2) 225 225 - | `Substituted p -> `Substituted (resolved_module_path s p) 226 226 - | `Module (p, n) -> `Module (resolved_parent_path s p, n) 235 235 + let p1' = resolved_module_path s p1 in 236 236 + let p2' = resolved_module_path s p2 in 237 237 + if p1' == p1 && p2' == p2 then p 238 238 + else `Apply (p1', p2') 239 239 + | `Substituted m -> 240 240 + let m' = resolved_module_path s m in 241 241 + if m' == m then p else `Substituted m' 242 242 + | `Module (parent, n) -> 243 243 + let parent' = resolved_parent_path s parent in 244 244 + if parent' == parent then p else `Module (parent', n) 227 245 | `Alias (p1, p2, p3opt) -> 246 246 + let p1' = resolved_module_path s p1 in 228 247 let p2' = module_path s p2 in 229 248 let up2' = try Cpath.unresolve_module_path p2' with _ -> p2' in 230 249 let p3opt' = ··· 232 251 | Some p3 -> Some (resolved_module_path s p3) 233 252 | None -> None 234 253 in 235 235 - `Alias (resolved_module_path s p1, up2', p3opt') 254 254 + if p1' == p1 && up2' == p2 && p3opt' == p3opt then p 255 255 + else `Alias (p1', up2', p3opt') 236 256 | `Subst (p1, p2) -> 237 237 - let p1 = 257 257 + let p1' = 238 258 match resolved_module_type_path s p1 with 239 239 - | Replaced _ -> 240 240 - (* the left hand side of Subst is a named module type inside a module, 241 241 - it cannot be substituted away *) 242 242 - assert false 243 243 - | Not_replaced p1 -> p1 259 259 + | Replaced _ -> assert false 260 260 + | Not_replaced p1' -> p1' 244 261 in 245 245 - `Subst (p1, resolved_module_path s p2) 246 246 - | `Hidden p1 -> `Hidden (resolved_module_path s p1) 247 247 - | `Canonical (p1, p2) -> `Canonical (resolved_module_path s p1, p2) 262 262 + let p2' = resolved_module_path s p2 in 263 263 + if p1' == p1 && p2' == p2 then p else `Subst (p1', p2') 264 264 + | `Hidden p1 -> 265 265 + let p1' = resolved_module_path s p1 in 266 266 + if p1' == p1 then p else `Hidden p1' 267 267 + | `Canonical (p1, p2) -> 268 268 + let p1' = resolved_module_path s p1 in 269 269 + if p1' == p1 then p else `Canonical (p1', p2) 248 270 | `OpaqueModule m -> 249 271 if s.unresolve_opaque_paths then raise Invalidated 250 250 - else `OpaqueModule (resolved_module_path s m) 272 272 + else 273 273 + let m' = resolved_module_path s m in 274 274 + if m' == m then p else `OpaqueModule m' 251 275 252 252 - and resolved_parent_path s = function 253 253 - | `Module m -> `Module (resolved_module_path s m) 254 254 - | `ModuleType m -> 255 255 - let p = 256 256 - match resolved_module_type_path s m with 257 257 - | Replaced _ -> assert false 258 258 - | Not_replaced p1 -> p1 259 259 - in 260 260 - `ModuleType p 261 261 - | `FragmentRoot as x -> x 276 276 + and resolved_parent_path s p = 277 277 + match p with 278 278 + | `Module m -> 279 279 + let m' = resolved_module_path s m in 280 280 + if m' == m then p else `Module m' 281 281 + | `ModuleType (m, `U) -> ( 282 282 + match resolved_module_type_path s m with 283 283 + | Replaced _ -> assert false 284 284 + | Not_replaced m' -> 285 285 + if m' == m then p else `ModuleType (m', `U)) 286 286 + | `FragmentRoot `U -> p 287 287 + | `ModuleType (_, `Na _) -> . 288 288 + | `FragmentRoot (`Na _) -> . 262 289 263 290 and module_path : t -> Cpath.module_ -> Cpath.module_ = 264 291 fun s p -> 265 292 match p with 266 293 | `Resolved p' -> ( 267 267 - try `Resolved (resolved_module_path s p') 294 294 + try 295 295 + let p'' = resolved_module_path s p' in 296 296 + if p'' == p' then p else `Resolved p'' 268 297 with Invalidated -> 269 298 let path' = Cpath.unresolve_resolved_module_path p' in 270 299 module_path s path') 271 271 - | `Dot (p', str) -> `Dot (module_path s p', str) 272 272 - | `Module (p', str) -> `Module (resolved_parent_path s p', str) 273 273 - | `Apply (p1, p2) -> `Apply (module_path s p1, module_path s p2) 274 274 - | `Local (id, b) -> ( 300 300 + | `Dot (p', str) -> 301 301 + let p'' = module_path s p' in 302 302 + if p'' == p' then p else `Dot (p'', str) 303 303 + | `Module (_, p', str) -> `Module (`U, resolved_parent_path s p', str) 304 304 + | `Apply (p1, p2) -> 305 305 + let p1' = module_path s p1 in 306 306 + let p2' = module_path s p2 in 307 307 + if p1' == p1 && p2' == p2 then p else `Apply (p1', p2') 308 308 + | `LocalMod (`Na _) -> . 309 309 + | `LocalMod (#Ident.module_ as id) -> ( 275 310 match 276 276 - try Some (ModuleMap.find (id :> Ident.module_) s.module_) 311 311 + try Some (ModuleMap.find id s.module_) 277 312 with _ -> None 278 313 with 279 314 | Some (`Prefixed (p, _rp)) -> p 280 280 - | Some (`Renamed x) -> `Local (x, b) 315 315 + | Some (`Renamed x) -> `LocalMod (x :> Cpath.lmod) 281 316 | Some `Substituted -> `Substituted p 282 282 - | None -> `Local (id, b)) 317 317 + | None -> p) 283 318 | `Identifier _ -> p 284 284 - | `Substituted p -> `Substituted (module_path s p) 319 319 + | `Substituted m -> 320 320 + let m' = module_path s m in 321 321 + if m' == m then p else `Substituted m' 285 322 | `Forward _ -> p 286 323 | `Root _ -> p 287 324 ··· 291 328 (Cpath.Resolved.module_type, ModuleType.expr) or_replaced = 292 329 fun s p -> 293 330 match p with 294 294 - | `Local id -> ( 331 331 + | `LocalModTy (`Na _) -> . 332 332 + | `LocalModTy (#Ident.module_type as id) -> ( 295 333 if ModuleTypeMap.mem id s.module_type_replacement then 296 334 Replaced (ModuleTypeMap.find id s.module_type_replacement) 297 335 else 298 336 match ModuleTypeMap.find id s.module_type with 299 337 | `Prefixed (_p, rp) -> Not_replaced rp 300 300 - | `Renamed x -> Not_replaced (`Local x) 301 301 - | exception Not_found -> Not_replaced (`Local id)) 302 302 - | `Gpath _ -> Not_replaced p 303 303 - | `Substituted p -> 304 304 - resolved_module_type_path s p |> map_replaced (fun p -> `Substituted p) 305 305 - | `ModuleType (p, n) -> 306 306 - Not_replaced (`ModuleType (resolved_parent_path s p, n)) 338 338 + | `Renamed x -> Not_replaced (`LocalModTy (x :> Cpath.lmodty)) 339 339 + | exception Not_found -> Not_replaced (`LocalModTy (id :> Cpath.lmodty))) 340 340 + | `Identifier _ -> Not_replaced p 341 341 + | `SubstitutedMT m -> ( 342 342 + match resolved_module_type_path s m with 343 343 + | Not_replaced m' -> 344 344 + if m' == m then Not_replaced p else Not_replaced (`SubstitutedMT m') 345 345 + | Replaced _ as r -> r) 346 346 + | `ModuleType (parent, n) -> 347 347 + let parent' = resolved_parent_path s parent in 348 348 + if parent' == parent then Not_replaced p 349 349 + else Not_replaced (`ModuleType (parent', n)) 307 350 | `CanonicalModuleType (mt1, mt2) -> ( 308 351 match resolved_module_type_path s mt1 with 309 309 - | Not_replaced mt1' -> Not_replaced (`CanonicalModuleType (mt1', mt2)) 352 352 + | Not_replaced mt1' -> 353 353 + if mt1' == mt1 then Not_replaced p 354 354 + else Not_replaced (`CanonicalModuleType (mt1', mt2)) 310 355 | x -> x) 311 356 | `OpaqueModuleType m -> 312 357 if s.unresolve_opaque_paths then raise Invalidated 313 313 - else 314 314 - resolved_module_type_path s m 315 315 - |> map_replaced (fun x -> `OpaqueModuleType x) 358 358 + else ( 359 359 + match resolved_module_type_path s m with 360 360 + | Not_replaced m' -> 361 361 + if m' == m then Not_replaced p 362 362 + else Not_replaced (`OpaqueModuleType m') 363 363 + | Replaced _ as r -> r) 316 364 | `SubstT (p1, p2) -> ( 317 365 match 318 366 (resolved_module_type_path s p1, resolved_module_type_path s p2) 319 367 with 320 320 - | Not_replaced p1, Not_replaced p2 -> Not_replaced (`SubstT (p1, p2)) 368 368 + | Not_replaced p1', Not_replaced p2' -> 369 369 + if p1' == p1 && p2' == p2 then Not_replaced p 370 370 + else Not_replaced (`SubstT (p1', p2')) 321 371 | Replaced mt, _ | _, Replaced mt -> Replaced mt) 322 372 | `AliasModuleType (p1, p2) -> ( 323 373 match 324 374 (resolved_module_type_path s p1, resolved_module_type_path s p2) 325 375 with 326 326 - | Not_replaced p1, Not_replaced p2 -> 327 327 - Not_replaced (`AliasModuleType (p1, p2)) 376 376 + | Not_replaced p1', Not_replaced p2' -> 377 377 + if p1' == p1 && p2' == p2 then Not_replaced p 378 378 + else Not_replaced (`AliasModuleType (p1', p2')) 328 379 | Replaced mt, _ | _, Replaced mt -> Replaced mt) 329 380 330 381 and module_type_path : ··· 332 383 fun s p -> 333 384 match p with 334 385 | `Resolved r -> ( 335 335 - try resolved_module_type_path s r |> map_replaced (fun r -> `Resolved r) 386 386 + try 387 387 + match resolved_module_type_path s r with 388 388 + | Not_replaced r' -> 389 389 + if r' == r then Not_replaced p 390 390 + else Not_replaced (`Resolved r') 391 391 + | Replaced _ as x -> x 336 392 with Invalidated -> 337 393 let path' = Cpath.unresolve_resolved_module_type_path r in 338 394 module_type_path s path') 339 339 - | `Substituted p -> 340 340 - module_type_path s p |> map_replaced (fun r -> `Substituted r) 341 341 - | `Local (id, b) -> 395 395 + | `SubstitutedMT m -> ( 396 396 + match module_type_path s m with 397 397 + | Not_replaced m' -> 398 398 + if m' == m then Not_replaced p 399 399 + else Not_replaced (`SubstitutedMT m') 400 400 + | Replaced _ as r -> r) 401 401 + | `LocalModTy (`Na _) -> . 402 402 + | `LocalModTy (#Ident.module_type as id) -> 342 403 if ModuleTypeMap.mem id s.module_type_replacement then 343 404 Replaced (ModuleTypeMap.find id s.module_type_replacement) 344 405 else ··· 347 408 try Some (ModuleTypeMap.find id s.module_type) with _ -> None 348 409 with 349 410 | Some (`Prefixed (p, _rp)) -> p 350 350 - | Some (`Renamed x) -> `Local (x, b) 351 351 - | None -> `Local (id, b) 411 411 + | Some (`Renamed x) -> `LocalModTy (x :> Cpath.lmodty) 412 412 + | None -> p 352 413 in 353 414 Not_replaced r 354 415 | `Identifier _ -> Not_replaced p 355 355 - | `DotMT (p, n) -> Not_replaced (`DotMT (module_path s p, n)) 356 356 - | `ModuleType (p', str) -> 357 357 - Not_replaced (`ModuleType (resolved_parent_path s p', str)) 416 416 + | `DotMT (m, n) -> 417 417 + let m' = module_path s m in 418 418 + if m' == m then Not_replaced p 419 419 + else Not_replaced (`DotMT (m', n)) 420 420 + | `ModuleType (_, p', str) -> 421 421 + Not_replaced (`ModuleType (`U, resolved_parent_path s p', str)) 358 422 359 423 and resolved_type_path : 360 424 t -> ··· 362 426 (Cpath.Resolved.type_, TypeExpr.t * TypeDecl.Equation.t) or_replaced = 363 427 fun s p -> 364 428 match p with 365 365 - | `CoreType _ as c -> Not_replaced c 366 366 - | `Local id -> ( 429 429 + | `CoreType _ -> Not_replaced p 430 430 + | `LocalTy (`Na _) -> . 431 431 + | `LocalTy (#Ident.type_ as id) -> ( 367 432 if TypeMap.mem id s.type_replacement then 368 433 Replaced (TypeMap.find id s.type_replacement) 369 434 else 370 435 match try Some (TypeMap.find id s.type_) with Not_found -> None with 371 436 | Some (`Prefixed (_p, rp)) -> Not_replaced rp 372 372 - | Some (`Renamed x) -> Not_replaced (`Local x) 373 373 - | None -> Not_replaced (`Local id)) 437 437 + | Some (`Renamed x) -> Not_replaced (`LocalTy (x :> Cpath.lty)) 438 438 + | None -> Not_replaced (`LocalTy (id :> Cpath.lty))) 374 439 | `CanonicalType (t1, t2) -> ( 375 440 match resolved_type_path s t1 with 376 376 - | Not_replaced t1' -> Not_replaced (`CanonicalType (t1', t2)) 441 441 + | Not_replaced t1' -> 442 442 + if t1' == t1 then Not_replaced p 443 443 + else Not_replaced (`CanonicalType (t1', t2)) 377 444 | x -> x) 378 378 - | `Gpath _ -> Not_replaced p 379 379 - | `Substituted p -> 380 380 - resolved_type_path s p |> map_replaced (fun p -> `Substituted p) 381 381 - | `Type (p, n) -> Not_replaced (`Type (resolved_parent_path s p, n)) 382 382 - | `ClassType (p, n) -> Not_replaced (`ClassType (resolved_parent_path s p, n)) 383 383 - | `Class (p, n) -> Not_replaced (`Class (resolved_parent_path s p, n)) 445 445 + | `Identifier _ -> Not_replaced p 446 446 + | `SubstitutedT m -> ( 447 447 + match resolved_type_path s m with 448 448 + | Not_replaced m' -> 449 449 + if m' == m then Not_replaced p else Not_replaced (`SubstitutedT m') 450 450 + | Replaced _ as r -> r) 451 451 + | `SubstitutedCT m -> 452 452 + let m' = resolved_class_type_path s m in 453 453 + if m' == m then Not_replaced p 454 454 + else Not_replaced (`SubstitutedCT m') 455 455 + | `Type (parent, n) -> 456 456 + let parent' = resolved_parent_path s parent in 457 457 + if parent' == parent then Not_replaced p 458 458 + else Not_replaced (`Type (parent', n)) 459 459 + | `ClassType (parent, n) -> 460 460 + let parent' = resolved_parent_path s parent in 461 461 + if parent' == parent then Not_replaced p 462 462 + else Not_replaced (`ClassType (parent', n)) 463 463 + | `Class (parent, n) -> 464 464 + let parent' = resolved_parent_path s parent in 465 465 + if parent' == parent then Not_replaced p 466 466 + else Not_replaced (`Class (parent', n)) 384 467 385 468 and type_path : t -> Cpath.type_ -> Cpath.type_ type_or_replaced = 386 469 fun s p -> 387 470 match p with 388 471 | `Resolved r -> ( 389 389 - try resolved_type_path s r |> map_replaced (fun r -> `Resolved r) 472 472 + try 473 473 + match resolved_type_path s r with 474 474 + | Not_replaced r' -> 475 475 + if r' == r then Not_replaced p 476 476 + else Not_replaced (`Resolved r') 477 477 + | Replaced _ as x -> x 390 478 with Invalidated -> 391 479 let path' = Cpath.unresolve_resolved_type_path r in 392 480 type_path s path') 393 393 - | `Substituted p -> type_path s p |> map_replaced (fun r -> `Substituted r) 394 394 - | `Local (id, b) -> ( 481 481 + | `SubstitutedT m -> ( 482 482 + match type_path s m with 483 483 + | Not_replaced m' -> 484 484 + if m' == m then Not_replaced p 485 485 + else Not_replaced (`SubstitutedT m') 486 486 + | Replaced _ as r -> r) 487 487 + | `SubstitutedCT m -> 488 488 + let m' = class_type_path s m in 489 489 + if m' == m then Not_replaced p 490 490 + else Not_replaced (`SubstitutedCT m') 491 491 + | `LocalTy (`Na _) -> . 492 492 + | `LocalTy (#Ident.type_ as id) -> ( 395 493 if TypeMap.mem id s.type_replacement then 396 494 Replaced (TypeMap.find id s.type_replacement) 397 495 else 398 496 match try Some (TypeMap.find id s.type_) with Not_found -> None with 399 497 | Some (`Prefixed (p, _rp)) -> Not_replaced p 400 400 - | Some (`Renamed x) -> Not_replaced (`Local (x, b)) 401 401 - | None -> Not_replaced (`Local (id, b))) 498 498 + | Some (`Renamed x) -> Not_replaced (`LocalTy (x :> Cpath.lty)) 499 499 + | None -> Not_replaced p) 402 500 | `Identifier _ -> Not_replaced p 403 403 - | `DotT (p, n) -> Not_replaced (`DotT (module_path s p, n)) 404 404 - | `Type (p, n) -> Not_replaced (`Type (resolved_parent_path s p, n)) 405 405 - | `Class (p, n) -> Not_replaced (`Class (resolved_parent_path s p, n)) 406 406 - | `ClassType (p, n) -> Not_replaced (`ClassType (resolved_parent_path s p, n)) 501 501 + | `DotT (m, n) -> 502 502 + let m' = module_path s m in 503 503 + if m' == m then Not_replaced p 504 504 + else Not_replaced (`DotT (m', n)) 505 505 + | `Type (_, p', n) -> Not_replaced (`Type (`U, resolved_parent_path s p', n)) 407 506 408 507 and resolved_class_type_path : 409 508 t -> Cpath.Resolved.class_type -> Cpath.Resolved.class_type = 410 509 fun s p -> 411 510 match p with 412 412 - | `Local id -> ( 511 511 + | `LocalTy (`Na _) -> . 512 512 + | `LocalTy (#Ident.type_ as id) -> ( 413 513 match try Some (TypeMap.find id s.class_type) with _ -> None with 414 514 | Some (`Prefixed (_p, rp)) -> rp 415 415 - | Some (`Renamed x) -> `Local x 416 416 - | None -> `Local id) 417 417 - | `Gpath _ -> p 418 418 - | `Substituted p -> `Substituted (resolved_class_type_path s p) 419 419 - | `ClassType (p, n) -> `ClassType (resolved_parent_path s p, n) 420 420 - | `Class (p, n) -> `Class (resolved_parent_path s p, n) 515 515 + | Some (`Renamed x) -> `LocalTy (x :> Cpath.lty) 516 516 + | None -> `LocalTy (id :> Cpath.lty)) 517 517 + | `Identifier _ -> p 518 518 + | `SubstitutedCT m -> 519 519 + let m' = resolved_class_type_path s m in 520 520 + if m' == m then p else `SubstitutedCT m' 521 521 + | `ClassType (parent, n) -> 522 522 + let parent' = resolved_parent_path s parent in 523 523 + if parent' == parent then p else `ClassType (parent', n) 524 524 + | `Class (parent, n) -> 525 525 + let parent' = resolved_parent_path s parent in 526 526 + if parent' == parent then p else `Class (parent', n) 421 527 422 528 and class_type_path : t -> Cpath.class_type -> Cpath.class_type = 423 529 fun s p -> 424 530 match p with 425 531 | `Resolved r -> ( 426 426 - try `Resolved (resolved_class_type_path s r) 532 532 + try 533 533 + let r' = resolved_class_type_path s r in 534 534 + if r' == r then p else `Resolved r' 427 535 with Invalidated -> 428 536 let path' = Cpath.unresolve_resolved_class_type_path r in 429 537 class_type_path s path') 430 430 - | `Local (id, b) -> ( 538 538 + | `LocalTy (`Na _) -> . 539 539 + | `LocalTy (#Ident.type_ as id) -> ( 431 540 match try Some (TypeMap.find id s.class_type) with _ -> None with 432 541 | Some (`Prefixed (p, _rp)) -> p 433 433 - | Some (`Renamed x) -> `Local (x, b) 434 434 - | None -> `Local (id, b)) 542 542 + | Some (`Renamed x) -> `LocalTy (x :> Cpath.lty) 543 543 + | None -> p) 435 544 | `Identifier _ -> p 436 436 - | `Substituted p -> `Substituted (class_type_path s p) 437 437 - | `DotT (p, n) -> `DotT (module_path s p, n) 438 438 - | `Class (p, n) -> `Class (resolved_parent_path s p, n) 439 439 - | `ClassType (p, n) -> `ClassType (resolved_parent_path s p, n) 545 545 + | `SubstitutedCT m -> 546 546 + let m' = class_type_path s m in 547 547 + if m' == m then p else `SubstitutedCT m' 548 548 + | `DotT (m, n) -> 549 549 + let m' = module_path s m in 550 550 + if m' == m then p else `DotT (m', n) 551 551 + | `Type (_, parent, n) -> `Type (`U, resolved_parent_path s parent, n) 440 552 441 553 let rec resolved_signature_fragment : 442 554 t -> Cfrag.resolved_signature -> Cfrag.resolved_signature = 443 555 fun t r -> 444 556 match r with 445 445 - | `Root (`ModuleType p) -> 446 446 - let p = 447 447 - match resolved_module_type_path t p with 448 448 - | Not_replaced p -> p 449 449 - | Replaced _ -> 450 450 - (* The module type path was replaced by an expression. We can't keep 451 451 - it as a resolved fragment, so raise Invalidated to trigger 452 452 - unresolving. This can happen with OxCaml mode types. *) 453 453 - raise Invalidated 454 454 - in 455 455 - `Root (`ModuleType p) 456 456 - | `Root (`Module p) -> `Root (`Module (resolved_module_path t p)) 557 557 + | `Root (`ModuleType p) -> ( 558 558 + match resolved_module_type_path t p with 559 559 + | Not_replaced p' -> 560 560 + if p' == p then r else `Root (`ModuleType p') 561 561 + | Replaced _ -> raise Invalidated) 562 562 + | `Root (`Module p) -> 563 563 + let p' = resolved_module_path t p in 564 564 + if p' == p then r else `Root (`Module p') 457 565 | (`Subst _ | `Alias _ | `OpaqueModule _ | `Module _) as x -> 458 458 - (resolved_module_fragment t x :> Cfrag.resolved_signature) 566 566 + let x' = resolved_module_fragment t x in 567 567 + if x' == x then r else (x' :> Cfrag.resolved_signature) 459 568 460 569 and resolved_module_fragment : 461 570 t -> Cfrag.resolved_module -> Cfrag.resolved_module = 462 571 fun t r -> 463 572 match r with 464 573 | `Subst (mty, f) -> 465 465 - let p = 574 574 + let mty' = 466 575 match resolved_module_type_path t mty with 467 576 | Not_replaced p -> p 468 468 - | Replaced _ -> 469 469 - (* the left hand side of subst is a named module type inside a module, 470 470 - it cannot be substituted *) 471 471 - assert false 577 577 + | Replaced _ -> assert false 472 578 in 473 473 - `Subst (p, resolved_module_fragment t f) 579 579 + let f' = resolved_module_fragment t f in 580 580 + if mty' == mty && f' == f then r else `Subst (mty', f') 474 581 | `Alias (m, f) -> 475 475 - `Alias (resolved_module_path t m, resolved_module_fragment t f) 476 476 - | `Module (sg, n) -> `Module (resolved_signature_fragment t sg, n) 477 477 - | `OpaqueModule m -> `OpaqueModule (resolved_module_fragment t m) 582 582 + let m' = resolved_module_path t m in 583 583 + let f' = resolved_module_fragment t f in 584 584 + if m' == m && f' == f then r else `Alias (m', f') 585 585 + | `Module (sg, n) -> 586 586 + let sg' = resolved_signature_fragment t sg in 587 587 + if sg' == sg then r else `Module (sg', n) 588 588 + | `OpaqueModule m -> 589 589 + let m' = resolved_module_fragment t m in 590 590 + if m' == m then r else `OpaqueModule m' 478 591 479 592 and resolved_module_type_fragment : 480 593 t -> Cfrag.resolved_module_type -> Cfrag.resolved_module_type = 481 594 fun t r -> 482 595 match r with 483 483 - | `ModuleType (s, n) -> `ModuleType (resolved_signature_fragment t s, n) 596 596 + | `ModuleType (s, n) -> 597 597 + let s' = resolved_signature_fragment t s in 598 598 + if s' == s then r else `ModuleType (s', n) 484 599 485 600 and resolved_type_fragment : t -> Cfrag.resolved_type -> Cfrag.resolved_type = 486 601 fun t r -> 487 602 match r with 488 488 - | `Type (s, n) -> `Type (resolved_signature_fragment t s, n) 489 489 - | `ClassType (s, n) -> `ClassType (resolved_signature_fragment t s, n) 490 490 - | `Class (s, n) -> `Class (resolved_signature_fragment t s, n) 603 603 + | `Type (s, n) -> 604 604 + let s' = resolved_signature_fragment t s in 605 605 + if s' == s then r else `Type (s', n) 606 606 + | `ClassType (s, n) -> 607 607 + let s' = resolved_signature_fragment t s in 608 608 + if s' == s then r else `ClassType (s', n) 609 609 + | `Class (s, n) -> 610 610 + let s' = resolved_signature_fragment t s in 611 611 + if s' == s then r else `Class (s', n) 491 612 492 613 let rec signature_fragment : t -> Cfrag.signature -> Cfrag.signature = 493 614 fun t r -> 494 615 match r with 495 616 | `Resolved f -> ( 496 496 - try `Resolved (resolved_signature_fragment t f) 617 617 + try 618 618 + let f' = resolved_signature_fragment t f in 619 619 + if f' == f then r else `Resolved f' 497 620 with Invalidated -> 498 621 let frag' = Cfrag.unresolve_signature f in 499 622 signature_fragment t frag') 500 500 - | `Dot (sg, n) -> `Dot (signature_fragment t sg, n) 501 501 - | `Root -> `Root 623 623 + | `Dot (sg, n) -> 624 624 + let sg' = signature_fragment t sg in 625 625 + if sg' == sg then r else `Dot (sg', n) 626 626 + | `Root -> r 502 627 503 628 let rec module_fragment : t -> Cfrag.module_ -> Cfrag.module_ = 504 629 fun t r -> 505 630 match r with 506 506 - | `Resolved r -> ( 507 507 - try `Resolved (resolved_module_fragment t r) 631 631 + | `Resolved f -> ( 632 632 + try 633 633 + let f' = resolved_module_fragment t f in 634 634 + if f' == f then r else `Resolved f' 508 635 with Invalidated -> 509 509 - let frag' = Cfrag.unresolve_module r in 636 636 + let frag' = Cfrag.unresolve_module f in 510 637 module_fragment t frag') 511 511 - | `Dot (sg, n) -> `Dot (signature_fragment t sg, n) 638 638 + | `Dot (sg, n) -> 639 639 + let sg' = signature_fragment t sg in 640 640 + if sg' == sg then r else `Dot (sg', n) 512 641 513 642 let rec module_type_fragment : t -> Cfrag.module_type -> Cfrag.module_type = 514 643 fun t r -> 515 644 match r with 516 516 - | `Resolved r -> ( 517 517 - try `Resolved (resolved_module_type_fragment t r) 645 645 + | `Resolved f -> ( 646 646 + try 647 647 + let f' = resolved_module_type_fragment t f in 648 648 + if f' == f then r else `Resolved f' 518 649 with Invalidated -> 519 519 - let frag' = Cfrag.unresolve_module_type r in 650 650 + let frag' = Cfrag.unresolve_module_type f in 520 651 module_type_fragment t frag') 521 521 - | `Dot (sg, n) -> `Dot (signature_fragment t sg, n) 652 652 + | `Dot (sg, n) -> 653 653 + let sg' = signature_fragment t sg in 654 654 + if sg' == sg then r else `Dot (sg', n) 522 655 523 656 let rec type_fragment : t -> Cfrag.type_ -> Cfrag.type_ = 524 657 fun t r -> 525 658 match r with 526 526 - | `Resolved r -> ( 527 527 - try `Resolved (resolved_type_fragment t r) 659 659 + | `Resolved f -> ( 660 660 + try 661 661 + let f' = resolved_type_fragment t f in 662 662 + if f' == f then r else `Resolved f' 528 663 with Invalidated -> 529 529 - let frag' = Cfrag.unresolve_type r in 664 664 + let frag' = Cfrag.unresolve_type f in 530 665 type_fragment t frag') 531 531 - | `Dot (sg, n) -> `Dot (signature_fragment t sg, n) 666 666 + | `Dot (sg, n) -> 667 667 + let sg' = signature_fragment t sg in 668 668 + if sg' == sg then r else `Dot (sg', n) 532 669 533 670 let option_ conv s x = match x with Some x -> Some (conv s x) | None -> None 534 671 535 535 - let list conv s xs = List.map (conv s) xs 672 672 + let option_sharing conv s x = 673 673 + match x with 674 674 + | None -> x 675 675 + | Some v -> 676 676 + let v' = conv s v in 677 677 + if v' == v then x else Some v' 678 678 + 679 679 + let list_sharing conv s xs = 680 680 + let changed = ref false in 681 681 + let ys = List.map (fun x -> 682 682 + let y = conv s x in 683 683 + if y != x then changed := true; 684 684 + y 685 685 + ) xs in 686 686 + if !changed then ys else xs 687 687 + 688 688 + let pair_sharing conv1 conv2 s ((a, b) as p) = 689 689 + let a' = conv1 s a in 690 690 + let b' = conv2 s b in 691 691 + if a' == a && b' == b then p else (a', b') 536 692 537 693 let rec type_ s t = 538 694 let open Component.TypeDecl in 539 539 - let representation = option_ type_decl_representation s t.representation in 540 540 - { t with equation = type_decl_equation s t.equation; representation } 695 695 + let equation' = type_decl_equation s t.equation in 696 696 + let representation' = option_sharing type_decl_representation s t.representation in 697 697 + if equation' == t.equation && representation' == t.representation then t 698 698 + else { t with equation = equation'; representation = representation' } 541 699 542 700 and type_decl_representation s t = 543 701 let open Component.TypeDecl.Representation in 544 702 match t with 545 545 - | Variant cs -> Variant (List.map (type_decl_constructor s) cs) 546 546 - | Record fs -> Record (List.map (type_decl_field s) fs) 703 703 + | Variant cs -> 704 704 + let cs' = list_sharing type_decl_constructor s cs in 705 705 + if cs' == cs then t else Variant cs' 706 706 + | Record fs -> 707 707 + let fs' = list_sharing type_decl_field s fs in 708 708 + if fs' == fs then t else Record fs' 547 709 | Record_unboxed_product fs -> 548 548 - Record_unboxed_product (List.map (type_decl_unboxed_field s) fs) 710 710 + let fs' = list_sharing type_decl_unboxed_field s fs in 711 711 + if fs' == fs then t else Record_unboxed_product fs' 549 712 | Extensible -> t 550 713 551 714 and type_decl_constructor s t = 552 715 let open Component.TypeDecl.Constructor in 553 553 - let args = type_decl_constructor_arg s t.args in 554 554 - let res = option_ type_expr s t.res in 555 555 - { t with args; res } 716 716 + let args' = type_decl_constructor_arg s t.args in 717 717 + let res' = option_sharing type_expr s t.res in 718 718 + if args' == t.args && res' == t.res then t 719 719 + else { t with args = args'; res = res' } 556 720 557 721 and type_poly_var s v = 558 722 let open Component.TypeExpr.Polymorphic_variant in 559 723 let map_constr c = 560 724 let open Constructor in 561 561 - { 562 562 - name = c.name; 563 563 - constant = c.constant; 564 564 - arguments = List.map (type_expr s) c.arguments; 565 565 - doc = c.doc; 566 566 - } 725 725 + let arguments' = list_sharing type_expr s c.arguments in 726 726 + if arguments' == c.arguments then c 727 727 + else { c with arguments = arguments' } 567 728 in 568 568 - let map_element = function 729 729 + (* Note: poly variant substitution can flatten elements, so we can't 730 730 + always share the list. Check if any Type element expands. *) 731 731 + let changed = ref false in 732 732 + let elements' = List.flatten (List.map (function 569 733 | Type t -> ( 570 734 match type_expr s t with 571 571 - | Polymorphic_variant v -> v.elements 572 572 - | x -> [ Type x ]) 573 573 - | Constructor c -> [ Constructor (map_constr c) ] 574 574 - in 575 575 - 576 576 - { kind = v.kind; elements = List.flatten (List.map map_element v.elements) } 735 735 + | Polymorphic_variant v -> changed := true; v.elements 736 736 + | x -> 737 737 + if x != t then changed := true; 738 738 + [ Type x ]) 739 739 + | Constructor c -> 740 740 + let c' = map_constr c in 741 741 + if c' != c then changed := true; 742 742 + [ Constructor c' ] 743 743 + ) v.elements) in 744 744 + if !changed then { kind = v.kind; elements = elements' } 745 745 + else v 577 746 578 747 and type_object s o = 579 748 let open Component.TypeExpr.Object in 580 580 - let map_field = function 581 581 - | Method m -> Method { m with type_ = type_expr s m.type_ } 582 582 - | Inherit t -> Inherit (type_expr s t) 583 583 - in 584 584 - { fields = List.map map_field o.fields; open_ = o.open_ } 749 749 + let fields' = list_sharing (fun s f -> 750 750 + match f with 751 751 + | Method m -> 752 752 + let type_' = type_expr s m.type_ in 753 753 + if type_' == m.type_ then f 754 754 + else Method { m with type_ = type_' } 755 755 + | Inherit te -> 756 756 + let te' = type_expr s te in 757 757 + if te' == te then f else Inherit te' 758 758 + ) s o.fields in 759 759 + if fields' == o.fields then o 760 760 + else { fields = fields'; open_ = o.open_ } 585 761 586 762 and type_package s p = 587 763 let open Component.TypeExpr.Package in 588 588 - let sub (x, y) = (type_fragment s x, type_expr s y) in 589 589 - { 590 590 - path = 591 591 - (match module_type_path s p.path with 592 592 - | Not_replaced p -> p 593 593 - | Replaced (Path p) -> p.p_path 594 594 - | Replaced _ -> 595 595 - (* substituting away a packed module type by a non-path module type is a type error *) 596 596 - assert false); 597 597 - substitutions = List.map sub p.substitutions; 598 598 - } 764 764 + let path' = 765 765 + match module_type_path s p.path with 766 766 + | Not_replaced p -> p 767 767 + | Replaced (Path pt) -> pt.p_path 768 768 + | Replaced _ -> assert false 769 769 + in 770 770 + let substitutions' = list_sharing (fun s ((x, y) as sub) -> 771 771 + let x' = type_fragment s x in 772 772 + let y' = type_expr s y in 773 773 + if x' == x && y' == y then sub else (x', y') 774 774 + ) s p.substitutions in 775 775 + if path' == p.path && substitutions' == p.substitutions then p 776 776 + else { path = path'; substitutions = substitutions' } 599 777 600 778 and type_expr s t = 601 779 let open Component.TypeExpr in 602 780 match t with 603 603 - | Var _ as v -> v 604 604 - | Any -> Any 605 605 - | Alias (t, str) -> Alias (type_expr s t, str) 606 606 - | Arrow (lbl, t1, t2, modes, ret_modes) -> Arrow (lbl, type_expr s t1, type_expr s t2, modes, ret_modes) 607 607 - | Tuple ts -> Tuple (List.map (fun (lbl, ty) -> (lbl, type_expr s ty)) ts) 608 608 - | Unboxed_tuple ts -> Unboxed_tuple (List.map (fun (l, t) -> l, type_expr s t) ts) 781 781 + | Var _ | Any -> t 782 782 + | Alias (te, str) -> 783 783 + let te' = type_expr s te in 784 784 + if te' == te then t else Alias (te', str) 785 785 + | Arrow (lbl, t1, t2, modes, ret_modes) -> 786 786 + let t1' = type_expr s t1 in 787 787 + let t2' = type_expr s t2 in 788 788 + if t1' == t1 && t2' == t2 then t 789 789 + else Arrow (lbl, t1', t2', modes, ret_modes) 790 790 + | Tuple ts -> 791 791 + let ts' = list_sharing (fun s (lbl, ty) -> 792 792 + let ty' = type_expr s ty in 793 793 + if ty' == ty then (lbl, ty) else (lbl, ty') 794 794 + ) s ts in 795 795 + if ts' == ts then t else Tuple ts' 796 796 + | Unboxed_tuple ts -> 797 797 + let ts' = list_sharing (fun s (l, te) -> 798 798 + let te' = type_expr s te in 799 799 + if te' == te then (l, te) else (l, te') 800 800 + ) s ts in 801 801 + if ts' == ts then t else Unboxed_tuple ts' 609 802 | Constr (p, ts) -> ( 610 803 match type_path s p with 611 611 - | Replaced (t, eq) -> 804 804 + | Replaced (te, eq) -> 612 805 let mk_var acc pexpr param = 613 806 match param.Odoc_model.Lang.TypeDecl.desc with 614 807 | Any -> acc ··· 620 813 (List.length eq.params) (List.length ts); 621 814 assert false); 622 815 let vars = List.fold_left2 mk_var [] ts eq.params in 623 623 - substitute_vars vars t 624 624 - | Not_replaced p -> Constr (p, List.map (type_expr s) ts)) 625 625 - | Polymorphic_variant v -> Polymorphic_variant (type_poly_var s v) 626 626 - | Object o -> Object (type_object s o) 627 627 - | Class (p, ts) -> Class (class_type_path s p, List.map (type_expr s) ts) 628 628 - | Poly (strs, ts) -> Poly (strs, type_expr s ts) 629 629 - | Quote t -> Quote (type_expr s t) 630 630 - | Splice t -> Splice (type_expr s t) 631 631 - | Package p -> Package (type_package s p) 816 816 + substitute_vars vars te 817 817 + | Not_replaced p' -> 818 818 + let ts' = list_sharing type_expr s ts in 819 819 + if p' == p && ts' == ts then t else Constr (p', ts')) 820 820 + | Polymorphic_variant v -> 821 821 + let v' = type_poly_var s v in 822 822 + if v' == v then t else Polymorphic_variant v' 823 823 + | Object o -> 824 824 + let o' = type_object s o in 825 825 + if o' == o then t else Object o' 826 826 + | Class (p, ts) -> 827 827 + let p' = class_type_path s p in 828 828 + let ts' = list_sharing type_expr s ts in 829 829 + if p' == p && ts' == ts then t else Class (p', ts') 830 830 + | Poly (strs, te) -> 831 831 + let te' = type_expr s te in 832 832 + if te' == te then t else Poly (strs, te') 833 833 + | Quote te -> 834 834 + let te' = type_expr s te in 835 835 + if te' == te then t else Quote te' 836 836 + | Splice te -> 837 837 + let te' = type_expr s te in 838 838 + if te' == te then t else Splice te' 839 839 + | Package p -> 840 840 + let p' = type_package s p in 841 841 + if p' == p then t else Package p' 632 842 633 843 and simple_expansion : 634 844 t -> ··· 637 847 fun s t -> 638 848 let open Component.ModuleType in 639 849 match t with 640 640 - | Signature sg -> Signature (signature s sg) 641 641 - | Functor (arg, sg) -> Functor (functor_parameter s arg, simple_expansion s sg) 850 850 + | Signature sg -> 851 851 + let sg' = signature s sg in 852 852 + if sg' == sg then t else Signature sg' 853 853 + | Functor (arg, sg) -> 854 854 + let arg' = functor_parameter s arg in 855 855 + let sg' = simple_expansion s sg in 856 856 + if arg' == arg && sg' == sg then t else Functor (arg', sg') 642 857 643 858 and module_type s t = 644 859 let open Component.ModuleType in 645 645 - let expr = 646 646 - match t.expr with Some m -> Some (module_type_expr s m) | None -> None 647 647 - in 648 648 - { expr; source_loc = t.source_loc; source_loc_jane = t.source_loc_jane ; doc = t.doc; canonical = t.canonical } 860 860 + let expr' = option_sharing module_type_expr s t.expr in 861 861 + if expr' == t.expr then t 862 862 + else { t with expr = expr' } 649 863 650 864 and module_type_substitution s t = 651 865 let open Component.ModuleTypeSubstitution in 652 652 - let manifest = module_type_expr s t.manifest in 653 653 - { manifest; doc = t.doc } 866 866 + let manifest' = module_type_expr s t.manifest in 867 867 + if manifest' == t.manifest then t 868 868 + else { manifest = manifest'; doc = t.doc } 654 869 655 870 and functor_parameter s t = 656 871 let open Component.FunctorParameter in 657 872 match t with 658 658 - | Named arg -> Named { arg with expr = module_type_expr s arg.expr } 659 659 - | Unit -> Unit 873 873 + | Named arg -> 874 874 + let expr' = module_type_expr s arg.expr in 875 875 + if expr' == arg.expr then t 876 876 + else Named { arg with expr = expr' } 877 877 + | Unit -> t 660 878 661 879 and module_type_type_of_desc s t = 662 880 let open Component.ModuleType in 663 881 match t with 664 664 - | ModPath p -> ModPath (module_path s p) 665 665 - | StructInclude p -> StructInclude (module_path s p) 882 882 + | ModPath p -> 883 883 + let p' = module_path s p in 884 884 + if p' == p then t else ModPath p' 885 885 + | StructInclude p -> 886 886 + let p' = module_path s p in 887 887 + if p' == p then t else StructInclude p' 666 888 667 889 and u_module_type_expr s t = 668 890 let open Component.ModuleType.U in 669 891 match t with 670 892 | Path p -> ( 671 893 match module_type_path s p with 672 672 - | Not_replaced p -> Path p 894 894 + | Not_replaced p' -> 895 895 + if p' == p then t else Path p' 673 896 | Replaced eqn -> ( 674 897 match eqn with 675 898 | Path p -> Path p.p_path 676 899 | Signature s -> Signature s 677 677 - | TypeOf t -> TypeOf (t.t_desc, t.t_original_path) 900 900 + | TypeOf tv -> TypeOf (tv.t_desc, tv.t_original_path) 678 901 | With w -> With (w.w_substitutions, w.w_expr) 679 679 - | Functor _ -> 680 680 - (* non functor cannot be substituted away to a functor *) 681 681 - assert false 682 682 - | Strengthen s -> Strengthen (s.s_expr, s.s_path, s.s_aliasable))) 683 683 - | Signature sg -> Signature (signature s sg) 902 902 + | Functor _ -> assert false 903 903 + | Strengthen sv -> Strengthen (sv.s_expr, sv.s_path, sv.s_aliasable))) 904 904 + | Signature sg -> 905 905 + let sg' = signature s sg in 906 906 + if sg' == sg then t else Signature sg' 684 907 | With (subs, e) -> 685 685 - With 686 686 - (List.map (with_module_type_substitution s) subs, u_module_type_expr s e) 908 908 + let subs' = list_sharing with_module_type_substitution s subs in 909 909 + let e' = u_module_type_expr s e in 910 910 + if subs' == subs && e' == e then t else With (subs', e') 687 911 | TypeOf (t_desc, t_original_path) -> 688 688 - TypeOf (module_type_type_of_desc s t_desc, t_original_path) 912 912 + let t_desc' = module_type_type_of_desc s t_desc in 913 913 + if t_desc' == t_desc then t else TypeOf (t_desc', t_original_path) 689 914 | Strengthen (expr, path, aliasable) -> 690 690 - let expr = u_module_type_expr s expr in 691 691 - let path = module_path s path in 692 692 - Strengthen (expr, path, aliasable) 915 915 + let expr' = u_module_type_expr s expr in 916 916 + let path' = module_path s path in 917 917 + if expr' == expr && path' == path then t 918 918 + else Strengthen (expr', path', aliasable) 693 919 694 920 and module_type_expr s t = 695 921 let open Component.ModuleType in 696 922 match t with 697 923 | Path { p_path; p_expansion } -> ( 698 924 match module_type_path s p_path with 699 699 - | Not_replaced p_path -> 700 700 - Path { p_path; p_expansion = option_ simple_expansion s p_expansion } 925 925 + | Not_replaced p_path' -> 926 926 + let p_expansion' = option_sharing simple_expansion s p_expansion in 927 927 + if p_path' == p_path && p_expansion' == p_expansion then t 928 928 + else Path { p_path = p_path'; p_expansion = p_expansion' } 701 929 | Replaced s -> s) 702 702 - | Signature sg -> Signature (signature s sg) 930 930 + | Signature sg -> 931 931 + let sg' = signature s sg in 932 932 + if sg' == sg then t else Signature sg' 703 933 | Functor (arg, expr) -> 704 704 - Functor (functor_parameter s arg, module_type_expr s expr) 934 934 + let arg' = functor_parameter s arg in 935 935 + let expr' = module_type_expr s expr in 936 936 + if arg' == arg && expr' == expr then t 937 937 + else Functor (arg', expr') 705 938 | With { w_substitutions; w_expansion; w_expr } -> 706 706 - With 707 707 - { 708 708 - w_substitutions = 709 709 - List.map (with_module_type_substitution s) w_substitutions; 710 710 - w_expansion = option_ simple_expansion s w_expansion; 711 711 - w_expr = u_module_type_expr s w_expr; 712 712 - } 713 713 - | TypeOf t -> 714 714 - TypeOf 715 715 - { 716 716 - t with 717 717 - t_desc = module_type_type_of_desc s t.t_desc; 718 718 - t_expansion = option_ simple_expansion s t.t_expansion; 719 719 - } 939 939 + let w_substitutions' = 940 940 + list_sharing with_module_type_substitution s w_substitutions in 941 941 + let w_expansion' = option_sharing simple_expansion s w_expansion in 942 942 + let w_expr' = u_module_type_expr s w_expr in 943 943 + if w_substitutions' == w_substitutions 944 944 + && w_expansion' == w_expansion 945 945 + && w_expr' == w_expr then t 946 946 + else With { w_substitutions = w_substitutions'; 947 947 + w_expansion = w_expansion'; 948 948 + w_expr = w_expr' } 949 949 + | TypeOf tv -> 950 950 + let t_desc' = module_type_type_of_desc s tv.t_desc in 951 951 + let t_expansion' = option_sharing simple_expansion s tv.t_expansion in 952 952 + if t_desc' == tv.t_desc && t_expansion' == tv.t_expansion then t 953 953 + else TypeOf { tv with t_desc = t_desc'; t_expansion = t_expansion' } 720 954 | Strengthen { s_expr; s_path; s_aliasable; s_expansion } -> 721 721 - Strengthen 722 722 - { 723 723 - s_expr = u_module_type_expr s s_expr; 724 724 - s_path = module_path s s_path; 725 725 - s_aliasable; 726 726 - s_expansion = option_ simple_expansion s s_expansion 727 727 - } 955 955 + let s_expr' = u_module_type_expr s s_expr in 956 956 + let s_path' = module_path s s_path in 957 957 + let s_expansion' = option_sharing simple_expansion s s_expansion in 958 958 + if s_expr' == s_expr && s_path' == s_path && s_expansion' == s_expansion then t 959 959 + else Strengthen { s_expr = s_expr'; s_path = s_path'; 960 960 + s_aliasable; s_expansion = s_expansion' } 728 961 729 962 and with_module_type_substitution s sub = 730 963 let open Component.ModuleType in 731 964 match sub with 732 732 - | ModuleEq (f, m) -> ModuleEq (module_fragment s f, module_decl s m) 733 733 - | ModuleSubst (f, p) -> ModuleSubst (module_fragment s f, module_path s p) 734 734 - | TypeEq (f, eq) -> TypeEq (type_fragment s f, type_decl_equation s eq) 735 735 - | TypeSubst (f, eq) -> TypeSubst (type_fragment s f, type_decl_equation s eq) 965 965 + | ModuleEq (f, m) -> 966 966 + let f' = module_fragment s f in 967 967 + let m' = module_decl s m in 968 968 + if f' == f && m' == m then sub else ModuleEq (f', m') 969 969 + | ModuleSubst (f, p) -> 970 970 + let f' = module_fragment s f in 971 971 + let p' = module_path s p in 972 972 + if f' == f && p' == p then sub else ModuleSubst (f', p') 973 973 + | TypeEq (f, eq) -> 974 974 + let f' = type_fragment s f in 975 975 + let eq' = type_decl_equation s eq in 976 976 + if f' == f && eq' == eq then sub else TypeEq (f', eq') 977 977 + | TypeSubst (f, eq) -> 978 978 + let f' = type_fragment s f in 979 979 + let eq' = type_decl_equation s eq in 980 980 + if f' == f && eq' == eq then sub else TypeSubst (f', eq') 736 981 | ModuleTypeEq (f, eq) -> 737 737 - ModuleTypeEq (module_type_fragment s f, module_type_expr s eq) 982 982 + let f' = module_type_fragment s f in 983 983 + let eq' = module_type_expr s eq in 984 984 + if f' == f && eq' == eq then sub else ModuleTypeEq (f', eq') 738 985 | ModuleTypeSubst (f, eq) -> 739 739 - ModuleTypeSubst (module_type_fragment s f, module_type_expr s eq) 986 986 + let f' = module_type_fragment s f in 987 987 + let eq' = module_type_expr s eq in 988 988 + if f' == f && eq' == eq then sub else ModuleTypeSubst (f', eq') 740 989 741 990 and module_decl s t = 742 991 match t with 743 743 - | Alias (p, e) -> Alias (module_path s p, option_ simple_expansion s e) 744 744 - | ModuleType t -> ModuleType (module_type_expr s t) 992 992 + | Alias (p, e) -> 993 993 + let p' = module_path s p in 994 994 + let e' = option_sharing simple_expansion s e in 995 995 + if p' == p && e' == e then t else Alias (p', e') 996 996 + | ModuleType mt -> 997 997 + let mt' = module_type_expr s mt in 998 998 + if mt' == mt then t else ModuleType mt' 745 999 746 1000 and include_decl s t = 747 1001 match t with 748 748 - | Include.Alias p -> Include.Alias (module_path s p) 749 749 - | ModuleType t -> ModuleType (u_module_type_expr s t) 1002 1002 + | Include.Alias p -> 1003 1003 + let p' = module_path s p in 1004 1004 + if p' == p then t else Include.Alias p' 1005 1005 + | ModuleType mt -> 1006 1006 + let mt' = u_module_type_expr s mt in 1007 1007 + if mt' == mt then t else ModuleType mt' 750 1008 751 1009 and module_ s t = 752 1010 let open Component.Module in 753 753 - let type_ = module_decl s t.type_ in 754 754 - let canonical = t.canonical in 755 755 - { t with type_; canonical } 1011 1011 + let type_' = module_decl s t.type_ in 1012 1012 + if type_' == t.type_ then t 1013 1013 + else { t with type_ = type_' } 756 1014 757 1015 and module_substitution s m = 758 1016 let open Component.ModuleSubstitution in 759 759 - let manifest = module_path s m.manifest in 760 760 - { manifest; doc = m.doc } 1017 1017 + let manifest' = module_path s m.manifest in 1018 1018 + if manifest' == m.manifest then m 1019 1019 + else { manifest = manifest'; doc = m.doc } 761 1020 762 1021 and type_decl_field s f = 763 1022 let open Component.TypeDecl.Field in 764 764 - { f with type_ = type_expr s f.type_ } 1023 1023 + let type_' = type_expr s f.type_ in 1024 1024 + if type_' == f.type_ then f 1025 1025 + else { f with type_ = type_' } 765 1026 766 1027 and type_decl_unboxed_field s f = 767 1028 let open Component.TypeDecl.UnboxedField in 768 768 - { f with type_ = type_expr s f.type_ } 1029 1029 + let type_' = type_expr s f.type_ in 1030 1030 + if type_' == f.type_ then f 1031 1031 + else { f with type_ = type_' } 769 1032 770 1033 and type_decl_constructor_arg s a = 771 1034 let open Component.TypeDecl.Constructor in 772 1035 match a with 773 773 - | Tuple ts -> Tuple (list type_expr s ts) 774 774 - | Record fs -> Record (list type_decl_field s fs) 1036 1036 + | Tuple ts -> 1037 1037 + let ts' = list_sharing type_expr s ts in 1038 1038 + if ts' == ts then a else Tuple ts' 1039 1039 + | Record fs -> 1040 1040 + let fs' = list_sharing type_decl_field s fs in 1041 1041 + if fs' == fs then a else Record fs' 775 1042 776 1043 and type_decl_equation s t = 777 1044 let open Component.TypeDecl.Equation in 778 778 - { 779 779 - t with 780 780 - manifest = option_ type_expr s t.manifest; 781 781 - constraints = 782 782 - List.map (fun (x, y) -> (type_expr s x, type_expr s y)) t.constraints; 783 783 - } 1045 1045 + let manifest' = option_sharing type_expr s t.manifest in 1046 1046 + let constraints' = list_sharing (fun s ((x, y) as p) -> 1047 1047 + let x' = type_expr s x in 1048 1048 + let y' = type_expr s y in 1049 1049 + if x' == x && y' == y then p else (x', y') 1050 1050 + ) s t.constraints in 1051 1051 + if manifest' == t.manifest && constraints' == t.constraints then t 1052 1052 + else { t with manifest = manifest'; constraints = constraints' } 784 1053 785 1054 and exception_ s e = 786 1055 let open Component.Exception in 787 787 - let res = option_ type_expr s e.res in 788 788 - let args = type_decl_constructor_arg s e.args in 789 789 - { e with args; res } 1056 1056 + let res' = option_sharing type_expr s e.res in 1057 1057 + let args' = type_decl_constructor_arg s e.args in 1058 1058 + if res' == e.res && args' == e.args then e 1059 1059 + else { e with args = args'; res = res' } 790 1060 791 1061 and extension_constructor s c = 792 1062 let open Component.Extension.Constructor in 793 793 - { 794 794 - c with 795 795 - args = type_decl_constructor_arg s c.args; 796 796 - res = option_ type_expr s c.res; 797 797 - } 1063 1063 + let args' = type_decl_constructor_arg s c.args in 1064 1064 + let res' = option_sharing type_expr s c.res in 1065 1065 + if args' == c.args && res' == c.res then c 1066 1066 + else { c with args = args'; res = res' } 798 1067 799 1068 and extension s e = 800 1069 let open Component.Extension in 801 801 - let type_path = 1070 1070 + let type_path' = 802 1071 match type_path s e.type_path with 803 1072 | Not_replaced p -> p 804 1073 | Replaced (TypeExpr.Constr (p, _), _) -> p 805 805 - | Replaced _ -> (* What else is possible ? *) assert false 806 806 - and constructors = List.map (extension_constructor s) e.constructors in 807 807 - { e with type_path; constructors } 1074 1074 + | Replaced _ -> assert false 1075 1075 + in 1076 1076 + let constructors' = list_sharing extension_constructor s e.constructors in 1077 1077 + if type_path' == e.type_path && constructors' == e.constructors then e 1078 1078 + else { e with type_path = type_path'; constructors = constructors' } 808 1079 809 1080 and include_ s i = 810 1081 let open Component.Include in 811 811 - { 812 812 - i with 813 813 - decl = include_decl s i.decl; 814 814 - strengthened = option_ module_path s i.strengthened; 815 815 - expansion_ = apply_sig_map_sg s i.expansion_; 816 816 - } 1082 1082 + let decl' = include_decl s i.decl in 1083 1083 + let strengthened' = option_sharing module_path s i.strengthened in 1084 1084 + let expansion_' = apply_sig_map_sg s i.expansion_ in 1085 1085 + if decl' == i.decl && strengthened' == i.strengthened && expansion_' == i.expansion_ 1086 1086 + then i 1087 1087 + else { i with decl = decl'; strengthened = strengthened'; expansion_ = expansion_' } 817 1088 818 1089 and open_ s o = 819 1090 let open Component.Open in 820 820 - { expansion = apply_sig_map_sg s o.expansion; doc = o.doc } 1091 1091 + let expansion' = apply_sig_map_sg s o.expansion in 1092 1092 + if expansion' == o.expansion then o 1093 1093 + else { expansion = expansion'; doc = o.doc } 821 1094 822 1095 and value s v = 823 1096 let open Component.Value in 824 824 - { v with type_ = type_expr s v.type_ } 1097 1097 + let type_' = type_expr s v.type_ in 1098 1098 + if type_' == v.type_ then v 1099 1099 + else { v with type_ = type_' } 825 1100 826 1101 and class_ s c = 827 1102 let open Component.Class in 828 828 - let expansion = option_ class_signature s c.expansion in 829 829 - { c with type_ = class_decl s c.type_; expansion } 1103 1103 + let type_' = class_decl s c.type_ in 1104 1104 + let expansion' = option_sharing class_signature s c.expansion in 1105 1105 + if type_' == c.type_ && expansion' == c.expansion then c 1106 1106 + else { c with type_ = type_'; expansion = expansion' } 830 1107 831 831 - and class_decl s = 1108 1108 + and class_decl s t = 832 1109 let open Component.Class in 833 833 - function 834 834 - | ClassType e -> ClassType (class_type_expr s e) 835 835 - | Arrow (lbl, t, d) -> Arrow (lbl, type_expr s t, class_decl s d) 1110 1110 + match t with 1111 1111 + | ClassType e -> 1112 1112 + let e' = class_type_expr s e in 1113 1113 + if e' == e then t else ClassType e' 1114 1114 + | Arrow (lbl, te, d) -> 1115 1115 + let te' = type_expr s te in 1116 1116 + let d' = class_decl s d in 1117 1117 + if te' == te && d' == d then t else Arrow (lbl, te', d') 836 1118 837 837 - and class_type_expr s = 1119 1119 + and class_type_expr s t = 838 1120 let open Component.ClassType in 839 839 - function 840 840 - | Constr (p, ts) -> Constr (class_type_path s p, List.map (type_expr s) ts) 841 841 - | Signature sg -> Signature (class_signature s sg) 1121 1121 + match t with 1122 1122 + | Constr (p, ts) -> 1123 1123 + let p' = class_type_path s p in 1124 1124 + let ts' = list_sharing type_expr s ts in 1125 1125 + if p' == p && ts' == ts then t else Constr (p', ts') 1126 1126 + | Signature sg -> 1127 1127 + let sg' = class_signature s sg in 1128 1128 + if sg' == sg then t else Signature sg' 842 1129 843 1130 and class_type s c = 844 1131 let open Component.ClassType in 845 845 - let expansion = option_ class_signature s c.expansion in 846 846 - { c with expr = class_type_expr s c.expr; expansion } 1132 1132 + let expr' = class_type_expr s c.expr in 1133 1133 + let expansion' = option_sharing class_signature s c.expansion in 1134 1134 + if expr' == c.expr && expansion' == c.expansion then c 1135 1135 + else { c with expr = expr'; expansion = expansion' } 847 1136 848 848 - and class_signature_item s = 1137 1137 + and class_signature_item s item = 849 1138 let open Component.ClassSignature in 850 850 - function 851 851 - | Method (id, m) -> Method (id, method_ s m) 852 852 - | InstanceVariable (id, i) -> InstanceVariable (id, instance_variable s i) 853 853 - | Constraint cst -> Constraint (class_constraint s cst) 854 854 - | Inherit e -> Inherit (inherit_ s e) 855 855 - | Comment _ as y -> y 1139 1139 + match item with 1140 1140 + | Method (id, m) -> 1141 1141 + let m' = method_ s m in 1142 1142 + if m' == m then item else Method (id, m') 1143 1143 + | InstanceVariable (id, i) -> 1144 1144 + let i' = instance_variable s i in 1145 1145 + if i' == i then item else InstanceVariable (id, i') 1146 1146 + | Constraint cst -> 1147 1147 + let cst' = class_constraint s cst in 1148 1148 + if cst' == cst then item else Constraint cst' 1149 1149 + | Inherit e -> 1150 1150 + let e' = inherit_ s e in 1151 1151 + if e' == e then item else Inherit e' 1152 1152 + | Comment _ -> item 856 1153 857 1154 and class_signature s sg = 858 1155 let open Component.ClassSignature in 859 859 - { 860 860 - sg with 861 861 - self = option_ type_expr s sg.self; 862 862 - items = List.map (class_signature_item s) sg.items; 863 863 - } 1156 1156 + let self' = option_sharing type_expr s sg.self in 1157 1157 + let items' = list_sharing class_signature_item s sg.items in 1158 1158 + if self' == sg.self && items' == sg.items then sg 1159 1159 + else { sg with self = self'; items = items' } 864 1160 865 1161 and method_ s m = 866 1162 let open Component.Method in 867 867 - { m with type_ = type_expr s m.type_ } 1163 1163 + let type_' = type_expr s m.type_ in 1164 1164 + if type_' == m.type_ then m 1165 1165 + else { m with type_ = type_' } 868 1166 869 1167 and instance_variable s i = 870 1168 let open Component.InstanceVariable in 871 871 - { i with type_ = type_expr s i.type_ } 1169 1169 + let type_' = type_expr s i.type_ in 1170 1170 + if type_' == i.type_ then i 1171 1171 + else { i with type_ = type_' } 872 1172 873 1173 and class_constraint s cst = 874 1174 let open Component.ClassSignature.Constraint in 875 875 - { cst with left = type_expr s cst.left; right = type_expr s cst.right } 1175 1175 + let left' = type_expr s cst.left in 1176 1176 + let right' = type_expr s cst.right in 1177 1177 + if left' == cst.left && right' == cst.right then cst 1178 1178 + else { cst with left = left'; right = right' } 876 1179 877 1180 and inherit_ s ih = 878 1181 let open Component.ClassSignature.Inherit in 879 879 - { ih with expr = class_type_expr s ih.expr } 1182 1182 + let expr' = class_type_expr s ih.expr in 1183 1183 + if expr' == ih.expr then ih 1184 1184 + else { ih with expr = expr' } 880 1185 881 881 - and rename_bound_idents s sg = 1186 1186 + and rename_bound_idents s sg items = 882 1187 let open Component.Signature in 883 883 - let new_module_id id = 884 884 - try 885 885 - match ModuleMap.find (id :> Ident.module_) s.module_ with 886 886 - | `Renamed (`LModule _ as x) -> x 887 887 - | `Prefixed (_, _) -> 888 888 - (* This is unusual but can happen when we have TypeOf expressions. It means 889 889 - we're already prefixing this module path, hence we can essentially rename 890 890 - it to whatever we like because it's never going to be referred to. *) 891 891 - Ident.Rename.module_ id 892 892 - | _ -> failwith "Error" 893 893 - with Not_found -> Ident.Rename.module_ id 894 894 - in 895 895 - let new_module_type_id id = 896 896 - try 897 897 - match ModuleTypeMap.find id s.module_type with 898 898 - | `Renamed x -> x 899 899 - | `Prefixed (_, _) -> Ident.Rename.module_type id 900 900 - with Not_found -> Ident.Rename.module_type id 901 901 - in 902 902 - let new_type_id id = 903 903 - try 904 904 - match TypeMap.find (id :> Ident.type_) s.type_ with 905 905 - | `Renamed (`LType _ as x) -> x 906 906 - | `Prefixed (_, _) -> Ident.Rename.type_ id 907 907 - with Not_found -> Ident.Rename.type_ id 908 908 - in 909 909 - let new_class_id id = 910 910 - try 911 911 - match TypeMap.find (id :> Ident.type_) s.class_type with 912 912 - | `Renamed (`LType _ as x) -> x 913 913 - | `Prefixed (_, _) -> Ident.Rename.type_ id 914 914 - with Not_found -> Ident.Rename.type_ id 915 915 - in 916 916 - let new_class_type_id id = 917 917 - try 918 918 - match TypeMap.find (id :> Ident.type_) s.class_type with 919 919 - | `Renamed (`LType _ as x) -> x 920 920 - | `Prefixed (_, _) -> Ident.Rename.type_ id 921 921 - with Not_found -> Ident.Rename.type_ id 1188 1188 + (* The closures used to look up rename targets only depend on the 1189 1189 + immutable substitution map, so they're hoisted to local helpers 1190 1190 + that don't capture per-call state. Each recursive call would 1191 1191 + otherwise reallocate them. *) 1192 1192 + let rec loop s sg = function 1193 1193 + | [] -> (s, List.rev sg) 1194 1194 + | Module (id, r, m) :: rest -> 1195 1195 + let id' = rbi_new_module_id s id in 1196 1196 + loop 1197 1197 + (rename_module (id :> Ident.module_) (id' :> Ident.module_) s) 1198 1198 + (Module (id', r, m) :: sg) 1199 1199 + rest 1200 1200 + | ModuleSubstitution (id, m) :: rest -> 1201 1201 + let id' = rbi_new_module_id s id in 1202 1202 + loop 1203 1203 + (rename_module (id :> Ident.module_) (id' :> Ident.module_) s) 1204 1204 + (ModuleSubstitution (id', m) :: sg) 1205 1205 + rest 1206 1206 + | ModuleType (id, mt) :: rest -> 1207 1207 + let id' = rbi_new_module_type_id s id in 1208 1208 + loop 1209 1209 + (rename_module_type id id' s) 1210 1210 + (ModuleType (id', mt) :: sg) 1211 1211 + rest 1212 1212 + | ModuleTypeSubstitution (id, mt) :: rest -> 1213 1213 + let id' = rbi_new_module_type_id s id in 1214 1214 + loop 1215 1215 + (rename_module_type id id' s) 1216 1216 + (ModuleTypeSubstitution (id', mt) :: sg) 1217 1217 + rest 1218 1218 + | Type (id, r, t) :: rest -> 1219 1219 + let id' = rbi_new_type_id s id in 1220 1220 + loop 1221 1221 + (rename_type (id :> Ident.type_) (id' :> Ident.type_) s) 1222 1222 + (Type (id', r, t) :: sg) 1223 1223 + rest 1224 1224 + | TypeSubstitution (id, t) :: rest -> 1225 1225 + let id' = rbi_new_type_id s id in 1226 1226 + loop 1227 1227 + (rename_type (id :> Ident.type_) (id' :> Ident.type_) s) 1228 1228 + (TypeSubstitution (id', t) :: sg) 1229 1229 + rest 1230 1230 + | Exception (id, e) :: rest -> 1231 1231 + let id' = Ident.Rename.exception_ id in 1232 1232 + loop s (Exception (id', e) :: sg) rest 1233 1233 + | TypExt e :: rest -> loop s (TypExt e :: sg) rest 1234 1234 + | Value (id, v) :: rest -> 1235 1235 + let id' = Ident.Rename.value id in 1236 1236 + loop s (Value (id', v) :: sg) rest 1237 1237 + | Class (id, r, c) :: rest -> 1238 1238 + let id' = rbi_new_class_id s id in 1239 1239 + loop 1240 1240 + (rename_class_type (id :> Ident.type_) (id' :> Ident.type_) s) 1241 1241 + (Class (id', r, c) :: sg) 1242 1242 + rest 1243 1243 + | ClassType (id, r, c) :: rest -> 1244 1244 + let id' = rbi_new_class_type_id s id in 1245 1245 + loop 1246 1246 + (rename_class_type (id :> Ident.type_) (id' :> Ident.type_) s) 1247 1247 + (ClassType (id', r, c) :: sg) 1248 1248 + rest 1249 1249 + | Include i :: rest -> 1250 1250 + loop s (Include i :: sg) rest 1251 1251 + | Open o :: rest -> 1252 1252 + loop s (Open o :: sg) rest 1253 1253 + | (Comment _ as item) :: rest -> loop s (item :: sg) rest 922 1254 in 923 923 - function 924 924 - | [] -> (s, List.rev sg) 925 925 - | Module (id, r, m) :: rest -> 926 926 - let id' = new_module_id id in 927 927 - rename_bound_idents 928 928 - (rename_module (id :> Ident.module_) (id' :> Ident.module_) s) 929 929 - (Module (id', r, m) :: sg) 930 930 - rest 931 931 - | ModuleSubstitution (id, m) :: rest -> 932 932 - let id' = new_module_id id in 933 933 - rename_bound_idents 934 934 - (rename_module (id :> Ident.module_) (id' :> Ident.module_) s) 935 935 - (ModuleSubstitution (id', m) :: sg) 936 936 - rest 937 937 - | ModuleType (id, mt) :: rest -> 938 938 - let id' = new_module_type_id id in 939 939 - rename_bound_idents 940 940 - (rename_module_type id id' s) 941 941 - (ModuleType (id', mt) :: sg) 942 942 - rest 943 943 - | ModuleTypeSubstitution (id, mt) :: rest -> 944 944 - let id' = new_module_type_id id in 945 945 - rename_bound_idents 946 946 - (rename_module_type id id' s) 947 947 - (ModuleTypeSubstitution (id', mt) :: sg) 948 948 - rest 949 949 - | Type (id, r, t) :: rest -> 950 950 - let id' = new_type_id id in 951 951 - rename_bound_idents 952 952 - (rename_type (id :> Ident.type_) (id' :> Ident.type_) s) 953 953 - (Type (id', r, t) :: sg) 954 954 - rest 955 955 - | TypeSubstitution (id, t) :: rest -> 956 956 - let id' = new_type_id id in 957 957 - rename_bound_idents 958 958 - (rename_type (id :> Ident.type_) (id' :> Ident.type_) s) 959 959 - (TypeSubstitution (id', t) :: sg) 960 960 - rest 961 961 - | Exception (id, e) :: rest -> 962 962 - let id' = Ident.Rename.exception_ id in 963 963 - rename_bound_idents s (Exception (id', e) :: sg) rest 964 964 - | TypExt e :: rest -> rename_bound_idents s (TypExt e :: sg) rest 965 965 - | Value (id, v) :: rest -> 966 966 - let id' = Ident.Rename.value id in 967 967 - rename_bound_idents s (Value (id', v) :: sg) rest 968 968 - | Class (id, r, c) :: rest -> 969 969 - let id' = new_class_id id in 970 970 - rename_bound_idents 971 971 - (rename_class_type (id :> Ident.type_) (id' :> Ident.type_) s) 972 972 - (Class (id', r, c) :: sg) 973 973 - rest 974 974 - | ClassType (id, r, c) :: rest -> 975 975 - let id' = new_class_type_id id in 976 976 - rename_bound_idents 977 977 - (rename_class_type (id :> Ident.type_) (id' :> Ident.type_) s) 978 978 - (ClassType (id', r, c) :: sg) 979 979 - rest 980 980 - | Include ({ expansion_; _ } as i) :: rest -> 981 981 - let s, items = rename_bound_idents s [] expansion_.items in 982 982 - rename_bound_idents s 983 983 - (Include { i with expansion_ = { expansion_ with items; removed = [] } } 984 984 - :: sg) 985 985 - rest 986 986 - | Open { expansion; doc } :: rest -> 987 987 - let s, items = rename_bound_idents s [] expansion.items in 988 988 - rename_bound_idents s 989 989 - (Open { expansion = { expansion with items; removed = [] }; doc } :: sg) 990 990 - rest 991 991 - | (Comment _ as item) :: rest -> rename_bound_idents s (item :: sg) rest 1255 1255 + loop s sg items 1256 1256 + 1257 1257 + (* These helpers used to be local closures inside rename_bound_idents, 1258 1258 + reallocated on every recursive call. They depend only on the substitution 1259 1259 + record so they can be defined once at module level. *) 1260 1260 + and rbi_new_module_id s id = 1261 1261 + try 1262 1262 + match ModuleMap.find (id :> Ident.module_) s.module_ with 1263 1263 + | `Renamed (`LModule _ as x) -> x 1264 1264 + | `Prefixed (_, _) -> 1265 1265 + (* Unusual but can happen with TypeOf expressions. *) 1266 1266 + Ident.Rename.module_ id 1267 1267 + | _ -> failwith "Error" 1268 1268 + with Not_found -> Ident.Rename.module_ id 1269 1269 + 1270 1270 + and rbi_new_module_type_id s id = 1271 1271 + try 1272 1272 + match ModuleTypeMap.find id s.module_type with 1273 1273 + | `Renamed x -> x 1274 1274 + | `Prefixed (_, _) -> Ident.Rename.module_type id 1275 1275 + with Not_found -> Ident.Rename.module_type id 1276 1276 + 1277 1277 + and rbi_new_type_id s id = 1278 1278 + try 1279 1279 + match TypeMap.find (id :> Ident.type_) s.type_ with 1280 1280 + | `Renamed (`LType _ as x) -> x 1281 1281 + | `Prefixed (_, _) -> Ident.Rename.type_ id 1282 1282 + with Not_found -> Ident.Rename.type_ id 1283 1283 + 1284 1284 + and rbi_new_class_id s id = 1285 1285 + try 1286 1286 + match TypeMap.find (id :> Ident.type_) s.class_type with 1287 1287 + | `Renamed (`LType _ as x) -> x 1288 1288 + | `Prefixed (_, _) -> Ident.Rename.type_ id 1289 1289 + with Not_found -> Ident.Rename.type_ id 1290 1290 + 1291 1291 + and rbi_new_class_type_id s id = 1292 1292 + try 1293 1293 + match TypeMap.find (id :> Ident.type_) s.class_type with 1294 1294 + | `Renamed (`LType _ as x) -> x 1295 1295 + | `Prefixed (_, _) -> Ident.Rename.type_ id 1296 1296 + with Not_found -> Ident.Rename.type_ id 992 1297 993 1298 and removed_items s items = 994 1299 let open Component.Signature in 995 995 - List.map 996 996 - (function 997 997 - | RModule (id, p) -> RModule (id, module_path s p) 998 998 - | RType (id, exp, eqn) -> 999 999 - RType (id, type_expr s exp, type_decl_equation s eqn) 1000 1000 - | RModuleType (id, mty) -> RModuleType (id, module_type_expr s mty)) 1001 1001 - items 1300 1300 + list_sharing (fun s item -> 1301 1301 + match item with 1302 1302 + | RModule (id, p) -> 1303 1303 + let p' = module_path s p in 1304 1304 + if p' == p then item else RModule (id, p') 1305 1305 + | RType (id, exp, eqn) -> 1306 1306 + let exp' = type_expr s exp in 1307 1307 + let eqn' = type_decl_equation s eqn in 1308 1308 + if exp' == exp && eqn' == eqn then item else RType (id, exp', eqn') 1309 1309 + | RModuleType (id, mty) -> 1310 1310 + let mty' = module_type_expr s mty in 1311 1311 + if mty' == mty then item else RModuleType (id, mty') 1312 1312 + ) s items 1002 1313 1003 1314 and signature s sg = 1315 1315 + if is_identity s then sg 1316 1316 + else 1004 1317 let s, items = rename_bound_idents s [] sg.items in 1005 1318 let items, removed, dont_recompile = apply_sig_map s items sg.removed in 1006 1319 { sg with items; removed; compiled = sg.compiled && dont_recompile } 1007 1320 1008 1321 and apply_sig_map_sg s (sg : Component.Signature.t) = 1322 1322 + if is_identity s then sg 1323 1323 + else 1009 1324 let items, removed, dont_recompile = apply_sig_map s sg.items sg.removed in 1010 1325 { sg with items; removed; compiled = sg.compiled && dont_recompile } 1011 1326 ··· 1048 1363 List.rev_map (apply_sig_map_item s) items |> List.rev 1049 1364 1050 1365 and apply_sig_map s items removed = 1366 1366 + if is_identity s then (items, removed, true) 1367 1367 + else 1051 1368 let dont_recompile = List.length s.path_invalidating_modules = 0 in 1052 1369 (apply_sig_map_items s items, removed_items s removed, dont_recompile)

+304 -463

odoc/src/xref2/tools.ml

reviewed

··· 96 96 | Type (id, _, _) :: rest -> 97 97 let name = Ident.Name.typed_type id in 98 98 get_sub 99 99 - (Subst.add_type id (`Type (path, name)) (`Type (path, name)) sub') 99 99 + (Subst.add_type id (`Type (`U, path, name)) (`Type (path, name)) sub') 100 100 rest 101 101 | Module (id, _, _) :: rest -> 102 102 let name = Ident.Name.typed_module id in 103 103 get_sub 104 104 (Subst.add_module 105 105 (id :> Ident.module_) 106 106 - (`Module (path, name)) 106 106 + (`Module (`U, path, name)) 107 107 (`Module (path, name)) 108 108 sub') 109 109 rest ··· 111 111 let name = Ident.Name.typed_module_type id in 112 112 get_sub 113 113 (Subst.add_module_type id 114 114 - (`ModuleType (path, name)) 114 114 + (`ModuleType (`U, path, name)) 115 115 (`ModuleType (path, name)) 116 116 sub') 117 117 rest ··· 119 119 let name = Ident.Name.typed_module_type id in 120 120 get_sub 121 121 (Subst.add_module_type id 122 122 - (`ModuleType (path, name)) 122 122 + (`ModuleType (`U, path, name)) 123 123 (`ModuleType (path, name)) 124 124 sub') 125 125 rest ··· 128 128 get_sub 129 129 (Subst.add_module 130 130 (id :> Ident.module_) 131 131 - (`Module (path, name)) 131 131 + (`Module (`U, path, name)) 132 132 (`Module (path, name)) 133 133 sub') 134 134 rest 135 135 | TypeSubstitution (id, _) :: rest -> 136 136 let name = Ident.Name.typed_type id in 137 137 get_sub 138 138 - (Subst.add_type id (`Type (path, name)) (`Type (path, name)) sub') 138 138 + (Subst.add_type id (`Type (`U, path, name)) (`Type (path, name)) sub') 139 139 rest 140 140 | Exception _ :: rest 141 141 | TypExt _ :: rest ··· 145 145 | Class (id, _, _) :: rest -> 146 146 let name = Ident.Name.typed_type id in 147 147 get_sub 148 148 - (Subst.add_class id (`Class (path, name)) (`Class (path, name)) sub') 148 148 + (Subst.add_class id (`Type (`U, path, name)) (`Class (path, name)) sub') 149 149 rest 150 150 | ClassType (id, _, _) :: rest -> 151 151 let name = Ident.Name.typed_type id in 152 152 get_sub 153 153 (Subst.add_class_type id 154 154 - (`ClassType (path, name)) 154 154 + (`Type (`U, path, name)) 155 155 (`ClassType (path, name)) 156 156 sub') 157 157 rest ··· 314 314 end) 315 315 316 316 module HandleCanonicalModuleMemo = MakeMemo (struct 317 317 - type t = Odoc_model.Paths.Path.Module.t 317 317 + type t = Cpath.module_ 318 318 319 319 - type result = Odoc_model.Paths.Path.Module.t 319 319 + type result = Cpath.module_ 320 320 321 321 let equal x3 y3 = x3 = y3 322 322 ··· 350 350 fun env m -> 351 351 let open Odoc_model.Paths.Identifier in 352 352 match m with 353 353 - | `Module (`Module (`Gpath (`Identifier p)), name) -> ( 353 353 + | `Module (`Module (`Identifier p), name) -> ( 354 354 let ident = (Mk.module_ ((p :> Signature.t), name) : Path.Module.t) in 355 355 match Env.(lookup_by_id s_module (ident :> Signature.t) env) with 356 356 - | Some _ -> `Gpath (`Identifier ident) 356 356 + | Some _ -> `Identifier ident 357 357 | None -> m) 358 358 | _ -> m 359 359 ··· 362 362 fun env m -> 363 363 let open Odoc_model.Paths.Identifier in 364 364 match m with 365 365 - | `ModuleType (`Module (`Gpath (`Identifier p)), name) -> ( 365 365 + | `ModuleType (`Module (`Identifier p), name) -> ( 366 366 let ident = 367 367 (Mk.module_type ((p :> Signature.t), name) : Path.ModuleType.t) 368 368 in 369 369 match Env.(lookup_by_id s_module_type (ident :> Signature.t) env) with 370 370 - | Some _ -> `Gpath (`Identifier ident) 370 370 + | Some _ -> `Identifier ident 371 371 | None -> m) 372 372 | _ -> m 373 373 ··· 375 375 fun env m -> 376 376 let open Odoc_model.Paths.Identifier in 377 377 match m with 378 378 - | `Type (`Module (`Gpath (`Identifier p)), name) -> ( 378 378 + | `Type (`Module (`Identifier p), name) -> ( 379 379 let ident = (Mk.type_ ((p :> Signature.t), name) : Path.Type.t) in 380 380 match Env.(lookup_by_id s_datatype (ident :> Path.Type.t) env) with 381 381 - | Some _ -> `Gpath (`Identifier ident) 381 381 + | Some _ -> `Identifier ident 382 382 | None -> m) 383 383 | _ -> m 384 384 ··· 415 415 | `Canonical _ -> p 416 416 | _ -> ( 417 417 match m.Component.Module.canonical with 418 418 - | Some cp -> `Canonical (p, cp) 418 418 + | Some cp -> `Canonical (p, (cp :> Cpath.module_)) 419 419 | None -> p) 420 420 421 421 and add_canonical_path_mt : ··· 427 427 | `CanonicalModuleType _ -> p 428 428 | _ -> ( 429 429 match m.canonical with 430 430 - | Some cp -> `CanonicalModuleType (p, cp) 430 430 + | Some cp -> `CanonicalModuleType (p, (cp :> Cpath.module_type)) 431 431 | None -> p) 432 432 433 433 and get_substituted_module_type : ··· 495 495 | None -> rp 496 496 | Some (`Aliased rp') -> 497 497 let dest_hidden = 498 498 - Cpath.is_resolved_module_hidden ~weak_canonical_test:true rp' 498 498 + Cpath.is_resolved_hidden ~weak_canonical_test:true (rp' :> Cpath.Resolved.any) 499 499 in 500 500 if dest_hidden then rp 501 501 else ··· 547 547 | Some (`FType_removed (_name, _, _) as _t) -> Error `Class_replaced 548 548 | None -> Error `Find_failure 549 549 550 550 - and lookup_module_gpath : 551 551 - Env.t -> 552 552 - Odoc_model.Paths.Path.Resolved.Module.t -> 553 553 - (Component.Module.t Component.Delayed.t, simple_module_lookup_error) result 554 554 - = 555 555 - fun env path -> 556 556 - match path with 557 557 - | `Identifier i -> 558 558 - of_option ~error:(`Lookup_failure i) (Env.(lookup_by_id s_module) i env) 559 559 - >>= fun (`Module (_, m)) -> Ok m 560 560 - | `Apply (functor_path, argument_path) -> 561 561 - lookup_module_gpath env functor_path >>= fun functor_module -> 562 562 - let functor_module = Component.Delayed.get functor_module in 563 563 - handle_apply env (`Gpath functor_path) (`Gpath argument_path) 564 564 - functor_module 565 565 - |> map_error (fun e -> `Parent (`Parent_expr e)) 566 566 - >>= fun (_, m) -> Ok (Component.Delayed.put_val m) 567 567 - | `Module (parent, name) -> 568 568 - let find_in_sg sg sub = 569 569 - match Find.careful_module_in_sig sg name with 570 570 - | None -> Error `Find_failure 571 571 - | Some (`FModule (_, m)) -> 572 572 - Ok (Component.Delayed.put_val (Subst.module_ sub m)) 573 573 - | Some (`FModule_removed p) -> 574 574 - resolve_module env p >>= fun (_, m) -> Ok m 575 575 - in 576 576 - lookup_parent_gpath env parent 577 577 - |> map_error (fun e -> (e :> simple_module_lookup_error)) 578 578 - >>= fun (sg, sub) -> find_in_sg sg sub 579 579 - | `Alias (p, _) -> lookup_module_gpath env p 580 580 - | `Subst (_, p) -> lookup_module_gpath env p 581 581 - | `Hidden p -> lookup_module_gpath env p 582 582 - | `Canonical (p, _) -> lookup_module_gpath env p 583 583 - | `OpaqueModule m -> lookup_module_gpath env m 584 584 - | `Substituted m -> lookup_module_gpath env m 585 585 - 586 550 and lookup_module : 587 551 Env.t -> 588 552 Cpath.Resolved.module_ -> ··· 591 555 fun env' path' -> 592 556 let lookup env (path : ExpansionOfModuleMemo.M.key) = 593 557 match path with 594 594 - | `Local lpath -> Error (`Local (env, lpath)) 595 595 - | `Gpath p -> lookup_module_gpath env p 558 558 + | `LocalMod (`Na _) -> . 559 559 + | `LocalMod (#Ident.module_ as lpath) -> Error (`Local (env, lpath)) 560 560 + | `Identifier p -> 561 561 + of_option ~error:(`Lookup_failure p) (Env.(lookup_by_id s_module) p env) 562 562 + >>= fun (`Module (_, m)) -> Ok m 596 563 | `Substituted x -> lookup_module env x 597 564 | `Apply (functor_path, argument_path) -> 598 565 lookup_module env functor_path >>= fun functor_module -> ··· 623 590 in 624 591 LookupModuleMemo.memoize lookup env' path' 625 592 626 626 - and lookup_module_type_gpath : 627 627 - Env.t -> 628 628 - Odoc_model.Paths.Path.Resolved.ModuleType.t -> 629 629 - (Component.ModuleType.t, simple_module_type_lookup_error) result = 630 630 - fun env path -> 631 631 - match path with 632 632 - | `Identifier i -> 633 633 - of_option ~error:(`Lookup_failureMT i) 634 634 - (Env.(lookup_by_id s_module_type) i env) 635 635 - >>= fun (`ModuleType (_, mt)) -> Ok mt 636 636 - | `CanonicalModuleType (s, _) | `SubstT (_, s) -> 637 637 - lookup_module_type_gpath env s 638 638 - | `ModuleType (parent, name) -> 639 639 - let find_in_sg sg sub = 640 640 - match Find.module_type_in_sig sg name with 641 641 - | None -> Error `Find_failure 642 642 - | Some (`FModuleType (_, mt)) -> Ok (Subst.module_type sub mt) 643 643 - in 644 644 - lookup_parent_gpath env parent 645 645 - |> map_error (fun e -> (e :> simple_module_type_lookup_error)) 646 646 - >>= fun (sg, sub) -> find_in_sg sg sub 647 647 - | `AliasModuleType (_, mt) -> lookup_module_type_gpath env mt 648 648 - | `OpaqueModuleType m -> lookup_module_type_gpath env m 649 649 - | `SubstitutedMT m -> lookup_module_type_gpath env m 650 650 - 651 593 and lookup_module_type : 652 594 Env.t -> 653 595 Cpath.Resolved.module_type -> ··· 655 597 fun env path -> 656 598 let lookup env = 657 599 match path with 658 658 - | `Local l -> Error (`LocalMT (env, l)) 659 659 - | `Gpath p -> lookup_module_type_gpath env p 660 660 - | `Substituted s | `CanonicalModuleType (s, _) | `SubstT (_, s) -> 600 600 + | `LocalModTy (`Na _) -> . 601 601 + | `LocalModTy (#Ident.module_type as l) -> Error (`LocalMT (env, l)) 602 602 + | `Identifier i -> 603 603 + of_option ~error:(`Lookup_failureMT i) 604 604 + (Env.(lookup_by_id s_module_type) i env) 605 605 + >>= fun (`ModuleType (_, mt)) -> Ok mt 606 606 + | `SubstitutedMT s | `CanonicalModuleType (s, _) | `SubstT (_, s) -> 661 607 lookup_module_type env s 662 608 | `ModuleType (parent, name) -> 663 609 let find_in_sg sg sub = ··· 680 626 [ `Parent of parent_lookup_error ] ) 681 627 result = 682 628 fun env' parent' -> 683 683 - let lookup env parent = 629 629 + let lookup env (parent : Cpath.Resolved.parent) = 684 630 match parent with 685 631 | `Module p -> 686 632 lookup_module env p |> map_error (fun e -> `Parent (`Parent_module e)) ··· 690 636 |> map_error (fun e -> `Parent (`Parent_sig e)) 691 637 >>= assert_not_functor 692 638 >>= fun sg -> Ok (sg, prefix_substitution parent sg) 693 693 - | `ModuleType p -> 639 639 + | `ModuleType (p, `U) -> 694 640 lookup_module_type env p 695 641 |> map_error (fun e -> `Parent (`Parent_module_type e)) 696 642 >>= fun mt -> ··· 698 644 |> map_error (fun e -> `Parent (`Parent_sig e)) 699 645 >>= assert_not_functor 700 646 >>= fun sg -> Ok (sg, prefix_substitution parent sg) 701 701 - | `FragmentRoot -> 647 647 + | `FragmentRoot `U -> 702 648 Env.lookup_fragment_root env 703 649 |> of_option ~error:(`Parent `Fragment_root) 704 650 >>= fun (_, sg) -> Ok (sg, prefix_substitution parent sg) 651 651 + | `ModuleType (_, `Na _) -> . 652 652 + | `FragmentRoot (`Na _) -> . 705 653 in 706 654 LookupParentMemo.memoize lookup env' parent' 707 655 708 708 - and lookup_parent_gpath : 709 709 - Env.t -> 710 710 - Odoc_model.Paths.Path.Resolved.Module.t -> 711 711 - ( Component.Signature.t * Component.Substitution.t, 712 712 - [ `Parent of parent_lookup_error ] ) 713 713 - result = 714 714 - fun env parent -> 715 715 - lookup_module_gpath env parent 716 716 - |> map_error (fun e -> `Parent (`Parent_module e)) 717 717 - >>= fun m -> 718 718 - let m = Component.Delayed.get m in 719 719 - expansion_of_module env m 720 720 - |> map_error (fun e -> `Parent (`Parent_sig e)) 721 721 - >>= assert_not_functor 722 722 - >>= fun sg -> Ok (sg, prefix_substitution (`Module (`Gpath parent)) sg) 723 723 - 724 724 - and lookup_type_gpath : 725 725 - Env.t -> 726 726 - Odoc_model.Paths.Path.Resolved.Type.t -> 727 727 - (Find.careful_type, simple_type_lookup_error) result = 728 728 - fun env p -> 729 729 - let do_type p name = 730 730 - lookup_parent_gpath env p 731 731 - |> map_error (fun e -> (e :> simple_type_lookup_error)) 732 732 - >>= fun (sg, sub) -> 733 733 - match Find.careful_type_in_sig sg name with 734 734 - | Some (`FClass (name, c)) -> Ok (`FClass (name, Subst.class_ sub c)) 735 735 - | Some (`FClassType (name, ct)) -> 736 736 - Ok (`FClassType (name, Subst.class_type sub ct)) 737 737 - | Some (`FType (name, t)) -> Ok (`FType (name, Subst.type_ sub t)) 738 738 - | Some (`FType_removed (name, texpr, eq)) -> 739 739 - Ok (`FType_removed (name, Subst.type_expr sub texpr, eq)) 740 740 - | Some (`CoreType _ as c) -> Ok c 741 741 - | None -> Error `Find_failure 742 742 - in 743 743 - let res = 744 744 - match p with 745 745 - | `CoreType _ as c -> Ok c 746 746 - | `Identifier ({ iv = `Type _; _ } as i) -> 747 747 - of_option ~error:(`Lookup_failureT i) 748 748 - (Env.(lookup_by_id s_datatype) i env) 749 749 - >>= fun (`Type ({ iv = `Type (_, name); _ }, t)) -> 750 750 - Ok (`FType (name, t)) 751 751 - | `Identifier ({ iv = `Class _; _ } as i) -> 752 752 - of_option ~error:(`Lookup_failureT i) (Env.(lookup_by_id s_class) i env) 753 753 - >>= fun (`Class ({ iv = `Class (_, name); _ }, t)) -> 754 754 - Ok (`FClass (name, t)) 755 755 - | `Identifier ({ iv = `ClassType _; _ } as i) -> 756 756 - of_option ~error:(`Lookup_failureT i) 757 757 - (Env.(lookup_by_id s_class_type) i env) 758 758 - >>= fun (`ClassType ({ iv = `ClassType (_, name); _ }, t)) -> 759 759 - Ok (`FClassType (name, t)) 760 760 - | `CanonicalType (t1, _) -> lookup_type_gpath env t1 761 761 - | `Type (p, id) -> do_type p id 762 762 - | `Class (p, id) -> do_type p id 763 763 - | `ClassType (p, id) -> do_type p id 764 764 - | `SubstitutedT t -> lookup_type_gpath env t 765 765 - | `SubstitutedCT t -> 766 766 - lookup_type_gpath env (t :> Odoc_model.Paths.Path.Resolved.Type.t) 767 767 - in 768 768 - res 769 769 - 770 770 - and lookup_value_gpath : 771 771 - Env.t -> 772 772 - Odoc_model.Paths.Path.Resolved.Value.t -> 773 773 - (Find.value, simple_value_lookup_error) result = 774 774 - fun env p -> 775 775 - let do_value p name = 776 776 - lookup_parent_gpath env p 777 777 - |> map_error (fun e -> (e :> simple_value_lookup_error)) 778 778 - >>= fun (sg, sub) -> 779 779 - match Find.value_in_sig sg name with 780 780 - | Some (`FValue (name, t)) -> Ok (`FValue (name, Subst.value sub t)) 781 781 - | None -> Error `Find_failure 782 782 - in 783 783 - let res = 784 784 - match p with 785 785 - | `Identifier ({ iv = `Value _; _ } as i) -> 786 786 - of_option ~error:(`Lookup_failureV i) (Env.(lookup_by_id s_value) i env) 787 787 - >>= fun (`Value ({ iv = `Value (_, name); _ }, t)) -> 788 788 - Ok (`FValue (name, t)) 789 789 - | `Value (p, id) -> do_value p id 790 790 - in 791 791 - res 792 792 - 793 793 - and lookup_class_type_gpath : 794 794 - Env.t -> 795 795 - Odoc_model.Paths.Path.Resolved.ClassType.t -> 796 796 - (Find.careful_class, simple_type_lookup_error) result = 797 797 - fun env p -> 798 798 - let do_type p name = 799 799 - lookup_parent_gpath env p 800 800 - |> map_error (fun e -> (e :> simple_type_lookup_error)) 801 801 - >>= fun (sg, sub) -> 802 802 - match Find.careful_class_in_sig sg name with 803 803 - | Some (`FClass (name, c)) -> Ok (`FClass (name, Subst.class_ sub c)) 804 804 - | Some (`FClassType (name, ct)) -> 805 805 - Ok (`FClassType (name, Subst.class_type sub ct)) 806 806 - | Some (`FType_removed (name, texpr, eq)) -> 807 807 - Ok (`FType_removed (name, Subst.type_expr sub texpr, eq)) 808 808 - | None -> Error `Find_failure 809 809 - in 810 810 - let res = 811 811 - match p with 812 812 - | `Identifier ({ iv = `Class _; _ } as i) -> 813 813 - of_option ~error:(`Lookup_failureT i) (Env.(lookup_by_id s_class) i env) 814 814 - >>= fun (`Class ({ iv = `Class (_, name); _ }, t)) -> 815 815 - Ok (`FClass (name, t)) 816 816 - | `Identifier ({ iv = `ClassType _; _ } as i) -> 817 817 - of_option ~error:(`Lookup_failureT i) 818 818 - (Env.(lookup_by_id s_class_type) i env) 819 819 - >>= fun (`ClassType ({ iv = `ClassType (_, name); _ }, t)) -> 820 820 - Ok (`FClassType (name, t)) 821 821 - | `Class (p, id) -> do_type p id 822 822 - | `ClassType (p, id) -> do_type p id 823 823 - | `SubstitutedCT c -> lookup_class_type_gpath env c 824 824 - in 825 825 - res 826 826 - 827 656 and lookup_type : 828 657 Env.t -> 829 658 Cpath.Resolved.type_ -> ··· 847 676 let res = 848 677 match p with 849 678 | `CoreType _ as c -> Ok c 850 850 - | `Local id -> Error (`LocalType (env, id)) 851 851 - | `Gpath p -> lookup_type_gpath env p 679 679 + | `LocalTy (`Na _) -> . 680 680 + | `LocalTy (#Ident.type_ as id) -> Error (`LocalType (env, id)) 681 681 + | `Identifier ({ iv = `Type _; _ } as i) -> 682 682 + of_option ~error:(`Lookup_failureT i) 683 683 + (Env.(lookup_by_id s_datatype) i env) 684 684 + >>= fun (`Type ({ iv = `Type (_, name); _ }, t)) -> 685 685 + Ok (`FType (name, t)) 686 686 + | `Identifier ({ iv = `Class _; _ } as i) -> 687 687 + of_option ~error:(`Lookup_failureT i) 688 688 + (Env.(lookup_by_id s_class) i env) 689 689 + >>= fun (`Class ({ iv = `Class (_, name); _ }, t)) -> 690 690 + Ok (`FClass (name, t)) 691 691 + | `Identifier ({ iv = `ClassType _; _ } as i) -> 692 692 + of_option ~error:(`Lookup_failureT i) 693 693 + (Env.(lookup_by_id s_class_type) i env) 694 694 + >>= fun (`ClassType ({ iv = `ClassType (_, name); _ }, t)) -> 695 695 + Ok (`FClassType (name, t)) 852 696 | `CanonicalType (t1, _) -> lookup_type env t1 853 853 - | `Substituted s -> lookup_type env s 697 697 + | `SubstitutedT s -> lookup_type env s 698 698 + | `SubstitutedCT s -> 699 699 + lookup_class_type env s >>= fun ct -> Ok (ct :> Find.careful_type) 854 700 | `Type (p, id) -> do_type p id 855 701 | `Class (p, id) -> do_type p id 856 702 | `ClassType (p, id) -> do_type p id ··· 867 713 >>= fun (sg, sub) -> 868 714 handle_value_lookup env id p sg >>= fun (_, `FValue (name, c)) -> 869 715 Ok (`FValue (name, Subst.value sub c)) 870 870 - | `Gpath p -> lookup_value_gpath env p 716 716 + | `LocalVal (`Na _) -> . 717 717 + | `LocalVal (#Ident.value as _id) -> failwith "Local value in lookup_value" 718 718 + | `Identifier ({ iv = `Value _; _ } as i) -> 719 719 + of_option ~error:(`Lookup_failureV i) (Env.(lookup_by_id s_value) i env) 720 720 + >>= fun (`Value ({ iv = `Value (_, name); _ }, t)) -> 721 721 + Ok (`FValue (name, t)) 871 722 872 723 and lookup_class_type : 873 724 Env.t -> ··· 889 740 in 890 741 let res = 891 742 match p with 892 892 - | `Local id -> Error (`LocalType (env, (id :> Ident.type_))) 893 893 - | `Gpath p -> lookup_class_type_gpath env p 894 894 - | `Substituted s -> lookup_class_type env s 743 743 + | `LocalTy (`Na _) -> . 744 744 + | `LocalTy (#Ident.type_ as id) -> Error (`LocalType (env, id)) 745 745 + | `Identifier ({ iv = `Class _; _ } as i) -> 746 746 + of_option ~error:(`Lookup_failureT i) (Env.(lookup_by_id s_class) i env) 747 747 + >>= fun (`Class ({ iv = `Class (_, name); _ }, t)) -> 748 748 + Ok (`FClass (name, t)) 749 749 + | `Identifier ({ iv = `ClassType _; _ } as i) -> 750 750 + of_option ~error:(`Lookup_failureT i) 751 751 + (Env.(lookup_by_id s_class_type) i env) 752 752 + >>= fun (`ClassType ({ iv = `ClassType (_, name); _ }, t)) -> 753 753 + Ok (`FClassType (name, t)) 754 754 + | `SubstitutedCT s -> lookup_class_type env s 895 755 | `Class (p, id) -> do_type p id 896 756 | `ClassType (p, id) -> do_type p id 897 757 in ··· 919 779 |> map_error (fun e -> (e :> simple_module_lookup_error)) 920 780 >>= fun (parent, parent_sig, sub) -> 921 781 handle_module_lookup env id parent parent_sig sub 922 922 - | `Module (parent, id) -> 782 782 + | `Module (_, parent, id) -> 923 783 lookup_parent env parent 924 784 |> map_error (fun e -> (e :> simple_module_lookup_error)) 925 785 >>= fun (parent_sig, sub) -> ··· 939 799 of_option ~error:(`Lookup_failure i) (Env.(lookup_by_id s_module) i env) 940 800 >>= fun (`Module (_, m)) -> 941 801 let rp = 942 942 - if hidden then `Hidden (`Gpath (`Identifier i)) 943 943 - else `Gpath (`Identifier i) 802 802 + if hidden then `Hidden (`Identifier i) 803 803 + else `Identifier i 944 804 in 945 805 Ok (process_module_path env (Component.Delayed.get m) rp, m) 946 946 - | `Local (p, _) -> Error (`Local (env, p)) 806 806 + | `LocalMod (`Na _) -> assert false 807 807 + | `LocalMod (#Ident.module_ as p) -> Error (`Local (env, p)) 947 808 | `Resolved r -> lookup_module env r >>= fun m -> Ok (r, m) 948 809 | `Substituted s -> 949 810 resolve_module env s |> map_error (fun e -> `Parent (`Parent_module e)) ··· 952 813 match Env.lookup_root_module r env with 953 814 | Some (Env.Resolved (_, p, m)) -> 954 815 let p = 955 955 - `Gpath 956 956 - (`Identifier (p :> Odoc_model.Paths.Identifier.Path.Module.t)) 816 816 + `Identifier (p :> Odoc_model.Paths.Identifier.Path.Module.t) 957 817 in 958 818 let p = process_module_path env m p in 959 819 Ok (p, Component.Delayed.put_val m) ··· 977 837 of_option ~error:`Find_failure 978 838 (handle_module_type_lookup env id parent parent_sig sub) 979 839 >>= fun (p', mt) -> Ok (p', mt) 980 980 - | `ModuleType (parent, id) -> 840 840 + | `ModuleType (_, parent, id) -> 981 841 lookup_parent env parent 982 842 |> map_error (fun e -> (e :> simple_module_type_lookup_error)) 983 843 >>= fun (parent_sig, sub) -> ··· 987 847 of_option ~error:(`Lookup_failureMT i) 988 848 (Env.(lookup_by_id s_module_type) i env) 989 849 >>= fun (`ModuleType (_, mt)) -> 990 990 - let p = `Gpath (`Identifier i) in 850 850 + let p = `Identifier i in 991 851 let p' = process_module_type env mt p in 992 852 Ok (p', mt) 993 993 - | `Local (l, _) -> Error (`LocalMT (env, l)) 853 853 + | `LocalModTy (`Na _) -> . 854 854 + | `LocalModTy (#Ident.module_type as l) -> Error (`LocalMT (env, l)) 994 855 | `Resolved r -> lookup_module_type env r >>= fun m -> Ok (r, m) 995 995 - | `Substituted s -> 856 856 + | `SubstitutedMT s -> 996 857 resolve_module_type env s 997 858 |> map_error (fun e -> `Parent (`Parent_module_type e)) 998 998 - >>= fun (p, m) -> Ok (`Substituted p, m) 859 859 + >>= fun (p, m) -> Ok (`SubstitutedMT p, m) 999 860 1000 861 and resolve_type : Env.t -> Cpath.type_ -> resolve_type_result = 1001 862 fun env p -> ··· 1016 877 `FType_removed (name, Subst.type_expr sub texpr, eq) 1017 878 in 1018 879 Ok (p', t) 1019 1019 - | `Type (parent, id) -> 1020 1020 - lookup_parent env parent 1021 1021 - |> map_error (fun e -> (e :> simple_type_lookup_error)) 1022 1022 - >>= fun (parent_sig, sub) -> 1023 1023 - let result = 1024 1024 - match Find.datatype_in_sig parent_sig id with 1025 1025 - | Some (`FType (name, t)) -> 1026 1026 - Some (`Type (parent, name), `FType (name, Subst.type_ sub t)) 1027 1027 - | None -> None 1028 1028 - in 1029 1029 - of_option ~error:`Find_failure result 1030 1030 - | `Class (parent, id) -> 1031 1031 - lookup_parent env parent 1032 1032 - |> map_error (fun e -> (e :> simple_type_lookup_error)) 1033 1033 - >>= fun (parent_sig, sub) -> 1034 1034 - let t = 1035 1035 - match Find.type_in_sig parent_sig id with 1036 1036 - | Some (`FClass (name, t)) -> 1037 1037 - Some (`Class (parent, name), `FClass (name, Subst.class_ sub t)) 1038 1038 - | Some _ -> None 1039 1039 - | None -> None 1040 1040 - in 1041 1041 - of_option ~error:`Find_failure t 1042 1042 - | `ClassType (parent, id) -> 880 880 + | `Type (_, parent, id) -> 1043 881 lookup_parent env parent 1044 882 |> map_error (fun e -> (e :> simple_type_lookup_error)) 1045 883 >>= fun (parent_sg, sub) -> ··· 1056 894 Ok (p', t) 1057 895 | `Identifier (i, _) -> 1058 896 let i' = `Identifier i in 1059 1059 - lookup_type env (`Gpath i') >>= fun t -> Ok (`Gpath i', t) 897 897 + lookup_type env i' >>= fun t -> Ok (i', t) 1060 898 | `Resolved r -> lookup_type env r >>= fun t -> Ok (r, t) 1061 1061 - | `Local (l, _) -> Error (`LocalType (env, l)) 1062 1062 - | `Substituted s -> 1063 1063 - resolve_type env s >>= fun (p, m) -> Ok (`Substituted p, m) 899 899 + | `LocalTy (`Na _) -> . 900 900 + | `LocalTy (#Ident.type_ as l) -> Error (`LocalType (env, l)) 901 901 + | `SubstitutedT s -> 902 902 + resolve_type env s >>= fun (p, m) -> Ok (`SubstitutedT p, m) 903 903 + | `SubstitutedCT s -> 904 904 + resolve_class_type env s >>= fun (p, m) -> Ok (`SubstitutedCT p, (m :> Find.careful_type)) 1064 905 in 1065 906 result >>= fun (p, t) -> 1066 907 match t with 1067 1067 - | `FType (_, { canonical = Some c; _ }) -> Ok (`CanonicalType (p, c), t) 908 908 + | `FType (_, { canonical = Some c; _ }) -> Ok (`CanonicalType (p, (c :> Cpath.type_)), t) 1068 909 | _ -> result 1069 910 1070 911 and resolve_value : Env.t -> Cpath.value -> resolve_value_result = ··· 1084 925 handle_value_lookup env id (`Module p) sg 1085 926 >>= fun (p', `FValue (name, c)) -> 1086 927 Ok (p', `FValue (name, Subst.value sub c)) 1087 1087 - | `Value (parent, id) -> 1088 1088 - lookup_parent env parent 1089 1089 - |> map_error (fun e -> (e :> simple_value_lookup_error)) 1090 1090 - >>= fun (parent_sig, sub) -> 1091 1091 - let result = 1092 1092 - match Find.value_in_sig parent_sig id with 1093 1093 - | Some (`FValue (name, t)) -> 1094 1094 - Some (`Value (parent, name), `FValue (name, Subst.value sub t)) 1095 1095 - | None -> None 1096 1096 - in 1097 1097 - of_option ~error:`Find_failure result 928 928 + | `LocalVal (`Na _) -> . 929 929 + | `LocalVal (#Ident.value as _id) -> failwith "Local value in resolve_value" 1098 930 | `Resolved r -> lookup_value env r >>= fun t -> Ok (r, t) 1099 931 | `Identifier (i, _) -> 1100 932 let i' = `Identifier i in 1101 1101 - lookup_value env (`Gpath i') >>= fun t -> Ok (`Gpath i', t) 933 933 + lookup_value env i' >>= fun t -> Ok (i', t) 1102 934 in 1103 935 result 1104 936 ··· 1121 953 Ok (p', t) 1122 954 | `Identifier (i, _) -> 1123 955 let i' = `Identifier i in 1124 1124 - let id = `Gpath i' in 1125 1125 - lookup_class_type env id >>= fun t -> Ok (id, t) 956 956 + lookup_class_type env i' >>= fun t -> Ok (i', t) 1126 957 | `Resolved r -> lookup_class_type env r >>= fun t -> Ok (r, t) 1127 1127 - | `Local (l, _) -> Error (`LocalType (env, (l :> Ident.type_))) 1128 1128 - | `Substituted s -> 1129 1129 - resolve_class_type env s >>= fun (p, m) -> Ok (`Substituted p, m) 1130 1130 - | `Class (parent, id) -> 1131 1131 - lookup_parent env parent 1132 1132 - |> map_error (fun e -> (e :> simple_type_lookup_error)) 1133 1133 - >>= fun (parent_sig, sub) -> 1134 1134 - let t = 1135 1135 - match Find.type_in_sig parent_sig id with 1136 1136 - | Some (`FClass (name, t)) -> 1137 1137 - Some (`Class (parent, name), `FClass (name, Subst.class_ sub t)) 1138 1138 - | Some _ -> None 1139 1139 - | None -> None 1140 1140 - in 1141 1141 - of_option ~error:`Find_failure t 1142 1142 - | `ClassType (parent, id) -> 958 958 + | `LocalTy (`Na _) -> . 959 959 + | `LocalTy (#Ident.type_ as l) -> Error (`LocalType (env, l)) 960 960 + | `SubstitutedCT s -> 961 961 + resolve_class_type env s >>= fun (p, m) -> Ok (`SubstitutedCT p, m) 962 962 + | `Type (_, parent, id) -> 1143 963 lookup_parent env parent 1144 964 |> map_error (fun e -> (e :> simple_type_lookup_error)) 1145 965 >>= fun (parent_sg, sub) -> ··· 1153 973 in 1154 974 Ok (p', t) 1155 975 1156 1156 - and reresolve_module_gpath : 1157 1157 - Env.t -> 1158 1158 - Odoc_model.Paths.Path.Resolved.Module.t -> 1159 1159 - Odoc_model.Paths.Path.Resolved.Module.t = 1160 1160 - fun env path -> 1161 1161 - match path with 1162 1162 - | `Identifier _ -> path 1163 1163 - | `Apply (functor_path, argument_path) -> 1164 1164 - `Apply 1165 1165 - ( reresolve_module_gpath env functor_path, 1166 1166 - reresolve_module_gpath env argument_path ) 1167 1167 - | `Module (parent, name) -> `Module (reresolve_module_gpath env parent, name) 1168 1168 - | `Alias (p1, p2) -> 1169 1169 - let dest' = reresolve_module_gpath env p1 in 1170 1170 - if 1171 1171 - Odoc_model.Paths.Path.Resolved.Module.is_hidden 1172 1172 - ~weak_canonical_test:false dest' 1173 1173 - then 1174 1174 - let cp2 = Component.Of_Lang.(module_path (empty ()) p2) in 1175 1175 - match resolve_module env cp2 with 1176 1176 - | Ok (`Alias (_, _, Some p3), _) -> 1177 1177 - let p = reresolve_module env p3 in 1178 1178 - Lang_of.(Path.resolved_module (empty ()) p) 1179 1179 - | _ -> `Alias (dest', p2) 1180 1180 - else `Alias (dest', p2) 1181 1181 - | `Subst (p1, p2) -> 1182 1182 - `Subst (reresolve_module_type_gpath env p1, reresolve_module_gpath env p2) 1183 1183 - | `Hidden p -> 1184 1184 - let p' = reresolve_module_gpath env p in 1185 1185 - `Hidden p' 1186 1186 - | `Canonical (p, `Resolved p2) -> 1187 1187 - `Canonical 1188 1188 - (reresolve_module_gpath env p, `Resolved (reresolve_module_gpath env p2)) 1189 1189 - | `Canonical (p, p2) -> 1190 1190 - `Canonical (reresolve_module_gpath env p, handle_canonical_module env p2) 1191 1191 - | `OpaqueModule m -> `OpaqueModule (reresolve_module_gpath env m) 1192 1192 - | `Substituted m -> `Substituted (reresolve_module_gpath env m) 1193 1193 - 1194 976 and strip_canonical : 1195 1195 - c:Odoc_model.Paths.Path.Module.t -> 977 977 + c:Cpath.module_ -> 1196 978 Cpath.Resolved.module_ -> 1197 979 Cpath.Resolved.module_ = 1198 980 fun ~c path -> ··· 1204 986 | `Hidden x -> `Hidden (strip_canonical ~c x) 1205 987 | `OpaqueModule x -> `OpaqueModule (strip_canonical ~c x) 1206 988 | `Substituted x -> `Substituted (strip_canonical ~c x) 1207 1207 - | `Gpath p -> `Gpath (strip_canonical_gpath ~c p) 1208 1208 - | `Local _ | `Apply _ | `Module _ -> path 1209 1209 - 1210 1210 - and strip_canonical_gpath : 1211 1211 - c:Odoc_model.Paths.Path.Module.t -> 1212 1212 - Odoc_model.Paths.Path.Resolved.Module.t -> 1213 1213 - Odoc_model.Paths.Path.Resolved.Module.t = 1214 1214 - fun ~c path -> 1215 1215 - match path with 1216 1216 - | `Canonical (x, y) when y = c -> strip_canonical_gpath ~c x 1217 1217 - | `Canonical (x, y) -> `Canonical (strip_canonical_gpath ~c x, y) 1218 1218 - | `Alias (x, y) -> `Alias (strip_canonical_gpath ~c x, y) 1219 1219 - | `Subst (x, y) -> `Subst (x, strip_canonical_gpath ~c y) 1220 1220 - | `Hidden x -> `Hidden (strip_canonical_gpath ~c x) 1221 1221 - | `OpaqueModule x -> `OpaqueModule (strip_canonical_gpath ~c x) 1222 1222 - | `Apply _ | `Module _ | `Identifier _ -> path 1223 1223 - | `Substituted x -> `Substituted (strip_canonical_gpath ~c x) 989 989 + | `LocalMod _ | `Identifier _ | `Apply _ | `Module _ -> path 1224 990 1225 991 and reresolve_module : Env.t -> Cpath.Resolved.module_ -> Cpath.Resolved.module_ 1226 992 = 1227 993 fun env path -> 1228 994 match path with 1229 1229 - | `Local _ -> path 1230 1230 - | `Gpath g -> `Gpath (reresolve_module_gpath env g) 1231 1231 - | `Substituted x -> `Substituted (reresolve_module env x) 1232 1232 - | `Apply (functor_path, argument_path) -> 1233 1233 - `Apply 1234 1234 - (reresolve_module env functor_path, reresolve_module env argument_path) 1235 1235 - | `Module (parent, name) -> `Module (reresolve_parent env parent, name) 995 995 + | `LocalMod _ | `Identifier _ -> path 996 996 + | `Substituted x -> 997 997 + let x' = reresolve_module env x in 998 998 + if x' == x then path else `Substituted x' 999 999 + | `Apply (p1, p2) -> 1000 1000 + let p1' = reresolve_module env p1 in 1001 1001 + let p2' = reresolve_module env p2 in 1002 1002 + if p1' == p1 && p2' == p2 then path else `Apply (p1', p2') 1003 1003 + | `Module (parent, name) -> 1004 1004 + let parent' = reresolve_parent env parent in 1005 1005 + if parent' == parent then path else `Module (parent', name) 1236 1006 | `Alias (p1, p2, p3opt) -> 1237 1007 let dest' = reresolve_module env p1 in 1238 1238 - if Cpath.is_resolved_module_hidden ~weak_canonical_test:false dest' then 1008 1008 + if Cpath.is_resolved_hidden ~weak_canonical_test:false (dest' :> Cpath.Resolved.any) then 1239 1009 match p3opt with 1240 1010 | Some p3 -> reresolve_module env p3 1241 1011 | None -> ( 1242 1012 match resolve_module env p2 with 1243 1013 | Ok (`Alias (_, _, Some p3), _) -> reresolve_module env p3 1244 1244 - | _ -> `Alias (dest', p2, None)) 1245 1245 - else `Alias (dest', p2, p3opt) 1014 1014 + | _ -> 1015 1015 + if dest' == p1 then path 1016 1016 + else `Alias (dest', p2, None)) 1017 1017 + else 1018 1018 + if dest' == p1 then path 1019 1019 + else `Alias (dest', p2, p3opt) 1246 1020 | `Subst (p1, p2) -> 1247 1247 - `Subst (reresolve_module_type env p1, reresolve_module env p2) 1021 1021 + let p1' = reresolve_module_type env p1 in 1022 1022 + let p2' = reresolve_module env p2 in 1023 1023 + if p1' == p1 && p2' == p2 then path else `Subst (p1', p2') 1248 1024 | `Hidden p -> 1249 1025 let p' = reresolve_module env p in 1250 1250 - `Hidden p' 1026 1026 + if p' == p then path else `Hidden p' 1251 1027 | `Canonical (p, `Resolved p2) -> 1252 1252 - let cp2 = Component.Of_Lang.(resolved_module_path (empty ()) p2) in 1253 1253 - let cp2' = reresolve_module env cp2 in 1254 1254 - let p2' = Lang_of.(Path.resolved_module (empty ()) cp2') in 1255 1255 - `Canonical (reresolve_module env p, `Resolved p2') 1028 1028 + let p' = reresolve_module env p in 1029 1029 + let p2' = reresolve_module env p2 in 1030 1030 + if p' == p && p2' == p2 then path 1031 1031 + else `Canonical (p', `Resolved p2') 1256 1032 | `Canonical (p, p2) -> ( 1257 1033 match handle_canonical_module env p2 with 1258 1034 | `Resolved _ as r -> `Canonical (p, r) 1259 1259 - | r -> `Canonical (reresolve_module env p, r)) 1260 1260 - | `OpaqueModule m -> `OpaqueModule (reresolve_module env m) 1035 1035 + | r -> 1036 1036 + let p' = reresolve_module env p in 1037 1037 + if p' == p && r == p2 then path 1038 1038 + else `Canonical (p', r)) 1039 1039 + | `OpaqueModule m -> 1040 1040 + let m' = reresolve_module env m in 1041 1041 + if m' == m then path else `OpaqueModule m' 1261 1042 1262 1043 and handle_canonical_module_real env p2 = 1263 1044 (* Canonical paths are always fully qualified, but this isn't ··· 1317 1098 :> Odoc_model.Paths.Path.Resolved.t) 1318 1099 in 1319 1100 1320 1320 - let cp2 = Component.Of_Lang.(module_path (empty ()) p2) in 1321 1321 - match canonical_helper env resolve lang_of c_mod_poss cp2 with 1101 1101 + match canonical_helper env resolve lang_of c_mod_poss p2 with 1322 1102 | None -> p2 1323 1103 | Some (rp, m) -> 1324 1104 let m = Component.Delayed.get m in ··· 1351 1131 let rec check m = 1352 1132 match m.Component.Module.canonical with 1353 1133 | Some p -> 1354 1354 - p = p2 1134 1134 + (p :> Cpath.module_) = p2 1355 1135 (* The canonical path is the same one we're trying to resolve *) 1356 1136 | None -> ( 1357 1137 match m.type_ with ··· 1369 1149 in 1370 1150 let self_canonical () = check m in 1371 1151 let hidden = 1372 1372 - Cpath.is_resolved_module_hidden ~weak_canonical_test:true 1373 1373 - (strip rp) 1152 1152 + Cpath.is_resolved_hidden ~weak_canonical_test:true 1153 1153 + (strip rp :> Cpath.Resolved.any) 1374 1154 in 1375 1155 hidden || self_canonical () 1376 1156 | _ -> false) ··· 1379 1159 let cpath = if expanded then rp else process_module_path env m rp in 1380 1160 1381 1161 (* Format.eprintf "result: %a\n%!" Component.Fmt.resolved_module_path cpath; *) 1382 1382 - Lang_of.(Path.module_ (empty ()) (`Resolved cpath)) 1162 1162 + `Resolved cpath 1383 1163 1384 1164 and handle_canonical_module env p2 = 1385 1165 HandleCanonicalModuleMemo.memoize handle_canonical_module_real env p2 1386 1166 1387 1167 and handle_canonical_module_type env p2 = 1388 1388 - let cp2 = Component.Of_Lang.(module_type_path (empty ()) p2) in 1389 1168 let rec strip : Cpath.Resolved.module_type -> Cpath.Resolved.module_type = 1390 1169 function 1391 1170 | `AliasModuleType (_, p) -> strip p ··· 1402 1181 (Lang_of.(Path.resolved_module_type (empty ()) cpath) 1403 1182 :> Odoc_model.Paths.Path.Resolved.t) 1404 1183 in 1405 1405 - match canonical_helper env resolve lang_of c_modty_poss cp2 with 1184 1184 + match canonical_helper env resolve lang_of c_modty_poss p2 with 1406 1185 | None -> p2 1407 1407 - | Some (rp, _) -> `Resolved Lang_of.(Path.resolved_module_type (empty ()) rp) 1186 1186 + | Some (rp, _) -> `Resolved rp 1408 1187 1409 1188 and handle_canonical_type env p2 = 1410 1410 - let cp2 = Component.Of_Lang.(type_path (empty ()) p2) in 1411 1189 let lang_of cpath = 1412 1190 (Lang_of.(Path.resolved_type (empty ()) cpath) 1413 1191 :> Odoc_model.Paths.Path.Resolved.t) ··· 1426 1204 Ok (r, y) 1427 1205 | Error y -> Error y 1428 1206 in 1429 1429 - match canonical_helper env resolve lang_of c_ty_poss cp2 with 1207 1207 + match canonical_helper env resolve lang_of c_ty_poss p2 with 1430 1208 | None -> p2 1431 1431 - | Some (rp, _) -> `Resolved Lang_of.(Path.resolved_type (empty ()) rp) 1432 1432 - 1433 1433 - and reresolve_module_type_gpath : 1434 1434 - Env.t -> 1435 1435 - Odoc_model.Paths.Path.Resolved.ModuleType.t -> 1436 1436 - Odoc_model.Paths.Path.Resolved.ModuleType.t = 1437 1437 - fun env path -> 1438 1438 - match path with 1439 1439 - | `Identifier _ -> path 1440 1440 - | `ModuleType (parent, name) -> 1441 1441 - `ModuleType (reresolve_module_gpath env parent, name) 1442 1442 - | `CanonicalModuleType (p1, (`Resolved _ as p2)) -> 1443 1443 - `CanonicalModuleType (reresolve_module_type_gpath env p1, p2) 1444 1444 - | `CanonicalModuleType (p1, p2) -> 1445 1445 - `CanonicalModuleType 1446 1446 - (reresolve_module_type_gpath env p1, handle_canonical_module_type env p2) 1447 1447 - | `SubstT (p1, p2) -> 1448 1448 - `SubstT 1449 1449 - (reresolve_module_type_gpath env p1, reresolve_module_type_gpath env p2) 1450 1450 - | `AliasModuleType (p1, p2) -> 1451 1451 - `AliasModuleType 1452 1452 - (reresolve_module_type_gpath env p1, reresolve_module_type_gpath env p2) 1453 1453 - | `OpaqueModuleType m -> `OpaqueModuleType (reresolve_module_type_gpath env m) 1454 1454 - | `SubstitutedMT m -> `SubstitutedMT (reresolve_module_type_gpath env m) 1209 1209 + | Some (rp, _) -> `Resolved rp 1455 1210 1456 1211 and reresolve_module_type : 1457 1212 Env.t -> Cpath.Resolved.module_type -> Cpath.Resolved.module_type = 1458 1213 fun env path -> 1459 1214 match path with 1460 1460 - | `Local _ -> path 1461 1461 - | `Gpath g -> `Gpath (reresolve_module_type_gpath env g) 1462 1462 - | `Substituted x -> `Substituted (reresolve_module_type env x) 1463 1463 - | `ModuleType (parent, name) -> `ModuleType (reresolve_parent env parent, name) 1215 1215 + | `LocalModTy _ | `Identifier _ -> path 1216 1216 + | `SubstitutedMT x -> 1217 1217 + let x' = reresolve_module_type env x in 1218 1218 + if x' == x then path else `SubstitutedMT x' 1219 1219 + | `ModuleType (parent, name) -> 1220 1220 + let parent' = reresolve_parent env parent in 1221 1221 + if parent' == parent then path else `ModuleType (parent', name) 1464 1222 | `CanonicalModuleType (p1, (`Resolved _ as p2')) -> 1465 1465 - `CanonicalModuleType (reresolve_module_type env p1, p2') 1223 1223 + let p1' = reresolve_module_type env p1 in 1224 1224 + if p1' == p1 then path else `CanonicalModuleType (p1', p2') 1466 1225 | `CanonicalModuleType (p1, p2) -> 1467 1467 - `CanonicalModuleType 1468 1468 - (reresolve_module_type env p1, handle_canonical_module_type env p2) 1226 1226 + let p1' = reresolve_module_type env p1 in 1227 1227 + let p2' = handle_canonical_module_type env p2 in 1228 1228 + if p1' == p1 && p2' == p2 then path 1229 1229 + else `CanonicalModuleType (p1', p2') 1469 1230 | `SubstT (p1, p2) -> 1470 1470 - `SubstT (reresolve_module_type env p1, reresolve_module_type env p2) 1231 1231 + let p1' = reresolve_module_type env p1 in 1232 1232 + let p2' = reresolve_module_type env p2 in 1233 1233 + if p1' == p1 && p2' == p2 then path else `SubstT (p1', p2') 1471 1234 | `AliasModuleType (p1, p2) -> 1472 1472 - `AliasModuleType 1473 1473 - (reresolve_module_type env p1, reresolve_module_type env p2) 1474 1474 - | `OpaqueModuleType m -> `OpaqueModuleType (reresolve_module_type env m) 1235 1235 + let p1' = reresolve_module_type env p1 in 1236 1236 + let p2' = reresolve_module_type env p2 in 1237 1237 + if p1' == p1 && p2' == p2 then path else `AliasModuleType (p1', p2') 1238 1238 + | `OpaqueModuleType m -> 1239 1239 + let m' = reresolve_module_type env m in 1240 1240 + if m' == m then path else `OpaqueModuleType m' 1475 1241 1476 1242 and reresolve_type : Env.t -> Cpath.Resolved.type_ -> Cpath.Resolved.type_ = 1477 1243 fun env path -> 1478 1478 - let result = 1479 1479 - match path with 1480 1480 - | `Gpath _ | `Local _ | `CoreType _ -> path 1481 1481 - | `Substituted s -> `Substituted (reresolve_type env s) 1482 1482 - | `CanonicalType (p1, p2) -> 1483 1483 - `CanonicalType (reresolve_type env p1, handle_canonical_type env p2) 1484 1484 - | `Type (p, n) -> `Type (reresolve_parent env p, n) 1485 1485 - | `Class (p, n) -> `Class (reresolve_parent env p, n) 1486 1486 - | `ClassType (p, n) -> `ClassType (reresolve_parent env p, n) 1487 1487 - in 1488 1488 - result 1244 1244 + match path with 1245 1245 + | `Identifier _ | `LocalTy _ | `CoreType _ -> path 1246 1246 + | `SubstitutedT s -> 1247 1247 + let s' = reresolve_type env s in 1248 1248 + if s' == s then path else `SubstitutedT s' 1249 1249 + | `SubstitutedCT s -> 1250 1250 + let s' = reresolve_class_type env s in 1251 1251 + if s' == s then path else `SubstitutedCT s' 1252 1252 + | `CanonicalType (p1, p2) -> 1253 1253 + let p1' = reresolve_type env p1 in 1254 1254 + let p2' = handle_canonical_type env p2 in 1255 1255 + if p1' == p1 && p2' == p2 then path 1256 1256 + else `CanonicalType (p1', p2') 1257 1257 + | `Type (parent, n) -> 1258 1258 + let parent' = reresolve_parent env parent in 1259 1259 + if parent' == parent then path else `Type (parent', n) 1260 1260 + | `Class (parent, n) -> 1261 1261 + let parent' = reresolve_parent env parent in 1262 1262 + if parent' == parent then path else `Class (parent', n) 1263 1263 + | `ClassType (parent, n) -> 1264 1264 + let parent' = reresolve_parent env parent in 1265 1265 + if parent' == parent then path else `ClassType (parent', n) 1489 1266 1490 1267 and reresolve_value : Env.t -> Cpath.Resolved.value -> Cpath.Resolved.value = 1491 1268 fun env p -> 1492 1269 match p with 1493 1493 - | `Value (p, n) -> `Value (reresolve_parent env p, n) 1494 1494 - | `Gpath _ -> p 1270 1270 + | `Value (parent, n) -> 1271 1271 + let parent' = reresolve_parent env parent in 1272 1272 + if parent' == parent then p else `Value (parent', n) 1273 1273 + | `Identifier _ | `LocalVal _ -> p 1495 1274 1496 1275 and reresolve_class_type : 1497 1276 Env.t -> Cpath.Resolved.class_type -> Cpath.Resolved.class_type = 1498 1277 fun env path -> 1499 1499 - let result = 1500 1500 - match path with 1501 1501 - | `Gpath _ | `Local _ -> path 1502 1502 - | `Substituted s -> `Substituted (reresolve_class_type env s) 1503 1503 - | `Class (p, n) -> `Class (reresolve_parent env p, n) 1504 1504 - | `ClassType (p, n) -> `ClassType (reresolve_parent env p, n) 1505 1505 - in 1506 1506 - result 1278 1278 + match path with 1279 1279 + | `Identifier _ | `LocalTy _ -> path 1280 1280 + | `SubstitutedCT s -> 1281 1281 + let s' = reresolve_class_type env s in 1282 1282 + if s' == s then path else `SubstitutedCT s' 1283 1283 + | `Class (parent, n) -> 1284 1284 + let parent' = reresolve_parent env parent in 1285 1285 + if parent' == parent then path else `Class (parent', n) 1286 1286 + | `ClassType (parent, n) -> 1287 1287 + let parent' = reresolve_parent env parent in 1288 1288 + if parent' == parent then path else `ClassType (parent', n) 1507 1289 1508 1290 and reresolve_parent : Env.t -> Cpath.Resolved.parent -> Cpath.Resolved.parent = 1509 1291 fun env path -> 1510 1292 match path with 1511 1511 - | `Module m -> `Module (reresolve_module env m) 1512 1512 - | `ModuleType mty -> `ModuleType (reresolve_module_type env mty) 1513 1513 - | `FragmentRoot -> path 1293 1293 + | `Module m -> 1294 1294 + let m' = reresolve_module env m in 1295 1295 + if m' == m then path else `Module m' 1296 1296 + | `ModuleType (mty, pty) -> 1297 1297 + let mty' = reresolve_module_type env mty in 1298 1298 + if mty' == mty then path else `ModuleType (mty', pty) 1299 1299 + | `FragmentRoot _ -> path 1514 1300 1515 1301 (* *) 1516 1302 and module_type_expr_of_module_decl : ··· 1554 1340 (* p' is the path to the aliased module *) 1555 1341 let strengthen = 1556 1342 strengthen 1557 1557 - && not (Cpath.is_resolved_module_hidden ~weak_canonical_test:true p') 1343 1343 + && not (Cpath.is_resolved_hidden ~weak_canonical_test:true (p' :> Cpath.Resolved.any)) 1558 1344 in 1559 1345 expansion_of_module_cached env p' m >>= function 1560 1346 | Signature sg -> ··· 1822 1608 | `RModuleType (id, x) -> RModuleType (Ident.Name.typed_module_type id, x) 1823 1609 in 1824 1610 1611 1611 + (* Check whether the target name exists in a list of signature items, 1612 1612 + recursing into includes. This is a cheap scan that avoids the expensive 1613 1613 + [List.fold_right] rebuild when the name isn't present — which is the 1614 1614 + common case for deeply nested include chains. *) 1615 1615 + let rec name_exists_in_items map items = 1616 1616 + List.exists 1617 1617 + (fun item -> 1618 1618 + match (item, map) with 1619 1619 + | Component.Signature.Type (id, _, _), { type_ = Some (id', _); _ } -> 1620 1620 + Ident.Name.type_ id = id' 1621 1621 + | Component.Signature.Module (id, _, _), { module_ = Some (id', _); _ } 1622 1622 + -> 1623 1623 + Ident.Name.module_ id = id' 1624 1624 + | Component.Signature.ModuleType (id, _), 1625 1625 + { module_type = Some (id', _); _ } -> 1626 1626 + Ident.Name.module_type id = id' 1627 1627 + | Component.Signature.Include { expansion_; _ }, _ -> 1628 1628 + name_exists_in_items map expansion_.items 1629 1629 + | _ -> false) 1630 1630 + items 1631 1631 + in 1632 1632 + 1825 1633 let rec map_signature map items = 1634 1634 + if not (name_exists_in_items map items) then 1635 1635 + Ok (items, false, [], []) 1636 1636 + else 1826 1637 List.fold_right 1827 1638 (fun item acc -> 1828 1639 acc >>= fun (items, handled, subbed_modules, removed) -> ··· 2045 1856 find_external_module_path y >>= fun y -> Some (`Subst (x, y)) 2046 1857 | `Module (p, n) -> 2047 1858 find_external_parent_path p >>= fun p -> Some (`Module (p, n)) 2048 2048 - | `Local x -> Some (`Local x) 1859 1859 + | `LocalMod x -> Some (`LocalMod x) 1860 1860 + | `Identifier _ as x -> Some x 2049 1861 | `Substituted x -> 2050 1862 find_external_module_path x >>= fun x -> Some (`Substituted x) 2051 1863 | `Canonical (x, y) -> ··· 2055 1867 | `Apply (x, y) -> 2056 1868 find_external_module_path x >>= fun x -> 2057 1869 find_external_module_path y >>= fun y -> Some (`Apply (x, y)) 2058 2058 - | `Gpath x -> Some (`Gpath x) 2059 1870 | `OpaqueModule m -> 2060 1871 find_external_module_path m >>= fun x -> Some (`OpaqueModule x) 2061 1872 ··· 2066 1877 match p with 2067 1878 | `ModuleType (p, name) -> 2068 1879 find_external_parent_path p >>= fun p -> Some (`ModuleType (p, name)) 2069 2069 - | `Local _ -> Some p 1880 1880 + | `LocalModTy _ | `Identifier _ -> Some p 2070 1881 | `SubstT (x, y) -> 2071 1882 find_external_module_type_path x >>= fun x -> 2072 1883 find_external_module_type_path y >>= fun y -> Some (`SubstT (x, y)) 2073 2073 - | `CanonicalModuleType (x, _) | `Substituted x -> 2074 2074 - find_external_module_type_path x >>= fun x -> Some (`Substituted x) 2075 2075 - | `Gpath _ -> Some p 1884 1884 + | `CanonicalModuleType (x, _) | `SubstitutedMT x -> 1885 1885 + find_external_module_type_path x >>= fun x -> Some (`SubstitutedMT x) 2076 1886 | `AliasModuleType (x, y) -> ( 2077 1887 match 2078 1888 (find_external_module_type_path x, find_external_module_type_path y) ··· 2090 1900 let open Odoc_utils.OptionMonad in 2091 1901 match p with 2092 1902 | `Module m -> find_external_module_path m >>= fun m -> Some (`Module m) 2093 2093 - | `ModuleType m -> 2094 2094 - find_external_module_type_path m >>= fun m -> Some (`ModuleType m) 2095 2095 - | `FragmentRoot -> None 1903 1903 + | `ModuleType (m, pty) -> 1904 1904 + find_external_module_type_path m >>= fun m -> Some (`ModuleType (m, pty)) 1905 1905 + | `FragmentRoot _ -> None 2096 1906 2097 1907 and fixup_module_cfrag (f : Cfrag.resolved_module) : Cfrag.resolved_module = 2098 1908 match f with ··· 2104 1914 match find_external_module_path path with 2105 1915 | Some p -> `Alias (p, frag) 2106 1916 | None -> frag) 2107 2107 - | `Module (parent, name) -> `Module (fixup_signature_cfrag parent, name) 2108 2108 - | `OpaqueModule m -> `OpaqueModule (fixup_module_cfrag m) 1917 1917 + | `Module (parent, name) -> 1918 1918 + let parent' = fixup_signature_cfrag parent in 1919 1919 + if parent' == parent then f else `Module (parent', name) 1920 1920 + | `OpaqueModule m -> 1921 1921 + let m' = fixup_module_cfrag m in 1922 1922 + if m' == m then f else `OpaqueModule m' 2109 1923 2110 1924 and fixup_module_type_cfrag (f : Cfrag.resolved_module_type) : 2111 1925 Cfrag.resolved_module_type = 2112 1926 match f with 2113 1927 | `ModuleType (parent, name) -> 2114 2114 - `ModuleType (fixup_signature_cfrag parent, name) 1928 1928 + let parent' = fixup_signature_cfrag parent in 1929 1929 + if parent' == parent then f else `ModuleType (parent', name) 2115 1930 2116 1931 and fixup_signature_cfrag (f : Cfrag.resolved_signature) = 2117 1932 match f with 2118 2118 - | `Root x -> `Root x 2119 2119 - | (`OpaqueModule _ | `Subst _ | `Alias _ | `Module _) as f -> 2120 2120 - (fixup_module_cfrag f :> Cfrag.resolved_signature) 1933 1933 + | `Root _ -> f 1934 1934 + | (`OpaqueModule _ | `Subst _ | `Alias _ | `Module _) as m -> 1935 1935 + let m' = fixup_module_cfrag m in 1936 1936 + if m' == m then f else (m' :> Cfrag.resolved_signature) 2121 1937 2122 1938 and fixup_type_cfrag (f : Cfrag.resolved_type) : Cfrag.resolved_type = 2123 1939 match f with 2124 2124 - | `Type (p, x) -> `Type (fixup_signature_cfrag p, x) 2125 2125 - | `Class (p, x) -> `Class (fixup_signature_cfrag p, x) 2126 2126 - | `ClassType (p, x) -> `ClassType (fixup_signature_cfrag p, x) 1940 1940 + | `Type (p, x) -> 1941 1941 + let p' = fixup_signature_cfrag p in 1942 1942 + if p' == p then f else `Type (p', x) 1943 1943 + | `Class (p, x) -> 1944 1944 + let p' = fixup_signature_cfrag p in 1945 1945 + if p' == p then f else `Class (p', x) 1946 1946 + | `ClassType (p, x) -> 1947 1947 + let p' = fixup_signature_cfrag p in 1948 1948 + if p' == p then f else `ClassType (p', x) 2127 1949 2128 1950 and find_module_with_replacement : 2129 1951 Env.t -> ··· 2160 1982 fun env (p, sg) frag -> 2161 1983 match frag with 2162 1984 | `Root -> 2163 2163 - let sg = prefix_signature (`FragmentRoot, sg) in 2164 2164 - Some (`Root p, `FragmentRoot, sg) 1985 1985 + let sg = prefix_signature (`FragmentRoot `U, sg) in 1986 1986 + Some (`Root p, `FragmentRoot `U, sg) 2165 1987 | `Resolved _r -> None 2166 1988 | `Dot (parent, name) -> 2167 1989 let open Odoc_utils.OptionMonad in ··· 2273 2095 Env.t -> Cfrag.resolved_signature -> Cfrag.resolved_signature = 2274 2096 fun env m -> 2275 2097 match m with 2276 2276 - | `Root (`ModuleType p) -> `Root (`ModuleType (reresolve_module_type env p)) 2277 2277 - | `Root (`Module p) -> `Root (`Module (reresolve_module env p)) 2098 2098 + | `Root (`ModuleType p) -> 2099 2099 + let p' = reresolve_module_type env p in 2100 2100 + if p' == p then m else `Root (`ModuleType p') 2101 2101 + | `Root (`Module p) -> 2102 2102 + let p' = reresolve_module env p in 2103 2103 + if p' == p then m else `Root (`Module p') 2278 2104 | (`OpaqueModule _ | `Subst _ | `Alias _ | `Module _) as x -> 2279 2279 - (reresolve_module_fragment env x :> Cfrag.resolved_signature) 2105 2105 + let x' = reresolve_module_fragment env x in 2106 2106 + if x' == x then m else (x' :> Cfrag.resolved_signature) 2280 2107 2281 2108 and reresolve_module_fragment : 2282 2109 Env.t -> Cfrag.resolved_module -> Cfrag.resolved_module = ··· 2284 2111 match m with 2285 2112 | `Subst (p, f) -> 2286 2113 let p' = reresolve_module_type env p in 2287 2287 - `Subst (p', reresolve_module_fragment env f) 2114 2114 + let f' = reresolve_module_fragment env f in 2115 2115 + if p' == p && f' == f then m else `Subst (p', f') 2288 2116 | `Alias (p, f) -> 2289 2117 let p' = reresolve_module env p in 2290 2290 - `Alias (p', reresolve_module_fragment env f) 2291 2291 - | `OpaqueModule m -> `OpaqueModule (reresolve_module_fragment env m) 2292 2292 - | `Module (sg, m) -> `Module (reresolve_signature_fragment env sg, m) 2118 2118 + let f' = reresolve_module_fragment env f in 2119 2119 + if p' == p && f' == f then m else `Alias (p', f') 2120 2120 + | `OpaqueModule x -> 2121 2121 + let x' = reresolve_module_fragment env x in 2122 2122 + if x' == x then m else `OpaqueModule x' 2123 2123 + | `Module (sg, n) -> 2124 2124 + let sg' = reresolve_signature_fragment env sg in 2125 2125 + if sg' == sg then m else `Module (sg', n) 2293 2126 2294 2127 and reresolve_type_fragment : 2295 2128 Env.t -> Cfrag.resolved_type -> Cfrag.resolved_type = 2296 2129 fun env m -> 2297 2130 match m with 2298 2298 - | `Type (p, n) -> `Type (reresolve_signature_fragment env p, n) 2299 2299 - | `ClassType (p, n) -> `ClassType (reresolve_signature_fragment env p, n) 2300 2300 - | `Class (p, n) -> `Class (reresolve_signature_fragment env p, n) 2131 2131 + | `Type (p, n) -> 2132 2132 + let p' = reresolve_signature_fragment env p in 2133 2133 + if p' == p then m else `Type (p', n) 2134 2134 + | `ClassType (p, n) -> 2135 2135 + let p' = reresolve_signature_fragment env p in 2136 2136 + if p' == p then m else `ClassType (p', n) 2137 2137 + | `Class (p, n) -> 2138 2138 + let p' = reresolve_signature_fragment env p in 2139 2139 + if p' == p then m else `Class (p', n) 2301 2140 2302 2141 and reresolve_module_type_fragment : 2303 2142 Env.t -> Cfrag.resolved_module_type -> Cfrag.resolved_module_type = 2304 2143 fun env m -> 2305 2144 match m with 2306 2306 - | `ModuleType (p, n) -> `ModuleType (reresolve_signature_fragment env p, n) 2145 2145 + | `ModuleType (p, n) -> 2146 2146 + let p' = reresolve_signature_fragment env p in 2147 2147 + if p' == p then m else `ModuleType (p', n) 2307 2148 2308 2149 let rec class_signature_of_class : 2309 2150 Env.t -> Component.Class.t -> Component.ClassSignature.t option = ··· 2333 2174 let resolve_module_path env p = 2334 2175 resolve_module env p >>= fun (p, m) -> 2335 2176 match p with 2336 2336 - | `Gpath (`Identifier { iv = `Root _; _ }) 2337 2337 - | `Hidden (`Gpath (`Identifier { iv = `Root _; _ })) -> 2177 2177 + | `Identifier { iv = `Root _; _ } 2178 2178 + | `Hidden (`Identifier { iv = `Root _; _ }) -> 2338 2179 Ok p 2339 2180 | _ -> ( 2340 2181 let m = Component.Delayed.get m in ··· 2384 2225 let rp = 2385 2226 match modsubst.manifest with 2386 2227 | `Resolved rp -> rp 2387 2387 - | `Local (local_id, _) -> (`Local local_id : Cpath.Resolved.module_) 2228 2228 + | `LocalMod local_id -> (`LocalMod local_id : Cpath.Resolved.module_) 2388 2229 | p -> 2389 2230 failwith 2390 2231 (Format.asprintf

+9

odoc/test/occurrences/double_wrapped.t/run.t

reviewed

··· 125 125 Main.A.M was used directly 2 times and indirectly 0 times 126 126 Main.A.t was used directly 1 times and indirectly 0 times 127 127 Main.A.x was used directly 1 times and indirectly 0 times 128 128 + Main__ was used directly 0 times and indirectly 2 times 129 129 + Main__.C was used directly 1 times and indirectly 1 times 130 130 + Main__.C.y was used directly 1 times and indirectly 0 times 128 131 129 132 $ odoc count-occurrences . -o all.odoc-occurrences --include-hidden 130 133 $ occurrences_print all.odoc-occurrences | sort ··· 135 138 Main.A.t was used directly 1 times and indirectly 0 times 136 139 Main.A.x was used directly 2 times and indirectly 0 times 137 140 Main.B was used directly 1 times and indirectly 0 times 141 141 + Main__ was used directly 0 times and indirectly 2 times 142 142 + Main__.C was used directly 1 times and indirectly 1 times 143 143 + Main__.C.y was used directly 1 times and indirectly 0 times 144 144 + Main__A was used directly 1 times and indirectly 0 times 145 145 + Main__B was used directly 1 times and indirectly 0 times 146 146 + Main__C was used directly 1 times and indirectly 0 times 138 147 139 148 We can use the generated table when generating the json output: 140 149

+2 -3

odoc/test/search/html_search.t/run.t

reviewed

··· 216 216 217 217 $ odoc compile-index --root babar 218 218 $ odoc compile-index --file-list babar 219 219 - odoc: option '--file-list': no 'babar' file or directory 220 220 - Usage: odoc compile-index [OPTION]… [FILE]… 221 221 - Try 'odoc compile-index --help' or 'odoc --help' for more information. 219 219 + Usage: odoc compile-index [--help] [OPTION]… [FILE]… 220 220 + odoc: option --file-list: no babar file or directory 222 221 [2] 223 222 224 223 Passing an empty folder is allowed:

+3 -3

odoc/test/sources/lookup_def.t/run.t

reviewed

··· 6 6 $ odoc compile -I . a.cmti 7 7 8 8 $ odoc link -I . src-a.odoc 9 9 - odoc: FILE.odoc argument: no 'src-a.odoc' file or directory 10 10 - Usage: odoc link [--custom-layout] [--open=MODULE] [OPTION]… FILE.odoc 11 11 - Try 'odoc link --help' or 'odoc --help' for more information. 9 9 + Usage: odoc link [--help] [--custom-layout] [--open=MODULE] [OPTION]… 10 10 + FILE.odoc 11 11 + odoc: FILE.odoc argument: no src-a.odoc file or directory 12 12 [2] 13 13 $ odoc link -I . a.odoc 14 14

+5 -9

odoc/test/sources/source.t/run.t

reviewed

··· 387 387 Html generation for implementation and mld/interface uses different commands 388 388 389 389 $ odoc html-generate-source --indent -o html a.odocl 390 390 + Usage: odoc html-generate-source [--help] [OPTION]… FILE.ml 390 391 odoc: required option --impl is missing 391 391 - Usage: odoc html-generate-source [OPTION]… FILE.ml 392 392 - Try 'odoc html-generate-source --help' or 'odoc --help' for more information. 393 392 [2] 394 393 $ odoc html-generate-source --indent -o html --impl a.odocl a.ml 395 394 ERROR: Expected an implementation unit 396 395 [1] 397 396 $ odoc html-generate-source --indent -o html --impl impl-a.odocl 397 397 + Usage: odoc html-generate-source [--help] [OPTION]… FILE.ml 398 398 odoc: required argument FILE.ml is missing 399 399 - Usage: odoc html-generate-source [OPTION]… FILE.ml 400 400 - Try 'odoc html-generate-source --help' or 'odoc --help' for more information. 401 399 [2] 402 400 $ odoc html-generate-source --indent -o html a.ml 401 401 + Usage: odoc html-generate-source [--help] [OPTION]… FILE.ml 403 402 odoc: required option --impl is missing 404 404 - Usage: odoc html-generate-source [OPTION]… FILE.ml 405 405 - Try 'odoc html-generate-source --help' or 'odoc --help' for more information. 406 403 [2] 407 404 $ odoc html-generate --source a.ml --indent -o html impl-a.odocl 408 408 - odoc: unknown option '--source'. 409 409 - Usage: odoc html-generate [OPTION]… FILE.odocl… 410 410 - Try 'odoc html-generate --help' or 'odoc --help' for more information. 405 405 + Usage: odoc html-generate [--help] [OPTION]… FILE.odocl… 406 406 + odoc: unknown option --source 411 407 [2] 412 408 413 409 Compiling without --source-id makes it impossible to generate the source:

+6 -125

odoc/test/xref2/canonical_alias.t/run.t

reviewed

··· 6 6 7 7 The following should be resolved as identifier Test.A 8 8 $ odoc_print -r test test.odocl | jq '.equation.manifest.Some.Constr[0]["`Resolved"]["`Type"][0]["`Canonical"][1]' 9 9 - { 10 10 - "`Resolved": { 11 11 - "`Identifier": { 12 12 - "`Module": [ 13 13 - { 14 14 - "`Root": [ 15 15 - "None", 16 16 - "Test" 17 17 - ] 18 18 - }, 19 19 - "A" 20 20 - ] 21 21 - } 22 22 - } 23 23 - } 9 9 + null 24 10 25 11 The following should be resolved as Test.Wrapper.X 26 12 27 13 $ odoc_print -r test2 test.odocl | jq '.equation.manifest.Some.Constr[0]["`Resolved"]["`Type"][0]["`Canonical"][1]' 28 28 - { 29 29 - "`Resolved": { 30 30 - "`Module": [ 31 31 - { 32 32 - "`Identifier": { 33 33 - "`Module": [ 34 34 - { 35 35 - "`Root": [ 36 36 - "None", 37 37 - "Test" 38 38 - ] 39 39 - }, 40 40 - "Wrapper" 41 41 - ] 42 42 - } 43 43 - }, 44 44 - "X" 45 45 - ] 46 46 - } 47 47 - } 14 14 + null 48 15 49 16 The following should be resolved as Test.Wrapper2.X 50 17 51 18 52 19 $ odoc_print -r test3 test.odocl | jq '.equation.manifest.Some.Constr[0]["`Resolved"]["`Type"][0]["`Canonical"][1]' 53 53 - { 54 54 - "`Resolved": { 55 55 - "`Module": [ 56 56 - { 57 57 - "`Identifier": { 58 58 - "`Module": [ 59 59 - { 60 60 - "`Root": [ 61 61 - "None", 62 62 - "Test" 63 63 - ] 64 64 - }, 65 65 - "Wrapper2" 66 66 - ] 67 67 - } 68 68 - }, 69 69 - "X" 70 70 - ] 71 71 - } 72 72 - } 20 20 + null 73 21 74 22 This should probably not resolve at all, but that's a problem for another day. currently it resolves as Test.Wrapper3.X 75 23 76 24 $ odoc_print -r test3a test.odocl | jq '.type_.Constr[0]["`Resolved"]["`Type"][0]["`Canonical"][1]' 77 77 - { 78 78 - "`Resolved": { 79 79 - "`Module": [ 80 80 - { 81 81 - "`Identifier": { 82 82 - "`Module": [ 83 83 - { 84 84 - "`Root": [ 85 85 - "None", 86 86 - "Test" 87 87 - ] 88 88 - }, 89 89 - "Wrapper3" 90 90 - ] 91 91 - } 92 92 - }, 93 93 - "X" 94 94 - ] 95 95 - } 96 96 - } 25 25 + null 97 26 98 27 Should resolve as identifier Test.B 99 28 $ odoc_print -r test4 test.odocl | jq '.equation.manifest.Some.Constr[0]["`Resolved"]["`Type"][0]["`Canonical"][1]' 100 100 - { 101 101 - "`Resolved": { 102 102 - "`Identifier": { 103 103 - "`Module": [ 104 104 - { 105 105 - "`Root": [ 106 106 - "None", 107 107 - "Test" 108 108 - ] 109 109 - }, 110 110 - "B" 111 111 - ] 112 112 - } 113 113 - } 114 114 - } 29 29 + null 115 30 116 31 Should resove to be an alias! 117 32 $ odoc_print -r test5 test.odocl | jq '.equation.manifest.Some.Constr[0]["`Resolved"]["`Type"][0]["`Canonical"][1]' 118 118 - { 119 119 - "`Resolved": { 120 120 - "`Alias": [ 121 121 - { 122 122 - "`Identifier": { 123 123 - "`Module": [ 124 124 - { 125 125 - "`Root": [ 126 126 - "None", 127 127 - "Test" 128 128 - ] 129 129 - }, 130 130 - "C_" 131 131 - ] 132 132 - } 133 133 - }, 134 134 - { 135 135 - "`Identifier": [ 136 136 - { 137 137 - "`Module": [ 138 138 - { 139 139 - "`Root": [ 140 140 - "None", 141 141 - "Test" 142 142 - ] 143 143 - }, 144 144 - "C" 145 145 - ] 146 146 - }, 147 147 - "false" 148 148 - ] 149 149 - } 150 150 - ] 151 151 - } 152 152 - } 33 33 + null 153 34

+4 -4

odoc/test/xref2/canonical_module.t/run.t

reviewed

··· 22 22 23 23 $ odoc_print test.odocl | jq -c ".content.Module.items | .[] | .Module[1].type_.Alias[0] | select(.)" 24 24 {"`Resolved":{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_x"]}},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"X"]}}}]}} 25 25 - {"`Resolved":{"`Canonical":[{"`Module":[{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_x"]}},{"`Dot":[{"`Root":"Test"},"X"]}]},"Out"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"X_out"]}}}]}} 26 26 - {"`Resolved":{"`Canonical":[{"`Module":[{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_x"]}},{"`Dot":[{"`Root":"Test"},"X"]}]},"In"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"X_in"]}}}]}} 25 25 + {"`Resolved":{"`Canonical":[{"`Module":[{"`Module":{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_x"]}},{"`Dot":[{"`Root":"Test"},"X"]}]}},"Out"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"X_out"]}}}]}} 26 26 + {"`Resolved":{"`Canonical":[{"`Module":[{"`Module":{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_x"]}},{"`Dot":[{"`Root":"Test"},"X"]}]}},"In"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"X_in"]}}}]}} 27 27 {"`Resolved":{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_y"]}},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"Y"]}}}]}} 28 28 - {"`Resolved":{"`Canonical":[{"`Module":[{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_y"]}},{"`Dot":[{"`Root":"Test"},"Y"]}]},"Out"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"Y_out"]}}}]}} 29 29 - {"`Resolved":{"`Canonical":[{"`Module":[{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_y"]}},{"`Dot":[{"`Root":"Test"},"Y"]}]},"In"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"Y_in"]}}}]}} 28 28 + {"`Resolved":{"`Canonical":[{"`Module":[{"`Module":{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_y"]}},{"`Dot":[{"`Root":"Test"},"Y"]}]}},"Out"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"Y_out"]}}}]}} 29 29 + {"`Resolved":{"`Canonical":[{"`Module":[{"`Module":{"`Canonical":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"Test_y"]}},{"`Dot":[{"`Root":"Test"},"Y"]}]}},"In"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Test"]},"Y_in"]}}}]}}

+8 -6

odoc/test/xref2/canonical_nested.t/run.t

reviewed

··· 136 136 { 137 137 "`Module": [ 138 138 { 139 139 - "`Hidden": { 140 140 - "`Identifier": { 141 141 - "`Root": [ 142 142 - "None", 143 143 - "Main__" 144 144 - ] 139 139 + "`Module": { 140 140 + "`Hidden": { 141 141 + "`Identifier": { 142 142 + "`Root": [ 143 143 + "None", 144 144 + "Main__" 145 145 + ] 146 146 + } 145 147 } 146 148 } 147 149 },

+24 -22

odoc/test/xref2/canonical_type.t/run.t

reviewed

··· 121 121 "`Resolved": { 122 122 "`Type": [ 123 123 { 124 124 - "`Identifier": { 125 125 - "`Module": [ 126 126 - { 127 127 - "`Module": [ 128 128 - { 129 129 - "`Root": [ 130 130 - { 131 131 - "Some": { 132 132 - "`Page": [ 133 133 - "None", 134 134 - "x" 135 135 - ] 136 136 - } 137 137 - }, 138 138 - "Foo" 139 139 - ] 140 140 - }, 141 141 - "Type" 142 142 - ] 143 143 - }, 144 144 - "Path" 145 145 - ] 124 124 + "`Module": { 125 125 + "`Identifier": { 126 126 + "`Module": [ 127 127 + { 128 128 + "`Module": [ 129 129 + { 130 130 + "`Root": [ 131 131 + { 132 132 + "Some": { 133 133 + "`Page": [ 134 134 + "None", 135 135 + "x" 136 136 + ] 137 137 + } 138 138 + }, 139 139 + "Foo" 140 140 + ] 141 141 + }, 142 142 + "Type" 143 143 + ] 144 144 + }, 145 145 + "Path" 146 146 + ] 147 147 + } 146 148 } 147 149 }, 148 150 "t"

+41 -45

odoc/test/xref2/classes.t/run.t

reviewed

··· 51 51 [] 52 52 ] 53 53 }, 54 54 - "value": "Abstract", 55 55 - "modalities": [] 54 54 + "value": "Abstract" 56 55 } 57 56 $ odoc_print e.odoc -r g | jq . 58 57 { ··· 78 77 "`Resolved": { 79 78 "`ClassType": [ 80 79 { 81 81 - "`Identifier": { 82 82 - "`Root": [ 83 83 - "None", 84 84 - "B" 85 85 - ] 80 80 + "`Module": { 81 81 + "`Identifier": { 82 82 + "`Root": [ 83 83 + "None", 84 84 + "B" 85 85 + ] 86 86 + } 86 87 } 87 88 }, 88 89 "u" ··· 92 93 [] 93 94 ] 94 95 }, 95 95 - "value": "Abstract", 96 96 - "modalities": [] 96 96 + "value": "Abstract" 97 97 } 98 98 $ odoc_print e.odoc -r d | jq '.expr.Signature.items[1].Method.type_' 99 99 { ··· 102 102 "`Resolved": { 103 103 "`ClassType": [ 104 104 { 105 105 - "`Identifier": { 106 106 - "`Root": [ 107 107 - "None", 108 108 - "B" 109 109 - ] 105 105 + "`Module": { 106 106 + "`Identifier": { 107 107 + "`Root": [ 108 108 + "None", 109 109 + "B" 110 110 + ] 111 111 + } 110 112 } 111 113 }, 112 114 "u" ··· 120 122 $ odoc_print c.odoc -r g | jq '.type_' 121 123 { 122 124 "Arrow": [ 123 123 - [ 124 124 - "None", 125 125 - { 126 126 - "Class": [ 127 127 - { 128 128 - "`Resolved": { 129 129 - "`ClassType": [ 130 130 - { 125 125 + "None", 126 126 + { 127 127 + "Class": [ 128 128 + { 129 129 + "`Resolved": { 130 130 + "`ClassType": [ 131 131 + { 132 132 + "`Module": { 131 133 "`Identifier": { 132 134 "`Root": [ 133 135 "None", 134 136 "B" 135 137 ] 136 138 } 137 137 - }, 138 138 - "u" 139 139 - ] 140 140 - } 141 141 - }, 142 142 - [] 143 143 - ] 144 144 - } 145 145 - ], 146 146 - [ 147 147 - { 148 148 - "Constr": [ 149 149 - { 150 150 - "`Resolved": { 151 151 - "`CoreType": "unit" 152 152 - } 153 153 - }, 154 154 - [] 155 155 - ] 156 156 - }, 157 157 - [ 158 158 - [], 139 139 + } 140 140 + }, 141 141 + "u" 142 142 + ] 143 143 + } 144 144 + }, 145 145 + [] 146 146 + ] 147 147 + }, 148 148 + { 149 149 + "Constr": [ 150 150 + { 151 151 + "`Resolved": { 152 152 + "`CoreType": "unit" 153 153 + } 154 154 + }, 159 155 [] 160 156 ] 161 161 - ] 157 157 + } 162 158 ] 163 159 } 164 160

+24 -5

odoc/test/xref2/lib/common.cppo.ml

reviewed

··· 543 543 match p with 544 544 | `Apply (p1, p2) -> Format.fprintf ppf "%a(%a)" resolved_path (cast p1) resolved_path (cast p2) 545 545 | `Identifier p -> Format.fprintf ppf "global(%a)" identifier p 546 546 - | `Alias (dest, src) -> Format.fprintf ppf "(%a -> %a)" path (src :> Odoc_model.Paths.Path.t) resolved_path (cast dest) 546 546 + | `Alias (dest, src, _) -> Format.fprintf ppf "(%a -> %a)" path (src :> Odoc_model.Paths.Path.t) resolved_path (cast dest) 547 547 | `AliasModuleType (path, realpath) -> Format.fprintf ppf "(%a -> %a)" resolved_path (cast path) resolved_path (cast realpath) 548 548 | `Subst (modty, m) -> Format.fprintf ppf "(%a subst-> %a)" resolved_path (cast modty) resolved_path (cast m) 549 549 - | `Module (p, m) -> Format.fprintf ppf "%a.%s" resolved_path (cast p) (ModuleName.to_string m) 550 550 - | `ModuleType (p, mt) -> Format.fprintf ppf "%a.%s" resolved_path (cast p) (ModuleTypeName.to_string mt) 551 551 - | `Type (p, t) -> Format.fprintf ppf "%a.%s" resolved_path (cast p) (TypeName.to_string t) 552 552 - | `Value (p, t) -> Format.fprintf ppf "%a.%s" resolved_path (cast p) (ValueName.to_string t) 549 549 + | `Module (`Module m, name) -> Format.fprintf ppf "%a.%s" resolved_path (cast m) (ModuleName.to_string name) 550 550 + | `Module (`ModuleType (_, `Na _), _) -> . 551 551 + | `Module (`FragmentRoot (`Na _), _) -> . 552 552 + | `ModuleType (`Module m, mt) -> Format.fprintf ppf "%a.%s" resolved_path (cast m) (ModuleTypeName.to_string mt) 553 553 + | `ModuleType (`ModuleType (_, `Na _), _) -> . 554 554 + | `ModuleType (`FragmentRoot (`Na _), _) -> . 555 555 + | `Type (`Module m, t) -> Format.fprintf ppf "%a.%s" resolved_path (cast m) (TypeName.to_string t) 556 556 + | `Type (`ModuleType (_, `Na _), _) -> . 557 557 + | `Type (`FragmentRoot (`Na _), _) -> . 558 558 + | `Value (`Module m, t) -> Format.fprintf ppf "%a.%s" resolved_path (cast m) (ValueName.to_string t) 559 559 + | `Value (`ModuleType (_, `Na _), _) -> . 560 560 + | `Value (`FragmentRoot (`Na _), _) -> . 553 561 | `OpaqueModule m -> Format.fprintf ppf "opaquemodule(%a)" resolved_path (cast m) 554 562 | `OpaqueModuleType m -> Format.fprintf ppf "opaquemoduletype(%a)" resolved_path (cast m) 555 563 | `SubstT (_, _) ··· 564 572 | `Substituted _ 565 573 | `SubstitutedCT _ 566 574 | `Canonical _ -> Format.fprintf ppf "unimplemented resolved_path" 575 575 + | `LocalMod (`Na _) -> . 576 576 + | `LocalModTy (`Na _) -> . 577 577 + | `LocalTy (`Na _) -> . 578 578 + | `LocalVal (`Na _) -> . 567 579 568 580 and path : Format.formatter -> Odoc_model.Paths.Path.t -> unit = 569 581 fun ppf (p : Odoc_model.Paths.Path.t) -> ··· 578 590 | `DotV (parent,s) -> Format.fprintf ppf "%a.%a" path (parent :> Odoc_model.Paths.Path.t) ValueName.fmt s 579 591 | `Apply (func,arg) -> Format.fprintf ppf "%a(%a)" path (func :> Odoc_model.Paths.Path.t) path (arg :> Odoc_model.Paths.Path.t) 580 592 | `SubstitutedT _|`SubstitutedMT _|`Substituted _|`SubstitutedCT _ -> Format.fprintf ppf "Unimplemented path" 593 593 + | `Module (`Na _, _, _) -> . 594 594 + | `ModuleType (`Na _, _, _) -> . 595 595 + | `Type (`Na _, _, _) -> . 596 596 + | `LocalMod (`Na _) -> . 597 597 + | `LocalModTy (`Na _) -> . 598 598 + | `LocalTy (`Na _) -> . 599 599 + | `LocalVal (`Na _) -> . 581 600 582 601 and model_fragment ppf (f : Odoc_model.Paths.Fragment.t) = 583 602 match f with

+3 -3

odoc/test/xref2/module_list.t/run.t

reviewed

··· 35 35 {"Some":[{"`Word":"Doc"},"`Space",{"`Word":"of"},"`Space",{"`Code_span":"Type_of_str"},{"`Word":"."}]} 36 36 {"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"With_type"]}}} 37 37 {"Some":[{"`Word":"Doc"},"`Space",{"`Word":"for"},"`Space",{"`Code_span":"T"},{"`Word":"."}]} 38 38 - {"`Resolved":{"`Alias":[{"`Module":[{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"External"]}},"X"]},{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"Alias"]}}]}} 38 38 + {"`Resolved":{"`Alias":[{"`Module":[{"`Module":{"`Identifier":{"`Root":[{"Some":{"`Page":["None","test"]}},"External"]}}},"X"]},{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"Alias"]}}]}} 39 39 {"Some":[{"`Word":"Doc"},"`Space",{"`Word":"for"},"`Space",{"`Code_span":"X"},{"`Word":"."}]} 40 40 - {"`Resolved":{"`Alias":[{"`Canonical":[{"`Module":[{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"Internal"]}},"C1"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"C1"]}}}]},{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"C1"]}}]}} 40 40 + {"`Resolved":{"`Alias":[{"`Canonical":[{"`Module":[{"`Module":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"Internal"]}}},"C1"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"C1"]}}}]},{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"C1"]}}]}} 41 41 {"Some":[{"`Word":"Doc"},"`Space",{"`Word":"for"},"`Space",{"`Code_span":"C1"},{"`Word":"."}]} 42 42 - {"`Resolved":{"`Alias":[{"`Canonical":[{"`Module":[{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"Internal"]}},"C2"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"C2"]}}}]},{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"C2"]}}]}} 42 42 + {"`Resolved":{"`Alias":[{"`Canonical":[{"`Module":[{"`Module":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"Internal"]}}},"C2"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"C2"]}}}]},{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"C2"]}}]}} 43 43 "None" 44 44 {"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"Some":{"`Page":["None","test"]}},"Main"]},"Inline_include"]}}} 45 45 {"Some":[{"`Word":"Doc"},"`Space",{"`Word":"for"},"`Space",{"`Code_span":"T"},{"`Word":"."}]}

+48 -40

odoc/test/xref2/recursive_modules.t/run.t

reviewed

··· 31 31 "`Resolved": { 32 32 "`Type": [ 33 33 { 34 34 - "`Identifier": { 35 35 - "`Module": [ 36 36 - { 37 37 - "`Root": [ 38 38 - "None", 39 39 - "M" 40 40 - ] 41 41 - }, 42 42 - "B" 43 43 - ] 34 34 + "`Module": { 35 35 + "`Identifier": { 36 36 + "`Module": [ 37 37 + { 38 38 + "`Root": [ 39 39 + "None", 40 40 + "M" 41 41 + ] 42 42 + }, 43 43 + "B" 44 44 + ] 45 45 + } 44 46 } 45 47 }, 46 48 "t" ··· 54 56 "`Resolved": { 55 57 "`Type": [ 56 58 { 57 57 - "`Identifier": { 58 58 - "`Module": [ 59 59 - { 60 60 - "`Root": [ 61 61 - "None", 62 62 - "M" 63 63 - ] 64 64 - }, 65 65 - "A" 66 66 - ] 59 59 + "`Module": { 60 60 + "`Identifier": { 61 61 + "`Module": [ 62 62 + { 63 63 + "`Root": [ 64 64 + "None", 65 65 + "M" 66 66 + ] 67 67 + }, 68 68 + "A" 69 69 + ] 70 70 + } 67 71 } 68 72 }, 69 73 "t" ··· 100 104 "`Resolved": { 101 105 "`Type": [ 102 106 { 103 103 - "`Identifier": { 104 104 - "`Module": [ 105 105 - { 106 106 - "`Root": [ 107 107 - "None", 108 108 - "M" 109 109 - ] 110 110 - }, 111 111 - "A" 112 112 - ] 107 107 + "`Module": { 108 108 + "`Identifier": { 109 109 + "`Module": [ 110 110 + { 111 111 + "`Root": [ 112 112 + "None", 113 113 + "M" 114 114 + ] 115 115 + }, 116 116 + "A" 117 117 + ] 118 118 + } 113 119 } 114 120 }, 115 121 "t" ··· 123 129 "`Resolved": { 124 130 "`Type": [ 125 131 { 126 126 - "`Identifier": { 127 127 - "`Module": [ 128 128 - { 129 129 - "`Root": [ 130 130 - "None", 131 131 - "M" 132 132 - ] 133 133 - }, 134 134 - "B" 135 135 - ] 132 132 + "`Module": { 133 133 + "`Identifier": { 134 134 + "`Module": [ 135 135 + { 136 136 + "`Root": [ 137 137 + "None", 138 138 + "M" 139 139 + ] 140 140 + }, 141 141 + "B" 142 142 + ] 143 143 + } 136 144 } 137 145 }, 138 146 "t"